elm-pages 2.1.9 → 2.1.10

package/src/{ElmHtml → 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
-
-                else if key == attributeNamespaceKey then
+            (\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 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 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.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 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 []

package/src/{ElmHtml → 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)

package/src/{ElmHtml → 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

package/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"
+        }
+    }

package/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
-           , "]"
-           ]