Merge pull request #241 from dillonkearns/lazy-rendering

Handle Html.Lazy in HTML pre-rendering

elm.json

@@ -42,6 +42,7 @@
         "elm/json": "1.1.3 <= v < 2.0.0",
         "elm/regex": "1.0.0 <= v < 2.0.0",
         "elm/url": "1.0.0 <= v < 2.0.0",
+        "elm/virtual-dom": "1.0.2 <= v < 2.0.0",
         "elm-community/dict-extra": "2.4.0 <= v < 3.0.0",
         "elm-community/list-extra": "8.3.0 <= v < 9.0.0",
         "jfmengels/elm-review": "2.5.0 <= v < 3.0.0",

examples/docs/elm.json

@@ -25,6 +25,7 @@
             "elm/regex": "1.0.0",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
             "elm-community/dict-extra": "2.4.0",
             "elm-community/list-extra": "8.3.0",
             "justinmimbs/date": "3.2.1",
@@ -47,7 +48,6 @@
             "elm/file": "1.0.5",
             "elm/parser": "1.1.0",
             "elm/random": "1.0.0",
-            "elm/virtual-dom": "1.0.2",
             "fredcy/elm-parseint": "2.0.1",
             "justinmimbs/time-extra": "1.1.0",
             "lazamar/dict-parser": "1.0.2",

examples/end-to-end/elm.json

@@ -22,6 +22,7 @@
             "elm/regex": "1.0.0",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
             "elm-community/dict-extra": "2.4.0",
             "elm-community/list-extra": "8.3.0",
             "matheus23/elm-default-tailwind-modules": "2.0.1",
@@ -41,7 +42,6 @@
             "elm/file": "1.0.5",
             "elm/parser": "1.1.0",
             "elm/random": "1.0.0",
-            "elm/virtual-dom": "1.0.2",
             "fredcy/elm-parseint": "2.0.1",
             "mgold/elm-nonempty-list": "4.2.0",
             "rtfeldman/elm-hex": "1.0.0"

examples/escaping/dist/escaping/index.html

@@ -29,6 +29,7 @@ let prefetchedPages=[window.location.pathname],initialLocationHash=document.loca
     font-size:14px;
     color:rgb(255, 0, 0);
 }</style><div><p>Hello! 2 &gt; 1</p></div></div>&lt;script&gt;&lt;/script&gt; is unsafe in JSON unless it is escaped properly.
+&lt;script&gt;&lt;/script&gt; is unsafe in JSON unless it is escaped properly.
 </div>
     </body>
   </html>

examples/escaping/elm.json

@@ -22,6 +22,7 @@
             "elm/regex": "1.0.0",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
             "elm-community/dict-extra": "2.4.0",
             "elm-community/list-extra": "8.3.0",
             "matheus23/elm-default-tailwind-modules": "2.0.1",
@@ -41,7 +42,6 @@
             "elm/file": "1.0.5",
             "elm/parser": "1.1.0",
             "elm/random": "1.0.0",
-            "elm/virtual-dom": "1.0.2",
             "fredcy/elm-parseint": "2.0.1",
             "mgold/elm-nonempty-list": "4.2.0",
             "rtfeldman/elm-hex": "1.0.0"

examples/escaping/package-lock.json

