├── .gitignore
├── LICENSE
├── README.md
├── bower.json
├── html
└── index.html
├── package.json
├── src
└── React
│ ├── Explore.purs
│ └── Explore
│ ├── Day.purs
│ ├── List.purs
│ └── Sum.purs
└── test
└── Main.purs
/.gitignore:
--------------------------------------------------------------------------------
1 | /html/index.js
2 | /bower_components/
3 | /node_modules/
4 | /.pulp-cache/
5 | /output/
6 | /.psci*
7 | /src/.webpack.js
8 | .psc-ide-port
9 |
10 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | The MIT License (MIT)
2 |
3 | Copyright (c) 2016-17 Phil Freeman
4 |
5 | Permission is hereby granted, free of charge, to any person obtaining a copy of
6 | this software and associated documentation files (the "Software"), to deal in
7 | the Software without restriction, including without limitation the rights to
8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
9 | the Software, and to permit persons to whom the Software is furnished to do so,
10 | subject to the following conditions:
11 |
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 |
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # purescript-react-explore
2 |
3 | Experiments with comonads for modelling React UIs, based on the paper
4 | [Declarative UIs are the Future - And the Future is Comonadic!](https://github.com/paf31/the-future-is-comonadic/).
5 |
6 | - [Module Documentation](https://pursuit.purescript.org/packages/purescript-react-explore)
7 | - [Example](test/Main.purs)
8 |
9 | Relevant blog posts:
10 |
11 | - [Comonads as Spaces](http://blog.functorial.com/posts/2016-08-07-Comonads-As-Spaces.html) explains the basic concepts
12 | - [Comonads and Day Convolution](http://blog.functorial.com/posts/2016-08-08-Comonad-And-Day-Convolution.html) explains the connection with Day convolution
13 | - [Comonads for Optionality](http://blog.functorial.com/posts/2017-10-28-Comonads-For-Optionality.html) explains the `Sum` construction
14 |
--------------------------------------------------------------------------------
/bower.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-react-explore",
3 | "ignore": [
4 | "**/.*",
5 | "node_modules",
6 | "bower_components",
7 | "output"
8 | ],
9 | "license": "MIT",
10 | "repository": {
11 | "type": "git",
12 | "url": "git://github.com/paf31/purescript-react-explore.git"
13 | },
14 | "dependencies": {
15 | "purescript-day": "^10.0.0",
16 | "purescript-pairing": "^5.1.0",
17 | "purescript-react": "^6.0.0"
18 | },
19 | "devDependencies": {
20 | "purescript-web-html": "^1.0.0",
21 | "purescript-react-dom": "^6.0.0"
22 | }
23 | }
24 |
--------------------------------------------------------------------------------
/html/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | purescript-react-explore
6 |
7 |
8 |
9 |
10 |
11 |
12 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-react-explore",
3 | "files": [],
4 | "scripts": {
5 | "example": "pulp browserify --main Test.Main --to html/index.js"
6 | },
7 | "dependencies": {
8 | "react": "^15.6.2",
9 | "react-dom": "^15.6.2"
10 | }
11 | }
12 |
--------------------------------------------------------------------------------
/src/React/Explore.purs:
--------------------------------------------------------------------------------
1 | -- | We can think of user interfaces as exploring a (pointed) space of states.
2 | -- | We can model that space using a comonad, and different choices of comonad
3 | -- | correspond to different UI patterns:
4 | -- |
5 | -- | - Store corresponds to something like React, where we just have a state,
6 | -- | and a function taking each state to a user interface.
7 | -- | - The Traced comonad corresponds to something like an incremental game,
8 | -- | where we have a state for every value in some monoid.
9 | -- | - Mealy machines are more like the Elm architecture, where we respond to
10 | -- | input events, and update some internal state.
11 | -- | - A cofree comonad is a bit like Halogen. We have some functor which
12 | -- | describes the transitions to new states, but which can also respond
13 | -- | to queries on the current state.
14 | -- |
15 | -- | We can use `Co w` to explore the state space. `Co w` actions will be
16 | -- | connected to the user interface. For example:
17 | -- |
18 | -- | - `Co (Store s)` is isomorphic to `State s`, so we can use get and put to
19 | -- | read and write the stored state.
20 | -- | - `Co (Traced w)` is isomorphic to `Writer`, so we can use `tell` to append some monoidal
21 | -- | value to our state.
22 | -- | - `Mealy action` is `Cofree (Function action)`, so `Co (Mealy action)` is isomorphic to
23 | -- | `Free (Tuple action)`. We can emit zero or more actions in response to
24 | -- | each user event.
25 | -- | - `Co (Cofree f)` is isomorphic to `Free g` whenever `f` pairs with `g`. This
26 | -- | corresponds to something like the Halogen API.
27 | module React.Explore where
28 |
29 | import Prelude
30 |
31 | import Control.Comonad (class Comonad, extend, extract)
32 | import Data.Functor.Pairing.Co (Co, runCo)
33 | import Effect (Effect)
34 | import React as R
35 |
36 | -- | A `Handler` takes an action and modifies the React component state.
37 | type Handler a = a -> Effect Unit
38 |
39 | -- | A UI, which is parameterized by its type of actions. For the purposes of
40 | -- | this implementation, a `UI` is just a `ReactElement` which takes its event
41 | -- | `Handler` as an explicit argument.
42 | type UI a = Handler a -> R.ReactElement
43 |
44 | -- | A `Component` is a comonad `w` full of future `UI`s. Those `UI`s can dispatch
45 | -- | actions in the `Co w` monad in order to explore the state space.
46 | type Component w = w (UI (Co w Unit))
47 |
48 | -- | Explore a space of states specified by some comonad, and defined by a
49 | -- | value in that comonad.
50 | -- |
51 | -- | This function creates a `ReactClass` which can be rendered using React.
52 | -- | See the test project for an example.
53 | explore :: forall w props. Comonad w => Component w -> R.ReactClass {| props }
54 | explore space =
55 | R.pureComponent "ReactExplore" \this ->
56 | pure { state: { space }
57 | , render: do
58 | { space: state } <- R.getState this
59 | let send :: Co w Unit -> Effect Unit
60 | send m = R.modifyState this \_ -> { space: runCo m (extend const state) }
61 | pure (extract state send)
62 | }
63 |
--------------------------------------------------------------------------------
/src/React/Explore/Day.purs:
--------------------------------------------------------------------------------
1 | module React.Explore.Day
2 | ( module Day
3 | , combine
4 | , liftLeft
5 | , liftRight
6 | ) where
7 |
8 | import Prelude
9 | import Control.Comonad (class Comonad, extract)
10 | import Data.Functor.Day (Day, day, runDay) as Day
11 | import Data.Functor.Pairing.Co (Co, co, runCo)
12 | import React.Explore (Component, UI)
13 |
14 | -- | To combine two components, we can take the Day convolution of their state
15 | -- | spaces.
16 | -- |
17 | -- | Conceptually, this is a bit like taking the smash product of pointed
18 | -- | topological spaces.
19 | combine :: forall w1 w2
20 | . Comonad w1
21 | => Comonad w2
22 | => (forall a. UI a -> UI a -> UI a)
23 | -> Component w1
24 | -> Component w2
25 | -> Component (Day.Day w1 w2)
26 | combine with = Day.day build where
27 | build :: UI (Co w1 Unit) -> UI (Co w2 Unit) -> UI (Co (Day.Day w1 w2) Unit)
28 | build render1 render2 = with (\send -> render1 \co -> send (liftLeft co))
29 | (\send -> render2 \co -> send (liftRight co))
30 |
31 | -- | Lift an action to act on the left state.
32 | liftLeft :: forall w w' a. Functor w => Comonad w' => Co w a -> Co (Day.Day w w') a
33 | liftLeft a = co (Day.runDay \f w w' -> runCo a (map (_ `f` extract w') w))
34 |
35 | -- | Lift an action to act on the right state.
36 | liftRight :: forall w w' a. Functor w => Comonad w' => Co w a -> Co (Day.Day w' w) a
37 | liftRight a = co (Day.runDay \f w' w -> runCo a (map (f (extract w')) w))
38 |
--------------------------------------------------------------------------------
/src/React/Explore/List.purs:
--------------------------------------------------------------------------------
1 | module React.Explore.List
2 | ( List
3 | , push
4 | , listOf
5 | ) where
6 |
7 | import Prelude
8 |
9 | import Control.Comonad (class Comonad, extract)
10 | import Control.Extend (class Extend, extend)
11 | import Data.Functor.Day (Day, day, runDay)
12 | import Data.Functor.Pairing.Co (Co, co, runCo)
13 | import Data.Identity (Identity)
14 | import Data.Lazy (Lazy, defer, force)
15 | import Data.Newtype (wrap)
16 | import React (ReactElement)
17 | import React.Explore (Component, Handler)
18 | import React.Explore.Sum (Sum(Sum))
19 |
20 | newtype LazyT w a = LazyT (Lazy (w a))
21 |
22 | runLazyT :: forall w a. LazyT w a -> w a
23 | runLazyT (LazyT wa) = force wa
24 |
25 | derive instance functorLazyT :: Functor f => Functor (LazyT f)
26 |
27 | instance extendLazyT :: Extend f => Extend (LazyT f) where
28 | extend f (LazyT x) = LazyT (x <#> \x_ -> extend (f <<< LazyT <<< pure) x_)
29 |
30 | instance comonadLazyT :: Comonad f => Comonad (LazyT f) where
31 | extract (LazyT x) = extract (force x)
32 |
33 | newtype List w a = List (Sum Identity (LazyT (Day w (List w))) a)
34 |
35 | derive instance functorList :: Functor f => Functor (List f)
36 |
37 | instance extendList :: Extend f => Extend (List f) where
38 | extend f (List x) = List (extend (f <<< List) x)
39 |
40 | instance comonadList :: Comonad f => Comonad (List f) where
41 | extract (List x) = extract x
42 |
43 | lowerDay0 :: forall w1 w2. Functor w1 => Comonad w2 => Day w1 w2 ~> w1
44 | lowerDay0 = runDay (\f w s -> map (_ `f` extract s) w)
45 |
46 | lowerDay1 :: forall w1 w2. Comonad w1 => Functor w2 => Day w1 w2 ~> w2
47 | lowerDay1 = runDay (\f w s -> map (f (extract w)) s)
48 |
49 | here :: forall w. Comonad w => List w ~> w
50 | here (List (Sum _ _ d)) = lowerDay0 (runLazyT d)
51 |
52 | next :: forall w. Comonad w => List w ~> List w
53 | next (List (Sum _ _ d)) = lowerDay1 (runLazyT d)
54 |
55 | push :: forall w. Comonad w => Co (List w) Unit
56 | push = co go where
57 | go :: forall r. List w (Unit -> r) -> r
58 | go l@(List (Sum b _ f)) =
59 | if b then extract f unit
60 | else go (next l)
61 |
62 | listOf :: forall w
63 | . Comonad w
64 | => (Array ReactElement -> ReactElement)
65 | -> Component w
66 | -> Component (List w)
67 | listOf render c = (render <<< _) <$> build identity where
68 | build :: (List w ~> List w) -> List w (Handler (Co (List w) Unit) -> Array ReactElement)
69 | build f =
70 | List
71 | (Sum true
72 | (wrap \_ -> [])
73 | (LazyT
74 | (defer \_ ->
75 | (day append
76 | (map ((pure <<< _) <<< (_ <<< (_ <<< liftWith (here <<< f)))) c)
77 | (build (next <<< f))))))
78 |
79 | liftWith :: (List w ~> w) -> Co w ~> Co (List w)
80 | liftWith f x = co \l -> runCo x (f l)
81 |
--------------------------------------------------------------------------------
/src/React/Explore/Sum.purs:
--------------------------------------------------------------------------------
1 | module React.Explore.Sum
2 | ( Sum(..)
3 | , combine
4 | , moveLeft
5 | , moveRight
6 | , liftLeft
7 | , liftRight
8 | ) where
9 |
10 | import Prelude
11 |
12 | import Control.Comonad (class Comonad, extract)
13 | import Control.Extend (class Extend, extend)
14 | import Data.Functor.Pairing.Co (Co, co, runCo)
15 | import React.Explore (Component)
16 |
17 | -- | The `Sum` of two comonads, which allows us to be in one state or the other
18 | -- | at a time, remembering the other state. We can also move from one state to
19 | -- | the other using the `moveLeft` and `moveRight` actions.
20 | data Sum f g a = Sum Boolean (f a) (g a)
21 |
22 | derive instance functorSum :: (Functor f, Functor g) => Functor (Sum f g)
23 |
24 | instance extendSum :: (Extend f, Extend g) => Extend (Sum f g) where
25 | extend f (Sum b fa ga) =
26 | Sum b (extend (f <<< flip (Sum true) ga) fa) (extend (f <<< Sum false fa) ga)
27 |
28 | instance comonadSum :: (Comonad f, Comonad g) => Comonad (Sum f g) where
29 | extract (Sum true fa _) = extract fa
30 | extract (Sum false _ ga) = extract ga
31 |
32 | -- | Move to the left state.
33 | moveLeft :: forall f g. Comonad f => Co (Sum f g) Unit
34 | moveLeft = co \(Sum _ fa _) -> extract fa unit
35 |
36 | -- | Move to the right state.
37 | moveRight :: forall f g. Comonad g => Co (Sum f g) Unit
38 | moveRight = co \(Sum _ _ ga) -> extract ga unit
39 |
40 | -- | Lift an action to act on the left state.
41 | liftLeft :: forall f g a. Co f a -> Co (Sum f g) a
42 | liftLeft x = co \(Sum _ fa _) -> runCo x fa
43 |
44 | -- | Lift an action to act on the right state.
45 | liftRight :: forall f g a. Co g a -> Co (Sum f g) a
46 | liftRight x = co \(Sum _ _ ga) -> runCo x ga
47 |
48 | -- | Combine two components, starting in the left state.
49 | combine :: forall w1 w2
50 | . Comonad w1
51 | => Comonad w2
52 | => Component w1
53 | -> Component w2
54 | -> Component (Sum w1 w2)
55 | combine c1 c2 =
56 | Sum true
57 | (map (\render send -> render (send <<< liftLeft)) c1)
58 | (map (\render send -> render (send <<< liftRight)) c2)
59 |
--------------------------------------------------------------------------------
/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 |
5 | import Control.Comonad.Cofree (Cofree, buildCofree)
6 | import Control.Comonad.Store (StoreT, store)
7 | import Control.Comonad.Traced (TracedT, traced)
8 | import Control.Monad.Free.Class (wrapFree)
9 | import Control.Monad.State (modify)
10 | import Control.Monad.Writer (tell)
11 | import Data.Functor.Pairing.Co (Co, co)
12 | import Data.Identity (Identity)
13 | import Data.Lazy (Lazy, defer, force)
14 | import Data.Maybe (fromJust)
15 | import Data.Monoid.Additive (Additive(..))
16 | import Data.Tuple (Tuple(..))
17 | import Effect (Effect)
18 | import Partial.Unsafe (unsafePartial)
19 | import React (ReactElement, unsafeCreateLeafElement)
20 | import React.DOM as D
21 | import React.DOM.Props as P
22 | import React.Explore (Component, UI, explore)
23 | import React.Explore.List as List
24 | import React.Explore.Sum as Sum
25 | import ReactDOM (render)
26 | import Web.HTML.HTMLDocument (toNonElementParentNode)
27 | import Web.DOM.NonElementParentNode (getElementById)
28 | import Web.HTML (window)
29 | import Web.HTML.Window (document)
30 |
31 | -- | A counter component implemented using the `Store` comonad.
32 | storeExample :: Component (StoreT Int Identity)
33 | storeExample = store render 0 where
34 | render :: Int -> UI (Co (StoreT Int Identity) Unit)
35 | render count send =
36 | D.div' [ D.p' [ D.text ("State: " <> show count) ]
37 | , D.button [ P.onClick \_ ->
38 | send (void (modify (add 1)))
39 | ]
40 | [ D.text "Increment"
41 | ]
42 | , D.button [ P.onClick \_ ->
43 | send (void (modify (_ `sub` 1)))
44 | ]
45 | [ D.text "Decrement"
46 | ]
47 | ]
48 |
49 | -- | A counter component implemented using the `Traced` comonad.
50 | tracedExample :: Component (TracedT (Additive Int) Identity)
51 | tracedExample = traced render where
52 | render :: Additive Int -> UI (Co (TracedT (Additive Int) Identity) Unit)
53 | render (Additive count) send =
54 | D.div' [ D.p' [ D.text ("State: " <> show count) ]
55 | , D.button [ P.onClick \_ ->
56 | send (tell (Additive 1))
57 | ]
58 | [ D.text "+ 1"
59 | ]
60 | , D.button [ P.onClick \_ ->
61 | send (tell (Additive 10))
62 | ]
63 | [ D.text "+ 10"
64 | ]
65 | , D.button [ P.onClick \_ ->
66 | send (tell (Additive 100))
67 | ]
68 | [ D.text "+ 100"
69 | ]
70 | ]
71 |
72 | -- | A counter component implemented using a `Cofree` comonad.
73 | cofreeExample :: Component (Cofree Lazy)
74 | cofreeExample = buildCofree step 0 where
75 | moveRight :: Co Lazy Unit
76 | moveRight = co \a -> force a unit
77 |
78 | step :: Int -> Tuple (UI (Co (Cofree Lazy) Unit)) (Lazy Int)
79 | step count = Tuple ui (defer \_ -> add count 1) where
80 | ui :: UI (Co (Cofree Lazy) Unit)
81 | ui send =
82 | D.div' [ D.p' [ D.text ("State: " <> show count) ]
83 | , D.button [ P.onClick \_ ->
84 | send (wrapFree (moveRight $> pure unit))
85 | ]
86 | [ D.text "Increment"
87 | ]
88 | ]
89 |
90 | main :: Effect Unit
91 | main = void (elm' >>= render ui) where
92 | together = map addControls
93 | (stores `Sum.combine` tracedExample `Sum.combine` cofreeExample)
94 |
95 | addControls render send =
96 | D.div' [ D.p' [ D.a [ P.onClick \_ -> send (Sum.moveLeft *> Sum.liftLeft Sum.moveLeft)
97 | , P.href "#"
98 | ]
99 | [ D.text "Stores example"
100 | ]
101 | , D.text " — "
102 | , D.a [ P.onClick \_ -> send (Sum.moveLeft *> Sum.liftLeft Sum.moveRight)
103 | , P.href "#"
104 | ]
105 | [ D.text "Traced example"
106 | ]
107 | , D.text " — "
108 | , D.a [ P.onClick \_ -> send Sum.moveRight
109 | , P.href "#"
110 | ]
111 | [ D.text "Cofree example"
112 | ]
113 | ]
114 | , render send
115 | ]
116 |
117 | stores = map withButton (List.listOf D.div' storeExample) where
118 | withButton render send =
119 | D.div' [ D.p' [ D.a [ P.onClick \_ -> send List.push
120 | , P.href "#"
121 | ]
122 | [ D.text "Add Store"
123 | ]
124 | ]
125 | , render send
126 | ]
127 |
128 | ui :: ReactElement
129 | ui = D.div' [ unsafeCreateLeafElement (explore together) {} ]
130 |
131 | elm' = do
132 | win <- window
133 | doc <- document win
134 | elm <- getElementById "example" (toNonElementParentNode doc)
135 | pure $ unsafePartial fromJust elm
136 |
--------------------------------------------------------------------------------