glazier-react-widget 0.6.0.0 → 1.0.0.0

raw patch · 15 files changed

+635/−464 lines, 15 filesdep +Diffdep +data-diversedep +data-diverse-lensdep −disposabledep −freedep −mmorphdep ~containersdep ~dlistdep ~ghcjs-base-stubPVP ok

version bump matches the API change (PVP)

Dependencies added: Diff, data-diverse, data-diverse-lens, deepseq, lens-misc, monadlist, tagged

Dependencies removed: disposable, free, mmorph, pipes-concurrency, stm

Dependency ranges changed: containers, dlist, ghcjs-base-stub, glazier, glazier-react, javascript-extras, lens, mtl, transformers

API changes (from Hackage documentation)

Files

• README.md +29/−29
• glazier-react-widget.cabal +30/−21
• src/Glazier/React/Action.hs +6/−0
• src/Glazier/React/Action/KeyDownKey.hs +26/−0
• src/Glazier/React/Effect.hs +11/−0
• src/Glazier/React/Effect/HTMLElement.hs +14/−0
• src/Glazier/React/Effect/HTMLElement/Exec.hs +39/−0
• src/Glazier/React/Effect/JavaScript.hs +45/−0
• src/Glazier/React/Effect/JavaScript/Exec.hs +16/−0
• src/Glazier/React/Widgets/Collection.hs +146/−0
• src/Glazier/React/Widgets/Collection/Dynamic.hs +99/−0
• src/Glazier/React/Widgets/Input.hs +174/−143
• src/Glazier/React/Widgets/Input/Run.hs +0/−10
• src/Glazier/React/Widgets/List.hs +0/−222
• src/Glazier/React/Widgets/List/Run.hs +0/−39

@@ -62,7 +62,7 @@ ```haskell MakerCommand (F (Maker Action) Action) ```-This is the command to run the `Maker` instruction in the `Maker` interpreter which results in an `Action` to dispatch back tot he gadget.+This is the command to run the `Maker` instruction in the `Maker` interpreter which results in an `Action` to outcome back tot he gadget.  ## Action This contains the events that the widget `Gadget` processes.@@ -104,9 +104,9 @@ makeClassy ''Design type Model = Design type Outline = Design-instance R.ToOutline Model Outline where outline = id+instance ToOutline Model Outline where outline = id -mkModel :: Outline -> F (R.Maker Action) Model+mkModel :: Outline -> F (Maker Action) Model mkModel = pure ``` `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).@@ -114,21 +114,21 @@ 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+    { _input :: DesignType t W.Input.Widget+    , _todos :: DesignType t (W.List.Widget TodosKey TD.Todo.Widget)+    , _footer :: 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)+type Model = Design WithGizmo+type Outline = Design WithOutline+instance ToOutline Model Outline where+    outline (Design a b c) = Design (outline a) (outline b) (outline c) -mkModel :: R.ReactMlT Identity () -> Outline -> F (R.Maker Action) Model+mkModel :: ReactMl () -> Outline -> F (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))+    <$> (hoistWithAction InputAction (mkGizmo' W.Input.widget a))+    <*> (hoistWithAction TodosAction (mkGizmo' (W.List.widget separator TD.Todo.widget) b))+    <*> (hoistWithAction FooterAction (mkGizmo' TD.Footer.widget c)) ```  ## Plan@@ -136,7 +136,7 @@  ```haskell data Plan = Plan-    { _component :: R.ReactComponent+    { _component :: ReactComponent     , _key :: J.JSString     , _frameNum :: Int     , _componentRef :: J.JSVal@@ -205,8 +205,8 @@ ```haskell mkPlan :: Frame Model Plan -> F (Maker Action) Plan mkPlan frm = Plan-    <$> R.getComponent-    <*> R.mkKey+    <$> getComponent+    <*> mkKey     <*> pure 0     <*> pure J.nullRef     <*> pure mempty@@ -230,14 +230,14 @@ Link `Glazier.React.Model`'s genericHasPlan/HasModel with this widget's specific `HasPlan`/`HasModel` from generated from `makeClassy`  ```haskell-instance HasPlan (R.Scene Model Plan) where-    plan = R.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+instance HasPlan (Scene Model Plan) where+    plan = plan+instance HasDesign (Scene Model Plan) where+    design = model+instance HasPlan (Gizmo Model Plan) where+    plan = scene . plan+instance HasDesign (Gizmo Model Plan) where+    design = scene . design ```  ### Widget definitions@@ -245,7 +245,7 @@ ```haskell type Widget = Widget Command Action Model Plan widget :: Widget-widget = R.Widget+widget = Widget     mkModel     mkPlan     window@@ -259,7 +259,7 @@ This is the starting rendering function to start the rendering. It always only renders the shim React component with the specific callbacks:  ```haskell-window :: WindowT (Design Model Plan) (ReactMlT Identity) ()+window :: WindowT (Design Model Plan) ReactMl () window = do     s <- ask     lift $ lf (s ^. component . to toJS)@@ -276,14 +276,14 @@  This contains the widget specific rendering instructions. ```haskell-render :: WindowT (Design Model Plan) (ReactMlT Identity) ()+render :: WindowT (Design Model Plan) ReactMl () ``` This a a monad transformer stack over `Identity`. This ensures only pure effects are allowed.  ## gadget This contains the state update logic: ```haskell-gadget :: G.GadgetT Action (R.SuperModel Model Plan) Identity (DList Command)+gadget :: G.Gadget () Action (SuperModel Model Plan) (DList Command) ``` This a a monad transformer stack over `Identity`. This ensures only pure effects are allowed. 