@@ -16,12 +16,12 @@
       }
     },
     "../..": {
-      "version": "2.1.7",
+      "version": "2.1.9",
       "dev": true,
       "license": "BSD-3-Clause",
       "dependencies": {
         "chokidar": "3.5.2",
-        "commander": "8.0.0",
+        "commander": "^8.1.0",
         "connect": "^3.7.0",
         "cross-spawn": "7.0.3",
         "elm-doc-preview": "^5.0.5",
@@ -29,12 +29,13 @@
         "fs-extra": "^10.0.0",
         "globby": "11.0.4",
         "gray-matter": "^4.0.3",
+        "jsesc": "^3.0.2",
         "kleur": "^4.1.4",
         "micromatch": "^4.0.4",
         "object-hash": "^2.2.0",
         "serve-static": "^1.14.1",
-        "terser": "5.7.1",
+        "terser": "^5.7.2",
-        "undici": "4.2.1",
+        "undici": "^4.4.7",
         "which": "^2.0.2"
       },
       "bin": {
@@ -43,16 +44,17 @@
       "devDependencies": {
         "@types/cross-spawn": "^6.0.2",
         "@types/fs-extra": "9.0.12",
-        "@types/micromatch": "^4.0.1",
+        "@types/micromatch": "^4.0.2",
         "@types/node": "12.20.12",
         "@types/serve-static": "1.13.10",
-        "cypress": "^8.0.0",
+        "cypress": "^8.3.0",
         "elm-optimize-level-2": "^0.1.5",
         "elm-review": "^2.5.3",
         "elm-test": "^0.19.1-revision7",
         "elm-tooling": "^1.3.0",
         "elm-verify-examples": "^5.0.0",
-        "mocha": "^8.4.0",
+        "elmi-to-json": "^1.2.0",
+        "mocha": "^9.1.0",
         "typescript": "4.3.5"
       }
     },
@@ -1487,14 +1489,14 @@
       "requires": {
         "@types/cross-spawn": "^6.0.2",
         "@types/fs-extra": "9.0.12",
-        "@types/micromatch": "^4.0.1",
+        "@types/micromatch": "^4.0.2",
         "@types/node": "12.20.12",
         "@types/serve-static": "1.13.10",
         "chokidar": "3.5.2",
-        "commander": "8.0.0",
+        "commander": "^8.1.0",
         "connect": "^3.7.0",
         "cross-spawn": "7.0.3",
-        "cypress": "^8.0.0",
+        "cypress": "^8.3.0",
         "elm-doc-preview": "^5.0.5",
         "elm-hot": "^1.1.6",
         "elm-optimize-level-2": "^0.1.5",
@@ -1502,17 +1504,19 @@
         "elm-test": "^0.19.1-revision7",
         "elm-tooling": "^1.3.0",
         "elm-verify-examples": "^5.0.0",
+        "elmi-to-json": "^1.2.0",
         "fs-extra": "^10.0.0",
         "globby": "11.0.4",
         "gray-matter": "^4.0.3",
+        "jsesc": "^3.0.2",
         "kleur": "^4.1.4",
         "micromatch": "^4.0.4",
-        "mocha": "^8.4.0",
+        "mocha": "^9.1.0",
         "object-hash": "^2.2.0",
         "serve-static": "^1.14.1",
-        "terser": "5.7.1",
+        "terser": "^5.7.2",
         "typescript": "4.3.5",
-        "undici": "4.2.1",
+        "undici": "^4.4.7",
         "which": "^2.0.2"
       },
       "dependencies": {

examples/escaping/package.json

@@ -4,7 +4,7 @@
   "description": "Example site built with elm-pages.",
   "scripts": {
     "start": "elm-pages dev",
-    "test": "elm-pages build --debug && git diff --exit-code ./dist",
+    "test": "elm-pages build --debug && git diff --exit-code ./dist && elm-pages build && git diff --exit-code ./dist",
     "serve": "npm run build && http-server ./dist -a localhost -p 3000 -c-1",
     "build": "elm-pages build"
   },

examples/escaping/src/Page/Escaping.elm

@@ -8,6 +8,7 @@ import Head
 import Head.Seo as Seo
 import Html.Styled as Html exposing (..)
 import Html.Styled.Attributes as Attr
+import Html.Styled.Lazy as HtmlLazy
 import Page exposing (Page, PageWithState, StaticPayload)
 import Pages.PageUrl exposing (PageUrl)
 import Pages.Url
@@ -91,6 +92,9 @@ view maybeUrl sharedModel static =
                     ]
                 ]
             ]
-            , text static.data
+
+        -- lazy and non-lazy versions render the same output
+        , Html.text static.data
+        , HtmlLazy.lazy (.data >> text) static
         ]
     }

examples/pokedex/elm.json

@@ -23,6 +23,7 @@
             "elm/regex": "1.0.0",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
             "elm-community/dict-extra": "2.4.0",
             "elm-community/list-extra": "8.3.0",
             "matheus23/elm-default-tailwind-modules": "2.0.1",
@@ -43,7 +44,6 @@
             "elm/file": "1.0.5",
             "elm/parser": "1.1.0",
             "elm/random": "1.0.0",
-            "elm/virtual-dom": "1.0.2",
             "fredcy/elm-parseint": "2.0.1",
             "mgold/elm-nonempty-list": "4.2.0",
             "rtfeldman/elm-hex": "1.0.0"

examples/routing/elm.json

@@ -22,6 +22,7 @@
             "elm/regex": "1.0.0",
             "elm/time": "1.0.0",
             "elm/url": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
             "elm-community/dict-extra": "2.4.0",
             "elm-community/list-extra": "8.3.0",
             "matheus23/elm-default-tailwind-modules": "2.0.1",
@@ -41,7 +42,6 @@
             "elm/file": "1.0.5",
             "elm/parser": "1.1.0",
             "elm/random": "1.0.0",
-            "elm/virtual-dom": "1.0.2",
             "fredcy/elm-parseint": "2.0.1",
             "mgold/elm-nonempty-list": "4.2.0",
             "rtfeldman/elm-hex": "1.0.0"

generator/src/build.js

@@ -344,12 +344,61 @@ async function compileCliApp(options) {
   );
 
   const elmFileContent = await fsPromises.readFile(ELM_FILE_PATH, "utf-8");
