elm-pages 3.0.0-beta.10 → 3.0.0-beta.13

package/src/ProgramTest/Failure.elm

@@ -0,0 +1,367 @@
+module ProgramTest.Failure exposing (Failure(..), toString)
+
+import Html exposing (Html)
+import ProgramTest.ComplexQuery as ComplexQuery exposing (Failure(..), FailureContext1(..))
+import ProgramTest.TestHtmlHacks as TestHtmlHacks
+import Set
+import String.Extra
+import Test.Html.Query as Query
+import Test.Runner.Failure
+import Url exposing (Url)
+import Vendored.Failure
+import Vendored.FormatMonochrome
+
+
+type Failure
+    = ChangedPage String Url
+      -- Errors
+    | ExpectFailed String String Test.Runner.Failure.Reason
+    | SimulateFailed String String
+    | SimulateFailedToFindTarget String String
+    | SimulateLastEffectFailed String
+    | InvalidLocationUrl String String
+    | InvalidFlags String String
+    | ProgramDoesNotSupportNavigation String
+    | NoBaseUrl String String
+    | NoMatchingHttpRequest Int Int String { method : String, url : String } (List ( String, String ))
+    | MultipleMatchingHttpRequest Int Int String { method : String, url : String } (List ( String, String ))
+    | EffectSimulationNotConfigured String
+    | ViewAssertionFailed String (Html ()) ComplexQuery.Highlight ( ComplexQuery.FailureContext, ComplexQuery.Failure )
+    | CustomFailure String String
+
+
+toString : Failure -> String
+toString failure =
+    case failure of
+        ChangedPage cause finalLocation ->
+            cause ++ " caused the program to end by navigating to " ++ String.Extra.escape (Url.toString finalLocation) ++ ".  NOTE: If this is what you intended, use ProgramTest.expectPageChange to end your test."
+
+        ExpectFailed expectationName description reason ->
+            expectationName
+                ++ ":\n"
+                ++ Vendored.Failure.format
+                    Vendored.FormatMonochrome.formatEquality
+                    description
+                    reason
+
+        SimulateFailed functionName message ->
+            functionName ++ ":\n" ++ message
+
+        SimulateFailedToFindTarget functionName message ->
+            functionName ++ ":\n" ++ message
+
+        SimulateLastEffectFailed message ->
+            "simulateLastEffect failed: " ++ message
+
+        InvalidLocationUrl functionName invalidUrl ->
+            functionName ++ ": " ++ "Not a valid absolute URL:\n" ++ String.Extra.escape invalidUrl
+
+        InvalidFlags functionName message ->
+            functionName ++ ":\n" ++ message
+
+        ProgramDoesNotSupportNavigation functionName ->
+            functionName ++ ": Program does not support navigation.  Use ProgramTest.createApplication to create a ProgramTest that supports navigation."
+
+        NoBaseUrl functionName relativeUrl ->
+            functionName ++ ": The ProgramTest does not have a base URL and cannot resolve the relative URL " ++ String.Extra.escape relativeUrl ++ ".  Use ProgramTest.withBaseUrl before calling ProgramTest.start to create a ProgramTest that can resolve relative URLs."
+
+        NoMatchingHttpRequest expected actual functionName request pendingRequests ->
+            String.concat
+                [ functionName
+                , ": "
+                , "Expected "
+                , case expected of
+                    1 ->
+                        "HTTP request"
+
+                    _ ->
+                        "at least " ++ String.fromInt expected ++ " HTTP requests"
+                , " ("
+                , request.method
+                , " "
+                , request.url
+                , ") to have been made and still be pending, "
+                , case actual of
+                    0 ->
+                        "but no such requests were made."
+
+                    _ ->
+                        "but only " ++ String.fromInt actual ++ " such requests were made."
+                , "\n"
+                , case pendingRequests of
+                    [] ->
+                        "    No requests were made."
+
+                    _ ->
+                        String.concat
+                            [ "    The following requests were made:\n"
+                            , String.join "\n" <|
+                                List.map (\( method, url ) -> "      - " ++ method ++ " " ++ url) pendingRequests
+                            ]
+                ]
+
+        MultipleMatchingHttpRequest expected actual functionName request pendingRequests ->
+            String.concat
+                [ functionName
+                , ": "
+                , "Expected "
+                , case expected of
+                    1 ->
+                        "a single HTTP request"
+
+                    _ ->
+                        String.fromInt expected ++ " HTTP requests"
+                , " ("
+                , request.method
+                , " "
+                , request.url
+                , ") to have been made, but "
+                , String.fromInt actual
+                , " such requests were made.\n"
+                , case pendingRequests of
+                    [] ->
+                        "    No requests were made."
+
+                    _ ->
+                        String.concat
+                            [ "    The following requests were made:\n"
+                            , String.join "\n" <|
+                                List.map (\( method, url ) -> "      - " ++ method ++ " " ++ url) pendingRequests
+                            ]
+                , if expected == 1 && actual > 1 then
+                    let
+                        useInstead =
+                            if String.startsWith "simulate" functionName then
+                                "simulateHttpResponseAdvanced"
+
+                            else if String.startsWith "expect" functionName then
+                                "expectHttpRequests"
+
+                            else
+                                "ensureHttpRequests"
+                    in
+                    "\n\nNOTE: If you want to allow multiple requests to the same endpoint, use ProgramTest." ++ useInstead ++ "."
+
+                  else
+                    ""
+                ]
+
+        EffectSimulationNotConfigured functionName ->
+            "TEST SETUP ERROR: In order to use " ++ functionName ++ ", you MUST use ProgramTest.withSimulatedEffects before calling ProgramTest.start"
+
+        ViewAssertionFailed functionName html highlight reason ->
+            let
+                highlighter =
+                    if Set.isEmpty highlight then
+                        \_ _ _ -> True
+
+                    else
+                        \tag attrs children ->
+                            Set.member tag highlight
+            in
+            String.join "\n"
+                [ TestHtmlHacks.renderHtml showColors.dim highlighter (Query.fromHtml html)
+                , ""
+                , "▼ " ++ functionName
+                , ""
+                , renderQueryFailureWithContext renderQueryFailure 0 True reason
+                ]
+
+        CustomFailure assertionName message ->
+            assertionName ++ ": " ++ message
+
+
+renderQueryFailureWithContext : (Int -> Bool -> a -> String) -> Int -> Bool -> ( ComplexQuery.FailureContext, a ) -> String
+renderQueryFailureWithContext renderInner indent color failure =
+    let
+        indentS =
+            String.repeat indent " "
+    in
+    case failure of
+        ( [], inner ) ->
+            renderInner indent color inner
+
+        ( (Description description) :: baseFailure, inner ) ->
+            String.join "\n" <|
+                List.filter ((/=) "")
+                    [ indentS ++ renderDescriptionResult (colorsFor color) description ++ ":"
+                    , renderQueryFailureWithContext renderInner (indent + 2) color ( baseFailure, inner )
+                    ]
+
+        ( (CheckSucceeded description checkContext) :: baseFailure, inner ) ->
+            String.join "\n" <|
+                List.filter ((/=) "")
+                    [ indentS ++ renderDescriptionResult (colorsFor color) (Ok description) ++ ":"
+                    , renderQueryFailureWithContext_ (\_ _ () -> "") (indent + 2) color ( checkContext, () )
+                    , renderQueryFailureWithContext renderInner indent color ( baseFailure, inner )
+                    ]
+
+        ( (FindSucceeded (Just description) successfulChecks) :: baseFailure, inner ) ->
+            String.join "\n" <|
+                List.filter ((/=) "")
+                    [ indentS ++ renderDescriptionResult (colorsFor color) (Ok description) ++ ":"
+                    , renderSelectorResults (indent + 2) (colorsFor color) (List.map Ok (successfulChecks ()))
+                    , renderQueryFailureWithContext renderInner indent color ( baseFailure, inner )
+                    ]
+
+        ( (FindSucceeded Nothing successfulChecks) :: baseFailure, inner ) ->
+            String.join "\n" <|
+                List.filter ((/=) "")
+                    [ renderSelectorResults indent (colorsFor color) (List.map Ok (successfulChecks ()))
+                    , renderQueryFailureWithContext renderInner indent color ( baseFailure, inner )
+                    ]
+
+
+renderQueryFailureWithContext_ : (Int -> Bool -> a -> String) -> Int -> Bool -> ( ComplexQuery.FailureContext, a ) -> String
+renderQueryFailureWithContext_ =
+    renderQueryFailureWithContext
+
+
+renderQueryFailure : Int -> Bool -> ComplexQuery.Failure -> String
+renderQueryFailure indent color failure =
+    let
+        indentS =
+            String.repeat indent " "
+    in
+    case failure of
+        QueryFailed failureReason ->
+            renderSelectorResults indent (colorsFor color) failureReason
+
+        ComplexQuery.SimulateFailed string ->
+            let
+                colors =
+                    colorsFor color
+            in
+            indentS ++ renderSelectorResult colors (Err string)
+
+        NoMatches description options ->
+            let
+                sortedByPriority =
+                    options
+                        |> List.sortBy (\( _, prio, _ ) -> -prio)
+
+                maxPriority =
+                    List.head sortedByPriority
+                        |> Maybe.map (\( _, prio, _ ) -> prio)
+                        |> Maybe.withDefault 0
+            in
+            String.join "\n" <|
+                List.concat
+                    [ [ indentS ++ description ++ ":" ]
+                    , sortedByPriority
+                        |> List.filter (\( _, prio, _ ) -> prio > maxPriority - 2)
+                        |> List.map (\( desc, prio, reason ) -> indentS ++ "- " ++ desc ++ "\n" ++ renderQueryFailureWithContext renderQueryFailure (indent + 4) (color && prio >= maxPriority - 1) reason)
+                    ]
+
+        TooManyMatches description matches ->
+            String.join "\n" <|
+                List.concat
+                    [ [ indentS ++ description ++ ", but there were multiple successful matches:" ]
+                    , matches
+                        |> List.sortBy (\( _, prio, _ ) -> -prio)
+                        |> List.map (\( desc, _, todo ) -> indentS ++ "- " ++ desc)
+                    , [ ""
+                      , "If that's what you intended, use `ProgramTest.within` to focus in on a portion of"
+                      , "the view that contains only one of the matches."
+                      ]
+                    ]
+
+
+renderSelectorResults : Int -> Colors -> List (Result String String) -> String
+renderSelectorResults indent colors results =
+    let
+        indentS =
+            String.repeat indent " "
+    in
+    List.map ((++) indentS << renderSelectorResult colors) (upToFirstErr results)
+        |> String.join "\n"
+
+
+renderSelectorResult : Colors -> Result String String -> String
+renderSelectorResult colors result =
+    case result of
+        Ok selector ->
+            String.concat
+                [ colors.green "✓"
+                , " "
+                , colors.bold selector
+                ]
+
+        Err selector ->
+            colors.red <|
+                String.concat
+                    [ "✗"
+                    , " "
+                    , selector
+                    ]
+
+
+renderDescriptionResult : Colors -> Result String String -> String
+renderDescriptionResult colors result =
+    case result of
+        Ok selector ->
+            String.concat
+                [ colors.green "✓"
+                , " "
+                , selector
+                ]
+
+        Err selector ->
+            String.concat
+                [ colors.red "✗"
+                , " "
+                , selector
+                ]
+
+
+upToFirstErr : List (Result x a) -> List (Result x a)
+upToFirstErr results =
+    let
+        step acc results_ =
+            case results_ of
+                [] ->
+                    acc
+
+                (Err x) :: _ ->
+                    Err x :: acc
+
+                (Ok a) :: rest ->
+                    step (Ok a :: acc) rest
+    in
+    step [] results
+        |> List.reverse
+
+
+type alias Colors =
+    { bold : String -> String
+    , red : String -> String
+    , green : String -> String
+    , dim : String -> String
+    }
+
+
+colorsFor : Bool -> Colors
+colorsFor show =
+    if show then
+        showColors
+
+    else
+        noColors
+
+
+showColors : Colors
+showColors =
+    { bold = \s -> String.concat [ "\u{001B}[1m", s, "\u{001B}[0m" ]
+    , red = \s -> String.concat [ "\u{001B}[31m", s, "\u{001B}[0m" ]
+    , green = \s -> String.concat [ "\u{001B}[32m", s, "\u{001B}[0m" ]
+    , dim = \s -> String.concat [ "\u{001B}[2m", s, "\u{001B}[0m" ]
+    }
+
+
+noColors : Colors
+noColors =
+    { bold = identity
+    , red = identity
+    , green = identity
+    , dim = identity
+    }

