mirror of
https://github.com/dillonkearns/elm-pages-v3-beta.git
synced 2024-12-26 13:21:42 +03:00
Port over HTML to string helpers from elm-explorations/test. TODO - still need to port the escaping fixes I did to the elm-explorations/test implementation.
This commit is contained in:
Dillon Kearns
parent
05b8684da4
commit
c91b01d5a4
1
elm.json
1
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",
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
, Html.text static.data
|
||||
|
||||
-- TODO need to do escaping within lazy text
|
||||
, HtmlLazy.lazy (.data >> text) static
|
||||
]
|
||||
}
|
||||
|
||||
@ -349,7 +349,51 @@ async function compileCliApp(options) {
|
||||
elmFileContent
|
||||
.replace(
|
||||
/return \$elm\$json\$Json\$Encode\$string\(.REPLACE_ME_WITH_JSON_STRINGIFY.\)/g,
|
||||
"return " + (options.debug ? "_Json_wrap(x)" : "x")
|
||||
"return " +
|
||||
(options.debug
|
||||
? // "_Json_wrap(x)"
|
||||
` _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) {
|
||||
return _Json_wrap(forceThunks(html));
|
||||
`
|
||||
: "x")
|
||||
)
|
||||
.replace(
|
||||
"return ports ? { ports: ports } : {};",
|
||||
|
||||
@ -1,17 +1,20 @@
|
||||
module HtmlPrinter exposing (htmlToString)
|
||||
|
||||
import ElmHtml.InternalTypes exposing (decodeElmHtml)
|
||||
import ElmHtml.ToString exposing (defaultFormatOptions, nodeToStringWithOptions)
|
||||
import Html exposing (Html)
|
||||
import Html.Events
|
||||
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 (\_ _ -> Decode.succeed ()))
|
||||
(decodeElmHtml (\_ _ -> VirtualDom.Normal (Decode.succeed ())))
|
||||
(asJsonView viewHtml)
|
||||
of
|
||||
Ok str ->
|
||||
|
||||
31
src/Test/Html/Descendant.elm
Normal file
31
src/Test/Html/Descendant.elm
Normal file
@ -0,0 +1,31 @@
|
||||
module Test.Html.Descendant exposing (isDescendant)
|
||||
|
||||
import Html exposing (Html)
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes exposing (ElmHtml(..))
|
||||
import Test.Html.Internal.Inert exposing (fromHtml, toElmHtml)
|
||||
|
||||
|
||||
isDescendant : List (ElmHtml msg) -> ElmHtml msg -> Bool
|
||||
isDescendant html potentialDescendant =
|
||||
case html of
|
||||
[] ->
|
||||
False
|
||||
|
||||
current :: rest ->
|
||||
if current == potentialDescendant then
|
||||
True
|
||||
|
||||
else
|
||||
isDescendant
|
||||
(prependChildren current rest)
|
||||
potentialDescendant
|
||||
|
||||
|
||||
prependChildren : ElmHtml msg -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
prependChildren parentNode nodeList =
|
||||
case parentNode of
|
||||
NodeEntry { children } ->
|
||||
List.concat [ children, nodeList ]
|
||||
|
||||
_ ->
|
||||
nodeList
|
||||
426
src/Test/Html/Event.elm
Normal file
426
src/Test/Html/Event.elm
Normal file
@ -0,0 +1,426 @@
|
||||
module Test.Html.Event exposing
|
||||
( Event, simulate, expect, toResult
|
||||
, expectStopPropagation, expectNotStopPropagation, expectPreventDefault, expectNotPreventDefault
|
||||
, custom, click, doubleClick, mouseDown, mouseUp, mouseEnter, mouseLeave, mouseOver, mouseOut, input, check, submit, blur, focus
|
||||
)
|
||||
|
||||
{-| This module lets you simulate events on `Html` values and expect that
|
||||
they result in certain `Msg` values being sent to `update`.
|
||||
|
||||
|
||||
## Simulating Events
|
||||
|
||||
@docs Event, simulate, expect, toResult
|
||||
|
||||
|
||||
## Testing Event Effects
|
||||
|
||||
These functions allow you to test that your event handlers are (or are not) calling
|
||||
[`stopPropagation()`](https://developer.mozilla.org/en-US/docs/Web/API/Event/stopPropagation)
|
||||
and
|
||||
[`preventDefault()`](https://developer.mozilla.org/en-US/docs/Web/API/Event/preventDefault).
|
||||
In Elm, you do this by calling
|
||||
[special functions](https://package.elm-lang.org/packages/elm/html/latest/Html-Events#stopPropagationOn)
|
||||
in `Html.Events`.
|
||||
|
||||
@docs expectStopPropagation, expectNotStopPropagation, expectPreventDefault, expectNotPreventDefault
|
||||
|
||||
|
||||
## Event Builders
|
||||
|
||||
@docs custom, click, doubleClick, mouseDown, mouseUp, mouseEnter, mouseLeave, mouseOver, mouseOut, input, check, submit, blur, focus
|
||||
|
||||
-}
|
||||
|
||||
import Dict
|
||||
import Expect exposing (Expectation)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Encode as Encode exposing (Value)
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes exposing (ElmHtml(..), Tagger)
|
||||
import Test.Html.Query as Query
|
||||
import Test.Html.Query.Internal as QueryInternal
|
||||
import Test.Internal as Internal
|
||||
import VirtualDom
|
||||
|
||||
|
||||
{-| A simulated event.
|
||||
|
||||
See [`simulate`](#simulate).
|
||||
|
||||
-}
|
||||
type Event msg
|
||||
= Event ( String, Value ) (QueryInternal.Single msg)
|
||||
|
||||
|
||||
{-| Simulate an event on a node.
|
||||
|
||||
import Test.Html.Event as Event
|
||||
|
||||
type Msg
|
||||
= Change String
|
||||
|
||||
|
||||
test "Input produces expected Msg" <|
|
||||
\() ->
|
||||
Html.input [ onInput Change ] [ ]
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.input "cats")
|
||||
|> Event.expect (Change "cats")
|
||||
|
||||
-}
|
||||
simulate : ( String, Value ) -> Query.Single msg -> Event msg
|
||||
simulate =
|
||||
Event
|
||||
|
||||
|
||||
{-| Passes if the given message is triggered by the simulated event.
|
||||
|
||||
import Test.Html.Event as Event
|
||||
|
||||
type Msg
|
||||
= Change String
|
||||
|
||||
|
||||
test "Input produces expected Msg" <|
|
||||
\() ->
|
||||
Html.input [ onInput Change ] [ ]
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.input "cats")
|
||||
|> Event.expect (Change "cats")
|
||||
|
||||
-}
|
||||
expect : msg -> Event msg -> Expectation
|
||||
expect msg (Event event (QueryInternal.Single showTrace query)) =
|
||||
case toResult (Event event (QueryInternal.Single showTrace query)) of
|
||||
Err noEvent ->
|
||||
Expect.fail noEvent
|
||||
|> QueryInternal.failWithQuery showTrace "" query
|
||||
|
||||
Ok foundMsg ->
|
||||
foundMsg
|
||||
|> Expect.equal msg
|
||||
|> QueryInternal.failWithQuery showTrace
|
||||
("Event.expectEvent: Expected the msg \u{001B}[32m"
|
||||
++ Internal.toString msg
|
||||
++ "\u{001B}[39m from the event \u{001B}[31m"
|
||||
++ Internal.toString event
|
||||
++ "\u{001B}[39m but could not find the event."
|
||||
)
|
||||
query
|
||||
|
||||
|
||||
{-| Returns a Result with the Msg produced by the event simulated on a node.
|
||||
Note that Event.expect gives nicer messages; this is generally more useful
|
||||
when testing that an event handler is _not_ present.
|
||||
|
||||
import Test.Html.Event as Event
|
||||
|
||||
|
||||
test "Input produces expected Msg" <|
|
||||
\() ->
|
||||
Html.input [ onInput Change ] [ ]
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.input "cats")
|
||||
|> Event.toResult
|
||||
|> Expect.equal (Ok (Change "cats"))
|
||||
|
||||
-}
|
||||
toResult : Event msg -> Result String msg
|
||||
toResult event =
|
||||
findHandler event
|
||||
|> Result.map (Decode.map .message)
|
||||
|> Result.andThen
|
||||
(\handler ->
|
||||
Decode.decodeValue handler (eventPayload event)
|
||||
|> Result.mapError Decode.errorToString
|
||||
)
|
||||
|
||||
|
||||
|
||||
-- EFFECTS --
|
||||
|
||||
|
||||
{-| -}
|
||||
expectStopPropagation : Event msg -> Expectation
|
||||
expectStopPropagation event =
|
||||
case checkStopPropagation event of
|
||||
Err reason ->
|
||||
Expect.fail reason
|
||||
|
||||
Ok False ->
|
||||
Expect.fail "I found a handler that could have stopped propagation of the event, but it didn't."
|
||||
|
||||
Ok True ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
{-| -}
|
||||
expectNotStopPropagation : Event msg -> Expectation
|
||||
expectNotStopPropagation event =
|
||||
case checkStopPropagation event of
|
||||
Err reason ->
|
||||
Expect.fail reason
|
||||
|
||||
Ok False ->
|
||||
Expect.pass
|
||||
|
||||
Ok True ->
|
||||
Expect.fail
|
||||
"I found a handler that should have not stopped propagation of the event, but it did."
|
||||
|
||||
|
||||
{-| -}
|
||||
expectPreventDefault : Event msg -> Expectation
|
||||
expectPreventDefault event =
|
||||
case checkPreventDefault event of
|
||||
Err reason ->
|
||||
Expect.fail reason
|
||||
|
||||
Ok False ->
|
||||
Expect.fail "I found a handler that could have prevented default action of the event, but it didn't."
|
||||
|
||||
Ok True ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
{-| -}
|
||||
expectNotPreventDefault : Event msg -> Expectation
|
||||
expectNotPreventDefault event =
|
||||
case checkPreventDefault event of
|
||||
Err reason ->
|
||||
Expect.fail reason
|
||||
|
||||
Ok False ->
|
||||
Expect.pass
|
||||
|
||||
Ok True ->
|
||||
Expect.fail
|
||||
"I found a handler that should have not prevented the default action of the event, but it did."
|
||||
|
||||
|
||||
{-| A [`click`](https://developer.mozilla.org/en-US/docs/Web/Events/click) event.
|
||||
-}
|
||||
click : ( String, Value )
|
||||
click =
|
||||
( "click", emptyObject )
|
||||
|
||||
|
||||
{-| A [`dblclick`](https://developer.mozilla.org/en-US/docs/Web/Events/dblclick) event.
|
||||
-}
|
||||
doubleClick : ( String, Value )
|
||||
doubleClick =
|
||||
( "dblclick", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mousedown`](https://developer.mozilla.org/en-US/docs/Web/Events/mousedown) event.
|
||||
-}
|
||||
mouseDown : ( String, Value )
|
||||
mouseDown =
|
||||
( "mousedown", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseup`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseup) event.
|
||||
-}
|
||||
mouseUp : ( String, Value )
|
||||
mouseUp =
|
||||
( "mouseup", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseenter`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseenter) event.
|
||||
-}
|
||||
mouseEnter : ( String, Value )
|
||||
mouseEnter =
|
||||
( "mouseenter", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseleave`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseleave) event.
|
||||
-}
|
||||
mouseLeave : ( String, Value )
|
||||
mouseLeave =
|
||||
( "mouseleave", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseover`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseover) event.
|
||||
-}
|
||||
mouseOver : ( String, Value )
|
||||
mouseOver =
|
||||
( "mouseover", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseout`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseout) event.
|
||||
-}
|
||||
mouseOut : ( String, Value )
|
||||
mouseOut =
|
||||
( "mouseout", emptyObject )
|
||||
|
||||
|
||||
{-| An [`input`](https://developer.mozilla.org/en-US/docs/Web/Events/input) event.
|
||||
-}
|
||||
input : String -> ( String, Value )
|
||||
input value =
|
||||
( "input"
|
||||
, Encode.object
|
||||
[ ( "target"
|
||||
, Encode.object [ ( "value", Encode.string value ) ]
|
||||
)
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
{-| A [`change`](https://developer.mozilla.org/en-US/docs/Web/Events/change) event
|
||||
where `event.target.checked` is set to the given `Bool` value.
|
||||
-}
|
||||
check : Bool -> ( String, Value )
|
||||
check checked =
|
||||
( "change"
|
||||
, Encode.object
|
||||
[ ( "target"
|
||||
, Encode.object [ ( "checked", Encode.bool checked ) ]
|
||||
)
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
{-| A [`submit`](https://developer.mozilla.org/en-US/docs/Web/Events/submit) event.
|
||||
-}
|
||||
submit : ( String, Value )
|
||||
submit =
|
||||
( "submit", emptyObject )
|
||||
|
||||
|
||||
{-| A [`blur`](https://developer.mozilla.org/en-US/docs/Web/Events/blur) event.
|
||||
-}
|
||||
blur : ( String, Value )
|
||||
blur =
|
||||
( "blur", emptyObject )
|
||||
|
||||
|
||||
{-| A [`focus`](https://developer.mozilla.org/en-US/docs/Web/Events/focus) event.
|
||||
-}
|
||||
focus : ( String, Value )
|
||||
focus =
|
||||
( "focus", emptyObject )
|
||||
|
||||
|
||||
{-| Simulate a custom event. The `String` is the event name, and the `Value` is the event object
|
||||
the browser would send to the event listener callback.
|
||||
|
||||
import Test.Html.Event as Event
|
||||
import Json.Encode as Encode exposing (Value)
|
||||
|
||||
|
||||
type Msg
|
||||
= Change String
|
||||
|
||||
|
||||
test "Input produces expected Msg" <|
|
||||
\() ->
|
||||
let
|
||||
simulatedEventObject : Value
|
||||
simulatedEventObject =
|
||||
Encode.object
|
||||
[ ( "target"
|
||||
, Encode.object [ ( "value", Encode.string "cats" ) ]
|
||||
)
|
||||
]
|
||||
in
|
||||
Html.input [ onInput Change ] [ ]
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.custom "input" simulatedEventObject)
|
||||
|> Event.expect (Change "cats")
|
||||
|
||||
-}
|
||||
custom : String -> Value -> ( String, Value )
|
||||
custom =
|
||||
Tuple.pair
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
emptyObject : Value
|
||||
emptyObject =
|
||||
Encode.object []
|
||||
|
||||
|
||||
eventPayload : Event msg -> Value
|
||||
eventPayload (Event ( _, payload ) _) =
|
||||
payload
|
||||
|
||||
|
||||
type alias Handling msg =
|
||||
{ message : msg, stopPropagation : Bool, preventDefault : Bool }
|
||||
|
||||
|
||||
findHandler : Event msg -> Result String (Decoder (Handling msg))
|
||||
findHandler (Event ( eventName, _ ) (QueryInternal.Single _ query)) =
|
||||
QueryInternal.traverse query
|
||||
|> Result.andThen (QueryInternal.verifySingle eventName)
|
||||
|> Result.mapError (QueryInternal.queryErrorToString query)
|
||||
|> Result.andThen (findEvent eventName)
|
||||
|
||||
|
||||
findEvent : String -> ElmHtml msg -> Result String (Decoder (Handling msg))
|
||||
findEvent eventName element =
|
||||
let
|
||||
elementOutput =
|
||||
QueryInternal.prettyPrint element
|
||||
|
||||
handlerToDecoder : VirtualDom.Handler msg -> Decoder (Handling msg)
|
||||
handlerToDecoder handler =
|
||||
case handler of
|
||||
VirtualDom.Normal decoder ->
|
||||
decoder |> Decode.map (\msg -> Handling msg False False)
|
||||
|
||||
VirtualDom.MayStopPropagation decoder ->
|
||||
decoder |> Decode.map (\( msg, sp ) -> Handling msg sp False)
|
||||
|
||||
VirtualDom.MayPreventDefault decoder ->
|
||||
decoder |> Decode.map (\( msg, pd ) -> Handling msg False pd)
|
||||
|
||||
VirtualDom.Custom decoder ->
|
||||
decoder
|
||||
|
||||
eventDecoder node =
|
||||
node.facts.events
|
||||
|> Dict.get eventName
|
||||
|> Maybe.map handlerToDecoder
|
||||
|> Result.fromMaybe ("Event.expectEvent: I found a node, but it does not listen for \"" ++ eventName ++ "\" events like I expected it would.\n\n" ++ elementOutput)
|
||||
in
|
||||
case element of
|
||||
TextTag _ ->
|
||||
Err ("I found a text node instead of an element. Text nodes do not receive events, so it would be impossible to simulate \"" ++ eventName ++ "\" events on it. The text in the node was: \"" ++ elementOutput ++ "\"")
|
||||
|
||||
NodeEntry node ->
|
||||
eventDecoder node
|
||||
|
||||
CustomNode node ->
|
||||
eventDecoder node
|
||||
|
||||
MarkdownNode node ->
|
||||
eventDecoder node
|
||||
|
||||
NoOp ->
|
||||
Err ("I found an element I did not know how to deal with, so simulating \"" ++ eventName ++ "\" events on it would be impossible. This is a problem with elm-test! Sorry about that. If you have time, could you report this issue on https://github.com/elm-explorations/test/issues with a http://sscce.org to reproduce this error message?")
|
||||
|
||||
|
||||
checkStopPropagation : Event msg -> Result String Bool
|
||||
checkStopPropagation =
|
||||
checkEffect .stopPropagation
|
||||
|
||||
|
||||
checkPreventDefault : Event msg -> Result String Bool
|
||||
checkPreventDefault =
|
||||
checkEffect .preventDefault
|
||||
|
||||
|
||||
checkEffect : (Handling msg -> Bool) -> Event msg -> Result String Bool
|
||||
checkEffect extractor event =
|
||||
findHandler event
|
||||
|> Result.map (Decode.map extractor)
|
||||
|> Result.andThen
|
||||
(\handler ->
|
||||
Decode.decodeValue handler (eventPayload event)
|
||||
|> Result.mapError Decode.errorToString
|
||||
)
|
||||
53
src/Test/Html/Internal/ElmHtml/Constants.elm
Normal file
53
src/Test/Html/Internal/ElmHtml/Constants.elm
Normal file
@ -0,0 +1,53 @@
|
||||
module Test.Html.Internal.ElmHtml.Constants exposing
|
||||
( propKey, styleKey, eventKey, attributeKey, attributeNamespaceKey
|
||||
, knownKeys
|
||||
)
|
||||
|
||||
{-| Constants for representing internal keys for Elm's vdom implementation
|
||||
|
||||
@docs propKey, styleKey, eventKey, attributeKey, attributeNamespaceKey
|
||||
@docs knownKeys
|
||||
|
||||
-}
|
||||
|
||||
|
||||
{-| Internal key for attribute properties
|
||||
-}
|
||||
propKey : String
|
||||
propKey =
|
||||
"a2"
|
||||
|
||||
|
||||
{-| Internal key for style
|
||||
-}
|
||||
styleKey : String
|
||||
styleKey =
|
||||
"a1"
|
||||
|
||||
|
||||
{-| Internal key for style
|
||||
-}
|
||||
eventKey : String
|
||||
eventKey =
|
||||
"a0"
|
||||
|
||||
|
||||
{-| Internal key for style
|
||||
-}
|
||||
attributeKey : String
|
||||
attributeKey =
|
||||
"a3"
|
||||
|
||||
|
||||
{-| Internal key for style
|
||||
-}
|
||||
attributeNamespaceKey : String
|
||||
attributeNamespaceKey =
|
||||
"a4"
|
||||
|
||||
|
||||
{-| Keys that we are aware of and should pay attention to
|
||||
-}
|
||||
knownKeys : List String
|
||||
knownKeys =
|
||||
[ styleKey, eventKey, attributeKey, attributeNamespaceKey ]
|
||||
17
src/Test/Html/Internal/ElmHtml/Helpers.elm
Normal file
17
src/Test/Html/Internal/ElmHtml/Helpers.elm
Normal file
@ -0,0 +1,17 @@
|
||||
module Test.Html.Internal.ElmHtml.Helpers exposing (filterKnownKeys)
|
||||
|
||||
{-| Internal helpers for ElmHtml
|
||||
|
||||
@docs filterKnownKeys
|
||||
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import Test.Html.Internal.ElmHtml.Constants exposing (knownKeys)
|
||||
|
||||
|
||||
{-| Filter out keys that we don't know
|
||||
-}
|
||||
filterKnownKeys : Dict String a -> Dict String a
|
||||
filterKnownKeys =
|
||||
Dict.filter (\key _ -> not (List.member key knownKeys))
|
||||
555
src/Test/Html/Internal/ElmHtml/InternalTypes.elm
Normal file
555
src/Test/Html/Internal/ElmHtml/InternalTypes.elm
Normal file
@ -0,0 +1,555 @@
|
||||
module Test.Html.Internal.ElmHtml.InternalTypes exposing
|
||||
( ElmHtml(..), TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord
|
||||
, Facts, Tagger, EventHandler, ElementKind(..)
|
||||
, Attribute(..), AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord
|
||||
, decodeElmHtml, emptyFacts, toElementKind, decodeAttribute
|
||||
)
|
||||
|
||||
{-| Internal types used to represent Elm Html in pure Elm
|
||||
|
||||
@docs ElmHtml, TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord
|
||||
|
||||
@docs Facts, Tagger, EventHandler, ElementKind
|
||||
|
||||
@docs Attribute, AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord
|
||||
|
||||
@docs decodeElmHtml, emptyFacts, toElementKind, decodeAttribute
|
||||
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
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 VirtualDom
|
||||
|
||||
|
||||
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"
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
{-| Type tree for representing Elm's Html
|
||||
|
||||
- TextTag is just a plain old bit of text.
|
||||
- NodeEntry is an actual HTML node, e.g a div
|
||||
- CustomNode are nodes defined to work with the renderer in some way, e.g webgl/markdown
|
||||
- MarkdownNode is just a wrapper for CustomNode designed just for markdown
|
||||
|
||||
-}
|
||||
type ElmHtml msg
|
||||
= TextTag TextTagRecord
|
||||
| NodeEntry (NodeRecord msg)
|
||||
| CustomNode (CustomNodeRecord msg)
|
||||
| MarkdownNode (MarkdownNodeRecord msg)
|
||||
| NoOp
|
||||
|
||||
|
||||
{-| 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
|
||||
-}
|
||||
type alias NodeRecord msg =
|
||||
{ tag : String
|
||||
, children : List (ElmHtml msg)
|
||||
, facts :
|
||||
Facts msg
|
||||
|
||||
--, namespace : String
|
||||
, descendantsCount : Int
|
||||
}
|
||||
|
||||
|
||||
{-| A markdown node contains facts (e.g attributes) and the model used by markdown
|
||||
-}
|
||||
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
|
||||
}
|
||||
|
||||
|
||||
{-| Tagger holds the map function when Html.Map is used, the tagger
|
||||
should then be applied to events comming from descendant nodes, it
|
||||
is basically a javascript function.
|
||||
-}
|
||||
type alias Tagger =
|
||||
Json.Decode.Value
|
||||
|
||||
|
||||
{-| EventHandler holds the function that is called when an event is
|
||||
triggered, it is basically a javascript object like this:
|
||||
|
||||
{ decoder: [Function] }
|
||||
|
||||
-}
|
||||
type alias EventHandler =
|
||||
Json.Decode.Value
|
||||
|
||||
|
||||
{-| 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
|
||||
}
|
||||
|
||||
|
||||
{-| Type for representing the five kinds of elements according to HTML 5
|
||||
[spec](https://html.spec.whatwg.org/multipage/syntax.html#elements-2).
|
||||
Used to handle different rendering behavior depending on the type of element.
|
||||
-}
|
||||
type ElementKind
|
||||
= VoidElements
|
||||
| RawTextElements
|
||||
| EscapableRawTextElements
|
||||
| ForeignElements
|
||||
| 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
|
||||
are applied using `element.setAttribute(key, value)` during a patch.
|
||||
- NamespacedAttribute has an namespace, like `Svg.Attributes.xlinkHref`
|
||||
- Property assigns a value to a node like `Html.Attributes.class`, and can
|
||||
hold any encoded value. Unlike attributes, where `element.setAttribute()` is
|
||||
used during the patch, properties are applied directly as
|
||||
`element[key] = value`.
|
||||
- Styles hold a list of key value pairs to be applied to the node's style set
|
||||
- Event contains a decoder for a msg and the `Html.Event.Options` for the event
|
||||
|
||||
-}
|
||||
type Attribute
|
||||
= Attribute AttributeRecord
|
||||
| NamespacedAttribute NamespacedAttributeRecord
|
||||
| Property PropertyRecord
|
||||
| Style { key : String, value : String }
|
||||
| Event EventRecord
|
||||
|
||||
|
||||
{-| Attribute contains a string key and a string value
|
||||
-}
|
||||
type alias AttributeRecord =
|
||||
{ key : String
|
||||
, value : String
|
||||
}
|
||||
|
||||
|
||||
{-| NamespacedAttribute contains a string key, string namespace and string value
|
||||
-}
|
||||
type alias NamespacedAttributeRecord =
|
||||
{ key : String
|
||||
, value : String
|
||||
, namespace : String
|
||||
}
|
||||
|
||||
|
||||
{-| Property contains a string key and a value with an arbitrary type
|
||||
-}
|
||||
type alias PropertyRecord =
|
||||
{ key : String
|
||||
, value : Json.Decode.Value
|
||||
}
|
||||
|
||||
|
||||
{-| Event contains a string key, a decoder for a msg and event options
|
||||
-}
|
||||
type alias EventRecord =
|
||||
{ key : String
|
||||
, decoder : Json.Decode.Value
|
||||
, options : EventOptions
|
||||
}
|
||||
|
||||
|
||||
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 (\_ _ -> 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)
|
||||
)
|
||||
|
||||
|
||||
elmListDecoder : Json.Decode.Decoder a -> Json.Decode.Decoder (List a)
|
||||
elmListDecoder itemDecoder =
|
||||
elmListDecoderHelp itemDecoder []
|
||||
|> Json.Decode.map List.reverse
|
||||
|
||||
|
||||
elmListDecoderHelp : Json.Decode.Decoder a -> List a -> Json.Decode.Decoder (List a)
|
||||
elmListDecoderHelp itemDecoder items =
|
||||
Json.Decode.field "ctor" Json.Decode.string
|
||||
|> Json.Decode.andThen
|
||||
(\ctor ->
|
||||
case ctor of
|
||||
"[]" ->
|
||||
Json.Decode.succeed items
|
||||
|
||||
"::" ->
|
||||
Json.Decode.field "_0" itemDecoder
|
||||
|> Json.Decode.andThen
|
||||
(\value ->
|
||||
Json.Decode.field "_1" (elmListDecoderHelp itemDecoder (value :: items))
|
||||
)
|
||||
|
||||
_ ->
|
||||
Json.Decode.fail <| "Unrecognized constructor for an Elm List: " ++ ctor
|
||||
)
|
||||
|
||||
|
||||
{-| 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
|
||||
-}
|
||||
voidElements : List String
|
||||
voidElements =
|
||||
[ "area"
|
||||
, "base"
|
||||
, "br"
|
||||
, "col"
|
||||
, "embed"
|
||||
, "hr"
|
||||
, "img"
|
||||
, "input"
|
||||
, "link"
|
||||
, "meta"
|
||||
, "param"
|
||||
, "source"
|
||||
, "track"
|
||||
, "wbr"
|
||||
]
|
||||
|
||||
|
||||
{-| A list of all Raw Text Elements as defined by the HTML5 specification. They
|
||||
can contain only text and have restrictions on which characters can appear
|
||||
within its innerHTML
|
||||
-}
|
||||
rawTextElements : List String
|
||||
rawTextElements =
|
||||
[ "script", "style" ]
|
||||
|
||||
|
||||
{-| A list of all Escapable Raw Text Elements as defined by the HTML5
|
||||
specification. They can have text and character references, but the text must
|
||||
not contain an ambiguous ampersand along with addional restrictions:
|
||||
<https://html.spec.whatwg.org/multipage/syntax.html#cdata-rcdata-restrictions>
|
||||
-}
|
||||
escapableRawTextElements : List String
|
||||
escapableRawTextElements =
|
||||
[ "textarea", "title" ]
|
||||
|
||||
|
||||
|
||||
{- Foreign elements are elements from the MathML namespace and the
|
||||
SVG namespace. TODO: detect these nodes and handle them correctly. Right
|
||||
now they will just be treated as Normal elements.
|
||||
-}
|
||||
|
||||
|
||||
{-| Identify the kind of element. Helper to convert an tag name into a type for
|
||||
pattern matching.
|
||||
-}
|
||||
toElementKind : String -> ElementKind
|
||||
toElementKind element =
|
||||
if List.member element voidElements then
|
||||
VoidElements
|
||||
|
||||
else if List.member element rawTextElements then
|
||||
RawTextElements
|
||||
|
||||
else if List.member element escapableRawTextElements then
|
||||
EscapableRawTextElements
|
||||
|
||||
else
|
||||
-- All other allowed HTML elements are normal elements
|
||||
NormalElements
|
||||
56
src/Test/Html/Internal/ElmHtml/Markdown.elm
Normal file
56
src/Test/Html/Internal/ElmHtml/Markdown.elm
Normal file
@ -0,0 +1,56 @@
|
||||
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 Json.Encode
|
||||
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)
|
||||
345
src/Test/Html/Internal/ElmHtml/Query.elm
Normal file
345
src/Test/Html/Internal/ElmHtml/Query.elm
Normal file
@ -0,0 +1,345 @@
|
||||
module Test.Html.Internal.ElmHtml.Query exposing
|
||||
( Selector(..)
|
||||
, query, queryAll, queryChildren, queryChildrenAll, queryInNode
|
||||
, queryById, queryByClassName, queryByClassList, queryByStyle, queryByTagName, queryByAttribute, queryByBoolAttribute
|
||||
, getChildren
|
||||
)
|
||||
|
||||
{-| Query things using ElmHtml
|
||||
|
||||
@docs Selector
|
||||
@docs query, queryAll, queryChildren, queryChildrenAll, queryInNode
|
||||
@docs queryById, queryByClassName, queryByClassList, queryByStyle, queryByTagName, queryByAttribute, queryByBoolAttribute
|
||||
@docs getChildren
|
||||
|
||||
-}
|
||||
|
||||
import Dict
|
||||
import String
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes exposing (..)
|
||||
|
||||
|
||||
{-| Selectors to query a Html element
|
||||
|
||||
- Id, classname, classlist, tag are all what you'd expect
|
||||
- Attribute and bool attribute are attributes
|
||||
- ConainsText just searches inside for the given text
|
||||
|
||||
-}
|
||||
type Selector
|
||||
= Id String
|
||||
| ClassName String
|
||||
| ClassList (List String)
|
||||
| Tag String
|
||||
| Attribute String String
|
||||
| BoolAttribute String Bool
|
||||
| Style { key : String, value : String }
|
||||
| ContainsText String
|
||||
| Multiple (List Selector)
|
||||
|
||||
|
||||
{-| Query for a node with a given tag in a Html element
|
||||
-}
|
||||
queryByTagName : String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByTagName tagname =
|
||||
query (Tag tagname)
|
||||
|
||||
|
||||
{-| Query for a node with a given id in a Html element
|
||||
-}
|
||||
queryById : String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryById id =
|
||||
query (Id id)
|
||||
|
||||
|
||||
{-| Query for a node with a given classname in a Html element
|
||||
-}
|
||||
queryByClassName : String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByClassName classname =
|
||||
query (ClassName classname)
|
||||
|
||||
|
||||
{-| Query for a node with all the given classnames in a Html element
|
||||
-}
|
||||
queryByClassList : List String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByClassList classList =
|
||||
query (ClassList classList)
|
||||
|
||||
|
||||
{-| Query for a node with the given style in a Html element
|
||||
-}
|
||||
queryByStyle : { key : String, value : String } -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByStyle style =
|
||||
query (Style style)
|
||||
|
||||
|
||||
{-| Query for a node with a given attribute in a Html element
|
||||
-}
|
||||
queryByAttribute : String -> String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByAttribute key value =
|
||||
query (Attribute key value)
|
||||
|
||||
|
||||
{-| Query for a node with a given attribute in a Html element
|
||||
-}
|
||||
queryByBoolAttribute : String -> Bool -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByBoolAttribute key value =
|
||||
query (BoolAttribute key value)
|
||||
|
||||
|
||||
{-| Query an ElmHtml element using a selector, searching all children.
|
||||
-}
|
||||
query : Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
query selector =
|
||||
queryInNode selector
|
||||
|
||||
|
||||
{-| Query an ElmHtml node using multiple selectors, considering both the node itself
|
||||
as well as all of its descendants.
|
||||
-}
|
||||
queryAll : List Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryAll selectors =
|
||||
query (Multiple selectors)
|
||||
|
||||
|
||||
{-| Query an ElmHtml node using a selector, considering both the node itself
|
||||
as well as all of its descendants.
|
||||
-}
|
||||
queryInNode : Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryInNode =
|
||||
queryInNodeHelp Nothing
|
||||
|
||||
|
||||
{-| Query an ElmHtml node using a selector, considering both the node itself
|
||||
as well as all of its descendants.
|
||||
-}
|
||||
queryChildren : Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryChildren =
|
||||
queryInNodeHelp (Just 1)
|
||||
|
||||
|
||||
{-| Returns just the immediate children of an ElmHtml node
|
||||
-}
|
||||
getChildren : ElmHtml msg -> List (ElmHtml msg)
|
||||
getChildren elmHtml =
|
||||
case elmHtml of
|
||||
NodeEntry { children } ->
|
||||
children
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
|
||||
{-| Query to ensure an ElmHtml node has all selectors given, without considering
|
||||
any descendants lower than its immediate children.
|
||||
-}
|
||||
queryChildrenAll : List Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryChildrenAll selectors =
|
||||
queryInNodeHelp (Just 1) (Multiple selectors)
|
||||
|
||||
|
||||
queryInNodeHelp : Maybe Int -> Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryInNodeHelp maxDescendantDepth selector node =
|
||||
case node of
|
||||
NodeEntry record ->
|
||||
let
|
||||
childEntries =
|
||||
descendInQuery maxDescendantDepth selector record.children
|
||||
in
|
||||
if predicateFromSelector selector node then
|
||||
node :: childEntries
|
||||
|
||||
else
|
||||
childEntries
|
||||
|
||||
TextTag { text } ->
|
||||
case selector of
|
||||
ContainsText innerText ->
|
||||
if String.contains innerText text then
|
||||
[ node ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
MarkdownNode { facts, model } ->
|
||||
if predicateFromSelector selector node then
|
||||
[ node ]
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
|
||||
descendInQuery : Maybe Int -> Selector -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
descendInQuery maxDescendantDepth selector children =
|
||||
case maxDescendantDepth of
|
||||
Nothing ->
|
||||
-- No maximum, so continue.
|
||||
List.concatMap
|
||||
(queryInNodeHelp Nothing selector)
|
||||
children
|
||||
|
||||
Just depth ->
|
||||
if depth > 0 then
|
||||
-- Continue with maximum depth reduced by 1.
|
||||
List.concatMap
|
||||
(queryInNodeHelp (Just (depth - 1)) selector)
|
||||
children
|
||||
|
||||
else
|
||||
[]
|
||||
|
||||
|
||||
predicateFromSelector : Selector -> ElmHtml msg -> Bool
|
||||
predicateFromSelector selector html =
|
||||
case html of
|
||||
NodeEntry record ->
|
||||
record
|
||||
|> nodeRecordPredicate selector
|
||||
|
||||
MarkdownNode markdownModel ->
|
||||
markdownModel
|
||||
|> markdownPredicate selector
|
||||
|
||||
_ ->
|
||||
False
|
||||
|
||||
|
||||
hasAllSelectors : List Selector -> ElmHtml msg -> Bool
|
||||
hasAllSelectors selectors record =
|
||||
List.map predicateFromSelector selectors
|
||||
|> List.map (\selector -> selector record)
|
||||
|> List.all identity
|
||||
|
||||
|
||||
hasAttribute : String -> String -> Facts msg -> Bool
|
||||
hasAttribute attribute queryString facts =
|
||||
case Dict.get attribute facts.stringAttributes of
|
||||
Just id ->
|
||||
id == queryString
|
||||
|
||||
Nothing ->
|
||||
False
|
||||
|
||||
|
||||
hasBoolAttribute : String -> Bool -> Facts msg -> Bool
|
||||
hasBoolAttribute attribute value facts =
|
||||
case Dict.get attribute facts.boolAttributes of
|
||||
Just id ->
|
||||
id == value
|
||||
|
||||
Nothing ->
|
||||
False
|
||||
|
||||
|
||||
hasClass : String -> Facts msg -> Bool
|
||||
hasClass queryString facts =
|
||||
List.member queryString (classnames facts)
|
||||
|
||||
|
||||
hasClasses : List String -> Facts msg -> Bool
|
||||
hasClasses classList facts =
|
||||
containsAll classList (classnames facts)
|
||||
|
||||
|
||||
hasStyle : { key : String, value : String } -> Facts msg -> Bool
|
||||
hasStyle style facts =
|
||||
Dict.get style.key facts.styles == Just style.value
|
||||
|
||||
|
||||
classnames : Facts msg -> List String
|
||||
classnames facts =
|
||||
Dict.get "className" facts.stringAttributes
|
||||
|> Maybe.withDefault ""
|
||||
|> String.split " "
|
||||
|
||||
|
||||
containsAll : List a -> List a -> Bool
|
||||
containsAll a b =
|
||||
b
|
||||
|> List.foldl (\i acc -> List.filter ((/=) i) acc) a
|
||||
|> List.isEmpty
|
||||
|
||||
|
||||
nodeRecordPredicate : Selector -> (NodeRecord msg -> Bool)
|
||||
nodeRecordPredicate selector =
|
||||
case selector of
|
||||
Id id ->
|
||||
.facts
|
||||
>> hasAttribute "id" id
|
||||
|
||||
ClassName classname ->
|
||||
.facts
|
||||
>> hasClass classname
|
||||
|
||||
ClassList classList ->
|
||||
.facts
|
||||
>> hasClasses classList
|
||||
|
||||
Tag tag ->
|
||||
.tag
|
||||
>> (==) tag
|
||||
|
||||
Attribute key value ->
|
||||
.facts
|
||||
>> hasAttribute key value
|
||||
|
||||
BoolAttribute key value ->
|
||||
.facts
|
||||
>> hasBoolAttribute key value
|
||||
|
||||
Style style ->
|
||||
.facts
|
||||
>> hasStyle style
|
||||
|
||||
ContainsText text ->
|
||||
always False
|
||||
|
||||
Multiple selectors ->
|
||||
NodeEntry
|
||||
>> hasAllSelectors selectors
|
||||
|
||||
|
||||
markdownPredicate : Selector -> (MarkdownNodeRecord msg -> Bool)
|
||||
markdownPredicate selector =
|
||||
case selector of
|
||||
Id id ->
|
||||
.facts
|
||||
>> hasAttribute "id" id
|
||||
|
||||
ClassName classname ->
|
||||
.facts
|
||||
>> hasClass classname
|
||||
|
||||
ClassList classList ->
|
||||
.facts
|
||||
>> hasClasses classList
|
||||
|
||||
Tag tag ->
|
||||
always False
|
||||
|
||||
Attribute key value ->
|
||||
.facts
|
||||
>> hasAttribute key value
|
||||
|
||||
BoolAttribute key value ->
|
||||
.facts
|
||||
>> hasBoolAttribute key value
|
||||
|
||||
Style style ->
|
||||
.facts
|
||||
>> hasStyle style
|
||||
|
||||
ContainsText text ->
|
||||
.model
|
||||
>> .markdown
|
||||
>> String.contains text
|
||||
|
||||
Multiple selectors ->
|
||||
MarkdownNode
|
||||
>> hasAllSelectors selectors
|
||||
161
src/Test/Html/Internal/ElmHtml/ToString.elm
Normal file
161
src/Test/Html/Internal/ElmHtml/ToString.elm
Normal file
@ -0,0 +1,161 @@
|
||||
module Test.Html.Internal.ElmHtml.ToString exposing
|
||||
( nodeRecordToString, nodeToString, nodeToStringWithOptions
|
||||
, FormatOptions, defaultFormatOptions
|
||||
)
|
||||
|
||||
{-| Convert ElmHtml to string.
|
||||
|
||||
@docs nodeRecordToString, nodeToString, nodeToStringWithOptions
|
||||
|
||||
@docs FormatOptions, defaultFormatOptions
|
||||
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import String
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes exposing (..)
|
||||
|
||||
|
||||
{-| 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 } ->
|
||||
[ 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
|
||||
-}
|
||||
nodeToString : ElmHtml msg -> String
|
||||
nodeToString =
|
||||
nodeToStringWithOptions defaultFormatOptions
|
||||
|
||||
|
||||
{-| same as nodeToString, but with options
|
||||
-}
|
||||
nodeToStringWithOptions : FormatOptions -> ElmHtml msg -> String
|
||||
nodeToStringWithOptions 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
|
||||
"<" ++ tag ++ filling ++ ">"
|
||||
|
||||
closeTag =
|
||||
"</" ++ tag ++ ">"
|
||||
|
||||
childrenStrings =
|
||||
List.map (nodeToLines options) children
|
||||
|> List.concat
|
||||
|> List.map ((++) (String.repeat options.indent " "))
|
||||
|
||||
styles =
|
||||
case Dict.toList facts.styles of
|
||||
[] ->
|
||||
Nothing
|
||||
|
||||
styleValues ->
|
||||
styleValues
|
||||
|> List.map (\( key, value ) -> key ++ ":" ++ value ++ ";")
|
||||
|> String.join ""
|
||||
|> (\styleString -> "style=\"" ++ styleString ++ "\"")
|
||||
|> Just
|
||||
|
||||
classes =
|
||||
Dict.get "className" facts.stringAttributes
|
||||
|> Maybe.map (\name -> "class=\"" ++ name ++ "\"")
|
||||
|
||||
stringAttributes =
|
||||
Dict.filter (\k v -> k /= "className") facts.stringAttributes
|
||||
|> Dict.toList
|
||||
|> List.map (\( k, v ) -> k ++ "=\"" ++ v ++ "\"")
|
||||
|> String.join " "
|
||||
|> Just
|
||||
|
||||
boolToString b =
|
||||
case b of
|
||||
True ->
|
||||
"True"
|
||||
|
||||
False ->
|
||||
"False"
|
||||
|
||||
boolAttributes =
|
||||
Dict.toList facts.boolAttributes
|
||||
|> List.map (\( k, v ) -> k ++ "=" ++ (String.toLower <| boolToString v))
|
||||
|> String.join " "
|
||||
|> Just
|
||||
in
|
||||
case toElementKind tag of
|
||||
{- Void elements only have a start tag; end tags must not be
|
||||
specified for void elements.
|
||||
-}
|
||||
VoidElements ->
|
||||
[ openTag [ classes, styles, stringAttributes, boolAttributes ] ]
|
||||
|
||||
{- TODO: implement restrictions for RawTextElements,
|
||||
EscapableRawTextElements. Also handle ForeignElements correctly.
|
||||
For now just punt and use the previous behavior for all other
|
||||
element kinds.
|
||||
-}
|
||||
_ ->
|
||||
[ openTag [ classes, styles, stringAttributes, boolAttributes ] ]
|
||||
++ childrenStrings
|
||||
++ [ closeTag ]
|
||||
121
src/Test/Html/Internal/Inert.elm
Normal file
121
src/Test/Html/Internal/Inert.elm
Normal file
@ -0,0 +1,121 @@
|
||||
module Test.Html.Internal.Inert exposing (Node, fromElmHtml, fromHtml, parseAttribute, toElmHtml)
|
||||
|
||||
{-| Inert Html - that is, can't do anything with events.
|
||||
|
||||
@docs Node, fromElmHtml, fromHtml, parseAttribute, toElmHtml
|
||||
|
||||
-}
|
||||
|
||||
import Elm.Kernel.HtmlAsJson
|
||||
import Html exposing (Html)
|
||||
import Json.Decode
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes exposing (ElmHtml(..), EventHandler, Facts, Tagger, decodeAttribute, decodeElmHtml)
|
||||
import VirtualDom
|
||||
|
||||
|
||||
type Node msg
|
||||
= Node (ElmHtml msg)
|
||||
|
||||
|
||||
fromHtml : Html msg -> Result String (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)
|
||||
|
||||
|
||||
fromElmHtml : ElmHtml msg -> Node msg
|
||||
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
|
||||
|
||||
|
||||
impossibleMessage : String
|
||||
impossibleMessage =
|
||||
"An Inert Node fired an event handler. This should never happen! Please report this bug."
|
||||
|
||||
|
||||
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
|
||||
)
|
||||
498
src/Test/Html/Query.elm
Normal file
498
src/Test/Html/Query.elm
Normal file
@ -0,0 +1,498 @@
|
||||
module Test.Html.Query exposing
|
||||
( Single, Multiple, fromHtml
|
||||
, find, findAll, children, first, index, keep
|
||||
, count, contains, has, hasNot, each
|
||||
)
|
||||
|
||||
{-| Querying HTML structure.
|
||||
|
||||
@docs Single, Multiple, fromHtml
|
||||
|
||||
|
||||
## Querying
|
||||
|
||||
@docs find, findAll, children, first, index, keep
|
||||
|
||||
|
||||
## Expecting
|
||||
|
||||
@docs count, contains, has, hasNot, each
|
||||
|
||||
-}
|
||||
|
||||
import Expect exposing (Expectation)
|
||||
import Html exposing (Html)
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes exposing (ElmHtml)
|
||||
import Test.Html.Internal.Inert as Inert
|
||||
import Test.Html.Query.Internal as Internal exposing (QueryError(..), failWithQuery)
|
||||
import Test.Html.Selector.Internal as Selector exposing (Selector, selectorToString)
|
||||
|
||||
|
||||
|
||||
{- DESIGN NOTES:
|
||||
|
||||
The reason for having `Query.index` and `Query.first` instead of doing them as
|
||||
selectors (which would let you do e.g. `Query.find [ first ]` to get the
|
||||
first child, instead of `Query.children [] |> Query.first` like you have to
|
||||
do now) is that it's not immediately obvious what a query like this would do:
|
||||
|
||||
Query.findAll [ first, tag "li" ]
|
||||
|
||||
Is that getting the first descendant, and then checking whether it's an <li>?
|
||||
Or is it finding the first <li> descendant? (Yes.) Also this is a findAll
|
||||
but it's only ever returning a single result despite being typed as a Multiple.
|
||||
|
||||
Arguably `id` could be treated the same way - since you *should* only have
|
||||
one id, *should* only ever return one result. However, in that case, it's
|
||||
possible that you have multiple IDs - and in that case you actually want the
|
||||
test to fail so you find out about the mistake!
|
||||
-}
|
||||
|
||||
|
||||
{-| A query that expects to find exactly one element.
|
||||
|
||||
Contrast with [`Multiple`](#Multiple).
|
||||
|
||||
-}
|
||||
type alias Single msg =
|
||||
Internal.Single msg
|
||||
|
||||
|
||||
{-| A query that may find any number of elements, including zero.
|
||||
|
||||
Contrast with [`Single`](#Single).
|
||||
|
||||
-}
|
||||
type alias Multiple msg =
|
||||
Internal.Multiple msg
|
||||
|
||||
|
||||
{-| Translate a `Html` value into a `Single` query. This is how queries
|
||||
typically begin.
|
||||
|
||||
import Html
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (text)
|
||||
|
||||
|
||||
test "Button has the expected text" <|
|
||||
\() ->
|
||||
Html.button [] [ Html.text "I'm a button!" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ text "I'm a button!" ]
|
||||
|
||||
-}
|
||||
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
|
||||
|
||||
|
||||
|
||||
-- TRAVERSAL --
|
||||
|
||||
|
||||
{-| Find the descendant elements which match all the given selectors.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag)
|
||||
import Expect
|
||||
|
||||
|
||||
test "The list has three items" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.count (Expect.equal 3)
|
||||
|
||||
-}
|
||||
findAll : List Selector -> Single msg -> Multiple msg
|
||||
findAll selectors (Internal.Single showTrace query) =
|
||||
Internal.FindAll selectors
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Multiple showTrace
|
||||
|
||||
|
||||
{-| Find the descendant elements of the result of `findAll` which match all the given selectors.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag)
|
||||
import Expect
|
||||
|
||||
|
||||
test "The list has three items" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ a [] [ text "first item" ]]
|
||||
, li [] [ a [] [ text "second item" ]]
|
||||
, li [] [ a [] [ text "third item" ]]
|
||||
, li [] [ button [] [ text "button" ]]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.keep ( tag "a" )
|
||||
|> Expect.all
|
||||
[ Query.each (Query.has [ tag "a" ])
|
||||
, Query.first >> Query.has [ text "first item" ]
|
||||
]
|
||||
|
||||
-}
|
||||
keep : Selector -> Multiple msg -> Multiple msg
|
||||
keep selector (Internal.Multiple showTrace query) =
|
||||
Internal.FindAll [ selector ]
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Multiple showTrace
|
||||
|
||||
|
||||
{-| Return the matched element's immediate child elements.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The <ul> only has <li> children" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [ class "item"] [ text "first item" ]
|
||||
, li [ class "item selected"] [ text "second item" ]
|
||||
, li [ class "item"] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ class "items" ]
|
||||
|> Query.children [ class "selected" ]
|
||||
|> Query.count (Expect.equal 1)
|
||||
|
||||
-}
|
||||
children : List Selector -> Single msg -> Multiple msg
|
||||
children selectors (Internal.Single showTrace query) =
|
||||
Internal.Children selectors
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Multiple showTrace
|
||||
|
||||
|
||||
{-| Find exactly one descendant element which matches all the given selectors.
|
||||
If no descendants match, or if more than one matches, the test will fail.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The list has both the classes 'items' and 'active'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "ul" ]
|
||||
|> Query.has [ classes [ "items", "active" ] ]
|
||||
|
||||
-}
|
||||
find : List Selector -> Single msg -> Single msg
|
||||
find selectors (Internal.Single showTrace query) =
|
||||
Internal.Find selectors
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Single showTrace
|
||||
|
||||
|
||||
{-| Return the first element in a match. If there were no matches, the test
|
||||
will fail.
|
||||
|
||||
`Query.first` is a shorthand for `Query.index 0` - they do the same thing.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The first <li> is called 'first item'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.first
|
||||
|> Query.has [ text "first item" ]
|
||||
|
||||
-}
|
||||
first : Multiple msg -> Single msg
|
||||
first (Internal.Multiple showTrace query) =
|
||||
Internal.First
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Single showTrace
|
||||
|
||||
|
||||
{-| Return the element in a match at the given index. For example,
|
||||
`Query.index 0` would match the first element, and `Query.index 1` would match
|
||||
the second element.
|
||||
|
||||
You can pass negative numbers to get elements from the end - for example, `Query.index -1`
|
||||
will match the last element, and `Query.index -2` will match the second-to-last.
|
||||
|
||||
If the index falls outside the bounds of the match, the test will fail.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The second <li> is called 'second item'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.index 1
|
||||
|> Query.has [ text "second item" ]
|
||||
|
||||
-}
|
||||
index : Int -> Multiple msg -> Single msg
|
||||
index position (Internal.Multiple showTrace query) =
|
||||
Internal.Index position
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Single showTrace
|
||||
|
||||
|
||||
|
||||
-- EXPECTATIONS --
|
||||
|
||||
|
||||
{-| Expect the number of elements matching the query fits the given expectation.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag)
|
||||
import Expect
|
||||
|
||||
|
||||
test "The list has three items" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.count (Expect.equal 3)
|
||||
|
||||
-}
|
||||
count : (Int -> Expectation) -> Multiple msg -> Expectation
|
||||
count expect ((Internal.Multiple showTrace query) as multiple) =
|
||||
(List.length >> expect >> failWithQuery showTrace "Query.count" query)
|
||||
|> Internal.multipleToExpectation multiple
|
||||
|
||||
|
||||
{-| Expect the element to have at least one descendant matching each node in the list.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The list has two li: one with the text \"third item\" and \
|
||||
another one with \"first item\"" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.contains
|
||||
[ li [] [ text "third item" ]
|
||||
, li [] [ text "first item" ]
|
||||
]
|
||||
|
||||
-}
|
||||
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 <https://github.com/elm-explorations/test/issues>." ]
|
||||
, 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
|
||||
|
||||
|
||||
{-| Expect the element to match all of the given selectors.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The list has both the classes 'items' and 'active'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "ul" ]
|
||||
|> Query.has [ tag "ul", classes [ "items", "active" ] ]
|
||||
|
||||
-}
|
||||
has : List Selector -> Single msg -> Expectation
|
||||
has selectors (Internal.Single showTrace query) =
|
||||
Internal.has selectors query
|
||||
|> failWithQuery showTrace ("Query.has " ++ Internal.joinAsList selectorToString selectors) query
|
||||
|
||||
|
||||
{-| Expect the element to **not** match all of the given selectors.
|
||||
|
||||
import Html exposing (div)
|
||||
import Html.Attributes as Attributes
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, class)
|
||||
|
||||
|
||||
test "The div element has no progress-bar class" <|
|
||||
\() ->
|
||||
div [ Attributes.class "button" ] []
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "div" ]
|
||||
|> Query.hasNot [ tag "div", class "progress-bar" ]
|
||||
|
||||
-}
|
||||
hasNot : List Selector -> Single msg -> Expectation
|
||||
hasNot selectors (Internal.Single showTrace query) =
|
||||
let
|
||||
queryName =
|
||||
"Query.hasNot " ++ Internal.joinAsList selectorToString selectors
|
||||
in
|
||||
Internal.hasNot selectors query
|
||||
|> failWithQuery showTrace queryName query
|
||||
|
||||
|
||||
{-| Expect that a [`Single`](#Single) expectation will hold true for each of the
|
||||
[`Multiple`](#Multiple) matched elements.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The list has both the classes 'items' and 'active'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "ul" ]
|
||||
|> Query.each
|
||||
(Expect.all
|
||||
[ Query.has [ tag "ul" ]
|
||||
, Query.has [ classes [ "items", "active" ] ]
|
||||
]
|
||||
)
|
||||
|
||||
-}
|
||||
each : (Single msg -> Expectation) -> Multiple msg -> Expectation
|
||||
each check (Internal.Multiple showTrace query) =
|
||||
Internal.expectAll check query
|
||||
|> failWithQuery showTrace "Query.each" query
|
||||
606
src/Test/Html/Query/Internal.elm
Normal file
606
src/Test/Html/Query/Internal.elm
Normal file
@ -0,0 +1,606 @@
|
||||
module Test.Html.Query.Internal exposing (Multiple(..), Query(..), QueryError(..), SelectorQuery(..), Single(..), addQueryFromHtmlLine, baseIndentation, contains, expectAll, expectAllHelp, failWithQuery, getChildren, getElementAt, getElementAtHelp, getHtmlContext, has, hasNot, isElement, joinAsList, missingDescendants, multipleToExpectation, prefixOutputLine, prependSelector, prettyPrint, printIndented, queryErrorToString, showSelectorOutcome, showSelectorOutcomeInverse, toLines, toLinesHelp, toOutputLine, traverse, traverseSelector, traverseSelectors, verifySingle, withHtmlContext)
|
||||
|
||||
import Expect exposing (Expectation)
|
||||
import Test.Html.Descendant as Descendant
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes exposing (ElmHtml(..))
|
||||
import Test.Html.Internal.ElmHtml.ToString exposing (nodeToStringWithOptions)
|
||||
import Test.Html.Internal.Inert as Inert exposing (Node)
|
||||
import Test.Html.Selector.Internal as InternalSelector exposing (Selector, selectorToString)
|
||||
import Test.Runner
|
||||
|
||||
|
||||
{-| Note: the selectors are stored in reverse order for better prepending perf.
|
||||
-}
|
||||
type Query msg
|
||||
= Query (Inert.Node msg) (List SelectorQuery)
|
||||
| InternalError String
|
||||
|
||||
|
||||
type SelectorQuery
|
||||
= Find (List Selector)
|
||||
| FindAll (List Selector)
|
||||
| Children (List Selector)
|
||||
-- First and Index are separate so we can report Query.first in error messages
|
||||
| First
|
||||
| Index Int
|
||||
|
||||
|
||||
{-| The Bool is `showTrace` - whether to show the Query.fromHtml trace at
|
||||
the beginning of the error message.
|
||||
|
||||
We need to track this so that Query.each can turn it off. Otherwise you get
|
||||
fromHtml printed twice - once at the very top, then again for the nested
|
||||
expectation that Query.each delegated to.
|
||||
|
||||
-}
|
||||
type Single msg
|
||||
= Single Bool (Query msg)
|
||||
|
||||
|
||||
{-| The Bool is `showTrace` - see `Single` for more info.
|
||||
-}
|
||||
type Multiple msg
|
||||
= Multiple Bool (Query 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 <https://github.com/elm-explorations/test/issues>"
|
||||
, message
|
||||
]
|
||||
|
||||
|
||||
prettyPrint : ElmHtml msg -> String
|
||||
prettyPrint =
|
||||
nodeToStringWithOptions { indent = 4, newLines = True }
|
||||
|
||||
|
||||
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 <https://github.com/elm-explorations/test/issues>. "
|
||||
++ message
|
||||
|
||||
|
||||
toLinesHelp : String -> List (ElmHtml msg) -> List SelectorQuery -> String -> List String -> List String
|
||||
toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results =
|
||||
let
|
||||
bailOut result =
|
||||
-- Bail out early so the last error message the user
|
||||
-- sees is Query.find rather than something like
|
||||
-- Query.has, to reflect how we didn't make it that far.
|
||||
String.join "\n\n\n✗ " [ result, expectationFailure ] :: results
|
||||
|
||||
recurse newElmHtmlList rest result =
|
||||
toLinesHelp
|
||||
expectationFailure
|
||||
newElmHtmlList
|
||||
rest
|
||||
queryName
|
||||
(result :: results)
|
||||
in
|
||||
case selectorQueries of
|
||||
[] ->
|
||||
String.join "\n\n" [ queryName, expectationFailure ] :: results
|
||||
|
||||
selectorQuery :: rest ->
|
||||
case selectorQuery of
|
||||
FindAll selectors ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAll selectors
|
||||
in
|
||||
("Query.findAll " ++ joinAsList selectorToString selectors)
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
|> recurse elements rest
|
||||
|
||||
Find selectors ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAll selectors
|
||||
|
||||
result =
|
||||
("Query.find " ++ joinAsList selectorToString selectors)
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
in
|
||||
if List.length elements == 1 then
|
||||
recurse elements rest result
|
||||
|
||||
else
|
||||
bailOut result
|
||||
|
||||
Children selectors ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAllChildren selectors
|
||||
in
|
||||
("Query.children " ++ joinAsList selectorToString selectors)
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
|> recurse elements rest
|
||||
|
||||
First ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> List.head
|
||||
|> Maybe.map (\elem -> [ elem ])
|
||||
|> Maybe.withDefault []
|
||||
|
||||
result =
|
||||
"Query.first"
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
in
|
||||
if List.length elements == 1 then
|
||||
recurse elements rest result
|
||||
|
||||
else
|
||||
bailOut result
|
||||
|
||||
Index index ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> getElementAt index
|
||||
|
||||
result =
|
||||
("Query.index " ++ String.fromInt index)
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
in
|
||||
if List.length elements == 1 then
|
||||
recurse elements rest result
|
||||
|
||||
else
|
||||
bailOut result
|
||||
|
||||
|
||||
withHtmlContext : String -> String -> String
|
||||
withHtmlContext htmlStr str =
|
||||
String.join "\n\n" [ str, htmlStr ]
|
||||
|
||||
|
||||
getHtmlContext : List (ElmHtml msg) -> String
|
||||
getHtmlContext elmHtmlList =
|
||||
if List.isEmpty elmHtmlList then
|
||||
"0 matches found for this query."
|
||||
|
||||
else
|
||||
let
|
||||
maxDigits =
|
||||
elmHtmlList
|
||||
|> List.length
|
||||
|> String.fromInt
|
||||
|> String.length
|
||||
in
|
||||
elmHtmlList
|
||||
|> List.indexedMap (printIndented maxDigits)
|
||||
|> String.join "\n\n"
|
||||
|
||||
|
||||
joinAsList : (a -> String) -> List a -> String
|
||||
joinAsList toStr list =
|
||||
if List.isEmpty list then
|
||||
"[]"
|
||||
|
||||
else
|
||||
"[ " ++ String.join ", " (List.map toStr list) ++ " ]"
|
||||
|
||||
|
||||
printIndented : Int -> Int -> ElmHtml msg -> String
|
||||
printIndented maxDigits index elmHtml =
|
||||
let
|
||||
caption =
|
||||
(String.fromInt (index + 1) ++ ")")
|
||||
|> String.padRight (maxDigits + 3) ' '
|
||||
|> String.append baseIndentation
|
||||
|
||||
indentation =
|
||||
String.repeat (String.length caption) " "
|
||||
in
|
||||
case String.split "\n" (prettyPrint elmHtml) of
|
||||
[] ->
|
||||
""
|
||||
|
||||
first :: rest ->
|
||||
rest
|
||||
|> List.map (String.append indentation)
|
||||
|> (::) (caption ++ first)
|
||||
|> String.join "\n"
|
||||
|
||||
|
||||
baseIndentation : String
|
||||
baseIndentation =
|
||||
" "
|
||||
|
||||
|
||||
prependSelector : Query msg -> SelectorQuery -> Query msg
|
||||
prependSelector query selector =
|
||||
case query of
|
||||
Query node selectors ->
|
||||
Query node (selector :: selectors)
|
||||
|
||||
InternalError message ->
|
||||
InternalError message
|
||||
|
||||
|
||||
{-| This is a more efficient implementation of the following:
|
||||
|
||||
list
|
||||
|> Array.fromList
|
||||
|> Array.get index
|
||||
|> Maybe.map (\elem -> [ elem ])
|
||||
|> Maybe.withDefault []
|
||||
|
||||
It also supports negative indeces, e.g. passing -1 for an index
|
||||
gets you the last element.
|
||||
|
||||
-}
|
||||
getElementAt : Int -> List a -> List a
|
||||
getElementAt index list =
|
||||
let
|
||||
length =
|
||||
List.length list
|
||||
in
|
||||
if
|
||||
-- Avoid attempting % 0
|
||||
(length == 0)
|
||||
-- don't wrap around if index is too high
|
||||
|| (index >= length)
|
||||
-- don't wrap around if index is too low
|
||||
|| (index < 0 && abs index > length)
|
||||
then
|
||||
[]
|
||||
|
||||
else
|
||||
-- Support wraparound, e.g. passing -1 to get the last element.
|
||||
getElementAtHelp (modBy length index) list
|
||||
|
||||
|
||||
getElementAtHelp : Int -> List a -> List a
|
||||
getElementAtHelp index list =
|
||||
case list of
|
||||
[] ->
|
||||
[]
|
||||
|
||||
first :: rest ->
|
||||
if index == 0 then
|
||||
[ first ]
|
||||
|
||||
else
|
||||
getElementAtHelp (index - 1) rest
|
||||
|
||||
|
||||
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)
|
||||
|
||||
|
||||
traverseSelectors : List SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg))
|
||||
traverseSelectors selectorQueries elmHtmlList =
|
||||
List.foldr
|
||||
(traverseSelector >> Result.andThen)
|
||||
(Ok elmHtmlList)
|
||||
selectorQueries
|
||||
|
||||
|
||||
traverseSelector : SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg))
|
||||
traverseSelector selectorQuery elmHtmlList =
|
||||
case selectorQuery of
|
||||
Find selectors ->
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAll selectors
|
||||
|> verifySingle "Query.find"
|
||||
|> Result.map (\elem -> [ elem ])
|
||||
|
||||
FindAll selectors ->
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAll selectors
|
||||
|> Ok
|
||||
|
||||
Children selectors ->
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAllChildren selectors
|
||||
|> Ok
|
||||
|
||||
First ->
|
||||
elmHtmlList
|
||||
|> List.head
|
||||
|> Maybe.map (\elem -> Ok [ elem ])
|
||||
|> Maybe.withDefault (Err (NoResultsForSingle "Query.first"))
|
||||
|
||||
Index index ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> getElementAt index
|
||||
in
|
||||
if List.length elements == 1 then
|
||||
Ok elements
|
||||
|
||||
else
|
||||
Err (NoResultsForSingle ("Query.index " ++ String.fromInt index))
|
||||
|
||||
|
||||
getChildren : ElmHtml msg -> List (ElmHtml msg)
|
||||
getChildren elmHtml =
|
||||
case elmHtml of
|
||||
NodeEntry { children } ->
|
||||
children
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
|
||||
isElement : ElmHtml msg -> Bool
|
||||
isElement elmHtml =
|
||||
case elmHtml of
|
||||
NodeEntry _ ->
|
||||
True
|
||||
|
||||
_ ->
|
||||
False
|
||||
|
||||
|
||||
verifySingle : String -> List a -> Result QueryError a
|
||||
verifySingle queryName list =
|
||||
case list of
|
||||
[] ->
|
||||
Err (NoResultsForSingle queryName)
|
||||
|
||||
singleton :: [] ->
|
||||
Ok singleton
|
||||
|
||||
multiples ->
|
||||
Err (MultipleResultsForSingle queryName (List.length multiples))
|
||||
|
||||
|
||||
expectAll : (Single msg -> Expectation) -> Query msg -> Expectation
|
||||
expectAll check query =
|
||||
case traverse query of
|
||||
Ok list ->
|
||||
expectAllHelp 0 check list
|
||||
|
||||
Err error ->
|
||||
Expect.fail (queryErrorToString query error)
|
||||
|
||||
|
||||
expectAllHelp : Int -> (Single msg -> Expectation) -> List (ElmHtml msg) -> Expectation
|
||||
expectAllHelp successes check list =
|
||||
case list of
|
||||
[] ->
|
||||
Expect.pass
|
||||
|
||||
elmHtml :: rest ->
|
||||
let
|
||||
expectation =
|
||||
Query (Inert.fromElmHtml elmHtml) []
|
||||
|> Single False
|
||||
|> check
|
||||
in
|
||||
case Test.Runner.getFailureReason expectation of
|
||||
Just { given, description } ->
|
||||
let
|
||||
prefix =
|
||||
if successes > 0 then
|
||||
"Element #" ++ String.fromInt (successes + 1) ++ " failed this test:"
|
||||
|
||||
else
|
||||
"The first element failed this test:"
|
||||
in
|
||||
[ prefix, description ]
|
||||
|> String.join "\n\n"
|
||||
|> Expect.fail
|
||||
|
||||
Nothing ->
|
||||
expectAllHelp (successes + 1) check rest
|
||||
|
||||
|
||||
multipleToExpectation : Multiple msg -> (List (ElmHtml msg) -> Expectation) -> Expectation
|
||||
multipleToExpectation (Multiple _ query) check =
|
||||
case traverse query of
|
||||
Ok list ->
|
||||
check list
|
||||
|
||||
Err error ->
|
||||
Expect.fail (queryErrorToString query error)
|
||||
|
||||
|
||||
queryErrorToString : Query msg -> QueryError -> String
|
||||
queryErrorToString query error =
|
||||
case error of
|
||||
NoResultsForSingle queryName ->
|
||||
queryName ++ " always expects to find 1 element, but it found 0 instead."
|
||||
|
||||
MultipleResultsForSingle queryName resultCount ->
|
||||
queryName
|
||||
++ " always expects to find 1 element, but it found "
|
||||
++ String.fromInt resultCount
|
||||
++ " instead.\n\n\nHINT: If you actually expected "
|
||||
++ 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 <https://github.com/elm-explorations/test/issues>. "
|
||||
++ message
|
||||
|
||||
|
||||
contains : List (ElmHtml msg) -> Query msg -> Expectation
|
||||
contains expectedDescendants query =
|
||||
case traverse query of
|
||||
Ok elmHtmlList ->
|
||||
let
|
||||
missing =
|
||||
missingDescendants elmHtmlList expectedDescendants
|
||||
|
||||
prettyPrintSections missingDescendantsList =
|
||||
String.join
|
||||
"\n\n---------------------------------------------\n\n"
|
||||
(List.indexedMap
|
||||
(\index descendant -> printIndented 3 index descendant)
|
||||
missingDescendantsList
|
||||
)
|
||||
in
|
||||
if List.isEmpty missing then
|
||||
Expect.pass
|
||||
|
||||
else
|
||||
Expect.fail
|
||||
(String.join ""
|
||||
[ "\t✗ /"
|
||||
, String.fromInt <| List.length missing
|
||||
, "\\ missing descendants: \n\n"
|
||||
, prettyPrintSections missing
|
||||
]
|
||||
)
|
||||
|
||||
Err error ->
|
||||
Expect.fail (queryErrorToString query error)
|
||||
|
||||
|
||||
missingDescendants : List (ElmHtml msg) -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
missingDescendants elmHtmlList expected =
|
||||
let
|
||||
isMissing =
|
||||
\expectedDescendant ->
|
||||
not <| Descendant.isDescendant elmHtmlList expectedDescendant
|
||||
in
|
||||
List.filter isMissing expected
|
||||
|
||||
|
||||
has : List Selector -> Query msg -> Expectation
|
||||
has selectors query =
|
||||
case traverse query of
|
||||
Ok elmHtmlList ->
|
||||
if InternalSelector.hasAll selectors elmHtmlList then
|
||||
Expect.pass
|
||||
|
||||
else
|
||||
selectors
|
||||
|> List.map (showSelectorOutcome elmHtmlList)
|
||||
|> String.join "\n"
|
||||
|> Expect.fail
|
||||
|
||||
Err error ->
|
||||
Expect.fail (queryErrorToString query error)
|
||||
|
||||
|
||||
hasNot : List Selector -> Query msg -> Expectation
|
||||
hasNot selectors query =
|
||||
case traverse query of
|
||||
Ok [] ->
|
||||
Expect.pass
|
||||
|
||||
Ok elmHtmlList ->
|
||||
case InternalSelector.queryAll selectors elmHtmlList of
|
||||
[] ->
|
||||
Expect.pass
|
||||
|
||||
_ ->
|
||||
selectors
|
||||
|> List.map (showSelectorOutcomeInverse elmHtmlList)
|
||||
|> String.join "\n"
|
||||
|> Expect.fail
|
||||
|
||||
Err error ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
showSelectorOutcome : List (ElmHtml msg) -> Selector -> String
|
||||
showSelectorOutcome elmHtmlList selector =
|
||||
let
|
||||
outcome =
|
||||
case InternalSelector.queryAll [ selector ] elmHtmlList of
|
||||
[] ->
|
||||
"✗"
|
||||
|
||||
_ ->
|
||||
"✓"
|
||||
in
|
||||
String.join " " [ outcome, "has", selectorToString selector ]
|
||||
|
||||
|
||||
showSelectorOutcomeInverse : List (ElmHtml msg) -> Selector -> String
|
||||
showSelectorOutcomeInverse elmHtmlList selector =
|
||||
let
|
||||
outcome =
|
||||
case InternalSelector.queryAll [ selector ] elmHtmlList of
|
||||
[] ->
|
||||
"✓"
|
||||
|
||||
_ ->
|
||||
"✗"
|
||||
in
|
||||
String.join " " [ outcome, "has not", selectorToString selector ]
|
||||
|
||||
|
||||
|
||||
-- HELPERS --
|
||||
|
||||
|
||||
failWithQuery : Bool -> String -> Query msg -> Expectation -> Expectation
|
||||
failWithQuery showTrace queryName query expectation =
|
||||
case Test.Runner.getFailureReason expectation of
|
||||
Just { given, description } ->
|
||||
let
|
||||
lines =
|
||||
toLines description query queryName
|
||||
|> List.map prefixOutputLine
|
||||
|
||||
tracedLines =
|
||||
if showTrace then
|
||||
addQueryFromHtmlLine query :: lines
|
||||
|
||||
else
|
||||
lines
|
||||
in
|
||||
tracedLines
|
||||
|> String.join "\n\n\n"
|
||||
|> Expect.fail
|
||||
|
||||
Nothing ->
|
||||
expectation
|
||||
|
||||
|
||||
addQueryFromHtmlLine : Query msg -> String
|
||||
addQueryFromHtmlLine query =
|
||||
String.join "\n\n"
|
||||
[ prefixOutputLine "Query.fromHtml"
|
||||
, toOutputLine query
|
||||
|> String.split "\n"
|
||||
|> List.map ((++) baseIndentation)
|
||||
|> String.join "\n"
|
||||
]
|
||||
|
||||
|
||||
prefixOutputLine : String -> String
|
||||
prefixOutputLine =
|
||||
(++) "▼ "
|
||||
331
src/Test/Html/Selector.elm
Normal file
331
src/Test/Html/Selector.elm
Normal file
@ -0,0 +1,331 @@
|
||||
module Test.Html.Selector exposing
|
||||
( Selector
|
||||
, tag, text, containing, attribute, all
|
||||
, id, class, classes, exactClassName, style, checked, selected, disabled
|
||||
)
|
||||
|
||||
{-| Selecting HTML elements.
|
||||
|
||||
@docs Selector
|
||||
|
||||
|
||||
## General Selectors
|
||||
|
||||
@docs tag, text, containing, attribute, all
|
||||
|
||||
|
||||
## Attributes
|
||||
|
||||
@docs id, class, classes, exactClassName, style, checked, selected, disabled
|
||||
|
||||
-}
|
||||
|
||||
import Html exposing (Attribute)
|
||||
import Json.Decode
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes
|
||||
import Test.Html.Internal.Inert as Inert
|
||||
import Test.Html.Selector.Internal as Internal exposing (..)
|
||||
|
||||
|
||||
{-| A selector used to filter sets of elements.
|
||||
-}
|
||||
type alias Selector =
|
||||
Internal.Selector
|
||||
|
||||
|
||||
{-| Combine the given selectors into one which requires all of them to match.
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (class, text, all, Selector)
|
||||
|
||||
|
||||
replyBtnSelector : Selector
|
||||
replyBtnSelector =
|
||||
all [ class "btn", text "Reply" ]
|
||||
|
||||
|
||||
test "Button has the class 'btn' and the text 'Reply'" <|
|
||||
\() ->
|
||||
Html.button [ Attr.class "btn btn-large" ] [ Html.text "Reply" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ replyBtnSelector ]
|
||||
|
||||
-}
|
||||
all : List Selector -> Selector
|
||||
all =
|
||||
All
|
||||
|
||||
|
||||
{-| Matches elements that have all the given classes (and possibly others as well).
|
||||
|
||||
When you only care about one class instead of several, you can use
|
||||
[`class`](#class) instead of passing this function a list with one value in it.
|
||||
|
||||
To match the element's exact class attribute string, use [`exactClassName`](#exactClassName).
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (classes)
|
||||
|
||||
|
||||
test "Button has the classes btn and btn-large" <|
|
||||
\() ->
|
||||
Html.button [ Attr.class "btn btn-large" ] [ Html.text "Reply" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ classes [ "btn", "btn-large" ] ]
|
||||
|
||||
-}
|
||||
classes : List String -> Selector
|
||||
classes =
|
||||
Classes
|
||||
|
||||
|
||||
{-| Matches elements that have the given class (and possibly others as well).
|
||||
|
||||
To match multiple classes at once, use [`classes`](#classes) instead.
|
||||
|
||||
To match the element's exact class attribute string, use [`exactClassName`](#exactClassName).
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (class)
|
||||
|
||||
|
||||
test "Button has the class btn-large" <|
|
||||
\() ->
|
||||
Html.button [ Attr.class "btn btn-large" ] [ Html.text "Reply" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ class "btn-large" ]
|
||||
|
||||
-}
|
||||
class : String -> Selector
|
||||
class =
|
||||
Class
|
||||
|
||||
|
||||
{-| Matches the element's exact class attribute string.
|
||||
|
||||
This is used less often than [`class`](#class), [`classes`](#classes) or
|
||||
[`attribute`](#attribute), which check for the _presence_ of a class as opposed
|
||||
to matching the entire class attribute exactly.
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (exactClassName)
|
||||
|
||||
|
||||
test "Button has the exact class 'btn btn-large'" <|
|
||||
\() ->
|
||||
Html.button [ Attr.class "btn btn-large" ] [ Html.text "Reply" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ exactClassName "btn btn-large" ]
|
||||
|
||||
-}
|
||||
exactClassName : String -> Selector
|
||||
exactClassName =
|
||||
namedAttr "className"
|
||||
|
||||
|
||||
{-| Matches elements that have the given `id` attribute.
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (id, text)
|
||||
|
||||
|
||||
test "the welcome <h1> says hello!" <|
|
||||
\() ->
|
||||
Html.div []
|
||||
[ Html.h1 [ Attr.id "welcome" ] [ Html.text "Hello!" ] ]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ id "welcome" ]
|
||||
|> Query.has [ text "Hello!" ]
|
||||
|
||||
-}
|
||||
id : String -> Selector
|
||||
id =
|
||||
namedAttr "id"
|
||||
|
||||
|
||||
{-| Matches elements that have the given tag.
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, text)
|
||||
|
||||
|
||||
test "the welcome <h1> says hello!" <|
|
||||
\() ->
|
||||
Html.div []
|
||||
[ Html.h1 [ Attr.id "welcome" ] [ Html.text "Hello!" ] ]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "h1" ]
|
||||
|> Query.has [ text "Hello!" ]
|
||||
|
||||
-}
|
||||
tag : String -> Selector
|
||||
tag name =
|
||||
Tag name
|
||||
|
||||
|
||||
{-| Matches elements that have the given attribute in a way that makes sense
|
||||
given their semantics in `Html`.
|
||||
-}
|
||||
attribute : Attribute Never -> Selector
|
||||
attribute attr =
|
||||
case Inert.parseAttribute attr of
|
||||
Ok (InternalTypes.Attribute { key, value }) ->
|
||||
if String.toLower key == "class" then
|
||||
value
|
||||
|> String.split " "
|
||||
|> Classes
|
||||
|
||||
else
|
||||
namedAttr key value
|
||||
|
||||
Ok (InternalTypes.Property { key, value }) ->
|
||||
if key == "className" then
|
||||
value
|
||||
|> Json.Decode.decodeValue Json.Decode.string
|
||||
|> Result.map (String.split " ")
|
||||
|> Result.withDefault []
|
||||
|> Classes
|
||||
|
||||
else
|
||||
value
|
||||
|> Json.Decode.decodeValue Json.Decode.string
|
||||
|> Result.map (namedAttr key)
|
||||
|> orElseLazy
|
||||
(\() ->
|
||||
value
|
||||
|> Json.Decode.decodeValue Json.Decode.bool
|
||||
|> Result.map (namedBoolAttr key)
|
||||
)
|
||||
|> Result.withDefault Invalid
|
||||
|
||||
Ok (InternalTypes.Style { key, value }) ->
|
||||
Style { key = key, value = value }
|
||||
|
||||
_ ->
|
||||
Invalid
|
||||
|
||||
|
||||
{-| Matches elements that have the given style properties (and possibly others as well).
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (classes)
|
||||
|
||||
|
||||
test "the Reply button has red text" <|
|
||||
\() ->
|
||||
Html.div []
|
||||
[ Html.button
|
||||
[ Attr.style "color" "red" ]
|
||||
[ Html.text "Reply" ]
|
||||
]
|
||||
|> Query.has [ style "color" "red" ]
|
||||
|
||||
-}
|
||||
style : String -> String -> Selector
|
||||
style key value =
|
||||
Style { key = key, value = value }
|
||||
|
||||
|
||||
{-| Matches elements that have a
|
||||
[`text`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#text)
|
||||
attribute with the given value.
|
||||
-}
|
||||
text : String -> Selector
|
||||
text =
|
||||
Internal.Text
|
||||
|
||||
|
||||
{-| Matches elements whose descendants match the given selectors.
|
||||
|
||||
(You will get the element and **not** the descendant.)
|
||||
|
||||
This is especially useful to find elements which contain specific
|
||||
text somewhere in their descendants.
|
||||
|
||||
import Html
|
||||
import Html.Events exposing (onClick)
|
||||
import Test exposing (test)
|
||||
import Test.Html.Event as Event
|
||||
import Test.Html.Query as Query
|
||||
import Test.Html.Selector exposing (containing, tag)
|
||||
|
||||
test : Test
|
||||
test =
|
||||
test "..." <|
|
||||
Html.div []
|
||||
[ Html.button [ onClick NopeMsg ] [ Html.text "not me" ]
|
||||
, Html.button [ onClick ClickedMsg ] [ Html.text "click me" ]
|
||||
]
|
||||
|> Query.find
|
||||
[ tag "button"
|
||||
, containing [ text "click me" ]
|
||||
]
|
||||
|> Event.simulate Event.click
|
||||
|> Event.expect ClickedMsg
|
||||
|
||||
-}
|
||||
containing : List Selector -> Selector
|
||||
containing =
|
||||
Internal.Containing
|
||||
|
||||
|
||||
{-| Matches elements that have a
|
||||
[`selected`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#selected)
|
||||
attribute with the given value.
|
||||
-}
|
||||
selected : Bool -> Selector
|
||||
selected =
|
||||
namedBoolAttr "selected"
|
||||
|
||||
|
||||
{-| Matches elements that have a
|
||||
[`disabled`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#disabled)
|
||||
attribute with the given value.
|
||||
-}
|
||||
disabled : Bool -> Selector
|
||||
disabled =
|
||||
namedBoolAttr "disabled"
|
||||
|
||||
|
||||
{-| Matches elements that have a
|
||||
[`checked`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#checked)
|
||||
attribute with the given value.
|
||||
-}
|
||||
checked : Bool -> Selector
|
||||
checked =
|
||||
namedBoolAttr "checked"
|
||||
|
||||
|
||||
|
||||
-- HELPERS
|
||||
|
||||
|
||||
orElseLazy : (() -> Result x a) -> Result x a -> Result x a
|
||||
orElseLazy fma mb =
|
||||
case mb of
|
||||
Err _ ->
|
||||
fma ()
|
||||
|
||||
Ok _ ->
|
||||
mb
|
||||
197
src/Test/Html/Selector/Internal.elm
Normal file
197
src/Test/Html/Selector/Internal.elm
Normal file
@ -0,0 +1,197 @@
|
||||
module Test.Html.Selector.Internal exposing (Selector(..), hasAll, namedAttr, namedBoolAttr, query, queryAll, queryAllChildren, selectorToString, styleToString)
|
||||
|
||||
import Test.Html.Internal.ElmHtml.InternalTypes exposing (ElmHtml)
|
||||
import Test.Html.Internal.ElmHtml.Query as ElmHtmlQuery
|
||||
|
||||
|
||||
type Selector
|
||||
= All (List Selector)
|
||||
| Classes (List String)
|
||||
| Class String
|
||||
| Attribute { name : String, value : String }
|
||||
| BoolAttribute { name : String, value : Bool }
|
||||
| Style { key : String, value : String }
|
||||
| Tag String
|
||||
| Text String
|
||||
| Containing (List Selector)
|
||||
| Invalid
|
||||
|
||||
|
||||
selectorToString : Selector -> String
|
||||
selectorToString criteria =
|
||||
let
|
||||
quoteString s =
|
||||
"\"" ++ s ++ "\""
|
||||
|
||||
boolToString b =
|
||||
case b of
|
||||
True ->
|
||||
"True"
|
||||
|
||||
False ->
|
||||
"False"
|
||||
in
|
||||
case criteria of
|
||||
All list ->
|
||||
list
|
||||
|> List.map selectorToString
|
||||
|> String.join " "
|
||||
|
||||
Classes list ->
|
||||
"classes " ++ quoteString (String.join " " list)
|
||||
|
||||
Class class ->
|
||||
"class " ++ quoteString class
|
||||
|
||||
Attribute { name, value } ->
|
||||
"attribute "
|
||||
++ quoteString name
|
||||
++ " "
|
||||
++ quoteString value
|
||||
|
||||
BoolAttribute { name, value } ->
|
||||
"attribute "
|
||||
++ quoteString name
|
||||
++ " "
|
||||
++ boolToString value
|
||||
|
||||
Style style ->
|
||||
"styles " ++ styleToString style
|
||||
|
||||
Tag name ->
|
||||
"tag " ++ quoteString name
|
||||
|
||||
Text text ->
|
||||
"text " ++ quoteString text
|
||||
|
||||
Containing list ->
|
||||
let
|
||||
selectors =
|
||||
list
|
||||
|> List.map selectorToString
|
||||
|> String.join ", "
|
||||
in
|
||||
"containing [ " ++ selectors ++ " ] "
|
||||
|
||||
Invalid ->
|
||||
"invalid"
|
||||
|
||||
|
||||
styleToString : { key : String, value : String } -> String
|
||||
styleToString { key, value } =
|
||||
key ++ ":" ++ value
|
||||
|
||||
|
||||
hasAll : List Selector -> List (ElmHtml msg) -> Bool
|
||||
hasAll selectors elems =
|
||||
case selectors of
|
||||
[] ->
|
||||
True
|
||||
|
||||
selector :: rest ->
|
||||
if List.isEmpty (queryAll [ selector ] elems) then
|
||||
False
|
||||
|
||||
else
|
||||
hasAll rest elems
|
||||
|
||||
|
||||
queryAll : List Selector -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
queryAll selectors list =
|
||||
case selectors of
|
||||
[] ->
|
||||
list
|
||||
|
||||
selector :: rest ->
|
||||
query ElmHtmlQuery.query queryAll selector list
|
||||
|> queryAll rest
|
||||
|
||||
|
||||
queryAllChildren : List Selector -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
queryAllChildren selectors list =
|
||||
case selectors of
|
||||
[] ->
|
||||
list
|
||||
|
||||
selector :: rest ->
|
||||
query ElmHtmlQuery.queryChildren queryAllChildren selector list
|
||||
|> queryAllChildren rest
|
||||
|
||||
|
||||
query :
|
||||
(ElmHtmlQuery.Selector -> ElmHtml msg -> List (ElmHtml msg))
|
||||
-> (List Selector -> List (ElmHtml msg) -> List (ElmHtml msg))
|
||||
-> Selector
|
||||
-> List (ElmHtml msg)
|
||||
-> List (ElmHtml msg)
|
||||
query fn fnAll selector list =
|
||||
case list of
|
||||
[] ->
|
||||
list
|
||||
|
||||
elems ->
|
||||
case selector of
|
||||
All selectors ->
|
||||
fnAll selectors elems
|
||||
|
||||
Classes classes ->
|
||||
List.concatMap (fn (ElmHtmlQuery.ClassList classes)) elems
|
||||
|
||||
Class class ->
|
||||
List.concatMap (fn (ElmHtmlQuery.ClassList [ class ])) elems
|
||||
|
||||
Attribute { name, value } ->
|
||||
List.concatMap (fn (ElmHtmlQuery.Attribute name value)) elems
|
||||
|
||||
BoolAttribute { name, value } ->
|
||||
List.concatMap (fn (ElmHtmlQuery.BoolAttribute name value)) elems
|
||||
|
||||
Style style ->
|
||||
List.concatMap (fn (ElmHtmlQuery.Style style)) elems
|
||||
|
||||
Tag name ->
|
||||
List.concatMap (fn (ElmHtmlQuery.Tag name)) elems
|
||||
|
||||
Text text ->
|
||||
List.concatMap (fn (ElmHtmlQuery.ContainsText text)) elems
|
||||
|
||||
Containing selectors ->
|
||||
let
|
||||
anyDescendantsMatch elem =
|
||||
case ElmHtmlQuery.getChildren elem of
|
||||
[] ->
|
||||
-- We have no children;
|
||||
-- no descendants can possibly match.
|
||||
False
|
||||
|
||||
children ->
|
||||
case query fn fnAll (All selectors) children of
|
||||
[] ->
|
||||
-- None of our children matched,
|
||||
-- but their descendants might!
|
||||
List.any anyDescendantsMatch children
|
||||
|
||||
_ :: _ ->
|
||||
-- At least one child matched. Yay!
|
||||
True
|
||||
in
|
||||
List.filter anyDescendantsMatch elems
|
||||
|
||||
Invalid ->
|
||||
[]
|
||||
|
||||
|
||||
namedAttr : String -> String -> Selector
|
||||
namedAttr name value =
|
||||
Attribute
|
||||
{ name = name
|
||||
, value = value
|
||||
}
|
||||
|
||||
|
||||
namedBoolAttr : String -> Bool -> Selector
|
||||
namedBoolAttr name value =
|
||||
BoolAttribute
|
||||
{ name = name
|
||||
, value = value
|
||||
}
|
||||
34
src/Test/Internal/KernelConstants.elm
Normal file
34
src/Test/Internal/KernelConstants.elm
Normal file
@ -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"
|
||||
}
|
||||
}
|
||||
33
tests/ElmToHtmlTests.elm
Normal file
33
tests/ElmToHtmlTests.elm
Normal file
@ -0,0 +1,33 @@
|
||||
module ElmToHtmlTests exposing (..)
|
||||
|
||||
import ElmHtml.InternalTypes
|
||||
import ElmHtml.ToString
|
||||
import Expect
|
||||
import Json.Decode
|
||||
import Test exposing (describe, test)
|
||||
|
||||
|
||||
all =
|
||||
describe "ElmToHtml"
|
||||
[ test "lazy" <|
|
||||
\() ->
|
||||
{-
|
||||
- "$": 0,
|
||||
- "a": "<script></script> is unsafe in JSON unless it is escaped properly.\n"
|
||||
|
||||
-}
|
||||
"""
|
||||
{"$":5,"l":[null,{"$":"#0"}]}
|
||||
"""
|
||||
|> Json.Decode.decodeString (ElmHtml.InternalTypes.decodeElmHtml (\_ _ -> Json.Decode.succeed ()))
|
||||
|> Result.map ElmHtml.ToString.nodeToString
|
||||
|> Expect.equal (Ok "HELLO")
|
||||
, test "no lazys" <|
|
||||
\() ->
|
||||
"""
|
||||
{"$":0,"a":"HELLO"}
|
||||
"""
|
||||
|> Json.Decode.decodeString (ElmHtml.InternalTypes.decodeElmHtml (\_ _ -> Json.Decode.succeed ()))
|
||||
|> Result.map ElmHtml.ToString.nodeToString
|
||||
|> Expect.equal (Ok "HELLO")
|
||||
]
|
||||
Loading…
Reference in New Issue
Block a user