+  // Source: https://github.com/elm-explorations/test/blob/d5eb84809de0f8bbf50303efd26889092c800609/src/Elm/Kernel/HtmlAsJson.js
+  const forceThunksSource = ` _HtmlAsJson_toJson(x)
+}
+
+              var virtualDomKernelConstants =
+  {
+    nodeTypeTagger: 4,
+    nodeTypeThunk: 5,
+    kids: "e",
+    refs: "l",
+    thunk: "m",
+    node: "k",
+    value: "a"
+  }
+
+function forceThunks(vNode) {
+  if (typeof vNode !== "undefined" && vNode.$ === "#2") {
+    // This is a tuple (the kids : List (String, Html) field of a Keyed node); recurse into the right side of the tuple
+    vNode.b = forceThunks(vNode.b);
+  }
+  if (typeof vNode !== 'undefined' && vNode.$ === virtualDomKernelConstants.nodeTypeThunk && !vNode[virtualDomKernelConstants.node]) {
+    // This is a lazy node; evaluate it
+    var args = vNode[virtualDomKernelConstants.thunk];
+    vNode[virtualDomKernelConstants.node] = vNode[virtualDomKernelConstants.thunk].apply(args);
+    // And then recurse into the evaluated node
+    vNode[virtualDomKernelConstants.node] = forceThunks(vNode[virtualDomKernelConstants.node]);
+  }
+  if (typeof vNode !== 'undefined' && vNode.$ === virtualDomKernelConstants.nodeTypeTagger) {
+    // This is an Html.map; recurse into the node it is wrapping
+    vNode[virtualDomKernelConstants.node] = forceThunks(vNode[virtualDomKernelConstants.node]);
+  }
+  if (typeof vNode !== 'undefined' && typeof vNode[virtualDomKernelConstants.kids] !== 'undefined') {
+    // This is something with children (either a node with kids : List Html, or keyed with kids : List (String, Html));
+    // recurse into the children
+    vNode[virtualDomKernelConstants.kids] = vNode[virtualDomKernelConstants.kids].map(forceThunks);
+  }
+  return vNode;
+}
+
+function _HtmlAsJson_toJson(html) {
+`;
+
   await fsPromises.writeFile(
     ELM_FILE_PATH,
     elmFileContent
       .replace(
         /return \$elm\$json\$Json\$Encode\$string\(.REPLACE_ME_WITH_JSON_STRINGIFY.\)/g,
-        "return " + (options.debug ? "_Json_wrap(x)" : "x")
+        "return " +
+          (options.debug
+            ? `${forceThunksSource}
+  return _Json_wrap(forceThunks(html));
+`
+            : `${forceThunksSource}
+return forceThunks(html);
+`)
       )
       .replace(
         "return ports ? { ports: ports } : {};",

review/src/ReviewConfig.elm

@@ -87,9 +87,6 @@ config =
                                 , "src/Pages/Http.elm" -- reports incorrect unused custom type constructor
                                 , "src/DataSource/ServerRequest.elm" -- temporarily removed from exposed modules for alpha serverless
                                 ]
-                            |> Rule.ignoreErrorsForDirectories
-                                [ "src/ElmHtml"
-                                ]
                     )
            )
     )
@@ -98,6 +95,7 @@ config =
                 rule
                     |> Rule.ignoreErrorsForDirectories
                         [ "src/ElmHtml"
+                        , "src/Test"
                         ]
             )
 

src/ElmHtml/ToElmString.elm

@@ -1,151 +0,0 @@
-module ElmHtml.ToElmString exposing
-    ( nodeRecordToString, toElmString, toElmStringWithOptions
-    , FormatOptions, defaultFormatOptions
-    )
-
-{-| Convert ElmHtml to string of Elm code.
-
-@docs nodeRecordToString, toElmString, toElmStringWithOptions
-
-@docs FormatOptions, defaultFormatOptions
-
--}
-
-import Dict exposing (Dict)
-import ElmHtml.InternalTypes exposing (..)
-import String
-
-
-{-| Formatting options to be used for converting to string
--}
-type alias FormatOptions =
-    { indent : Int
-    , newLines : Bool
-    }
-
-
-{-| default formatting options
--}
-defaultFormatOptions : FormatOptions
-defaultFormatOptions =
-    { indent = 0
-    , newLines = False
-    }
-
-
-nodeToLines : FormatOptions -> ElmHtml msg -> List String
-nodeToLines options nodeType =
-    case nodeType of
-        TextTag { text } ->
-            [ "Html.text \"" ++ text ++ "\"" ]
-
-        NodeEntry record ->
-            nodeRecordToString options record
-
-        CustomNode record ->
-            []
-
-        MarkdownNode record ->
-            [ record.model.markdown ]
-
-        NoOp ->
-            []
-
-
-{-| Convert a given html node to a string based on the type
--}
-toElmString : ElmHtml msg -> String
-toElmString =
-    toElmStringWithOptions defaultFormatOptions
-
-
-{-| same as toElmString, but with options
--}
-toElmStringWithOptions : FormatOptions -> ElmHtml msg -> String
-toElmStringWithOptions options =
-    nodeToLines options
-        >> String.join
-            (if options.newLines then
-                "\n"
-
-             else
-                ""
-            )
-
-
-{-| Convert a node record to a string. This basically takes the tag name, then
-pulls all the facts into tag declaration, then goes through the children and
-nests them under this one
--}
-nodeRecordToString : FormatOptions -> NodeRecord msg -> List String
-nodeRecordToString options { tag, children, facts } =
-    let
-        openTag : List (Maybe String) -> String
-        openTag extras =
-            let
-                trimmedExtras =
-                    List.filterMap (\x -> x) extras
-                        |> List.map String.trim
-                        |> List.filter ((/=) "")
-
-                filling =
-                    case trimmedExtras of
-                        [] ->
-                            ""
-
-                        more ->
-                            " " ++ String.join " " more
-            in
-            "Html." ++ tag ++ " [" ++ filling
-
-        childrenStrings =
-            List.map (nodeToLines options) children
-                |> List.concat
-                |> List.map ((++) (String.repeat options.indent " "))
-
-        styles =
-            case Dict.toList facts.styles of
-                [] ->
-                    Nothing
-
-                stylesList ->
-                    stylesList
-                        |> List.map (\( key, value ) -> "(\"" ++ key ++ "\",\"" ++ value ++ "\")")
-                        |> String.join ", "
-                        |> (\styleString -> "Html.Attributes.style [" ++ styleString ++ "]")
-                        |> Just
-
-        classes =
-            Dict.get "className" facts.stringAttributes
-                |> Maybe.map (\name -> "Html.Attributes.class [\"" ++ name ++ "\"]")
-
-        stringAttributes =
-            Dict.filter (\k v -> k /= "className") facts.stringAttributes
-                |> Dict.toList
-                |> List.map (\( k, v ) -> "Html.Attributes." ++ k ++ " \"" ++ v ++ "\"")
-                |> String.join ", "
-                |> Just
-
-        boolAttributes =
-            Dict.toList facts.boolAttributes
-                |> List.map
-                    (\( k, v ) ->
-                        "Html.Attributes.property \""
-                            ++ k
-                            ++ "\" <| Json.Encode.bool "
-                            ++ (if v then
-                                    "True"
-
-                                else
-                                    "False"
-                               )
-                    )
-                |> String.join " "
-                |> Just
-    in
-    [ openTag [ classes, styles, stringAttributes, boolAttributes ] ]
-        ++ [ " ] "
-           , "[ "
-           , String.join "" childrenStrings
-           , "]"
-           ]

