glazier-react-widget 0.4.0.0 → 0.5.0.0

raw patch · 4 files changed

+174/−139 lines, 4 filesdep ~disposabledep ~glazier-reactPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: disposable, glazier-react

API changes (from Hackage documentation)

Files

• README.md +69/−49
• glazier-react-widget.cabal +4/−3
• src/Glazier/React/Widgets/Input.hs +31/−29
• src/Glazier/React/Widgets/List.hs +70/−58

@@ -22,18 +22,14 @@     ( Command(..)     , Action(..)     , AsAction(..)+    , Design(..)+    , HasDesign(..)     , Plan(..)     , HasPlan(..)-    , mkPlan-    , Model(..)-    , HasModel(..)-    , Design-    , Frame-    , SuperModel+    , Outline+    , Model     , Widget     , widget-    , window-    , gadget     ) where ``` This provides a consistent way to interact and use every widget.@@ -99,20 +95,60 @@  This action is generated by the [`componentDidUpdate`](https://facebook.github.io/react/docs/react-component.html#componentdidupdate) event listener. This event is usually used to generate the `DisposeCommand` to dispose callbacks from removed widgets. -## Model-This contains the pure data for state processing logic and rendering (the nouns).+## Design+This contains the template for pure data for state processing logic (the nouns). ```haskell-data Model = Model-    { _key :: J.JSString-    , _componentRef :: J.JSVal-    , _frameNum :: Int-    , _deferredCommands :: D.DList (Command key itemWidget)+data Design = Design+    { _blah :: Foo     }-makeClassy ''Model+makeClassy ''Design+type Model = Design+type Outline = Design+instance R.ToOutline Model Outline where outline = id++mkModel :: Outline -> F (R.Maker Action) Model+mkModel = pure ```-`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).+`Design`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+If the `Design` contains child widgets, then it should have use a type parameter and `DesignType` to allow specializations of `Model` and `Outline`+```haskell+data Design t = Design+    { _input :: R.DesignType t W.Input.Widget+    , _todos :: R.DesignType t (W.List.Widget TodosKey TD.Todo.Widget)+    , _footer :: R.DesignType t TD.Footer.Widget+    }++type Model = Design R.WithGizmo+type Outline = Design R.WithOutline+instance R.ToOutline Model Outline where+    outline (Design a b c) = Design (R.outline a) (R.outline b) (R.outline c)++mkModel :: R.ReactMlT Identity () -> Outline -> F (R.Maker Action) Model+mkModel separator (Design a b c) = Design+    <$> (R.hoistWithAction InputAction (R.mkGizmo' W.Input.widget a))+    <*> (R.hoistWithAction TodosAction (R.mkGizmo' (W.List.widget separator TD.Todo.widget) b))+    <*> (R.hoistWithAction FooterAction (R.mkGizmo' TD.Footer.widget c))+```++## 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).++```haskell+data Plan = Plan+    { _component :: R.ReactComponent+    , _key :: J.JSString+    , _frameNum :: Int+    , _componentRef :: J.JSVal+    , _deferredDisposables :: D.DList CD.SomeDisposable+    , _onRender :: J.Callback (J.JSVal -> IO J.JSVal)+    , _onComponentRef :: J.Callback (J.JSVal -> IO ())+    , _onComponentDidUpdate :: J.Callback (J.JSVal -> IO ())   makeClassy ''Plan+```+`Plan`s should have [`makeClassy`](https://hackage.haskell.org/package/lens-4.15.1/docs/Control-Lens-TH.html#v:makeClassy) generated to allow consistent usage of lens to access `Model` and `Plan` fields.++Some common `Plan` fields are+ ### key ```haskell _key :: JSString@@ -137,20 +173,6 @@ ``` `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).--```haskell-data Plan = Plan-    { _component :: R.ReactComponent-    , _onRender :: J.Callback (J.JSVal -> IO J.JSVal)-    , _onComponentRef :: J.Callback (J.JSVal -> IO ())-    , _onComponentDidUpdate :: J.Callback (J.JSVal -> IO ())   makeClassy ''Plan-```-`Plan`s should have [`makeClassy`](https://hackage.haskell.org/package/lens-4.15.1/docs/Control-Lens-TH.html#v:makeClassy) generated to allow consistent usage of lens to access `Model` and `Plan` fields.--Some common `Plan` fields are- ### _component ```haskell _component :: ReactComponent@@ -183,7 +205,11 @@ ```haskell mkPlan :: Frame Model Plan -> F (Maker Action) Plan mkPlan frm = Plan-    <$> getComponent+    <$> R.getComponent+    <*> R.mkKey+    <*> pure 0+    <*> pure J.nullRef+    <*> pure mempty     <*> (mkRenderer frm $ const render)     <*> (mkHandler $ pure . pure . InputRefAction)     <*> (mkHandler $ pure . pure . ComponentRefAction)@@ -204,29 +230,23 @@ Link `Glazier.React.Model`'s genericHasPlan/HasModel with this widget's specific `HasPlan`/`HasModel` from generated from `makeClassy`  ```haskell-instance HasPlan (R.Design Model Plan) where+instance HasPlan (R.Scene Model Plan) where     plan = R.plan-instance HasModel (R.Design Model Plan) where-    model = R.model-instance HasPlan (R.SuperModel Model Plan) where-    plan = R.design . plan-instance HasModel (R.SuperModel Model Plan) where-    model = R.design . model-```--### Synonums to Design, Frame, and SuperModel-```haskell-type Design = R.Design Model Plan-type Frame = R.Frame Model Plan-type SuperModel = R.SuperModel Model Plan+instance HasDesign (R.Scene Model Plan) where+    design = R.model+instance HasPlan (R.Gizmo Model Plan) where+    plan = R.scene . plan+instance HasDesign (R.Gizmo Model Plan) where+    design = R.scene . design ```  ### Widget definitions `widget` is a record of functions of the essential functions required to make, render and interact with the widget. By convention, `mkPlan`, `window`, and `gadget` is exported, but sometimes it's convenient to have all three grouped together in a record. ```haskell type Widget = Widget Command Action Model Plan-widget :: Widget Command Action Model Plan-widget = Widget+widget :: Widget+widget = R.Widget+    mkModel     mkPlan     window     gadget