@@ -1,7 +1,7 @@ name:                glazier-react-widget-version:             0.6.0.0+version:             1.0.0.0 synopsis:            Generic widget library using glazier-react-description:         Generic widget library using glazier-react+description:         Generic widget library using glazier-react. Please see README.md. homepage:            https://github.com/louispan/glazier-react-widget#readme license:             BSD3 license-file:        LICENSE@@ -15,31 +15,40 @@  library   hs-source-dirs:      src-  exposed-modules:     Glazier.React.Widgets.Input-                       Glazier.React.Widgets.Input.Run-                       Glazier.React.Widgets.List-                       Glazier.React.Widgets.List.Run+  exposed-modules:+                       Glazier.React.Action+                       Glazier.React.Action.KeyDownKey+                       Glazier.React.Effect+                       Glazier.React.Effect.HTMLElement+                       Glazier.React.Effect.HTMLElement.Exec+                       Glazier.React.Effect.JavaScript+                       Glazier.React.Effect.JavaScript.Exec+                       Glazier.React.Widgets.Input+                       Glazier.React.Widgets.Collection+                       Glazier.React.Widgets.Collection.Dynamic   build-depends:       base >= 4.7 && < 5-                     , containers >= 0.5 && < 0.6-                     , disposable >= 0.2.0.4 && < 1-                     , dlist >= 0.8 && < 0.9-                     , free >= 4.12 && < 5-                     , glazier >= 0.10 && < 1-                     , glazier-react >= 0.6 && < 1-                     , javascript-extras >= 0.3.0.0 && < 1-                     , lens >= 4 && < 5-                     , mmorph >= 1 && < 2-                     , mtl >= 2 && < 3-                     , pipes-concurrency >= 2 && < 3-                     , stm >= 2.4 && < 3-                     , transformers >= 0.4 && < 0.6+                     , containers >= 0.5+                     , data-diverse >= 4.6+                     , data-diverse-lens >= 4.3+                     , deepseq >= 1.4+                     , Diff >= 0.3.4+                     , dlist >= 0.8+                     , glazier >= 1.0+                     , glazier-react >= 1.0+                     , javascript-extras >= 0.5+                     , lens >= 4+                     , lens-misc >= 0+                     , monadlist >= 0+                     , mtl >= 2+                     , tagged >= 0.8+                     , transformers >= 0.4   default-language:    Haskell2010   default-extensions:  ApplicativeDo-  ghc-options:         -Wall+  ghc-options:         -Wall -Wredundant-constraints   if impl(ghcjs)     build-depends: ghcjs-base   if !impl(ghcjs)-    build-depends: ghcjs-base-stub >= 0.1.0.2 && < 1+    build-depends: ghcjs-base-stub >= 0.2  source-repository head   type:     git

@@ -0,0 +1,6 @@+-- | Actions are things usually used in Triggers+module Glazier.React.Action+    ( module Glazier.React.Action.KeyDownKey+    ) where++import Glazier.React.Action.KeyDownKey

@@ -0,0 +1,26 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DisambiguateRecordFields #-}+{-# LANGUAGE DuplicateRecordFields #-}++module Glazier.React.Action.KeyDownKey where++import Control.DeepSeq+import Control.Monad.Trans+import Control.Monad.Trans.Maybe+import qualified GHC.Generics as G+import qualified GHCJS.Types as J+import Glazier.React+import Glazier.React.Event.Keyboard+import Glazier.React.Event.Synthetic++data KeyDownKey = KeyDownKey EventTarget J.JSString+    deriving (G.Generic, NFData)++fireKeyDownKey :: Notice -> MaybeT IO KeyDownKey+fireKeyDownKey ntc = do+    kevt <- MaybeT $ pure $ toKeyboardEvent ntc+    let evt = toSyntheticEvent ntc+        k = key kevt+    t <- lift $ pure $ target evt+    pure $ KeyDownKey t k

@@ -0,0 +1,11 @@+module Glazier.React.Effect+    ( module Glazier.React.Effect.HTMLElement+    , module Glazier.React.Effect.HTMLElement.Exec+    , module Glazier.React.Effect.JavaScript+    , module Glazier.React.Effect.JavaScript.Exec+    ) where++import Glazier.React.Effect.HTMLElement+import Glazier.React.Effect.HTMLElement.Exec+import Glazier.React.Effect.JavaScript+import Glazier.React.Effect.JavaScript.Exec

