diff --git a/.gitignore b/.gitignore
index 7224331..b546736 100644
--- a/.gitignore
+++ b/.gitignore
@@ -6,3 +6,6 @@ package-lock.json
/bower_components/
/node_modules/
/output/
+/app.js
+/hydration-test.js
+/yarn-error.log
diff --git a/HOW_DOM_ATTRIBUTES_AND_PROPERTIES_WORK.md b/HOW_DOM_ATTRIBUTES_AND_PROPERTIES_WORK.md
new file mode 100644
index 0000000..93dd8f2
--- /dev/null
+++ b/HOW_DOM_ATTRIBUTES_AND_PROPERTIES_WORK.md
@@ -0,0 +1,41 @@
+# How .attributes work
+
+`$0.attributes` are:
+- is { required: "" }
+- is { required: "false" }
+-
is { colspan: "1" }, but prop is colSpan = 1
+-
is { "foo:data-foo": "1" }
+
+# Properties
+
+```
+Having ``
+If do `$0.required = true` in chrome.
+ THE html ``
+ THE $0.attributes = { required: "true" }
+```
+
+```
+Having ``
+If do `$0.required = false` in chrome.
+ THE html ``
+ THE $0.attributes = {}
+```
+
+# How .dataset property works? should we support it?
+
+```
+Having ``
+ The `$0.attributes`
+ `NamedNodeMap { id: "1", data-foo: "foo", data-bar: "bar", data-baz-bak: "baz-bak", someint: "1" }`
+ The `$0.dataset`
+ `DOMStringMap { foo: "foo", bar: "bar", bazBak: "baz-bak", someint: "1" }`
+```
+
+Also, react doesnt support dataset property during hydration. Proof:
+
+- server = `
`
+- client = ``
+- errorMessage = `Prop `dataset` did not match. Server: "null" Client: "[object Object]"`
+
+thus, react does support `data-***` attributes, but doesn't support `dataset` property, so why bother with supporting `dataset` property?
diff --git a/hydration-test.html b/hydration-test.html
new file mode 100644
index 0000000..5c6f27c
--- /dev/null
+++ b/hydration-test.html
@@ -0,0 +1,25 @@
+
+
+
+
+
+
+ hydration test
+
+
+
+
+
+
+
test label 1
test label 2
+
+
+
+
+
+
+
diff --git a/package.json b/package.json
index a9b2aa6..a213117 100644
--- a/package.json
+++ b/package.json
@@ -3,7 +3,11 @@
"scripts": {
"clean": "rimraf output && rimraf",
"test": "pulp build -I test -- --censor-lib --strict",
- "build": "pulp build -- --censor-lib --strict"
+ "build": "pulp build -- --censor-lib --strict",
+ "spago:test": "spago bundle-app --main Test.Main --to app.js",
+ "spago:hydration-test": "spago bundle-app --main Test.Hydration --to hydration-test.js",
+ "spago:test:watch": "yarn run spago:test --watch",
+ "spago:hydration-test:watch": "yarn run spago:hydration-test --watch"
},
"devDependencies": {
"pulp": "^15.0.0",
diff --git a/packages.dhall b/packages.dhall
new file mode 100644
index 0000000..dffed93
--- /dev/null
+++ b/packages.dhall
@@ -0,0 +1,128 @@
+{-
+Welcome to your new Dhall package-set!
+
+Below are instructions for how to edit this file for most use
+cases, so that you don't need to know Dhall to use it.
+
+## Warning: Don't Move This Top-Level Comment!
+
+Due to how `dhall format` currently works, this comment's
+instructions cannot appear near corresponding sections below
+because `dhall format` will delete the comment. However,
+it will not delete a top-level comment like this one.
+
+## Use Cases
+
+Most will want to do one or both of these options:
+1. Override/Patch a package's dependency
+2. Add a package not already in the default package set
+
+This file will continue to work whether you use one or both options.
+Instructions for each option are explained below.
+
+### Overriding/Patching a package
+
+Purpose:
+- Change a package's dependency to a newer/older release than the
+ default package set's release
+- Use your own modified version of some dependency that may
+ include new API, changed API, removed API by
+ using your custom git repo of the library rather than
+ the package set's repo
+
+Syntax:
+Replace the overrides' "{=}" (an empty record) with the following idea
+The "//" or "⫽" means "merge these two records and
+ when they have the same value, use the one on the right:"
+-------------------------------
+let overrides =
+ { packageName =
+ upstream.packageName // { updateEntity1 = "new value", updateEntity2 = "new value" }
+ , packageName =
+ upstream.packageName // { version = "v4.0.0" }
+ , packageName =
+ upstream.packageName // { repo = "https://www.example.com/path/to/new/repo.git" }
+ }
+-------------------------------
+
+Example:
+-------------------------------
+let overrides =
+ { halogen =
+ upstream.halogen // { version = "master" }
+ , halogen-vdom =
+ upstream.halogen-vdom // { version = "v4.0.0" }
+ }
+-------------------------------
+
+### Additions
+
+Purpose:
+- Add packages that aren't already included in the default package set
+
+Syntax:
+Replace the additions' "{=}" (an empty record) with the following idea:
+-------------------------------
+let additions =
+ { package-name =
+ { dependencies =
+ [ "dependency1"
+ , "dependency2"
+ ]
+ , repo =
+ "https://example.com/path/to/git/repo.git"
+ , version =
+ "tag ('v4.0.0') or branch ('master')"
+ }
+ , package-name =
+ { dependencies =
+ [ "dependency1"
+ , "dependency2"
+ ]
+ , repo =
+ "https://example.com/path/to/git/repo.git"
+ , version =
+ "tag ('v4.0.0') or branch ('master')"
+ }
+ , etc.
+ }
+-------------------------------
+
+Example:
+-------------------------------
+let additions =
+ { benchotron =
+ { dependencies =
+ [ "arrays"
+ , "exists"
+ , "profunctor"
+ , "strings"
+ , "quickcheck"
+ , "lcg"
+ , "transformers"
+ , "foldable-traversable"
+ , "exceptions"
+ , "node-fs"
+ , "node-buffer"
+ , "node-readline"
+ , "datetime"
+ , "now"
+ ]
+ , repo =
+ "https://github.com/hdgarrood/purescript-benchotron.git"
+ , version =
+ "v7.0.0"
+ }
+ }
+-------------------------------
+-}
+
+
+let upstream =
+ /home/srghma/projects/package-sets/src/packages.dhall
+
+let overrides = {=}
+
+let additions = {=}
+
+in upstream // overrides // additions
diff --git a/spago.dhall b/spago.dhall
new file mode 100644
index 0000000..9cd6c00
--- /dev/null
+++ b/spago.dhall
@@ -0,0 +1,28 @@
+{-
+Welcome to a Spago project!
+You can edit this file as you like.
+-}
+{ name = "halogen-vdom"
+, dependencies =
+ [ "bifunctors"
+ , "console"
+ , "effect"
+ , "exists"
+ , "foreign"
+ , "foreign-object"
+ , "js-timers"
+ , "maybe"
+ , "prelude"
+ , "psci-support"
+ , "refs"
+ , "tuples"
+ , "unsafe-coerce"
+ , "web-html"
+ , "web-dom"
+ , "strings"
+ , "control"
+ , "lazy"
+ ]
+, packages = ./packages.dhall
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
+}
diff --git a/src/Halogen/VDom.purs b/src/Halogen/VDom.purs
index 797aa13..1261cce 100644
--- a/src/Halogen/VDom.purs
+++ b/src/Halogen/VDom.purs
@@ -4,6 +4,6 @@ module Halogen.VDom
, module Types
) where
-import Halogen.VDom.DOM (VDomSpec(..), buildVDom) as DOM
+import Halogen.VDom.DOM (VDomSpec(..), VDomSpecWithHydration(..), buildVDom, hydrateVDom) as DOM
import Halogen.VDom.Machine (Machine, Step, Step'(..), mkStep, unStep, extract, step, halt) as Machine
import Halogen.VDom.Types (VDom(..), Graft, runGraft, ElemName(..), Namespace(..)) as Types
diff --git a/src/Halogen/VDom/Attributes.js b/src/Halogen/VDom/Attributes.js
new file mode 100644
index 0000000..72d6dce
--- /dev/null
+++ b/src/Halogen/VDom/Attributes.js
@@ -0,0 +1,3 @@
+exports.attributes = function (el) {
+ return el.attributes;
+};
diff --git a/src/Halogen/VDom/Attributes.purs b/src/Halogen/VDom/Attributes.purs
new file mode 100644
index 0000000..a9f86f3
--- /dev/null
+++ b/src/Halogen/VDom/Attributes.purs
@@ -0,0 +1,19 @@
+module Halogen.VDom.Attributes where
+
+import Prelude (Unit)
+
+import Web.DOM.Element as DOM
+import Effect.Uncurried as EFn
+import Unsafe.Coerce (unsafeCoerce)
+import Halogen.VDom.Util as Util
+
+data NamedNodeMap
+
+foreign import attributes ∷ DOM.Element → NamedNodeMap
+
+forEachE
+ ∷ EFn.EffectFn2
+ NamedNodeMap
+ (EFn.EffectFn1 { name :: String } Unit)
+ Unit
+forEachE = unsafeCoerce Util.forEachE
diff --git a/src/Halogen/VDom/DOM.purs b/src/Halogen/VDom/DOM.purs
index 83d7b3a..6e21b4e 100644
--- a/src/Halogen/VDom/DOM.purs
+++ b/src/Halogen/VDom/DOM.purs
@@ -1,47 +1,34 @@
module Halogen.VDom.DOM
- ( VDomSpec(..)
+ ( module Export
, buildVDom
- , buildText
- , buildElem
- , buildKeyed
- , buildWidget
+ , hydrateVDom
) where
-import Prelude
-
-import Data.Array as Array
-import Data.Function.Uncurried as Fn
-import Data.Maybe (Maybe(..))
-import Data.Nullable (toNullable)
-import Data.Tuple (Tuple(..), fst)
import Effect.Uncurried as EFn
-import Foreign.Object as Object
-import Halogen.VDom.Machine (Machine, Step, Step'(..), extract, halt, mkStep, step, unStep)
-import Halogen.VDom.Machine as Machine
-import Halogen.VDom.Types (ElemName(..), Namespace(..), VDom(..), runGraft)
-import Halogen.VDom.Util as Util
-import Web.DOM.Document (Document) as DOM
-import Web.DOM.Element (Element) as DOM
-import Web.DOM.Element as DOMElement
+import Halogen.VDom.DOM.Elem (buildElem) as Export
+import Halogen.VDom.DOM.Elem (buildElem, hydrateElem)
+import Halogen.VDom.DOM.Keyed (buildKeyed) as Export
+import Halogen.VDom.DOM.Keyed (buildKeyed, hydrateKeyed)
+import Halogen.VDom.DOM.Text (buildText) as Export
+import Halogen.VDom.DOM.Text (buildText, hydrateText)
+import Halogen.VDom.DOM.Types (VDomMachine, VDomSpec, VDomSpecWithHydration(..))
+import Halogen.VDom.DOM.Types (VDomSpec(..), VDomSpecWithHydration(..)) as Export
+import Halogen.VDom.DOM.Widget (buildWidget) as Export
+import Halogen.VDom.DOM.Widget (buildWidget, hydrateWidget)
+import Halogen.VDom.Types (VDom(..), runGraft)
import Web.DOM.Node (Node) as DOM
-type VDomMachine a w = Machine (VDom a w) DOM.Node
-
-type VDomStep a w = Step (VDom a w) DOM.Node
-
-type VDomInit i a w = EFn.EffectFn1 i (VDomStep a w)
-
-type VDomBuilder i a w = EFn.EffectFn3 (VDomSpec a w) (VDomMachine a w) i (VDomStep a w)
-
-type VDomBuilder4 i j k l a w = EFn.EffectFn6 (VDomSpec a w) (VDomMachine a w) i j k l (VDomStep a w)
-
--- | Widget machines recursively reference the configured spec to potentially
--- | enable recursive trees of Widgets.
-newtype VDomSpec a w = VDomSpec
- { buildWidget ∷ VDomSpec a w → Machine w DOM.Node
- , buildAttributes ∷ DOM.Element → Machine a Unit
- , document ∷ DOM.Document
- }
+hydrateVDom ∷ ∀ a w. VDomSpecWithHydration a w → DOM.Node -> VDomMachine a w
+hydrateVDom specWithHydration@(VDomSpecWithHydration specWithHydration') rootNode = hydrate rootNode
+ where
+ build = buildVDom specWithHydration'.vdomSpec
+ hydrate node = EFn.mkEffectFn1 \vdom -> do
+ case vdom of
+ Text s → EFn.runEffectFn5 hydrateText node specWithHydration hydrate build s
+ Elem namespace elemName attribute childrenVdoms → EFn.runEffectFn8 hydrateElem node specWithHydration hydrate build namespace elemName attribute childrenVdoms
+ Keyed namespace elemName attribute keyedChildrenVdoms → EFn.runEffectFn8 hydrateKeyed node specWithHydration hydrate build namespace elemName attribute keyedChildrenVdoms
+ Widget w → EFn.runEffectFn5 hydrateWidget node specWithHydration hydrate build w
+ Grafted g → EFn.runEffectFn1 (hydrate node) (runGraft g)
-- | Starts an initial `VDom` machine by providing a `VDomSpec`.
-- |
@@ -55,259 +42,10 @@ newtype VDomSpec a w = VDomSpec
buildVDom ∷ ∀ a w. VDomSpec a w → VDomMachine a w
buildVDom spec = build
where
- build = EFn.mkEffectFn1 case _ of
- Text s → EFn.runEffectFn3 buildText spec build s
- Elem ns n a ch → EFn.runEffectFn6 buildElem spec build ns n a ch
- Keyed ns n a ch → EFn.runEffectFn6 buildKeyed spec build ns n a ch
- Widget w → EFn.runEffectFn3 buildWidget spec build w
- Grafted g → EFn.runEffectFn1 build (runGraft g)
-
-type TextState a w =
- { build ∷ VDomMachine a w
- , node ∷ DOM.Node
- , value ∷ String
- }
-
-buildText ∷ ∀ a w. VDomBuilder String a w
-buildText = EFn.mkEffectFn3 \(VDomSpec spec) build s → do
- node ← EFn.runEffectFn2 Util.createTextNode s spec.document
- let state = { build, node, value: s }
- pure $ mkStep $ Step node state patchText haltText
-
-patchText ∷ ∀ a w. EFn.EffectFn2 (TextState a w) (VDom a w) (VDomStep a w)
-patchText = EFn.mkEffectFn2 \state vdom → do
- let { build, node, value: value1 } = state
- case vdom of
- Grafted g →
- EFn.runEffectFn2 patchText state (runGraft g)
- Text value2
- | value1 == value2 →
- pure $ mkStep $ Step node state patchText haltText
- | otherwise → do
- let nextState = { build, node, value: value2 }
- EFn.runEffectFn2 Util.setTextContent value2 node
- pure $ mkStep $ Step node nextState patchText haltText
- _ → do
- EFn.runEffectFn1 haltText state
- EFn.runEffectFn1 build vdom
-
-haltText ∷ ∀ a w. EFn.EffectFn1 (TextState a w) Unit
-haltText = EFn.mkEffectFn1 \{ node } → do
- parent ← EFn.runEffectFn1 Util.parentNode node
- EFn.runEffectFn2 Util.removeChild node parent
-
-type ElemState a w =
- { build ∷ VDomMachine a w
- , node ∷ DOM.Node
- , attrs ∷ Step a Unit
- , ns ∷ Maybe Namespace
- , name ∷ ElemName
- , children ∷ Array (VDomStep a w)
- }
-
-buildElem ∷ ∀ a w. VDomBuilder4 (Maybe Namespace) ElemName a (Array (VDom a w)) a w
-buildElem = EFn.mkEffectFn6 \(VDomSpec spec) build ns1 name1 as1 ch1 → do
- el ← EFn.runEffectFn3 Util.createElement (toNullable ns1) name1 spec.document
- let
- node = DOMElement.toNode el
- onChild = EFn.mkEffectFn2 \ix child → do
- res ← EFn.runEffectFn1 build child
- EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
- pure res
- children ← EFn.runEffectFn2 Util.forE ch1 onChild
- attrs ← EFn.runEffectFn1 (spec.buildAttributes el) as1
- let
- state =
- { build
- , node
- , attrs
- , ns: ns1
- , name: name1
- , children
- }
- pure $ mkStep $ Step node state patchElem haltElem
-
-patchElem ∷ ∀ a w. EFn.EffectFn2 (ElemState a w) (VDom a w) (VDomStep a w)
-patchElem = EFn.mkEffectFn2 \state vdom → do
- let { build, node, attrs, ns: ns1, name: name1, children: ch1 } = state
- case vdom of
- Grafted g →
- EFn.runEffectFn2 patchElem state (runGraft g)
- Elem ns2 name2 as2 ch2 | Fn.runFn4 eqElemSpec ns1 name1 ns2 name2 → do
- case Array.length ch1, Array.length ch2 of
- 0, 0 → do
- attrs2 ← EFn.runEffectFn2 step attrs as2
- let
- nextState =
- { build
- , node
- , attrs: attrs2
- , ns: ns2
- , name: name2
- , children: ch1
- }
- pure $ mkStep $ Step node nextState patchElem haltElem
- _, _ → do
- let
- onThese = EFn.mkEffectFn3 \ix s v → do
- res ← EFn.runEffectFn2 step s v
- EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
- pure res
- onThis = EFn.mkEffectFn2 \ix s → EFn.runEffectFn1 halt s
- onThat = EFn.mkEffectFn2 \ix v → do
- res ← EFn.runEffectFn1 build v
- EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
- pure res
- children2 ← EFn.runEffectFn5 Util.diffWithIxE ch1 ch2 onThese onThis onThat
- attrs2 ← EFn.runEffectFn2 step attrs as2
- let
- nextState =
- { build
- , node
- , attrs: attrs2
- , ns: ns2
- , name: name2
- , children: children2
- }
- pure $ mkStep $ Step node nextState patchElem haltElem
- _ → do
- EFn.runEffectFn1 haltElem state
- EFn.runEffectFn1 build vdom
-
-haltElem ∷ ∀ a w. EFn.EffectFn1 (ElemState a w) Unit
-haltElem = EFn.mkEffectFn1 \{ node, attrs, children } → do
- parent ← EFn.runEffectFn1 Util.parentNode node
- EFn.runEffectFn2 Util.removeChild node parent
- EFn.runEffectFn2 Util.forEachE children halt
- EFn.runEffectFn1 halt attrs
-
-type KeyedState a w =
- { build ∷ VDomMachine a w
- , node ∷ DOM.Node
- , attrs ∷ Step a Unit
- , ns ∷ Maybe Namespace
- , name ∷ ElemName
- , children ∷ Object.Object (VDomStep a w)
- , length ∷ Int
- }
-
-buildKeyed ∷ ∀ a w. VDomBuilder4 (Maybe Namespace) ElemName a (Array (Tuple String (VDom a w))) a w
-buildKeyed = EFn.mkEffectFn6 \(VDomSpec spec) build ns1 name1 as1 ch1 → do
- el ← EFn.runEffectFn3 Util.createElement (toNullable ns1) name1 spec.document
- let
- node = DOMElement.toNode el
- onChild = EFn.mkEffectFn3 \k ix (Tuple _ vdom) → do
- res ← EFn.runEffectFn1 build vdom
- EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
- pure res
- children ← EFn.runEffectFn3 Util.strMapWithIxE ch1 fst onChild
- attrs ← EFn.runEffectFn1 (spec.buildAttributes el) as1
- let
- state =
- { build
- , node
- , attrs
- , ns: ns1
- , name: name1
- , children
- , length: Array.length ch1
- }
- pure $ mkStep $ Step node state patchKeyed haltKeyed
-
-patchKeyed ∷ ∀ a w. EFn.EffectFn2 (KeyedState a w) (VDom a w) (VDomStep a w)
-patchKeyed = EFn.mkEffectFn2 \state vdom → do
- let { build, node, attrs, ns: ns1, name: name1, children: ch1, length: len1 } = state
- case vdom of
- Grafted g →
- EFn.runEffectFn2 patchKeyed state (runGraft g)
- Keyed ns2 name2 as2 ch2 | Fn.runFn4 eqElemSpec ns1 name1 ns2 name2 →
- case len1, Array.length ch2 of
- 0, 0 → do
- attrs2 ← EFn.runEffectFn2 Machine.step attrs as2
- let
- nextState =
- { build
- , node
- , attrs: attrs2
- , ns: ns2
- , name: name2
- , children: ch1
- , length: 0
- }
- pure $ mkStep $ Step node nextState patchKeyed haltKeyed
- _, len2 → do
- let
- onThese = EFn.mkEffectFn4 \_ ix' s (Tuple _ v) → do
- res ← EFn.runEffectFn2 step s v
- EFn.runEffectFn3 Util.insertChildIx ix' (extract res) node
- pure res
- onThis = EFn.mkEffectFn2 \_ s → EFn.runEffectFn1 halt s
- onThat = EFn.mkEffectFn3 \_ ix (Tuple _ v) → do
- res ← EFn.runEffectFn1 build v
- EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
- pure res
- children2 ← EFn.runEffectFn6 Util.diffWithKeyAndIxE ch1 ch2 fst onThese onThis onThat
- attrs2 ← EFn.runEffectFn2 step attrs as2
- let
- nextState =
- { build
- , node
- , attrs: attrs2
- , ns: ns2
- , name: name2
- , children: children2
- , length: len2
- }
- pure $ mkStep $ Step node nextState patchKeyed haltKeyed
- _ → do
- EFn.runEffectFn1 haltKeyed state
- EFn.runEffectFn1 build vdom
-
-haltKeyed ∷ ∀ a w. EFn.EffectFn1 (KeyedState a w) Unit
-haltKeyed = EFn.mkEffectFn1 \{ node, attrs, children } → do
- parent ← EFn.runEffectFn1 Util.parentNode node
- EFn.runEffectFn2 Util.removeChild node parent
- EFn.runEffectFn2 Util.forInE children (EFn.mkEffectFn2 \_ s → EFn.runEffectFn1 halt s)
- EFn.runEffectFn1 halt attrs
-
-type WidgetState a w =
- { build ∷ VDomMachine a w
- , widget ∷ Step w DOM.Node
- }
-
-buildWidget ∷ ∀ a w. VDomBuilder w a w
-buildWidget = EFn.mkEffectFn3 \(VDomSpec spec) build w → do
- res ← EFn.runEffectFn1 (spec.buildWidget (VDomSpec spec)) w
- let
- res' = res # unStep \(Step n s k1 k2) →
- mkStep $ Step n { build, widget: res } patchWidget haltWidget
- pure res'
-
-patchWidget ∷ ∀ a w. EFn.EffectFn2 (WidgetState a w) (VDom a w) (VDomStep a w)
-patchWidget = EFn.mkEffectFn2 \state vdom → do
- let { build, widget } = state
- case vdom of
- Grafted g →
- EFn.runEffectFn2 patchWidget state (runGraft g)
- Widget w → do
- res ← EFn.runEffectFn2 step widget w
- let
- res' = res # unStep \(Step n s k1 k2) →
- mkStep $ Step n { build, widget: res } patchWidget haltWidget
- pure res'
- _ → do
- EFn.runEffectFn1 haltWidget state
- EFn.runEffectFn1 build vdom
-
-haltWidget ∷ forall a w. EFn.EffectFn1 (WidgetState a w) Unit
-haltWidget = EFn.mkEffectFn1 \{ widget } → do
- EFn.runEffectFn1 halt widget
-
-eqElemSpec ∷ Fn.Fn4 (Maybe Namespace) ElemName (Maybe Namespace) ElemName Boolean
-eqElemSpec = Fn.mkFn4 \ns1 (ElemName name1) ns2 (ElemName name2) →
- if name1 == name2
- then case ns1, ns2 of
- Just (Namespace ns1'), Just (Namespace ns2') | ns1' == ns2' → true
- Nothing, Nothing → true
- _, _ → false
- else false
+ build = EFn.mkEffectFn1 \vdom -> do
+ case vdom of
+ Text s → EFn.runEffectFn3 buildText spec build s
+ Elem namespace elemName a childrenVdoms → EFn.runEffectFn6 buildElem spec build namespace elemName a childrenVdoms
+ Keyed namespace elemName a keyedChildrenVdoms → EFn.runEffectFn6 buildKeyed spec build namespace elemName a keyedChildrenVdoms
+ Widget w → EFn.runEffectFn3 buildWidget spec build w
+ Grafted g → EFn.runEffectFn1 build (runGraft g)
diff --git a/src/Halogen/VDom/DOM/Checkers.purs b/src/Halogen/VDom/DOM/Checkers.purs
new file mode 100644
index 0000000..b759435
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Checkers.purs
@@ -0,0 +1,73 @@
+module Halogen.VDom.DOM.Checkers where
+
+import Prelude
+
+import Data.Maybe (Maybe(..))
+import Effect (Effect)
+import Effect.Exception (error, throwException)
+import Effect.Uncurried as EFn
+import Halogen.VDom.Types (ElemName(..), Namespace)
+import Halogen.VDom.Util as Util
+import Partial.Unsafe (unsafePartial)
+import Unsafe.Coerce (unsafeCoerce)
+import Web.DOM as DOM
+import Web.DOM.CharacterData as DOM.CharacterData
+import Web.DOM.Element as DOM.Element
+import Web.DOM.Node as DOM.Node
+import Web.DOM.NodeType as DOM.NodeType
+import Web.DOM.Text as DOM.Text
+
+-- | Text checkers
+
+checkIsTextNode :: DOM.Node -> Effect DOM.Text
+checkIsTextNode node =
+ case DOM.Text.fromNode node of
+ Just text -> pure text
+ Nothing -> do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { node }
+ throwException $ error $ "Expected node to be a " <> show DOM.NodeType.TextNode <> ", but got " <> show (unsafePartial (DOM.Node.nodeType node)) <> " (check warning above for more information)"
+
+checkTextContentIsEqTo :: String -> DOM.Text -> Effect Unit
+checkTextContentIsEqTo expectedText text = do
+ textContent <- DOM.CharacterData.data_ (DOM.Text.toCharacterData text)
+ when (textContent /= expectedText) do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { text }
+ throwException $ error $ "Expected element text content to equal to " <> Util.quote expectedText <> ", but got " <> Util.quote textContent <> " (check warning above for more information)"
+
+-- | Elem checkers
+
+checkIsElementNode :: DOM.Node -> Effect DOM.Element
+checkIsElementNode node =
+ case DOM.Element.fromNode node of
+ Just text -> pure text
+ Nothing -> do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { node }
+ throwException $ error $ "Expected node to be a " <> show DOM.NodeType.ElementNode <> ", but got " <> show (unsafePartial (DOM.Node.nodeType node)) <> " (check warning above for more information)"
+
+checkTagNameIsEqualTo :: Maybe Namespace -> ElemName -> DOM.Element -> Effect Unit
+checkTagNameIsEqualTo maybeNamespace (ElemName elemName) element = do
+ let
+ localName :: String
+ localName = DOM.Element.localName element
+
+ when (localName /= elemName) do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { maybeNamespace, elemName, element }
+ throwException $ error $ "Expected element localName equal to " <> show elemName <> ", but got " <> show localName <> " (check warning above for more information)"
+
+ let
+ maybeNamespace' :: Maybe String
+ maybeNamespace' = unsafeCoerce maybeNamespace
+
+ namespaceURI :: Maybe String
+ namespaceURI = DOM.Element.namespaceURI element
+
+ -- | default namespace is "http://www.w3.org/1999/xhtml"
+ namespaceURI' :: Maybe String
+ namespaceURI' =
+ case namespaceURI of
+ Just "http://www.w3.org/1999/xhtml" -> Nothing
+ other -> other
+
+ when (namespaceURI' /= maybeNamespace') do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { maybeNamespace, elemName, element }
+ throwException $ error $ "Expected element namespaceURI equal to " <> show maybeNamespace' <> ", but got " <> show namespaceURI' <> " (check warning above for more information)"
diff --git a/src/Halogen/VDom/DOM/Elem.purs b/src/Halogen/VDom/DOM/Elem.purs
new file mode 100644
index 0000000..32c2e62
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Elem.purs
@@ -0,0 +1,172 @@
+module Halogen.VDom.DOM.Elem where
+
+import Prelude
+
+import Data.Array (fromFoldable, length) as Array
+import Data.Function.Uncurried as Fn
+import Data.List (List)
+import Data.List as List
+import Data.Maybe (Maybe)
+import Data.Nullable (toNullable)
+import Data.Traversable (for)
+import Effect (Effect)
+import Effect.Uncurried as EFn
+import Halogen.VDom.DOM.Checkers (checkIsElementNode, checkTagNameIsEqualTo)
+import Halogen.VDom.DOM.Types (VDomBuilder4, VDomHydrator4, VDomMachine, VDomSpec(..), VDomSpecWithHydration(..), VDomStep)
+import Halogen.VDom.DOM.Util as DOMUtil
+import Halogen.VDom.Machine (Step, Step'(..), extract, halt, mkStep, step)
+import Halogen.VDom.Types (ElemName, Namespace, VDom(..), runGraft)
+import Halogen.VDom.Util as Util
+import Web.DOM as DOM
+import Web.DOM.Element as DOM.Element
+import Web.DOM.Node as DOM.Node
+import Web.DOM.NodeList as DOM.NodeList
+
+type ElemState a w =
+ { build ∷ VDomMachine a w
+ , node ∷ DOM.Node
+ , attrs ∷ Step a Unit
+ , ns ∷ Maybe Namespace
+ , name ∷ ElemName
+ , children ∷ Array (VDomStep a w)
+ }
+
+hydrateElem
+ ∷ ∀ a w
+ . VDomHydrator4
+ (Maybe Namespace)
+ ElemName
+ a
+ (Array (VDom a w))
+ a
+ w
+hydrateElem = EFn.mkEffectFn8 \currentNode (VDomSpecWithHydration spec) hydrate build ns1 name1 as1 ch1 → do
+ currentElement <- checkIsElementNode currentNode
+ checkTagNameIsEqualTo ns1 name1 currentElement
+
+ (currentElementChildren :: List DOM.Node) <- DOM.Node.childNodes currentNode >>= DOM.NodeList.toArray <#> List.fromFoldable
+
+ let (currentElementChildren' :: List DOMUtil.ElementOrTextNode) = DOMUtil.listToElementOrTextNode currentElementChildren
+
+ (zippedChildren :: List { node :: DOM.Node, vdom :: VDom a w }) <-
+ EFn.runEffectFn6
+ DOMUtil.zipChildrenAndSplitTextNodes
+ (\(node :: DOMUtil.ElementOrTextNode) (vdom :: VDom a w) -> { node: DOMUtil.elementOrTextNodeToNode node, vdom })
+ identity
+ (case spec.vdomSpec of VDomSpec vdomSpec -> vdomSpec).document
+ currentNode
+ currentElementChildren'
+ (List.fromFoldable ch1)
+
+ let
+ onChild :: { node :: DOM.Node, vdom :: VDom a w } -> Effect (Step (VDom a w) DOM.Node)
+ onChild { node, vdom } = EFn.runEffectFn1 (hydrate node) vdom
+ (children :: Array (Step (VDom a w) DOM.Node)) <- for zippedChildren onChild <#> Array.fromFoldable
+ (attrs :: Step a Unit) ← EFn.runEffectFn1 (spec.hydrateAttributes currentElement) as1
+ let
+ state =
+ { build
+ , node: currentNode
+ , attrs
+ , ns: ns1
+ , name: name1
+ , children
+ }
+ pure $ mkStep $ Step currentNode state patchElem haltElem
+
+buildElem
+ ∷ ∀ a w
+ . VDomBuilder4
+ (Maybe Namespace)
+ ElemName
+ a
+ (Array (VDom a w))
+ a
+ w
+buildElem = EFn.mkEffectFn6 \(VDomSpec spec) build ns1 name1 as1 ch1 → do
+ el ← EFn.runEffectFn3 Util.createElement (toNullable ns1) name1 spec.document
+ let
+ node :: DOM.Node
+ node = DOM.Element.toNode el
+
+ onChild :: EFn.EffectFn2 Int (VDom a w) (Step (VDom a w) DOM.Node)
+ onChild = EFn.mkEffectFn2 \ix child → do
+ (res :: Step (VDom a w) DOM.Node) ← EFn.runEffectFn1 build child
+ EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
+ pure res
+ children ← EFn.runEffectFn2 Util.forE ch1 onChild
+ attrs ← EFn.runEffectFn1 (spec.buildAttributes el) as1
+ let
+ state =
+ { build
+ , node
+ , attrs
+ , ns: ns1
+ , name: name1
+ , children
+ }
+ pure $ mkStep $ Step node state patchElem haltElem
+
+patchElem ∷ ∀ a w. EFn.EffectFn2 (ElemState a w) (VDom a w) (VDomStep a w)
+patchElem = EFn.mkEffectFn2 \state vdom → do
+ let { build, node, attrs, ns: ns1, name: name1, children: ch1 } = state
+ case vdom of
+ Grafted g →
+ EFn.runEffectFn2 patchElem state (runGraft g)
+ Elem ns2 name2 as2 ch2 | Fn.runFn4 Util.eqElemSpec ns1 name1 ns2 name2 → do -- if new vdom is elem AND new and old are equal
+ case Array.length ch1, Array.length ch2 of
+ 0, 0 → do
+ attrs2 ← EFn.runEffectFn2 step attrs as2
+ let
+ nextState =
+ { build
+ , node
+ , attrs: attrs2
+ , ns: ns2
+ , name: name2
+ , children: ch1
+ }
+ pure $ mkStep $ Step node nextState patchElem haltElem
+ _, _ → do
+ let
+ -- both elements are found
+ onThese :: EFn.EffectFn3 Int (Step (VDom a w) DOM.Node) (VDom a w) (Step (VDom a w) DOM.Node)
+ onThese = EFn.mkEffectFn3 \ix (ch1Elem :: VDomStep a w) (ch2Elem :: VDom a w) → do
+ -- execute step function (compare previous dom and ch2Elem), the patchXXX function will be called for ch2Elem element
+ -- if elements are different - old element is removed from DOM, replaced with new but not yet attached to DOM
+ res ← EFn.runEffectFn2 step ch1Elem ch2Elem
+ EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
+ pure res
+
+ -- there are no more new elements in the new list, but there is an element in old list
+ onThis :: EFn.EffectFn2 Int (Step (VDom a w) DOM.Node) Unit
+ onThis = EFn.mkEffectFn2 \ix ch1Elem → EFn.runEffectFn1 halt ch1Elem
+
+ -- there are no more new elements in the old list, but there is an element in new list
+ onThat :: EFn.EffectFn2 Int (VDom a w) (Step (VDom a w) DOM.Node)
+ onThat = EFn.mkEffectFn2 \ix ch2Elem → do
+ res ← EFn.runEffectFn1 build ch2Elem
+ EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
+ pure res
+ (children2 :: Array (Step (VDom a w) DOM.Node)) ← EFn.runEffectFn5 Util.diffWithIxE ch1 ch2 onThese onThis onThat
+ (attrs2 :: Step a Unit) ← EFn.runEffectFn2 step attrs as2
+ let
+ nextState =
+ { build
+ , node
+ , attrs: attrs2
+ , ns: ns2
+ , name: name2
+ , children: children2
+ }
+ pure $ mkStep $ Step node nextState patchElem haltElem
+ _ → do
+ EFn.runEffectFn1 haltElem state
+ EFn.runEffectFn1 build vdom
+
+haltElem ∷ ∀ a w. EFn.EffectFn1 (ElemState a w) Unit
+haltElem = EFn.mkEffectFn1 \{ node, attrs, children } → do
+ parent ← EFn.runEffectFn1 Util.parentNode node
+ EFn.runEffectFn2 Util.removeChild node parent
+ EFn.runEffectFn2 Util.forEachE children halt
+ EFn.runEffectFn1 halt attrs
diff --git a/src/Halogen/VDom/DOM/Keyed.purs b/src/Halogen/VDom/DOM/Keyed.purs
new file mode 100644
index 0000000..fa00bec
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Keyed.purs
@@ -0,0 +1,169 @@
+module Halogen.VDom.DOM.Keyed where
+
+import Prelude
+
+import Data.Array as Array
+import Data.Function.Uncurried as Fn
+import Data.List (List)
+import Data.List as List
+import Data.Maybe (Maybe)
+import Data.Nullable (toNullable)
+import Data.Tuple (Tuple(..), fst, snd)
+import Effect.Uncurried as EFn
+import Foreign.Object as Object
+import Halogen.VDom.DOM.Checkers (checkIsElementNode, checkTagNameIsEqualTo)
+import Halogen.VDom.DOM.Types (VDomBuilder4, VDomHydrator4, VDomMachine, VDomSpec(..), VDomSpecWithHydration(..), VDomStep)
+import Halogen.VDom.DOM.Util as DOMUtil
+import Halogen.VDom.Machine (Step, Step'(..), extract, halt, mkStep, step)
+import Halogen.VDom.Machine as Machine
+import Halogen.VDom.Types (ElemName, Namespace, VDom(..), runGraft)
+import Halogen.VDom.Util as Util
+import Web.DOM.Element as DOM.Element
+import Web.DOM.Node (Node, childNodes) as DOM
+import Web.DOM.NodeList as DOM.NodeList
+
+type KeyedState a w =
+ { build ∷ VDomMachine a w
+ , node ∷ DOM.Node
+ , attrs ∷ Step a Unit
+ , ns ∷ Maybe Namespace
+ , name ∷ ElemName
+ , children ∷ Object.Object (VDomStep a w)
+ , length ∷ Int
+ }
+
+hydrateKeyed
+ ∷ ∀ a w
+ . VDomHydrator4
+ (Maybe Namespace)
+ ElemName
+ a
+ (Array (Tuple String (VDom a w)))
+ a
+ w
+hydrateKeyed = EFn.mkEffectFn8 \currentNode (VDomSpecWithHydration spec) hydrate build ns1 name1 as1 keyedChildren1 → do
+ currentElement <- checkIsElementNode currentNode
+ checkTagNameIsEqualTo ns1 name1 currentElement
+
+ (currentElementChildren :: List DOM.Node) <- DOM.childNodes currentNode >>= DOM.NodeList.toArray <#> List.fromFoldable
+
+ let (currentElementChildren' :: List DOMUtil.ElementOrTextNode) = DOMUtil.listToElementOrTextNode currentElementChildren
+
+ (zippedChildren :: List { node :: DOM.Node, vdom :: VDom a w, key :: String }) <-
+ EFn.runEffectFn6
+ DOMUtil.zipChildrenAndSplitTextNodes
+ (\(node :: DOMUtil.ElementOrTextNode) (Tuple key vdom) -> { node: DOMUtil.elementOrTextNodeToNode node, vdom, key })
+ snd
+ (case spec.vdomSpec of VDomSpec vdomSpec -> vdomSpec).document
+ currentNode
+ currentElementChildren'
+ (List.fromFoldable keyedChildren1)
+
+ let
+ onChild :: EFn.EffectFn3 String Int ({ node :: DOM.Node, vdom :: VDom a w, key :: String }) (Step (VDom a w) DOM.Node)
+ onChild = EFn.mkEffectFn3 \k ix ({ node, vdom }) → EFn.runEffectFn1 (hydrate node) vdom
+ (children :: Object.Object (Step (VDom a w) DOM.Node)) ←
+ EFn.runEffectFn3
+ Util.strMapWithIxE
+ (Array.fromFoldable zippedChildren)
+ (\{ key } → key)
+ onChild
+ (attrs :: Step a Unit) ← EFn.runEffectFn1 (spec.hydrateAttributes currentElement) as1
+ let
+ state =
+ { build
+ , node: currentNode
+ , attrs
+ , ns: ns1
+ , name: name1
+ , children
+ , length: Array.length keyedChildren1
+ }
+ pure $ mkStep $ Step currentNode state patchKeyed haltKeyed
+
+buildKeyed ∷ ∀ a w. VDomBuilder4 (Maybe Namespace) ElemName a (Array (Tuple String (VDom a w))) a w
+buildKeyed = EFn.mkEffectFn6 \(VDomSpec spec) build ns1 name1 as1 keyedChildren1 → do
+ el ← EFn.runEffectFn3 Util.createElement (toNullable ns1) name1 spec.document
+ let
+ node :: DOM.Node
+ node = DOM.Element.toNode el
+
+ onChild :: EFn.EffectFn3 String Int (Tuple String (VDom a w)) (Step (VDom a w) DOM.Node)
+ onChild = EFn.mkEffectFn3 \k ix (Tuple _ vdom) → do
+ res ← EFn.runEffectFn1 build vdom
+ EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
+ pure res
+ (children :: Object.Object (Step (VDom a w) DOM.Node)) ← EFn.runEffectFn3 Util.strMapWithIxE keyedChildren1 fst onChild -- build keyed childrens
+ (attrs :: Step a Unit) ← EFn.runEffectFn1 (spec.buildAttributes el) as1
+ let
+ state =
+ { build
+ , node
+ , attrs
+ , ns: ns1
+ , name: name1
+ , children
+ , length: Array.length keyedChildren1
+ }
+ pure $ mkStep $ Step node state patchKeyed haltKeyed
+
+patchKeyed ∷ ∀ a w. EFn.EffectFn2 (KeyedState a w) (VDom a w) (VDomStep a w)
+patchKeyed = EFn.mkEffectFn2 \state vdom → do
+ let { build, node, attrs, ns: ns1, name: name1, children: keyedChildren1, length: len1 } = state
+ case vdom of
+ Grafted g →
+ EFn.runEffectFn2 patchKeyed state (runGraft g)
+ Keyed ns2 name2 as2 ch2 | Fn.runFn4 Util.eqElemSpec ns1 name1 ns2 name2 →
+ case len1, Array.length ch2 of
+ 0, 0 → do
+ attrs2 ← EFn.runEffectFn2 Machine.step attrs as2
+ let
+ nextState =
+ { build
+ , node
+ , attrs: attrs2
+ , ns: ns2
+ , name: name2
+ , children: keyedChildren1
+ , length: 0
+ }
+ pure $ mkStep $ Step node nextState patchKeyed haltKeyed
+ _, len2 → do
+ let
+ onThese :: EFn.EffectFn4 String Int (Step (VDom a w) DOM.Node) (Tuple String (VDom a w)) (Step (VDom a w) DOM.Node)
+ onThese = EFn.mkEffectFn4 \_ ix' s (Tuple _ v) → do
+ res ← EFn.runEffectFn2 step s v
+ EFn.runEffectFn3 Util.insertChildIx ix' (extract res) node
+ pure res
+
+ onThis :: EFn.EffectFn2 String (Step (VDom a w) DOM.Node) Unit
+ onThis = EFn.mkEffectFn2 \_ s → EFn.runEffectFn1 halt s
+
+ onThat :: EFn.EffectFn3 String Int (Tuple String (VDom a w)) (Step (VDom a w) DOM.Node)
+ onThat = EFn.mkEffectFn3 \_ ix (Tuple _ v) → do
+ res ← EFn.runEffectFn1 build v
+ EFn.runEffectFn3 Util.insertChildIx ix (extract res) node
+ pure res
+ children2 ← EFn.runEffectFn6 Util.diffWithKeyAndIxE keyedChildren1 ch2 fst onThese onThis onThat
+ attrs2 ← EFn.runEffectFn2 step attrs as2
+ let
+ nextState =
+ { build
+ , node
+ , attrs: attrs2
+ , ns: ns2
+ , name: name2
+ , children: children2
+ , length: len2
+ }
+ pure $ mkStep $ Step node nextState patchKeyed haltKeyed
+ _ → do
+ EFn.runEffectFn1 haltKeyed state
+ EFn.runEffectFn1 build vdom
+
+haltKeyed ∷ ∀ a w. EFn.EffectFn1 (KeyedState a w) Unit
+haltKeyed = EFn.mkEffectFn1 \{ node, attrs, children } → do
+ parent ← EFn.runEffectFn1 Util.parentNode node
+ EFn.runEffectFn2 Util.removeChild node parent
+ EFn.runEffectFn2 Util.forInE children (EFn.mkEffectFn2 \_ s → EFn.runEffectFn1 halt s)
+ EFn.runEffectFn1 halt attrs
diff --git a/src/Halogen/VDom/DOM/Prop.purs b/src/Halogen/VDom/DOM/Prop.purs
index 6c24315..d64a0b5 100644
--- a/src/Halogen/VDom/DOM/Prop.purs
+++ b/src/Halogen/VDom/DOM/Prop.purs
@@ -1,204 +1,100 @@
module Halogen.VDom.DOM.Prop
- ( Prop(..)
- , ElemRef(..)
- , PropValue
- , propFromString
- , propFromBoolean
- , propFromInt
- , propFromNumber
+ ( module Export
, buildProp
+ , hydrateProp
) where
import Prelude
+import Halogen.VDom.DOM.Prop.Implementation (applyProp, diffProp, hydrateApplyProp, mbEmit, removeProp)
+import Halogen.VDom.DOM.Prop.Types (ElemRef(..), EventListenerAndCurrentEmitterInputBuilder, Prop(..), PropState, BuildPropFunction)
+import Halogen.VDom.DOM.Prop.Util (propToStrKey)
+import Halogen.VDom.Util (STObject')
import Data.Function.Uncurried as Fn
import Data.Maybe (Maybe(..))
-import Data.Nullable (null, toNullable)
-import Data.Tuple (Tuple(..), fst, snd)
-import Effect (Effect)
-import Effect.Ref as Ref
import Effect.Uncurried as EFn
-import Foreign (typeOf)
import Foreign.Object as Object
-import Halogen.VDom as V
-import Halogen.VDom.Machine (Step'(..), mkStep)
-import Halogen.VDom.Types (Namespace(..))
+import Halogen.VDom.Machine (Step, Step'(..), mkStep)
import Halogen.VDom.Util as Util
-import Unsafe.Coerce (unsafeCoerce)
-import Web.DOM.Element (Element) as DOM
-import Web.Event.Event (EventType(..), Event) as DOM
-import Web.Event.EventTarget (eventListener) as DOM
+import Halogen.VDom.DOM.Prop.Checkers (mkExtraAttributeNames, checkExtraAttributeNamesIsEmpty)
--- | Attributes, properties, event handlers, and element lifecycles.
--- | Parameterized by the type of handlers outputs.
-data Prop a
- = Attribute (Maybe Namespace) String String
- | Property String PropValue
- | Handler DOM.EventType (DOM.Event → Maybe a)
- | Ref (ElemRef DOM.Element → Maybe a)
+import Halogen.VDom.DOM.Prop.Types (Prop(..), ElemRef(..), PropValue, propFromString, propFromBoolean, propFromInt, propFromNumber) as Export
-instance functorProp ∷ Functor Prop where
- map f (Handler ty g) = Handler ty (map f <$> g)
- map f (Ref g) = Ref (map f <$> g)
- map f p = unsafeCoerce p
-
-data ElemRef a
- = Created a
- | Removed a
-
-instance functorElemRef ∷ Functor ElemRef where
- map f (Created a) = Created (f a)
- map f (Removed a) = Removed (f a)
-
-foreign import data PropValue ∷ Type
+hydrateProp
+ ∷ ∀ a
+ . BuildPropFunction a
+hydrateProp emit el = renderProp
+ where
+ renderProp ∷ EFn.EffectFn1 (Array (Prop a)) (Step (Array (Prop a)) Unit)
+ renderProp = EFn.mkEffectFn1 \ps1 → do
+ (events ∷ STObject' (EventListenerAndCurrentEmitterInputBuilder a)) ← Util.newMutMap
-propFromString ∷ String → PropValue
-propFromString = unsafeCoerce
+ extraAttributeNames ← mkExtraAttributeNames el
-propFromBoolean ∷ Boolean → PropValue
-propFromBoolean = unsafeCoerce
+ (props ∷ Object.Object (Prop a)) ← EFn.runEffectFn3 Util.strMapWithIxE ps1 propToStrKey (Fn.runFn4 hydrateApplyProp extraAttributeNames el emit events)
-propFromInt ∷ Int → PropValue
-propFromInt = unsafeCoerce
+ checkExtraAttributeNamesIsEmpty ps1 extraAttributeNames el
-propFromNumber ∷ Number → PropValue
-propFromNumber = unsafeCoerce
+ let
+ (state ∷ PropState a) =
+ { events: Util.unsafeFreeze events
+ , props
+ , el
+ , emit
+ }
+ pure $ mkStep $ Step unit state patchProp haltProp
-- | A `Machine`` for applying attributes, properties, and event handlers.
-- | An emitter effect must be provided to respond to events. For example,
-- | to allow arbitrary effects in event handlers, one could use `id`.
buildProp
∷ ∀ a
- . (a → Effect Unit)
- → DOM.Element
- → V.Machine (Array (Prop a)) Unit
+ . BuildPropFunction a
buildProp emit el = renderProp
where
+ renderProp ∷ EFn.EffectFn1 (Array (Prop a)) (Step (Array (Prop a)) Unit)
renderProp = EFn.mkEffectFn1 \ps1 → do
- events ← Util.newMutMap
- ps1' ← EFn.runEffectFn3 Util.strMapWithIxE ps1 propToStrKey (applyProp events)
+ (events ∷ STObject' (EventListenerAndCurrentEmitterInputBuilder a)) ← Util.newMutMap
+ (props ∷ Object.Object (Prop a)) ← EFn.runEffectFn3 Util.strMapWithIxE ps1 propToStrKey (Fn.runFn3 applyProp el emit events)
let
- state =
- { events: Util.unsafeFreeze events
- , props: ps1'
- }
- pure $ mkStep $ Step unit state patchProp haltProp
-
- patchProp = EFn.mkEffectFn2 \state ps2 → do
- events ← Util.newMutMap
- let
- { events: prevEvents, props: ps1 } = state
- onThese = Fn.runFn2 diffProp prevEvents events
- onThis = removeProp prevEvents
- onThat = applyProp events
- props ← EFn.runEffectFn6 Util.diffWithKeyAndIxE ps1 ps2 propToStrKey onThese onThis onThat
- let
- nextState =
+ (state ∷ PropState a) =
{ events: Util.unsafeFreeze events
, props
+ , el
+ , emit
}
- pure $ mkStep $ Step unit nextState patchProp haltProp
-
- haltProp = EFn.mkEffectFn1 \state → do
- case Object.lookup "ref" state.props of
- Just (Ref f) →
- EFn.runEffectFn1 mbEmit (f (Removed el))
- _ → pure unit
+ pure $ mkStep $ Step unit state patchProp haltProp
- mbEmit = EFn.mkEffectFn1 case _ of
- Just a → emit a
+patchProp ::
+ ∀ a
+ . EFn.EffectFn2
+ (PropState a)
+ (Array (Prop a))
+ (Step (Array (Prop a)) Unit)
+patchProp = EFn.mkEffectFn2 \state ps2 → do
+ events ← Util.newMutMap
+ let
+ { events: prevEvents, props: ps1, emit, el } = state
+ onThese = Fn.runFn3 diffProp el prevEvents events
+ onThis = Fn.runFn2 removeProp el prevEvents
+ onThat = Fn.runFn3 applyProp el emit events
+ props ← EFn.runEffectFn6 Util.diffWithKeyAndIxE ps1 ps2 propToStrKey onThese onThis onThat
+ let
+ nextState = -- TODO: reuse prev object
+ { events: Util.unsafeFreeze events
+ , props
+ , el
+ , emit
+ }
+ pure $ mkStep $ Step unit nextState patchProp haltProp
+
+haltProp
+ ∷ ∀ a
+ . EFn.EffectFn1
+ (PropState a)
+ Unit
+haltProp = EFn.mkEffectFn1 \state → do
+ case Object.lookup "ref" state.props of
+ Just (Ref emitterInputBuilder) →
+ EFn.runEffectFn2 mbEmit state.emit (emitterInputBuilder (Removed state.el))
_ → pure unit
-
- applyProp events = EFn.mkEffectFn3 \_ _ v →
- case v of
- Attribute ns attr val → do
- EFn.runEffectFn4 Util.setAttribute (toNullable ns) attr val el
- pure v
- Property prop val → do
- EFn.runEffectFn3 setProperty prop val el
- pure v
- Handler (DOM.EventType ty) f → do
- case Fn.runFn2 Util.unsafeGetAny ty events of
- handler | Fn.runFn2 Util.unsafeHasAny ty events → do
- Ref.write f (snd handler)
- pure v
- _ → do
- ref ← Ref.new f
- listener ← DOM.eventListener \ev → do
- f' ← Ref.read ref
- EFn.runEffectFn1 mbEmit (f' ev)
- EFn.runEffectFn3 Util.pokeMutMap ty (Tuple listener ref) events
- EFn.runEffectFn3 Util.addEventListener ty listener el
- pure v
- Ref f → do
- EFn.runEffectFn1 mbEmit (f (Created el))
- pure v
-
- diffProp = Fn.mkFn2 \prevEvents events → EFn.mkEffectFn4 \_ _ v1 v2 →
- case v1, v2 of
- Attribute _ _ val1, Attribute ns2 attr2 val2 →
- if val1 == val2
- then pure v2
- else do
- EFn.runEffectFn4 Util.setAttribute (toNullable ns2) attr2 val2 el
- pure v2
- Property _ val1, Property prop2 val2 →
- case Fn.runFn2 Util.refEq val1 val2, prop2 of
- true, _ →
- pure v2
- _, "value" → do
- let elVal = Fn.runFn2 unsafeGetProperty "value" el
- if Fn.runFn2 Util.refEq elVal val2
- then pure v2
- else do
- EFn.runEffectFn3 setProperty prop2 val2 el
- pure v2
- _, _ → do
- EFn.runEffectFn3 setProperty prop2 val2 el
- pure v2
- Handler _ _, Handler (DOM.EventType ty) f → do
- let
- handler = Fn.runFn2 Util.unsafeLookup ty prevEvents
- Ref.write f (snd handler)
- EFn.runEffectFn3 Util.pokeMutMap ty handler events
- pure v2
- _, _ →
- pure v2
-
- removeProp prevEvents = EFn.mkEffectFn2 \_ v →
- case v of
- Attribute ns attr _ →
- EFn.runEffectFn3 Util.removeAttribute (toNullable ns) attr el
- Property prop _ →
- EFn.runEffectFn2 removeProperty prop el
- Handler (DOM.EventType ty) _ → do
- let
- handler = Fn.runFn2 Util.unsafeLookup ty prevEvents
- EFn.runEffectFn3 Util.removeEventListener ty (fst handler) el
- Ref _ →
- pure unit
-
-propToStrKey ∷ ∀ i. Prop i → String
-propToStrKey = case _ of
- Attribute (Just (Namespace ns)) attr _ → "attr/" <> ns <> ":" <> attr
- Attribute _ attr _ → "attr/:" <> attr
- Property prop _ → "prop/" <> prop
- Handler (DOM.EventType ty) _ → "handler/" <> ty
- Ref _ → "ref"
-
-setProperty ∷ EFn.EffectFn3 String PropValue DOM.Element Unit
-setProperty = Util.unsafeSetAny
-
-unsafeGetProperty ∷ Fn.Fn2 String DOM.Element PropValue
-unsafeGetProperty = Util.unsafeGetAny
-
-removeProperty ∷ EFn.EffectFn2 String DOM.Element Unit
-removeProperty = EFn.mkEffectFn2 \key el →
- EFn.runEffectFn3 Util.hasAttribute null key el >>= if _
- then EFn.runEffectFn3 Util.removeAttribute null key el
- else case typeOf (Fn.runFn2 Util.unsafeGetAny key el) of
- "string" → EFn.runEffectFn3 Util.unsafeSetAny key "" el
- _ → case key of
- "rowSpan" → EFn.runEffectFn3 Util.unsafeSetAny key 1 el
- "colSpan" → EFn.runEffectFn3 Util.unsafeSetAny key 1 el
- _ → EFn.runEffectFn3 Util.unsafeSetAny key Util.jsUndefined el
diff --git a/src/Halogen/VDom/DOM/Prop/Checkers.purs b/src/Halogen/VDom/DOM/Prop/Checkers.purs
new file mode 100644
index 0000000..9c6f9d2
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Prop/Checkers.purs
@@ -0,0 +1,57 @@
+module Halogen.VDom.DOM.Prop.Checkers where
+
+import Prelude
+
+import Data.Function.Uncurried as Fn
+import Data.Maybe (Maybe(..))
+import Data.Nullable (toMaybe, toNullable)
+import Data.String.Common (joinWith)
+import Effect (Effect)
+import Effect.Exception (error, throwException)
+import Effect.Uncurried as EFn
+import Halogen.VDom.Attributes (attributes, forEachE) as Attributes
+import Halogen.VDom.DOM.Prop.Types (Prop, PropValue)
+import Halogen.VDom.DOM.Prop.Util (unsafeGetProperty)
+import Halogen.VDom.JsSet (JsSet)
+import Halogen.VDom.JsSet as JsSet
+import Halogen.VDom.Types (Namespace)
+import Halogen.VDom.Util as Util
+import Web.DOM.Element (Element) as DOM
+
+checkAttributeExistsAndIsEqual ∷ Maybe Namespace → String → String → DOM.Element → Effect Unit
+checkAttributeExistsAndIsEqual maybeNamespace attributeName expectedElementValue element = do
+ elementValue ← EFn.runEffectFn3 Util.getAttribute (toNullable maybeNamespace) attributeName element <#> toMaybe
+
+ case elementValue of
+ Nothing → do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { element }
+ throwException $ error $ "Expected element to have an attribute " <> Util.quote (Util.fullAttributeName maybeNamespace attributeName) <> " eq to " <> Util.quote expectedElementValue <> ", but it is missing (check warning above for more information)"
+ Just elementValue' →
+ unless (elementValue' == expectedElementValue) do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { element }
+ throwException $ error $ "Expected element to have an attribute " <> Util.quote (Util.fullAttributeName maybeNamespace attributeName) <> " eq to " <> Util.quote expectedElementValue <> ", but it was equal to " <> Util.quote elementValue' <> " (check warning above for more information)"
+
+checkPropExistsAndIsEqual ∷ String → PropValue → DOM.Element → Effect Unit
+checkPropExistsAndIsEqual propName expectedPropValue element = do
+ let propValue = Fn.runFn2 unsafeGetProperty propName element
+
+ unless (Fn.runFn2 Util.refEq propValue expectedPropValue) do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { element, propValue, expectedPropValue }
+ throwException $ error $ "Expected element to have a prop " <> Util.quote propName <> " eq to " <> Util.quote (Util.anyToString expectedPropValue) <> ", but it was equal to " <> Util.quote (Util.anyToString propValue) <> " (check warning above for more information)"
+
+-- | Inspired by https://github.com/facebook/react/blob/823dc581fea8814a904579e85a62da6d18258830/packages/react-dom/src/client/ReactDOMComponent.js#L1030
+mkExtraAttributeNames ∷ DOM.Element → Effect (JsSet String)
+mkExtraAttributeNames el = do
+ let
+ namedNodeMap = Attributes.attributes el
+ (set ∷ JsSet String) ← JsSet.empty
+ EFn.runEffectFn2 Attributes.forEachE namedNodeMap (EFn.mkEffectFn1 \attribute → EFn.runEffectFn2 JsSet._add attribute.name set)
+ pure set
+
+checkExtraAttributeNamesIsEmpty ∷ forall a . Array (Prop a) -> JsSet String -> DOM.Element -> Effect Unit
+checkExtraAttributeNamesIsEmpty propsToHydrate extraAttributeNames element = do
+ size <- EFn.runEffectFn1 JsSet._size extraAttributeNames
+ when (size > 0) do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { extraAttributeNames, element, propsToHydrate }
+ extraAttributeNames' <- EFn.runEffectFn1 JsSet._toArray extraAttributeNames
+ throwException $ error $ "Extra attributes from the server: " <> joinWith ", " extraAttributeNames' <> " (check warning above for more information)"
diff --git a/src/Halogen/VDom/DOM/Prop/Implementation.purs b/src/Halogen/VDom/DOM/Prop/Implementation.purs
new file mode 100644
index 0000000..d6efa28
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Prop/Implementation.purs
@@ -0,0 +1,219 @@
+module Halogen.VDom.DOM.Prop.Implementation where
+
+import Prelude
+
+import Data.Function.Uncurried as Fn
+import Data.Maybe (Maybe(..))
+import Data.Nullable (toNullable)
+import Data.String.Common (toLower)
+import Data.Tuple (Tuple(..), fst, snd)
+import Effect (Effect)
+import Effect.Exception (error, throwException)
+import Effect.Ref as Ref
+import Effect.Uncurried as EFn
+import Foreign.Object as Object
+import Halogen.VDom.DOM.Prop.Checkers (checkAttributeExistsAndIsEqual, checkPropExistsAndIsEqual)
+import Halogen.VDom.DOM.Prop.Types (ElemRef(..), EmitterInputBuilder, EventListenerAndCurrentEmitterInputBuilder, Prop(..), PropValue)
+import Halogen.VDom.DOM.Prop.Util (removeProperty, setProperty, unsafeGetProperty)
+import Halogen.VDom.JsSet (JsSet)
+import Halogen.VDom.JsSet as JsSet
+import Halogen.VDom.Util (STObject', anyToString, fullAttributeName, quote)
+import Halogen.VDom.Util as Util
+import Web.DOM.Element (Element) as DOM
+import Web.Event.Event (EventType(..), Event) as DOM
+import Web.Event.EventTarget (eventListener, EventListener) as DOM
+import Foreign (unsafeToForeign, typeOf)
+import Unsafe.Coerce (unsafeCoerce)
+
+deleteRequiredElement :: EFn.EffectFn2 String (JsSet String) Unit
+deleteRequiredElement = EFn.mkEffectFn2 \element extraAttributeNames -> do
+ isPresent <- EFn.runEffectFn2 JsSet._has element extraAttributeNames
+ if isPresent
+ then EFn.runEffectFn2 JsSet._delete element extraAttributeNames
+ else do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { element, extraAttributeNames }
+ throwException $ error $ "Cannot delete element " <> quote element <> " that is not present in extraAttributeNames (check warning above for more information)"
+
+checkPropExistsAndIsEqualAndDelete :: EFn.EffectFn5 (JsSet String) String PropValue DOM.Element String Unit
+checkPropExistsAndIsEqualAndDelete = EFn.mkEffectFn5 \extraAttributeNames propName val el correspondingAttributeName -> do
+ checkPropExistsAndIsEqual propName val el
+ EFn.runEffectFn2 deleteRequiredElement correspondingAttributeName extraAttributeNames
+
+hydrateApplyProp
+ ∷ ∀ a
+ . Fn.Fn4
+ (JsSet String)
+ DOM.Element
+ (a → Effect Unit)
+ (STObject' (EventListenerAndCurrentEmitterInputBuilder a))
+ (EFn.EffectFn3 String Int (Prop a) (Prop a))
+hydrateApplyProp = Fn.mkFn4 \extraAttributeNames el emit events → EFn.mkEffectFn3 \_ _ v →
+ case v of
+ Attribute maybeNamespace attributeName val → do
+ checkAttributeExistsAndIsEqual maybeNamespace attributeName val el
+ let fullAttributeName' = fullAttributeName maybeNamespace attributeName -- should be lowercased
+ EFn.runEffectFn2 deleteRequiredElement fullAttributeName' extraAttributeNames
+ pure v
+ Property propName val → do
+ case propName of
+ -- | We use custom check for "href" (i.e. checking attribute instead of property) because:
+ -- | with
+ -- | property $0.href is eq to "http://localhost:3000/foo"
+ -- | but attribute
+ -- | $0.attributes.href.value is eq to "/foo"
+ -- | $0.getAttribute("href") is eq to "/foo" too
+ -- |
+ -- | The same is true for elements also
+ "href" -> do
+ checkAttributeExistsAndIsEqual Nothing "href" (anyToString val) el
+ EFn.runEffectFn2 deleteRequiredElement "href" extraAttributeNames
+ -- | these 4 property names are taken from https://github.com/elm/virtual-dom/blob/5a5bcf48720bc7d53461b3cd42a9f19f119c5503/src/Elm/Kernel/VirtualDom.server.js#L196-L201
+ "className" -> EFn.runEffectFn5 checkPropExistsAndIsEqualAndDelete extraAttributeNames propName val el "class"
+ "htmlFor" -> EFn.runEffectFn5 checkPropExistsAndIsEqualAndDelete extraAttributeNames propName val el "for"
+ "httpEquiv" -> EFn.runEffectFn5 checkPropExistsAndIsEqualAndDelete extraAttributeNames propName val el "http-equiv"
+ "acceptCharset" -> EFn.runEffectFn5 checkPropExistsAndIsEqualAndDelete extraAttributeNames propName val el "accept-charset"
+ _ -> do
+ checkPropExistsAndIsEqual propName val el
+ case typeOf (unsafeToForeign val), (unsafeCoerce :: PropValue -> Boolean) val of
+ -- | If this is a boolean and is false - then it should not have been prerendered
+ -- |
+ -- | For example:
+ -- | `HH.button [HP.disabled false] []` should be rendered as ``
+ -- | `HH.button [HP.disabled true] []` should be rendered as ``
+ -- |
+ -- | Why it should NOT be rendered at all? Because
+ -- | `` the `$0.disabled === true`
+ -- | `` the `$0.disabled === true`
+ -- | `` the `$0.disabled === true`
+ -- | `` the `$0.disabled === true`
+ -- | `` the `$0.disabled === false`
+ "boolean", false -> pure unit
+ _, _ ->
+ let fullAttributeName' = toLower propName -- transforms `colSpan` to `colspan`
+ in EFn.runEffectFn2 deleteRequiredElement fullAttributeName' extraAttributeNames
+
+ pure v
+ Handler eventType emitterInputBuilder → do
+ EFn.runEffectFn5 applyPropHandler el emit events eventType emitterInputBuilder
+ pure v
+ Ref emitterInputBuilder → do
+ EFn.runEffectFn2 mbEmit emit (emitterInputBuilder (Created el))
+ pure v
+
+applyProp
+ ∷ ∀ a
+ . Fn.Fn3
+ DOM.Element
+ (a → Effect Unit)
+ (STObject' (EventListenerAndCurrentEmitterInputBuilder a))
+ (EFn.EffectFn3 String Int (Prop a) (Prop a))
+applyProp = Fn.mkFn3 \el emit events → EFn.mkEffectFn3 \_ _ v →
+ case v of
+ Attribute maybeNamespace attributeName val → do
+ EFn.runEffectFn4 Util.setAttribute (toNullable maybeNamespace) attributeName val el
+ pure v
+ Property propName val → do
+ EFn.runEffectFn3 setProperty propName val el
+ pure v
+ Handler eventType emitterInputBuilder → do
+ EFn.runEffectFn5 applyPropHandler el emit events eventType emitterInputBuilder
+ pure v
+ Ref emitterInputBuilder → do
+ EFn.runEffectFn2 mbEmit emit (emitterInputBuilder (Created el))
+ pure v
+
+applyPropHandler
+ ∷ ∀ a
+ . EFn.EffectFn5
+ DOM.Element
+ (a -> Effect Unit)
+ (STObject' (Tuple DOM.EventListener (Ref.Ref (DOM.Event -> Maybe a))))
+ DOM.EventType
+ (DOM.Event -> Maybe a)
+ Unit
+applyPropHandler = EFn.mkEffectFn5 \el emit events (DOM.EventType eventType) emitterInputBuilder →
+ case Fn.runFn2 Util.unsafeGetAny eventType events of
+ -- if eventType is already present in events storage / listened
+ handler | Fn.runFn2 Util.unsafeHasAny eventType events → do
+ -- replace current event listener with new
+ Ref.write emitterInputBuilder (snd handler)
+ _ → do
+ ref ← Ref.new emitterInputBuilder
+ listener ← DOM.eventListener \ev → do
+ (emitterInputBuilder' ∷ EmitterInputBuilder a) ← Ref.read ref
+ EFn.runEffectFn2 mbEmit emit (emitterInputBuilder' ev)
+
+ -- set/add to events map, key is eventType, value contains element listener (so we can remove it on halt) AND current emitterInputBuilder
+ EFn.runEffectFn3 Util.pokeMutMap eventType (Tuple listener ref) events
+
+ -- listen events of that type on the element
+ EFn.runEffectFn3 Util.addEventListener eventType listener el
+
+mbEmit
+ ∷ ∀ a
+ . EFn.EffectFn2
+ (a → Effect Unit)
+ (Maybe a)
+ Unit
+mbEmit = EFn.mkEffectFn2 \emit ma → case ma of
+ Just a → emit a
+ _ → pure unit
+
+diffProp
+ ∷ ∀ a
+ . Fn.Fn3
+ DOM.Element
+ (Object.Object (EventListenerAndCurrentEmitterInputBuilder a))
+ (STObject' (EventListenerAndCurrentEmitterInputBuilder a))
+ (EFn.EffectFn4 String Int (Prop a) (Prop a) (Prop a))
+diffProp = Fn.mkFn3 \el prevEvents events → EFn.mkEffectFn4 \_ _ v1 v2 →
+ case v1, v2 of
+ Attribute _ _ val1, Attribute ns2 attr2 val2 →
+ if val1 == val2
+ then pure v2
+ else do
+ EFn.runEffectFn4 Util.setAttribute (toNullable ns2) attr2 val2 el
+ pure v2
+ Property _ val1, Property prop2 val2 →
+ case Fn.runFn2 Util.refEq val1 val2, prop2 of
+ true, _ →
+ pure v2
+ -- | In many browsers, though it may not be the case anymore, setting the input value always resets the cursor position/selection.
+ -- | This avoids setting it if it has not changed so as not to reset the cursor when you are typing.
+ _, "value" → do
+ let elVal = Fn.runFn2 unsafeGetProperty "value" el
+ if Fn.runFn2 Util.refEq elVal val2
+ then pure v2
+ else do
+ EFn.runEffectFn3 setProperty prop2 val2 el
+ pure v2
+ _, _ → do
+ EFn.runEffectFn3 setProperty prop2 val2 el
+ pure v2
+ Handler _ _, Handler (DOM.EventType ty) emitterInputBuilder → do
+ let
+ handler = Fn.runFn2 Util.unsafeLookup ty prevEvents
+ Ref.write emitterInputBuilder (snd handler)
+ EFn.runEffectFn3 Util.pokeMutMap ty handler events
+ pure v2
+ _, _ →
+ pure v2
+
+removeProp
+ ∷ ∀ a
+ . Fn.Fn2
+ DOM.Element
+ (Object.Object (EventListenerAndCurrentEmitterInputBuilder a))
+ (EFn.EffectFn2 String (Prop a) Unit)
+removeProp = Fn.mkFn2 \el prevEvents → EFn.mkEffectFn2 \_ v →
+ case v of
+ Attribute maybeNamespace attributeName _ →
+ EFn.runEffectFn3 Util.removeAttribute (toNullable maybeNamespace) attributeName el
+ Property propName _ →
+ EFn.runEffectFn2 removeProperty propName el
+ Handler (DOM.EventType ty) _ → do
+ let
+ handler = Fn.runFn2 Util.unsafeLookup ty prevEvents
+ EFn.runEffectFn3 Util.removeEventListener ty (fst handler) el
+ Ref _ →
+ pure unit
diff --git a/src/Halogen/VDom/DOM/Prop/Types.purs b/src/Halogen/VDom/DOM/Prop/Types.purs
new file mode 100644
index 0000000..f0d9161
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Prop/Types.purs
@@ -0,0 +1,93 @@
+module Halogen.VDom.DOM.Prop.Types where
+
+import Prelude
+
+import Data.Maybe (Maybe)
+import Data.Tuple (Tuple)
+import Effect (Effect)
+import Effect.Ref as Ref
+import Foreign.Object as Object
+import Halogen.VDom.Machine (Machine)
+import Halogen.VDom.Types (Namespace)
+import Unsafe.Coerce (unsafeCoerce)
+import Web.DOM.Element (Element) as DOM
+import Web.Event.Event (Event, EventType) as DOM
+import Web.Event.EventTarget (EventListener) as DOM
+
+-- | Attributes, properties, event handlers, and element lifecycles.
+-- | Parameterized by the type of handlers outputs.
+
+-- | What is the difference between attributes and properties?
+-- |
+-- | Attributes are defined by HTML. Properties (on DOM elements) are defined by DOM.
+-- | E.g. `class` attribute corresponds to `element.className` property
+-- | almost always you should use properties on html elements, the svg elements don't have properties, only classes
+-- | more https://github.com/purescript-halogen/purescript-halogen-vdom/issues/30#issuecomment-518015764
+-- |
+-- | Also, attributes can be only strings, props - strings, numbers, booleans
+data Prop a
+ = Attribute
+ -- XML namespace
+ (Maybe Namespace)
+ -- Attribute name
+ String
+ -- Attribute value
+ String
+ | Property
+ -- Property name. Usually is equal to attribute name, exeptions are: "htmlFor" property is a "for" attribute, "className" - "class"
+ String
+ PropValue
+ | Handler
+ -- Event type to listen to
+ DOM.EventType
+ -- Function that builds input for emitter (EmitterInputBuilder), if Nothing is returned - emitter is not called
+ -- NOTE: If multiple event handlers are added for the same event for the same element - only last event handler is going to work
+ -- (e.g. like in `H.div [HP.eventHandler (...), HP.eventHandler (...)]`)
+ (DOM.Event → Maybe a)
+ | Ref
+ -- This function builds input for emitter function too, but when parent element is removed or created
+ -- If Nothing is returned - emitter is not called
+ -- NOTE: If multiple ref handlers are added for the same element - only last ref handler is going to work
+ (ElemRef DOM.Element → Maybe a)
+
+instance functorProp ∷ Functor Prop where
+ map f (Handler ty g) = Handler ty (map f <$> g)
+ map f (Ref g) = Ref (map f <$> g)
+ map f p = unsafeCoerce p
+
+data ElemRef a
+ = Created a
+ | Removed a
+
+instance functorElemRef ∷ Functor ElemRef where
+ map f (Created a) = Created (f a)
+ map f (Removed a) = Removed (f a)
+
+foreign import data PropValue ∷ Type
+
+propFromString ∷ String → PropValue
+propFromString = unsafeCoerce
+
+propFromBoolean ∷ Boolean → PropValue
+propFromBoolean = unsafeCoerce
+
+propFromInt ∷ Int → PropValue
+propFromInt = unsafeCoerce
+
+propFromNumber ∷ Number → PropValue
+propFromNumber = unsafeCoerce
+
+type EmitterInputBuilder a = DOM.Event → Maybe a
+type EventListenerAndCurrentEmitterInputBuilder a = Tuple DOM.EventListener (Ref.Ref (EmitterInputBuilder a))
+
+type PropState a =
+ { events ∷ Object.Object (EventListenerAndCurrentEmitterInputBuilder a)
+ , props ∷ Object.Object (Prop a)
+ , el ∷ DOM.Element
+ , emit ∷ a → Effect Unit
+ }
+
+type BuildPropFunction a
+ = (a → Effect Unit) -- Emitter, for example the global broadcaster function for all elements in halogen component
+ → DOM.Element
+ → Machine (Array (Prop a)) Unit
diff --git a/src/Halogen/VDom/DOM/Prop/Util.purs b/src/Halogen/VDom/DOM/Prop/Util.purs
new file mode 100644
index 0000000..068395a
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Prop/Util.purs
@@ -0,0 +1,39 @@
+module Halogen.VDom.DOM.Prop.Util where
+
+import Prelude (Unit, (<>), (>>=))
+
+import Data.Function.Uncurried as Fn
+import Data.Maybe (Maybe(..))
+import Data.Nullable (Nullable, null)
+import Effect.Uncurried as EFn
+import Foreign (typeOf)
+import Halogen.VDom.Types (Namespace(..))
+import Halogen.VDom.Util as Util
+import Web.DOM.Element (Element) as DOM
+import Web.Event.Event (EventType(..)) as DOM
+import Halogen.VDom.DOM.Prop.Types (Prop(..), PropValue)
+
+propToStrKey ∷ ∀ i. Prop i → String
+propToStrKey = case _ of
+ Attribute (Just (Namespace ns)) attr _ → "attr/" <> ns <> ":" <> attr
+ Attribute _ attr _ → "attr/:" <> attr
+ Property prop _ → "prop/" <> prop
+ Handler (DOM.EventType ty) _ → "handler/" <> ty
+ Ref _ → "ref"
+
+setProperty ∷ EFn.EffectFn3 String PropValue DOM.Element Unit
+setProperty = Util.unsafeSetAny
+
+unsafeGetProperty ∷ Fn.Fn2 String DOM.Element (Nullable PropValue)
+unsafeGetProperty = Util.unsafeGetAny
+
+removeProperty ∷ EFn.EffectFn2 String DOM.Element Unit
+removeProperty = EFn.mkEffectFn2 \key el →
+ EFn.runEffectFn3 Util.hasAttribute (null ∷ Nullable Namespace) key el >>= if _
+ then EFn.runEffectFn3 Util.removeAttribute (null ∷ Nullable Namespace) key el
+ else case typeOf (Fn.runFn2 Util.unsafeGetAny key el) of
+ "string" → EFn.runEffectFn3 Util.unsafeSetAny key "" el
+ _ → case key of
+ "rowSpan" → EFn.runEffectFn3 Util.unsafeSetAny key 1 el
+ "colSpan" → EFn.runEffectFn3 Util.unsafeSetAny key 1 el
+ _ → EFn.runEffectFn3 Util.unsafeSetAny key Util.jsUndefined el
diff --git a/src/Halogen/VDom/DOM/Text.purs b/src/Halogen/VDom/DOM/Text.purs
new file mode 100644
index 0000000..f19cec5
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Text.purs
@@ -0,0 +1,51 @@
+module Halogen.VDom.DOM.Text where
+
+import Effect.Uncurried as EFn
+import Halogen.VDom.DOM.Checkers (checkIsTextNode, checkTextContentIsEqTo)
+import Halogen.VDom.DOM.Types (VDomBuilder, VDomHydrator, VDomMachine, VDomSpec(..), VDomSpecWithHydration(..), VDomStep)
+import Halogen.VDom.Machine (Step'(..), mkStep)
+import Halogen.VDom.Types (VDom(..), runGraft)
+import Halogen.VDom.Util as Util
+import Prelude (Unit, bind, discard, otherwise, pure, ($), (==))
+import Web.DOM.Node (Node) as DOM
+
+type TextState a w =
+ { build ∷ VDomMachine a w
+ , node ∷ DOM.Node
+ , value ∷ String
+ }
+
+hydrateText ∷ ∀ a w. VDomHydrator String a w
+hydrateText = EFn.mkEffectFn5 \currentNode (VDomSpecWithHydration spec) _hydrate build s → do
+ currentText <- checkIsTextNode currentNode
+ checkTextContentIsEqTo s currentText
+ let (state :: TextState a w) = { build, node: currentNode, value: s }
+ pure $ mkStep $ Step currentNode state patchText haltText
+
+buildText ∷ ∀ a w. VDomBuilder String a w
+buildText = EFn.mkEffectFn3 \(VDomSpec spec) build s → do
+ node ← EFn.runEffectFn2 Util.createTextNode s spec.document
+ let (state :: TextState a w) = { build, node, value: s }
+ pure $ mkStep $ Step node state patchText haltText
+
+patchText ∷ ∀ a w. EFn.EffectFn2 (TextState a w) (VDom a w) (VDomStep a w)
+patchText = EFn.mkEffectFn2 \state vdom → do
+ let { build, node, value: value1 } = state
+ case vdom of
+ Grafted g →
+ EFn.runEffectFn2 patchText state (runGraft g) -- Before there was a Text on this place. We call patchText instead of patch to be able to remove text
+ Text value2
+ | value1 == value2 →
+ pure $ mkStep $ Step node state patchText haltText
+ | otherwise → do
+ let nextState = { build, node, value: value2 }
+ EFn.runEffectFn2 Util.setTextContent value2 node
+ pure $ mkStep $ Step node nextState patchText haltText
+ _ → do
+ EFn.runEffectFn1 haltText state
+ EFn.runEffectFn1 build vdom
+
+haltText ∷ ∀ a w. EFn.EffectFn1 (TextState a w) Unit
+haltText = EFn.mkEffectFn1 \{ node } → do
+ parent ← EFn.runEffectFn1 Util.parentNode node
+ EFn.runEffectFn2 Util.removeChild node parent
diff --git a/src/Halogen/VDom/DOM/Types.purs b/src/Halogen/VDom/DOM/Types.purs
new file mode 100644
index 0000000..e7a9a7a
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Types.purs
@@ -0,0 +1,55 @@
+module Halogen.VDom.DOM.Types where
+
+import Prelude
+
+import Effect.Uncurried as EFn
+import Halogen.VDom.Machine (Machine, Step)
+import Halogen.VDom.Types (VDom)
+import Web.DOM.Document (Document) as DOM
+import Web.DOM.Element (Element) as DOM
+import Web.DOM.Node (Node) as DOM
+
+type VDomMachine a w = Machine (VDom a w) DOM.Node
+
+type VDomStep a w = Step (VDom a w) DOM.Node
+
+type VDomInit i a w = EFn.EffectFn1 i (VDomStep a w)
+
+type VDomBuilder i a w = EFn.EffectFn3 (VDomSpec a w) (VDomMachine a w) i (VDomStep a w)
+
+type VDomHydrator i a w
+ = EFn.EffectFn5
+ DOM.Node -- current element
+ (VDomSpecWithHydration a w)
+ (DOM.Node -> VDomMachine a w) -- top hydrate function
+ (VDomMachine a w) -- top build function
+ i
+ (VDomStep a w)
+
+type VDomBuilder4 i j k l a w = EFn.EffectFn6 (VDomSpec a w) (VDomMachine a w) i j k l (VDomStep a w)
+
+type VDomHydrator4 i j k l a w
+ = EFn.EffectFn8
+ DOM.Node
+ (VDomSpecWithHydration a w)
+ (DOM.Node -> VDomMachine a w)
+ (VDomMachine a w)
+ i
+ j
+ k
+ l
+ (VDomStep a w)
+
+-- | Widget machines recursively reference the configured spec to potentially
+-- | enable recursive trees of Widgets.
+newtype VDomSpec a w = VDomSpec
+ { buildWidget ∷ VDomSpec a w → Machine w DOM.Node -- `buildWidget` takes a circular reference to the `VDomSpec`
+ , buildAttributes ∷ DOM.Element → Machine a Unit
+ , document ∷ DOM.Document -- We need document to be able to call `document.createElement` function
+ }
+
+newtype VDomSpecWithHydration a w = VDomSpecWithHydration
+ { vdomSpec ∷ VDomSpec a w
+ , hydrateWidget ∷ VDomSpecWithHydration a w → DOM.Node → Machine w DOM.Node
+ , hydrateAttributes ∷ DOM.Element → Machine a Unit
+ }
diff --git a/src/Halogen/VDom/DOM/Util.purs b/src/Halogen/VDom/DOM/Util.purs
new file mode 100644
index 0000000..c462ed6
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Util.purs
@@ -0,0 +1,123 @@
+module Halogen.VDom.DOM.Util where
+
+import Prelude
+
+import Halogen.VDom.Types (VDom(..))
+import Data.List as List
+import Data.List (List(..), (:))
+import Web.DOM as DOM
+import Web.DOM.Element as DOM.Element
+import Web.DOM.Node as DOM.Node
+import Web.DOM.Text as DOM.Text
+import Web.DOM.Document as DOM.Document
+import Web.DOM.CharacterData as DOM.CharacterData
+import Data.Maybe (Maybe)
+import Control.Alt ((<|>))
+import Effect.Exception (error, throwException)
+import Effect.Uncurried as EFn
+import Halogen.VDom.Util as Util
+import Data.String as String
+
+data ElementOrTextNode = ElementNode DOM.Element | TextNode DOM.Text
+
+elementOrTextNodeToNode :: ElementOrTextNode -> DOM.Node
+elementOrTextNodeToNode referenceNode =
+ case referenceNode of
+ ElementNode element -> DOM.Element.toNode element
+ TextNode text -> DOM.Text.toNode text
+
+toElementOrTextNode :: DOM.Node -> Maybe ElementOrTextNode
+toElementOrTextNode node = (DOM.Text.fromNode node <#> TextNode) <|> (DOM.Element.fromNode node <#> ElementNode)
+
+listToElementOrTextNode :: List DOM.Node -> List ElementOrTextNode
+listToElementOrTextNode = map toElementOrTextNode >>> List.catMaybes
+
+-- | The idea is to prevent rerendering on the next render after hydration
+-- | but because in the prerendered html all Text nodes are merged (i.e. `HH.div_ [ HH.text "foo", HH.text "bar" ]` is rendered as `
foobar
`, not `
"foo""bar"
`)
+-- | and empty text nodes "" are hidden (i.e. they exist in $0.childNodes, but are not rendered),
+-- | we need to split text nodes using .splitText() and insert "" nodes where it is needed
+-- |
+-- | Check https://jsbin.com/bukulicito/edit?html,output to see how text nodes are added to the parent
+-- | The code was tested on this example https://github.com/srghma/purescript-halogen-nextjs/tree/master/examples/text-nodes
+-- |
+-- | Also, to undestand what's happening, you need to understand how textNode.splitText() works:
+-- | 1. when $0 is '
foobar
' -> $0.childNodes[0].splitText(0) -> returns "foobar", does nothing
+-- | 2. when $0 is '
foobar
' -> $0.childNodes[0].splitText(3) -> splits on "foo" and "bar", returns "bar"
+-- | 3. when $0 is '
foobar
' -> $0.childNodes[0].splitText(6) -> adds new node "" after "foobar", returns ""
+-- | 4. when $0 is '
foobar
' -> $0.childNodes[0].splitText(100) -> throws "Uncaught DOMException: Failed to execute 'splitText' on 'Text': The offset 100 is larger than the Text node's length."
+-- | 5. when $0 is '
foobar
' -> $0.childNodes[0].splitText(-100) -> throws "Uncaught DOMException: Failed to execute 'splitText' on 'Text': The offset 4294966996 is larger than the Text node's length."
+zipChildrenAndSplitTextNodes
+ :: forall a w vdomContainer output
+ . EFn.EffectFn6
+ (ElementOrTextNode -> vdomContainer -> output)
+ (vdomContainer -> VDom a w)
+ DOM.Document
+ DOM.Node
+ (List ElementOrTextNode)
+ (List vdomContainer)
+ (List output)
+zipChildrenAndSplitTextNodes = EFn.mkEffectFn6 \toOutput extractVdom document parent domChildren vdomContainerChildren ->
+ case domChildren, vdomContainerChildren of
+ Nil, Nil -> pure Nil
+ _, (vdomContainerChild : vdomContainerChildrenTail) ->
+ let vdomChild = extractVdom vdomContainerChild
+ in case domChildren, vdomChild of
+ -- | Expected text is "", but it wasnt rendered in dom (it is never rendered) - add the "" to the dom
+ _, Text "" -> do
+ (newChildWithEmptyText :: DOM.Text) <- DOM.Document.createTextNode "" document
+
+ case domChildren of
+ -- | when DOM is `` (no children) and vdom is `HH.div_ [HH.text ""]` - it will create append new text node
+ Nil -> void $ DOM.Node.appendChild (DOM.Text.toNode newChildWithEmptyText) parent
+ -- | when DOM is `
foo
` and vdom is `HH.div_ [HH.text "foo", HH.text ""]` - it wont touch the "foo", but should append new text node "" after "foo"
+ (referenceNode : _) -> do
+ let (referenceNode' :: DOM.Node) = elementOrTextNodeToNode referenceNode
+ void $ DOM.Node.insertBefore (DOM.Text.toNode newChildWithEmptyText) referenceNode' parent
+
+ let (head :: output) = toOutput (TextNode newChildWithEmptyText) vdomContainerChild
+
+ (tailResult :: List output) <- EFn.runEffectFn6 zipChildrenAndSplitTextNodes toOutput extractVdom document parent domChildren vdomContainerChildrenTail
+
+ pure (head : tailResult)
+ -- | We have Text in dom and Text in vdom
+ -- | when DOM is `
foobar
` and vdom is `HH.div_ [HH.text "foobarbaz"]` - throw error (LT case)
+ -- | when DOM is `
foobar
` and vdom is `HH.div_ [HH.text "foobar"]` - it should just hydrate the node (EQ case)
+ -- | when DOM is `
foobar
` and vdom is `HH.div_ [HH.text "foo", HH.text "bar"]` - it should split "foobar" on "foo" and "bar" (GT case)
+ (TextNode textNode : domChildrenTail), (Text expectedText) -> do
+ textNodeLength <- DOM.CharacterData.length (DOM.Text.toCharacterData textNode)
+
+ let expectedTextLength = String.length expectedText
+
+ case compare textNodeLength expectedTextLength of
+ LT -> do
+ textNodeData <- DOM.CharacterData.data_ (DOM.Text.toCharacterData textNode)
+
+ EFn.runEffectFn2 Util.warnAny "Error info: " { textNode, expectedText }
+
+ throwException $ error $ "[zipChildrenAndSplitTextNodes] The Text node length should not smaller then expected. Expected length = " <> show expectedTextLength <> ", actual = " <> show textNodeLength <> " (check warning above for more information)"
+ EQ -> do
+ let (head :: output) = toOutput (TextNode textNode) vdomContainerChild
+
+ tailResult <- EFn.runEffectFn6 zipChildrenAndSplitTextNodes toOutput extractVdom document parent domChildrenTail vdomContainerChildrenTail
+
+ pure (head : tailResult)
+ GT -> do
+ nextTextNode <- DOM.Text.splitText expectedTextLength textNode -- this is our "bar", and textNode is now our "foo" (but was - "foobar")
+
+ let (head :: output) = toOutput (TextNode textNode) vdomContainerChild
+
+ tailResult <- EFn.runEffectFn6 zipChildrenAndSplitTextNodes toOutput extractVdom document parent (TextNode nextTextNode : domChildrenTail) vdomContainerChildrenTail
+
+ pure (head : tailResult)
+ (domChild : domChildrenTail), _ -> do
+ let (head :: output) = toOutput domChild vdomContainerChild
+
+ tailResult <- EFn.runEffectFn6 zipChildrenAndSplitTextNodes toOutput extractVdom document parent domChildrenTail vdomContainerChildrenTail
+
+ pure (head : tailResult)
+ domChildren', vdomChild' -> do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { domChildren: domChildren', vdomChild: vdomChild' }
+ throwException $ error $ "[zipChildrenAndSplitTextNodes] Unexpected input (check warning above for more information)"
+ domChildren', vdomChildren' -> do
+ EFn.runEffectFn2 Util.warnAny "Error info: " { domChildren: domChildren', vdomChildren: vdomChildren' }
+ throwException $ error $ "[zipChildrenAndSplitTextNodes] Unexpected input (check warning above for more information)"
diff --git a/src/Halogen/VDom/DOM/Widget.purs b/src/Halogen/VDom/DOM/Widget.purs
new file mode 100644
index 0000000..9fc0972
--- /dev/null
+++ b/src/Halogen/VDom/DOM/Widget.purs
@@ -0,0 +1,51 @@
+module Halogen.VDom.DOM.Widget where
+
+import Effect.Uncurried as EFn
+import Halogen.VDom.DOM.Types (VDomBuilder, VDomMachine, VDomSpec(..), VDomSpecWithHydration(..), VDomStep, VDomHydrator)
+import Halogen.VDom.Machine (Step, Step'(..), halt, mkStep, step, unStep)
+import Halogen.VDom.Types (VDom(..), runGraft)
+import Prelude (Unit, bind, discard, pure, (#), ($))
+import Web.DOM.Node (Node) as DOM
+
+type WidgetState a w =
+ { build ∷ VDomMachine a w
+ , widget ∷ Step w DOM.Node
+ }
+
+hydrateWidget ∷ ∀ a w. VDomHydrator w a w
+hydrateWidget = EFn.mkEffectFn5 \elem (VDomSpecWithHydration spec) _hydrate build w → do
+ res ← EFn.runEffectFn1 (spec.hydrateWidget (VDomSpecWithHydration spec) elem) w
+ let
+ res' :: Step (VDom a w) DOM.Node
+ res' = res # unStep \(Step n s k1 k2) →
+ mkStep $ Step n { build, widget: res } patchWidget haltWidget
+ pure res'
+
+buildWidget ∷ ∀ a w. VDomBuilder w a w
+buildWidget = EFn.mkEffectFn3 \(VDomSpec spec) build w → do
+ res ← EFn.runEffectFn1 (spec.buildWidget (VDomSpec spec)) w
+ let
+ res' :: Step (VDom a w) DOM.Node
+ res' = res # unStep \(Step n s k1 k2) →
+ mkStep $ Step n { build, widget: res } patchWidget haltWidget
+ pure res'
+
+patchWidget ∷ ∀ a w. EFn.EffectFn2 (WidgetState a w) (VDom a w) (VDomStep a w)
+patchWidget = EFn.mkEffectFn2 \state vdom → do
+ let { build, widget } = state
+ case vdom of
+ Grafted g →
+ EFn.runEffectFn2 patchWidget state (runGraft g)
+ Widget w → do
+ res ← EFn.runEffectFn2 step widget w
+ let
+ res' = res # unStep \(Step n s k1 k2) →
+ mkStep $ Step n { build, widget: res } patchWidget haltWidget
+ pure res'
+ _ → do
+ EFn.runEffectFn1 haltWidget state
+ EFn.runEffectFn1 build vdom
+
+haltWidget ∷ forall a w. EFn.EffectFn1 (WidgetState a w) Unit
+haltWidget = EFn.mkEffectFn1 \{ widget } → do
+ EFn.runEffectFn1 halt widget
diff --git a/src/Halogen/VDom/Finders.purs b/src/Halogen/VDom/Finders.purs
new file mode 100644
index 0000000..2254fdc
--- /dev/null
+++ b/src/Halogen/VDom/Finders.purs
@@ -0,0 +1,23 @@
+module Halogen.VDom.Finders where
+
+import Prelude
+
+import Data.Either (Either(..), note)
+import Effect (Effect)
+import Web.DOM (Element)
+import Web.DOM.Element (toParentNode) as DOM.Element
+import Web.DOM.ParentNode (firstElementChild, childElementCount) as DOM.ParentNode
+
+-- | Used for hydration in halogen code and in halogen-vdom tests
+findElementFirstChild :: Element -> Effect (Either String Element)
+findElementFirstChild container = do
+ let
+ container' = DOM.Element.toParentNode container
+
+ childrenCount <- DOM.ParentNode.childElementCount container'
+
+ if childrenCount /= 1
+ then pure $ Left $ "Root container should have only 1 child element (aka root element; it can be Element, Keyed, Text, etc.), but actual children count is " <> show childrenCount
+ else do
+ maybeRootElement <- DOM.ParentNode.firstElementChild container'
+ pure $ note "Root element not found" $ maybeRootElement
diff --git a/src/Halogen/VDom/JsSet.js b/src/Halogen/VDom/JsSet.js
new file mode 100644
index 0000000..322c3bc
--- /dev/null
+++ b/src/Halogen/VDom/JsSet.js
@@ -0,0 +1,23 @@
+exports.empty = function() {
+ return new Set()
+}
+
+exports._delete = function(value, set) {
+ set.delete(value)
+}
+
+exports._add = function(value, set) {
+ set.add(value)
+}
+
+exports._size = function(set) {
+ return set.size
+}
+
+exports._has = function(value, set) {
+ return set.has(value)
+}
+
+exports._toArray = function(set) {
+ return Array.from(set)
+}
diff --git a/src/Halogen/VDom/JsSet.purs b/src/Halogen/VDom/JsSet.purs
new file mode 100644
index 0000000..e95272c
--- /dev/null
+++ b/src/Halogen/VDom/JsSet.purs
@@ -0,0 +1,20 @@
+module Halogen.VDom.JsSet where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Uncurried (EffectFn1, EffectFn2) as EFn
+
+foreign import data JsSet :: Type -> Type
+
+foreign import empty ∷ ∀ a . Effect (JsSet a)
+
+foreign import _delete ∷ ∀ a . EFn.EffectFn2 a (JsSet a) Unit
+
+foreign import _add ∷ ∀ a . EFn.EffectFn2 a (JsSet a) Unit
+
+foreign import _size ∷ ∀ a . EFn.EffectFn1 (JsSet a) Int
+
+foreign import _has ∷ ∀ a . EFn.EffectFn2 a (JsSet a) Boolean
+
+foreign import _toArray ∷ ∀ a . EFn.EffectFn1 (JsSet a) (Array a)
diff --git a/src/Halogen/VDom/Thunk.purs b/src/Halogen/VDom/Thunk.purs
index 4a94040..5290d32 100644
--- a/src/Halogen/VDom/Thunk.purs
+++ b/src/Halogen/VDom/Thunk.purs
@@ -1,6 +1,7 @@
module Halogen.VDom.Thunk
( Thunk
, buildThunk
+ , hydrateThunk
, runThunk
, hoist
, mapThunk
@@ -19,13 +20,19 @@ import Halogen.VDom.Machine as M
import Halogen.VDom.Util as Util
import Unsafe.Coerce (unsafeCoerce)
import Web.DOM.Node (Node)
+import Halogen.VDom.DOM.Types (VDomMachine)
foreign import data ThunkArg ∷ Type
foreign import data ThunkId ∷ Type
data Thunk :: (Type -> Type) -> Type -> Type
-data Thunk f i = Thunk ThunkId (Fn.Fn2 ThunkArg ThunkArg Boolean) (ThunkArg → f i) ThunkArg
+data Thunk f i
+ = Thunk
+ ThunkId
+ (Fn.Fn2 ThunkArg ThunkArg Boolean) -- (oldArg -> newArg -> isEqual)
+ (ThunkArg → f i) -- (oldArg -> output)
+ ThunkArg -- oldArg
unsafeThunkId ∷ ∀ a. a → ThunkId
unsafeThunkId = unsafeCoerce
@@ -82,36 +89,51 @@ runThunk ∷ ∀ f i. Thunk f i → f i
runThunk (Thunk _ _ render arg) = render arg
unsafeEqThunk ∷ ∀ f i. Fn.Fn2 (Thunk f i) (Thunk f i) Boolean
-unsafeEqThunk = Fn.mkFn2 \(Thunk a1 b1 _ d1) (Thunk a2 b2 _ d2) →
- Fn.runFn2 Util.refEq a1 a2 &&
- Fn.runFn2 Util.refEq b1 b2 &&
- Fn.runFn2 b1 d1 d2
+unsafeEqThunk = Fn.mkFn2 \(Thunk id eqFn _ renderArg) (Thunk id' eqFn' _ renderArg') →
+ Fn.runFn2 Util.refEq id id' &&
+ Fn.runFn2 Util.refEq eqFn eqFn' &&
+ Fn.runFn2 eqFn renderArg renderArg'
type ThunkState :: (Type -> Type) -> Type -> Type -> Type -> Type
type ThunkState f i a w =
- { thunk ∷ Thunk f i
+ { thunk ∷ Thunk f i -- prev thunk
, vdom ∷ M.Step (V.VDom a w) Node
}
+hydrateThunk
+ ∷ ∀ f i a w
+ . (f i → V.VDom a w)
+ → V.VDomSpecWithHydration a w
+ → Node
+ → V.Machine (Thunk f i) Node
+hydrateThunk toVDom spec element = mkThunkBuilder (V.hydrateVDom spec element) toVDom
+
buildThunk
∷ ∀ f i a w
. (f i → V.VDom a w)
→ V.VDomSpec a w
→ V.Machine (Thunk f i) Node
-buildThunk toVDom = renderThunk
+buildThunk toVDom spec = mkThunkBuilder (V.buildVDom spec) toVDom
+
+mkThunkBuilder
+ ∷ ∀ f i a w
+ . VDomMachine a w
+ → (f i → V.VDom a w)
+ → V.Machine (Thunk f i) Node
+mkThunkBuilder build toVDom = renderThunk
where
- renderThunk ∷ V.VDomSpec a w → V.Machine (Thunk f i) Node
- renderThunk spec = EFn.mkEffectFn1 \t → do
- vdom ← EFn.runEffectFn1 (V.buildVDom spec) (toVDom (runThunk t))
+ renderThunk ∷ V.Machine (Thunk f i) Node
+ renderThunk = EFn.mkEffectFn1 \t → do
+ vdom ← EFn.runEffectFn1 build (toVDom (runThunk t))
pure $ M.mkStep $ M.Step (M.extract vdom) { thunk: t, vdom } patchThunk haltThunk
patchThunk ∷ EFn.EffectFn2 (ThunkState f i a w) (Thunk f i) (V.Step (Thunk f i) Node)
patchThunk = EFn.mkEffectFn2 \state t2 → do
let { vdom: prev, thunk: t1 } = state
- if Fn.runFn2 unsafeEqThunk t1 t2
- then pure $ M.mkStep $ M.Step (M.extract prev) state patchThunk haltThunk
+ if Fn.runFn2 unsafeEqThunk t1 t2 -- if eq
+ then pure $ M.mkStep $ M.Step (M.extract prev) state patchThunk haltThunk -- dont run effect
else do
- vdom ← EFn.runEffectFn2 M.step prev (toVDom (runThunk t2))
+ vdom ← EFn.runEffectFn2 M.step prev (toVDom (runThunk t2)) -- else create new vdom, execute step (compare and patch if need)
pure $ M.mkStep $ M.Step (M.extract vdom) { vdom, thunk: t2 } patchThunk haltThunk
haltThunk ∷ EFn.EffectFn1 (ThunkState f i a w) Unit
diff --git a/src/Halogen/VDom/Types.purs b/src/Halogen/VDom/Types.purs
index 9500cb5..b6a704a 100644
--- a/src/Halogen/VDom/Types.purs
+++ b/src/Halogen/VDom/Types.purs
@@ -102,3 +102,4 @@ newtype Namespace = Namespace String
derive instance newtypeNamespace ∷ Newtype Namespace _
derive newtype instance eqNamespace ∷ Eq Namespace
derive newtype instance ordNamespace ∷ Ord Namespace
+derive newtype instance showNamespace ∷ Show Namespace
diff --git a/src/Halogen/VDom/Util.js b/src/Halogen/VDom/Util.js
index bf006bd..8a1627a 100644
--- a/src/Halogen/VDom/Util.js
+++ b/src/Halogen/VDom/Util.js
@@ -157,6 +157,14 @@ exports.hasAttribute = function (ns, attr, el) {
}
};
+exports.getAttribute = function (ns, attr, el) {
+ if (ns != null) {
+ return el.getAttributeNS(ns, attr);
+ } else {
+ return el.getAttribute(attr);
+ }
+};
+
exports.addEventListener = function (ev, listener, el) {
el.addEventListener(ev, listener, false);
};
@@ -166,3 +174,15 @@ exports.removeEventListener = function (ev, listener, el) {
};
exports.jsUndefined = void 0;
+
+exports.anyToString = function (a) {
+ return String(a);
+};
+
+exports.warnAny = function(message, x) {
+ console.warn(message, x)
+}
+
+exports.logAny = function(message, x) {
+ console.log(message, x)
+}
diff --git a/src/Halogen/VDom/Util.purs b/src/Halogen/VDom/Util.purs
index cd4fb92..08584b8 100644
--- a/src/Halogen/VDom/Util.purs
+++ b/src/Halogen/VDom/Util.purs
@@ -1,37 +1,6 @@
-module Halogen.VDom.Util
- ( newMutMap
- , pokeMutMap
- , deleteMutMap
- , unsafeFreeze
- , unsafeLookup
- , unsafeGetAny
- , unsafeHasAny
- , unsafeSetAny
- , unsafeDeleteAny
- , forE
- , forEachE
- , forInE
- , replicateE
- , diffWithIxE
- , diffWithKeyAndIxE
- , strMapWithIxE
- , refEq
- , createTextNode
- , setTextContent
- , createElement
- , insertChildIx
- , removeChild
- , parentNode
- , setAttribute
- , removeAttribute
- , hasAttribute
- , addEventListener
- , removeEventListener
- , JsUndefined
- , jsUndefined
- ) where
-
-import Prelude
+module Halogen.VDom.Util where
+
+import Prelude (Unit, (<>), (==))
import Data.Function.Uncurried as Fn
import Data.Nullable (Nullable)
@@ -39,25 +8,27 @@ import Effect (Effect)
import Effect.Uncurried as EFn
import Foreign.Object (Object)
import Foreign.Object as Object
-import Foreign.Object.ST (STObject)
import Foreign.Object.ST as STObject
-import Halogen.VDom.Types (Namespace, ElemName)
+import Halogen.VDom.Types (ElemName(..), Namespace(..))
import Unsafe.Coerce (unsafeCoerce)
import Web.DOM.Document (Document) as DOM
import Web.DOM.Element (Element) as DOM
import Web.DOM.Node (Node) as DOM
import Web.Event.EventTarget (EventListener) as DOM
+import Data.Maybe (Maybe(..))
+
+foreign import data STObject' :: Type -> Type
-newMutMap ∷ ∀ r a. Effect (STObject r a)
+newMutMap ∷ ∀ a. Effect (STObject' a)
newMutMap = unsafeCoerce STObject.new
-pokeMutMap ∷ ∀ r a. EFn.EffectFn3 String a (STObject r a) Unit
+pokeMutMap ∷ ∀ a. EFn.EffectFn3 String a (STObject' a) Unit
pokeMutMap = unsafeSetAny
-deleteMutMap ∷ ∀ r a. EFn.EffectFn2 String (STObject r a) Unit
+deleteMutMap ∷ ∀ a. EFn.EffectFn2 String (STObject' a) Unit
deleteMutMap = unsafeDeleteAny
-unsafeFreeze ∷ ∀ r a. STObject r a → Object a
+unsafeFreeze ∷ ∀ a. STObject' a → Object a
unsafeFreeze = unsafeCoerce
unsafeLookup ∷ ∀ a. Fn.Fn2 String (Object a) a
@@ -161,6 +132,9 @@ foreign import removeAttribute
foreign import hasAttribute
∷ EFn.EffectFn3 (Nullable Namespace) String DOM.Element Boolean
+foreign import getAttribute
+ ∷ EFn.EffectFn3 (Nullable Namespace) String DOM.Element (Nullable String)
+
foreign import addEventListener
∷ EFn.EffectFn3 String DOM.EventListener DOM.Element Unit
@@ -170,3 +144,27 @@ foreign import removeEventListener
foreign import data JsUndefined ∷ Type
foreign import jsUndefined ∷ JsUndefined
+
+foreign import warnAny ∷ ∀ a . EFn.EffectFn2 String a Unit
+
+foreign import logAny ∷ ∀ a . EFn.EffectFn2 String a Unit
+
+fullAttributeName ∷ Maybe Namespace → String → String
+fullAttributeName maybeNamespace attributeName =
+ case maybeNamespace of
+ Just (Namespace namespace) -> namespace <> ":" <> attributeName
+ Nothing -> attributeName
+
+eqElemSpec ∷ Fn.Fn4 (Maybe Namespace) ElemName (Maybe Namespace) ElemName Boolean
+eqElemSpec = Fn.mkFn4 \ns1 (ElemName name1) ns2 (ElemName name2) →
+ if name1 == name2
+ then case ns1, ns2 of
+ Just (Namespace ns1'), Just (Namespace ns2') | ns1' == ns2' → true
+ Nothing, Nothing → true
+ _, _ → false
+ else false
+
+quote :: String -> String
+quote s = "\"" <> s <> "\""
+
+foreign import anyToString ∷ ∀ a . a → String
diff --git a/test/Hydration.purs b/test/Hydration.purs
new file mode 100644
index 0000000..2819457
--- /dev/null
+++ b/test/Hydration.purs
@@ -0,0 +1,139 @@
+module Test.Hydration where
+
+import Prelude
+
+import Effect.Exception (error, throwException)
+import Data.Either (either)
+import Data.Newtype (un)
+import Data.Tuple (Tuple(..))
+import Effect (Effect)
+import Effect.Uncurried as EFn
+import Halogen.VDom as V
+import Halogen.VDom.Finders (findElementFirstChild)
+import Web.DOM.ParentNode (ParentNode)
+import Web.DOM.Element as DOM.Element
+import Web.DOM (Element)
+import Web.DOM.ParentNode (querySelector, QuerySelector(..)) as DOM
+import Data.Maybe (maybe)
+import Halogen.VDom.Util (addEventListener) as Util
+import Test.TestVdom (VDom(..), elem, keyed, mkSpecWithHydration, text, thunk, (:=))
+import Web.Event.EventTarget (eventListener) as DOM
+import Web.HTML (window) as DOM
+import Web.HTML.HTMLDocument (toDocument, toParentNode) as DOM
+import Web.HTML.Window (document) as DOM
+
+type State = Array { classes ∷ String, text ∷ String, key ∷ String }
+
+initialState ∷ State
+initialState =
+ [ { classes: "label1", text: "test label 1", key: "1" }
+ , { classes: "label2", text: "test label 2", key: "2" }
+ ]
+
+state2 ∷ State
+state2 =
+ [ { classes: "label2", text: "test label 1.1", key: "1" }
+ , { classes: "label1", text: "test label 2.1", key: "2" }
+ ]
+
+renderData ∷ State → VDom Void
+renderData stateArray =
+ -- | keyed "div" [ "className" := "component" ] (stateArray <#> renderElement)
+ -- | keyed "div" [ "className" := "component" ] (map (\state → Tuple state.key (renderElement state)) stateArray)
+ keyed "div" [ "className" := "component" ] (map (\state → Tuple state.key (thunk renderElement state)) stateArray)
+ where
+ renderElement elementState =
+ elem "div"
+ [ "className" := elementState.classes ]
+ [ text elementState.text ]
+
+findRequiredElement ∷ String → ParentNode → Effect Element
+findRequiredElement selector parentNode = do
+ maybeElement <- DOM.querySelector (DOM.QuerySelector selector) parentNode
+ maybe (throwException $ error $ selector <> " not found") pure maybeElement
+
+main ∷ Effect Unit
+main = do
+ win ← DOM.window
+ doc ← DOM.document win
+
+ appDiv ← findRequiredElement "#app" (DOM.toParentNode doc)
+
+ rootElement ← findElementFirstChild appDiv >>= either (throwException <<< error) pure
+
+ updateStateButton ← findRequiredElement "#update-state-button" (DOM.toParentNode doc)
+
+ let
+ spec = mkSpecWithHydration (DOM.toDocument doc)
+ initialValue = initialState
+ render = renderData
+ initialVdom = un VDom (render initialValue)
+
+ machine ← EFn.runEffectFn1 (V.hydrateVDom spec (DOM.Element.toNode rootElement)) initialVdom
+
+ listener ← DOM.eventListener \_ev →
+ void $ EFn.runEffectFn2 V.step machine (un VDom (render state2))
+
+ EFn.runEffectFn3 Util.addEventListener "click" listener updateStateButton
+
+-- | TODO
+-- |
+-- | tests ∷ Array { client ∷ String , errorMessage ∷ String , server ∷ String , title ∷ String }
+-- | tests =
+-- | -- | [ { title: "Attribute → renders"
+-- | [ { title: "Attribute → missing prop"
+-- | , server: """
+-- |