diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -103,7 +103,7 @@ This contains the pure data for state processing logic and rendering (the nouns). ```haskell data Model = Model - { _uid :: J.JSString + { _key :: J.JSString , _componentRef :: J.JSVal , _frameNum :: Int , _deferredCommands :: D.DList (Command key itemWidget) @@ -113,11 +113,11 @@ `Model`s should have [`makeClassy`](https://hackage.haskell.org/package/lens-4.15.1/docs/Control-Lens-TH.html#v:makeClassy) generated to facilitate embedding it in larger widget with [`magnify`](https://hackage.haskell.org/package/lens-4.15.1/docs/Control-Lens-Zoom.html#v:magnify) and [`zoom`](https://hackage.haskell.org/package/lens-4.15.1/docs/Control-Lens-Zoom.html#v:zoom). Some common Model fields are -### uid +### key ```haskell -_uid :: JSString +_key :: JSString ``` -`uid` is used to ensure a unique [key](https://facebook.github.io/react/docs/lists-and-keys.html) for React's efficient rendering of a list. +`key` is used to ensure a unique [key](https://facebook.github.io/react/docs/lists-and-keys.html) for React's efficient rendering of a list. ### componentRef ```haskell @@ -131,11 +131,11 @@ ``` `frameNum` is the sequence number used in `RenderCommand`. -### _deferredCommands +### _deferredDisposables ```haskell -_deferredCommands :: DList Command +_deferredDisposables :: DList SomeDisposable ``` -`deferredCommands` keep the list of commands to run at the next `ComponentDidUpdateAction`. It usually contains `DisposeCommand`. +`deferredDisposables` keep the list of disposables to dispose at the next `ComponentDidUpdateAction`. ## Plan The `Plan` contains the callbacks for integrating with React (the verbs). It also contains a javascript reference to the instance of shim component used for the widget. This reference is used to trigger rendering with [`setState`](https://facebook.github.io/react/docs/react-component.html#setstate). @@ -243,7 +243,7 @@ window = do s <- ask lift $ lf (s ^. component . to toJS) - [ ("key", s ^. uid . to toJS) + [ ("key", s ^. key . to toJS) , ("render", s ^. onRender . to toJS) , ("ref", s ^. onComponentRef . to toJS) , ("componentDidUpdate", s ^. onComponentDidUpdate . to toJS) diff --git a/glazier-react-widget.cabal b/glazier-react-widget.cabal --- a/glazier-react-widget.cabal +++ b/glazier-react-widget.cabal @@ -1,5 +1,5 @@ name: glazier-react-widget -version: 0.3.0.1 +version: 0.4.0.0 synopsis: Generic widget library using glazier-react description: Generic widget library using glazier-react homepage: https://github.com/louispan/glazier-react-widget#readme @@ -21,12 +21,12 @@ Glazier.React.Widgets.List.Run build-depends: base >= 4.7 && < 5 , containers >= 0.5 && < 0.6 - , disposable >= 0.2.0.2 && < 1 + , disposable >= 0.2.0.3 && < 1 , dlist >= 0.8 && < 0.9 , free >= 4.12 && < 5 , glazier >= 0.10 && < 1 - , glazier-react >= 0.3 && < 1 - , javascript-extras >= 0.2 && < 1 + , glazier-react >= 0.4 && < 1 + , javascript-extras >= 0.2.0.2 && < 1 , lens >= 4 && < 5 , mmorph >= 1 && < 2 , mtl >= 2 && < 3 diff --git a/src/Glazier/React/Widgets/Input.hs b/src/Glazier/React/Widgets/Input.hs --- a/src/Glazier/React/Widgets/Input.hs +++ b/src/Glazier/React/Widgets/Input.hs @@ -56,7 +56,7 @@ | InputRefAction J.JSVal data Model = Model - { _uid :: J.JSString + { _key :: J.JSString , _inputRef :: J.JSVal , _placeholder :: J.JSString , _className :: J.JSString @@ -110,7 +110,7 @@ window = do s <- ask lift $ R.lf (s ^. component . to JE.toJS) - [ ("key", s ^. uid . to JE.toJS) + [ ("key", s ^. key . to JE.toJS) , ("render", s ^. onRender . to JE.toJS) ] @@ -119,7 +119,7 @@ render = do s <- ask lift $ R.lf (JE.strJS "input") - [ ("key", s ^. uid . to JE.toJS) + [ ("key", s ^. key . to JE.toJS) , ("className", s ^. className . to JE.toJS) , ("placeholder", s ^. placeholder . to JE.toJS) , ("autoFocus", JE.toJS True) diff --git a/src/Glazier/React/Widgets/List.hs b/src/Glazier/React/Widgets/List.hs --- a/src/Glazier/React/Widgets/List.hs +++ b/src/Glazier/React/Widgets/List.hs @@ -51,30 +51,30 @@ import qualified Glazier.React.Widget as R import qualified JavaScript.Extras as JE -data Command key itemWidget - = RenderCommand (R.SuperModel (Model key itemWidget) Plan) [JE.Property] J.JSVal +data Command k itemWidget + = RenderCommand (R.SuperModel (Model k itemWidget) Plan) [JE.Property] J.JSVal | DisposeCommand CD.SomeDisposable - | MakerCommand (F (R.Maker (Action key itemWidget)) (Action key itemWidget)) - | ItemCommand key (R.CommandOf itemWidget) + | MakerCommand (F (R.Maker (Action k itemWidget)) (Action k itemWidget)) + | ItemCommand k (R.CommandOf itemWidget) -data Action key itemWidget +data Action k itemWidget = ComponentRefAction J.JSVal | RenderAction | ComponentDidUpdateAction - | DestroyItemAction key - | MakeItemAction (key -> key) (key -> F (R.Maker (R.ActionOf itemWidget)) (R.ModelOf itemWidget)) - | AddItemAction key (R.SuperModelOf itemWidget) - | ItemAction key (R.ActionOf itemWidget) + | DestroyItemAction k + | MakeItemAction (k -> k) (k -> F (R.Maker (R.ActionOf itemWidget)) (R.ModelOf itemWidget)) + | AddItemAction k (R.SuperModelOf itemWidget) + | ItemAction k (R.ActionOf itemWidget) | SetFilterAction (R.SuperModelOf itemWidget -> Bool) -data Model key itemWidget = Model - { _uid :: J.JSString +data Model k itemWidget = Model + { _key :: J.JSString , _componentRef :: J.JSVal , _frameNum :: Int - , _deferredCommands :: D.DList (Command key itemWidget) + , _deferredDisposables :: D.DList CD.SomeDisposable , _className ::J.JSString - , _itemKey :: key - , _itemsModel :: M.Map key (R.SuperModelOf itemWidget) + , _itemKey :: k + , _itemsModel :: M.Map k (R.SuperModelOf itemWidget) , _itemsFilter :: R.SuperModelOf itemWidget -> Bool } @@ -92,8 +92,8 @@ mkPlan :: R.ReactMlT Identity () -> G.WindowT (R.DesignOf itemWidget) (R.ReactMlT Identity) () - -> R.Frame (Model key itemWidget) Plan - -> F (R.Maker (Action key itemWidget)) Plan + -> R.Frame (Model k itemWidget) Plan + -> F (R.Maker (Action k itemWidget)) Plan mkPlan separator itemWindow frm = Plan <$> R.getComponent <*> (R.mkRenderer frm $ const (render separator itemWindow)) @@ -102,40 +102,40 @@ instance CD.Disposing Plan instance (CD.Disposing (R.SuperModelOf itemWidget)) => - CD.Disposing (Model key itemWidget) where + CD.Disposing (Model k itemWidget) where disposing s = CD.DisposeList $ foldr ((:) . CD.disposing) [] (_itemsModel s) -- Link Glazier.React.Model's HasPlan/HasModel with this widget's HasPlan/HasModel from makeClassy -instance HasPlan (R.Design (Model key itemWidget) Plan) where +instance HasPlan (R.Design (Model k itemWidget) Plan) where plan = R.plan -instance HasModel (R.Design (Model key itemWidget) Plan) key itemWidget where +instance HasModel (R.Design (Model k itemWidget) Plan) k itemWidget where model = R.model -instance HasPlan (R.SuperModel (Model key itemWidget) Plan) where +instance HasPlan (R.SuperModel (Model k itemWidget) Plan) where plan = R.design . plan -instance HasModel (R.SuperModel (Model key itemWidget) Plan) key itemWidget where +instance HasModel (R.SuperModel (Model k itemWidget) Plan) k itemWidget where model = R.design . model -type Design key itemWidget = R.Design (Model key itemWidget) Plan -type Frame key itemWidget = R.Frame (Model key itemWidget) Plan -type SuperModel key itemWidget = R.SuperModel (Model key itemWidget) Plan +type Design k itemWidget = R.Design (Model k itemWidget) Plan +type Frame k itemWidget = R.Frame (Model k itemWidget) Plan +type SuperModel k itemWidget = R.SuperModel (Model k itemWidget) Plan -type Widget key itemWidget = R.Widget (Command key itemWidget) (Action key itemWidget) (Model key itemWidget) Plan +type Widget k itemWidget = R.Widget (Command k itemWidget) (Action k itemWidget) (Model k itemWidget) Plan widget - :: (R.IsWidget itemWidget, Ord key) + :: (R.IsWidget itemWidget, Ord k) => R.ReactMlT Identity () -> itemWidget - -> R.Widget (Command key itemWidget) (Action key itemWidget) (Model key itemWidget) Plan + -> R.Widget (Command k itemWidget) (Action k itemWidget) (Model k itemWidget) Plan widget separator itemWidget = R.Widget (mkPlan separator (R.window itemWidget)) window (gadget (R.mkSuperModel itemWidget) (R.gadget itemWidget)) -- | Exposed to parent components to render this component -window :: G.WindowT (R.Design (Model key itemWidget) Plan) (R.ReactMlT Identity) () +window :: G.WindowT (R.Design (Model k itemWidget) Plan) (R.ReactMlT Identity) () window = do s <- ask lift $ R.lf (s ^. component . to JE.toJS) - [ ("key", s ^. uid . to JE.toJS) + [ ("key", s ^. key . to JE.toJS) , ("render", s ^. onRender . to JE.toJS) , ("ref", s ^. onComponentRef . to JE.toJS) , ("componentDidUpdate", s ^. onComponentDidUpdate . to JE.toJS) @@ -145,11 +145,11 @@ render :: R.ReactMlT Identity () -> G.WindowT (R.DesignOf itemWidget) (R.ReactMlT Identity) () - -> G.WindowT (R.Design (Model key itemWidget) Plan) (R.ReactMlT Identity) () + -> G.WindowT (R.Design (Model k itemWidget) Plan) (R.ReactMlT Identity) () render separator itemWindow = do s <- ask items <- fmap (view R.design) . filter (s ^. itemsFilter) . fmap snd . M.toList <$> view itemsModel - lift $ R.bh (JE.strJS "ul") [ ("key", s ^. uid . to JE.toJS) + lift $ R.bh (JE.strJS "ul") [ ("key", s ^. key . to JE.toJS) , ("className", s ^. className . to JE.toJS) ] $ do let itemsWindows = (view G._WindowT itemWindow) <$> items @@ -157,10 +157,10 @@ sequenceA_ separatedWindows gadget - :: (Ord key, CD.Disposing (R.ModelOf itemWidget), CD.Disposing (R.PlanOf itemWidget)) + :: (Ord k, R.IsWidget itemWidget) => (R.ModelOf itemWidget -> F (R.Maker (R.ActionOf itemWidget)) (R.SuperModelOf itemWidget)) -> G.GadgetT (R.ActionOf itemWidget) (R.SuperModelOf itemWidget) Identity (D.DList (R.CommandOf itemWidget)) - -> G.GadgetT (Action key itemWidget) (R.SuperModel (Model key itemWidget) Plan) Identity (D.DList (Command key itemWidget)) + -> G.GadgetT (Action k itemWidget) (R.SuperModel (Model k itemWidget) Plan) Identity (D.DList (Command k itemWidget)) gadget mkItemSuperModel itemGadget = do a <- ask case a of @@ -174,16 +174,15 @@ ComponentDidUpdateAction -> do -- Run delayed commands that need to wait until frame is re-rendered -- Eg focusing after other rendering changes - cmds <- use deferredCommands - deferredCommands .= mempty - pure cmds + ds <- use deferredDisposables + deferredDisposables .= mempty + pure . D.singleton . DisposeCommand . CD.DisposeList $ D.toList ds DestroyItemAction k -> do -- queue up callbacks to be released after rerendering ret <- runMaybeT $ do itemSuperModel <- MaybeT $ use (itemsModel . at k) - let junk = CD.disposing itemSuperModel - deferredCommands %= (`D.snoc` DisposeCommand junk) + deferredDisposables %= (`D.snoc` CD.disposing itemSuperModel) -- Remove the todo from the model itemsModel %= M.delete k -- on re-render the todo Shim will not get rendered and will be removed by react @@ -202,9 +201,9 @@ itemsModel %= M.insert n v D.singleton <$> (R.basicRenderCmd frameNum componentRef RenderCommand) - ItemAction key _ -> fmap (ItemCommand key) <$> + ItemAction k _ -> fmap (ItemCommand k) <$> (magnify (_ItemAction . to snd) - (zoom (itemsModel . at key . _Just) itemGadget)) + (zoom (itemsModel . at k . _Just) itemGadget)) SetFilterAction ftr -> do itemsFilter .= ftr diff --git a/src/Glazier/React/Widgets/List/Run.hs b/src/Glazier/React/Widgets/List/Run.hs --- a/src/Glazier/React/Widgets/List/Run.hs +++ b/src/Glazier/React/Widgets/List/Run.hs @@ -8,6 +8,7 @@ ( run ) where +import Control.Concurrent.MVar import Control.Concurrent.STM import qualified Control.Disposable as CD import Control.Monad @@ -20,18 +21,19 @@ import qualified Pipes.Concurrent as PC run - :: (key -> R.CommandOf itemWidget -> IO ()) -- command runner for the items + :: (k -> R.CommandOf itemWidget -> IO ()) -- command runner for the items + -> MVar Int -> R.ReactComponent -- for Maker - -> PC.Output (Action key itemWidget) - -> Command key itemWidget + -> PC.Output (Action k itemWidget) + -> Command k itemWidget -> IO () -run _ _ _ (RenderCommand sm props j) = R.componentSetState sm props j +run _ _ _ _ (RenderCommand sm props j) = R.componentSetState sm props j -run _ _ _ (DisposeCommand x) = CD.dispose x +run _ _ _ _ (DisposeCommand x) = CD.dispose x -run _ comp output (MakerCommand mks) = do - act <- iterM (R.Maker.run comp output) mks +run _ muid comp output (MakerCommand mks) = do + act <- iterM (R.Maker.run muid comp output) mks void $ atomically $ PC.send output act -run itemCmdRun _ _ (ItemCommand key itemCmd) = itemCmdRun key itemCmd +run itemCmdRun _ _ _ (ItemCommand k itemCmd) = itemCmdRun k itemCmd