elm-pages 3.0.0-beta.1 → 3.0.0-beta.12

package/src/ProgramTest/HtmlRenderer.elm

@@ -0,0 +1,73 @@
+module ProgramTest.HtmlRenderer exposing (render)
+
+import ProgramTest.HtmlHighlighter as HtmlHighlighter exposing (Node(..))
+
+
+render : (String -> String) -> Int -> List HtmlHighlighter.Node -> String
+render colorHidden indent nodes =
+    case nodes of
+        [] ->
+            ""
+
+        (Text text) :: rest ->
+            case String.trim (String.replace "\n" " " text) of
+                "" ->
+                    render colorHidden indent rest
+
+                trimmed ->
+                    String.repeat indent " " ++ trimmed ++ "\n" ++ render colorHidden indent rest
+
+        (Comment text) :: rest ->
+            String.repeat indent " " ++ "<!--" ++ text ++ "-->\n" ++ render colorHidden indent rest
+
+        (Element tag attrs []) :: rest ->
+            String.repeat indent " "
+                ++ "<"
+                ++ tag
+                ++ renderAttrs attrs
+                ++ "></"
+                ++ tag
+                ++ ">\n"
+                ++ render colorHidden indent rest
+
+        (Element tag attrs children) :: rest ->
+            String.repeat indent " "
+                ++ "<"
+                ++ tag
+                ++ renderAttrs attrs
+                ++ ">\n"
+                ++ render colorHidden (indent + 4) children
+                ++ String.repeat indent " "
+                ++ "</"
+                ++ tag
+                ++ ">\n"
+                ++ render colorHidden indent rest
+
+        (Hidden short) :: rest ->
+            String.repeat indent " " ++ colorHidden short ++ "\n" ++ render colorHidden indent rest
+
+
+renderAttrs : List HtmlHighlighter.Attribute -> String
+renderAttrs attrs =
+    case attrs of
+        [] ->
+            ""
+
+        some ->
+            " " ++ String.join " " (List.map renderAttr some)
+
+
+renderAttr : ( String, String ) -> String
+renderAttr ( name, value ) =
+    case ( name, value ) of
+        ( "htmlfor", _ ) ->
+            "for=\"" ++ value ++ "\""
+
+        ( _, "true" ) ->
+            name ++ "=true"
+
+        ( _, "false" ) ->
+            name ++ "=false"
+
+        _ ->
+            name ++ "=\"" ++ value ++ "\""

package/src/ProgramTest/Program.elm

@@ -0,0 +1,30 @@
+module ProgramTest.Program exposing (Program, renderView)
+
+import Browser
+import Html exposing (Html)
+import Test.Html.Query as Query
+import Url exposing (Url)
+
+
+{-| Since we can't inspect `Platform.Program`s in Elm,
+this type represents the same thing as a record that we can access.
+
+Note that we also parameterize `effect` and `sub` separately because
+`Platform.Cmd` and `Platform.Sub` are not inspectable in Elm.
+
+-}
+type alias Program model msg effect sub =
+    { update : msg -> model -> ( model, effect )
+    , view : model -> Html msg
+    , onUrlRequest : Maybe (Browser.UrlRequest -> msg)
+    , onUrlChange : Maybe (Url -> msg)
+    , subscriptions : Maybe (model -> sub)
+    , withinFocus : Query.Single msg -> Query.Single msg
+    }
+
+
+renderView : Program model msg effect sub -> model -> Query.Single msg
+renderView program model =
+    program.view model
+        |> Query.fromHtml
+        |> program.withinFocus

package/src/ProgramTest/StringLines.elm

@@ -0,0 +1,26 @@
+module ProgramTest.StringLines exposing (charAt, replaceAt)
+
+
+charAt : Int -> Int -> String -> Maybe String
+charAt row col input =
+    String.lines input
+        |> List.drop (row - 1)
+        |> List.head
+        |> Maybe.map
+            (String.dropLeft (col - 1)
+                >> String.left 1
+            )
+
+
+replaceAt : Int -> Int -> String -> String -> String
+replaceAt row col replacement input =
+    String.lines input
+        |> List.indexedMap
+            (\i line ->
+                if i == (row - 1) then
+                    String.left (col - 1) line ++ replacement ++ String.dropLeft col line
+
+                else
+                    line
+            )
+        |> String.join "\n"

