├── .gitignore
├── package.json
├── src
└── Halogen
│ ├── VDom.purs
│ └── VDom
│ ├── Machine.purs
│ ├── Types.purs
│ ├── Util.js
│ ├── Thunk.purs
│ ├── Util.purs
│ ├── DOM
│ └── Prop.purs
│ └── DOM.purs
├── index.html
├── test
├── Main.js
└── Main.purs
├── .github
└── workflows
│ └── ci.yml
├── bower.json
├── README.md
├── GUIDE.md
└── LICENSE
/.gitignore:
--------------------------------------------------------------------------------
1 | /.*
2 | !/.gitignore
3 | !/.eslintrc.json
4 | !/.github/
5 | package-lock.json
6 | /bower_components/
7 | /node_modules/
8 | /output/
9 |
--------------------------------------------------------------------------------
/package.json:
--------------------------------------------------------------------------------
1 | {
2 | "private": true,
3 | "scripts": {
4 | "clean": "rimraf output && rimraf",
5 | "test": "pulp build -I test -- --censor-lib --strict",
6 | "build": "pulp build -- --censor-lib --strict"
7 | },
8 | "devDependencies": {
9 | "pulp": "^16.0.0-0",
10 | "purescript-psa": "^0.8.2",
11 | "rimraf": "^3.0.2"
12 | }
13 | }
14 |
--------------------------------------------------------------------------------
/src/Halogen/VDom.purs:
--------------------------------------------------------------------------------
1 | module Halogen.VDom
2 | ( module DOM
3 | , module Machine
4 | , module Types
5 | ) where
6 |
7 | import Halogen.VDom.DOM (VDomSpec(..), buildVDom) as DOM
8 | import Halogen.VDom.Machine (Machine, Step, Step'(..), mkStep, unStep, extract, step, halt) as Machine
9 | import Halogen.VDom.Types (VDom(..), Graft, runGraft, ElemName(..), Namespace(..)) as Types
10 |
--------------------------------------------------------------------------------
/index.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 | dbmon (halogen-vdom)
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
--------------------------------------------------------------------------------
/test/Main.js:
--------------------------------------------------------------------------------
1 | export function getData() {
2 | return ENV.generateData().toArray();
3 | }
4 |
5 | export function getTimeout() {
6 | return ENV.timeout;
7 | }
8 |
9 | export function pingRenderRate() {
10 | Monitoring.renderRate.ping();
11 | }
12 |
13 | export function setTimeout(ms) {
14 | return function (fn) {
15 | return function () {
16 | return setTimeout(fn, ms);
17 | };
18 | };
19 | }
20 |
21 | export function requestAnimationFrame(f) {
22 | return function () {
23 | window.requestAnimationFrame(function () {
24 | f();
25 | });
26 | };
27 | }
28 |
--------------------------------------------------------------------------------
/.github/workflows/ci.yml:
--------------------------------------------------------------------------------
1 | name: CI
2 |
3 | on:
4 | push:
5 | branches: [master]
6 | pull_request:
7 |
8 | jobs:
9 | build:
10 | runs-on: ubuntu-latest
11 | steps:
12 | - uses: actions/checkout@v2
13 |
14 | - uses: purescript-contrib/setup-purescript@main
15 | with:
16 | purescript: "unstable"
17 |
18 | - uses: actions/setup-node@v2
19 | with:
20 | node-version: "14"
21 |
22 | - name: Install dependencies
23 | run: |
24 | npm install -g bower
25 | npm install
26 | bower install --production
27 |
28 | - name: Build source
29 | run: npm run-script build
30 |
31 | - name: Run tests
32 | run: |
33 | bower install
34 | npm run-script test --if-present
35 |
--------------------------------------------------------------------------------
/bower.json:
--------------------------------------------------------------------------------
1 | {
2 | "name": "purescript-halogen-vdom",
3 | "homepage": "https://github.com/purescript-halogen/purescript-halogen-vdom",
4 | "authors": ["Nathan Faubion "],
5 | "description": "An extensible virtial-dom library for PureScript",
6 | "keywords": ["purescript", "halogen", "virtual-dom"],
7 | "repository": {
8 | "type": "git",
9 | "url": "https://github.com/purescript-halogen/purescript-halogen-vdom.git"
10 | },
11 | "license": "Apache-2.0",
12 | "ignore": ["**/.*", "node_modules", "bower_components", "output"],
13 | "dependencies": {
14 | "purescript-prelude": "^6.0.0",
15 | "purescript-effect": "^4.0.0",
16 | "purescript-tuples": "^7.0.0",
17 | "purescript-web-html": "^4.0.0",
18 | "purescript-foreign-object": "^4.0.0",
19 | "purescript-maybe": "^6.0.0",
20 | "purescript-unsafe-coerce": "^6.0.0",
21 | "purescript-bifunctors": "^6.0.0",
22 | "purescript-refs": "^6.0.0",
23 | "purescript-foreign": "^7.0.0"
24 | },
25 | "devDependencies": {
26 | "purescript-exists": "^6.0.0"
27 | }
28 | }
29 |
--------------------------------------------------------------------------------
/src/Halogen/VDom/Machine.purs:
--------------------------------------------------------------------------------
1 | module Halogen.VDom.Machine
2 | ( Machine
3 | , Step'(..)
4 | , Step
5 | , mkStep
6 | , unStep
7 | , extract
8 | , step
9 | , halt
10 | ) where
11 |
12 | import Prelude
13 |
14 | import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2)
15 | import Unsafe.Coerce (unsafeCoerce)
16 |
17 | type Machine a b = EffectFn1 a (Step a b)
18 |
19 | data Step' a b s = Step b s (EffectFn2 s a (Step a b)) (EffectFn1 s Unit)
20 |
21 | foreign import data Step ∷ Type → Type → Type
22 |
23 | mkStep ∷ ∀ a b s. Step' a b s → Step a b
24 | mkStep = unsafeCoerce
25 |
26 | unStep :: ∀ a b r. (∀ s. Step' a b s → r) → Step a b → r
27 | unStep = unsafeCoerce
28 |
29 | -- | Returns the output value of a `Step`.
30 | extract ∷ ∀ a b. Step a b → b
31 | extract = unStep \(Step x _ _ _) → x
32 |
33 | -- | Runs the next step.
34 | step ∷ ∀ a b. EffectFn2 (Step a b) a (Step a b)
35 | step = coerce $ mkEffectFn2 \(Step _ s k _) a → runEffectFn2 k s a
36 | where
37 | coerce ∷ ∀ s. EffectFn2 (Step' a b s) a (Step a b) → EffectFn2 (Step a b) a (Step a b)
38 | coerce = unsafeCoerce
39 |
40 | -- | Runs the finalizer associated with a `Step`
41 | halt ∷ ∀ a b. EffectFn1 (Step a b) Unit
42 | halt = coerce $ mkEffectFn1 \(Step _ s _ k) → runEffectFn1 k s
43 | where
44 | coerce ∷ ∀ s. EffectFn1 (Step' a b s) Unit → EffectFn1 (Step a b) Unit
45 | coerce = unsafeCoerce
46 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | # purescript-halogen-vdom
2 |
3 | [](https://github.com/purescript-halogen/purescript-halogen-vdom/releases)
4 | [](https://github.com/purescript-halogen/purescript-halogen-vdom/actions?query=workflow%3ACI+branch%3Amaster)
5 | [](https://pursuit.purescript.org/packages/purescript-halogen-vdom)
6 |
7 | An extensible virtual-dom library for PureScript.
8 |
9 | ## Installation
10 |
11 | Install with Spago:
12 |
13 | ```
14 | spago install halogen-vdom
15 | ```
16 |
17 | ## Quick Start
18 |
19 | You can get started with `halogen-vdom` with these resources:
20 |
21 | - Read the [guide](./GUIDE.md).
22 | - See the [test example](./test/Main.purs).
23 |
24 | ## Overview
25 |
26 | `Halogen.VDom` is a bare-bones virtual-dom library for PureScript with inspiration drawn from:
27 |
28 | - https://github.com/Matt-Esch/virtual-dom
29 | - https://github.com/paldepind/snabbdom
30 | - https://github.com/elm-lang/virtual-dom
31 |
32 | Its goals include:
33 |
34 | 1. Use as little FFI as possible.
35 | 2. Be as fast as possible given (1).
36 | 3. Be extensible.
37 |
38 | Notably, `Halogen.VDom` is largely useless out of the box. You'll need to bring your own attributes, properties, and event listeners (though there is a working implementation included). It is intended to be extended (and likely `newtype`d) by other frameworks to suit their needs.
39 |
--------------------------------------------------------------------------------
/src/Halogen/VDom/Types.purs:
--------------------------------------------------------------------------------
1 | module Halogen.VDom.Types
2 | ( VDom(..)
3 | , renderWidget
4 | , Graft
5 | , GraftX(..)
6 | , graft
7 | , unGraft
8 | , runGraft
9 | , ElemName(..)
10 | , Namespace(..)
11 | ) where
12 |
13 | import Prelude
14 | import Data.Bifunctor (class Bifunctor, bimap)
15 | import Data.Maybe (Maybe)
16 | import Data.Newtype (class Newtype)
17 | import Data.Tuple (Tuple)
18 | import Unsafe.Coerce (unsafeCoerce)
19 |
20 | -- | The core virtual-dom tree type, where `a` is the type of attributes,
21 | -- | and `w` is the type of "widgets". Widgets are machines that have complete
22 | -- | control over the lifecycle of some `DOM.Node`.
23 | -- |
24 | -- | The `Grafted` constructor and associated machinery enables `bimap`
25 | -- | fusion using a Coyoneda-like encoding.
26 | data VDom a w
27 | = Text String
28 | | Elem (Maybe Namespace) ElemName a (Array (VDom a w))
29 | | Keyed (Maybe Namespace) ElemName a (Array (Tuple String (VDom a w)))
30 | | Widget w
31 | | Grafted (Graft a w)
32 |
33 | instance functorVDom ∷ Functor (VDom a) where
34 | map _ (Text a) = Text a
35 | map g (Grafted a) = Grafted (map g a)
36 | map g a = Grafted (graft (Graft identity g a))
37 |
38 | instance bifunctorVDom ∷ Bifunctor VDom where
39 | bimap _ _ (Text a) = Text a
40 | bimap f g (Grafted a) = Grafted (bimap f g a)
41 | bimap f g a = Grafted (graft (Graft f g a))
42 |
43 | -- | Replaces "widgets" in the `VDom` with the ability to turn them into other
44 | -- | `VDom` nodes.
45 | -- |
46 | -- | Using this function will fuse any `Graft`s present in the `VDom`.
47 | renderWidget ∷ ∀ a b w x. (a → b) → (w → VDom b x) → VDom a w → VDom b x
48 | renderWidget f g = case _ of
49 | Text a → Text a
50 | Elem ns n a ch → Elem ns n (f a) (map (renderWidget f g) ch)
51 | Keyed ns n a ch → Keyed ns n (f a) (map (map (renderWidget f g)) ch)
52 | Widget w → g w
53 | Grafted gaw → renderWidget f g (runGraft gaw)
54 |
55 | foreign import data Graft ∷ Type → Type → Type
56 |
57 | instance functorGraft ∷ Functor (Graft a) where
58 | map g = unGraft \(Graft f' g' a) → graft (Graft f' (g <<< g') a)
59 |
60 | instance bifunctorGraft ∷ Bifunctor Graft where
61 | bimap f g = unGraft \(Graft f' g' a) → graft (Graft (f <<< f') (g <<< g') a)
62 |
63 | data GraftX a a' w w' =
64 | Graft (a → a') (w → w') (VDom a w)
65 |
66 | graft
67 | ∷ ∀ a a' w w'
68 | . GraftX a a' w w'
69 | → Graft a' w'
70 | graft = unsafeCoerce
71 |
72 | unGraft
73 | ∷ ∀ a' w' r
74 | . (∀ a w. GraftX a a' w w' → r)
75 | → Graft a' w'
76 | → r
77 | unGraft f = f <<< unsafeCoerce
78 |
79 | runGraft
80 | ∷ ∀ a' w'
81 | . Graft a' w'
82 | → VDom a' w'
83 | runGraft =
84 | unGraft \(Graft fa fw v) →
85 | let
86 | go (Text s) = Text s
87 | go (Elem ns n a ch) = Elem ns n (fa a) (map go ch)
88 | go (Keyed ns n a ch) = Keyed ns n (fa a) (map (map go) ch)
89 | go (Widget w) = Widget (fw w)
90 | go (Grafted g) = Grafted (bimap fa fw g)
91 | in
92 | go v
93 |
94 | newtype ElemName = ElemName String
95 |
96 | derive instance newtypeElemName ∷ Newtype ElemName _
97 | derive newtype instance eqElemName ∷ Eq ElemName
98 | derive newtype instance ordElemName ∷ Ord ElemName
99 |
100 | newtype Namespace = Namespace String
101 |
102 | derive instance newtypeNamespace ∷ Newtype Namespace _
103 | derive newtype instance eqNamespace ∷ Eq Namespace
104 | derive newtype instance ordNamespace ∷ Ord Namespace
105 |
--------------------------------------------------------------------------------
/src/Halogen/VDom/Util.js:
--------------------------------------------------------------------------------
1 | "use strict";
2 |
3 | export function unsafeGetAny(key, obj) {
4 | return obj[key];
5 | }
6 |
7 | export function unsafeHasAny(key, obj) {
8 | return obj.hasOwnProperty(key);
9 | }
10 |
11 | export function unsafeSetAny(key, val, obj) {
12 | obj[key] = val;
13 | }
14 |
15 | export function unsafeDeleteAny(key, obj) {
16 | delete obj[key];
17 | }
18 |
19 | export function forE(a, f) {
20 | var b = [];
21 | for (var i = 0; i < a.length; i++) {
22 | b.push(f(i, a[i]));
23 | }
24 | return b;
25 | }
26 |
27 | export function forEachE(a, f) {
28 | for (var i = 0; i < a.length; i++) {
29 | f(a[i]);
30 | }
31 | }
32 |
33 | export function forInE(o, f) {
34 | var ks = Object.keys(o);
35 | for (var i = 0; i < ks.length; i++) {
36 | var k = ks[i];
37 | f(k, o[k]);
38 | }
39 | }
40 |
41 | export function replicateE(n, f) {
42 | for (var i = 0; i < n; i++) {
43 | f();
44 | }
45 | }
46 |
47 | export function diffWithIxE(a1, a2, f1, f2, f3) {
48 | var a3 = [];
49 | var l1 = a1.length;
50 | var l2 = a2.length;
51 | var i = 0;
52 | while (1) {
53 | if (i < l1) {
54 | if (i < l2) {
55 | a3.push(f1(i, a1[i], a2[i]));
56 | } else {
57 | f2(i, a1[i]);
58 | }
59 | } else if (i < l2) {
60 | a3.push(f3(i, a2[i]));
61 | } else {
62 | break;
63 | }
64 | i++;
65 | }
66 | return a3;
67 | }
68 |
69 | export function strMapWithIxE(as, fk, f) {
70 | var o = {};
71 | for (var i = 0; i < as.length; i++) {
72 | var a = as[i];
73 | var k = fk(a);
74 | o[k] = f(k, i, a);
75 | }
76 | return o;
77 | }
78 |
79 | export function diffWithKeyAndIxE(o1, as, fk, f1, f2, f3) {
80 | var o2 = {};
81 | for (var i = 0; i < as.length; i++) {
82 | var a = as[i];
83 | var k = fk(a);
84 | if (o1.hasOwnProperty(k)) {
85 | o2[k] = f1(k, i, o1[k], a);
86 | } else {
87 | o2[k] = f3(k, i, a);
88 | }
89 | }
90 | for (var k in o1) {
91 | if (k in o2) {
92 | continue;
93 | }
94 | f2(k, o1[k]);
95 | }
96 | return o2;
97 | }
98 |
99 | export function refEq(a, b) {
100 | return a === b;
101 | }
102 |
103 | export function createTextNode(s, doc) {
104 | return doc.createTextNode(s);
105 | }
106 |
107 | export function setTextContent(s, n) {
108 | n.textContent = s;
109 | }
110 |
111 | export function createElement(ns, name, doc) {
112 | if (ns != null) {
113 | return doc.createElementNS(ns, name);
114 | } else {
115 | return doc.createElement(name)
116 | }
117 | }
118 |
119 | export function insertChildIx(i, a, b) {
120 | var n = b.childNodes.item(i) || null;
121 | if (n !== a) {
122 | b.insertBefore(a, n);
123 | }
124 | }
125 |
126 | export function removeChild(a, b) {
127 | if (b && a.parentNode === b) {
128 | b.removeChild(a);
129 | }
130 | }
131 |
132 | export function parentNode(a) {
133 | return a.parentNode;
134 | }
135 |
136 | export function setAttribute(ns, attr, val, el) {
137 | if (ns != null) {
138 | el.setAttributeNS(ns, attr, val);
139 | } else {
140 | el.setAttribute(attr, val);
141 | }
142 | }
143 |
144 | export function removeAttribute(ns, attr, el) {
145 | if (ns != null) {
146 | el.removeAttributeNS(ns, attr);
147 | } else {
148 | el.removeAttribute(attr);
149 | }
150 | }
151 |
152 | export function hasAttribute(ns, attr, el) {
153 | if (ns != null) {
154 | return el.hasAttributeNS(ns, attr);
155 | } else {
156 | return el.hasAttribute(attr);
157 | }
158 | }
159 |
160 | export function addEventListener(ev, listener, el) {
161 | el.addEventListener(ev, listener, false);
162 | }
163 |
164 | export function removeEventListener(ev, listener, el) {
165 | el.removeEventListener(ev, listener, false);
166 | }
167 |
168 | export var jsUndefined = void 0;
169 |
--------------------------------------------------------------------------------
/src/Halogen/VDom/Thunk.purs:
--------------------------------------------------------------------------------
1 | module Halogen.VDom.Thunk
2 | ( Thunk
3 | , buildThunk
4 | , runThunk
5 | , hoist
6 | , mapThunk
7 | , thunked
8 | , thunk1
9 | , thunk2
10 | , thunk3
11 | ) where
12 |
13 | import Prelude
14 |
15 | import Data.Function.Uncurried as Fn
16 | import Effect.Uncurried as EFn
17 | import Halogen.VDom as V
18 | import Halogen.VDom.Machine as M
19 | import Halogen.VDom.Util as Util
20 | import Unsafe.Coerce (unsafeCoerce)
21 | import Web.DOM.Node (Node)
22 |
23 | foreign import data ThunkArg ∷ Type
24 |
25 | foreign import data ThunkId ∷ Type
26 |
27 | data Thunk :: (Type -> Type) -> Type -> Type
28 | data Thunk f i = Thunk ThunkId (Fn.Fn2 ThunkArg ThunkArg Boolean) (ThunkArg → f i) ThunkArg
29 |
30 | unsafeThunkId ∷ ∀ a. a → ThunkId
31 | unsafeThunkId = unsafeCoerce
32 |
33 | instance functorThunk ∷ Functor f ⇒ Functor (Thunk f) where
34 | map f (Thunk a b c d) = Thunk a b (c >>> map f) d
35 |
36 | hoist ∷ ∀ f g. (f ~> g) → Thunk f ~> Thunk g
37 | hoist = mapThunk
38 |
39 | mapThunk ∷ ∀ f g i j. (f i -> g j) → Thunk f i -> Thunk g j
40 | mapThunk k (Thunk a b c d) = Thunk a b (c >>> k) d
41 |
42 | thunk ∷ ∀ a f i. Fn.Fn4 ThunkId (Fn.Fn2 a a Boolean) (a → f i) a (Thunk f i)
43 | thunk = Fn.mkFn4 \tid eqFn f a →
44 | Thunk tid
45 | (unsafeCoerce eqFn ∷ Fn.Fn2 ThunkArg ThunkArg Boolean)
46 | (unsafeCoerce f ∷ ThunkArg → f i)
47 | (unsafeCoerce a ∷ ThunkArg)
48 |
49 | thunked ∷ ∀ a f i. (a → a → Boolean) → (a → f i) → a → Thunk f i
50 | thunked eqFn f =
51 | let
52 | tid = unsafeThunkId { f }
53 | eqFn' = Fn.mkFn2 eqFn
54 | in
55 | \a → Fn.runFn4 thunk tid eqFn' f a
56 |
57 | thunk1 ∷ ∀ a f i. Fn.Fn2 (a → f i) a (Thunk f i)
58 | thunk1 = Fn.mkFn2 \f a → Fn.runFn4 thunk (unsafeThunkId f) Util.refEq f a
59 |
60 | thunk2 ∷ ∀ a b f i. Fn.Fn3 (a → b → f i) a b (Thunk f i)
61 | thunk2 =
62 | let
63 | eqFn = Fn.mkFn2 \a b →
64 | Fn.runFn2 Util.refEq a._1 b._1 &&
65 | Fn.runFn2 Util.refEq a._2 b._2
66 | in
67 | Fn.mkFn3 \f a b →
68 | Fn.runFn4 thunk (unsafeThunkId f) eqFn (\{ _1, _2 } → f _1 _2) { _1: a, _2: b }
69 |
70 | thunk3 ∷ ∀ a b c f i. Fn.Fn4 (a → b → c → f i) a b c (Thunk f i)
71 | thunk3 =
72 | let
73 | eqFn = Fn.mkFn2 \a b →
74 | Fn.runFn2 Util.refEq a._1 b._1 &&
75 | Fn.runFn2 Util.refEq a._2 b._2 &&
76 | Fn.runFn2 Util.refEq a._3 b._3
77 | in
78 | Fn.mkFn4 \f a b c →
79 | Fn.runFn4 thunk (unsafeThunkId f) eqFn (\{ _1, _2, _3 } → f _1 _2 _3) { _1: a, _2: b, _3: c }
80 |
81 | runThunk ∷ ∀ f i. Thunk f i → f i
82 | runThunk (Thunk _ _ render arg) = render arg
83 |
84 | unsafeEqThunk ∷ ∀ f i. Fn.Fn2 (Thunk f i) (Thunk f i) Boolean
85 | unsafeEqThunk = Fn.mkFn2 \(Thunk a1 b1 _ d1) (Thunk a2 b2 _ d2) →
86 | Fn.runFn2 Util.refEq a1 a2 &&
87 | Fn.runFn2 Util.refEq b1 b2 &&
88 | Fn.runFn2 b1 d1 d2
89 |
90 | type ThunkState :: (Type -> Type) -> Type -> Type -> Type -> Type
91 | type ThunkState f i a w =
92 | { thunk ∷ Thunk f i
93 | , vdom ∷ M.Step (V.VDom a w) Node
94 | }
95 |
96 | buildThunk
97 | ∷ ∀ f i a w
98 | . (f i → V.VDom a w)
99 | → V.VDomSpec a w
100 | → V.Machine (Thunk f i) Node
101 | buildThunk toVDom = renderThunk
102 | where
103 | renderThunk ∷ V.VDomSpec a w → V.Machine (Thunk f i) Node
104 | renderThunk spec = EFn.mkEffectFn1 \t → do
105 | vdom ← EFn.runEffectFn1 (V.buildVDom spec) (toVDom (runThunk t))
106 | pure $ M.mkStep $ M.Step (M.extract vdom) { thunk: t, vdom } patchThunk haltThunk
107 |
108 | patchThunk ∷ EFn.EffectFn2 (ThunkState f i a w) (Thunk f i) (V.Step (Thunk f i) Node)
109 | patchThunk = EFn.mkEffectFn2 \state t2 → do
110 | let { vdom: prev, thunk: t1 } = state
111 | if Fn.runFn2 unsafeEqThunk t1 t2
112 | then pure $ M.mkStep $ M.Step (M.extract prev) state patchThunk haltThunk
113 | else do
114 | vdom ← EFn.runEffectFn2 M.step prev (toVDom (runThunk t2))
115 | pure $ M.mkStep $ M.Step (M.extract vdom) { vdom, thunk: t2 } patchThunk haltThunk
116 |
117 | haltThunk ∷ EFn.EffectFn1 (ThunkState f i a w) Unit
118 | haltThunk = EFn.mkEffectFn1 \state → do
119 | EFn.runEffectFn1 M.halt state.vdom
120 |
--------------------------------------------------------------------------------
/src/Halogen/VDom/Util.purs:
--------------------------------------------------------------------------------
1 | module Halogen.VDom.Util
2 | ( newMutMap
3 | , pokeMutMap
4 | , deleteMutMap
5 | , unsafeFreeze
6 | , unsafeLookup
7 | , unsafeGetAny
8 | , unsafeHasAny
9 | , unsafeSetAny
10 | , unsafeDeleteAny
11 | , forE
12 | , forEachE
13 | , forInE
14 | , replicateE
15 | , diffWithIxE
16 | , diffWithKeyAndIxE
17 | , strMapWithIxE
18 | , refEq
19 | , createTextNode
20 | , setTextContent
21 | , createElement
22 | , insertChildIx
23 | , removeChild
24 | , parentNode
25 | , setAttribute
26 | , removeAttribute
27 | , hasAttribute
28 | , addEventListener
29 | , removeEventListener
30 | , JsUndefined
31 | , jsUndefined
32 | ) where
33 |
34 | import Prelude
35 |
36 | import Data.Function.Uncurried as Fn
37 | import Data.Nullable (Nullable)
38 | import Effect (Effect)
39 | import Effect.Uncurried as EFn
40 | import Foreign.Object (Object)
41 | import Foreign.Object as Object
42 | import Foreign.Object.ST (STObject)
43 | import Foreign.Object.ST as STObject
44 | import Halogen.VDom.Types (Namespace, ElemName)
45 | import Unsafe.Coerce (unsafeCoerce)
46 | import Web.DOM.Document (Document) as DOM
47 | import Web.DOM.Element (Element) as DOM
48 | import Web.DOM.Node (Node) as DOM
49 | import Web.Event.EventTarget (EventListener) as DOM
50 |
51 | newMutMap ∷ ∀ r a. Effect (STObject r a)
52 | newMutMap = unsafeCoerce STObject.new
53 |
54 | pokeMutMap ∷ ∀ r a. EFn.EffectFn3 String a (STObject r a) Unit
55 | pokeMutMap = unsafeSetAny
56 |
57 | deleteMutMap ∷ ∀ r a. EFn.EffectFn2 String (STObject r a) Unit
58 | deleteMutMap = unsafeDeleteAny
59 |
60 | unsafeFreeze ∷ ∀ r a. STObject r a → Object a
61 | unsafeFreeze = unsafeCoerce
62 |
63 | unsafeLookup ∷ ∀ a. Fn.Fn2 String (Object a) a
64 | unsafeLookup = unsafeGetAny
65 |
66 | foreign import unsafeGetAny
67 | ∷ ∀ a b. Fn.Fn2 String a b
68 |
69 | foreign import unsafeHasAny
70 | ∷ ∀ a. Fn.Fn2 String a Boolean
71 |
72 | foreign import unsafeSetAny ∷ ∀ a b. EFn.EffectFn3 String a b Unit
73 |
74 | foreign import unsafeDeleteAny
75 | ∷ ∀ a. EFn.EffectFn2 String a Unit
76 |
77 | foreign import forE
78 | ∷ ∀ a b
79 | . EFn.EffectFn2
80 | (Array a)
81 | (EFn.EffectFn2 Int a b)
82 | (Array b)
83 |
84 | foreign import forEachE
85 | ∷ ∀ a
86 | . EFn.EffectFn2
87 | (Array a)
88 | (EFn.EffectFn1 a Unit)
89 | Unit
90 |
91 | foreign import forInE
92 | ∷ ∀ a
93 | . EFn.EffectFn2
94 | (Object.Object a)
95 | (EFn.EffectFn2 String a Unit)
96 | Unit
97 |
98 | foreign import replicateE
99 | ∷ ∀ a
100 | . EFn.EffectFn2
101 | Int
102 | (Effect a)
103 | Unit
104 |
105 | foreign import diffWithIxE
106 | ∷ ∀ b c d
107 | . EFn.EffectFn5
108 | (Array b)
109 | (Array c)
110 | (EFn.EffectFn3 Int b c d)
111 | (EFn.EffectFn2 Int b Unit)
112 | (EFn.EffectFn2 Int c d)
113 | (Array d)
114 |
115 | foreign import diffWithKeyAndIxE
116 | ∷ ∀ a b c d
117 | . EFn.EffectFn6
118 | (Object.Object a)
119 | (Array b)
120 | (b → String)
121 | (EFn.EffectFn4 String Int a b c)
122 | (EFn.EffectFn2 String a d)
123 | (EFn.EffectFn3 String Int b c)
124 | (Object.Object c)
125 |
126 | foreign import strMapWithIxE
127 | ∷ ∀ a b
128 | . EFn.EffectFn3
129 | (Array a)
130 | (a → String)
131 | (EFn.EffectFn3 String Int a b)
132 | (Object.Object b)
133 |
134 | foreign import refEq
135 | ∷ ∀ a b. Fn.Fn2 a b Boolean
136 |
137 | foreign import createTextNode
138 | ∷ EFn.EffectFn2 String DOM.Document DOM.Node
139 |
140 | foreign import setTextContent
141 | ∷ EFn.EffectFn2 String DOM.Node Unit
142 |
143 | foreign import createElement
144 | ∷ EFn.EffectFn3 (Nullable Namespace) ElemName DOM.Document DOM.Element
145 |
146 | foreign import insertChildIx
147 | ∷ EFn.EffectFn3 Int DOM.Node DOM.Node Unit
148 |
149 | foreign import removeChild
150 | ∷ EFn.EffectFn2 DOM.Node DOM.Node Unit
151 |
152 | foreign import parentNode
153 | ∷ EFn.EffectFn1 DOM.Node DOM.Node
154 |
155 | foreign import setAttribute
156 | ∷ EFn.EffectFn4 (Nullable Namespace) String String DOM.Element Unit
157 |
158 | foreign import removeAttribute
159 | ∷ EFn.EffectFn3 (Nullable Namespace) String DOM.Element Unit
160 |
161 | foreign import hasAttribute
162 | ∷ EFn.EffectFn3 (Nullable Namespace) String DOM.Element Boolean
163 |
164 | foreign import addEventListener
165 | ∷ EFn.EffectFn3 String DOM.EventListener DOM.Element Unit
166 |
167 | foreign import removeEventListener
168 | ∷ EFn.EffectFn3 String DOM.EventListener DOM.Element Unit
169 |
170 | foreign import data JsUndefined ∷ Type
171 |
172 | foreign import jsUndefined ∷ JsUndefined
173 |
--------------------------------------------------------------------------------
/test/Main.purs:
--------------------------------------------------------------------------------
1 | module Test.Main where
2 |
3 | import Prelude
4 |
5 | import Data.Bifunctor (bimap)
6 | import Data.Foldable (for_, traverse_)
7 | import Data.Function.Uncurried as Fn
8 | import Data.Maybe (Maybe(..), isNothing)
9 | import Data.Newtype (class Newtype, un, wrap)
10 | import Data.Tuple (Tuple(..))
11 | import Effect (Effect)
12 | import Effect.Ref as Ref
13 | import Effect.Uncurried as EFn
14 | import Halogen.VDom as V
15 | import Halogen.VDom.DOM.Prop (Prop(..), propFromString, buildProp)
16 | import Halogen.VDom.Thunk (Thunk, thunk1, buildThunk)
17 | import Unsafe.Coerce (unsafeCoerce)
18 | import Web.DOM.Document (Document) as DOM
19 | import Web.DOM.Element (toNode) as DOM
20 | import Web.DOM.Node (Node, appendChild) as DOM
21 | import Web.DOM.ParentNode (querySelector) as DOM
22 | import Web.HTML (window) as DOM
23 | import Web.HTML.HTMLDocument (toDocument, toParentNode) as DOM
24 | import Web.HTML.Window (document) as DOM
25 |
26 | infixr 1 prop as :=
27 |
28 | prop ∷ ∀ a. String → String → Prop a
29 | prop key val = Property key (propFromString val)
30 |
31 | newtype VDom a = VDom (V.VDom (Array (Prop a)) (Thunk VDom a))
32 |
33 | instance functorHtml ∷ Functor VDom where
34 | map f (VDom vdom) = VDom (bimap (map (map f)) (map f) vdom)
35 |
36 | derive instance newtypeVDom ∷ Newtype (VDom a) _
37 |
38 | type State = Array Database
39 |
40 | type Database =
41 | { dbname ∷ String
42 | , lastSample ∷ LastSample
43 | }
44 |
45 | type LastSample =
46 | { countClassName ∷ String
47 | , nbQueries ∷ Int
48 | , topFiveQueries ∷ Array DBQuery
49 | }
50 |
51 | type DBQuery =
52 | { elapsedClassName ∷ String
53 | , formatElapsed ∷ String
54 | , query ∷ String
55 | }
56 |
57 | initialState ∷ State
58 | initialState = []
59 |
60 | elem ∷ ∀ a. String → Array (Prop a) → Array (VDom a) → VDom a
61 | elem n a c = VDom $ V.Elem Nothing (V.ElemName n) a (unsafeCoerce c)
62 |
63 | keyed ∷ ∀ a. String → Array (Prop a) → Array (Tuple String (VDom a)) → VDom a
64 | keyed n a c = VDom $ V.Keyed Nothing (V.ElemName n) a (unsafeCoerce c)
65 |
66 | text ∷ ∀ a. String → VDom a
67 | text a = VDom $ V.Text a
68 |
69 | thunk ∷ ∀ a b. (a → VDom b) → a → VDom b
70 | thunk render val = VDom $ V.Widget $ Fn.runFn2 thunk1 render val
71 |
72 | renderData ∷ State → VDom Void
73 | renderData st =
74 | elem "div" []
75 | [ elem "table"
76 | [ "className" := "table table-striped latest data" ]
77 | [ keyed "tbody" [] (map (\db → Tuple db.dbname (thunk renderDatabase db)) st) ]
78 | -- [ keyed "tbody" [] (map (\db → Tuple db.dbname (renderDatabase db)) st) ]
79 | -- [ elem "tbody" [] (map (thunk renderDatabase) st) ]
80 | -- [ elem "tbody" [] (map renderDatabase st) ]
81 | ]
82 |
83 | where
84 | renderDatabase db =
85 | elem "tr"
86 | []
87 | ([ elem "td"
88 | [ "className" := "dbname" ]
89 | [ text db.dbname ]
90 | , elem "td"
91 | [ "className" := "query-count" ]
92 | [ elem "span"
93 | [ "className" := db.lastSample.countClassName ]
94 | [ text (show db.lastSample.nbQueries) ]
95 | ]
96 | ] <> map renderQuery db.lastSample.topFiveQueries)
97 |
98 | renderQuery q =
99 | elem "td"
100 | [ "className" := "Query" <> q.elapsedClassName ]
101 | [ text q.formatElapsed
102 | , elem "div"
103 | [ "className" := "popover left" ]
104 | [ elem "div"
105 | [ "className" := "popover-content" ]
106 | [ text q.query ]
107 | , elem "div"
108 | [ "className" := "arrow" ]
109 | []
110 | ]
111 | ]
112 |
113 | mkSpec
114 | ∷ DOM.Document
115 | → V.VDomSpec (Array (Prop Void)) (Thunk VDom Void)
116 | mkSpec document = V.VDomSpec
117 | { buildWidget: buildThunk (un VDom)
118 | , buildAttributes: buildProp (const (pure unit))
119 | , document
120 | }
121 |
122 | foreign import getData ∷ Effect State
123 |
124 | foreign import getTimeout ∷ Effect Int
125 |
126 | foreign import pingRenderRate ∷ Effect Unit
127 |
128 | foreign import requestAnimationFrame ∷ Effect Unit → Effect Unit
129 |
130 | foreign import setTimeout :: Int -> Effect Unit -> Effect Int
131 |
132 | mkRenderQueue
133 | ∷ ∀ a
134 | . V.VDomSpec (Array (Prop Void)) (Thunk VDom Void)
135 | → DOM.Node
136 | → (a → VDom Void)
137 | → a
138 | → Effect (a → Effect Unit)
139 | mkRenderQueue spec parent render initialValue = do
140 | initMachine ← EFn.runEffectFn1 (V.buildVDom spec) (un VDom (render initialValue))
141 | _ ← DOM.appendChild (V.extract initMachine) parent
142 | ref ← Ref.new initMachine
143 | val ← Ref.new Nothing
144 | pure \a → do
145 | v ← Ref.read val
146 | Ref.write (Just a) val
147 | when (isNothing v) $ requestAnimationFrame do
148 | machine ← Ref.read ref
149 | Ref.read val >>= traverse_ \v' → do
150 | res ← EFn.runEffectFn2 V.step machine (un VDom (render v'))
151 | Ref.write res ref
152 | Ref.write Nothing val
153 |
154 | mkRenderQueue'
155 | ∷ ∀ a
156 | . V.VDomSpec (Array (Prop Void)) (Thunk VDom Void)
157 | → DOM.Node
158 | → (a → VDom Void)
159 | → a
160 | → Effect (a → Effect Unit)
161 | mkRenderQueue' spec parent render initialValue = do
162 | initMachine ← EFn.runEffectFn1 (V.buildVDom spec) (un VDom (render initialValue))
163 | _ ← DOM.appendChild (V.extract initMachine) parent
164 | ref ← Ref.new initMachine
165 | pure \v → do
166 | machine ← Ref.read ref
167 | res ← EFn.runEffectFn2 V.step machine (un VDom (render v))
168 | Ref.write res ref
169 |
170 | main ∷ Effect Unit
171 | main = do
172 | win ← DOM.window
173 | doc ← DOM.document win
174 | bod ← DOM.querySelector (wrap "body") (DOM.toParentNode doc)
175 | for_ bod \body → do
176 | let spec = mkSpec (DOM.toDocument doc)
177 | pushQueue ← mkRenderQueue' spec (DOM.toNode body) renderData initialState
178 | let
179 | loop = do
180 | newData ← getData
181 | timeout ← getTimeout
182 | pushQueue newData
183 | pingRenderRate
184 | void (setTimeout timeout loop)
185 | loop
186 |
--------------------------------------------------------------------------------
/GUIDE.md:
--------------------------------------------------------------------------------
1 | # Usage Guide
2 |
3 | ## Overview
4 |
5 | `Halogen.VDom` is built on [Mealy machines](https://en.wikipedia.org/wiki/Mealy_machine).
6 | Given an input `VDom`, the machine yields a `Node`, the next machine step, and a finalizer.
7 |
8 | ```purescript
9 | import Halogen.VDom as VDom
10 |
11 | type MyVDom = VDom.VDom ...
12 |
13 | render ∷ MyState → MyVDom
14 |
15 | main = do
16 | -- Build the initial machine
17 | machine1 ← V.buildVDom myVDomSpec (render state1)
18 |
19 | -- Attach the output node to the DOM
20 | appendChildToBody (V.extract machine1)
21 |
22 | -- Patch
23 | machine2 ← V.step machine1 (render state2)
24 | machine3 ← V.step machine2 (render state3)
25 | ...
26 | ```
27 |
28 | Out of the box, only very basic text and node creation is supported. Attributes,
29 | properties, event listeners, hooks, etc. are left for library implementors to
30 | plug in as needed. Library authors should likely `newtype` their wrappers to
31 | get more convenient instances (eg. `map`ping over inputs from event listeners).
32 |
33 | ## Extending
34 |
35 | The core `VDom a w` type is parameterized by the types for element attributes
36 | and custom widgets. Element attributes will likely be a sum for the usual suspects
37 | (DOM attributes, properties, event listeners, lifecycle hooks) and mutate a
38 | given DOM `Element`, while widgets give you complete control over the patching
39 | and diffing of a tree (eg. thunks, custom components, etc).
40 |
41 | When you start your initial machine, you provide a `VDomSpec`, which contains
42 | the machines for running your attributes and widgets.
43 |
44 | ```purescript
45 | import Halogen.VDom as VDom
46 |
47 | data MyAttribute
48 | data MyWidget
49 |
50 | makeSpec ∷ ∀ eff. DOM.Document → VDom.VDomSpec eff MyAttribute MyWidget
51 | makeSpec document =
52 | VDom.VDomSpec
53 | { buildWidget: ...
54 | , buildAttributes: ...
55 | , document
56 | }
57 | ```
58 |
59 | The type signature for `buildWidget` looks like:
60 |
61 | ```purescript
62 | buildWidget
63 | ∷ ∀ eff a
64 | . V.VDomSpec eff a MyWidget
65 | → V.VDomMachine eff MyWidget DOM.Node
66 | ```
67 |
68 | `buildWidget` takes a circular reference to the `VDomSpec` you are building so you
69 | can have recursive trees. The core though is in the returned `VDomMachine` which
70 | takes your widget type, and yields a DOM node.
71 |
72 | The type signature for `buildAttributes` looks like:
73 |
74 | ```purescript
75 | buildAttributes
76 | ∷ ∀ eff
77 | . DOM.Element
78 | → V.VDomMachine eff MyAttribute Unit
79 | ```
80 |
81 | This takes the current `Element` and yields a machine which takes your attribute
82 | type and yields `Unit`.
83 |
84 | If you don't have any custom widgets, you can supply a `Void` machine.
85 |
86 | ```purescript
87 | import Halogen.VDom as VDom
88 | import Halogen.VDom.Machine as Machine
89 |
90 | data MyAttribute
91 |
92 | makeSpec ∷ ∀ eff. DOM.Document → VDom.VDomSpec eff MyAttribute Void
93 | makeSpec document =
94 | VDom.VDomSpec
95 | { buildWidget: const (Machine.never)
96 | , buildAttributes: ...
97 | , document
98 | }
99 | ```
100 |
101 | ## Creating Machines
102 |
103 | A `Machine`'s type looks like:
104 |
105 | ```purescript
106 | type Machine m a b = a → m (Step m a b)
107 |
108 | data Step m a b = Step b (Machine m a b) (m Unit)
109 | ```
110 |
111 | So it is just an effectful function from some input to a `Step`, which is a
112 | product of an output value `b`, the next transition, and a finalizer. Finalizers
113 | are useful when your widgets or attributes need to perform cleanup.
114 |
115 | The structure of a widget machine will likely follow this pattern:
116 |
117 | ```purescript
118 | import Halogen.VDom as V
119 |
120 | createWidgetNode ∷ MyWidget → V.VDomEff eff DOM.Node
121 |
122 | patchWidgetNode ∷ DOM.Node → MyWidget → MyWidget → V.VDomEff eff DOM.Node
123 |
124 | cleanupWidgetNode ∷ DOM.Node → MyWidget → V.VDomEff eff Unit
125 |
126 | buildWidget
127 | ∷ ∀ eff a
128 | . V.VDomSpec eff a MyWidget
129 | → V.VDomMachine eff MyWidget DOM.Node
130 | buildWidget spec = render
131 | where
132 | render ∷ V.VDomMachine eff MyWidget DOM.Node
133 | render widget = do
134 | node ← createWidgetNode widget
135 | pure
136 | (V.Step node
137 | (patch node widget)
138 | (done node widget))
139 |
140 | patch ∷ DOM.Node → MyWidget → V.VDomMachine eff MyWidget DOM.Node
141 | patch node1 widget1 widget2 = do
142 | node2 ← patchWidgetNode node widget1 widget2
143 | pure
144 | (V.Step node2
145 | (patch node2 myWidget2)
146 | (done node2 myWidget2))
147 |
148 | done ∷ DOM.Node → MyWidget → V.VDomEff eff Unit
149 | done node widget = cleanupWidgetNode node widget
150 | ```
151 |
152 | Note that `Machine`s can keep any state they need to, it is just passed from
153 | machine to machine through closures.
154 |
155 | The structure of an attribute machine will likely follow this pattern:
156 |
157 | ```purescript
158 | import Halogen.VDom as V
159 |
160 | applyAttributes ∷ DOM.Element → MyAttribute → V.VDomEff eff Unit
161 |
162 | patchAttributes ∷ DOM.Element → MyAttribute → MyAttribute → V.VDomEff eff Unit
163 |
164 | cleanupAttributes ∷ DOM.Element → MyAttribute → V.VDomEff eff Unit
165 |
166 | buildAttributes
167 | ∷ ∀ eff a
168 | . DOM.Element
169 | → V.VDomMachine eff MyAttribute Unit
170 | buildAttribute elem = apply
171 | where
172 | apply ∷ V.VDomMachine eff MyAttribute Unit
173 | apply attrs = do
174 | applyAttributes elem attrs
175 | pure
176 | (V.Step unit
177 | (patch attrs)
178 | (done attrs))
179 |
180 | patch ∷ MyAttribute → V.VDomMachine eff MyAttribute Unit
181 | patch attrs1 attrs2 = do
182 | patchAttributes elem attrs1 attrs2
183 | pure
184 | (V.Step unit
185 | (patch attrs2)
186 | (done attrs2))
187 |
188 | done ∷ MyAttribute → V.VDomEff eff Unit
189 | done attrs = cleanupAttribute elem attrs
190 | ```
191 |
192 | Note that the `Element` is provided on initialization, and there is no meaninful
193 | output type because it is only effectful.
194 |
195 | ## Getting Performance
196 |
197 | The core of `Halogen.VDom` strives to be as fast as possible. It does this
198 | through pervasive use of monomorphic `Eff` do-blocks (which are optimized into
199 | imperative JavaScript) and `Data.Function.Uncurried` (which eliminates the
200 | overhead of currying). It also provides a few monomorphic utilities in
201 | `Halogen.VDom.Util` to help cut down on allocations. Additionally there are
202 | some general purposes utilities to help with faster diffing.
203 |
--------------------------------------------------------------------------------
/src/Halogen/VDom/DOM/Prop.purs:
--------------------------------------------------------------------------------
1 | module Halogen.VDom.DOM.Prop
2 | ( Prop(..)
3 | , ElemRef(..)
4 | , PropValue
5 | , propFromString
6 | , propFromBoolean
7 | , propFromInt
8 | , propFromNumber
9 | , buildProp
10 | ) where
11 |
12 | import Prelude
13 |
14 | import Data.Function.Uncurried as Fn
15 | import Data.Maybe (Maybe(..))
16 | import Data.Nullable (null, toNullable)
17 | import Data.Tuple (Tuple(..), fst, snd)
18 | import Effect (Effect)
19 | import Effect.Ref as Ref
20 | import Effect.Uncurried as EFn
21 | import Foreign (typeOf)
22 | import Foreign.Object as Object
23 | import Halogen.VDom as V
24 | import Halogen.VDom.Machine (Step'(..), mkStep)
25 | import Halogen.VDom.Types (Namespace(..))
26 | import Halogen.VDom.Util as Util
27 | import Unsafe.Coerce (unsafeCoerce)
28 | import Web.DOM.Element (Element) as DOM
29 | import Web.Event.Event (EventType(..), Event) as DOM
30 | import Web.Event.EventTarget (eventListener) as DOM
31 |
32 | -- | Attributes, properties, event handlers, and element lifecycles.
33 | -- | Parameterized by the type of handlers outputs.
34 | data Prop a
35 | = Attribute (Maybe Namespace) String String
36 | | Property String PropValue
37 | | Handler DOM.EventType (DOM.Event → Maybe a)
38 | | Ref (ElemRef DOM.Element → Maybe a)
39 |
40 | instance functorProp ∷ Functor Prop where
41 | map f (Handler ty g) = Handler ty (map f <$> g)
42 | map f (Ref g) = Ref (map f <$> g)
43 | map _ p = unsafeCoerce p
44 |
45 | data ElemRef a
46 | = Created a
47 | | Removed a
48 |
49 | instance functorElemRef ∷ Functor ElemRef where
50 | map f (Created a) = Created (f a)
51 | map f (Removed a) = Removed (f a)
52 |
53 | foreign import data PropValue ∷ Type
54 |
55 | propFromString ∷ String → PropValue
56 | propFromString = unsafeCoerce
57 |
58 | propFromBoolean ∷ Boolean → PropValue
59 | propFromBoolean = unsafeCoerce
60 |
61 | propFromInt ∷ Int → PropValue
62 | propFromInt = unsafeCoerce
63 |
64 | propFromNumber ∷ Number → PropValue
65 | propFromNumber = unsafeCoerce
66 |
67 | -- | A `Machine`` for applying attributes, properties, and event handlers.
68 | -- | An emitter effect must be provided to respond to events. For example,
69 | -- | to allow arbitrary effects in event handlers, one could use `id`.
70 | buildProp
71 | ∷ ∀ a
72 | . (a → Effect Unit)
73 | → DOM.Element
74 | → V.Machine (Array (Prop a)) Unit
75 | buildProp emit el = renderProp
76 | where
77 | renderProp = EFn.mkEffectFn1 \ps1 → do
78 | events ← Util.newMutMap
79 | ps1' ← EFn.runEffectFn3 Util.strMapWithIxE ps1 propToStrKey (applyProp events)
80 | let
81 | state =
82 | { events: Util.unsafeFreeze events
83 | , props: ps1'
84 | }
85 | pure $ mkStep $ Step unit state patchProp haltProp
86 |
87 | patchProp = EFn.mkEffectFn2 \state ps2 → do
88 | events ← Util.newMutMap
89 | let
90 | { events: prevEvents, props: ps1 } = state
91 | onThese = Fn.runFn2 diffProp prevEvents events
92 | onThis = removeProp prevEvents
93 | onThat = applyProp events
94 | props ← EFn.runEffectFn6 Util.diffWithKeyAndIxE ps1 ps2 propToStrKey onThese onThis onThat
95 | let
96 | nextState =
97 | { events: Util.unsafeFreeze events
98 | , props
99 | }
100 | pure $ mkStep $ Step unit nextState patchProp haltProp
101 |
102 | haltProp = EFn.mkEffectFn1 \state → do
103 | case Object.lookup "ref" state.props of
104 | Just (Ref f) →
105 | EFn.runEffectFn1 mbEmit (f (Removed el))
106 | _ → pure unit
107 |
108 | mbEmit = EFn.mkEffectFn1 case _ of
109 | Just a → emit a
110 | _ → pure unit
111 |
112 | applyProp events = EFn.mkEffectFn3 \_ _ v →
113 | case v of
114 | Attribute ns attr val → do
115 | EFn.runEffectFn4 Util.setAttribute (toNullable ns) attr val el
116 | pure v
117 | Property prop val → do
118 | EFn.runEffectFn3 setProperty prop val el
119 | pure v
120 | Handler (DOM.EventType ty) f → do
121 | case Fn.runFn2 Util.unsafeGetAny ty events of
122 | handler | Fn.runFn2 Util.unsafeHasAny ty events → do
123 | Ref.write f (snd handler)
124 | pure v
125 | _ → do
126 | ref ← Ref.new f
127 | listener ← DOM.eventListener \ev → do
128 | f' ← Ref.read ref
129 | EFn.runEffectFn1 mbEmit (f' ev)
130 | EFn.runEffectFn3 Util.pokeMutMap ty (Tuple listener ref) events
131 | EFn.runEffectFn3 Util.addEventListener ty listener el
132 | pure v
133 | Ref f → do
134 | EFn.runEffectFn1 mbEmit (f (Created el))
135 | pure v
136 |
137 | diffProp = Fn.mkFn2 \prevEvents events → EFn.mkEffectFn4 \_ _ v1 v2 →
138 | case v1, v2 of
139 | Attribute _ _ val1, Attribute ns2 attr2 val2 →
140 | if val1 == val2
141 | then pure v2
142 | else do
143 | EFn.runEffectFn4 Util.setAttribute (toNullable ns2) attr2 val2 el
144 | pure v2
145 | Property _ val1, Property prop2 val2 →
146 | case Fn.runFn2 Util.refEq val1 val2, prop2 of
147 | true, _ →
148 | pure v2
149 | _, "value" → do
150 | let elVal = Fn.runFn2 unsafeGetProperty "value" el
151 | if Fn.runFn2 Util.refEq elVal val2
152 | then pure v2
153 | else do
154 | EFn.runEffectFn3 setProperty prop2 val2 el
155 | pure v2
156 | _, _ → do
157 | EFn.runEffectFn3 setProperty prop2 val2 el
158 | pure v2
159 | Handler _ _, Handler (DOM.EventType ty) f → do
160 | let
161 | handler = Fn.runFn2 Util.unsafeLookup ty prevEvents
162 | Ref.write f (snd handler)
163 | EFn.runEffectFn3 Util.pokeMutMap ty handler events
164 | pure v2
165 | _, _ →
166 | pure v2
167 |
168 | removeProp prevEvents = EFn.mkEffectFn2 \_ v →
169 | case v of
170 | Attribute ns attr _ →
171 | EFn.runEffectFn3 Util.removeAttribute (toNullable ns) attr el
172 | Property prop _ →
173 | EFn.runEffectFn2 removeProperty prop el
174 | Handler (DOM.EventType ty) _ → do
175 | let
176 | handler = Fn.runFn2 Util.unsafeLookup ty prevEvents
177 | EFn.runEffectFn3 Util.removeEventListener ty (fst handler) el
178 | Ref _ →
179 | pure unit
180 |
181 | propToStrKey ∷ ∀ i. Prop i → String
182 | propToStrKey = case _ of
183 | Attribute (Just (Namespace ns)) attr _ → "attr/" <> ns <> ":" <> attr
184 | Attribute _ attr _ → "attr/:" <> attr
185 | Property prop _ → "prop/" <> prop
186 | Handler (DOM.EventType ty) _ → "handler/" <> ty
187 | Ref _ → "ref"
188 |
189 | setProperty ∷ EFn.EffectFn3 String PropValue DOM.Element Unit
190 | setProperty = Util.unsafeSetAny
191 |
192 | unsafeGetProperty ∷ Fn.Fn2 String DOM.Element PropValue
193 | unsafeGetProperty = Util.unsafeGetAny
194 |
195 | removeProperty ∷ EFn.EffectFn2 String DOM.Element Unit
196 | removeProperty = EFn.mkEffectFn2 \key el →
197 | EFn.runEffectFn3 Util.hasAttribute null key el >>= if _
198 | then EFn.runEffectFn3 Util.removeAttribute null key el
199 | else case typeOf (Fn.runFn2 Util.unsafeGetAny key el) of
200 | "string" → EFn.runEffectFn3 Util.unsafeSetAny key "" el
201 | _ → case key of
202 | "rowSpan" → EFn.runEffectFn3 Util.unsafeSetAny key 1 el
203 | "colSpan" → EFn.runEffectFn3 Util.unsafeSetAny key 1 el
204 | _ → EFn.runEffectFn3 Util.unsafeSetAny key Util.jsUndefined el
205 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | Apache License
2 | Version 2.0, January 2004
3 | http://www.apache.org/licenses/
4 |
5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
6 |
7 | 1. Definitions.
8 |
9 | "License" shall mean the terms and conditions for use, reproduction,
10 | and distribution as defined by Sections 1 through 9 of this document.
11 |
12 | "Licensor" shall mean the copyright owner or entity authorized by
13 | the copyright owner that is granting the License.
14 |
15 | "Legal Entity" shall mean the union of the acting entity and all
16 | other entities that control, are controlled by, or are under common
17 | control with that entity. For the purposes of this definition,
18 | "control" means (i) the power, direct or indirect, to cause the
19 | direction or management of such entity, whether by contract or
20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the
21 | outstanding shares, or (iii) beneficial ownership of such entity.
22 |
23 | "You" (or "Your") shall mean an individual or Legal Entity
24 | exercising permissions granted by this License.
25 |
26 | "Source" form shall mean the preferred form for making modifications,
27 | including but not limited to software source code, documentation
28 | source, and configuration files.
29 |
30 | "Object" form shall mean any form resulting from mechanical
31 | transformation or translation of a Source form, including but
32 | not limited to compiled object code, generated documentation,
33 | and conversions to other media types.
34 |
35 | "Work" shall mean the work of authorship, whether in Source or
36 | Object form, made available under the License, as indicated by a
37 | copyright notice that is included in or attached to the work
38 | (an example is provided in the Appendix below).
39 |
40 | "Derivative Works" shall mean any work, whether in Source or Object
41 | form, that is based on (or derived from) the Work and for which the
42 | editorial revisions, annotations, elaborations, or other modifications
43 | represent, as a whole, an original work of authorship. For the purposes
44 | of this License, Derivative Works shall not include works that remain
45 | separable from, or merely link (or bind by name) to the interfaces of,
46 | the Work and Derivative Works thereof.
47 |
48 | "Contribution" shall mean any work of authorship, including
49 | the original version of the Work and any modifications or additions
50 | to that Work or Derivative Works thereof, that is intentionally
51 | submitted to Licensor for inclusion in the Work by the copyright owner
52 | or by an individual or Legal Entity authorized to submit on behalf of
53 | the copyright owner. For the purposes of this definition, "submitted"
54 | means any form of electronic, verbal, or written communication sent
55 | to the Licensor or its representatives, including but not limited to
56 | communication on electronic mailing lists, source code control systems,
57 | and issue tracking systems that are managed by, or on behalf of, the
58 | Licensor for the purpose of discussing and improving the Work, but
59 | excluding communication that is conspicuously marked or otherwise
60 | designated in writing by the copyright owner as "Not a Contribution."
61 |
62 | "Contributor" shall mean Licensor and any individual or Legal Entity
63 | on behalf of whom a Contribution has been received by Licensor and
64 | subsequently incorporated within the Work.
65 |
66 | 2. Grant of Copyright License. Subject to the terms and conditions of
67 | this License, each Contributor hereby grants to You a perpetual,
68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable
69 | copyright license to reproduce, prepare Derivative Works of,
70 | publicly display, publicly perform, sublicense, and distribute the
71 | Work and such Derivative Works in Source or Object form.
72 |
73 | 3. Grant of Patent License. Subject to the terms and conditions of
74 | this License, each Contributor hereby grants to You a perpetual,
75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable
76 | (except as stated in this section) patent license to make, have made,
77 | use, offer to sell, sell, import, and otherwise transfer the Work,
78 | where such license applies only to those patent claims licensable
79 | by such Contributor that are necessarily infringed by their
80 | Contribution(s) alone or by combination of their Contribution(s)
81 | with the Work to which such Contribution(s) was submitted. If You
82 | institute patent litigation against any entity (including a
83 | cross-claim or counterclaim in a lawsuit) alleging that the Work
84 | or a Contribution incorporated within the Work constitutes direct
85 | or contributory patent infringement, then any patent licenses
86 | granted to You under this License for that Work shall terminate
87 | as of the date such litigation is filed.
88 |
89 | 4. Redistribution. You may reproduce and distribute copies of the
90 | Work or Derivative Works thereof in any medium, with or without
91 | modifications, and in Source or Object form, provided that You
92 | meet the following conditions:
93 |
94 | (a) You must give any other recipients of the Work or
95 | Derivative Works a copy of this License; and
96 |
97 | (b) You must cause any modified files to carry prominent notices
98 | stating that You changed the files; and
99 |
100 | (c) You must retain, in the Source form of any Derivative Works
101 | that You distribute, all copyright, patent, trademark, and
102 | attribution notices from the Source form of the Work,
103 | excluding those notices that do not pertain to any part of
104 | the Derivative Works; and
105 |
106 | (d) If the Work includes a "NOTICE" text file as part of its
107 | distribution, then any Derivative Works that You distribute must
108 | include a readable copy of the attribution notices contained
109 | within such NOTICE file, excluding those notices that do not
110 | pertain to any part of the Derivative Works, in at least one
111 | of the following places: within a NOTICE text file distributed
112 | as part of the Derivative Works; within the Source form or
113 | documentation, if provided along with the Derivative Works; or,
114 | within a display generated by the Derivative Works, if and
115 | wherever such third-party notices normally appear. The contents
116 | of the NOTICE file are for informational purposes only and
117 | do not modify the License. You may add Your own attribution
118 | notices within Derivative Works that You distribute, alongside
119 | or as an addendum to the NOTICE text from the Work, provided
120 | that such additional attribution notices cannot be construed
121 | as modifying the License.
122 |
123 | You may add Your own copyright statement to Your modifications and
124 | may provide additional or different license terms and conditions
125 | for use, reproduction, or distribution of Your modifications, or
126 | for any such Derivative Works as a whole, provided Your use,
127 | reproduction, and distribution of the Work otherwise complies with
128 | the conditions stated in this License.
129 |
130 | 5. Submission of Contributions. Unless You explicitly state otherwise,
131 | any Contribution intentionally submitted for inclusion in the Work
132 | by You to the Licensor shall be under the terms and conditions of
133 | this License, without any additional terms or conditions.
134 | Notwithstanding the above, nothing herein shall supersede or modify
135 | the terms of any separate license agreement you may have executed
136 | with Licensor regarding such Contributions.
137 |
138 | 6. Trademarks. This License does not grant permission to use the trade
139 | names, trademarks, service marks, or product names of the Licensor,
140 | except as required for reasonable and customary use in describing the
141 | origin of the Work and reproducing the content of the NOTICE file.
142 |
143 | 7. Disclaimer of Warranty. Unless required by applicable law or
144 | agreed to in writing, Licensor provides the Work (and each
145 | Contributor provides its Contributions) on an "AS IS" BASIS,
146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
147 | implied, including, without limitation, any warranties or conditions
148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
149 | PARTICULAR PURPOSE. You are solely responsible for determining the
150 | appropriateness of using or redistributing the Work and assume any
151 | risks associated with Your exercise of permissions under this License.
152 |
153 | 8. Limitation of Liability. In no event and under no legal theory,
154 | whether in tort (including negligence), contract, or otherwise,
155 | unless required by applicable law (such as deliberate and grossly
156 | negligent acts) or agreed to in writing, shall any Contributor be
157 | liable to You for damages, including any direct, indirect, special,
158 | incidental, or consequential damages of any character arising as a
159 | result of this License or out of the use or inability to use the
160 | Work (including but not limited to damages for loss of goodwill,
161 | work stoppage, computer failure or malfunction, or any and all
162 | other commercial damages or losses), even if such Contributor
163 | has been advised of the possibility of such damages.
164 |
165 | 9. Accepting Warranty or Additional Liability. While redistributing
166 | the Work or Derivative Works thereof, You may choose to offer,
167 | and charge a fee for, acceptance of support, warranty, indemnity,
168 | or other liability obligations and/or rights consistent with this
169 | License. However, in accepting such obligations, You may act only
170 | on Your own behalf and on Your sole responsibility, not on behalf
171 | of any other Contributor, and only if You agree to indemnify,
172 | defend, and hold each Contributor harmless for any liability
173 | incurred by, or claims asserted against, such Contributor by reason
174 | of your accepting any such warranty or additional liability.
175 |
176 | END OF TERMS AND CONDITIONS
177 |
178 | APPENDIX: How to apply the Apache License to your work.
179 |
180 | To apply the Apache License to your work, attach the following
181 | boilerplate notice, with the fields enclosed by brackets "{}"
182 | replaced with your own identifying information. (Don't include
183 | the brackets!) The text should be enclosed in the appropriate
184 | comment syntax for the file format. We also recommend that a
185 | file or class name and description of purpose be included on the
186 | same "printed page" as the copyright notice for easier
187 | identification within third-party archives.
188 |
189 | Copyright {yyyy} {name of copyright owner}
190 |
191 | Licensed under the Apache License, Version 2.0 (the "License");
192 | you may not use this file except in compliance with the License.
193 | You may obtain a copy of the License at
194 |
195 | http://www.apache.org/licenses/LICENSE-2.0
196 |
197 | Unless required by applicable law or agreed to in writing, software
198 | distributed under the License is distributed on an "AS IS" BASIS,
199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
200 | See the License for the specific language governing permissions and
201 | limitations under the License.
202 |
--------------------------------------------------------------------------------
/src/Halogen/VDom/DOM.purs:
--------------------------------------------------------------------------------
1 | module Halogen.VDom.DOM
2 | ( VDomSpec(..)
3 | , buildVDom
4 | , buildText
5 | , buildElem
6 | , buildKeyed
7 | , buildWidget
8 | ) where
9 |
10 | import Prelude
11 |
12 | import Data.Array as Array
13 | import Data.Function.Uncurried as Fn
14 | import Data.Maybe (Maybe(..))
15 | import Data.Nullable (toNullable)
16 | import Data.Tuple (Tuple(..), fst)
17 | import Effect.Uncurried as EFn
18 | import Foreign.Object as Object
19 | import Halogen.VDom.Machine (Machine, Step, Step'(..), extract, halt, mkStep, step, unStep)
20 | import Halogen.VDom.Machine as Machine
21 | import Halogen.VDom.Types (ElemName(..), Namespace(..), VDom(..), runGraft)
22 | import Halogen.VDom.Util as Util
23 | import Web.DOM.Document (Document) as DOM
24 | import Web.DOM.Element (Element) as DOM
25 | import Web.DOM.Element as DOMElement
26 | import Web.DOM.Node (Node) as DOM
27 |
28 | type VDomMachine a w = Machine (VDom a w) DOM.Node
29 |
30 | type VDomStep a w = Step (VDom a w) DOM.Node
31 |
32 | type VDomInit i a w = EFn.EffectFn1 i (VDomStep a w)
33 |
34 | type VDomBuilder i a w = EFn.EffectFn3 (VDomSpec a w) (VDomMachine a w) i (VDomStep a w)
35 |
36 | type VDomBuilder4 i j k l a w = EFn.EffectFn6 (VDomSpec a w) (VDomMachine a w) i j k l (VDomStep a w)
37 |
38 | -- | Widget machines recursively reference the configured spec to potentially
39 | -- | enable recursive trees of Widgets.
40 | newtype VDomSpec a w = VDomSpec
41 | { buildWidget ∷ VDomSpec a w → Machine w DOM.Node
42 | , buildAttributes ∷ DOM.Element → Machine a Unit
43 | , document ∷ DOM.Document
44 | }
45 |
46 | -- | Starts an initial `VDom` machine by providing a `VDomSpec`.
47 | -- |
48 | -- | ```purescript
49 | -- | main = do
50 | -- | machine1 ← buildVDom spec vdomTree1
51 | -- | machine2 ← Machine.step machine1 vdomTree2
52 | -- | machine3 ← Machine.step machine2 vdomTree3
53 | -- | ...
54 | -- | ````
55 | buildVDom ∷ ∀ a w. VDomSpec a w → VDomMachine a w
56 | buildVDom spec = build
57 | where
58 | build = EFn.mkEffectFn1 case _ of
59 | Text s → EFn.runEffectFn3 buildText spec build s
60 | Elem ns n a ch → EFn.runEffectFn6 buildElem spec build ns n a ch
61 | Keyed ns n a ch → EFn.runEffectFn6 buildKeyed spec build ns n a ch
62 | Widget w → EFn.runEffectFn3 buildWidget spec build w
63 | Grafted g → EFn.runEffectFn1 build (runGraft g)
64 |
65 | type TextState a w =
66 | { build ∷ VDomMachine a w
67 | , node ∷ DOM.Node
68 | , value ∷ String
69 | }
70 |
71 | buildText ∷ ∀ a w. VDomBuilder String a w
72 | buildText = EFn.mkEffectFn3 \(VDomSpec spec) build s → do
73 | node ← EFn.runEffectFn2 Util.createTextNode s spec.document
74 | let state = { build, node, value: s }
75 | pure $ mkStep $ Step node state patchText haltText
76 |
77 | patchText ∷ ∀ a w. EFn.EffectFn2 (TextState a w) (VDom a w) (VDomStep a w)
78 | patchText = EFn.mkEffectFn2 \state vdom → do
79 | let { build, node, value: value1 } = state
80 | case vdom of
81 | Grafted g →
82 | EFn.runEffectFn2 patchText state (runGraft g)
83 | Text value2
84 | | value1 == value2 →
85 | pure $ mkStep $ Step node state patchText haltText
86 | | otherwise → do
87 | let nextState = { build, node, value: value2 }
88 | EFn.runEffectFn2 Util.setTextContent value2 node
89 | pure $ mkStep $ Step node nextState patchText haltText
90 | _ → do
91 | EFn.runEffectFn1 haltText state
92 | EFn.runEffectFn1 build vdom
93 |
94 | haltText ∷ ∀ a w. EFn.EffectFn1 (TextState a w) Unit
95 | haltText = EFn.mkEffectFn1 \{ node } → do
96 | parent ← EFn.runEffectFn1 Util.parentNode node
97 | EFn.runEffectFn2 Util.removeChild node parent
98 |
99 | type ElemState a w =
100 | { build ∷ VDomMachine a w
101 | , node ∷ DOM.Node
102 | , attrs ∷ Step a Unit
103 | , ns ∷ Maybe Namespace
104 | , name ∷ ElemName
105 | , children ∷ Array (VDomStep a w)
106 | }
107 |
108 | buildElem ∷ ∀ a w. VDomBuilder4 (Maybe Namespace) ElemName a (Array (VDom a w)) a w
109 | buildElem = EFn.mkEffectFn6 \(VDomSpec spec) build ns1 name1 as1 ch1 → do
110 | el ← EFn.runEffectFn3 Util.createElement (toNullable ns1) name1 spec.document
111 | let
112 | node = DOMElement.toNode el
113 | onChild = EFn.mkEffectFn2 \ix child → do
114 | res ← EFn.runEffectFn1 build child
115 | EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
116 | pure res
117 | children ← EFn.runEffectFn2 Util.forE ch1 onChild
118 | attrs ← EFn.runEffectFn1 (spec.buildAttributes el) as1
119 | let
120 | state =
121 | { build
122 | , node
123 | , attrs
124 | , ns: ns1
125 | , name: name1
126 | , children
127 | }
128 | pure $ mkStep $ Step node state patchElem haltElem
129 |
130 | patchElem ∷ ∀ a w. EFn.EffectFn2 (ElemState a w) (VDom a w) (VDomStep a w)
131 | patchElem = EFn.mkEffectFn2 \state vdom → do
132 | let { build, node, attrs, ns: ns1, name: name1, children: ch1 } = state
133 | case vdom of
134 | Grafted g →
135 | EFn.runEffectFn2 patchElem state (runGraft g)
136 | Elem ns2 name2 as2 ch2 | Fn.runFn4 eqElemSpec ns1 name1 ns2 name2 → do
137 | case Array.length ch1, Array.length ch2 of
138 | 0, 0 → do
139 | attrs2 ← EFn.runEffectFn2 step attrs as2
140 | let
141 | nextState =
142 | { build
143 | , node
144 | , attrs: attrs2
145 | , ns: ns2
146 | , name: name2
147 | , children: ch1
148 | }
149 | pure $ mkStep $ Step node nextState patchElem haltElem
150 | _, _ → do
151 | let
152 | onThese = EFn.mkEffectFn3 \ix s v → do
153 | res ← EFn.runEffectFn2 step s v
154 | EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
155 | pure res
156 | onThis = EFn.mkEffectFn2 \_ s → EFn.runEffectFn1 halt s
157 | onThat = EFn.mkEffectFn2 \ix v → do
158 | res ← EFn.runEffectFn1 build v
159 | EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
160 | pure res
161 | children2 ← EFn.runEffectFn5 Util.diffWithIxE ch1 ch2 onThese onThis onThat
162 | attrs2 ← EFn.runEffectFn2 step attrs as2
163 | let
164 | nextState =
165 | { build
166 | , node
167 | , attrs: attrs2
168 | , ns: ns2
169 | , name: name2
170 | , children: children2
171 | }
172 | pure $ mkStep $ Step node nextState patchElem haltElem
173 | _ → do
174 | EFn.runEffectFn1 haltElem state
175 | EFn.runEffectFn1 build vdom
176 |
177 | haltElem ∷ ∀ a w. EFn.EffectFn1 (ElemState a w) Unit
178 | haltElem = EFn.mkEffectFn1 \{ node, attrs, children } → do
179 | parent ← EFn.runEffectFn1 Util.parentNode node
180 | EFn.runEffectFn2 Util.removeChild node parent
181 | EFn.runEffectFn2 Util.forEachE children halt
182 | EFn.runEffectFn1 halt attrs
183 |
184 | type KeyedState a w =
185 | { build ∷ VDomMachine a w
186 | , node ∷ DOM.Node
187 | , attrs ∷ Step a Unit
188 | , ns ∷ Maybe Namespace
189 | , name ∷ ElemName
190 | , children ∷ Object.Object (VDomStep a w)
191 | , length ∷ Int
192 | }
193 |
194 | buildKeyed ∷ ∀ a w. VDomBuilder4 (Maybe Namespace) ElemName a (Array (Tuple String (VDom a w))) a w
195 | buildKeyed = EFn.mkEffectFn6 \(VDomSpec spec) build ns1 name1 as1 ch1 → do
196 | el ← EFn.runEffectFn3 Util.createElement (toNullable ns1) name1 spec.document
197 | let
198 | node = DOMElement.toNode el
199 | onChild = EFn.mkEffectFn3 \_ ix (Tuple _ vdom) → do
200 | res ← EFn.runEffectFn1 build vdom
201 | EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
202 | pure res
203 | children ← EFn.runEffectFn3 Util.strMapWithIxE ch1 fst onChild
204 | attrs ← EFn.runEffectFn1 (spec.buildAttributes el) as1
205 | let
206 | state =
207 | { build
208 | , node
209 | , attrs
210 | , ns: ns1
211 | , name: name1
212 | , children
213 | , length: Array.length ch1
214 | }
215 | pure $ mkStep $ Step node state patchKeyed haltKeyed
216 |
217 | patchKeyed ∷ ∀ a w. EFn.EffectFn2 (KeyedState a w) (VDom a w) (VDomStep a w)
218 | patchKeyed = EFn.mkEffectFn2 \state vdom → do
219 | let { build, node, attrs, ns: ns1, name: name1, children: ch1, length: len1 } = state
220 | case vdom of
221 | Grafted g →
222 | EFn.runEffectFn2 patchKeyed state (runGraft g)
223 | Keyed ns2 name2 as2 ch2 | Fn.runFn4 eqElemSpec ns1 name1 ns2 name2 →
224 | case len1, Array.length ch2 of
225 | 0, 0 → do
226 | attrs2 ← EFn.runEffectFn2 Machine.step attrs as2
227 | let
228 | nextState =
229 | { build
230 | , node
231 | , attrs: attrs2
232 | , ns: ns2
233 | , name: name2
234 | , children: ch1
235 | , length: 0
236 | }
237 | pure $ mkStep $ Step node nextState patchKeyed haltKeyed
238 | _, len2 → do
239 | let
240 | onThese = EFn.mkEffectFn4 \_ ix' s (Tuple _ v) → do
241 | res ← EFn.runEffectFn2 step s v
242 | EFn.runEffectFn3 Util.insertChildIx ix' (extract res) node
243 | pure res
244 | onThis = EFn.mkEffectFn2 \_ s → EFn.runEffectFn1 halt s
245 | onThat = EFn.mkEffectFn3 \_ ix (Tuple _ v) → do
246 | res ← EFn.runEffectFn1 build v
247 | EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
248 | pure res
249 | children2 ← EFn.runEffectFn6 Util.diffWithKeyAndIxE ch1 ch2 fst onThese onThis onThat
250 | attrs2 ← EFn.runEffectFn2 step attrs as2
251 | let
252 | nextState =
253 | { build
254 | , node
255 | , attrs: attrs2
256 | , ns: ns2
257 | , name: name2
258 | , children: children2
259 | , length: len2
260 | }
261 | pure $ mkStep $ Step node nextState patchKeyed haltKeyed
262 | _ → do
263 | EFn.runEffectFn1 haltKeyed state
264 | EFn.runEffectFn1 build vdom
265 |
266 | haltKeyed ∷ ∀ a w. EFn.EffectFn1 (KeyedState a w) Unit
267 | haltKeyed = EFn.mkEffectFn1 \{ node, attrs, children } → do
268 | parent ← EFn.runEffectFn1 Util.parentNode node
269 | EFn.runEffectFn2 Util.removeChild node parent
270 | EFn.runEffectFn2 Util.forInE children (EFn.mkEffectFn2 \_ s → EFn.runEffectFn1 halt s)
271 | EFn.runEffectFn1 halt attrs
272 |
273 | type WidgetState a w =
274 | { build ∷ VDomMachine a w
275 | , widget ∷ Step w DOM.Node
276 | }
277 |
278 | buildWidget ∷ ∀ a w. VDomBuilder w a w
279 | buildWidget = EFn.mkEffectFn3 \(VDomSpec spec) build w → do
280 | res ← EFn.runEffectFn1 (spec.buildWidget (VDomSpec spec)) w
281 | let
282 | res' = res # unStep \(Step n _ _ _) →
283 | mkStep $ Step n { build, widget: res } patchWidget haltWidget
284 | pure res'
285 |
286 | patchWidget ∷ ∀ a w. EFn.EffectFn2 (WidgetState a w) (VDom a w) (VDomStep a w)
287 | patchWidget = EFn.mkEffectFn2 \state vdom → do
288 | let { build, widget } = state
289 | case vdom of
290 | Grafted g →
291 | EFn.runEffectFn2 patchWidget state (runGraft g)
292 | Widget w → do
293 | res ← EFn.runEffectFn2 step widget w
294 | let
295 | res' = res # unStep \(Step n _ _ _) →
296 | mkStep $ Step n { build, widget: res } patchWidget haltWidget
297 | pure res'
298 | _ → do
299 | EFn.runEffectFn1 haltWidget state
300 | EFn.runEffectFn1 build vdom
301 |
302 | haltWidget ∷ forall a w. EFn.EffectFn1 (WidgetState a w) Unit
303 | haltWidget = EFn.mkEffectFn1 \{ widget } → do
304 | EFn.runEffectFn1 halt widget
305 |
306 | eqElemSpec ∷ Fn.Fn4 (Maybe Namespace) ElemName (Maybe Namespace) ElemName Boolean
307 | eqElemSpec = Fn.mkFn4 \ns1 (ElemName name1) ns2 (ElemName name2) →
308 | if name1 == name2
309 | then case ns1, ns2 of
310 | Just (Namespace ns1'), Just (Namespace ns2') | ns1' == ns2' → true
311 | Nothing, Nothing → true
312 | _, _ → false
313 | else false
314 |
--------------------------------------------------------------------------------