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

package/src/Pages/Script.elm

@@ -0,0 +1,100 @@
+module Pages.Script exposing
+    ( Script(..)
+    , withCliOptions, withoutCliOptions
+    , writeFile
+    , log
+    )
+
+{-|
+
+@docs Script
+
+@docs withCliOptions, withoutCliOptions
+
+
+## File System Utilities
+
+@docs writeFile
+
+
+## Utilities
+
+@docs log
+
+-}
+
+import Cli.OptionsParser as OptionsParser
+import Cli.Program as Program
+import DataSource exposing (DataSource)
+import DataSource.Http
+import DataSource.Internal.Request
+import Html exposing (Html)
+import Json.Decode as Decode
+import Json.Encode as Encode
+
+
+{-| -}
+type Script
+    = Generator
+        ((Maybe { indent : Int, newLines : Bool }
+          -> Html Never
+          -> String
+         )
+         -> Program.Config (DataSource ())
+        )
+
+
+{-| -}
+writeFile : { path : String, body : String } -> DataSource ()
+writeFile { path, body } =
+    DataSource.Internal.Request.request
+        { name = "write-file"
+        , body =
+            DataSource.Http.jsonBody
+                (Encode.object
+                    [ ( "path", Encode.string path )
+                    , ( "body", Encode.string body )
+                    ]
+                )
+        , expect = DataSource.Http.expectJson (Decode.succeed ())
+        }
+
+
+{-| -}
+log : String -> DataSource ()
+log message =
+    DataSource.Internal.Request.request
+        { name = "log"
+        , body =
+            DataSource.Http.jsonBody
+                (Encode.object
+                    [ ( "message", Encode.string message )
+                    ]
+                )
+        , expect = DataSource.Http.expectJson (Decode.succeed ())
+        }
+
+
+{-| -}
+withoutCliOptions : DataSource () -> Script
+withoutCliOptions execute =
+    Generator
+        (\_ ->
+            Program.config
+                |> Program.add
+                    (OptionsParser.build ())
+                |> Program.mapConfig
+                    (\() ->
+                        execute
+                    )
+        )
+
+
+{-| -}
+withCliOptions : Program.Config cliOptions -> (cliOptions -> DataSource ()) -> Script
+withCliOptions config execute =
+    Generator
+        (\_ ->
+            config
+                |> Program.mapConfig execute
+        )

package/src/PairingHeap.elm