package/src/ProgramTest/TestHtmlHacks.elm

@@ -0,0 +1,132 @@
+module ProgramTest.TestHtmlHacks exposing (getPassingSelectors, parseFailureReport, parseFailureReportWithoutHtml, parseSimulateFailure, renderHtml)
+
+import Html.Parser
+import Parser
+import Parser.Extra
+import ProgramTest.HtmlHighlighter as HtmlHighlighter
+import ProgramTest.HtmlRenderer as HtmlRenderer
+import ProgramTest.TestHtmlParser as TestHtmlParser exposing (Assertion(..), FailureReport(..))
+import Test.Html.Query as Query
+import Test.Html.Selector as Selector exposing (Selector)
+import Test.Runner
+
+
+pleaseReport description =
+    "PLEASE REPORT THIS AT <https://github.com/avh4/elm-program-test/issues>: " ++ description
+
+
+renderHtml : (String -> String) -> (String -> List Html.Parser.Attribute -> List Html.Parser.Node -> Bool) -> Query.Single any -> String
+renderHtml colorHidden highlightPredicate single =
+    case forceFailureReport [] single of
+        Ok (QueryFailure node _ _) ->
+            let
+                tryHighlight =
+                    HtmlHighlighter.highlight highlightPredicate
+                        node
+
+                finalHighlighted =
+                    if HtmlHighlighter.isNonHiddenElement tryHighlight then
+                        tryHighlight
+
+                    else
+                        HtmlHighlighter.highlight (\_ _ _ -> True)
+                            node
+            in
+            "▼ Query.fromHtml\n\n"
+                ++ HtmlRenderer.render colorHidden 4 [ finalHighlighted ]
+
+        Ok (EventFailure name _) ->
+            pleaseReport ("renderHtml: unexpected EventFailure: \"" ++ name ++ "\"")
+
+        Err err ->
+            pleaseReport ("renderHtml: couldn't parse failure report: " ++ err)
+
+
+getPassingSelectors : List Selector -> Query.Single msg -> List String
+getPassingSelectors selectors single =
+    case forceFailureReportWithoutHtml selectors single of
+        Ok (QueryFailure _ _ (Has _ results)) ->
+            case List.reverse results of
+                (Ok _) :: _ ->
+                    [ pleaseReport "getPassingSelectors: forced selector didn't fail" ]
+
+                _ ->
+                    List.filterMap Result.toMaybe results
+
+        Ok (EventFailure name _) ->
+            [ pleaseReport ("getPassingSelectors: got unexpected EventFailure \"" ++ name ++ "\"") ]
+
+        Err err ->
+            [ pleaseReport ("getPassingSelectors: couldn't parse failure report: " ++ err) ]
+
+
+forceFailureReport : List Selector -> Query.Single any -> Result String (FailureReport Html.Parser.Node)
+forceFailureReport selectors =
+    forceFailureReport_ parseFailureReport selectors "ProgramTest.TestHtmlHacks is trying to force a failure to collect the error message %%"
+
+
+forceFailureReportWithoutHtml : List Selector -> Query.Single any -> Result String (FailureReport ())
+forceFailureReportWithoutHtml selectors =
+    forceFailureReport_ parseFailureReportWithoutHtml selectors "ProgramTest.TestHtmlHacks is trying to force a failure to collect the error message %%"
+
+
+forceFailureReport_ : (String -> result) -> List Selector -> String -> Query.Single any -> result
+forceFailureReport_ parseFailure selectors unique single =
+    case
+        single
+            |> Query.has (selectors ++ [ Selector.text unique ])
+            |> Test.Runner.getFailureReason
+    of
+        Nothing ->
+            -- We expect the fake query to fail -- if it doesn't for some reason, just try recursing with a different fake matching string until it does fail
+            forceFailureReport_ parseFailure selectors (unique ++ "_") single
+
+        Just reason ->
+            parseFailure reason.description
+
+
+parseFailureReport : String -> Result String (FailureReport Html.Parser.Node)
+parseFailureReport string =
+    Parser.run TestHtmlParser.parser string
+        |> Result.mapError Parser.Extra.deadEndsToString
+
+
+parseFailureReportWithoutHtml : String -> Result String (FailureReport ())
+parseFailureReportWithoutHtml string =
+    Parser.run TestHtmlParser.parserWithoutHtml string
+        |> Result.mapError Parser.Extra.deadEndsToString
+
+
+partitionSections_ : List String -> List (List String) -> List String -> List (List String)
+partitionSections_ accLines accSections remaining =
+    case remaining of
+        [] ->
+            case List.reverse (List.reverse accLines :: accSections) of
+                [] :: rest ->
+                    rest
+
+                all ->
+                    all
+
+        next :: rest ->
+            if String.startsWith "▼ " next then
+                partitionSections_ [ next ] (List.reverse accLines :: accSections) rest
+
+            else
+                partitionSections_ (next :: accLines) accSections rest
+
+
+parseSimulateFailure : String -> String
+parseSimulateFailure string =
+    let
+        simpleFailure result =
+            case result of
+                EventFailure name html ->
+                    Ok ("Event.expectEvent: I found a node, but it does not listen for \"" ++ name ++ "\" events like I expected it would.")
+
+                _ ->
+                    Err (pleaseReport "Got a failure message from Test.Html.Query that we couldn't parse: " ++ string)
+    in
+    parseFailureReport string
+        |> Result.andThen simpleFailure
+        |> Result.withDefault (pleaseReport "Got a failure message from Test.Html.Query that we couldn't parse: " ++ string)

