diff --git a/elm.json b/elm.json index a9eb9968..a5d773a0 100644 --- a/elm.json +++ b/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", diff --git a/examples/docs/elm.json b/examples/docs/elm.json index 0a797e78..ff832fd1 100644 --- a/examples/docs/elm.json +++ b/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", diff --git a/examples/end-to-end/elm.json b/examples/end-to-end/elm.json index bf9a5c08..620d098e 100644 --- a/examples/end-to-end/elm.json +++ b/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" diff --git a/examples/escaping/dist/escaping/index.html b/examples/escaping/dist/escaping/index.html index 1292c4eb..f532b1e7 100644 --- a/examples/escaping/dist/escaping/index.html +++ b/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); }

Hello! 2 > 1

<script></script> is unsafe in JSON unless it is escaped properly. +<script></script> is unsafe in JSON unless it is escaped properly. diff --git a/examples/escaping/elm.json b/examples/escaping/elm.json index bf9a5c08..620d098e 100644 --- a/examples/escaping/elm.json +++ b/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" diff --git a/examples/escaping/package-lock.json b/examples/escaping/package-lock.json index c743a191..39fb05ce 100644 --- a/examples/escaping/package-lock.json +++ b/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", - "undici": "4.2.1", + "terser": "^5.7.2", + "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": { diff --git a/examples/escaping/package.json b/examples/escaping/package.json index eca9d57c..d379eb55 100644 --- a/examples/escaping/package.json +++ b/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" }, diff --git a/examples/escaping/src/Page/Escaping.elm b/examples/escaping/src/Page/Escaping.elm index 96073797..975811c2 100644 --- a/examples/escaping/src/Page/Escaping.elm +++ b/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 ] } diff --git a/examples/pokedex/elm.json b/examples/pokedex/elm.json index b026d060..d25b9d17 100644 --- a/examples/pokedex/elm.json +++ b/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" diff --git a/examples/repos/elm.json b/examples/repos/elm.json index 82ec8bc4..68ad23f3 100644 --- a/examples/repos/elm.json +++ b/examples/repos/elm.json @@ -63,4 +63,4 @@ }, "indirect": {} } -} \ No newline at end of file +} diff --git a/examples/routing/elm.json b/examples/routing/elm.json index bf9a5c08..620d098e 100644 --- a/examples/routing/elm.json +++ b/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" diff --git a/generator/src/build.js b/generator/src/build.js index cb94f7df..fd394a8e 100755 --- a/generator/src/build.js +++ b/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 } : {};", diff --git a/review/src/ReviewConfig.elm b/review/src/ReviewConfig.elm index 0d6b81d2..2e1e7a5b 100644 --- a/review/src/ReviewConfig.elm +++ b/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" ] ) diff --git a/src/ElmHtml/ToElmString.elm b/src/ElmHtml/ToElmString.elm deleted file mode 100644 index 9c19ce9b..00000000 --- a/src/ElmHtml/ToElmString.elm +++ /dev/null @@ -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 - , "]" - ] diff --git a/src/ElmHtml/ToHtml.elm b/src/ElmHtml/ToHtml.elm deleted file mode 100644 index b1b039ca..00000000 --- a/src/ElmHtml/ToHtml.elm +++ /dev/null @@ -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 - ] diff --git a/src/HtmlPrinter.elm b/src/HtmlPrinter.elm index 4e11b997..4ec301c1 100644 --- a/src/HtmlPrinter.elm +++ b/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 -> diff --git a/src/Pages/Internal/Platform/Cli.elm b/src/Pages/Internal/Platform/Cli.elm index 02933647..d598e358 100644 --- a/src/Pages/Internal/Platform/Cli.elm +++ b/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 -> diff --git a/src/ElmHtml/Constants.elm b/src/Test/Html/Internal/ElmHtml/Constants.elm similarity index 55% rename from src/ElmHtml/Constants.elm rename to src/Test/Html/Internal/ElmHtml/Constants.elm index 52e6c692..fff17d53 100644 --- a/src/ElmHtml/Constants.elm +++ b/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 -propertyKey = - "a2" - - -{-| Internal key for attributes +{-| Internal key for style -} attributeKey : String attributeKey = "a3" -{-| Internal key for namespaced attributes +{-| Internal key for style -} attributeNamespaceKey : String attributeNamespaceKey = diff --git a/src/ElmHtml/Helpers.elm b/src/Test/Html/Internal/ElmHtml/Helpers.elm similarity index 66% rename from src/ElmHtml/Helpers.elm rename to src/Test/Html/Internal/ElmHtml/Helpers.elm index ca5f81e4..37876e2a 100644 --- a/src/ElmHtml/Helpers.elm +++ b/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 diff --git a/src/ElmHtml/InternalTypes.elm b/src/Test/Html/Internal/ElmHtml/InternalTypes.elm similarity index 70% rename from src/ElmHtml/InternalTypes.elm rename to src/Test/Html/Internal/ElmHtml/InternalTypes.elm index 76502fb4..4e9dee1d 100644 --- a/src/ElmHtml/InternalTypes.elm +++ b/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 -factsKey = - "d" - - -descendantsCountKey : String -descendantsCountKey = - "b" - - -tagKey : String -tagKey = - "c" - - -childrenKey : String -childrenKey = - "e" +type alias EventOptions = + { stopPropagation : Bool + , preventDefault : Bool + } {-| 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 -> - case typeInt of - 0 -> - Json.Decode.map TextTag decodeTextTag + (\nodeType -> + if nodeType == kernelConstants.virtualDom.nodeTypeText then + Json.Decode.map TextTag decodeTextTag - 2 -> - Json.Decode.map NodeEntry (decodeKeyedNode context) + else if nodeType == kernelConstants.virtualDom.nodeTypeKeyedNode then + Json.Decode.map NodeEntry (decodeKeyedNode context) - 1 -> - Json.Decode.map NodeEntry (decodeNode context) + else if nodeType == kernelConstants.virtualDom.nodeTypeNode then + Json.Decode.map NodeEntry (decodeNode context) - 3 -> - decodeCustomNode context + else if nodeType == kernelConstants.virtualDom.nodeTypeCustom then + decodeCustomNode context - 4 -> - decodeTagger context + else if nodeType == kernelConstants.virtualDom.nodeTypeTagger then + decodeTagger context - 5 -> - field "node" (contextDecodeElmHtml context) + else if nodeType == kernelConstants.virtualDom.nodeTypeThunk then + field kernelConstants.virtualDom.node (contextDecodeElmHtml context) - _ -> - Json.Decode.fail ("No such type as " ++ String.fromInt typeInt) + else + 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) - - -{-| encode text tag --} -encodeTextTag : TextTagRecord -> Json.Encode.Value -encodeTextTag { text } = - Json.Encode.object [ ( "a", Json.Encode.string text ) ] + field kernelConstants.virtualDom.text (Json.Decode.andThen (\text -> Json.Decode.succeed { text = text }) Json.Decode.string) {-| 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 - -- 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 + Json.Decode.at [ kernelConstants.virtualDom.node ] 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 childrenKey (Json.Decode.list decodeSecondNode)) - (Json.Decode.field factsKey (decodeFacts context)) - (Json.Decode.field descendantsCountKey Json.Decode.int) + (Json.Decode.field kernelConstants.virtualDom.tag Json.Decode.string) + (Json.Decode.field kernelConstants.virtualDom.kids (Json.Decode.list decodeSecondNode)) + (Json.Decode.field kernelConstants.virtualDom.facts (decodeFacts context)) + (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 childrenKey (Json.Decode.list (contextDecodeElmHtml context))) - (field factsKey (decodeFacts context)) - (field descendantsCountKey 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 ) - ] + (field kernelConstants.virtualDom.tag Json.Decode.string) + (field kernelConstants.virtualDom.kids (Json.Decode.list (contextDecodeElmHtml context))) + (field kernelConstants.virtualDom.facts (decodeFacts context)) + (field kernelConstants.virtualDom.descendantsCount Json.Decode.int) {-| 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 "g" Json.Decode.value) + (field kernelConstants.virtualDom.facts (decodeFacts context)) + (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 "g" decodeMarkdownModel) + (field kernelConstants.virtualDom.facts (decodeFacts context)) + (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 -> - if key == attributeKey then - Json.Decode.map2 AttributeRecord - (Json.Decode.field "realKey" Json.Decode.string) - (Json.Decode.field "value" Json.Decode.string) - |> Json.Decode.map Attribute + (\tag -> + if tag == Constants.attributeKey then + Json.Decode.map2 (\key val -> Attribute (AttributeRecord key val)) + (Json.Decode.field "n" Json.Decode.string) + (Json.Decode.field "o" Json.Decode.string) - else if key == attributeNamespaceKey then + else if tag == Constants.attributeNamespaceKey then Json.Decode.map3 NamespacedAttributeRecord - (Json.Decode.field "realKey" Json.Decode.string) - (Json.Decode.at [ "value", "value" ] Json.Decode.string) - (Json.Decode.at [ "value", "namespace" ] Json.Decode.string) + (Json.Decode.field "n" Json.Decode.string) + (Json.Decode.at [ "o", "o" ] Json.Decode.string) + (Json.Decode.at [ "o", "f" ] Json.Decode.string) |> Json.Decode.map NamespacedAttribute - else if key == styleKey then - Json.Decode.map2 (\a b -> ( a, b )) - (Json.Decode.field "_0" Json.Decode.string) - (Json.Decode.field "_1" Json.Decode.string) - |> elmListDecoder - |> Json.Decode.field "value" - |> Json.Decode.map Styles + else if tag == Constants.styleKey then + Json.Decode.map2 (\key val -> Style { key = key, value = val }) + (Json.Decode.field "n" Json.Decode.string) + (Json.Decode.field "o" Json.Decode.string) - else if key == eventKey then - Json.Decode.map3 EventRecord - (Json.Decode.field "realKey" Json.Decode.string) - (Json.Decode.at [ "value", "decoder" ] Json.Decode.value) - (Json.Decode.at [ "value", "options" ] decodeOptions) - |> Json.Decode.map Event + else if tag == Constants.propKey then + Json.Decode.map2 (\key val -> Property (PropertyRecord key val)) + (Json.Decode.field "n" Json.Decode.string) + (Json.Decode.at [ "o", "a" ] Json.Decode.value) else - Json.Decode.field "value" Json.Decode.value - |> Json.Decode.map (PropertyRecord key >> Property) + Json.Decode.fail ("Unexpected Html.Attribute tag: " ++ tag) ) -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 [] diff --git a/src/ElmHtml/Markdown.elm b/src/Test/Html/Internal/ElmHtml/Markdown.elm similarity index 61% rename from src/ElmHtml/Markdown.elm rename to src/Test/Html/Internal/ElmHtml/Markdown.elm index 088ff48b..4058ccd1 100644 --- a/src/ElmHtml/Markdown.elm +++ b/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) diff --git a/src/ElmHtml/ToString.elm b/src/Test/Html/Internal/ElmHtml/ToString.elm similarity index 91% rename from src/ElmHtml/ToString.elm rename to src/Test/Html/Internal/ElmHtml/ToString.elm index fd8d2479..125a6076 100644 --- a/src/ElmHtml/ToString.elm +++ b/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 -> - stylesList + styleValues -> + 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 - (\( k, v ) -> - k - ++ "=" - ++ (if v then - "true" - - else - "false" - ) - ) + |> List.map (\( k, v ) -> k ++ "=" ++ (String.toLower <| boolToString v)) |> String.join " " |> Just in diff --git a/src/Test/Internal/KernelConstants.elm b/src/Test/Internal/KernelConstants.elm new file mode 100644 index 00000000..83365e8f --- /dev/null +++ b/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" + } + } diff --git a/tests/StaticHttpRequestsTests.elm b/tests/StaticHttpRequestsTests.elm index 5f9c64c4..d94d79b6 100644 --- a/tests/StaticHttpRequestsTests.elm +++ 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"