@@ -1,5 +1,5 @@ name:                glazier-react-widget-version:             0.4.0.0+version:             0.5.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,11 +21,11 @@                        Glazier.React.Widgets.List.Run   build-depends:       base >= 4.7 && < 5                      , containers >= 0.5 && < 0.6-                     , disposable >= 0.2.0.3 && < 1+                     , disposable >= 0.2.0.4 && < 1                      , dlist >= 0.8 && < 0.9                      , free >= 4.12 && < 5                      , glazier >= 0.10 && < 1-                     , glazier-react >= 0.4 && < 1+                     , glazier-react >= 0.5 && < 1                      , javascript-extras >= 0.2.0.2 && < 1                      , lens >= 4 && < 5                      , mmorph >= 1 && < 2@@ -34,6 +34,7 @@                      , stm >= 2.4 && < 3                      , transformers >= 0.4 && < 0.6   default-language:    Haskell2010+  default-extensions:  ApplicativeDo   ghc-options:         -Wall   if impl(ghcjs)     build-depends: ghcjs-base

@@ -12,18 +12,14 @@     ( Command(..)     , Action(..)     , AsAction(..)+    , Schema(..)+    , HasSchema(..)     , Plan(..)     , HasPlan(..)-    , mkPlan-    , Model(..)-    , HasModel(..)-    , Design-    , Frame-    , SuperModel+    , Outline+    , Model     , Widget     , widget-    , window-    , gadget     , whenKeyDown     ) where @@ -55,15 +51,22 @@     | SubmitAction J.JSString     | InputRefAction J.JSVal -data Model = Model-    { _key :: J.JSString-    , _inputRef :: J.JSVal-    , _placeholder :: J.JSString+data Schema = Schema+    { _placeholder :: J.JSString     , _className :: J.JSString     } +type Model = Schema+type Outline = Schema+instance R.ToOutline Model Outline where outline = id++mkModel :: Outline -> F (R.Maker Action) Model+mkModel = pure+ data Plan = Plan     { _component :: R.ReactComponent+    , _key :: J.JSString+    , _inputRef :: J.JSVal     , _onRender :: J.Callback (J.JSVal -> IO J.JSVal)     , _onInputRef :: J.Callback (J.JSVal -> IO ())     , _onKeyDown :: J.Callback (J.JSVal -> IO ())@@ -71,11 +74,13 @@  makeClassyPrisms ''Action makeClassy ''Plan-makeClassy ''Model+makeClassy ''Schema  mkPlan :: R.Frame Model Plan -> F (R.Maker Action) Plan mkPlan frm = Plan     <$> R.getComponent+    <*> R.mkKey+    <*> pure J.nullRef     <*> (R.mkRenderer frm $ const render)     <*> (R.mkHandler $ pure . pure . InputRefAction)     <*> (R.mkHandler onKeyDown')@@ -85,28 +90,25 @@     disposing _ = CD.DisposeNone  -- Link Glazier.React.Model's HasPlan/HasModel with this widget's HasPlan/HasModel from makeClassy-instance HasPlan (R.Design Model Plan) where+instance HasPlan (R.Scene Model Plan) where     plan = R.plan-instance HasModel (R.Design Model Plan) where-    model = R.model-instance HasPlan (R.SuperModel Model Plan) where-    plan = R.design . plan-instance HasModel (R.SuperModel Model Plan) where-    model = R.design . model--type Design = R.Design Model Plan-type Frame = R.Frame Model Plan-type SuperModel = R.SuperModel Model Plan+instance HasSchema (R.Scene Model Plan) where+    schema = R.model+instance HasPlan (R.Gizmo Model Plan) where+    plan = R.scene . plan+instance HasSchema (R.Gizmo Model Plan) where+    schema = R.scene . schema -type Widget = R.Widget Command Action Model Plan-widget :: R.Widget Command Action Model Plan+type Widget = R.Widget Command Action Outline Model Plan+widget :: Widget widget = R.Widget+    mkModel     mkPlan     window     gadget  -- | Exposed to parent components to render this component-window :: G.WindowT (R.Design Model Plan) (R.ReactMlT Identity) ()+window :: G.WindowT (R.Scene Model Plan) (R.ReactMlT Identity) () window = do     s <- ask     lift $ R.lf (s ^. component . to JE.toJS)@@ -115,7 +117,7 @@         ]  -- | Internal rendering used by the React render callback-render :: G.WindowT (R.Design Model Plan) (R.ReactMlT Identity) ()+render :: G.WindowT (R.Scene Model Plan) (R.ReactMlT Identity) () render = do     s <- ask     lift $ R.lf (JE.strJS "input")@@ -155,7 +157,7 @@ -- The best practice is to leave this in general Monad m (eg, not MonadIO). -- This allows gadget to use STM as the base monad which allows for combining concurrently -- with other stateful STM effects and still maintain a single source of truth.-gadget :: G.GadgetT Action (R.SuperModel Model Plan) Identity (D.DList Command)+gadget :: G.GadgetT Action (R.Gizmo Model Plan) Identity (D.DList Command) gadget = do     a <- ask     case a of

@@ -9,23 +9,20 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DuplicateRecordFields #-}  module Glazier.React.Widgets.List     ( Command(..)     , Action(..)     , AsAction(..)+    , Schema(..)+    , HasSchema(..)     , Plan(..)     , HasPlan(..)-    , mkPlan-    , Model(..)-    , HasModel(..)-    , Design-    , Frame-    , SuperModel+    , Outline+    , Model     , Widget     , widget-    , window-    , gadget     ) where  import qualified Control.Disposable as CD@@ -52,7 +49,7 @@ import qualified JavaScript.Extras as JE  data Command k itemWidget-    = RenderCommand (R.SuperModel (Model k itemWidget) Plan) [JE.Property] J.JSVal+    = RenderCommand (R.Gizmo (Model k itemWidget) Plan) [JE.Property] J.JSVal     | DisposeCommand CD.SomeDisposable     | MakerCommand (F (R.Maker (Action k itemWidget)) (Action k itemWidget))     | ItemCommand k (R.CommandOf itemWidget)@@ -63,75 +60,90 @@     | ComponentDidUpdateAction     | DestroyItemAction k     | MakeItemAction (k -> k) (k -> F (R.Maker (R.ActionOf itemWidget)) (R.ModelOf itemWidget))-    | AddItemAction k (R.SuperModelOf itemWidget)+    | AddItemAction k (R.GizmoOf itemWidget)     | ItemAction k (R.ActionOf itemWidget)-    | SetFilterAction (R.SuperModelOf itemWidget -> Bool)+    | SetFilterAction (R.OutlineOf itemWidget -> Bool) -data Model k itemWidget = Model-    { _key :: J.JSString-    , _componentRef :: J.JSVal-    , _frameNum :: Int-    , _deferredDisposables :: D.DList CD.SomeDisposable-    , _className ::J.JSString-    , _itemKey :: k-    , _itemsModel :: M.Map k (R.SuperModelOf itemWidget)-    , _itemsFilter :: R.SuperModelOf itemWidget -> Bool+data Schema k itemWidget t = Schema+    { _className :: J.JSString+    , _idx :: k+    , _items :: M.Map k (R.SchemaType t itemWidget)+    , _itemsFilter :: R.OutlineOf itemWidget -> Bool     } +type Model k itemWidget = Schema k itemWidget R.WithGizmo+type Outline k itemWidget = Schema k itemWidget R.WithOutline+instance R.IsWidget itemWidget => R.ToOutline (Model k itemWidget) (Outline k itemWidget) where+    outline (Schema a b c d) = Schema a b (R.outline <$> c) d++mkModel :: R.IsWidget itemWidget => itemWidget -> Outline k itemWidget -> F (R.Maker (Action k itemWidget)) (Model k itemWidget)+mkModel w (Schema a b c d) = Schema+    <$> pure a+    <*> pure b+    <*> M.traverseWithKey (\k i -> R.hoistWithAction (ItemAction k) (R.mkGizmo' w i)) c+    <*> pure d+ data Plan = Plan     { _component :: R.ReactComponent+    , _key :: J.JSString+    , _frameNum :: Int+    , _componentRef :: J.JSVal+    , _deferredDisposables :: D.DList CD.SomeDisposable     , _onRender ::  J.Callback (J.JSVal -> IO J.JSVal)     , _onComponentRef :: J.Callback (J.JSVal -> IO ())     , _onComponentDidUpdate :: J.Callback (J.JSVal -> IO ())     } deriving (G.Generic)  makeClassyPrisms ''Action+makeClassy ''Schema makeClassy ''Plan-makeClassy ''Model  mkPlan-    :: R.ReactMlT Identity ()-    -> G.WindowT (R.DesignOf itemWidget) (R.ReactMlT Identity) ()+    :: R.IsWidget itemWidget => R.ReactMlT Identity ()+    -> G.WindowT (R.SceneOf itemWidget) (R.ReactMlT Identity) ()     -> R.Frame (Model k itemWidget) Plan     -> F (R.Maker (Action k itemWidget)) Plan mkPlan separator itemWindow frm = Plan     <$> R.getComponent+    <*> R.mkKey+    <*> pure 0+    <*> pure J.nullRef+    <*> pure mempty     <*> (R.mkRenderer frm $ const (render separator itemWindow))     <*> (R.mkHandler $ pure . pure . ComponentRefAction)     <*> (R.mkHandler $ pure . pure . const ComponentDidUpdateAction)  instance CD.Disposing Plan-instance (CD.Disposing (R.SuperModelOf itemWidget)) =>+-- | Undecidable instances because itemWidget appears more often in the constraint+-- but this is safe because @R.GizmoOf itemWidget@ is smaller than @Model k itemWidget@+instance (CD.Disposing (R.GizmoOf itemWidget)) =>          CD.Disposing (Model k itemWidget) where-    disposing s = CD.DisposeList $ foldr ((:) . CD.disposing) [] (_itemsModel s)+    disposing s = CD.DisposeList $ foldr ((:) . CD.disposing) [] (s ^. items)  -- Link Glazier.React.Model's HasPlan/HasModel with this widget's HasPlan/HasModel from makeClassy-instance HasPlan (R.Design (Model k itemWidget) Plan) where+instance HasPlan (R.Scene (Model k itemWidget) Plan) where     plan = R.plan-instance HasModel (R.Design (Model k itemWidget) Plan) k itemWidget where-    model = R.model-instance HasPlan (R.SuperModel (Model k itemWidget) Plan) where-    plan = R.design . plan-instance HasModel (R.SuperModel (Model k itemWidget) Plan) k itemWidget where-    model = R.design . model--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+instance HasSchema (R.Scene (Model k itemWidget) Plan) k itemWidget R.WithGizmo where+    schema = R.model+instance HasPlan (R.Gizmo (Model k itemWidget) Plan) where+    plan = R.scene . plan+instance HasSchema (R.Gizmo (Model k itemWidget) Plan) k itemWidget R.WithGizmo where+    schema = R.scene . schema -type Widget k itemWidget = R.Widget (Command k itemWidget) (Action k itemWidget) (Model k itemWidget) Plan+type Widget k itemWidget = R.Widget (Command k itemWidget) (Action k itemWidget) (Outline k itemWidget) (Model k itemWidget) Plan widget     :: (R.IsWidget itemWidget, Ord k)     => R.ReactMlT Identity ()     -> itemWidget-    -> R.Widget (Command k itemWidget) (Action k itemWidget) (Model k itemWidget) Plan+    -> Widget k itemWidget widget separator itemWidget = R.Widget+    (mkModel itemWidget)     (mkPlan separator (R.window itemWidget))     window-    (gadget (R.mkSuperModel itemWidget) (R.gadget itemWidget))+    (gadget (R.mkGizmo itemWidget) (R.gadget itemWidget))  -- | Exposed to parent components to render this component-window :: G.WindowT (R.Design (Model k itemWidget) Plan) (R.ReactMlT Identity) ()+window :: G.WindowT (R.Scene (Model k itemWidget) Plan) (R.ReactMlT Identity) () window = do     s <- ask     lift $ R.lf (s ^. component . to JE.toJS)@@ -143,25 +155,25 @@  -- | Internal rendering used by the React render callback render-    :: R.ReactMlT Identity ()-    -> G.WindowT (R.DesignOf itemWidget) (R.ReactMlT Identity) ()-    -> G.WindowT (R.Design (Model k itemWidget) Plan) (R.ReactMlT Identity) ()+    :: R.IsWidget itemWidget => R.ReactMlT Identity ()+    -> G.WindowT (R.SceneOf itemWidget) (R.ReactMlT Identity) ()+    -> G.WindowT (R.Scene (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+    xs <- fmap (view R.scene) . filter ((s ^. itemsFilter) . R.outline . view R.model) . fmap snd .  M.toList <$> view items     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+        let itemsWindows = (view G._WindowT itemWindow) <$> xs             separatedWindows = DL.intersperse separator itemsWindows         sequenceA_ separatedWindows  gadget     :: (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 k itemWidget) (R.SuperModel (Model k itemWidget) Plan) Identity (D.DList (Command k itemWidget))-gadget mkItemSuperModel itemGadget = do+    => (R.ModelOf itemWidget -> F (R.Maker (R.ActionOf itemWidget)) (R.GizmoOf itemWidget))+    -> G.GadgetT (R.ActionOf itemWidget) (R.GizmoOf itemWidget) Identity (D.DList (R.CommandOf itemWidget))+    -> G.GadgetT (Action k itemWidget) (R.Gizmo (Model k itemWidget) Plan) Identity (D.DList (Command k itemWidget))+gadget mkItemGizmo itemGadget = do     a <- ask     case a of         ComponentRefAction node -> do@@ -181,29 +193,29 @@         DestroyItemAction k -> do             -- queue up callbacks to be released after rerendering             ret <- runMaybeT $ do-                itemSuperModel <- MaybeT $ use (itemsModel . at k)-                deferredDisposables %= (`D.snoc` CD.disposing itemSuperModel)+                itemGizmo <- MaybeT $ use (items . at k)+                deferredDisposables %= (`D.snoc` CD.disposing itemGizmo)                 -- Remove the todo from the model-                itemsModel %= M.delete k+                items %= M.delete k                 -- on re-render the todo Shim will not get rendered and will be removed by react                 D.singleton <$> (R.basicRenderCmd frameNum componentRef RenderCommand)             maybe (pure mempty) pure ret          MakeItemAction keyMaker itemModelMaker -> do-            n <- keyMaker <$> use itemKey-            itemKey .= n+            n <- keyMaker <$> use idx+            idx .= n             pure $ D.singleton $ MakerCommand $ do-                sm <- hoistF (R.mapAction $ \act -> ItemAction n act) (-                    itemModelMaker n >>= mkItemSuperModel)+                sm <- R.hoistWithAction (ItemAction n) (+                    itemModelMaker n >>= mkItemGizmo)                 pure $ AddItemAction n sm          AddItemAction n v -> do-            itemsModel %= M.insert n v+            items %= M.insert n v             D.singleton <$> (R.basicRenderCmd frameNum componentRef RenderCommand)          ItemAction k _ -> fmap (ItemCommand k) <$>             (magnify (_ItemAction . to snd)-            (zoom (itemsModel . at k . _Just) itemGadget))+            (zoom (items . at k . _Just) itemGadget))          SetFilterAction ftr -> do             itemsFilter .= ftr