├── ComonadsForUIs.pdf
├── .gitignore
├── package.json
├── src
├── Control
│ └── Comonad
│ │ ├── Pairing.purs
│ │ └── Cofree
│ │ └── Trans.purs
├── Todos
│ ├── Model.purs
│ ├── Persistence.purs
│ ├── Store
│ │ ├── Tasks.purs
│ │ └── App.purs
│ ├── Moore
│ │ ├── Tasks.purs
│ │ └── App.purs
│ └── Cofree
│ │ ├── Tasks.purs
│ │ └── App.purs
├── UI
│ └── React.purs
├── Main.purs
├── Data
│ ├── Machine
│ │ └── Moore.purs
│ └── Functor
│ │ └── Pairing.purs
└── UI.purs
├── Makefile
├── html
├── index.html
└── index.css
├── LICENSE
├── bower.json
└── README.md
/ComonadsForUIs.pdf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/arthurxavierx/purescript-comonad-ui-todos/HEAD/ComonadsForUIs.pdf
--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | /bower_components/
2 | /node_modules/
3 | /.pulp-cache/
4 | /output/
5 | /generated-docs/
6 | /.psc*
7 | /.purs*
8 | /.psa*
9 |
10 | /html/index.js
11 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-comonad-ui-todos",
3 | "files": [],
4 | "dependencies": {
5 | "create-react-class": "^15.6.2",
6 | "react": "^16.0.0",
7 | "react-dom": "^16.0.0"
8 | }
9 | }
10 |
--------------------------------------------------------------------------------
/src/Control/Comonad/Pairing.purs:
--------------------------------------------------------------------------------
1 | module Control.Comonad.Pairing where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad (class Comonad, duplicate)
6 | import Data.Functor.Pairing (class Pairing, pair, pairFlipped)
7 |
8 | select :: forall m w a b. Pairing m w => w a -> m b -> b
9 | select = pairFlipped (const identity)
10 |
11 | move :: forall m w a. Comonad w => Pairing m w => w a -> m Unit -> w a
12 | move w m = pair (const identity) m (duplicate w)
13 |
--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
1 | OUTDIR = html
2 | SRC = src
3 |
4 | SOURCES = $(wilcard $(SRC)/**/*.purs)
5 |
6 | OUTPUT = $(OUTDIR)/index.js
7 |
8 | all: $(OUTPUT)
9 |
10 | build:
11 | pulp build
12 |
13 | test:
14 | pulp test
15 |
16 | node_modules/:
17 | npm install
18 |
19 | bower_components/:
20 | bower install
21 |
22 | html/index.js html/%.js %.js: $(SOURCES) | node_modules/ bower_components/
23 | pulp browserify --to $@
24 |
25 | clean:
26 | rm -rf $(OUTPUT) output/
27 |
28 | .PHONY: all $(OUTPUT) build clean test
29 |
--------------------------------------------------------------------------------
/html/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 | ToDos
5 |
6 |
7 |
8 |
11 |
12 |
17 |
18 |
19 |
20 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Copyright 2017 Arthur Xavier Gomes Ribeiro
2 |
3 | Licensed under the Apache License, Version 2.0 (the "License");
4 | you may not use this file except in compliance with the License.
5 | You may obtain a copy of the License at
6 |
7 | http://www.apache.org/licenses/LICENSE-2.0
8 |
9 | Unless required by applicable law or agreed to in writing, software
10 | distributed under the License is distributed on an "AS IS" BASIS,
11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12 | See the License for the specific language governing permissions and
13 | limitations under the License.
14 |
--------------------------------------------------------------------------------
/bower.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-comonad-ui-todos",
3 | "ignore": [
4 | "**/.*",
5 | "node_modules",
6 | "bower_components",
7 | "output"
8 | ],
9 | "dependencies": {
10 | "purescript-prelude": "^4.0.0",
11 | "purescript-console": "^4.1.0",
12 | "purescript-react-dom": "^6.0.0",
13 | "purescript-web-dom": "^1.0.0",
14 | "purescript-web-html": "^1.0.0",
15 | "purescript-web-storage": "^2.0.0",
16 | "purescript-functors": "^3.0.0",
17 | "purescript-free": "^5.0.0",
18 | "purescript-freet": "^4.0.0",
19 | "purescript-simple-json": "^4.2.0"
20 | },
21 | "devDependencies": {
22 | "purescript-debug": "^4.0.0",
23 | "purescript-psci-support": "^4.0.0"
24 | }
25 | }
26 |
--------------------------------------------------------------------------------
/src/Todos/Model.purs:
--------------------------------------------------------------------------------
1 | module Todos.Model where
2 |
3 | import Data.Array (length)
4 |
5 | type Task =
6 | { id :: Int
7 | , description :: String
8 | , done :: Boolean
9 | }
10 |
11 | type TasksModel = Array Task
12 |
13 | tasksInit :: TasksModel
14 | tasksInit = [{ id: 0, description: "Test", done: false }]
15 |
16 | type AppModel =
17 | { field :: String
18 | , uid :: Int
19 | }
20 |
21 | appInit :: TasksModel -> AppModel
22 | appInit tasks = { field: "", uid: length tasks }
23 |
24 |
25 | -- | The `GlobalModel` type describes a model of the whole state of the application, as
26 | -- | used by the moore machine example, which models the Elm architecture.
27 | type GlobalModel =
28 | { field :: String
29 | , uid :: Int
30 | , tasks :: TasksModel
31 | }
32 |
33 | globalInit :: TasksModel -> GlobalModel
34 | globalInit tasks = { field: "", uid: length tasks, tasks }
35 |
--------------------------------------------------------------------------------
/src/Todos/Persistence.purs:
--------------------------------------------------------------------------------
1 | module Todos.Persistence where
2 |
3 | import Prelude
4 |
5 | import Data.Either (hush)
6 | import Data.Maybe (fromMaybe)
7 | import Data.Newtype (class Newtype)
8 | import Effect (Effect)
9 | import Simple.JSON (class ReadForeign, class WriteForeign, readJSON, writeJSON)
10 | import Todos.Model (TasksModel, tasksInit)
11 | import Web.HTML (window)
12 | import Web.HTML.Window (localStorage)
13 | import Web.Storage.Storage (getItem, setItem)
14 |
15 | newtype PersistedTasks = PersistedTasks TasksModel
16 | derive instance newtypePersistedTasks :: Newtype PersistedTasks _
17 | derive newtype instance readForeignPersistedTasks :: ReadForeign PersistedTasks
18 | derive newtype instance writeForeignPersistedTasks :: WriteForeign PersistedTasks
19 |
20 | save :: String -> TasksModel -> Effect Unit
21 | save key tasks = do
22 | let model = PersistedTasks tasks
23 | setItem key (writeJSON model) =<< localStorage =<< window
24 |
25 | load :: String -> Effect TasksModel
26 | load key = do
27 | modelM <- getItem key =<< localStorage =<< window
28 | pure $ fromMaybe tasksInit do
29 | PersistedTasks tasks <- hush <<< readJSON =<< modelM
30 | pure $ tasks
31 |
32 | keyCofree :: String
33 | keyCofree = "todos_Cofree"
34 |
35 | keyMoore :: String
36 | keyMoore = "todos_Moore"
37 |
38 | keyStore :: String
39 | keyStore = "todos_Store"
40 |
--------------------------------------------------------------------------------
/src/UI/React.purs:
--------------------------------------------------------------------------------
1 | module UI.React where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad (class Comonad)
6 | import Data.Functor.Pairing (class Pairing)
7 | import Effect (Effect)
8 | import React as R
9 | import UI (ComponentT, UI, explore) as UI
10 |
11 | -- | A `ReactUI` is a `UI` whose action handlers run in the `Effect` monad, producing
12 | -- | interfaces described by `ReactElement`s.
13 | type ReactUI m = UI.UI Effect m R.ReactElement
14 |
15 | -- | A `ReactComponent` is a comonad `w` describing a space of all future possible
16 | -- | `ReactUI`s.
17 | type ReactComponent w m =
18 | UI.ComponentT
19 | Effect
20 | w
21 | m
22 | R.ReactElement
23 |
24 | -- | Explore a `ReactComponent` whose comonad and monad do form a `Pairing` by producing
25 | -- | a `ReactClass` which can be rendered using React.
26 | explore
27 | :: forall w m
28 | . Comonad w
29 | => Pairing m w
30 | => ReactComponent w m
31 | -> R.ReactClass {}
32 | explore space = R.component "ComonadComponent" \this -> pure
33 | { state: { space }
34 | , render: do
35 | state <- R.getState this
36 | pure $ UI.explore (\s -> R.writeState this { space: s }) state.space
37 | }
38 |
39 | -- | Instantiate a `ReactComponent` as a `ReactElement`
40 | toReact :: forall w m. Comonad w => Pairing m w => ReactComponent w m -> R.ReactElement
41 | toReact = flip R.createLeafElement {} <<< explore
42 |
--------------------------------------------------------------------------------
/src/Todos/Store/Tasks.purs:
--------------------------------------------------------------------------------
1 | module Todos.Store.Tasks where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad.Store (Store, store)
6 | import Control.Monad.State (State, modify)
7 | import Data.Array (filter)
8 | import Data.Foldable (fold)
9 | import React.DOM as D
10 | import React.DOM.Props as P
11 | import Todos.Model (TasksModel)
12 | import UI.React (ReactComponent, ReactUI)
13 |
14 | type Space = Store TasksModel
15 | type Action = State TasksModel
16 |
17 | tasksComponent :: TasksModel -> ReactComponent Space Action
18 | tasksComponent init = store render init
19 | where
20 | render :: TasksModel -> ReactUI (Action Unit)
21 | render model send =
22 | D.div [ P.className "Tasks" ] $ fold $ model <#> \task ->
23 | [ D.div
24 | [ P.className (if task.done then "Task done" else "Task") ]
25 | [ D.span
26 | [ P.onClick \_ -> send $ pure (toggleDone task.id)
27 | ]
28 | [ D.text task.description ]
29 | , D.button
30 | [ P._type "button"
31 | , P.onClick \_ -> send $ pure (removeTask task.id)
32 | ]
33 | [ D.text "×" ]
34 | ]
35 | ]
36 |
37 | toggleDone :: Int -> Action Unit
38 | toggleDone id = void $ modify $ map \task ->
39 | if task.id == id then task { done = not task.done } else task
40 |
41 | removeTask :: Int -> Action Unit
42 | removeTask id = void $ modify $ filter ((_ /= id) <<< _.id)
43 |
--------------------------------------------------------------------------------
/src/Todos/Moore/Tasks.purs:
--------------------------------------------------------------------------------
1 | module Todos.Moore.Tasks where
2 |
3 | import Prelude
4 |
5 | import Data.Array (filter)
6 | import Data.Foldable (fold)
7 | import Data.Machine.Moore (Comoore, action)
8 | import React.DOM as D
9 | import React.DOM.Props as P
10 | import Todos.Model (TasksModel, Task)
11 | import Todos.Persistence (keyMoore, save) as Persistence
12 | import UI.React (ReactUI)
13 |
14 | data Input
15 | = AddTask Task
16 | | RemoveTask Int
17 | | ToggleDone Int
18 |
19 | type Action = Comoore Input
20 |
21 | tasksComponent :: TasksModel -> ReactUI (Action Unit)
22 | tasksComponent model send =
23 | D.div [ P.className "Tasks" ] $ fold $ model <#> \task ->
24 | [ D.div
25 | [ P.className (if task.done then "Task done" else "Task") ]
26 | [ D.span
27 | [ P.onClick \_ -> send $ saveAndAction (ToggleDone task.id)
28 | ]
29 | [ D.text task.description ]
30 | , D.button
31 | [ P._type "button"
32 | , P.onClick \_ -> send $ saveAndAction (RemoveTask task.id)
33 | ]
34 | [ D.text "×" ]
35 | ]
36 | ]
37 | where
38 | saveAndAction input = do
39 | Persistence.save Persistence.keyMoore (tasksUpdate model input)
40 | pure $ action input
41 |
42 | tasksUpdate :: TasksModel -> Input -> TasksModel
43 | tasksUpdate model input =
44 | case input of
45 | AddTask task -> [task] <> model
46 | RemoveTask id -> filter ((_ /= id) <<< _.id) model
47 | ToggleDone id -> model <#> \task ->
48 | if task.id == id then task { done = not task.done } else task
49 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # purescript-comonad-ui-todos
2 |
3 | Simple task management application inspired by [TodoMVC](todomvc.com); written for the first part of my bachelor thesis [Comonads for User Interfaces](https://arthurxavierx.github.com/ComonadsForUIs.pdf) based on Phil Freeman's [Comonads as spaces](http://blog.functorial.com/posts/2016-08-07-Comonads-As-Spaces.html).
4 |
5 | This simple application demonstrates three types of UIs modelled with three different comonads, namely:
6 |
7 | - the `Store` comonad: models a general architecture where every component fully exposes its state for read and write operations;
8 | - the `Moore i` comonad: isomorphic to `Cofree ((->) i)` or `Traced [i]`, this comonad models the Elm architecture where user component inputs are given by a type `i`;
9 | - the `Cofree f` comonad: models an object-oriented architecture similar to that of [Halogen](https://github.com/slamdata/purescript-halogen).
10 |
11 | We have implemented local storage in the browser for saving tasks for all UI examples. In the `Moore` example, however, it is still unclear what could be the best method for applying effects when of a component action (as the component state is private). We have used an _ad hoc_ approach by replicating a `save` function when of every user action.
12 |
13 | ## Build instructions
14 |
15 | In order to build this application one must have the [PureScript](http://www.purescript.org/) compiler (version 0.11.7) installed, as well as the [npm](https://www.npmjs.com/) and [bower](https://bower.io/) tools for package management.
16 |
17 | After installing the prerequisites, simply run
18 |
19 | ```
20 | make
21 | ```
22 |
--------------------------------------------------------------------------------
/src/Main.purs:
--------------------------------------------------------------------------------
1 | module Main where
2 |
3 | import Prelude
4 |
5 | import Data.Traversable (for_)
6 | import Effect (Effect)
7 | import React.DOM as D
8 | import React.DOM.Props as P
9 | import ReactDOM (render)
10 | import Todos.Cofree.App (appComponent) as Cofree
11 | import Todos.Moore.App (appComponent) as Moore
12 | import Todos.Persistence (keyCofree, keyMoore, keyStore, load) as Persistence
13 | import Todos.Store.App (appComponent) as Store
14 | import UI.React (toReact)
15 | import Web.DOM.NonElementParentNode (getElementById) as DOM
16 | import Web.HTML (window) as DOM
17 | import Web.HTML.Window (document) as DOM
18 | import Web.HTML.HTMLDocument (toNonElementParentNode) as DOM
19 |
20 | main :: Effect Unit
21 | main = do
22 | document <- DOM.window >>= DOM.document
23 | appDiv <- DOM.getElementById "app" (DOM.toNonElementParentNode document)
24 | ui <- loadUI
25 | for_ appDiv (render ui)
26 |
27 | where
28 | loadUI = do
29 | tasksCofree <- Persistence.load Persistence.keyCofree
30 | tasksMoore <- Persistence.load Persistence.keyMoore
31 | tasksStore <- Persistence.load Persistence.keyStore
32 | pure $
33 | D.div
34 | [ P.className "Container" ]
35 | [ D.div [ P.className "AppContainer" ]
36 | [ D.h4' [ D.text "Cofree comonad" ]
37 | , toReact $ Cofree.appComponent tasksCofree
38 | ]
39 | , D.div [ P.className "AppContainer" ]
40 | [ D.h4' [ D.text "Moore machine" ]
41 | , toReact $ Moore.appComponent tasksMoore
42 | ]
43 | , D.div [ P.className "AppContainer" ]
44 | [ D.h4' [ D.text "Store comonad" ]
45 | , toReact $ Store.appComponent tasksStore
46 | ]
47 | ]
48 |
--------------------------------------------------------------------------------
/src/Control/Comonad/Cofree/Trans.purs:
--------------------------------------------------------------------------------
1 | module Control.Comonad.Cofree.Trans where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad (class Comonad, extract)
6 | import Control.Comonad.Trans.Class (class ComonadTrans)
7 | import Control.Extend (class Extend, extend)
8 | import Data.Bifunctor (bimap)
9 | import Data.Identity (Identity(..))
10 | import Data.Lazy (Lazy, defer, force)
11 | import Data.Tuple (Tuple(..), fst, snd)
12 |
13 | type CofreeF f a b = Tuple a (Lazy (f b))
14 |
15 | newtype CofreeT f w a = CofreeT (w (CofreeF f a (CofreeT f w a)))
16 |
17 | type Cofree f = CofreeT f Identity
18 |
19 | cofree :: forall f a. CofreeF f a (Cofree f a) -> Cofree f a
20 | cofree = CofreeT <<< Identity
21 |
22 | runCofreeT :: forall f w a. CofreeT f w a -> w (CofreeF f a (CofreeT f w a))
23 | runCofreeT (CofreeT w) = w
24 |
25 | coresume :: forall f w a. Comonad w => CofreeT f w a -> w (Tuple a (f (CofreeT f w a)))
26 | coresume (CofreeT w) = w <#> \(Tuple a as) -> Tuple a (force as)
27 |
28 | unfoldCofreeT :: forall f w s a. Functor f => Comonad w => (s -> w (Tuple a (f s))) -> s -> CofreeT f w a
29 | unfoldCofreeT f s = CofreeT $ f s <#> map (\next -> defer \_ -> unfoldCofreeT f <$> next)
30 |
31 | unfoldCofree :: forall f s a. Functor f => (s -> Tuple a (f s)) -> s -> Cofree f a
32 | unfoldCofree f = unfoldCofreeT (Identity <<< f)
33 |
34 | instance eqCofreeT :: Eq (w (CofreeF f a (CofreeT f w a))) => Eq (CofreeT f w a) where
35 | eq = eq
36 |
37 | instance ordCofreeT :: Ord (w (CofreeF f a (CofreeT f w a))) => Ord (CofreeT f w a) where
38 | compare = compare
39 |
40 | instance functorCofreeT :: (Functor f, Functor w) => Functor (CofreeT f w) where
41 | map f (CofreeT w) = CofreeT $ map (bimap f (map (map (map f)))) w
42 |
43 | instance extendCofreeT :: (Functor f, Comonad w) => Extend (CofreeT f w) where
44 | extend f =
45 | CofreeT
46 | <<< extend (\w -> Tuple (f (CofreeT w)) (map (extend f) <$> snd (extract w)))
47 | <<< runCofreeT
48 |
49 | instance comonadCofreeT :: (Functor f, Comonad w) => Comonad (CofreeT f w) where
50 | extract (CofreeT w) = fst (extract w)
51 |
52 | instance comonadTransCofreeT :: ComonadTrans (CofreeT f) where
53 | lower = map fst <<< runCofreeT
54 |
--------------------------------------------------------------------------------
/src/Todos/Store/App.purs:
--------------------------------------------------------------------------------
1 | module Todos.Store.App where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad (extract, (=>>))
6 | import Control.Comonad.Store (StoreT(StoreT), pos)
7 | import Control.Comonad.Trans.Class (lower)
8 | import Control.Monad.State (StateT, get, modify, put)
9 | import Control.Monad.Trans.Class (lift)
10 | import Data.Array (filter, length)
11 | import Data.Tuple (Tuple(..))
12 | import React.DOM as D
13 | import React.DOM.Props as P
14 | import React.SyntheticEvent as E
15 | import Todos.Model (AppModel, TasksModel, appInit)
16 | import Todos.Persistence (keyStore, save) as Persistence
17 | import Todos.Store.Tasks as Tasks
18 | import UI as UI
19 | import UI.React (ReactComponent, ReactUI)
20 | import Unsafe.Coerce (unsafeCoerce)
21 |
22 | type AppSpace = StoreT AppModel Tasks.Space
23 | type AppAction = StateT AppModel Tasks.Action
24 |
25 | appComponent :: TasksModel -> ReactComponent AppSpace AppAction
26 | appComponent tasksInit =
27 | StoreT (Tuple (Tasks.tasksComponent tasksInit =>> render <<< UI.liftComponentT) (appInit tasksInit))
28 | =>>
29 | UI.effect \component -> do
30 | Persistence.save Persistence.keyStore (pos $ lower component)
31 |
32 | where
33 | render :: ReactComponent Tasks.Space AppAction -> AppModel -> ReactUI (AppAction Unit)
34 | render child model send =
35 | D.form
36 | [ P.className "App"
37 | , P.onSubmit \event -> send do
38 | _ <- E.preventDefault event
39 | pure createTask
40 | ]
41 | [ D.input
42 | [ P._type "text"
43 | , P.placeholder "What needs to be done?"
44 | , P.value model.field
45 | , P.onChange \event -> send do
46 | let value = (unsafeCoerce event).target.value
47 | pure $ void $ modify (_ { field = value })
48 | ]
49 | , extract child send
50 | , D.small'
51 | [ D.text $ show (length $ filter _.done (pos child)) <> " tasks completed"
52 | ]
53 | ]
54 |
55 | createTask :: AppAction Unit
56 | createTask = do
57 | model <- get
58 | lift $ void $ modify $ append [{ id: model.uid, description: model.field, done: false }]
59 | put (model { field = "", uid = model.uid + 1 })
60 |
--------------------------------------------------------------------------------
/src/Todos/Moore/App.purs:
--------------------------------------------------------------------------------
1 | module Todos.Moore.App where
2 |
3 | import Prelude
4 |
5 | import Data.Array (filter, length)
6 | import Data.Machine.Moore (Comoore, Moore, action, mapAction, unfoldMoore)
7 | import Data.Tuple (Tuple(Tuple))
8 | import React.DOM as D
9 | import React.DOM.Props as P
10 | import React.SyntheticEvent as E
11 | import Todos.Model (GlobalModel, TasksModel, Task, globalInit)
12 | import Todos.Moore.Tasks as Tasks
13 | import Todos.Persistence (keyMoore, save) as Persistence
14 | import UI.React (ReactComponent, ReactUI)
15 | import Unsafe.Coerce (unsafeCoerce)
16 |
17 | data AppInput
18 | = ChangeField String
19 | | IncrementUID
20 | | TasksAction Tasks.Input
21 |
22 | type AppSpace = Moore AppInput
23 | type AppAction = Comoore AppInput
24 |
25 | appComponent :: TasksModel -> ReactComponent AppSpace AppAction
26 | appComponent tasksInit = unfoldMoore step (globalInit tasksInit)
27 | where
28 | step model =
29 | Tuple
30 | (render model)
31 | (update model)
32 |
33 | update :: GlobalModel -> AppInput -> GlobalModel
34 | update model input =
35 | case input of
36 | ChangeField field -> model { field = field }
37 | IncrementUID -> model { uid = model.uid + 1 }
38 | TasksAction tasksInput ->
39 | model { tasks = Tasks.tasksUpdate model.tasks tasksInput }
40 |
41 | render :: GlobalModel -> ReactUI (AppAction Unit)
42 | render model send =
43 | D.form
44 | [ P.className "App"
45 | , P.onSubmit \event -> send do
46 | _ <- E.preventDefault event
47 | let newTask = { id: model.uid, description: model.field, done: false }
48 | Persistence.save Persistence.keyMoore ([newTask] <> model.tasks)
49 | pure $ createTask newTask model
50 | ]
51 | [ D.input
52 | [ P._type "text"
53 | , P.placeholder "What needs to be done?"
54 | , P.value model.field
55 | , P.onChange \event -> send do
56 | let value = (unsafeCoerce event).target.value
57 | pure $ action (ChangeField value)
58 | ]
59 | , Tasks.tasksComponent model.tasks (send <<< map (mapAction TasksAction))
60 | , D.small'
61 | [ D.text $ show (length $ filter _.done model.tasks) <> " tasks completed"
62 | ]
63 | ]
64 |
65 | createTask :: Task -> GlobalModel -> AppAction Unit
66 | createTask newTask model = do
67 | action (ChangeField "")
68 | action IncrementUID
69 | action (TasksAction $ Tasks.AddTask newTask)
70 |
--------------------------------------------------------------------------------
/src/Data/Machine/Moore.purs:
--------------------------------------------------------------------------------
1 | module Data.Machine.Moore where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad (class Comonad)
6 | import Control.Comonad.Cofree.Trans (CofreeT, unfoldCofreeT)
7 | import Control.Comonad.Trans.Class (class ComonadTrans)
8 | import Control.Extend (class Extend)
9 | import Control.Monad.Free.Trans (FreeT, interpret, liftFreeT)
10 | import Control.Monad.Rec.Class (class MonadRec)
11 | import Control.Monad.Trans.Class (class MonadTrans)
12 | import Data.Bifunctor (lmap)
13 | import Data.Functor.Pairing (class Pairing, pair)
14 | import Data.Identity (Identity(..))
15 | import Data.Tuple (Tuple(..))
16 |
17 | newtype MooreT i w a = MooreT (CofreeT ((->) i) w a)
18 | type Moore i = MooreT i Identity
19 |
20 | unfoldMooreT :: forall w s i a. Comonad w => (s -> w (Tuple a (i -> s))) -> s -> MooreT i w a
21 | unfoldMooreT f = MooreT <<< unfoldCofreeT f
22 |
23 | unfoldMoore :: forall s i a. (s -> Tuple a (i -> s)) -> s -> Moore i a
24 | unfoldMoore f = MooreT <<< unfoldCofreeT (Identity <<< f)
25 |
26 | derive newtype instance functorMooreT :: Functor w => Functor (MooreT i w)
27 | derive newtype instance extendMooreT :: Comonad w => Extend (MooreT i w)
28 | derive newtype instance comonadMooreT :: Comonad w => Comonad (MooreT i w)
29 | derive newtype instance comonadTransMooreT :: ComonadTrans (MooreT i)
30 |
31 | --------------------------------------------------------------------------------
32 |
33 | newtype ComooreT i m a = ComooreT (FreeT (Tuple i) m a)
34 | type Comoore i = ComooreT i Identity
35 |
36 | liftComooreT :: forall m i a. Monad m => i -> a -> ComooreT i m a
37 | liftComooreT input = ComooreT <<< liftFreeT <<< Tuple input
38 |
39 | action :: forall m i. Monad m => i -> ComooreT i m Unit
40 | action = flip liftComooreT unit
41 |
42 | mapAction :: forall m i j. Monad m => (i -> j) -> ComooreT i m ~> ComooreT j m
43 | mapAction f (ComooreT freet) = ComooreT $ interpret (lmap f) freet
44 |
45 | derive newtype instance functorComooreT :: Functor m => Functor (ComooreT i m)
46 | derive newtype instance applyComooreT :: Monad m => Apply (ComooreT i m)
47 | derive newtype instance applicativeComooreT :: Monad m => Applicative (ComooreT i m)
48 | derive newtype instance bindComooreT :: Monad m => Bind (ComooreT i m)
49 | derive newtype instance monadComooreT :: Monad m => Monad (ComooreT i m)
50 | derive newtype instance monadTransComooreT :: MonadTrans (ComooreT i)
51 | derive newtype instance monadRecComooreT :: Monad m => MonadRec (ComooreT i m)
52 |
53 | instance pairComooreTMooreT :: (MonadRec m, Comonad w, Pairing m w) => Pairing (ComooreT i m) (MooreT i w) where
54 | pair f (ComooreT m) (MooreT w) = pair f m w
55 |
--------------------------------------------------------------------------------
/src/Data/Functor/Pairing.purs:
--------------------------------------------------------------------------------
1 | module Data.Functor.Pairing where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad (class Comonad)
6 | import Control.Comonad.Cofree (Cofree, explore)
7 | import Control.Comonad.Cofree.Trans (CofreeT, coresume)
8 | import Control.Comonad.Env (EnvT(..))
9 | import Control.Comonad.Store (StoreT(..))
10 | import Control.Comonad.Traced (TracedT(..))
11 | import Control.Monad.Free (Free)
12 | import Control.Monad.Free.Trans (FreeT, resume)
13 | import Control.Monad.Reader (ReaderT(..))
14 | import Control.Monad.Rec.Class (class MonadRec)
15 | import Control.Monad.State (StateT(StateT))
16 | import Control.Monad.Writer (WriterT(..))
17 | import Data.Either (Either(..))
18 | import Data.Functor.Coproduct (Coproduct(..))
19 | import Data.Functor.Product (Product(..))
20 | import Data.Identity (Identity(..))
21 | import Data.Tuple (Tuple(Tuple))
22 |
23 | class Pairing f g where
24 | pair :: forall a b c. (a -> b -> c) -> f a -> g b -> c
25 |
26 | zap :: forall f g a b. Pairing f g => f (a -> b) -> g a -> b
27 | zap = pair ($)
28 |
29 | pairFlipped :: forall a b c f g. Pairing f g => (a -> b -> c) -> g a -> f b -> c
30 | pairFlipped f ga fb = pair (flip f) fb ga
31 |
32 | instance pairIdentity :: Pairing Identity Identity where
33 | pair f (Identity a) (Identity b) = f a b
34 |
35 | instance pairTupleFunction :: Pairing (Tuple a) ((->) a) where
36 | pair f (Tuple a b) g = f b (g a)
37 |
38 | instance pairProductCoproduct :: (Pairing f1 g1, Pairing f2 g2) => Pairing (Product f1 f2) (Coproduct g1 g2) where
39 | pair f (Product (Tuple f1 f2)) (Coproduct e) =
40 | case e of
41 | Left g1 -> pair f f1 g1
42 | Right g2 -> pair f f2 g2
43 |
44 | instance pairStateStore :: Pairing f g => Pairing (StateT s f) (StoreT s g) where
45 | pair f (StateT state) (StoreT (Tuple wf s)) =
46 | pair (\(Tuple a s1) f1 -> f a (f1 s1)) (state s) wf
47 |
48 | instance pairWriterTraced :: Pairing f g => Pairing (WriterT w f) (TracedT w g) where
49 | pair f (WriterT writer) (TracedT gf) =
50 | pair (\(Tuple a w) f1 -> f a (f1 w)) writer gf
51 |
52 | instance pairReaderEnv :: Pairing f g => Pairing (ReaderT e f) (EnvT e g) where
53 | pair f (ReaderT reader) (EnvT (Tuple e gb)) = pair f (reader e) gb
54 |
55 | instance pairFreeCofree :: (Functor f, Functor g, Pairing f g) => Pairing (Free f) (Cofree g) where
56 | pair f = explore zap <<< map f
57 |
58 | instance pairFreeTCofreeT :: (Functor f, Functor g, MonadRec m, Comonad w, Pairing f g, Pairing m w) => Pairing (FreeT f m) (CofreeT g w) where
59 | pair f m w = go (step m w)
60 | where
61 | go (Tuple mf wc) =
62 | case pair Tuple mf wc of
63 | Tuple (Left a) (Tuple b _) -> f a b
64 | Tuple (Right ff) (Tuple _ tail) -> go (pair step ff tail)
65 |
66 | step a b = Tuple (resume a) (coresume b)
67 |
--------------------------------------------------------------------------------
/html/index.css:
--------------------------------------------------------------------------------
1 | html {
2 | font-family: 'Source Sans Pro', 'Helvetica', 'Arial', sans-serif;
3 | font-size: 62.5%;
4 | -ms-text-size-adjust: 100%;
5 | -webkit-text-size-adjust: 100%;
6 | }
7 |
8 | body {
9 | background-color: #F5F5F5;
10 |
11 | font-size: 1.5em;
12 | line-height: 1.6;
13 | font-weight: 400;
14 | color: #121212;
15 |
16 | margin: 0;
17 | }
18 |
19 | header {
20 | text-align: center;
21 | margin: 4.2rem 0;
22 | }
23 |
24 | header h1 {
25 | color: #666;
26 | }
27 |
28 | footer {
29 | font-size: 1.3rem;
30 | font-weight: 300;
31 | color: #B6B6B6;
32 | margin: 5.4rem 0;
33 | text-align: center;
34 | display: flex;
35 | flex-flow: column;
36 | }
37 | footer a {
38 | color: #777777;
39 | text-decoration: none;
40 | }
41 |
42 | h1 {
43 | font-size: 9.6rem;
44 | font-weight: 300;
45 | line-height: 7.2rem;
46 | }
47 |
48 | h4 {
49 | font-size: 2.0rem;
50 | font-weight: normal;
51 | }
52 |
53 | h1, h2, h3, h4, h5, h6 {
54 | margin: 0.3rem 0 0.9rem;
55 | }
56 |
57 | .Container {
58 | margin: 0 auto;
59 |
60 | display: flex;
61 | flex-flow: row;
62 | }
63 |
64 | .AppContainer {
65 | background-color: #FFFFFF;
66 |
67 | border-radius: 3px;
68 | margin: 1.5rem;
69 | padding: 1.2rem 1.5rem 1.45rem 1.5rem;
70 | height: 100%;
71 |
72 | box-shadow: 0 1px 3px rgba(0, 0, 0, 0.12), 0 1px 2px rgba(0, 0, 0, 0.24);
73 |
74 | flex: 1;
75 | display: flex;
76 | flex-flow: column;
77 | }
78 |
79 | .App {
80 | margin-top: 0.9rem;
81 | flex: 1;
82 | display: flex;
83 | flex-flow: column;
84 | }
85 |
86 | .App input[type="text"] {
87 | font-size: 1.4rem;
88 | border: none;
89 | border-bottom: 1px solid #121212;
90 | padding: 0.3rem 0.1rem;
91 | outline: none;
92 | flex: 1;
93 | }
94 | .App input[type="text"]:focus {
95 | border-bottom: 1px solid #2050F9;
96 | }
97 | .App input[type="text"]::placeholder {
98 | font-style: italic;
99 | color: #A5A5A5;
100 | }
101 |
102 | .App small {
103 | color: #666;
104 | text-align: right;
105 | }
106 |
107 |
108 | .Tasks {
109 | padding: 1.2rem 0 0.9rem;
110 |
111 | flex-flow: row;
112 | align-items: flex-start;
113 | }
114 |
115 | .Task {
116 | font-size: 1.6rem;
117 | border-bottom: 1px dotted #A5A5A5;
118 | padding: 0.6rem 0 0.3rem;
119 | margin: 0.6rem 0 0.9rem;
120 | display: flex;
121 | align-items: center;
122 | }
123 |
124 | .Task span {
125 | margin-right: 0.9rem;
126 | flex: 1;
127 | }
128 | .Task span:hover { cursor: pointer; }
129 | .Task.done span {
130 | color: #A5A5A5;
131 | text-decoration: line-through;
132 | }
133 |
134 | .Task button {
135 | background-color: #F0F0F0;
136 | font-size: 1.6rem;
137 | color: #666;
138 |
139 | border: none;
140 | border-radius: 50%;
141 | outline: none;
142 |
143 | line-height: 1.3rem;
144 | padding: 0;
145 | width: 2.1rem;
146 | height: 2.1rem;
147 | }
148 | .Task button:hover {
149 | background-color: #FFD6D6;
150 | cursor: pointer;
151 | }
152 |
--------------------------------------------------------------------------------
/src/Todos/Cofree/Tasks.purs:
--------------------------------------------------------------------------------
1 | module Todos.Cofree.Tasks where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad.Cofree (Cofree, unfoldCofree)
6 | import Control.Monad.Free (Free, liftF)
7 | import Data.Array (filter, length)
8 | import Data.Foldable (fold)
9 | import Data.Functor.Pairing (class Pairing)
10 | import Data.Tuple (Tuple(..), fst, snd)
11 | import React.DOM as D
12 | import React.DOM.Props as P
13 | import Todos.Model (TasksModel, Task)
14 | import UI.React (ReactComponent, ReactUI)
15 |
16 | type Space = Cofree Interpreter
17 | type Action = Free Query
18 |
19 | tasksComponent :: TasksModel -> ReactComponent Space Action
20 | tasksComponent init = unfoldCofree render eval init
21 | where
22 | eval :: TasksModel -> Interpreter TasksModel
23 | eval tasks = Interpreter
24 | { toggleDone: \id ->
25 | tasks <#> \task ->
26 | if task.id == id then task { done = not task.done } else task
27 | , addTask: \task -> [task] <> tasks
28 | , removeTask: \id -> filter ((_ /= id) <<< _.id) tasks
29 | , getDones: Tuple (length $ filter _.done tasks) tasks
30 | , getTasks: Tuple tasks tasks
31 | }
32 |
33 | render :: TasksModel -> ReactUI (Action Unit)
34 | render model send =
35 | D.div [ P.className "Tasks" ] $ fold $ model <#> \task ->
36 | [ D.div
37 | [ P.className (if task.done then "Task done" else "Task") ]
38 | [ D.span
39 | [ P.onClick \_ -> send $ pure (toggleDone task.id) ]
40 | [ D.text task.description ]
41 | , D.button
42 | [ P._type "button"
43 | , P.onClick \_ -> send $ pure (removeTask task.id)
44 | ]
45 | [ D.text "×" ]
46 | ]
47 | ]
48 |
49 | --------------------------------------------------------------------------------
50 |
51 | data Query a
52 | = ToggleDone Int a
53 | | AddTask Task a
54 | | RemoveTask Int a
55 | | GetTasks (Array Task -> a)
56 | | GetDones (Int -> a)
57 | derive instance functorQuery :: Functor Query
58 |
59 | toggleDone :: Int -> Action Unit
60 | toggleDone id = liftF $ ToggleDone id unit
61 |
62 | addTask :: Task -> Action Unit
63 | addTask task = liftF $ AddTask task unit
64 |
65 | removeTask :: Int -> Action Unit
66 | removeTask id = liftF $ RemoveTask id unit
67 |
68 | getDones :: forall a. (Int -> a) -> Action a
69 | getDones f = liftF $ GetDones f
70 |
71 | getTasks :: forall a. (Array Task -> a) -> Action a
72 | getTasks f = liftF $ GetTasks f
73 |
74 | newtype Interpreter a = Interpreter
75 | { toggleDone :: Int -> a
76 | , addTask :: Task -> a
77 | , removeTask :: Int -> a
78 | , getDones :: Tuple Int a
79 | , getTasks :: Tuple (Array Task) a
80 | }
81 | derive instance functorInterpreter :: Functor Interpreter
82 |
83 | instance pairQueryInterpreter :: Pairing Query Interpreter where
84 | pair f (ToggleDone id a) (Interpreter i) = f a (i.toggleDone id)
85 | pair f (AddTask task a) (Interpreter i) = f a (i.addTask task)
86 | pair f (RemoveTask task a) (Interpreter i) = f a (i.removeTask task)
87 | pair f (GetDones g) (Interpreter i) = f (g (fst i.getDones)) (snd i.getDones)
88 | pair f (GetTasks g) (Interpreter i) = f (g (fst i.getTasks)) (snd i.getTasks)
89 |
--------------------------------------------------------------------------------
/src/Todos/Cofree/App.purs:
--------------------------------------------------------------------------------
1 | module Todos.Cofree.App where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad (extract, (=>>))
6 | import Control.Comonad.Cofree.Trans (CofreeT, unfoldCofreeT)
7 | import Control.Comonad.Pairing (select)
8 | import Control.Comonad.Trans.Class (lower)
9 | import Control.Monad.Free.Trans (FreeT, liftFreeT)
10 | import Control.Monad.Trans.Class (lift)
11 | import Data.Functor.Pairing (class Pairing)
12 | import Data.Tuple (Tuple(..))
13 | import React.DOM as D
14 | import React.DOM.Props as P
15 | import React.SyntheticEvent as E
16 | import Todos.Cofree.Tasks as Tasks
17 | import Todos.Model (AppModel, TasksModel, appInit)
18 | import Todos.Persistence (keyCofree, save) as Persistence
19 | import UI as UI
20 | import UI.React (ReactComponent, ReactUI)
21 | import Unsafe.Coerce (unsafeCoerce)
22 |
23 | type AppSpace = CofreeT AppInterpreter Tasks.Space
24 | type AppAction = FreeT AppQuery Tasks.Action
25 |
26 | appComponent :: TasksModel -> ReactComponent AppSpace AppAction
27 | appComponent tasksInit =
28 | unfoldCofreeT step (Tuple (Tasks.tasksComponent tasksInit) (appInit tasksInit))
29 | =>>
30 | UI.effect \component ->
31 | select (lower component) $
32 | Tasks.getTasks $ Persistence.save Persistence.keyCofree
33 |
34 | where
35 | step (Tuple childComponent model) =
36 | childComponent
37 | =>> \child -> Tuple (render (UI.liftComponentT child) model) (Tuple child <$> eval model)
38 |
39 | eval :: AppModel -> AppInterpreter AppModel
40 | eval model = AppInterpreter
41 | { changeField: \field -> model { field = field }
42 | , incrementUID: model { uid = model.uid + 1 }
43 | }
44 |
45 | render :: ReactComponent Tasks.Space AppAction -> AppModel -> ReactUI (AppAction Unit)
46 | render child model send =
47 | D.form
48 | [ P.className "App"
49 | , P.onSubmit \event -> send do
50 | _ <- E.preventDefault event
51 | pure $ createTask model
52 | ]
53 | [ D.input
54 | [ P._type "text"
55 | , P.placeholder "What needs to be done?"
56 | , P.value model.field
57 | , P.onChange \event -> send do
58 | let value = (unsafeCoerce event).target.value
59 | pure $ changeField value
60 | ]
61 | , extract child send
62 | , select child $ Tasks.getDones \dones ->
63 | D.small' [ D.text $ show dones <> " tasks completed" ]
64 | ]
65 |
66 | --------------------------------------------------------------------------------
67 |
68 | data AppQuery a
69 | = ChangeField String a
70 | | IncrementUID a
71 | derive instance functorAppQuery :: Functor AppQuery
72 |
73 | changeField :: String -> AppAction Unit
74 | changeField field = liftFreeT $ ChangeField field unit
75 |
76 | incrementUID :: AppAction Unit
77 | incrementUID = liftFreeT $ IncrementUID unit
78 |
79 | createTask :: AppModel -> AppAction Unit
80 | createTask model = do
81 | changeField ""
82 | incrementUID
83 | lift $ Tasks.addTask { id: model.uid, description: model.field, done: false }
84 |
85 | newtype AppInterpreter a = AppInterpreter
86 | { changeField :: String -> a
87 | , incrementUID :: a
88 | }
89 | derive instance functorAppInterpreter :: Functor AppInterpreter
90 |
91 | instance pairAppQueryAppInterpreter :: Pairing AppQuery AppInterpreter where
92 | pair f (ChangeField field a) (AppInterpreter i) = f a (i.changeField field)
93 | pair f (IncrementUID a) (AppInterpreter i) = f a i.incrementUID
94 |
--------------------------------------------------------------------------------
/src/UI.purs:
--------------------------------------------------------------------------------
1 | module UI where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad (class Comonad, extract)
6 | import Control.Comonad.Pairing (move)
7 | import Control.Monad.Trans.Class (class MonadTrans, lift)
8 | import Data.Functor.Pairing (class Pairing)
9 | import Data.Identity (Identity)
10 |
11 | -- | A `Handler` is an event handler running in a `base` monad for actions of type `action`.
12 | type Handler base action = base action -> base Unit
13 |
14 | -- | A `UI` is a function which outputs a description of type `a` of an interface given
15 | -- | a way to handle the `action`s dispatched by this interface through a `Handler`.
16 | type UI base action a = Handler base action -> a
17 |
18 | -- | A component is a comonad `w` representing the space of all possible future `UI`s.
19 | -- | Through the use of `Pairing`s, one can `pair` this comonad `w` with a monad `m` for
20 | -- | moving around in this space and, thus, modifying the state of the component.
21 | -- |
22 | -- | In this way, a `ComponentT` is a comonad `w` full of future `UI`s whose `Handler`s
23 | -- | handle (in a `base` monad) actions of type `m Unit` dispatched by an interface of
24 | -- | type `a`.
25 | type ComponentT base w m a = w (UI base (m Unit) a)
26 |
27 | type Component w m a = ComponentT Identity w m a
28 |
29 | -- | Given a way of writing/updating the component's state within a `base` monad and
30 | -- | a current or initial `ComponentT` (a space of interfaces), to `explore` a component
31 | -- | means to get the current interface out of the component's comonad by wiring up the
32 | -- | action handler with the `write` function supplied.
33 | -- |
34 | -- | This is a generic function for exploring the space of states defined by a comonad.
35 | -- | Specific UI renderers must define their own specific derivations to effectively
36 | -- | create the stateful components.
37 | explore
38 | :: forall base w m a
39 | . Comonad w
40 | => Monad base
41 | => Pairing m w
42 | => (ComponentT base w m a -> base Unit)
43 | -> ComponentT base w m a
44 | -> a
45 | explore write space = extract space send
46 | where
47 | send :: Handler base (m Unit)
48 | send base = base >>= \m -> write (move space m)
49 |
50 | -- | Given a way of transforming actions of a child `UI` into actions of a parent `UI`,
51 | -- | `liftUI` produces a natural transformation of child `UI`s into parent `UI`s.
52 | liftUI
53 | :: forall base action actionp
54 | . Monad base
55 | => (action -> actionp)
56 | -> UI base action ~> UI base actionp
57 | liftUI liftm ui = \send -> ui \m -> send (m >>= pure <<< liftm)
58 |
59 | -- | Allow for transforming child `UI`s into parent `UI`s if the parent action type is a
60 | -- | monad transformer and the child action type is a monad.
61 | liftUIT
62 | :: forall base m mp a
63 | . Monad base
64 | => MonadTrans mp
65 | => Monad m
66 | => UI base (m a) ~> UI base (mp m a)
67 | liftUIT = liftUI lift
68 |
69 | -- | Produce a natural transformation of child `UI`s into parent `UI`s given a way of
70 | -- | transforming effectful actions of the child into effectful actions of the parent.
71 | liftUIEff
72 | :: forall base action actionp
73 | . Monad base
74 | => (base action -> base actionp)
75 | -> UI base action ~> UI base actionp
76 | liftUIEff liftm ui = \send -> ui (send <<< liftm)
77 |
78 | -- | Embed a child component into a parent component given a natural transformation from
79 | -- | the child's monad into the parent's monad.
80 | liftComponent
81 | :: forall base w m mp
82 | . Functor w
83 | => Monad base
84 | => m ~> mp
85 | -> ComponentT base w m ~> ComponentT base w mp
86 | liftComponent liftm = map (liftUI liftm)
87 |
88 | -- | Embed a child component into a parent one if the parent monad is a monad transformer.
89 | liftComponentT
90 | :: forall base w m mp
91 | . Functor w
92 | => Monad base
93 | => MonadTrans mp
94 | => Monad m
95 | => ComponentT base w m ~> ComponentT base w (mp m)
96 | liftComponentT = map liftUIT
97 |
98 | -- | Embed a child component into a parent one given a way of transforming monadic
99 | -- | actions of the child within a `base` monad into monadic actions of the parent within
100 | -- | a `base` monad.
101 | liftComponentEff
102 | :: forall base w m mp
103 | . Functor w
104 | => Monad base
105 | => (forall a. base (m a) -> base (mp a))
106 | -> ComponentT base w m ~> ComponentT base w mp
107 | liftComponentEff liftm = map (liftUIEff liftm)
108 |
109 | -- | Allow for the execution of monadic actions in the `base` monad (with access to the
110 | -- | current state of the component) in response to every user action within a
111 | -- | `ComponentT`.
112 | -- |
113 | -- | This function is a comonadic combinator.
114 | effect
115 | :: forall base w m a
116 | . Monad base
117 | => Comonad w
118 | => Pairing m w
119 | => (ComponentT base w m a -> base Unit)
120 | -> ComponentT base w m a
121 | -> UI base (m Unit) a
122 | effect eff component send = extract component \base -> send do
123 | action <- base
124 | eff (move component action)
125 | pure action
126 |
127 | -- | Allow for the execution of monadic actions in the `base` monad in response to every
128 | -- | user action within a `ComponentT`. The handling function has access to the current
129 | -- | state of the component as well as to the dispatched action to which it responds.
130 | -- |
131 | -- | This function is a comonadic combinator.
132 | effect'
133 | :: forall base w m a
134 | . Monad base
135 | => Comonad w
136 | => Pairing m w
137 | => (ComponentT base w m a -> m Unit -> base Unit)
138 | -> ComponentT base w m a
139 | -> UI base (m Unit) a
140 | effect' eff component send = extract component \base -> send do
141 | action <- base
142 | eff (move component action) action
143 | pure action
144 |
--------------------------------------------------------------------------------