src/ElmHtml/ToHtml.elm

@@ -1,82 +0,0 @@
-module ElmHtml.ToHtml exposing (toHtml, factsToAttributes)
-
-{-| This module is particularly useful for putting parsed Html into Elm.Html at runtime.
-Estentially allowing the user to use tools like html-to-elm on their code.
-
-@docs toHtml, factsToAttributes
-
--}
-
-import Dict exposing (Dict)
-import ElmHtml.InternalTypes exposing (..)
-import Html
-import Html.Attributes
-import Html.Events
-import Json.Decode
-import Json.Encode
-import String
-
-
-{-| Turns ElmHtml into normal Elm Html
--}
-toHtml : ElmHtml msg -> Html.Html msg
-toHtml elmHtml =
-    case elmHtml of
-        TextTag text ->
-            Html.text text.text
-
-        NodeEntry { tag, children, facts } ->
-            Html.node tag [] (List.map toHtml children)
-
-        CustomNode record ->
-            --let
-            --    _ =
-            --        Debug.log "Custom node is not supported" ""
-            --in
-            Html.text ""
-
-        MarkdownNode record ->
-            --let
-            --    _ =
-            --        Debug.log "Markdown node is not supported" ""
-            --in
-            Html.text ""
-
-        NoOp ->
-            Html.text ""
-
-
-stylesToAttribute : Dict String String -> List (Html.Attribute msg)
-stylesToAttribute =
-    Dict.toList
-        >> List.map (\( k, v ) -> Html.Attributes.style k v)
-
-
-eventsToAttributes : Dict String (Json.Decode.Decoder msg) -> List (Html.Attribute msg)
-eventsToAttributes =
-    Dict.toList
-        >> List.map (\( x, y ) -> Html.Events.on x y)
-
-
-stringAttributesToAttributes : Dict String String -> List (Html.Attribute msg)
-stringAttributesToAttributes =
-    Dict.toList
-        >> List.map (\( x, y ) -> Html.Attributes.attribute x y)
-
-
-boolAttributesToAttributes : Dict String Bool -> List (Html.Attribute msg)
-boolAttributesToAttributes =
-    Dict.toList
-        >> List.map (\( x, y ) -> Html.Attributes.property x (Json.Encode.bool y))
-
-
-{-| Turns a fact record into a list of attributes
--}
-factsToAttributes : Facts msg -> List (Html.Attribute msg)
-factsToAttributes facts =
-    List.concat
-        [ stylesToAttribute facts.styles
-        , eventsToAttributes facts.events
-        , stringAttributesToAttributes facts.stringAttributes
-        , boolAttributesToAttributes facts.boolAttributes
-        ]

src/HtmlPrinter.elm

@@ -1,17 +1,18 @@
 module HtmlPrinter exposing (htmlToString)
 
-import ElmHtml.InternalTypes exposing (decodeElmHtml)
-import ElmHtml.ToString exposing (defaultFormatOptions, nodeToStringWithOptions)
 import Html exposing (Html)
 import Json.Decode as Decode
 import Json.Encode
+import Test.Html.Internal.ElmHtml.InternalTypes exposing (decodeElmHtml)
+import Test.Html.Internal.ElmHtml.ToString exposing (defaultFormatOptions, nodeToStringWithOptions)
+import VirtualDom
 
 
 htmlToString : Html msg -> String
 htmlToString viewHtml =
     case
         Decode.decodeValue
-            (decodeElmHtml (\_ _ -> Decode.succeed ()))
+            (decodeElmHtml (\_ _ -> VirtualDom.Normal (Decode.succeed ())))
             (asJsonView viewHtml)
     of
         Ok str ->

src/Pages/Internal/Platform/Cli.elm

@@ -91,6 +91,7 @@ cliApplication config =
         site =
             getSiteConfig config
 
+        getSiteConfig : ProgramConfig userMsg userModel (Maybe route) siteData pageData sharedData -> SiteConfig siteData
         getSiteConfig fullConfig =
             case fullConfig.site of
                 Just mySite ->

src/Test/Html/Internal/ElmHtml/Constants.elm

@@ -1,12 +1,23 @@
-module ElmHtml.Constants exposing (styleKey, eventKey, attributeKey, attributeNamespaceKey, knownKeys)
+module Test.Html.Internal.ElmHtml.Constants exposing
+    ( propKey, styleKey, eventKey, attributeKey, attributeNamespaceKey
+    , knownKeys
+    )
 
 {-| Constants for representing internal keys for Elm's vdom implementation
 
-@docs styleKey, eventKey, attributeKey, attributeNamespaceKey, knownKeys
+@docs propKey, styleKey, eventKey, attributeKey, attributeNamespaceKey
+@docs knownKeys
 
 -}
 
 