package/src/ProgramTest/TestHtmlParser.elm

@@ -0,0 +1,201 @@
+module ProgramTest.TestHtmlParser exposing (Assertion(..), FailureReport(..), Selector(..), Step(..), parser, parserWithoutHtml)
+
+import Html.Parser
+import Parser exposing ((|.), (|=), Parser)
+import Parser.Extra.String
+import ProgramTest.HtmlParserHacks as HtmlParserHacks
+
+
+type FailureReport html
+    = QueryFailure html (List (Step html)) Assertion
+    | EventFailure String html
+
+
+type Step html
+    = FindStep (List Selector) html
+
+
+type Selector
+    = Tag String
+    | Containing (List Selector)
+    | Text String
+    | Attribute String String
+    | All (List Selector)
+
+
+type Assertion
+    = Has (List Selector) (List (Result String String))
+
+
+parser_ : Parser html -> Parser (FailureReport html)
+parser_ parseHtml =
+    Parser.oneOf
+        [ Parser.succeed QueryFailure
+            |. Parser.keyword "▼ Query.fromHtml"
+            |. Parser.symbol "\n\n    "
+            |= parseHtml
+            |= stepsParser parseHtml
+            |= assertionParser
+            |. Parser.end
+        , Parser.succeed EventFailure
+            |. Parser.keyword "Event.expectEvent:"
+            |. Parser.symbol " I found a node, but it does not listen for \""
+            |= (Parser.getChompedString <| Parser.chompUntil "\"")
+            |. Parser.symbol "\" events like I expected it would.\n\n"
+            |= parseHtml
+            |. Parser.end
+        ]
+
+
+parser : Parser (FailureReport Html.Parser.Node)
+parser =
+    parser_ trimmedHtml
+
+
+trimmedHtml : Parser Html.Parser.Node
+trimmedHtml =
+    Parser.map HtmlParserHacks.trimText Html.Parser.node
+        |. Parser.oneOf
+            [ Parser.symbol "\n\n\n"
+            , Parser.end
+            ]
+
+
+parserWithoutHtml : Parser (FailureReport ())
+parserWithoutHtml =
+    parser_ ignoreHtml
+
+
+ignoreHtml : Parser ()
+ignoreHtml =
+    Parser.chompUntilEndOr "▼"
+
+
+stepsParser : Parser html -> Parser (List (Step html))
+stepsParser parseHtml =
+    Parser.loop [] <|
+        \acc ->
+            Parser.oneOf
+                [ Parser.succeed (\stmt -> Parser.Loop (stmt :: acc))
+                    |= stepParser parseHtml
+                , Parser.succeed ()
+                    |> Parser.map (\_ -> Parser.Done (List.reverse acc))
+                ]
+
+
+stepParser : Parser html -> Parser (Step html)
+stepParser parseHtml =
+    Parser.oneOf
+        [ Parser.succeed FindStep
+            |. Parser.keyword "▼ Query.find "
+            |= selectorsParser
+            |. Parser.symbol "\n\n    1)  "
+            |= parseHtml
+        ]
+
+
+selectorsParser : Parser (List Selector)
+selectorsParser =
+    Parser.sequence
+        { start = "[ "
+        , separator = ", "
+        , end = " ]"
+        , spaces = Parser.succeed ()
+        , item = selectorParser
+        , trailing = Parser.Forbidden
+        }
+
+
+selectorParser : Parser Selector
+selectorParser =
+    -- As of elm-explorations/test 1.2.2, `Selector.all` renders simply as a space-separated sequence of selectors
+    let
+        done acc =
+            case acc of
+                [ single ] ->
+                    single
+
+                more ->
+                    All (List.reverse more)
+    in
+    singleSelectorParser
+        |> Parser.andThen
+            (\first ->
+                Parser.loop [ first ] <|
+                    \acc ->
+                        Parser.oneOf
+                            [ Parser.succeed (\stmt -> Parser.Loop (stmt :: acc))
+                                |. Parser.backtrackable (Parser.symbol " ")
+                                |= singleSelectorParser
+                            , Parser.succeed ()
+                                |> Parser.map (\_ -> Parser.Done (done acc))
+                            ]
+            )
+
+
+singleSelectorParser : Parser Selector
+singleSelectorParser =
+    Parser.oneOf
+        [ Parser.succeed Tag
+            |. Parser.keyword "tag "
+            |= Parser.Extra.String.string
+        , Parser.succeed Text
+            |. Parser.keyword "text "
+            |= Parser.Extra.String.string
+        , Parser.succeed Attribute
+            |. Parser.keyword "attribute "
+            |= Parser.Extra.String.string
+            |. Parser.symbol " "
+            |= Parser.oneOf
+                [ Parser.Extra.String.string
+                , Parser.succeed "true"
+                    |. Parser.keyword "True"
+                , Parser.succeed "false"
+                    |. Parser.keyword "False"
+                ]
+        , Parser.succeed Containing
+            |. Parser.keyword "containing "
+            |= Parser.lazy (\() -> selectorsParser)
+            |. Parser.symbol " "
+        ]
+
+
+assertionParser : Parser Assertion
+assertionParser =
+    Parser.oneOf
+        [ Parser.succeed Has
+            |. Parser.keyword "▼ Query.has "
+            |= selectorsParser
+            |. Parser.symbol "\n\n"
+            |= selectorResultsParser
+        ]
+
+
+selectorResultsParser : Parser (List (Result String String))
+selectorResultsParser =
+    let
+        help acc =
+            Parser.oneOf
+                [ Parser.succeed (\stmt -> Parser.Loop (stmt :: acc))
+                    |= selectorResultParser
+                , Parser.succeed ()
+                    |> Parser.map (\_ -> Parser.Done (List.reverse acc))
+                ]
+    in
+    Parser.loop [] help
+
+
+selectorResultParser : Parser (Result String String)
+selectorResultParser =
+    Parser.oneOf
+        [ Parser.succeed (Ok << String.trim)
+            |. Parser.symbol "✓ "
+            |. Parser.commit ()
+            |= (Parser.getChompedString <| Parser.chompUntilEndOr "\n")
+            |. Parser.chompWhile ((==) '\n')
+        , Parser.succeed (Err << String.trim)
+            |. Parser.symbol "✗ "
+            |. Parser.commit ()
+            |= (Parser.getChompedString <| Parser.chompUntilEndOr "\n")
+            |. Parser.chompWhile ((==) '\n')
+        ]