@@ -0,0 +1,14 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}++module Glazier.React.Effect.HTMLElement where++import Data.Diverse.Lens+import Glazier.React++type AsHTMLElement cmd = AsFacet HTMLElementCmd cmd++-- Effects from methods in https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement+data HTMLElementCmd = Focus EventTarget | Blur EventTarget+    deriving Show

@@ -0,0 +1,39 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Glazier.React.Effect.HTMLElement.Exec where++import Control.Monad.IO.Class+import Glazier.React+import Glazier.React.Effect.HTMLElement++execHTMLElementCmd ::+    ( MonadIO m+    )+    => HTMLElementCmd -> m ()+execHTMLElementCmd c = case c of+    Blur j -> liftIO $ js_blur j+    Focus j -> liftIO $ js_focus j++#ifdef __GHCJS__++foreign import javascript unsafe+  "if ($1 && $1['focus']) { $1['focus'](); }"+  js_focus :: EventTarget -> IO ()++foreign import javascript unsafe+  "if ($1 && $1['blur']) { $1['blur'](); }"+  js_blur :: EventTarget -> IO ()++#else++js_focus :: EventTarget -> IO ()+js_focus _ = pure ()++js_blur :: EventTarget -> IO ()+js_blur _ = pure ()++#endif

@@ -0,0 +1,45 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}++module Glazier.React.Effect.JavaScript where++import Control.Monad.Trans.Maybe+import Data.Diverse.Lens+import qualified GHCJS.Types as J+import Glazier.Command+import qualified JavaScript.Extras as JE++type AsJavascript cmd = AsFacet (JavaScriptCmd cmd) cmd++data JavaScriptCmd cmd where+    SetProperty :: JE.ToJS j+        => JE.Property -> j -> JavaScriptCmd c+    GetProperty :: JE.ToJS j+        => J.JSString+        -> j+        -> (JE.JSRep -> cmd)+        -> JavaScriptCmd cmd++instance Show (JavaScriptCmd cmd) where+    showsPrec d (SetProperty p j) = showParen (d >= 11) $+        showString "SetProperty "+        . showsPrec 11 p+        . showChar ' '+        . showsPrec 11 (JE.toJSR j)+        . showString "}"+    showsPrec d (GetProperty n j _) = showParen (d >= 11) $+        showString "GetProperty "+        . showsPrec 11 n+        . showChar ' '+        . showsPrec 11 (JE.toJSR j)+        . showString "}"++maybeGetProperty ::+    ( AsJavascript cmd+    , MonadCommand cmd m+    , JE.FromJS a+    , JE.ToJS j)+    => J.JSString -> j -> MaybeT m a+maybeGetProperty n j = MaybeT . fmap JE.fromJSR . eval' $ GetProperty n j

