module Glazier.React.Widget where
import qualified Control.Disposable as CD
import Control.Lens
import Control.Monad.Free.Church
import qualified Data.DList as D
import qualified Glazier as G
import qualified Glazier.React.Maker as R
import qualified Glazier.React.Markup as R
import qualified Glazier.React.Model as R
type family CommandOf w where
CommandOf (Widget c a o m p) = c
type family ActionOf w where
ActionOf (Widget c a o m p) = a
type family OutlineOf w where
OutlineOf (Widget c a o m p) = o
type family ModelOf w where
ModelOf (Widget c a o m p) = m
type family PlanOf w where
PlanOf (Widget c a o m p) = p
type SceneOf w = R.Scene (ModelOf w) (PlanOf w)
type FrameOf w = R.Frame (ModelOf w) (PlanOf w)
type GizmoOf w = R.Gizmo (ModelOf w) (PlanOf w)
type WindowOf w = G.WindowT (SceneOf w) (R.ReactMlT Identity) ()
type GadgetOf w = G.GadgetT (ActionOf w) (GizmoOf w) Identity (D.DList (CommandOf w))
data WithGizmo
data WithOutline
type family SchemaType tag w where
SchemaType WithGizmo w = GizmoOf w
SchemaType WithOutline w = OutlineOf w
data Widget c a o m p where
Widget
:: (CD.Disposing m, CD.Disposing p, R.ToOutline m o)
=> (o -> F (R.Maker a) m)
-> (R.Frame m p -> F (R.Maker a) p)
-> G.WindowT (R.Scene m p) (R.ReactMlT Identity) ()
-> G.GadgetT a (R.Gizmo m p) Identity (D.DList c)
-> Widget c a o m p
class (CD.Disposing (ModelOf w)
, CD.Disposing (PlanOf w)
, R.ToOutline (ModelOf w) (OutlineOf w)) => IsWidget w where
mkModel :: w -> OutlineOf w -> F (R.Maker (ActionOf w)) (ModelOf w)
mkPlan :: w -> R.Frame (ModelOf w) (PlanOf w) -> F (R.Maker (ActionOf w)) (PlanOf w)
window :: w -> G.WindowT (R.Scene (ModelOf w) (PlanOf w)) (R.ReactMlT Identity) ()
gadget :: w -> G.GadgetT (ActionOf w) (R.Gizmo (ModelOf w) (PlanOf w)) Identity (D.DList (CommandOf w))
instance (CD.Disposing m, CD.Disposing p, R.ToOutline m o) => IsWidget (Widget c a o m p) where
mkModel (Widget f _ _ _) = f
mkPlan (Widget _ f _ _) = f
window (Widget _ _ f _) = f
gadget (Widget _ _ _ f) = f
mkGizmo :: IsWidget w => w -> ModelOf w -> F (R.Maker (ActionOf w)) (R.Gizmo (ModelOf w) (PlanOf w))
mkGizmo w mdl = do
frm <- R.mkEmptyFrame
scn <- R.Scene mdl <$> mkPlan w frm
R.putFrame frm scn
pure (R.Gizmo scn frm)
mkGizmo' ::
IsWidget w =>
w
-> OutlineOf w
-> F (R.Maker (ActionOf w)) (R.Gizmo (ModelOf w) (PlanOf w))
mkGizmo' w i = mkModel w i >>= mkGizmo w