elm-pages 3.0.0-beta.14 → 3.0.0-beta.16

package/src/ProgramTest/EffectSimulation.elm

@@ -1,122 +0,0 @@
-module ProgramTest.EffectSimulation exposing
-    ( EffectSimulation
-    , SimulationState
-    , clearOutgoingPortValues
-    , emptySimulationState
-    , init
-    , outgoingPortValues
-    , queueTask
-    , stepWorkQueue
-    )
-
-import Dict exposing (Dict)
-import Fifo exposing (Fifo)
-import Json.Encode
-import MultiDict exposing (MultiDict)
-import PairingHeap exposing (PairingHeap)
-import SimulatedEffect exposing (SimulatedEffect, SimulatedTask)
-import Time
-
-
-type alias EffectSimulation msg effect =
-    { deconstructEffect :
-        effect
-        -> SimulatedEffect msg -- TODO: this should not be in here
-    , workQueue : Fifo (SimulatedTask msg msg)
-    , state : SimulationState msg
-    , outgoingPortValues : Dict String (List Json.Encode.Value)
-    }
-
-
-init : (effect -> SimulatedEffect msg) -> EffectSimulation msg effect
-init f =
-    { deconstructEffect = f
-    , workQueue = Fifo.empty
-    , state = emptySimulationState
-    , outgoingPortValues = Dict.empty
-    }
-
-
-type alias SimulationState msg =
-    { http : MultiDict ( String, String ) (SimulatedEffect.HttpRequest msg msg)
-    , futureTasks : PairingHeap Int (() -> SimulatedTask msg msg)
-    , nowMs : Int
-    }
-
-
-emptySimulationState : SimulationState msg
-emptySimulationState =
-    { http = MultiDict.empty
-    , futureTasks = PairingHeap.empty
-    , nowMs = 0
-    }
-
-
-queueTask : SimulatedTask msg msg -> EffectSimulation msg effect -> EffectSimulation msg effect
-queueTask task simulation =
-    { simulation
-        | workQueue = Fifo.insert task simulation.workQueue
-    }
-
-
-stepWorkQueue : EffectSimulation msg effect -> Maybe ( EffectSimulation msg effect, Maybe msg )
-stepWorkQueue simulation =
-    case Fifo.remove simulation.workQueue of
-        ( Nothing, _ ) ->
-            Nothing
-
-        ( Just task, rest ) ->
-            let
-                ( newState, msg ) =
-                    simulateTask task simulation.state
-            in
-            Just
-                ( { simulation
-                    | workQueue = rest
-                    , state = newState
-                  }
-                , msg
-                )
-
-
-simulateTask : SimulatedTask msg msg -> SimulationState msg -> ( SimulationState msg, Maybe msg )
-simulateTask task simulationState =
-    case task of
-        SimulatedEffect.Succeed msg ->
-            ( simulationState, Just msg )
-
-        SimulatedEffect.Fail msg ->
-            ( simulationState, Just msg )
-
-        SimulatedEffect.HttpTask request ->
-            ( { simulationState
-                | http =
-                    MultiDict.insert ( request.method, request.url )
-                        request
-                        simulationState.http
-              }
-            , Nothing
-            )
-
-        SimulatedEffect.SleepTask delay onResult ->
-            ( { simulationState
-                | futureTasks =
-                    PairingHeap.insert (simulationState.nowMs + round delay) onResult simulationState.futureTasks
-              }
-            , Nothing
-            )
-
-        SimulatedEffect.NowTask onResult ->
-            simulateTask (onResult (Time.millisToPosix simulationState.nowMs)) simulationState
-
-
-outgoingPortValues : String -> EffectSimulation msg effect -> List Json.Encode.Value
-outgoingPortValues portName simulation =
-    Dict.get portName simulation.outgoingPortValues
-        |> Maybe.withDefault []
-        |> List.reverse
-
-
-clearOutgoingPortValues : String -> EffectSimulation msg effect -> EffectSimulation msg effect
-clearOutgoingPortValues portName simulation =
-    { simulation | outgoingPortValues = Dict.remove portName simulation.outgoingPortValues }

package/src/ProgramTest/Failure.elm

@@ -1,367 +0,0 @@
-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

@@ -1,116 +0,0 @@
-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

@@ -1,58 +0,0 @@
-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