├── .gitignore ├── LICENSE ├── README.md ├── bower.json ├── generated-docs └── Purview.md ├── html └── index.html ├── package.json ├── src └── Purview.purs └── test └── Main.purs /.gitignore: -------------------------------------------------------------------------------- 1 | /html/index.js 2 | /bower_components/ 3 | /node_modules/ 4 | /.pulp-cache/ 5 | /output/ 6 | /.psc-package/ 7 | /.psc* 8 | /.purs* 9 | /.psa* 10 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2018 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 | # Purview 2 | 3 | A proof-of-concept UI library based on the incremental lambda calculus. 4 | 5 | - [Module Documentation](generated-docs/Purview.md) 6 | - [Counter Example](test/Main.purs) 7 | 8 | ## Motivation 9 | 10 | As I've claimed before, [you might not need the virtual DOM](http://blog.functorial.com/posts/2018-03-12-You-Might-Not-Need-The-Virtual-DOM.html). In [purescript-sdom](https://github.com/paf31/purescript-sdom/), I tried to remove the need for the virtual DOM by using types to force parts of the DOM structure to be static, and then exploiting that in order to remove the need for a diff algorithm. 11 | 12 | Here, I take a different approach, where I restrict the rendering function `model -> view` to the class of _incrementalizable functions_. That is, the rendering function must be computable in the regular sense, but it must also tell us how the view _changes_ in response to changes in the model. In this way, we can avoid a diff algorithm, and use the incremental lambda calculus (provided by [purescript-incremental](https://github.com/paf31/purescript-incremental/)) in order to propagate model changes to the DOM. 13 | 14 | The approach here is to provide an unopinionated toolkit which can be used to define a variety of APIs. An example API is provided for reference. See the [module documentation](generated-docs/Purview.md) for an overview of the API. 15 | -------------------------------------------------------------------------------- /bower.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "purescript-purview", 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-purview.git" 13 | }, 14 | "dependencies": { 15 | "purescript-dom-classy": "^2.2.0", 16 | "purescript-incremental-functions": "^1.3.0", 17 | "purescript-refs": "^3.0.0" 18 | }, 19 | "devDependencies": { 20 | "purescript-console": "^3.0.0", 21 | "purescript-psci-support": "^3.0.0", 22 | "purescript-random": "^3.0.0" 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /generated-docs/Purview.md: -------------------------------------------------------------------------------- 1 | ## Module Purview 2 | 3 | #### `View` 4 | 5 | ``` purescript 6 | newtype View eff 7 | ``` 8 | 9 | The (abstract) type of views. 10 | 11 | You can create (incremental) functions returning values of this type by 12 | using the `text` and `element` functions. 13 | 14 | `View`s can be initially rendered to the DOM using the `render` function. 15 | 16 | ##### Instances 17 | ``` purescript 18 | Patch (View eff) (ViewChanges eff) 19 | ``` 20 | 21 | #### `ViewChanges` 22 | 23 | ``` purescript 24 | newtype ViewChanges eff 25 | ``` 26 | 27 | The (abstract) type of view updates. 28 | 29 | `View`s can be applied to the DOM using the `applyPatch` function. 30 | 31 | ##### Instances 32 | ``` purescript 33 | Semigroup (ViewChanges eff) 34 | Monoid (ViewChanges eff) 35 | Patch (View eff) (ViewChanges eff) 36 | ``` 37 | 38 | #### `text` 39 | 40 | ``` purescript 41 | text :: forall eff. Jet (Atomic String) -> Jet (View eff) 42 | ``` 43 | 44 | Create a text node wrapped in a `` element. 45 | 46 | #### `textWith` 47 | 48 | ``` purescript 49 | textWith :: forall eff. String -> Jet (Atomic String) -> Jet (View eff) 50 | ``` 51 | 52 | Create a text node wrapped in an element with the specified name. 53 | 54 | #### `element` 55 | 56 | ``` purescript 57 | element :: forall eff. String -> Jet (IMap String (Atomic String)) -> Jet (IMap String (Atomic (EventListener eff))) -> Jet (IArray (View eff)) -> Jet (View eff) 58 | ``` 59 | 60 | Create an element with the given name, attributes, event listeners and 61 | children. 62 | 63 | #### `element_` 64 | 65 | ``` purescript 66 | element_ :: forall eff. String -> Jet (IArray (View eff)) -> Jet (View eff) 67 | ``` 68 | 69 | Create an element with no attributes or event handlers. 70 | 71 | #### `render` 72 | 73 | ``` purescript 74 | render :: forall eff. Node -> View (dom :: DOM | eff) -> Eff (dom :: DOM | eff) Unit 75 | ``` 76 | 77 | Render a `View` to the DOM, under the given `Node`, and connect any 78 | event listeners. 79 | 80 | Once the initial `View` is rendered, the DOM can be updated using the 81 | `applyPatch` function. 82 | 83 | #### `applyPatch` 84 | 85 | ``` purescript 86 | applyPatch :: forall eff. Element -> View (dom :: DOM | eff) -> ViewChanges (dom :: DOM | eff) -> Eff (dom :: DOM | eff) Unit 87 | ``` 88 | 89 | Apply a set of `ViewChanges` to the DOM, under the given `Node`, which should 90 | be the same as the one initially passed to `render`. 91 | 92 | The second argument is the _most-recently rendered_ `View`, i.e. the one which 93 | should correspond to the current state of the DOM. 94 | 95 | _Note_: in order to correctly remove event listeners, the `View` passed in 96 | must contain the same event listeners as those last attached, _by reference_. 97 | In practice, this means that the `View` passed into this function should be 98 | obtained using the `patch` function. 99 | 100 | See the implementation of the `run` function for an example. 101 | 102 | #### `Component` 103 | 104 | ``` purescript 105 | type Component model eff = Jet (Atomic (Change model -> Eff eff Unit)) -> Jet model -> Jet (View eff) 106 | ``` 107 | 108 | An example component type, used by the `run` function. 109 | 110 | A component takes a changing update function, and a changing `model` 111 | and returns a changing `View`. The update function receives a `Change` to 112 | the model and applies it. 113 | 114 | #### `run` 115 | 116 | ``` purescript 117 | run :: forall model change eff. Patch model change => Element -> Component model (dom :: DOM, ref :: REF | eff) -> model -> Eff (dom :: DOM, ref :: REF | eff) Unit 118 | ``` 119 | 120 | An example implementation of an application loop. 121 | 122 | Renders a `View` to the DOM under the given `Node`. The `View` can depend 123 | on the current value of the `model`, which can change over time by the 124 | application of `Change`s in event handlers. 125 | 126 | 127 | -------------------------------------------------------------------------------- /html/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Counter Example 5 | 29 | 30 | 31 |
32 |

