diff --git a/glazier-react.cabal b/glazier-react.cabal --- a/glazier-react.cabal +++ b/glazier-react.cabal @@ -1,5 +1,5 @@ name: glazier-react -version: 0.1.0.0 +version: 0.2.0.0 synopsis: ReactJS binding using Glazier and Pipes.Fluid description: ReactJS binding using Glazier and Pipes.Fluid, which is more functional and composable than Elm/Flux. diff --git a/src/Glazier/React/Command/Run.hs b/src/Glazier/React/Command/Run.hs --- a/src/Glazier/React/Command/Run.hs +++ b/src/Glazier/React/Command/Run.hs @@ -14,11 +14,11 @@ import qualified JavaScript.Extras as JE import qualified JavaScript.Object as JO -componentSetState :: R.HasSuperModel sm g m => sm -> [JE.Property] -> J.JSVal -> IO () +componentSetState :: R.HasSuperModel sm mdl pln => sm -> [JE.Property] -> J.JSVal -> IO () componentSetState sm props j = do - let gm = sm ^. R.gModel - mm = sm ^. R.mModel - void $ swapMVar mm gm + let dsn = sm ^. R.design + rep = sm ^. R.replica + void $ swapMVar rep dsn js_componentSetState (JE.fromProperties props) j #ifdef __GHCJS__ diff --git a/src/Glazier/React/Maker.hs b/src/Glazier/React/Maker.hs --- a/src/Glazier/React/Maker.hs +++ b/src/Glazier/React/Maker.hs @@ -25,17 +25,17 @@ :: (J.JSVal -> MaybeT IO [act]) -> (J.Callback (J.JSVal -> IO ()) -> nxt) -> Maker act nxt - MkEmptyMModel - :: (R.MModel gsk mdl -> nxt) + MkEmptyReplica + :: (R.Replica mdl pln -> nxt) -> Maker act nxt MkRenderer - :: R.MModel gsk mdl - -> (J.JSVal -> G.WindowT (R.GModel gsk mdl) (R.ReactMl) ()) + :: R.Replica mdl pln + -> (J.JSVal -> G.WindowT (R.Design mdl pln) (R.ReactMl) ()) -> (J.Callback (J.JSVal -> IO J.JSVal) -> nxt) -> Maker act nxt - PutMModel - :: R.MModel gsk mdl - -> R.GModel gsk mdl + PutReplica + :: R.Replica mdl pln + -> R.Design mdl pln -> nxt -> Maker act nxt GetComponent @@ -44,9 +44,9 @@ instance Functor (Maker act) where fmap f (MkHandler handler g) = MkHandler handler (f . g) - fmap f (MkEmptyMModel g) = MkEmptyMModel (f . g) + fmap f (MkEmptyReplica g) = MkEmptyReplica (f . g) fmap f (MkRenderer ms render g) = MkRenderer ms render (f . g) - fmap f (PutMModel ms s x) = PutMModel ms s (f x) + fmap f (PutReplica rep dsn x) = PutReplica rep dsn (f x) fmap f (GetComponent g) = GetComponent (f . g) makeFree ''Maker @@ -54,19 +54,19 @@ -- | Allows changing the action type of Maker mapAction :: (act -> act') -> Maker act a -> Maker act' a mapAction f (MkHandler handler g) = MkHandler (\v -> fmap f <$> handler v) g -mapAction _ (MkEmptyMModel g) = MkEmptyMModel g +mapAction _ (MkEmptyReplica g) = MkEmptyReplica g mapAction _ (MkRenderer ms render g) = MkRenderer ms render g -mapAction _ (PutMModel ms s x) = PutMModel ms s x +mapAction _ (PutReplica ms s x) = PutReplica ms s x mapAction _ (GetComponent g) = GetComponent g mkSuperModel :: MonadFree (Maker act) m - => (R.MModel gsk mdl -> m gsk) - -> (gsk -> R.GModel gsk mdl) - -> m (R.SuperModel gsk mdl) -mkSuperModel makeGasket createGModel = do - mm <- mkEmptyMModel - g <- makeGasket mm - let gm = createGModel g - putMModel mm gm - pure (R.SuperModel mm gm) + => (R.Replica mdl pln -> m pln) + -> (pln -> R.Design mdl pln) + -> m (R.SuperModel mdl pln) +mkSuperModel makePlan toDesign = do + rep <- mkEmptyReplica + pln <- makePlan rep + let dsn = toDesign pln + putReplica rep dsn + pure (R.SuperModel dsn rep) diff --git a/src/Glazier/React/Maker/Run.hs b/src/Glazier/React/Maker/Run.hs --- a/src/Glazier/React/Maker/Run.hs +++ b/src/Glazier/React/Maker/Run.hs @@ -35,12 +35,12 @@ run :: R.ReactComponent -> PC.Output act -> R.Maker act (IO a) -> IO a run _ output (R.MkHandler handler g) = mkActionCallback output handler >>= g -run _ _ (R.MkEmptyMModel g) = newEmptyMVar >>= g +run _ _ (R.MkEmptyReplica g) = newEmptyMVar >>= g run _ _ (R.MkRenderer ms render g) = J.syncCallback1' (onRender ms render') >>= g where render' v = hoist (hoist generalize) (render v) -run _ _ (R.PutMModel ms s g) = putMVar ms s >> g +run _ _ (R.PutReplica rep dsn g) = putMVar rep dsn >> g run component _ (R.GetComponent g) = g component diff --git a/src/Glazier/React/Widget.hs b/src/Glazier/React/Widget.hs --- a/src/Glazier/React/Widget.hs +++ b/src/Glazier/React/Widget.hs @@ -13,62 +13,62 @@ import Control.Lens import qualified GHC.Generics as G -class HasWidgetGasket c gsk | c -> gsk where - widgetGasket :: Lens' c gsk +class HasWidgetPlan c pln | c -> pln where + widgetPlan :: Lens' c pln class HasWidgetModel c mdl | c -> mdl where widgetModel :: Lens' c mdl -data GModel gsk mdl = GModel - { _widgetGasket :: gsk - , _widgetModel :: mdl +data Design mdl pln = Design + { _widgetModel :: mdl + , _widgetPlan :: pln } deriving (G.Generic) -instance (CD.Disposing gsk, CD.Disposing mdl) => CD.Disposing (GModel gsk mdl) +instance (CD.Disposing pln, CD.Disposing mdl) => CD.Disposing (Design mdl pln) -instance HasWidgetGasket (GModel gsk mdl) gsk where - widgetGasket f (GModel gsk mdl) = fmap (\gsk' -> GModel gsk' mdl) (f gsk) - {-# INLINE widgetGasket #-} +instance HasWidgetPlan (Design mdl pln) pln where + widgetPlan f (Design mdl pln) = fmap (\pln' -> Design mdl pln') (f pln) + {-# INLINE widgetPlan #-} -instance HasWidgetModel (GModel gsk mdl) mdl where - widgetModel f (GModel gsk mdl) = fmap (\mdl' -> GModel gsk mdl') (f mdl) +instance HasWidgetModel (Design mdl pln) mdl where + widgetModel f (Design mdl pln) = fmap (\mdl' -> Design mdl' pln) (f mdl) {-# INLINE widgetModel #-} -class HasGModel c gsk mdl | c -> gsk mdl where - gModel :: Lens' c (GModel gsk mdl) +class HasDesign c mdl pln | c -> mdl pln where + design :: Lens' c (Design mdl pln) -instance HasGModel (GModel gsk mdl) gsk mdl where - gModel = id +instance HasDesign (Design mdl pln) mdl pln where + design = id -type MModel gsk mdl = MVar (GModel gsk mdl) +type Replica mdl pln = MVar (Design mdl pln) -class HasMModel c gsk mdl | c -> gsk mdl where - mModel :: Lens' c (MModel gsk mdl) +class HasReplica c mdl pln | c -> mdl pln where + replica :: Lens' c (Replica mdl pln) -instance HasMModel (MModel gsk mdl) gsk mdl where - mModel = id +instance HasReplica (Replica mdl pln) mdl pln where + replica = id -data SuperModel gsk mdl = SuperModel - { _mModel :: MModel gsk mdl - , _gModel :: GModel gsk mdl +data SuperModel mdl pln = SuperModel + { _design :: Design mdl pln + , _replica :: Replica mdl pln } deriving (G.Generic) -instance CD.Disposing (GModel gsk mdl) => CD.Disposing (SuperModel gsk mdl) where - disposing s = CD.disposing $ s ^. gModel +instance CD.Disposing (Design mdl pln) => CD.Disposing (SuperModel mdl pln) where + disposing s = CD.disposing $ s ^. design -class (HasMModel c gsk mdl, HasGModel c gsk mdl) => HasSuperModel c gsk mdl | c -> gsk mdl where - superModel :: Lens' c (SuperModel gsk mdl) +class (HasDesign c mdl pln, HasReplica c mdl pln) => HasSuperModel c mdl pln | c -> mdl pln where + superModel :: Lens' c (SuperModel mdl pln) -instance HasSuperModel (SuperModel gsk mdl) gsk mdl where +instance HasSuperModel (SuperModel mdl pln) mdl pln where superModel = id -instance HasMModel (SuperModel gsk mdl) gsk mdl where - mModel f (SuperModel mm gm) = fmap (\mm' -> SuperModel mm' gm) (f mm) - {-# INLINE mModel #-} +instance HasReplica (SuperModel mdl pln) mdl pln where + replica f (SuperModel dsn rep) = fmap (\rep' -> SuperModel dsn rep') (f rep) + {-# INLINE replica #-} -instance HasGModel (SuperModel gsk mdl) gsk mdl where - gModel f (SuperModel mm gm) = fmap (\gm' -> SuperModel mm gm') (f gm) - {-# INLINE gModel #-} +instance HasDesign (SuperModel mdl pln) mdl pln where + design f (SuperModel dsn rep) = fmap (\dsn' -> SuperModel dsn' rep) (f dsn) + {-# INLINE design #-} class IsWidget w where -- The input to Gadget @@ -81,8 +81,8 @@ type WidgetModel w :: * -- Callbacks and data required for interfacing with react. - type WidgetGasket w :: * + type WidgetPlan w :: * -type WidgetGModel w = GModel (WidgetGasket w) (WidgetModel w) -type WidgetMModel w = MModel (WidgetGasket w) (WidgetModel w) -type WidgetSuperModel w = SuperModel (WidgetGasket w) (WidgetModel w) +type WidgetDesign w = Design (WidgetModel w) (WidgetPlan w) +type WidgetReplica w = Replica (WidgetModel w) (WidgetPlan w) +type WidgetSuperModel w = SuperModel (WidgetModel w) (WidgetPlan w)