package/src/ProgramTest/HtmlHighlighter.elm

@@ -0,0 +1,116 @@
+module ProgramTest.HtmlHighlighter exposing (Attribute, Node(..), NodeF(..), fold, foldWithOriginal, highlight, isNonHiddenElement)
+
+import Html.Parser
+
+
+type NodeF a
+    = TextF String
+    | ElementF String (List Attribute) (List a)
+    | CommentF String
+
+
+type alias Attribute =
+    ( String, String )
+
+
+fold : (NodeF a -> a) -> Html.Parser.Node -> a
+fold f node =
+    case node of
+        Html.Parser.Text text ->
+            f (TextF text)
+
+        Html.Parser.Element tag attrs children ->
+            f (ElementF tag attrs (List.map (fold f) children))
+
+        Html.Parser.Comment string ->
+            f (CommentF string)
+
+
+foldWithOriginal : (NodeF ( Html.Parser.Node, a ) -> a) -> Html.Parser.Node -> a
+foldWithOriginal f node =
+    case node of
+        Html.Parser.Text text ->
+            f (TextF text)
+
+        Html.Parser.Element tag attrs children ->
+            f (ElementF tag attrs (List.map (\child -> ( child, foldWithOriginal f child )) children))
+
+        Html.Parser.Comment string ->
+            f (CommentF string)
+
+
+type Node
+    = Text String
+    | Element String (List Attribute) (List Node)
+    | Comment String
+    | Hidden String
+
+
+highlight : (String -> List Attribute -> List Html.Parser.Node -> Bool) -> Html.Parser.Node -> Node
+highlight predicate =
+    foldWithOriginal <|
+        \node ->
+            case node of
+                TextF text ->
+                    Text text
+
+                ElementF tag attrs children ->
+                    let
+                        foldedChildren =
+                            List.map Tuple.second children
+                    in
+                    if predicate tag attrs (List.map Tuple.first children) || List.any isNonHiddenElement foldedChildren then
+                        Element tag attrs foldedChildren
+
+                    else
+                        let
+                            bestId =
+                                List.concatMap identity
+                                    [ List.filter (Tuple.first >> (==) "id") attrs
+                                    , List.filter (Tuple.first >> (==) "name") attrs
+                                    , List.filter (Tuple.first >> (==) "class") attrs
+                                    ]
+                                    |> List.head
+                                    |> Maybe.map (\( name, value ) -> " " ++ name ++ "=\"" ++ value ++ "\"")
+                                    |> Maybe.withDefault ""
+
+                            bestContent =
+                                case foldedChildren of
+                                    [] ->
+                                        ""
+
+                                    [ Text single ] ->
+                                        truncate 15 (String.trim single)
+
+                                    _ ->
+                                        "..."
+                        in
+                        Hidden ("<" ++ tag ++ bestId ++ ">" ++ bestContent ++ "</" ++ tag ++ ">")
+
+                CommentF string ->
+                    Comment string
+
+
+isNonHiddenElement : Node -> Bool
+isNonHiddenElement node =
+    case node of
+        Text _ ->
+            False
+
+        Element _ _ _ ->
+            True
+
+        Comment _ ->
+            False
+
+        Hidden _ ->
+            False
+
+
+truncate : Int -> String -> String
+truncate max input =
+    if String.length input < max - 3 then
+        input
+
+    else
+        String.left (max - 3) input ++ "..."

