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

package/src/SimulatedEffect/Task.elm

@@ -0,0 +1,252 @@
+module SimulatedEffect.Task exposing
+    ( perform, attempt
+    , andThen, succeed, fail, sequence
+    , map, map2, map3, map4, map5
+    , mapError, onError
+    )
+
+{-| This module parallels [elm/core's `Task` module](https://package.elm-lang.org/packages/elm/core/1.0.2/Task).
+_Pull requests are welcome to add any functions that are missing._
+
+The functions here produce `SimulatedTasks`s instead of `Tasks`s
+and `SimulatedEffect`s instead of `Cmd`s, which are meant to be used
+to help you implement the function to provide when using [`ProgramTest.withSimulatedEffects`](ProgramTest#withSimulatedEffects).
+
+
+# Tasks
+
+@docs perform, attempt
+
+
+# Chains
+
+@docs andThen, succeed, fail, sequence
+
+
+# Maps
+
+@docs map, map2, map3, map4, map5
+
+
+# Errors
+
+@docs mapError, onError
+
+-}
+
+import ProgramTest exposing (SimulatedEffect, SimulatedTask)
+import SimulatedEffect
+
+
+{-| -}
+perform : (a -> msg) -> SimulatedTask Never a -> SimulatedEffect msg
+perform f task =
+    task
+        |> map f
+        |> mapError never
+        |> SimulatedEffect.Task
+
+
+{-| This is very similar to [`perform`](#perform) except it can handle failures!
+-}
+attempt : (Result x a -> msg) -> SimulatedTask x a -> SimulatedEffect msg
+attempt f task =
+    task
+        |> map (Ok >> f)
+        |> mapError (Err >> f)
+        |> SimulatedEffect.Task
+
+
+{-| Chain together a task and a callback.
+-}
+andThen : (a -> SimulatedTask x b) -> SimulatedTask x a -> SimulatedTask x b
+andThen f task =
+    case task of
+        SimulatedEffect.Succeed a ->
+            f a
+
+        SimulatedEffect.Fail x ->
+            SimulatedEffect.Fail x
+
+        SimulatedEffect.HttpTask request ->
+            SimulatedEffect.HttpTask
+                { method = request.method
+                , url = request.url
+                , body = request.body
+                , headers = request.headers
+                , onRequestComplete = request.onRequestComplete >> andThen f
+                }
+
+        SimulatedEffect.SleepTask delay onResult ->
+            SimulatedEffect.SleepTask delay (onResult >> andThen f)
+
+        SimulatedEffect.NowTask onResult ->
+            SimulatedEffect.NowTask (onResult >> andThen f)
+
+
+{-| A task that succeeds immediately when run.
+-}
+succeed : a -> SimulatedTask x a
+succeed =
+    SimulatedEffect.Succeed
+
+
+{-| A task that fails immediately when run.
+-}
+fail : x -> SimulatedTask x a
+fail =
+    SimulatedEffect.Fail
+
+
+{-| Start with a list of tasks, and turn them into a single task that returns a
+list.
+-}
+sequence : List (SimulatedTask x a) -> SimulatedTask x (List a)
+sequence tasks =
+    List.foldr (map2 (::)) (succeed []) tasks
+
+
+{-| Transform a task.
+-}
+map : (a -> b) -> SimulatedTask x a -> SimulatedTask x b
+map f =
+    andThen (f >> SimulatedEffect.Succeed)
+
+
+{-| Put the results of two tasks together.
+-}
+map2 : (a -> b -> result) -> SimulatedTask x a -> SimulatedTask x b -> SimulatedTask x result
+map2 func taskA taskB =
+    taskA
+        |> andThen
+            (\a ->
+                taskB
+                    |> andThen (\b -> succeed (func a b))
+            )
+
+
+{-| Put the results of three tasks together.
+-}
+map3 : (a -> b -> c -> result) -> SimulatedTask x a -> SimulatedTask x b -> SimulatedTask x c -> SimulatedTask x result
+map3 func taskA taskB taskC =
+    taskA
+        |> andThen
+            (\a ->
+                taskB
+                    |> andThen
+                        (\b ->
+                            taskC
+                                |> andThen (\c -> succeed (func a b c))
+                        )
+            )
+
+
+{-| Put the results of four tasks together.
+-}
+map4 :
+    (a -> b -> c -> d -> result)
+    -> SimulatedTask x a
+    -> SimulatedTask x b
+    -> SimulatedTask x c
+    -> SimulatedTask x d
+    -> SimulatedTask x result
+map4 func taskA taskB taskC taskD =
+    taskA
+        |> andThen
+            (\a ->
+                taskB
+                    |> andThen
+                        (\b ->
+                            taskC
+                                |> andThen
+                                    (\c ->
+                                        taskD
+                                            |> andThen (\d -> succeed (func a b c d))
+                                    )
+                        )
+            )
+
+
+{-| Put the results of five tasks together.
+-}
+map5 :
+    (a -> b -> c -> d -> e -> result)
+    -> SimulatedTask x a
+    -> SimulatedTask x b
+    -> SimulatedTask x c
+    -> SimulatedTask x d
+    -> SimulatedTask x e
+    -> SimulatedTask x result
+map5 func taskA taskB taskC taskD taskE =
+    taskA
+        |> andThen
+            (\a ->
+                taskB
+                    |> andThen
+                        (\b ->
+                            taskC
+                                |> andThen
+                                    (\c ->
+                                        taskD
+                                            |> andThen
+                                                (\d ->
+                                                    taskE
+                                                        |> andThen (\e -> succeed (func a b c d e))
+                                                )
+                                    )
+                        )
+            )
+
+
+{-| Transform the error value.
+-}
+mapError : (x -> y) -> SimulatedTask x a -> SimulatedTask y a
+mapError f task =
+    case task of
+        SimulatedEffect.Succeed a ->
+            SimulatedEffect.Succeed a
+
+        SimulatedEffect.Fail x ->
+            SimulatedEffect.Fail (f x)
+
+        SimulatedEffect.HttpTask request ->
+            SimulatedEffect.HttpTask
+                { method = request.method
+                , url = request.url
+                , body = request.body
+                , headers = request.headers
+                , onRequestComplete = request.onRequestComplete >> mapError f
+                }
+
+        SimulatedEffect.SleepTask delay onResult ->
+            SimulatedEffect.SleepTask delay (onResult >> mapError f)
+
+        SimulatedEffect.NowTask onResult ->
+            SimulatedEffect.NowTask (onResult >> mapError f)
+
+
+{-| Recover from a failure in a task.
+-}
+onError : (x -> SimulatedTask y a) -> SimulatedTask x a -> SimulatedTask y a
+onError f task =
+    case task of
+        SimulatedEffect.Succeed a ->
+            SimulatedEffect.Succeed a
+
+        SimulatedEffect.Fail x ->
+            f x
+
+        SimulatedEffect.HttpTask request ->
+            SimulatedEffect.HttpTask
+                { method = request.method
+                , url = request.url
+                , body = request.body
+                , headers = request.headers
+                , onRequestComplete = request.onRequestComplete >> onError f
+                }
+
+        SimulatedEffect.SleepTask delay onResult ->
+            SimulatedEffect.SleepTask delay (onResult >> onError f)
+
+        SimulatedEffect.NowTask onResult ->
+            SimulatedEffect.NowTask (onResult >> onError f)

package/src/SimulatedEffect/Time.elm

@@ -0,0 +1,25 @@
+module SimulatedEffect.Time exposing (now)
+
+{-| This module parallels [elm/time's `Time` module](https://package.elm-lang.org/packages/elm/time/1.0.0/Time).
+_Pull requests are welcome to add any functions that are missing._
+
+The functions here produce `SimulatedEffect`s instead of `Cmd`s, which are meant to be used
+to help you implement the function to provide when using [`ProgramTest.withSimulatedEffects`](ProgramTest#withSimulatedEffects).
+
+
+# Time
+
+@docs now
+
+-}
+
+import ProgramTest exposing (SimulatedTask)
+import SimulatedEffect
+import Time
+
+
+{-| Get the POSIX time at the moment when this task is run.
+-}
+now : SimulatedTask x Time.Posix
+now =
+    SimulatedEffect.NowTask SimulatedEffect.Succeed

package/src/SimulatedEffect.elm

@@ -0,0 +1,42 @@
+module SimulatedEffect exposing (HttpRequest, SimulatedEffect(..), SimulatedSub(..), SimulatedTask(..))
+
+import Http
+import Json.Decode
+import Json.Encode
+import Time
+
+
+type SimulatedEffect msg
+    = None
+    | Batch (List (SimulatedEffect msg))
+    | Task (SimulatedTask msg msg)
+    | PortEffect String Json.Encode.Value
+      -- Navigation
+    | PushUrl String
+    | ReplaceUrl String
+    | Back Int
+    | Load String
+    | Reload Bool
+
+
+type SimulatedTask x a
+    = Succeed a
+    | Fail x
+    | HttpTask (HttpRequest x a)
+    | SleepTask Float (() -> SimulatedTask x a)
+    | NowTask (Time.Posix -> SimulatedTask x a)
+
+
+type alias HttpRequest x a =
+    { method : String
+    , url : String
+    , body : String
+    , headers : List ( String, String )
+    , onRequestComplete : Http.Response String -> SimulatedTask x a
+    }
+
+
+type SimulatedSub msg
+    = NoneSub
+    | BatchSub (List (SimulatedSub msg))
+    | PortSub String (Json.Decode.Decoder msg)

package/src/String/Extra.elm

@@ -0,0 +1,6 @@
+module String.Extra exposing (escape)
+
+
+escape : String -> String
+escape s =
+    "\"" ++ s ++ "\""

package/src/Test/Http.elm

@@ -0,0 +1,145 @@
+module Test.Http exposing
+    ( expectJsonBody, HttpRequest, hasHeader
+    , timeout, networkError, httpResponse
+    )
+
+{-| Convenience functions for testing HTTP requests.
+_Pull requests are welcome to add more useful functions._
+
+
+## Expectations
+
+These functions provide some convenient checks that can be used with [`ProgramTest.expectHttpRequest`](ProgramTest#expectHttpRequest).
+
+@docs expectJsonBody, HttpRequest, hasHeader
+
+
+## Responses
+
+These are ways to easily make `Http.Response` values for use with [`ProgramTest.simulateHttpResponse`](ProgramTest#simulateHttpResponse).
+
+@docs timeout, networkError, httpResponse
+
+-}
+
+import Dict exposing (Dict)
+import Expect exposing (Expectation)
+import Http
+import Json.Decode
+import SimulatedEffect exposing (SimulatedTask)
+
+
+{-| -}
+type alias HttpRequest x a =
+    { method : String
+    , url : String
+    , body : String
+    , headers : List ( String, String )
+    , onRequestComplete : Http.Response String -> SimulatedTask x a
+    }
+
+
+{-| A convenient way to check something about the request body of a pending HTTP request.
+
+    ...
+        |> ProgramTest.expectHttpRequest "POST"
+            "https://example.com/ok"
+            (Test.Http.expectJsonBody
+                (Json.Decode.field "version" Json.Decode.string)
+                (Expect.equal "3.1.5")
+            )
+
+-}
+expectJsonBody :
+    Json.Decode.Decoder requestBody
+    -> (requestBody -> Expectation)
+    -> HttpRequest x a
+    -> Expectation
+expectJsonBody decoder check request =
+    case Json.Decode.decodeString decoder request.body of
+        Err err ->
+            Expect.fail ("expectJsonBody: Failed to decode HTTP request body: " ++ Json.Decode.errorToString err)
+
+        Ok responseBody ->
+            check responseBody
+
+
+{-| Assert that the given HTTP request has the specified header.
+
+    ...
+        |> ProgramTest.expectHttpRequest "POST"
+            "https://example.com/ok"
+            (Test.Http.hasHeader "Content-Type" "application/json")
+
+-}
+hasHeader : String -> String -> HttpRequest x a -> Expectation
+hasHeader key value { headers } =
+    let
+        key_ =
+            String.toLower key
+
+        value_ =
+            String.toLower value
+
+        matches ( k, v ) =
+            ( String.toLower k, String.toLower v )
+                == ( key_, value_ )
+    in
+    if List.any matches headers then
+        Expect.pass
+
+    else
+        Expect.fail <|
+            String.join "\n"
+                [ "Expected HTTP header " ++ key ++ ": " ++ value
+                , "but got headers:"
+                , List.map (\( k, v ) -> "    " ++ k ++ ": " ++ v) headers
+                    |> String.join "\n"
+                ]
+
+
+{-| This is the same as `Http.Timeout_`,
+but is exposed here so that your test doesn't need to import both `Http` and `Test.Http`.
+-}
+timeout : Http.Response body
+timeout =
+    Http.Timeout_
+
+
+{-| This is the same as `Http.NetworkError_`,
+but is exposed here so that your test doesn't need to import both `Http` and `Test.Http`.
+-}
+networkError : Http.Response body
+networkError =
+    Http.NetworkError_
+
+
+{-| This is a more convenient way to create `Http.BadStatus_` and `Http.GoodStatus_` values.
+
+Following the [logic in elm/http](https://github.com/elm/http/blob/2.0.0/src/Elm/Kernel/Http.js#L65),
+this will produce `Http.GoodStatus_` if the given status code is in the 200 series, otherwise
+it will produce `Http.BadStatus_`.
+
+-}
+httpResponse :
+    { statusCode : Int
+    , headers : List ( String, String )
+    , body : body
+    }
+    -> Http.Response body
+httpResponse response =
+    let
+        variant =
+            if response.statusCode >= 200 && response.statusCode < 300 then
+                Http.GoodStatus_
+
+            else
+                Http.BadStatus_
+    in
+    variant
+        { url = ""
+        , statusCode = response.statusCode
+        , statusText = "TODO: if you need this, please report to https://github.com/avh4/elm-program-test/issues"
+        , headers = Dict.fromList response.headers
+        }
+        response.body

package/src/TestResult.elm

@@ -0,0 +1,35 @@
+module TestResult exposing (TestResult, andThen, fail)
+
+import ProgramTest.Failure exposing (Failure)
+import TestState exposing (TestState)
+
+
+{-| TODO: what's a better name?
+-}
+type alias TestResult model msg effect =
+    Result
+        { reason : Failure
+        }
+        (TestState model msg effect)
+
+
+fail : Failure -> TestState model msg effect -> TestResult model msg effect
+fail failure state =
+    Err
+        { reason = failure
+        }
+
+
+andThen : (TestState model msg effect -> Result Failure (TestState model msg effect)) -> TestResult model msg effect -> TestResult model msg effect
+andThen f testResult =
+    case testResult of
+        Ok state ->
+            case f state of
+                Err failure ->
+                    fail failure state
+
+                Ok newState ->
+                    Ok newState
+
+        Err _ ->
+            testResult