@@ -0,0 +1,137 @@
+module PairingHeap exposing
+    ( PairingHeap, empty
+    , insert, merge, findMin, deleteMin
+    , fromList, toSortedList
+    )
+
+{-| This is a simple pairing heap implementation written in Elm usable as a priority queue. This code is
+based heavily on the pseudocode available at [the Wikipedia page](https://en.wikipedia.org/wiki/Pairing_heap).
+
+
+# Type and Constructor
+
+@docs PairingHeap, empty
+
+
+# Operations
+
+@docs insert, merge, findMin, deleteMin
+
+
+# Convenience functions
+
+@docs fromList, toSortedList
+
+-}
+
+
+{-| A `PairingHeap` has comparable keys and values of an arbitrary type.
+-}
+type PairingHeap comparable a
+    = Empty
+    | Heap comparable a (List (PairingHeap comparable a))
+
+
+{-| Create an empty PairingHeap.
+-}
+empty : PairingHeap comparable a
+empty =
+    Empty
+
+
+{-| Find the minimum value in a heap returning Nothing if the heap is empty.
+Complexity: O(1)
+
+    findMin (fromList [ ( 10, () ), ( 3, () ), ( 8, () ) ]) == Just 3
+
+-}
+findMin : PairingHeap comparable a -> Maybe ( comparable, a )
+findMin x =
+    case x of
+        Empty ->
+            Nothing
+
+        Heap k v _ ->
+            Just ( k, v )
+
+
+{-| Merges two `PairingHeap`s together into one new heap containing all of the key-value pairs from both inputs.
+Complexity: O(1)
+-}
+merge : PairingHeap comparable a -> PairingHeap comparable a -> PairingHeap comparable a
+merge heap1 heap2 =
+    case ( heap1, heap2 ) of
+        ( Empty, _ ) ->
+            heap2
+
+        ( _, Empty ) ->
+            heap1
+
+        ( Heap k1 v1 hs1, Heap k2 v2 hs2 ) ->
+            if k1 < k2 then
+                Heap k1 v1 (heap2 :: hs1)
+
+            else
+                Heap k2 v2 (heap1 :: hs2)
+
+
+{-| Inserts a new element into a `PairingHeap`.
+Complexity: O(1)
+-}
+insert : comparable -> a -> PairingHeap comparable a -> PairingHeap comparable a
+insert k v heap =
+    merge (Heap k v []) heap
+
+
+{-| Removes the minimum element from a `PairingHeap` returning a new heap without that element.
+This will return an empty heap if given an empty heap as input.
+Complexity: O(log n)
+-}
+deleteMin : PairingHeap comparable a -> PairingHeap comparable a
+deleteMin heap =
+    case heap of
+        Empty ->
+            Empty
+
+        Heap k v heaps ->
+            mergePairs heaps
+
+
+{-| This is an internal function used by deleteMin.
+-}
+mergePairs : List (PairingHeap comparable a) -> PairingHeap comparable a
+mergePairs heaps =
+    case heaps of
+        [] ->
+            Empty
+
+        x :: [] ->
+            x
+
+        x :: (y :: xs) ->
+            merge (merge x y) (mergePairs xs)
+
+
+
+-- Extra convenience functions
+
+
+{-| This function turns a list of key-value pairs into a `PairingHeap`.
+Complexity: O(n)
+-}
+fromList : List ( comparable, a ) -> PairingHeap comparable a
+fromList =
+    List.foldl (\( k, v ) -> insert k v) empty
+
+
+{-| This function turns a `PairingHeap` into a sorted list of key-value pairs.
+Complexity: O(n log n)
+-}
+toSortedList : PairingHeap comparable a -> List ( comparable, a )
+toSortedList heap =
+    case heap of
+        Empty ->
+            []
+
+        Heap k v _ ->
+            ( k, v ) :: toSortedList (deleteMin heap)

package/src/Parser/Extra/String.elm

@@ -0,0 +1,33 @@
+module Parser.Extra.String exposing (string)
+
+import Parser exposing (..)
+
+
+string : Parser String
+string =
+    succeed identity
+        |. token "\""
+        |= loop [] stringHelp
+
+
+stringHelp : List String -> Parser (Step (List String) String)
+stringHelp revChunks =
+    oneOf
+        [ succeed (\chunk -> Loop (chunk :: revChunks))
+            |. token "\\"
+            |= oneOf
+                [ map (\_ -> "\n") (token "n")
+                , map (\_ -> "\t") (token "t")
+                , map (\_ -> "\u{000D}") (token "r")
+                ]
+        , token "\""
+            |> map (\_ -> Done (String.join "" (List.reverse revChunks)))
+        , chompWhile isUninteresting
+            |> getChompedString
+            |> map (\chunk -> Loop (chunk :: revChunks))
+        ]
+
+
+isUninteresting : Char -> Bool
+isUninteresting char =
+    char /= '\\' && char /= '"'

package/src/Parser/Extra.elm

@@ -0,0 +1,69 @@
+module Parser.Extra exposing (deadEndsToString)
+
+{-| [No implementation for deadEndsToString · Issue #9 · elm/parser](https://github.com/elm/parser/issues/9)
+-}
+
+import Parser exposing (DeadEnd, Problem(..))
+
+
+deadEndsToString : List DeadEnd -> String
+deadEndsToString deadEnds =
+    String.join "\n" (List.map deadEndToString deadEnds)
+
+
+deadEndToString : DeadEnd -> String
+deadEndToString deadEnd =
+    problemToString deadEnd.problem
+        ++ " at "
+        ++ deadEndToRowColString deadEnd
+
+
+problemToString : Problem -> String
+problemToString prob =
+    case prob of
+        Expecting s ->
+            "Expecting " ++ s
+
+        ExpectingInt ->
+            "Expecting Int"
+
+        ExpectingHex ->
+            "Expecting Hex"
+
+        ExpectingOctal ->
+            "Expecting Octal"
+
+        ExpectingBinary ->
+            "Expecting Binary"
+
+        ExpectingFloat ->
+            "Expecting Float"
+
+        ExpectingNumber ->
+            "Expecting Number"
+
+        ExpectingVariable ->
+            "Expecting Variable"
+
+        ExpectingSymbol s ->
+            "Expecting Symbol " ++ s
+
+        ExpectingKeyword s ->
+            "Expecting Keyword " ++ s
+
+        ExpectingEnd ->
+            "Expecting End"
+
+        UnexpectedChar ->
+            "Unexpected Char"
+
+        Problem s ->
+            "Problem: " ++ s
+
+        BadRepeat ->
+            "Bad Repeat"
+
+
+deadEndToRowColString : DeadEnd -> String
+deadEndToRowColString deadEnd =
+    "row " ++ String.fromInt deadEnd.row ++ ", " ++ "col " ++ String.fromInt deadEnd.col

package/src/ProgramTest/ComplexQuery.elm

@@ -0,0 +1,360 @@
+module ProgramTest.ComplexQuery exposing (ComplexQuery, Failure(..), FailureContext, FailureContext1(..), Highlight, Priority, check, exactlyOneOf, find, findButNot, run, simulate, succeed)
+
+import Json.Encode as Json
+import ProgramTest.TestHtmlHacks as TestHtmlHacks
+import ProgramTest.TestHtmlParser as TestHtmlParser
+import Result.Extra
+import Set exposing (Set)
+import Test.Html.Event
+import Test.Html.Query as Query
+import Test.Html.Selector as Selector exposing (Selector)
+import Test.Runner
+
+
+type ComplexQuery a
+    = QueryResult State Highlight (List FailureContext1) (Result Failure a)
+
+
+succeed : a -> ComplexQuery a
+succeed a =
+    QueryResult initState Set.empty [] (Ok a)
+
+
+type alias Priority =
+    Int
+
+
+type alias State =
+    { priority : Priority
+    }
+
+
+initState : State
+initState =
+    { priority = 0
+    }
+
+
+type Failure
+    = QueryFailed (List (Result String String))
+    | SimulateFailed String
+    | NoMatches String (List ( String, Priority, ( List FailureContext1, Failure ) ))
+    | TooManyMatches String (List ( String, Priority, List FailureContext1 ))
+
+
+type alias FailureContext =
+    List FailureContext1
+
+
+type FailureContext1
+    = FindSucceeded (Maybe String) (() -> List String)
+    | CheckSucceeded String (List FailureContext1)
+    | Description (Result String String)
+
+
+type alias Highlight =
+    Set String
+
+
+run : ComplexQuery a -> ( Highlight, Result ( List FailureContext1, Failure ) a )
+run (QueryResult _ highlight context result) =
+    ( highlight
+    , case result of
+        Ok a ->
+            Ok a
+
+        Err error ->
+            Err ( List.reverse context, error )
+    )
+
+
+find : Maybe String -> List String -> List Selector -> ComplexQuery (Query.Single msg) -> ComplexQuery (Query.Single msg)
+find description highlight selectors prev =
+    case prev of
+        QueryResult _ _ _ (Err _) ->
+            prev
+
+        QueryResult state prevHighlight prevContext (Ok source) ->
+            case Test.Runner.getFailureReason (Query.has [ Selector.all selectors ] source) of
+                Just _ ->
+                    let
+                        error =
+                            firstErrorOf source
+                                [ selectors
+                                , [ Selector.all selectors ]
+                                ]
+
+                        context =
+                            case description of
+                                Nothing ->
+                                    []
+
+                                Just desc ->
+                                    [ Description (Err desc) ]
+                    in
+                    QueryResult
+                        { state
+                            | priority = state.priority + countSuccesses error
+                        }
+                        (Set.union (Set.fromList highlight) prevHighlight)
+                        (context ++ prevContext)
+                        (Err (QueryFailed error))
+
+                Nothing ->
+                    QueryResult
+                        { state
+                            | priority = state.priority + List.length selectors
+                        }
+                        (Set.union (Set.fromList highlight) prevHighlight)
+                        (FindSucceeded description (\() -> TestHtmlHacks.getPassingSelectors selectors source) :: prevContext)
+                        (Ok (Query.find selectors source))
+
+
+exactlyOneOf : String -> List ( String, ComplexQuery a -> ComplexQuery b ) -> ComplexQuery a -> ComplexQuery b
+exactlyOneOf description options prev =
+    case prev of
+        QueryResult state prevHighlight prevContext (Err err) ->
+            QueryResult state prevHighlight prevContext (Err err)
+
+        QueryResult state prevHighlight prevContext (Ok _) ->
+            let
+                results : List ( String, ComplexQuery b )
+                results =
+                    List.map (Tuple.mapSecond (\option -> option prev)) options
+
+                successes : List ( String, ComplexQuery b )
+                successes =
+                    List.filter (isSuccess << Tuple.second) results
+
+                isSuccess res =
+                    case res of
+                        QueryResult _ _ _ (Err _) ->
+                            False
+
+                        QueryResult _ _ _ (Ok _) ->
+                            True
+
+                collectHighlight (QueryResult _ highlight _ _) =
+                    highlight
+
+                highlights =
+                    List.map (collectHighlight << Tuple.second) results
+                        |> List.foldl Set.union Set.empty
+
+                collectError ( desc, QueryResult newState _ context result ) =
+                    case result of
+                        Ok _ ->
+                            Nothing
+
+                        Err x ->
+                            Just
+                                ( desc
+                                , newState.priority
+                                , ( List.reverse context, x )
+                                )
+            in
+            case successes of
+                [ ( _, one ) ] ->
+                    one
+
+                [] ->
+                    let
+                        failures =
+                            List.filterMap collectError results
+                    in
+                    QueryResult
+                        state
+                        (Set.union highlights prevHighlight)
+                        prevContext
+                        (Err (NoMatches description failures))
+
+                many ->
+                    let
+                        matches =
+                            List.map
+                                (\( desc, QueryResult newState _ context _ ) ->
+                                    ( desc, newState.priority, context )
+                                )
+                                many
+                    in
+                    QueryResult
+                        state
+                        (Set.union highlights prevHighlight)
+                        prevContext
+                        (Err (TooManyMatches description matches))
+
+
+{-|
+
+  - `good`: the primary selector that must match
+  - `bads`: a list of selectors that must NOT match
+  - `onError`: the selector to use to produce an error message if any of the checks fail
+
+-}
+findButNot :
+    Maybe String
+    -> List String
+    ->
+        { good : List Selector
+        , bads : List (List Selector)
+        , onError : List Selector
+        }
+    -> ComplexQuery (Query.Single msg)
+    -> ComplexQuery (Query.Single msg)
+findButNot description highlight { good, bads, onError } prev =
+    case prev of
+        QueryResult _ _ _ (Err _) ->
+            prev
+
+        QueryResult state prevHighlight prevContext (Ok source) ->
+            -- This is tricky because Test.Html doesn't provide a way to search for an attribute being *not* present.
+            -- So we have to check if a selector we don't want *is* present, and manually force a failure if it is.
+            let
+                addDescription =
+                    case description of
+                        Nothing ->
+                            []
+
+                        Just desc ->
+                            [ Description (Err desc) ]
+
+                checkBads : Priority -> List (List Selector) -> Query.Single msg -> ComplexQuery (Query.Single msg)
+                checkBads extraPriority bads_ found =
+                    case bads_ of
+                        [] ->
+                            QueryResult
+                                { state | priority = state.priority + extraPriority + 1 }
+                                (Set.union (Set.fromList highlight) prevHighlight)
+                                -- TODO: add the not bads to the context (or alternatively, add the "onErrors", but convert them all to successes)
+                                (FindSucceeded description (\() -> TestHtmlHacks.getPassingSelectors good source) :: prevContext)
+                                (Ok found)
+
+                        nextBad :: rest ->
+                            let
+                                isBad =
+                                    Query.has [ Selector.all nextBad ] source
+                            in
+                            case Test.Runner.getFailureReason isBad of
+                                Nothing ->
+                                    -- the element matches the bad selectors; produce a Query using the onError selectors that will fail that will show a reasonable failure message
+                                    let
+                                        error =
+                                            firstErrorOf source
+                                                [ good
+                                                , [ Selector.all good ]
+                                                , onError
+                                                , [ Selector.all onError ]
+                                                ]
+                                    in
+                                    QueryResult
+                                        { state | priority = state.priority + extraPriority + countSuccesses error }
+                                        (Set.union (Set.fromList highlight) prevHighlight)
+                                        (addDescription ++ prevContext)
+                                        (Err (QueryFailed error))
+
+                                Just _ ->
+                                    -- the element we found is not bad; continue on to the next check
+                                    checkBads (extraPriority + List.length nextBad) rest found
+
+                isGood =
+                    Query.has [ Selector.all good ] source
+            in
+            case Test.Runner.getFailureReason isGood of
+                Just _ ->
+                    -- Couldn't find it, so report the best error message we can
+                    let
+                        error =
+                            firstErrorOf source
+                                [ good
+                                , [ Selector.all good ]
+                                ]
+                    in
+                    QueryResult
+                        { state | priority = state.priority + countSuccesses error }
+                        (Set.union (Set.fromList highlight) prevHighlight)
+                        prevContext
+                        (Err (QueryFailed error))
+
+                Nothing ->
+                    Query.find good source
+                        |> checkBads (List.length good) bads
+
+
+simulate : ( String, Json.Value ) -> ComplexQuery (Query.Single msg) -> ComplexQuery msg
+simulate event prev =
+    case prev of
+        QueryResult state prevHighlight prevContext (Err err) ->
+            QueryResult state prevHighlight prevContext (Err err)
+
+        QueryResult state prevHighlight prevContext (Ok source) ->
+            case
+                source
+                    |> Test.Html.Event.simulate event
+                    |> Test.Html.Event.toResult
+            of
+                Err message ->
+                    QueryResult
+                        state
+                        prevHighlight
+                        (Description (Err ("simulate " ++ Tuple.first event)) :: prevContext)
+                        (Err (SimulateFailed (TestHtmlHacks.parseSimulateFailure message)))
+
+                Ok msg ->
+                    QueryResult state prevHighlight prevContext (Ok msg)
+
+
+{-| Ensure that the given query succeeds, but then ignore its result.
+-}
+check : String -> (ComplexQuery a -> ComplexQuery ignored) -> ComplexQuery a -> ComplexQuery a
+check description checkQuery prev =
+    case prev of
+        QueryResult _ _ _ (Err _) ->
+            prev
+
+        QueryResult state prevHighlight prevContext (Ok source) ->
+            let
+                (QueryResult checkedState highlight checkContext checkResult) =
+                    checkQuery (QueryResult state prevHighlight [] (Ok source))
+            in
+            case checkResult of
+                Err failure ->
+                    QueryResult
+                        checkedState
+                        (Set.union highlight prevHighlight)
+                        (Description (Err description) :: checkContext ++ prevContext)
+                        (Err failure)
+
+                Ok _ ->
+                    QueryResult
+                        { state | priority = checkedState.priority }
+                        (Set.union highlight prevHighlight)
+                        (CheckSucceeded description checkContext :: prevContext)
+                        (Ok source)
+
+
+firstErrorOf : Query.Single msg -> List (List Selector) -> List (Result String String)
+firstErrorOf source choices =
+    case choices of
+        [] ->
+            [ Err "PLEASE REPORT THIS AT <https://github.com/avh4/elm-program-test/issues>: firstErrorOf: asked to report an error but none of the choices failed" ]
+
+        next :: rest ->
+            case Test.Runner.getFailureReason (Query.has next source) of
+                Just reason ->
+                    case TestHtmlHacks.parseFailureReportWithoutHtml reason.description of
+                        Ok (TestHtmlParser.QueryFailure _ _ (TestHtmlParser.Has _ results)) ->
+                            results
+
+                        Ok (TestHtmlParser.EventFailure name _) ->
+                            [ Err ("PLEASE REPORT THIS AT <https://github.com/avh4/elm-program-test/issues>: firstErrorOf: got unexpected EventFailure \"" ++ name ++ "\"") ]
+
+                        Err err ->
+                            [ Err ("PLEASE REPORT THIS AT <https://github.com/avh4/elm-program-test/issues>: firstErrorOf: couldn't parse failure report: " ++ err) ]
+
+                Nothing ->
+                    firstErrorOf source rest
+
+
+countSuccesses : List (Result String String) -> Int
+countSuccesses results =
+    List.length (List.filter Result.Extra.isOk results)