package/src/ProgramTest/HtmlParserHacks.elm

@@ -0,0 +1,58 @@
+module ProgramTest.HtmlParserHacks exposing (parse, trimText)
+
+import Html.Parser
+import Parser
+import ProgramTest.StringLines as StringLines
+
+
+parse : String -> Result (List Parser.DeadEnd) (List Html.Parser.Node)
+parse input =
+    case Html.Parser.run input of
+        Ok nodes ->
+            Ok nodes
+
+        Err errs ->
+            case fixError errs input of
+                Nothing ->
+                    Err errs
+
+                Just nodes ->
+                    Ok nodes
+
+
+fixError : List Parser.DeadEnd -> String -> Maybe (List Html.Parser.Node)
+fixError errs input =
+    case errs of
+        [] ->
+            Nothing
+
+        { row, col, problem } :: rest ->
+            case problem of
+                Parser.UnexpectedChar ->
+                    case StringLines.charAt row (col - 1) input of
+                        Just "<" ->
+                            parse (StringLines.replaceAt row (col - 1) "&lt;" input)
+                                |> Result.toMaybe
+
+                        _ ->
+                            fixError rest input
+
+                _ ->
+                    fixError rest input
+
+
+trimText : Html.Parser.Node -> Html.Parser.Node
+trimText node =
+    case node of
+        Html.Parser.Text string ->
+            Html.Parser.Text (String.trim string)
+
+        Html.Parser.Element string list nodes ->
+            Html.Parser.Element string
+                list
+                (List.map trimText nodes
+                    |> List.filter ((/=) (Html.Parser.Text ""))
+                )
+
+        Html.Parser.Comment string ->
+            Html.Parser.Comment string

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"