Counter Example

33 | 34 |
35 |
36 |
37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "private": true, 3 | "scripts": { 4 | "clean": "rimraf output && rimraf .pulp-cache", 5 | "build": "pulp build", 6 | "example": "pulp test -r cat > html/index.js && open html/index.html" 7 | }, 8 | "devDependencies": { 9 | "pulp": "^11.0.0", 10 | "purescript-psa": "^0.5.0", 11 | "purescript": "^0.11.1", 12 | "rimraf": "^2.5.4" 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /src/Purview.purs: -------------------------------------------------------------------------------- 1 | module Purview 2 | ( View 3 | , ViewChanges 4 | , text 5 | , textWith 6 | , element 7 | , element_ 8 | , render 9 | , applyPatch 10 | , Component 11 | , run 12 | ) where 13 | 14 | import Prelude 15 | 16 | import Control.Monad.Eff (Eff) 17 | import Control.Monad.Eff.Ref (REF, newRef, readRef, writeRef) 18 | import DOM (DOM) 19 | import DOM.Classy.Element (appendChild, insertBefore, removeAttribute, removeChild, setAttribute, setTextContent) 20 | import DOM.Classy.Event.EventTarget (EventListener, addEventListener, removeEventListener) 21 | import DOM.Classy.Node (toNode) 22 | import DOM.Classy.ParentNode (children, firstElementChild) 23 | import DOM.HTML (window) 24 | import DOM.HTML.Types (htmlDocumentToDocument) 25 | import DOM.HTML.Window (document) 26 | import DOM.Node.Document (createDocumentFragment, createElement, createTextNode) 27 | import DOM.Node.HTMLCollection (item) 28 | import DOM.Node.Types (Element, Node, documentFragmentToNode, textToNode) 29 | import Data.Array (foldM, (!!)) 30 | import Data.Foldable (sequence_, traverse_) 31 | import Data.Incremental (class Patch, Change, Jet, constant, fromChange, patch, toChange) 32 | import Data.Incremental.Array (ArrayChange(..), IArray) 33 | import Data.Incremental.Eq (Atomic) 34 | import Data.Incremental.Map (MapChange(..), MapChanges, IMap) 35 | import Data.Map (empty, lookup, mapWithKey) 36 | import Data.Maybe (Maybe(..)) 37 | import Data.Maybe.Last (Last) 38 | import Data.Monoid (class Monoid, mempty) 39 | import Data.Newtype (unwrap, wrap) 40 | import Partial.Unsafe (unsafeCrashWith) 41 | 42 | -- | The (abstract) type of views. 43 | -- | 44 | -- | You can create (incremental) functions returning values of this type by 45 | -- | using the `text` and `element` functions. 46 | -- | 47 | -- | `View`s can be initially rendered to the DOM using the `render` function. 48 | newtype View eff = View 49 | { element :: String 50 | , text :: Atomic String 51 | , attrs :: IMap String (Atomic String) 52 | , handlers :: IMap String (Atomic (EventListener eff)) 53 | , kids :: IArray (View eff) 54 | } 55 | 56 | -- | The (abstract) type of view updates. 57 | -- | 58 | -- | `View`s can be applied to the DOM using the `applyPatch` function. 59 | newtype ViewChanges eff = ViewChanges 60 | { text :: Last String 61 | , attrs :: MapChanges String (Atomic String) (Last String) 62 | , handlers :: MapChanges String (Atomic (EventListener eff)) (Last (EventListener eff)) 63 | , kids :: Array (ArrayChange (View eff) (ViewChanges eff)) 64 | } 65 | 66 | instance semigroupViewChanges :: Semigroup (ViewChanges eff) where 67 | append (ViewChanges a) (ViewChanges b) = 68 | ViewChanges 69 | { text: a.text <> b.text 70 | , attrs: a.attrs <> b.attrs 71 | , handlers: a.handlers <> b.handlers 72 | , kids: a.kids <> b.kids 73 | } 74 | 75 | instance monoidViewChanges :: Monoid (ViewChanges eff) where 76 | mempty = ViewChanges { text: mempty, attrs: mempty, handlers: mempty, kids: mempty } 77 | 78 | instance patchView :: Patch (View eff) (ViewChanges eff) where 79 | patch (View v) (ViewChanges vc) = 80 | View v { text = patch v.text vc.text 81 | , attrs = patch v.attrs vc.attrs 82 | , handlers = patch v.handlers vc.handlers 83 | , kids = patch v.kids vc.kids 84 | } 85 | 86 | view_ 87 | :: forall eff 88 | . String 89 | -> Jet (Atomic String) 90 | -> Jet (IMap String (Atomic String)) 91 | -> Jet (IMap String (Atomic (EventListener eff))) 92 | -> Jet (IArray (View eff)) 93 | -> Jet (View eff) 94 | view_ elName text_ attrs handlers kids = 95 | { position: View 96 | { element: elName 97 | , text: text_.position 98 | , attrs: attrs.position 99 | , handlers: handlers.position 100 | , kids: kids.position 101 | } 102 | , velocity: toChange $ ViewChanges 103 | { text: fromChange text_.velocity 104 | , attrs: fromChange attrs.velocity 105 | , handlers: fromChange handlers.velocity 106 | , kids: fromChange kids.velocity 107 | } 108 | } 109 | 110 | -- | Create a text node wrapped in an element with the specified name. 111 | textWith :: forall eff. String -> Jet (Atomic String) -> Jet (View eff) 112 | textWith elName s = view_ elName s (constant (wrap empty)) (constant (wrap empty)) (constant (wrap [])) 113 | 114 | -- | Create a text node wrapped in a `` element. 115 | text :: forall eff. Jet (Atomic String) -> Jet (View eff) 116 | text = textWith "span" 117 | 118 | -- | Create an element with the given name, attributes, event listeners and 119 | -- | children. 120 | element 121 | :: forall eff 122 | . String 123 | -> Jet (IMap String (Atomic String)) 124 | -> Jet (IMap String (Atomic (EventListener eff))) 125 | -> Jet (IArray (View eff)) 126 | -> Jet (View eff) 127 | element elName = view_ elName (constant (wrap "")) 128 | 129 | -- | Create an element with no attributes or event handlers. 130 | element_ 131 | :: forall eff 132 | . String 133 | -> Jet (IArray (View eff)) 134 | -> Jet (View eff) 135 | element_ elName kids = view_ elName (constant (wrap "")) (constant (wrap empty)) (constant (wrap empty)) kids 136 | 137 | -- | Render a `View` to the DOM, under the given `Node`, and connect any 138 | -- | event listeners. 139 | -- | 140 | -- | Once the initial `View` is rendered, the DOM can be updated using the 141 | -- | `applyPatch` function. 142 | render 143 | :: forall eff 144 | . Node 145 | -> View (dom :: DOM | eff) 146 | -> Eff (dom :: DOM | eff) Unit 147 | render n (View v) = do 148 | doc <- window >>= document >>> map htmlDocumentToDocument 149 | ne <- createElement v.element doc 150 | tn <- createTextNode (unwrap v.text) doc 151 | _ <- appendChild (textToNode tn) ne 152 | sequence_ (mapWithKey (\k s -> setAttribute k (unwrap s) ne) (unwrap v.attrs)) 153 | sequence_ (mapWithKey (\k h -> addEventListener (wrap k) (unwrap h) false ne) (unwrap v.handlers)) 154 | traverse_ (render (toNode ne)) (unwrap v.kids) 155 | _ <- appendChild ne n 156 | pure unit 157 | 158 | -- | Apply a set of `ViewChanges` to the DOM, under the given `Node`, which should 159 | -- | be the same as the one initially passed to `render`. 160 | -- | 161 | -- | The second argument is the _most-recently rendered_ `View`, i.e. the one which 162 | -- | should correspond to the current state of the DOM. 163 | -- | 164 | -- | _Note_: in order to correctly remove event listeners, the `View` passed in 165 | -- | must contain the same event listeners as those last attached, _by reference_. 166 | -- | In practice, this means that the `View` passed into this function should be 167 | -- | obtained using the `patch` function. 168 | -- | 169 | -- | See the implementation of the `run` function for an example. 170 | applyPatch 171 | :: forall eff 172 | . Element 173 | -> View (dom :: DOM | eff) 174 | -> ViewChanges (dom :: DOM | eff) 175 | -> Eff (dom :: DOM | eff) Unit 176 | applyPatch e vv@(View v) (ViewChanges vc) = do 177 | _ <- traverse_ (_ `setTextContent` e) vc.text 178 | sequence_ (mapWithKey updateAttr (unwrap vc.attrs)) 179 | sequence_ (mapWithKey updateHandler (unwrap vc.handlers)) 180 | void $ foldM updateChildren v.kids vc.kids 181 | where 182 | updateAttr 183 | :: String 184 | -> MapChange (Atomic String) (Last String) 185 | -> Eff (dom :: DOM | eff) Unit 186 | updateAttr k (Add val) = setAttribute k (unwrap val) e 187 | updateAttr k Remove = removeAttribute k e 188 | updateAttr k (Update u) = traverse_ (\s -> setAttribute k s e) (unwrap u) 189 | 190 | updateHandler 191 | :: String 192 | -> MapChange (Atomic (EventListener (dom :: DOM | eff))) (Last (EventListener (dom :: DOM | eff))) 193 | -> Eff (dom :: DOM | eff) Unit 194 | updateHandler k (Add h) = do 195 | addEventListener (wrap k) (unwrap h) false e 196 | updateHandler k Remove = do 197 | lookup k (unwrap v.handlers) # traverse_ \h -> 198 | removeEventListener (wrap k) (unwrap h) false e 199 | updateHandler k (Update dh) = dh # traverse_ \new -> do 200 | lookup k (unwrap v.handlers) # traverse_ \old -> 201 | removeEventListener (wrap k) (unwrap old) false e 202 | addEventListener (wrap k) new false e 203 | 204 | updateChildren 205 | :: IArray (View (dom :: DOM | eff)) 206 | -> ArrayChange (View (dom :: DOM | eff)) (ViewChanges (dom :: DOM | eff)) 207 | -> Eff (dom :: DOM | eff) (IArray (View (dom :: DOM | eff))) 208 | updateChildren kids ch@(InsertAt i vw) = do 209 | doc <- window >>= document >>> map htmlDocumentToDocument 210 | cs <- children e 211 | mc <- item i cs 212 | newNode <- documentFragmentToNode <$> createDocumentFragment doc 213 | render newNode vw 214 | _ <- case mc of 215 | Just c -> insertBefore newNode c e 216 | Nothing -> appendChild newNode e 217 | pure (patch kids [ch]) 218 | updateChildren kids ch@(DeleteAt i) = do 219 | cs <- children e 220 | mc <- item i cs 221 | case mc of 222 | Just c -> void (removeChild c e) 223 | Nothing -> pure unit 224 | pure (patch kids [ch]) 225 | updateChildren kids ch@(ModifyAt i dv) = do 226 | cs <- children e 227 | mc <- item i cs 228 | mc # traverse_ \c -> 229 | unwrap kids !! i # traverse_ \cv -> 230 | applyPatch c cv dv 231 | pure (patch kids [ch]) 232 | 233 | -- | An example component type, used by the `run` function. 234 | -- | 235 | -- | A component takes a changing update function, and a changing `model` 236 | -- | and returns a changing `View`. The update function receives a `Change` to 237 | -- | the model and applies it. 238 | type Component model eff 239 | = Jet (Atomic (Change model -> Eff eff Unit)) 240 | -> Jet model 241 | -> Jet (View eff) 242 | 243 | -- | An example implementation of an application loop. 244 | -- | 245 | -- | Renders a `View` to the DOM under the given `Node`. The `View` can depend 246 | -- | on the current value of the `model`, which can change over time by the 247 | -- | application of `Change`s in event handlers. 248 | run 249 | :: forall model change eff 250 | . Patch model change 251 | => Element 252 | -> Component model (dom :: DOM, ref :: REF | eff) 253 | -> model 254 | -> Eff (dom :: DOM, ref :: REF | eff) Unit 255 | run root component initialModel = do 256 | modelRef <- newRef initialModel 257 | viewRef <- newRef Nothing 258 | document <- window >>= document 259 | let initialView = (component (constant (wrap onChange)) (constant initialModel)).position 260 | onChange modelChange = do 261 | currentModel <- readRef modelRef 262 | currentView_ <- readRef viewRef 263 | case currentView_ of 264 | Nothing -> unsafeCrashWith "viewRef was empty" 265 | Just currentView -> do 266 | let newModel = patch currentModel (fromChange modelChange) 267 | patches = updater currentModel modelChange 268 | -- Compute and store the new view based on the patch we are about 269 | -- to apply. This way, we can use the stored view to detach event 270 | -- handlers correctly later, if necessary. 271 | newView = patch currentView patches 272 | writeRef modelRef newModel 273 | writeRef viewRef (Just newView) 274 | firstElementChild root >>= traverse_ \e -> 275 | applyPatch e currentView patches 276 | updater m dm = fromChange (component (constant (wrap onChange)) { position: m, velocity: dm }).velocity 277 | writeRef viewRef (Just initialView) 278 | render (toNode root) initialView 279 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | 5 | import Control.Monad.Eff (Eff) 6 | import Control.Monad.Eff.Console (CONSOLE, log) 7 | import Control.Monad.Eff.Ref (REF) 8 | import DOM (DOM) 9 | import DOM.Event.EventTarget (eventListener) 10 | import DOM.HTML (window) 11 | import DOM.HTML.Types (htmlDocumentToNonElementParentNode) 12 | import DOM.HTML.Window (document) 13 | import DOM.Node.NonElementParentNode (getElementById) 14 | import Data.Incremental (class Patch, constant) 15 | import Data.Incremental.Array (IArray) 16 | import Data.Incremental.Array as IArray 17 | import Data.Incremental.Eq (Atomic) 18 | import Data.Incremental.Eq as Atomic 19 | import Data.Incremental.Map as IMap 20 | import Data.Maybe (Maybe(..)) 21 | import Data.Monoid (mempty) 22 | import Data.Newtype (wrap) 23 | import Purview (Component, element, element_, run, text) 24 | 25 | type Counter = Atomic Int 26 | 27 | counter :: forall eff. Component Counter eff 28 | counter change model = 29 | element "button" (constant (wrap mempty)) 30 | -- ^ a