diff --git a/src/Elm/Kernel/HtmlAsJson.js b/src/Elm/Kernel/HtmlAsJson.js
deleted file mode 100644
index 9de6a057..00000000
--- a/src/Elm/Kernel/HtmlAsJson.js
+++ /dev/null
@@ -1,63 +0,0 @@
-/*
-
-import Elm.Kernel.Json exposing (wrap)
-
-*/
-
-
-// NOTE: this is duplicating constants also defined in Test.Internal.KernelConstants
-// so if you make any changes here, be sure to synchronize them there!
-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)
-{
- return _Json_wrap(forceThunks(html));
-}
-
-function _HtmlAsJson_eventHandler(event)
-{
- return event[virtualDomKernelConstants.value];
-}
-
-function _HtmlAsJson_taggerFunction(tagger)
-{
- return tagger.a;
-}
-
-function _HtmlAsJson_attributeToJson(attribute)
-{
- return _Json_wrap(attribute);
-}
diff --git a/src/Elm/Kernel/Test.js b/src/Elm/Kernel/Test.js
index 1ef03633..67c23a44 100644
--- a/src/Elm/Kernel/Test.js
+++ b/src/Elm/Kernel/Test.js
@@ -1,6 +1,7 @@
/*
import Elm.Kernel.Utils exposing (Tuple0)
+import Elm.Kernel.VirtualDom exposing (toTest)
import Result exposing (Err, Ok)
*/
@@ -16,3 +17,6 @@ function _Test_runThunk(thunk)
return __Result_Err(err.toString());
}
}
+
+
+var _Test_virtualDomToTest = __VirtualDom_toTest;
diff --git a/src/Test/Html/Event.elm b/src/Test/Html/Event.elm
index cdea16fd..80b15250 100644
--- a/src/Test/Html/Event.elm
+++ b/src/Test/Html/Event.elm
@@ -399,8 +399,8 @@ findEvent eventName element =
NodeEntry node ->
eventDecoder node
- CustomNode node ->
- eventDecoder node
+ CustomNode facts ->
+ eventDecoder { facts = facts }
MarkdownNode node ->
eventDecoder node
diff --git a/src/Test/Html/Internal/ElmHtml/InternalTypes.elm b/src/Test/Html/Internal/ElmHtml/InternalTypes.elm
index f2a6bc73..2ed973e9 100644
--- a/src/Test/Html/Internal/ElmHtml/InternalTypes.elm
+++ b/src/Test/Html/Internal/ElmHtml/InternalTypes.elm
@@ -1,19 +1,19 @@
module Test.Html.Internal.ElmHtml.InternalTypes exposing
- ( ElmHtml(..), TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord
+ ( ElmHtml(..), NodeRecord, MarkdownNodeRecord
, Facts, Tagger, EventHandler, ElementKind(..)
, Attribute(..), AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord
- , decodeElmHtml, emptyFacts, toElementKind, decodeAttribute
+ , toElementKind
)
{-| Internal types used to represent Elm Html in pure Elm
-@docs ElmHtml, TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord
+@docs ElmHtml, NodeRecord, MarkdownNodeRecord
@docs Facts, Tagger, EventHandler, ElementKind
@docs Attribute, AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord
-@docs decodeElmHtml, emptyFacts, toElementKind, decodeAttribute
+@docs toElementKind
-}
@@ -21,8 +21,6 @@ import Dict exposing (Dict)
import Json.Decode exposing (field)
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
@@ -35,28 +33,19 @@ import VirtualDom
-}
type ElmHtml msg
- = TextTag TextTagRecord
+ = TextTag String
| NodeEntry (NodeRecord msg)
- | CustomNode (CustomNodeRecord msg)
+ | CustomNode (Facts msg)
| MarkdownNode (MarkdownNodeRecord msg)
-{-| Text tags just contain text
--}
-type alias TextTagRecord =
- { text : String }
-
-
-{-| A node contains the `tag` as a string, the children, the facts (e.g attributes) and descendantsCount
+{-| A node contains the `tag` as a string, the children, the facts (e.g attributes) and namespace
-}
type alias NodeRecord msg =
{ tag : String
, children : List (ElmHtml msg)
- , facts :
- Facts msg
-
- --, namespace : String
- , descendantsCount : Int
+ , facts : Facts msg
+ , namespace : Maybe String
}
@@ -64,15 +53,7 @@ type alias NodeRecord msg =
-}
type alias MarkdownNodeRecord msg =
{ facts : Facts msg
- , model : MarkdownModel
- }
-
-
-{-| Custom nodes contain facts (e.g attributes) and a json value for the model
--}
-type alias CustomNodeRecord msg =
- { facts : Facts msg
- , model : Json.Decode.Value
+ , markdown : String
}
@@ -95,19 +76,13 @@ type alias EventHandler =
{-| Facts contain various dictionaries and values for a node
-
- - styles are a mapping of rules
- - events may be a json object containing event handlers
- - attributes are pulled out into stringAttributes and boolAttributes - things with string values go into
- stringAttributes, things with bool values go into boolAttributes
-
-}
type alias Facts msg =
{ styles : Dict String String
, events : Dict String (VirtualDom.Handler msg)
- , attributeNamespace : Maybe Json.Decode.Value
- , stringAttributes : Dict String String
- , boolAttributes : Dict String Bool
+ , attributes : Dict String String
+ , attributesNS : Dict String { namespace : String, value : String }
+ , properties : Dict String Json.Decode.Value
}
@@ -123,10 +98,6 @@ type ElementKind
| NormalElements
-type HtmlContext msg
- = HtmlContext (List Tagger) (List Tagger -> EventHandler -> VirtualDom.Handler msg)
-
-
{-| Type for representing Elm's Attributes
- Attribute is an HTML attribute, like `Html.Attributes.colspan`. These values
@@ -173,265 +144,13 @@ type alias PropertyRecord =
}
-{-| Event contains a string key, a decoder for a msg and event options
+{-| Event contains a string event
-}
type alias EventRecord =
- { key : String
- , decoder : Json.Decode.Value
- , options : EventOptions
- }
-
-
-type alias EventOptions =
- { stopPropagation : Bool
- , preventDefault : Bool
+ { event : String
}
-{-| 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 (\_ _ -> 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 -> VirtualDom.Handler msg) -> Json.Decode.Decoder (ElmHtml msg)
-decodeElmHtml eventDecoder =
- contextDecodeElmHtml (HtmlContext [] eventDecoder)
-
-
-contextDecodeElmHtml : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg)
-contextDecodeElmHtml context =
- field kernelConstants.virtualDom.nodeType Json.Decode.int
- |> Json.Decode.andThen
- (\nodeType ->
- if nodeType == kernelConstants.virtualDom.nodeTypeText then
- Json.Decode.map TextTag decodeTextTag
-
- else if nodeType == kernelConstants.virtualDom.nodeTypeKeyedNode then
- Json.Decode.map NodeEntry (decodeKeyedNode context)
-
- else if nodeType == kernelConstants.virtualDom.nodeTypeNode then
- Json.Decode.map NodeEntry (decodeNode context)
-
- else if nodeType == kernelConstants.virtualDom.nodeTypeCustom then
- decodeCustomNode context
-
- else if nodeType == kernelConstants.virtualDom.nodeTypeTagger then
- decodeTagger context
-
- else if nodeType == kernelConstants.virtualDom.nodeTypeThunk then
- field kernelConstants.virtualDom.node (contextDecodeElmHtml context)
-
- else
- Json.Decode.fail ("No such type as " ++ String.fromInt nodeType)
- )
-
-
-{-| decode text tag
--}
-decodeTextTag : Json.Decode.Decoder TextTagRecord
-decodeTextTag =
- 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 kernelConstants.virtualDom.tagger Json.Decode.value
- |> Json.Decode.andThen
- (\tagger ->
- let
- nodeDecoder =
- contextDecodeElmHtml (HtmlContext (taggers ++ [ tagger ]) eventDecoder)
- in
- Json.Decode.at [ kernelConstants.virtualDom.node ] nodeDecoder
- )
-
-
-decodeKeyedNode : HtmlContext msg -> Json.Decode.Decoder (NodeRecord msg)
-decodeKeyedNode context =
- let
- -- elm stores keyed nodes as tuples
- -- we only want to decode the html, in the second property
- decodeSecondNode =
- Json.Decode.field "b" (contextDecodeElmHtml context)
- in
- Json.Decode.map4 NodeRecord
- (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
--}
-decodeNode : HtmlContext msg -> Json.Decode.Decoder (NodeRecord msg)
-decodeNode context =
- Json.Decode.map4 NodeRecord
- (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
--}
-decodeCustomNode : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg)
-decodeCustomNode context =
- Json.Decode.oneOf
- [ Json.Decode.map MarkdownNode (decodeMarkdownNodeRecord context)
- , Json.Decode.map CustomNode (decodeCustomNodeRecord context)
- ]
-
-
-{-| decode custom node record
--}
-decodeCustomNodeRecord : HtmlContext msg -> Json.Decode.Decoder (CustomNodeRecord msg)
-decodeCustomNodeRecord context =
- Json.Decode.map2 CustomNodeRecord
- (field kernelConstants.virtualDom.facts (decodeFacts context))
- (field kernelConstants.virtualDom.model Json.Decode.value)
-
-
-{-| decode markdown node record
--}
-decodeMarkdownNodeRecord : HtmlContext msg -> Json.Decode.Decoder (MarkdownNodeRecord msg)
-decodeMarkdownNodeRecord context =
- Json.Decode.map2 MarkdownNodeRecord
- (field kernelConstants.virtualDom.facts (decodeFacts context))
- (field kernelConstants.virtualDom.model decodeMarkdownModel)
-
-
-{-| decode the styles
--}
-decodeStyles : Json.Decode.Decoder (Dict String String)
-decodeStyles =
- Json.Decode.oneOf
- [ field styleKey (Json.Decode.dict Json.Decode.string)
- , Json.Decode.succeed Dict.empty
- ]
-
-
-{-| grab things from attributes via a decoder, then anything that isn't filtered on
-the object
--}
-decodeOthers : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a)
-decodeOthers otherDecoder =
- decodeAttributes otherDecoder
- |> Json.Decode.andThen
- (\attributes ->
- decodeDictFilterMap otherDecoder
- |> Json.Decode.map (filterKnownKeys >> Dict.union attributes)
- )
-
-
-{-| For a given decoder, keep the values from a dict that pass the decoder
--}
-decodeDictFilterMap : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a)
-decodeDictFilterMap decoder =
- Json.Decode.dict Json.Decode.value
- |> Json.Decode.map
- (Dict.toList
- >> List.filterMap
- (\( key, value ) ->
- case Json.Decode.decodeValue decoder value of
- Err _ ->
- Nothing
-
- Ok v ->
- Just ( key, v )
- )
- >> Dict.fromList
- )
-
-
-decodeAttributes : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a)
-decodeAttributes decoder =
- Json.Decode.oneOf
- [ Json.Decode.field attributeKey (decodeDictFilterMap decoder)
- , Json.Decode.succeed Dict.empty
- ]
-
-
-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))
- , Json.Decode.succeed Dict.empty
- ]
-
-
-{-| decode fact
--}
-decodeFacts : HtmlContext msg -> Json.Decode.Decoder (Facts msg)
-decodeFacts (HtmlContext taggers eventDecoder) =
- Json.Decode.map5 Facts
- decodeStyles
- (decodeEvents (eventDecoder taggers))
- (Json.Decode.maybe (Json.Decode.field attributeNamespaceKey Json.Decode.value))
- (decodeOthers Json.Decode.string)
- (decodeOthers Json.Decode.bool)
-
-
-{-| Just empty facts
--}
-emptyFacts : Facts msg
-emptyFacts =
- { styles = Dict.empty
- , events = Dict.empty
- , attributeNamespace = Nothing
- , stringAttributes = Dict.empty
- , boolAttributes = Dict.empty
- }
-
-
-{-| Decode a JSON object into an Attribute. You have to pass a function that
-decodes events from event attributes. If you don't want to decode event msgs,
-you can ignore it:
-
- decodeAttribute (\_ -> ()) 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.
-
--}
-decodeAttribute : Json.Decode.Decoder Attribute
-decodeAttribute =
- Json.Decode.field "$" Json.Decode.string
- |> Json.Decode.andThen
- (\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 "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 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.fail ("Unexpected Html.Attribute tag: " ++ tag)
- )
-
-
{-| A list of Void elements as defined by the HTML5 specification. These
elements must not have closing tags and most not be written as self closing
either
diff --git a/src/Test/Html/Internal/ElmHtml/Markdown.elm b/src/Test/Html/Internal/ElmHtml/Markdown.elm
deleted file mode 100644
index cdbef7af..00000000
--- a/src/Test/Html/Internal/ElmHtml/Markdown.elm
+++ /dev/null
@@ -1,55 +0,0 @@
-module Test.Html.Internal.ElmHtml.Markdown exposing
- ( MarkdownOptions, MarkdownModel, baseMarkdownModel
- , decodeMarkdownModel
- )
-
-{-| Markdown helpers
-
-@docs MarkdownOptions, MarkdownModel, baseMarkdownModel
-
-@docs decodeMarkdownModel
-
--}
-
-import Json.Decode exposing (field)
-import Test.Internal.KernelConstants exposing (kernelConstants)
-
-
-{-| Just a default markdown model
--}
-baseMarkdownModel : MarkdownModel
-baseMarkdownModel =
- { options =
- { githubFlavored = Just { tables = False, breaks = False }
- , defaultHighlighting = Nothing
- , sanitize = False
- , smartypants = False
- }
- , markdown = ""
- }
-
-
-{-| options markdown expects
--}
-type alias MarkdownOptions =
- { githubFlavored : Maybe { tables : Bool, breaks : Bool }
- , defaultHighlighting : Maybe String
- , sanitize : Bool
- , smartypants : Bool
- }
-
-
-{-| An internal markdown model. Options are the things you give markdown, markdown is the string
--}
-type alias MarkdownModel =
- { options : MarkdownOptions
- , markdown : String
- }
-
-
-{-| decode a markdown model
--}
-decodeMarkdownModel : Json.Decode.Decoder MarkdownModel
-decodeMarkdownModel =
- field kernelConstants.markdown.markdown Json.Decode.string
- |> Json.Decode.map (MarkdownModel baseMarkdownModel.options)
diff --git a/src/Test/Html/Internal/ElmHtml/Query.elm b/src/Test/Html/Internal/ElmHtml/Query.elm
index 64b1c36c..9aa43d9d 100644
--- a/src/Test/Html/Internal/ElmHtml/Query.elm
+++ b/src/Test/Html/Internal/ElmHtml/Query.elm
@@ -15,6 +15,7 @@ module Test.Html.Internal.ElmHtml.Query exposing
-}
import Dict
+import Json.Decode
import String
import Test.Html.Internal.ElmHtml.InternalTypes exposing (..)
@@ -153,7 +154,7 @@ queryInNodeHelp maxDescendantDepth selector node =
else
childEntries
- TextTag { text } ->
+ TextTag text ->
case selector of
ContainsText innerText ->
if String.contains innerText text then
@@ -227,19 +228,24 @@ hasAllSelectors selectors record =
hasAttribute : String -> String -> Facts msg -> Bool
hasAttribute attribute queryString facts =
- case Dict.get attribute facts.stringAttributes of
+ case Dict.get attribute facts.attributes of
Just id ->
id == queryString
Nothing ->
- False
+ case Dict.get attribute facts.properties of
+ Just id ->
+ Json.Decode.decodeValue Json.Decode.string id == Ok queryString
+
+ Nothing ->
+ False
hasBoolAttribute : String -> Bool -> Facts msg -> Bool
hasBoolAttribute attribute value facts =
- case Dict.get attribute facts.boolAttributes of
+ case Dict.get attribute facts.properties of
Just id ->
- id == value
+ Json.Decode.decodeValue Json.Decode.bool id == Ok value
Nothing ->
False
@@ -262,8 +268,26 @@ hasStyle style facts =
classnames : Facts msg -> List String
classnames facts =
- Dict.get "className" facts.stringAttributes
- |> Maybe.withDefault ""
+ (case ( Dict.get "class" facts.attributes, Dict.get "className" facts.properties ) of
+ ( Just _, Just _ ) ->
+ -- If you use both the `class` attribute and the `className` property at the same time,
+ -- it’s undefined which classes you end up with. It depends on which order they are specified,
+ -- which order elm/virtual-dom happens to apply them, and which of them changed most recently.
+ -- Mixing both is not a good idea. Ideally, we’d show some nice error message explaining this
+ -- here, but since this is very much an edge case it does not feel worth the complexity.
+ -- Instead, silently claim that there are no classes (that no classes match the node).
+ ""
+
+ ( Just class, Nothing ) ->
+ class
+
+ ( Nothing, Just className ) ->
+ Json.Decode.decodeValue Json.Decode.string className
+ |> Result.withDefault ""
+
+ ( Nothing, Nothing ) ->
+ ""
+ )
|> String.split " "
@@ -347,13 +371,11 @@ markdownPredicate selector =
>> hasStyle style
ContainsText text ->
- .model
- >> .markdown
+ .markdown
>> String.contains text
ContainsExactText text ->
- .model
- >> .markdown
+ .markdown
>> (==) text
Multiple selectors ->
diff --git a/src/Test/Html/Internal/ElmHtml/ToString.elm b/src/Test/Html/Internal/ElmHtml/ToString.elm
index e9b85008..5cf79948 100644
--- a/src/Test/Html/Internal/ElmHtml/ToString.elm
+++ b/src/Test/Html/Internal/ElmHtml/ToString.elm
@@ -12,6 +12,7 @@ module Test.Html.Internal.ElmHtml.ToString exposing
-}
import Dict
+import Json.Decode
import String
import Test.Html.Internal.ElmHtml.InternalTypes exposing (..)
@@ -36,7 +37,7 @@ defaultFormatOptions =
nodeToLines : FormatOptions -> ElmHtml msg -> List String
nodeToLines options nodeType =
case nodeType of
- TextTag { text } ->
+ TextTag text ->
[ text ]
NodeEntry record ->
@@ -46,7 +47,7 @@ nodeToLines options nodeType =
[]
MarkdownNode record ->
- [ record.model.markdown ]
+ [ record.markdown ]
{-| Convert a given html node to a string based on the type
@@ -116,25 +117,38 @@ nodeRecordToString options { tag, children, facts } =
|> Just
classes =
- Dict.get "className" facts.stringAttributes
+ Dict.get "className" facts.properties
+ |> Maybe.andThen (Json.Decode.decodeValue Json.Decode.string >> Result.toMaybe)
|> Maybe.map (\name -> "class=\"" ++ name ++ "\"")
stringAttributes =
- Dict.filter (\k _ -> k /= "className") facts.stringAttributes
+ facts.properties
|> Dict.toList
+ |> List.filterMap
+ (\( k, v ) ->
+ if k == "className" then
+ Nothing
+
+ else
+ Json.Decode.decodeValue Json.Decode.string v
+ |> Result.toMaybe
+ |> Maybe.map (Tuple.pair k)
+ )
+ |> List.append (Dict.toList facts.attributes)
|> List.map (\( k, v ) -> k ++ "=\"" ++ v ++ "\"")
|> String.join " "
|> Just
boolAttributes =
- Dict.toList facts.boolAttributes
+ Dict.toList facts.properties
|> List.filterMap
(\( k, v ) ->
- if v then
- Just k
+ case Json.Decode.decodeValue Json.Decode.bool v of
+ Ok True ->
+ Just k
- else
- Nothing
+ _ ->
+ Nothing
)
|> String.join " "
|> Just
diff --git a/src/Test/Html/Internal/Inert.elm b/src/Test/Html/Internal/Inert.elm
index fae19242..4b8bd2ce 100644
--- a/src/Test/Html/Internal/Inert.elm
+++ b/src/Test/Html/Internal/Inert.elm
@@ -6,10 +6,11 @@ module Test.Html.Internal.Inert exposing (Node, fromElmHtml, fromHtml, parseAttr
-}
-import Elm.Kernel.HtmlAsJson
+import Dict
+import Elm.Kernel.Test
import Html exposing (Html)
import Json.Decode
-import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes exposing (ElmHtml, EventHandler, Tagger, decodeAttribute, decodeElmHtml)
+import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes exposing (ElmHtml(..), EventHandler, Tagger)
import VirtualDom
@@ -17,14 +18,9 @@ type Node msg
= Node (ElmHtml msg)
-fromHtml : Html msg -> Result String (Node msg)
+fromHtml : Html msg -> Node msg
fromHtml html =
- case Json.Decode.decodeValue (decodeElmHtml taggedEventDecoder) (toJson html) of
- Ok elmHtml ->
- Ok (Node elmHtml)
-
- Err jsonError ->
- Err (Json.Decode.errorToString jsonError)
+ Node (Elm.Kernel.Test.virtualDomToTest html TextTag NodeEntry CustomNode MarkdownNode)
fromElmHtml : ElmHtml msg -> Node msg
@@ -32,85 +28,41 @@ fromElmHtml =
Node
-{-| Convert a Html node to a Json string
--}
-toJson : Html a -> Json.Decode.Value
-toJson node =
- Elm.Kernel.HtmlAsJson.toJson node
-
-
toElmHtml : Node msg -> ElmHtml msg
toElmHtml (Node elmHtml) =
elmHtml
-attributeToJson : Html.Attribute a -> Json.Decode.Value
-attributeToJson attribute =
- Elm.Kernel.HtmlAsJson.attributeToJson attribute
-
-
parseAttribute : Html.Attribute a -> Result String InternalTypes.Attribute
parseAttribute attr =
- case Json.Decode.decodeValue decodeAttribute (attributeToJson attr) of
- Ok parsedAttribute ->
- Ok parsedAttribute
-
- Err jsonError ->
- Err
- ("Error internally processing Attribute for testing - please report this error message as a bug: "
- ++ Json.Decode.errorToString jsonError
- )
-
-
-{-| Gets the function out of a tagger
--}
-taggerFunction : Tagger -> (a -> msg)
-taggerFunction tagger =
- Elm.Kernel.HtmlAsJson.taggerFunction tagger
-
-
-{-| Gets the decoder out of an EventHandler
--}
-eventDecoder : EventHandler -> VirtualDom.Handler msg
-eventDecoder eventHandler =
- Elm.Kernel.HtmlAsJson.eventHandler eventHandler
-
-
-{-| Applies the taggers over the event handlers to have the complete event decoder
--}
-taggedEventDecoder : List Tagger -> EventHandler -> VirtualDom.Handler msg
-taggedEventDecoder taggers eventHandler =
- case taggers of
- [] ->
- eventDecoder eventHandler
-
- [ tagger ] ->
- mapHandler (taggerFunction tagger) (eventDecoder eventHandler)
-
- tagger :: rest ->
- mapHandler (taggerFunction tagger) (taggedEventDecoder rest eventHandler)
-
-
-mapHandler : (a -> b) -> VirtualDom.Handler a -> VirtualDom.Handler b
-mapHandler f handler =
- case handler of
- VirtualDom.Normal decoder ->
- VirtualDom.Normal (Json.Decode.map f decoder)
-
- VirtualDom.MayStopPropagation decoder ->
- VirtualDom.MayStopPropagation (Json.Decode.map (Tuple.mapFirst f) decoder)
-
- VirtualDom.MayPreventDefault decoder ->
- VirtualDom.MayPreventDefault (Json.Decode.map (Tuple.mapFirst f) decoder)
-
- VirtualDom.Custom decoder ->
- VirtualDom.Custom
- (Json.Decode.map
- (\value ->
- { message = f value.message
- , stopPropagation = value.stopPropagation
- , preventDefault = value.preventDefault
- }
- )
- decoder
- )
+ case fromHtml (Html.div [ attr ] []) of
+ Node (NodeEntry { facts }) ->
+ case Dict.toList facts.attributes of
+ [ ( key, value ) ] ->
+ Ok (InternalTypes.Attribute { key = key, value = value })
+
+ _ ->
+ case Dict.toList facts.attributesNS of
+ [ ( key, { namespace, value } ) ] ->
+ Ok (InternalTypes.NamespacedAttribute { key = key, value = value, namespace = namespace })
+
+ _ ->
+ case Dict.toList facts.properties of
+ [ ( key, value ) ] ->
+ Ok (InternalTypes.Property { key = key, value = value })
+
+ _ ->
+ case Dict.toList facts.styles of
+ [ ( key, value ) ] ->
+ Ok (InternalTypes.Style { key = key, value = value })
+
+ _ ->
+ case Dict.toList facts.events of
+ [ ( event, _ ) ] ->
+ Ok (InternalTypes.Event { event = event })
+
+ _ ->
+ Err "Error internally processing Attribute for testing - please report this error message as a bug: Html.Attribute didn't end up as a fact in NodeEntry"
+
+ _ ->
+ Err "Error internally processing Attribute for testing - please report this error message as a bug: Html.div wasn't parsed as NodeEntry"
diff --git a/src/Test/Html/Query.elm b/src/Test/Html/Query.elm
index 8c57f325..c4de82e2 100644
--- a/src/Test/Html/Query.elm
+++ b/src/Test/Html/Query.elm
@@ -86,12 +86,7 @@ typically begin.
fromHtml : Html msg -> Single msg
fromHtml html =
Internal.Single True <|
- case Inert.fromHtml html of
- Ok node ->
- Internal.Query node []
-
- Err message ->
- Internal.InternalError message
+ Internal.Query (Inert.fromHtml html) []
@@ -361,50 +356,10 @@ count expect ((Internal.Multiple showTrace query) as multiple) =
-}
contains : List (Html msg) -> Single msg -> Expectation
contains expectedHtml (Internal.Single showTrace query) =
- case
- List.map Inert.fromHtml expectedHtml
- |> collectResults
- of
- Ok expectedElmHtml ->
- Internal.contains
- (List.map Inert.toElmHtml expectedElmHtml)
- query
- |> failWithQuery showTrace "Query.contains" query
-
- Err errors ->
- Expect.fail <|
- String.join "\n" <|
- List.concat
- [ [ "Internal Error: failed to decode the virtual dom. Please report this at ." ]
- , errors
- ]
-
-
-collectResults : List (Result x a) -> Result (List x) (List a)
-collectResults listOfResults =
- let
- step : Result (List x) (List a) -> List (Result x a) -> Result (List x) (List a)
- step acc list =
- case ( acc, list ) of
- ( Err errors, [] ) ->
- Err (List.reverse errors)
-
- ( Ok values, [] ) ->
- Ok (List.reverse values)
-
- ( Err errors, (Err x) :: rest ) ->
- step (Err (x :: errors)) rest
-
- ( Ok _, (Err x) :: rest ) ->
- step (Err [ x ]) rest
-
- ( Err errors, (Ok _) :: rest ) ->
- step (Err errors) rest
-
- ( Ok values, (Ok a) :: rest ) ->
- step (Ok (a :: values)) rest
- in
- step (Ok []) listOfResults
+ Internal.contains
+ (List.map (Inert.fromHtml >> Inert.toElmHtml) expectedHtml)
+ query
+ |> failWithQuery showTrace "Query.contains" query
{-| Expect the element to match all of the given selectors.
diff --git a/src/Test/Html/Query/Internal.elm b/src/Test/Html/Query/Internal.elm
index 27e8374c..f7826479 100644
--- a/src/Test/Html/Query/Internal.elm
+++ b/src/Test/Html/Query/Internal.elm
@@ -13,7 +13,6 @@ import Test.Runner
-}
type Query msg
= Query (Inert.Node msg) (List SelectorQuery)
- | InternalError String
type SelectorQuery
@@ -46,20 +45,12 @@ type Multiple msg
type QueryError
= NoResultsForSingle String
| MultipleResultsForSingle String Int
- | OtherInternalError String
toLines : String -> Query msg -> String -> List String
-toLines expectationFailure query queryName =
- case query of
- Query node selectors ->
- toLinesHelp expectationFailure [ Inert.toElmHtml node ] (List.reverse selectors) queryName []
- |> List.reverse
-
- InternalError message ->
- [ "Internal Error: failed to decode the virtual dom. Please report this at "
- , message
- ]
+toLines expectationFailure (Query node selectors) queryName =
+ toLinesHelp expectationFailure [ Inert.toElmHtml node ] (List.reverse selectors) queryName []
+ |> List.reverse
prettyPrint : ElmHtml msg -> String
@@ -68,14 +59,8 @@ prettyPrint =
toOutputLine : Query msg -> String
-toOutputLine query =
- case query of
- Query node _ ->
- prettyPrint (Inert.toElmHtml node)
-
- InternalError message ->
- "Internal Error: failed to decode the virtual dom. Please report this at . "
- ++ message
+toOutputLine (Query node _) =
+ prettyPrint (Inert.toElmHtml node)
toLinesHelp : String -> List (ElmHtml msg) -> List SelectorQuery -> String -> List String -> List String
@@ -235,13 +220,8 @@ baseIndentation =
prependSelector : Query msg -> SelectorQuery -> Query msg
-prependSelector query selector =
- case query of
- Query node selectors ->
- Query node (selector :: selectors)
-
- InternalError message ->
- InternalError message
+prependSelector (Query node selectors) selector =
+ Query node (selector :: selectors)
{-| This is a more efficient implementation of the following:
@@ -292,13 +272,8 @@ getElementAtHelp index list =
traverse : Query msg -> Result QueryError (List (ElmHtml msg))
-traverse query =
- case query of
- Query node selectorQueries ->
- traverseSelectors selectorQueries [ Inert.toElmHtml node ]
-
- InternalError message ->
- Err (OtherInternalError message)
+traverse (Query node selectorQueries) =
+ traverseSelectors selectorQueries [ Inert.toElmHtml node ]
traverseSelectors : List SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg))
@@ -448,10 +423,6 @@ queryErrorToString error =
++ String.fromInt resultCount
++ " elements, use Query.findAll instead of Query.find."
- OtherInternalError message ->
- "Internal Error: failed to decode the virtual dom. Please report this at . "
- ++ message
-
contains : List (ElmHtml msg) -> Query msg -> Expectation
contains expectedDescendants query =
diff --git a/src/Test/Internal/KernelConstants.elm b/src/Test/Internal/KernelConstants.elm
deleted file mode 100644
index 83365e8f..00000000
--- a/src/Test/Internal/KernelConstants.elm
+++ /dev/null
@@ -1,34 +0,0 @@
-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/src/Test/Html/QueryTests.elm b/tests/src/Test/Html/QueryTests.elm
index 134ff5c2..198d7b01 100644
--- a/tests/src/Test/Html/QueryTests.elm
+++ b/tests/src/Test/Html/QueryTests.elm
@@ -113,6 +113,27 @@ all =
[ Query.has [ attribute (Attr.property "className" (Encode.string "hello world")) ]
, Query.has [ attribute (Attr.property "className" (Encode.string "world hello")) ]
]
+ , test "matches a class added using Attr.attribute" <|
+ \() ->
+ divWithAttribute (Attr.attribute "class" "hello")
+ |> Query.fromHtml
+ |> Query.has [ class "hello" ]
+ , test "matches a class added using Attr.property" <|
+ \() ->
+ divWithAttribute (Attr.property "className" (Encode.string "hello"))
+ |> Query.fromHtml
+ |> Query.has [ class "hello" ]
+ , test "matches nothing if classes are added both using Attr.attribute and Attr.property" <|
+ \() ->
+ Html.div
+ [ Attr.attribute "class" "hello"
+ , Attr.property "className" (Encode.string "world")
+ ]
+ []
+ |> Query.fromHtml
+ |> Query.has [ class "hello" ]
+ |> expectationToIsPassing
+ |> Expect.equal False
]
]
, describe "Query.contains" <|