+{-| Internal key for attribute properties
+-}
+propKey : String
+propKey =
+    "a2"
+
+
 {-| Internal key for style
 -}
 styleKey : String
@@ -14,26 +25,21 @@ styleKey =
     "a1"
 
 
-{-| Internal key for 'on' events
+{-| Internal key for style
 -}
 eventKey : String
 eventKey =
     "a0"
 
 
-propertyKey : String
+{-| Internal key for style
-propertyKey =
-    "a2"
-
-
-{-| Internal key for attributes
 -}
 attributeKey : String
 attributeKey =
     "a3"
 
 
-{-| Internal key for namespaced attributes
+{-| Internal key for style
 -}
 attributeNamespaceKey : String
 attributeNamespaceKey =

src/Test/Html/Internal/ElmHtml/Helpers.elm

@@ -1,4 +1,4 @@
-module ElmHtml.Helpers exposing (filterKnownKeys)
+module Test.Html.Internal.ElmHtml.Helpers exposing (filterKnownKeys)
 
 {-| Internal helpers for ElmHtml
 
@@ -7,7 +7,7 @@ module ElmHtml.Helpers exposing (filterKnownKeys)
 -}
 
 import Dict exposing (Dict)
-import ElmHtml.Constants exposing (..)
+import Test.Html.Internal.ElmHtml.Constants exposing (knownKeys)
 
 
 {-| Filter out keys that we don't know

src/Test/Html/Internal/ElmHtml/InternalTypes.elm

@@ -1,4 +1,4 @@
-module ElmHtml.InternalTypes exposing
+module Test.Html.Internal.ElmHtml.InternalTypes exposing
     ( ElmHtml(..), TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord
     , Facts, Tagger, EventHandler, ElementKind(..)
     , Attribute(..), AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord
@@ -18,12 +18,14 @@ module ElmHtml.InternalTypes exposing
 -}
 
 import Dict exposing (Dict)
-import ElmHtml.Constants exposing (..)
-import ElmHtml.Helpers exposing (..)
-import ElmHtml.Markdown exposing (..)
 import Html.Events
 import Json.Decode exposing (field)
 import Json.Encode
+import Test.Html.Internal.ElmHtml.Constants as Constants exposing (..)
+import Test.Html.Internal.ElmHtml.Helpers exposing (..)
+import Test.Html.Internal.ElmHtml.Markdown exposing (..)
+import Test.Internal.KernelConstants exposing (kernelConstants)
+import VirtualDom
 
 
 {-| Type tree for representing Elm's Html
@@ -105,7 +107,7 @@ type alias EventHandler =
 -}
 type alias Facts msg =
     { styles : Dict String String
-    , events : Dict String (Json.Decode.Decoder msg)
+    , events : Dict String (VirtualDom.Handler msg)
     , attributeNamespace : Maybe Json.Decode.Value
     , stringAttributes : Dict String String
     , boolAttributes : Dict String Bool
@@ -125,7 +127,7 @@ type ElementKind
 
 
 type HtmlContext msg
-    = HtmlContext (List Tagger) (List Tagger -> EventHandler -> Json.Decode.Decoder msg)
+    = HtmlContext (List Tagger) (List Tagger -> EventHandler -> VirtualDom.Handler msg)
 
 
 {-| Type for representing Elm's Attributes
@@ -145,7 +147,7 @@ type Attribute
     = Attribute AttributeRecord
     | NamespacedAttribute NamespacedAttributeRecord
     | Property PropertyRecord
-    | Styles (List ( String, String ))
+    | Style { key : String, value : String }
     | Event EventRecord
 
 
@@ -179,70 +181,55 @@ type alias PropertyRecord =
 type alias EventRecord =
     { key : String
     , decoder : Json.Decode.Value
-    , options : { stopPropagation : Bool, preventDefault : Bool }
+    , options : EventOptions
     }
 
 
-factsKey : String
+type alias EventOptions =
-factsKey =
+    { stopPropagation : Bool
-    "d"
+    , preventDefault : Bool
-
+    }
-
-descendantsCountKey : String
-descendantsCountKey =
-    "b"
-
-
-tagKey : String
-tagKey =
-    "c"
-
-
-childrenKey : String
-childrenKey =
-    "e"
 
 
 {-| decode a json object into ElmHtml, you have to pass a function that decodes
 events from Html Nodes. If you don't want to decode event msgs, you can ignore it:
 
-decodeElmHtml (\_ \_ -> ()) jsonHtml
+    decodeElmHtml (\_ _ -> VirtualDom.Normal (Json.Decode.succeed ())) jsonHtml
 
 if you do want to decode them, you will probably need to write some native code
 like elm-html-test does to extract the function inside those.
 
 -}
-decodeElmHtml : (List Tagger -> EventHandler -> Json.Decode.Decoder msg) -> Json.Decode.Decoder (ElmHtml msg)
+decodeElmHtml : (List Tagger -> EventHandler -> VirtualDom.Handler msg) -> Json.Decode.Decoder (ElmHtml msg)
 decodeElmHtml eventDecoder =
     contextDecodeElmHtml (HtmlContext [] eventDecoder)
 
 
 contextDecodeElmHtml : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg)
 contextDecodeElmHtml context =
-    field "$" Json.Decode.int
+    field kernelConstants.virtualDom.nodeType Json.Decode.int
         |> Json.Decode.andThen
-            (\typeInt ->
+            (\nodeType ->
-                case typeInt of
+                if nodeType == kernelConstants.virtualDom.nodeTypeText then
-                    0 ->
                     Json.Decode.map TextTag decodeTextTag
 
-                    2 ->
+                else if nodeType == kernelConstants.virtualDom.nodeTypeKeyedNode then
                     Json.Decode.map NodeEntry (decodeKeyedNode context)
 
-                    1 ->
+                else if nodeType == kernelConstants.virtualDom.nodeTypeNode then
                     Json.Decode.map NodeEntry (decodeNode context)
 
-                    3 ->
+                else if nodeType == kernelConstants.virtualDom.nodeTypeCustom then
                     decodeCustomNode context
 
-                    4 ->
+                else if nodeType == kernelConstants.virtualDom.nodeTypeTagger then
                     decodeTagger context
 
-                    5 ->
+                else if nodeType == kernelConstants.virtualDom.nodeTypeThunk then
-                        field "node" (contextDecodeElmHtml context)
+                    field kernelConstants.virtualDom.node (contextDecodeElmHtml context)
 
-                    _ ->
+                else
-                        Json.Decode.fail ("No such type as " ++ String.fromInt typeInt)
+                    Json.Decode.fail ("No such type as " ++ String.fromInt nodeType)
             )
 
 
@@ -250,31 +237,21 @@ contextDecodeElmHtml context =
 -}
 decodeTextTag : Json.Decode.Decoder TextTagRecord
 decodeTextTag =
-    field "a" (Json.Decode.andThen (\text -> Json.Decode.succeed { text = text }) Json.Decode.string)
+    field kernelConstants.virtualDom.text (Json.Decode.andThen (\text -> Json.Decode.succeed { text = text }) Json.Decode.string)
-
-
-{-| encode text tag
--}
-encodeTextTag : TextTagRecord -> Json.Encode.Value
-encodeTextTag { text } =
-    Json.Encode.object [ ( "a", Json.Encode.string text ) ]
 
 
 {-| decode a tagger
 -}
 decodeTagger : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg)
 decodeTagger (HtmlContext taggers eventDecoder) =
-    Json.Decode.field "j" Json.Decode.value
+    Json.Decode.field kernelConstants.virtualDom.tagger Json.Decode.value
         |> Json.Decode.andThen
             (\tagger ->
                 let
                     nodeDecoder =
                         contextDecodeElmHtml (HtmlContext (taggers ++ [ tagger ]) eventDecoder)
                 in
-                -- The child node is at the k field of tagger
+                Json.Decode.at [ kernelConstants.virtualDom.node ] nodeDecoder
-                -- TODO determine if the descendantsCount should be updated for this node,
-                -- because the tagger object counds as one node. this.b = 1 + (this.k.b || 0)
-                Json.Decode.at [ "k" ] nodeDecoder
             )
 
 
@@ -287,10 +264,10 @@ decodeKeyedNode context =
             Json.Decode.field "b" (contextDecodeElmHtml context)
     in
     Json.Decode.map4 NodeRecord
-        (Json.Decode.field tagKey Json.Decode.string)
+        (Json.Decode.field kernelConstants.virtualDom.tag Json.Decode.string)
-        (Json.Decode.field childrenKey (Json.Decode.list decodeSecondNode))
+        (Json.Decode.field kernelConstants.virtualDom.kids (Json.Decode.list decodeSecondNode))
-        (Json.Decode.field factsKey (decodeFacts context))
+        (Json.Decode.field kernelConstants.virtualDom.facts (decodeFacts context))
-        (Json.Decode.field descendantsCountKey Json.Decode.int)
+        (Json.Decode.field kernelConstants.virtualDom.descendantsCount Json.Decode.int)
 
 
 {-| decode a node record
@@ -298,23 +275,10 @@ decodeKeyedNode context =
 decodeNode : HtmlContext msg -> Json.Decode.Decoder (NodeRecord msg)
 decodeNode context =
     Json.Decode.map4 NodeRecord
-        (field tagKey Json.Decode.string)
+        (field kernelConstants.virtualDom.tag Json.Decode.string)
-        (field childrenKey (Json.Decode.list (contextDecodeElmHtml context)))
+        (field kernelConstants.virtualDom.kids (Json.Decode.list (contextDecodeElmHtml context)))
-        (field factsKey (decodeFacts context))
+        (field kernelConstants.virtualDom.facts (decodeFacts context))
-        (field descendantsCountKey Json.Decode.int)
+        (field kernelConstants.virtualDom.descendantsCount Json.Decode.int)
-
-
-{-| encode a node record: currently does not support facts or children
--}
-encodeNodeRecord : NodeRecord msg -> Json.Encode.Value
-encodeNodeRecord record =
-    Json.Encode.object
-        [ ( tagKey, Json.Encode.string record.tag )
-
-        --, ( childrenKey, Json.Encode.list encodeElmHtml)
-        --, ( factsKey, encodeFacts)
-        , ( descendantsCountKey, Json.Encode.int record.descendantsCount )
-        ]
 
 
 {-| decode custom node into either markdown or custom
@@ -332,8 +296,8 @@ decodeCustomNode context =
 decodeCustomNodeRecord : HtmlContext msg -> Json.Decode.Decoder (CustomNodeRecord msg)
 decodeCustomNodeRecord context =
     Json.Decode.map2 CustomNodeRecord
-        (field factsKey (decodeFacts context))
+        (field kernelConstants.virtualDom.facts (decodeFacts context))
-        (field "g" Json.Decode.value)
+        (field kernelConstants.virtualDom.model Json.Decode.value)
 
 
 {-| decode markdown node record
@@ -341,8 +305,8 @@ decodeCustomNodeRecord context =
 decodeMarkdownNodeRecord : HtmlContext msg -> Json.Decode.Decoder (MarkdownNodeRecord msg)
 decodeMarkdownNodeRecord context =
     Json.Decode.map2 MarkdownNodeRecord
-        (field factsKey (decodeFacts context))
+        (field kernelConstants.virtualDom.facts (decodeFacts context))
-        (field "g" decodeMarkdownModel)
+        (field kernelConstants.virtualDom.model decodeMarkdownModel)
 
 
 {-| decode the styles
@@ -355,19 +319,6 @@ decodeStyles =
         ]
 
 
-{-| encode styles
--}
-encodeStyles : Dict String String -> Json.Encode.Value
-encodeStyles stylesDict =
-    let
-        encodedDict =
-            stylesDict
-                |> Dict.toList
-                |> List.map (\( k, v ) -> ( k, Json.Encode.string v ))
-    in
-    Json.Encode.object [ ( styleKey, Json.Encode.object encodedDict ) ]
-
-
 {-| grab things from attributes via a decoder, then anything that isn't filtered on
 the object
 -}
@@ -409,7 +360,7 @@ decodeAttributes decoder =
         ]
 
 
-decodeEvents : (EventHandler -> Json.Decode.Decoder msg) -> Json.Decode.Decoder (Dict String (Json.Decode.Decoder msg))
+decodeEvents : (EventHandler -> VirtualDom.Handler msg) -> Json.Decode.Decoder (Dict String (VirtualDom.Handler msg))
 decodeEvents taggedEventDecoder =
     Json.Decode.oneOf
         [ Json.Decode.field eventKey (Json.Decode.dict (Json.Decode.map taggedEventDecoder Json.Decode.value))
@@ -453,50 +404,36 @@ like elm-html-test does to extract the function inside those.
 -}
 decodeAttribute : Json.Decode.Decoder Attribute
 decodeAttribute =
-    Json.Decode.field "key" Json.Decode.string
+    Json.Decode.field "$" Json.Decode.string
         |> Json.Decode.andThen
-            (\key ->
+            (\tag ->
-                if key == attributeKey then
+                if tag == Constants.attributeKey then
-                    Json.Decode.map2 AttributeRecord
+                    Json.Decode.map2 (\key val -> Attribute (AttributeRecord key val))
-                        (Json.Decode.field "realKey" Json.Decode.string)
+                        (Json.Decode.field "n" Json.Decode.string)
-                        (Json.Decode.field "value" Json.Decode.string)
+                        (Json.Decode.field "o" Json.Decode.string)
-                        |> Json.Decode.map Attribute
 
-                else if key == attributeNamespaceKey then
+                else if tag == Constants.attributeNamespaceKey then
                     Json.Decode.map3 NamespacedAttributeRecord
-                        (Json.Decode.field "realKey" Json.Decode.string)
+                        (Json.Decode.field "n" Json.Decode.string)
-                        (Json.Decode.at [ "value", "value" ] Json.Decode.string)
+                        (Json.Decode.at [ "o", "o" ] Json.Decode.string)
-                        (Json.Decode.at [ "value", "namespace" ] Json.Decode.string)
+                        (Json.Decode.at [ "o", "f" ] Json.Decode.string)
                         |> Json.Decode.map NamespacedAttribute
 
-                else if key == styleKey then
+                else if tag == Constants.styleKey then
-                    Json.Decode.map2 (\a b -> ( a, b ))
+                    Json.Decode.map2 (\key val -> Style { key = key, value = val })
-                        (Json.Decode.field "_0" Json.Decode.string)
+                        (Json.Decode.field "n" Json.Decode.string)
-                        (Json.Decode.field "_1" Json.Decode.string)
+                        (Json.Decode.field "o" Json.Decode.string)
-                        |> elmListDecoder
-                        |> Json.Decode.field "value"
-                        |> Json.Decode.map Styles
 
-                else if key == eventKey then
+                else if tag == Constants.propKey then
-                    Json.Decode.map3 EventRecord
+                    Json.Decode.map2 (\key val -> Property (PropertyRecord key val))
-                        (Json.Decode.field "realKey" Json.Decode.string)
+                        (Json.Decode.field "n" Json.Decode.string)
-                        (Json.Decode.at [ "value", "decoder" ] Json.Decode.value)
+                        (Json.Decode.at [ "o", "a" ] Json.Decode.value)
-                        (Json.Decode.at [ "value", "options" ] decodeOptions)
-                        |> Json.Decode.map Event
 
                 else
-                    Json.Decode.field "value" Json.Decode.value
+                    Json.Decode.fail ("Unexpected Html.Attribute tag: " ++ tag)
-                        |> Json.Decode.map (PropertyRecord key >> Property)
             )
 
 
-decodeOptions : Json.Decode.Decoder { stopPropagation : Bool, preventDefault : Bool }
-decodeOptions =
-    Json.Decode.map2 (\stopPropagation preventDefault -> { stopPropagation = stopPropagation, preventDefault = preventDefault })
-        (Json.Decode.field "stopPropagation" Json.Decode.bool)
-        (Json.Decode.field "preventDefault" Json.Decode.bool)
-
-
 elmListDecoder : Json.Decode.Decoder a -> Json.Decode.Decoder (List a)
 elmListDecoder itemDecoder =
     elmListDecoderHelp itemDecoder []

src/Test/Html/Internal/ElmHtml/Markdown.elm

@@ -1,18 +1,19 @@
-module ElmHtml.Markdown exposing
+module Test.Html.Internal.ElmHtml.Markdown exposing
     ( MarkdownOptions, MarkdownModel, baseMarkdownModel
-    , encodeOptions, encodeMarkdownModel, decodeMarkdownModel
+    , decodeMarkdownModel
     )
 
 {-| Markdown helpers
 
 @docs MarkdownOptions, MarkdownModel, baseMarkdownModel
 
-@docs encodeOptions, encodeMarkdownModel, decodeMarkdownModel
+@docs decodeMarkdownModel
 
 -}
 
 import Json.Decode exposing (field)
 import Json.Encode
+import Test.Internal.KernelConstants exposing (kernelConstants)
 
 
 {-| Just a default markdown model
@@ -47,27 +48,9 @@ type alias MarkdownModel =
     }
 
 
-{-| We don't really care about encoding options right now
-TODO: we will if we want to represent things as we do for elm-html
--}
-encodeOptions : MarkdownOptions -> Json.Decode.Value
-encodeOptions options =
-    Json.Encode.null
-
-
-{-| encode markdown model
--}
-encodeMarkdownModel : MarkdownModel -> Json.Decode.Value
-encodeMarkdownModel model =
-    Json.Encode.object
-        [ ( "options", encodeOptions model.options )
-        , ( "markdown", Json.Encode.string model.markdown )
-        ]
-
-
 {-| decode a markdown model
 -}
 decodeMarkdownModel : Json.Decode.Decoder MarkdownModel
 decodeMarkdownModel =
-    field "markdown" Json.Decode.string
+    field kernelConstants.markdown.markdown Json.Decode.string
         |> Json.Decode.map (MarkdownModel baseMarkdownModel.options)

src/Test/Html/Internal/ElmHtml/ToString.elm

@@ -1,4 +1,4 @@
-module ElmHtml.ToString exposing
+module Test.Html.Internal.ElmHtml.ToString exposing
     ( nodeRecordToString, nodeToString, nodeToStringWithOptions
     , FormatOptions, defaultFormatOptions
     )
@@ -12,8 +12,8 @@ module ElmHtml.ToString exposing
 -}
 
 import Dict exposing (Dict)
-import ElmHtml.InternalTypes exposing (..)
 import String
+import Test.Html.Internal.ElmHtml.InternalTypes exposing (..)
 
 
 {-| Formatting options to be used for converting to string
@@ -111,8 +111,8 @@ nodeRecordToString options { tag, children, facts } =
                 [] ->
                     Nothing
 
-                stylesList ->
+                styleValues ->
-                    stylesList
+                    styleValues
                         |> List.map (\( key, value ) -> key ++ ":" ++ value ++ ";")
                         |> String.join ""
                         |> (\styleString -> "style=\"" ++ styleString ++ "\"")
@@ -130,19 +130,17 @@ nodeRecordToString options { tag, children, facts } =
                 |> String.join " "
                 |> Just
 
+        boolToString b =
+            case b of
+                True ->
+                    "True"
+
+                False ->
+                    "False"
+
         boolAttributes =
             Dict.toList facts.boolAttributes
-                |> List.map
+                |> List.map (\( k, v ) -> k ++ "=" ++ (String.toLower <| boolToString v))
-                    (\( k, v ) ->
-                        k
-                            ++ "="
-                            ++ (if v then
-                                    "true"
-
-                                else
-                                    "false"
-                               )
-                    )
                 |> String.join " "
                 |> Just
     in

src/Test/Internal/KernelConstants.elm

@@ -0,0 +1,34 @@
+module Test.Internal.KernelConstants exposing (kernelConstants)
+
+{-| This module defines the mapping of optimized field name and enum values
+for kernel code in other packages the we depend on.
+-}
+
+
+{-| NOTE: this is duplicating constants also defined in src/Elm/Kernel/HtmlAsJson.js
+so if you make any changes here, be sure to synchronize them there!
+-}
+kernelConstants =
+    { virtualDom =
+        { nodeType = "$"
+        , nodeTypeText = 0
+        , nodeTypeKeyedNode = 2
+        , nodeTypeNode = 1
+        , nodeTypeCustom = 3
+        , nodeTypeTagger = 4
+        , nodeTypeThunk = 5
+        , tag = "c"
+        , kids = "e"
+        , facts = "d"
+        , descendantsCount = "b"
+        , text = "a"
+        , refs = "l"
+        , node = "k"
+        , tagger = "j"
+        , model = "g"
+        }
+    , markdown =
+        { options = "a"
+        , markdown = "b"
+        }
+    }

tests/StaticHttpRequestsTests.elm

@@ -20,6 +20,7 @@ import Pages.Internal.Platform.ToJsPayload as ToJsPayload
 import Pages.Internal.StaticHttpBody as StaticHttpBody
 import Pages.Manifest as Manifest
 import Pages.ProgramConfig exposing (ProgramConfig)
+import Pages.SiteConfig exposing (SiteConfig)
 import Pages.StaticHttp.Request as Request
 import Path
 import ProgramTest exposing (ProgramTest)
@@ -1124,6 +1125,7 @@ startLowLevel apiRoutes staticHttpCache pages =
         |> ProgramTest.start (flags (Encode.encode 0 encodedFlags))
 
 
+site : SiteConfig ()
 site =
     { data = DataSource.succeed ()
     , canonicalUrl = "canonical-site-url"