@@ -0,0 +1,16 @@+{-# LANGUAGE FlexibleContexts #-}++module Glazier.React.Effect.JavaScript.Exec where++import Control.Monad.IO.Class+import Glazier.React.Effect.JavaScript+import qualified JavaScript.Extras as JE++execJavascript ::+    MonadIO m+    => (c -> m ()) -> JavaScriptCmd c -> m ()+execJavascript executor c = case c of+    SetProperty prop j -> liftIO $ JE.setProperty prop j+    GetProperty n j k -> do+        r <- liftIO $ JE.getProperty n j+        executor $ k r

@@ -0,0 +1,146 @@+-- {-# LANGUAGE DataKinds #-}+-- {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+-- {-# LANGUAGE FlexibleInstances #-}+-- {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+-- {-# LANGUAGE RankNTypes #-}+-- {-# LANGUAGE RecordWildCards #-}+-- {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Glazier.React.Widgets.Collection+    ( HKD+    , UKey+    , zeroUKey+    , smallerUKey+    , largerUKey+    , betweenUKey+    -- * Collection+    , Collection+    , HKCollection+    , collectionWindow+    , deleteCollectionItem+    , insertCollectionItem+    ) where++import Control.Lens+import Data.Foldable+import qualified Data.Map.Strict as M+import qualified GHC.Generics as G+import Glazier.React+import qualified JavaScript.Extras as JE++-- "Higher-Kinded Data" http://reasonablypolymorphic.com/blog/higher-kinded-data/+-- Erases Identity+type family HKD f a where+    HKD Identity a = a+    HKD f        a = f a++-- | A key where you can always create+-- another key ordered between two different keys,+-- or another key above or below this key.+-- Memonic: U for uncountable https://en.wikipedia.org/wiki/Uncountable_set+newtype UKey = UKey { unUKey :: [Int] }+    deriving (G.Generic, Show)++-- | For comparison purposes, an empty list is equivalent to [0,0,..]+instance Ord UKey where+    compare (UKey []) (UKey []) = EQ+    compare (UKey xs) (UKey []) = compare (UKey xs) (UKey [0])+    compare (UKey []) (UKey ys) = compare (UKey [0]) (UKey ys)+    compare (UKey (x : xs)) (UKey (y : ys)) = case compare x y of+        EQ -> compare (UKey xs) (UKey ys)+        o -> o++-- | For comparison purposes, an empty list is equivalent to [0,0,..]+instance Eq UKey where+    (UKey []) == (UKey []) = True+    (UKey xs) == (UKey []) = (UKey xs) == (UKey [0])+    (UKey []) == (UKey ys) = (UKey [0]) == (UKey ys)+    (UKey (x : xs)) == (UKey (y : ys)) = if x == y+        then (UKey xs) == (UKey ys)+        else False++zeroUKey :: UKey+zeroUKey = UKey []++ukeyStep :: Int+ukeyStep = 32++-- | Create a key smaller than the input key.+smallerUKey :: UKey -> UKey+smallerUKey (UKey []) = UKey [-ukeyStep]+smallerUKey (UKey (a : as)) = UKey $ case compare a (JE.minSafeInteger + ukeyStep) of+        LT -> if JE.minSafeInteger == a+            then JE.minSafeInteger : unUKey (smallerUKey (UKey as))+            else [JE.minSafeInteger]+        _ -> [a - ukeyStep]++-- | Create a key larger than the input key.+largerUKey :: UKey -> UKey+largerUKey (UKey []) = UKey [ukeyStep]+largerUKey (UKey (a : as)) = UKey $ case compare a (JE.maxSafeInteger - ukeyStep) of+        GT -> if JE.maxSafeInteger == a+            then JE.maxSafeInteger : unUKey (largerUKey (UKey as))+            else [JE.maxSafeInteger]+        _ -> [a + ukeyStep]++-- | Make a key that will fit in between the two provided keys,+-- with no guarantees on how close it is to the mid point.+-- Except when the inputs are equal, then it will return the same key.+betweenUKey :: UKey -> UKey -> UKey+betweenUKey (UKey []) (UKey []) = zeroUKey+betweenUKey (UKey xs) (UKey []) = betweenUKey (UKey xs) (UKey [0])+betweenUKey (UKey []) (UKey ys) = betweenUKey (UKey [0]) (UKey ys)+betweenUKey (UKey (x : xs)) (UKey (y : ys)) = UKey $ case compare x y of+    LT -> if x + 1 == y+        then x : unUKey (betweenUKey (UKey xs) (UKey $ repeat JE.maxSafeInteger))+        else [betweenUncInt x y]+    GT -> if y + 1 == x+        then y : unUKey (betweenUKey (UKey ys) (UKey $ repeat JE.maxSafeInteger))+        else [betweenUncInt x y]+    EQ -> x : unUKey (betweenUKey (UKey xs) (UKey ys))++betweenUncInt :: Int -> Int -> Int+betweenUncInt x y =+    let (xq, xr) = quotRem x 2+        (yq, yr) = quotRem y 2+        z = case (xr + yr) of+            2 -> 1+            _ -> 0+    in xq + yq + z++-----------------------------------------------------------------++-- | Collection of higher kinded data+type Collection t s f = t (HKD f s)++-- | Collection of higher kinded "higher kinded data"+type HKCollection t s f = t (HKD f (s f))++-- | Collection doesn't have an initializing gadget since+-- the 'Subject's in the model are all initialized via 'addSubject'.+collectionWindow :: (Functor t, Foldable t)+    => ReactId -> Window (t (Subject s)) ()+collectionWindow ri = do+    ss <- view _model+    let displayItem s = Als $ (displaySubject s)+    bh "ul" [("key", JE.toJSR $ ri)] (getAls (fold $ displayItem <$> ss))++deleteCollectionItem :: (MonadReactor p allS cmd m, Ord k)+    => k -> ModelState (M.Map k (Subject s)) (m ())+deleteCollectionItem k = do+    old <- use (id.at k)+    (at k) .= Nothing+    pure $ maybe (pure ()) bookSubjectCleanup old++insertCollectionItem :: (MonadReactor p allS cmd m, Ord k)+    => k -> Subject s -> ModelState (M.Map k (Subject s)) (m ())+insertCollectionItem k sbj = do+    old <- use (at k)+    (at k) .= Just sbj+    pure $ maybe (pure ()) bookSubjectCleanup old

@@ -0,0 +1,99 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Glazier.React.Widgets.Collection.Dynamic+    ( DynamicCollection(..)+    , HKDynamicCollection+    , _filterCriteria+    , _sortCriteria+    , _visibleList+    , _rawCollection+    , dynamicCollectionWindow+    , updateVisibleList+    -- , setDynamicCollectionSortCriteria+    -- , setDynamicCollectionFilterCriteria+    , deleteDynamicCollectionItem+    , insertDynamicCollectionItem+    , module Glazier.React.Widgets.Collection+    ) where++import Control.Lens+import Control.Lens.Misc+import qualified Control.Monad.ListM as LM+import Control.Monad.Reader+import Data.Foldable+import qualified Data.Map.Strict as M+import qualified GHC.Generics as G+import Glazier.React+import Glazier.React.Widgets.Collection++-- | Contains information on sorting and filtering the items in a collection+-- differerently from the native data structure.+data DynamicCollection ftr srt k a f = DynamicCollection+    { filterCriteria :: ftr+    , sortCriteria :: srt+    , visibleList :: [HKD f a] -- filtered and sorted.+    , rawCollection :: M.Map k (HKD f a)+    } deriving (G.Generic)++type HKDynamicCollection ftr srt k a f = DynamicCollection ftr srt k (a f) f++makeLenses_ ''DynamicCollection++updateVisibleList ::+    (ftr -> s -> ReadIORef Bool)+    -> (srt -> s -> s -> ReadIORef Ordering)+    -> ModelState (DynamicCollection ftr srt k s Subject) ()+updateVisibleList ff fs = do+    zs@(DynamicCollection ftr srt _ xs) <- use id+    let xs' = toList xs+        ftr' x = do+            x' <- doReadIORef $ sceneRef x+            ff ftr (model x')+        srt' x y = do+            x' <- doReadIORef $ sceneRef x+            y' <- doReadIORef $ sceneRef y+            fs srt (model x') (model y')+    ys <- lift $ LM.filterMP ftr' xs' >>= LM.sortByM srt'+    id .= zs { visibleList = ys }++-- -- | Sort the items on the listing given a sorting function+-- setDynamicCollectionSortCriteria ::+--     (ftr -> s -> ReadIORef Bool)+--     -> (srt -> s -> s -> ReadIORef Ordering)+--     -> srt+--     -> SceneState (DynamicCollection ftr srt k s Subject) ()+-- setDynamicCollectionSortCriteria ff fs srt = do+--     _model._sortCriteria .= srt+--     regenerateVisibleList ff fs++-- -- | Filter the items on the listing given a filter function+-- setDynamicCollectionFilterCriteria ::+--     (ftr -> s -> ReadIORef Bool)+--     -> (srt -> s -> s -> ReadIORef Ordering)+--     -> ftr+--     -> SceneState (DynamicCollection ftr srt k s Subject) ()+-- setDynamicCollectionFilterCriteria ff fs ftr = do+--     _model._filterCriteria .= ftr+--     regenerateVisibleList ff fs++dynamicCollectionWindow :: ReactId -> Window (DynamicCollection ftr srt k s Subject) ()+dynamicCollectionWindow ri = magnifiedScene _visibleList $ collectionWindow ri++deleteDynamicCollectionItem :: (MonadReactor p allS cmd m, Ord k)+    => k+    -> ModelState (DynamicCollection ftr srt k s Subject) (m ())+deleteDynamicCollectionItem k =+    zoom _rawCollection (deleteCollectionItem k)+    -- lift $ regenerateVisibleList ff fs++insertDynamicCollectionItem :: (MonadReactor p allS cmd m, Ord k)+    => k+    -> Subject s+    -> ModelState (DynamicCollection ftr srt k s Subject) (m ())+insertDynamicCollectionItem k sbj =+    zoom _rawCollection (insertCollectionItem k sbj)+    -- regenerateVisibleList ff fs

@@ -1,170 +1,201 @@-{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeApplications #-}  module Glazier.React.Widgets.Input-    ( Command(..)-    , Action(..)-    , AsAction(..)-    , Schema(..)-    , HasSchema(..)-    , Plan(..)-    , HasPlan(..)-    , Outline-    , Model-    , Widget-    , widget-    , whenKeyDown+    ( -- * Text input+    textInput+    -- * Checkbox input+    , checkboxInput+    , IndeterminateCheckboxInput(..)+    , indeterminateCheckboxInput     ) where -import Control.Applicative-import qualified Control.Disposable as CD import Control.Lens-import Control.Monad.Free.Church-import Control.Monad.Reader-import Control.Monad.Trans.Maybe-import qualified Data.DList as D+import Control.Lens.Misc+import qualified Data.Algorithm.Diff as D import qualified Data.JSString as J+import Data.Tagged import qualified GHC.Generics as G-import qualified GHCJS.Foreign.Callback as J-import qualified GHCJS.Types as J-import qualified Glazier as G-import qualified Glazier.React.Component as R-import qualified Glazier.React.Event as R-import qualified Glazier.React.Maker as R-import qualified Glazier.React.Markup as R-import qualified Glazier.React.Model as R-import qualified Glazier.React.Widget as R+import Glazier.React+import Glazier.React.Effect.JavaScript+import Glazier.React.Event.Synthetic import qualified JavaScript.Extras as JE -data Command-    = SetPropertyCommand JE.Property J.JSVal--data Action-    = SetPropertyAction JE.Property J.JSVal-    | SubmitAction J.JSString-    | InputRefAction J.JSVal--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 ())-    } deriving (G.Generic)+---------------------------------------- -makeClassyPrisms ''Action-makeClassy ''Plan-makeClassy ''Schema+-- Tagged event. The convention is to fire "OnXXX" if the event is not handled+-- or fire "XXX" to notify handled events.+type InputChange = Tagged "InputChange" -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')+-- | Text inputs dosn't interact well as a React controlled component.+-- Eg. cursor jumps if user types quickly.+-- I think there a timing issue with lazy event handlers setting the value,+-- So this prototype uses the React uncontrolled component+-- (using defaultValue instead of value).+--+-- For input, React uses controlled input if input.value is not null.+--+-- This widget attempts to set the cursor position at the correct place+-- by using a diffing algorithm on the old and new value.+--+-- Warning: This widget listens to onChange and will update the model value with the DOM input value.+-- potentially overridding any user changes.+-- So when changing the model value, be sure that the onChange handler will not be called.+textInput ::+    ( AsReactor cmd+    , AsJavascript cmd+    )+    => ReactId -> Widget cmd p J.JSString (InputChange ())+textInput ri =+    let win = do+            s <- ask+            lf' ri "input"+                [ ("key", JE.toJSR ri)+                -- "value" cannot be used as React will take over as a controlled component.+                -- The defaultValue only sets the *initial* DOM value+                -- The user will need to modify reactKey if they want+                -- react to actually rerender, since React will not do anything+                -- even if defaultValue changes.+                -- But hopefully this is not necessary as the DOM inpt value+                -- is updated under the hood in onInitialized+                , ("defaultValue", JE.toJSR $ s ^. _model)+                ]+        gad = (finish hdlRendered)+            `also` hdlChange+    in (display win) `also` (lift gad)+  where -instance CD.Disposing Plan-instance CD.Disposing Model where-    disposing _ = CD.DisposeNone+    -- | Modify the DOM input value after every render to match the model value+    hdlRendered ::+        ( AsReactor cmd+        , AsJavascript cmd+        )+        => Gadget cmd p J.JSString ()+    hdlRendered = onRendered $ do+        s <- getModel+        j <- getElementalRef ri+        (`evalMaybeT` ()) $ do+            start <- maybeGetProperty "selectionStart" j+            end <- maybeGetProperty "selectionEnd" j+            v <- maybeGetProperty "value" j+            let (a, b) = estimateSelectionRange (J.unpack v) (J.unpack s) start end+            exec' $ SetProperty ("value", JE.toJSR s) j+            exec' $ SetProperty ("selectionStart", JE.toJSR a) j+            exec' $ SetProperty ("selectionEnd", JE.toJSR b) j --- Link Glazier.React.Model's HasPlan/HasModel with this widget's HasPlan/HasModel from makeClassy-instance HasPlan (R.Scene Model Plan) where-    plan = R.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+    hdlChange ::+        ( AsReactor cmd+        , AsJavascript cmd+        )+        => Gadget cmd p J.JSString (InputChange ())+    hdlChange = do+        j <- trigger ri "onChange" (pure . target . toSyntheticEvent)+        maybeDelegate () $ runMaybeT $ do+            v <- maybeGetProperty "value" j+            tickModel $ id .= v+            pure $ Tagged @"InputChange" () -type Widget = R.Widget Command Action Outline Model Plan-widget :: Widget-widget = R.Widget-    mkModel-    mkPlan-    window-    gadget+-- This returns an greedy selection range for a new string based+-- on the selection range on the original string, using a diffing algo.+--+-- https://developer.mozilla.org/en-US/docs/Web/API/HTMLInputElement/setSelectionRange+-- selectionStart+-- The 0-based index of the first selected character.+-- selectionEnd+-- The 0-based index of the character after the last selected character.+--+-- So if there is no selection then selectionEnd == selectionStart+estimateSelectionRange :: String -> String -> Int -> Int -> (Int, Int)+estimateSelectionRange before after start end =+    let ds = D.getDiff before after+    in go ds start end 0 0+  where+    go :: [D.Diff Char] -> Int -> Int -> Int -> Int -> (Int, Int)+    go [] _ _ a b = (a, b)+    go (d : ds) s e a b =+        if (s <= 0 && e <= -1)+            then (a, b)+            else+                let (s', a') = step d s a+                    (e', b') = greedyStep d e b+                in go ds s' e' a' b' --- | Exposed to parent components to render this component-window :: G.WindowT (R.Scene Model Plan) (R.ReactMlT Identity) ()-window = do-    s <- ask-    lift $ R.lf (s ^. component . to JE.toJS')-        [ ("key",  s ^. key . to JE.toJS')-        , ("render", s ^. onRender . to JE.toJS')-        ]+    step :: D.Diff Char -> Int -> Int -> (Int, Int)+    step (D.First _) s s' = (if s > 0 then s - 1 else 0, s')+    step (D.Second _) s s' = (s, if s > 0 then s' + 1 else s')+    step (D.Both _ _) s s' = if s > 0+        then (s - 1, s' + 1)+        else (0, s') --- | Internal rendering used by the React render callback-render :: G.WindowT (R.Scene Model Plan) (R.ReactMlT Identity) ()-render = do-    s <- ask-    lift $ R.lf "input"-        [ ("key", s ^. key . to JE.toJS')-        , ("className", s ^. className . to JE.toJS')-        , ("placeholder", s ^. placeholder . to JE.toJS')-        , ("autoFocus", JE.toJS' True)-        , ("onKeyDown", s ^. onKeyDown . to JE.toJS')-        ]+    greedyStep :: D.Diff Char -> Int -> Int -> (Int, Int)+    greedyStep (D.First _) s s' = (if s >= 0 then s - 1 else (-1), s')+    greedyStep (D.Second _) s s' = (s, if s >= 0 then s' + 1 else s')+    greedyStep (D.Both _ _) s s' = if s > 0+        then (s - 1, s' + 1)+        else (-1, s') -whenKeyDown :: J.JSVal -> MaybeT IO (Maybe J.JSString, J.JSVal)-whenKeyDown evt = do-        sevt <- MaybeT $ pure $ JE.fromJS evt-        kevt <- MaybeT $ pure $ R.parseKeyboardEvent sevt-        let evt' = R.parseEvent sevt-            k = R.keyCode kevt-        input <- lift $ pure . JE.toJS . R.target $ evt'-        case k of-            -- FIXME: ESCAPE_KEY-            27 -> pure (Nothing, input)-            -- FIXME: ENTER_KEY-            13 -> do-                v <- MaybeT $ JE.fromJS' <$> JE.getProperty "value" input-                pure (Just v, input)-            _ -> empty+---------------------------------------- -onKeyDown' :: J.JSVal -> MaybeT IO [Action]-onKeyDown' = R.eventHandlerM whenKeyDown goLazy+-- | This is a 'React controlled' checkbox.+-- For checkboxes,  React uses controlled checkbox if input.checked is not null+-- https://stackoverflow.com/questions/37427508/react-changing-an-uncontrolled-input+checkboxInput ::+    (AsReactor cmd)+    => ReactId -> Widget cmd p Bool (InputChange ())+checkboxInput ri =+    let win = do+            s <- ask+            lf' ri "input"+                [ ("key", JE.toJSR ri)+                , ("type", "checkbox")+                , ("checked", JE.toJSR $ s ^. _model)+                ]+        gad = hdlChange+    in (display win) `also` (lift gad)   where-    goLazy :: (Maybe J.JSString, J.JSVal) -> MaybeT IO [Action]-    goLazy (ms, j) = pure $-        SetPropertyAction ("value", JE.toJS' J.empty) j-        : maybe [] (pure . SubmitAction) ms+    hdlChange ::+        (AsReactor cmd)+        => Gadget cmd p Bool (InputChange ())+    hdlChange = do+        trigger_ ri "onChange" ()+        tickModel $ id %= not+        pure $ Tagged @"InputChange" () --- | State update logic.--- 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.Gizmo Model Plan) Identity (D.DList Command)-gadget = do-    a <- ask-    case a of-        SetPropertyAction props j -> pure $ D.singleton $ SetPropertyCommand props j+data IndeterminateCheckboxInput = IndeterminateCheckboxInput+    { checked :: Bool+    , indeterminate :: Bool+    } deriving (G.Generic, Show, Eq, Ord) -        -- parent widgets should detect this case to do something with submitted action-        SubmitAction _ -> pure empty+makeLenses_ ''IndeterminateCheckboxInput -        InputRefAction v -> do-            inputRef .= v-            pure mempty+-- | Variation of 'checkboxInput' supporting indeterminate state.+indeterminateCheckboxInput ::+    ( AsReactor cmd+    , AsJavascript cmd+    )+    => ReactId -> Widget cmd p IndeterminateCheckboxInput (InputChange ())+indeterminateCheckboxInput ri = magnifyWidget _checked (checkboxInput ri)+    `also` finish (lift hdlRendered)+  where+    hdlRendered ::+        ( AsReactor cmd+        , AsJavascript cmd+        )+        => Gadget cmd p IndeterminateCheckboxInput ()+    hdlRendered = onRendered $ do+        j <- getElementalRef ri+        s <- getModel+        (`evalMaybeT` ()) $ do+            i <- MaybeT $ pure $ preview _indeterminate s+            exec' $ SetProperty ("indeterminate", JE.toJSR i) j

@@ -1,10 +0,0 @@-module Glazier.React.Widgets.Input.Run-    ( run-    ) where--import qualified JavaScript.Extras as JE-import Glazier.React.Widgets.Input--run :: Command -> IO ()--run (SetPropertyCommand prop j) = JE.setProperty prop j

@@ -1,222 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE DuplicateRecordFields #-}--module Glazier.React.Widgets.List-    ( Command(..)-    , Action(..)-    , AsAction(..)-    , Schema(..)-    , HasSchema(..)-    , Plan(..)-    , HasPlan(..)-    , Outline-    , Model-    , Widget-    , widget-    ) where--import qualified Control.Disposable as CD-import Control.Lens-import Control.Monad.Free.Church-import Control.Monad.Morph-import Control.Monad.Reader-import Control.Monad.Trans.Maybe-import qualified Data.DList as D-import Data.Foldable-import qualified Data.JSString as J-import qualified Data.List as DL-import qualified Data.Map.Strict as M-import qualified GHC.Generics as G-import qualified GHCJS.Foreign.Callback as J-import qualified GHCJS.Types as J-import qualified Glazier as G-import qualified Glazier.React.Command as R-import qualified Glazier.React.Component as R-import qualified Glazier.React.Maker as R-import qualified Glazier.React.Markup as R-import qualified Glazier.React.Model as R-import qualified Glazier.React.Widget as R-import qualified JavaScript.Extras as JE--data Command k itemWidget-    = 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)--data Action k itemWidget-    = ComponentRefAction J.JSVal-    | RenderAction-    | ComponentDidUpdateAction-    | DestroyItemAction k-    | MakeItemAction (k -> k) (k -> F (R.Maker (R.ActionOf itemWidget)) (R.ModelOf itemWidget))-    | AddItemAction k (R.GizmoOf itemWidget)-    | ItemAction k (R.ActionOf itemWidget)-    | SetFilterAction (R.OutlineOf 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--mkPlan-    :: 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--- | 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) [] (s ^. items)---- Link Glazier.React.Model's HasPlan/HasModel with this widget's HasPlan/HasModel from makeClassy-instance HasPlan (R.Scene (Model k itemWidget) Plan) where-    plan = R.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) (Outline k itemWidget) (Model k itemWidget) Plan-widget-    :: (R.IsWidget itemWidget, Ord k)-    => R.ReactMlT Identity ()-    -> itemWidget-    -> Widget k itemWidget-widget separator itemWidget = R.Widget-    (mkModel itemWidget)-    (mkPlan separator (R.window itemWidget))-    window-    (gadget (R.mkGizmo itemWidget) (R.gadget itemWidget))---- | Exposed to parent components to render this component-window :: G.WindowT (R.Scene (Model k itemWidget) Plan) (R.ReactMlT Identity) ()-window = do-    s <- ask-    lift $ R.lf (s ^. component . 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')-        ]---- | Internal rendering used by the React render callback-render-    :: 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-    xs <- fmap (view R.scene) . filter ((s ^. itemsFilter) . R.outline . view R.model) . fmap snd .  M.toList <$> view items-    lift $ R.bh "ul" [ ("key", s ^. key . to JE.toJS')-                     , ("className", s ^. className . to JE.toJS')-                     ] $ do-        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.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-            componentRef .= node-            pure mempty--        RenderAction ->-            D.singleton <$> (R.basicRenderCmd frameNum componentRef RenderCommand)--        ComponentDidUpdateAction -> do-            -- Run delayed commands that need to wait until frame is re-rendered-            -- Eg focusing after other rendering changes-            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-                itemGizmo <- MaybeT $ use (items . at k)-                deferredDisposables %= (`D.snoc` CD.disposing itemGizmo)-                -- Remove the todo from the model-                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 idx-            idx .= n-            pure $ D.singleton $ MakerCommand $ do-                sm <- R.hoistWithAction (ItemAction n) (-                    itemModelMaker n >>= mkItemGizmo)-                pure $ AddItemAction n sm--        AddItemAction n v -> do-            items %= M.insert n v-            D.singleton <$> (R.basicRenderCmd frameNum componentRef RenderCommand)--        ItemAction k _ -> fmap (ItemCommand k) <$>-            (magnify (_ItemAction . to snd)-            (zoom (items . at k . _Just) itemGadget))--        SetFilterAction ftr -> do-            itemsFilter .= ftr-            D.singleton <$> (R.basicRenderCmd frameNum componentRef RenderCommand)

@@ -1,39 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TemplateHaskell #-}--module Glazier.React.Widgets.List.Run-    ( run-    ) where--import Control.Concurrent.MVar-import Control.Concurrent.STM-import qualified Control.Disposable as CD-import Control.Monad-import Control.Monad.Free.Church-import qualified Glazier.React.Component as R-import qualified Glazier.React.Command.Run as R-import qualified Glazier.React.Maker.Run as R.Maker-import qualified Glazier.React.Widget as R-import Glazier.React.Widgets.List as W.List-import qualified Pipes.Concurrent as PC--run-    :: (k -> R.CommandOf itemWidget -> IO ()) -- command runner for the items-    -> MVar Int-    -> R.ReactComponent -- for Maker-    -> PC.Output (Action k itemWidget)-    -> Command k itemWidget-    -> IO ()--run _ _ _ _ (RenderCommand sm props j) = R.componentSetState sm props j--run _ _ _ _ (DisposeCommand x) = CD.dispose x--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 k itemCmd) = itemCmdRun k itemCmd