Move stuff
This commit is contained in:
4
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/.gitignore
vendored
Normal file
4
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/.gitignore
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
# elm-package generated files
|
||||
elm-stuff/
|
||||
# elm-repl generated files
|
||||
repl-temp-*
|
||||
27
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/LICENSE
vendored
Normal file
27
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/LICENSE
vendored
Normal file
@@ -0,0 +1,27 @@
|
||||
Copyright (c) 2016, NoRedInk
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of elm-decode-pipeline nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
108
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/README.md
vendored
Normal file
108
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/README.md
vendored
Normal file
@@ -0,0 +1,108 @@
|
||||
# elm-decode-pipeline
|
||||
|
||||
A library for building decoders using the pipeline [`(|>)`](http://package.elm-lang.org/packages/elm-lang/core/3.0.0/Basics#|>)
|
||||
operator and plain function calls.
|
||||
|
||||
## Motivation
|
||||
|
||||
It's common to decode into a record that has a `type alias`. Here's an example
|
||||
of this from the [`object3`](http://package.elm-lang.org/packages/elm-lang/core/3.0.0/Json-Decode#object3)
|
||||
docs:
|
||||
|
||||
```elm
|
||||
type alias Job = { name : String, id : Int, completed : Bool }
|
||||
|
||||
point : Decoder Job
|
||||
point =
|
||||
object3 Job
|
||||
("name" := string)
|
||||
("id" := int)
|
||||
("completed" := bool)
|
||||
```
|
||||
|
||||
This works because a record type alias can be called as a normal function. In
|
||||
that case it accepts one argument for each field (in whatever order the fields
|
||||
are declared in the type alias) and then returns an appropriate record built
|
||||
with those arguments.
|
||||
|
||||
The `objectN` decoders are straightforward, but require manually changing N
|
||||
whenever the field count changes. This library provides functions designed to
|
||||
be used with the `|>` operator, with the goal of having decoders that are both
|
||||
easy to read and easy to modify.
|
||||
|
||||
## Examples
|
||||
|
||||
Here is a decoder built with this library.
|
||||
|
||||
```elm
|
||||
import Json.Decode exposing (int, string, float, Decoder)
|
||||
import Json.Decode.Pipeline exposing (decode, required, optional, hardcoded)
|
||||
|
||||
|
||||
type alias User =
|
||||
{ id : Int
|
||||
, email : Maybe String
|
||||
, name : String
|
||||
, percentExcited : Float
|
||||
}
|
||||
|
||||
|
||||
userDecoder : Decoder User
|
||||
userDecoder =
|
||||
decode User
|
||||
|> required "id" int
|
||||
|> required "email" (nullable string) -- `null` decodes to `Nothing`
|
||||
|> optional "name" string "(fallback if name is `null` or not present)"
|
||||
|> hardcoded 1.0
|
||||
```
|
||||
|
||||
In this example:
|
||||
|
||||
* `decode` is a synonym for [`succeed`](http://package.elm-lang.org/packages/elm-lang/core/3.0.0/Json-Decode#succeed) (it just reads better here)
|
||||
* `required "id" int` is similar to `("id" := int)`
|
||||
* `optional` is like `required`, but if the field is either `null` or not present, decoding does not fail; instead it succeeds with the provided fallback value.
|
||||
* `hardcoded` does not look at the provided JSON, and instead always decodes to the same value.
|
||||
|
||||
You could use this decoder as follows:
|
||||
|
||||
```elm
|
||||
Json.Decode.decodeString
|
||||
userDecoder
|
||||
"""
|
||||
{"id": 123, "email": "sam@example.com", "name": "Sam Sample"}
|
||||
"""
|
||||
```
|
||||
|
||||
The result would be:
|
||||
|
||||
```elm
|
||||
{ id = 123
|
||||
, email = "sam@example.com"
|
||||
, name = "Sam Sample"
|
||||
, percentExcited = 1.0
|
||||
}
|
||||
```
|
||||
|
||||
Alternatively, you could use it like so:
|
||||
|
||||
```elm
|
||||
Json.Decode.decodeString
|
||||
userDecoder
|
||||
"""
|
||||
{"id": 123, "email": "sam@example.com", "percentExcited": "(hardcoded)"}
|
||||
"""
|
||||
```
|
||||
|
||||
In this case, the result would be:
|
||||
|
||||
```elm
|
||||
{ id = 123
|
||||
, email = "sam@example.com"
|
||||
, name = "(fallback if name not present)"
|
||||
, percentExcited = 1.0
|
||||
}
|
||||
```
|
||||
|
||||
---
|
||||
[][team]
|
||||
[team]: http://noredink.com/about/team
|
||||
16
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/elm-package.json
vendored
Normal file
16
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/elm-package.json
vendored
Normal file
@@ -0,0 +1,16 @@
|
||||
{
|
||||
"version": "3.0.0",
|
||||
"summary": "A pipeline-friendly library for building JSON decoders.",
|
||||
"repository": "https://github.com/NoRedInk/elm-decode-pipeline.git",
|
||||
"license": "BSD-3-Clause",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": [
|
||||
"Json.Decode.Pipeline"
|
||||
],
|
||||
"dependencies": {
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
@@ -0,0 +1,19 @@
|
||||
module Example exposing (..)
|
||||
|
||||
import Json.Decode exposing (int, string, float, Decoder)
|
||||
import Json.Decode.Pipeline exposing (decode, required, optional, hardcoded)
|
||||
|
||||
|
||||
type alias User =
|
||||
{ id : Int
|
||||
, name : String
|
||||
, percentExcited : Float
|
||||
}
|
||||
|
||||
|
||||
userDecoder : Decoder User
|
||||
userDecoder =
|
||||
decode User
|
||||
|> required "id" int
|
||||
|> optional "name" string "(fallback if name not present)"
|
||||
|> hardcoded 1.0
|
||||
@@ -0,0 +1,292 @@
|
||||
module Json.Decode.Pipeline exposing (required, requiredAt, optional, optionalAt, resolve, decode, hardcoded, custom)
|
||||
|
||||
{-| # Json.Decode.Pipeline
|
||||
|
||||
Use the `(|>)` operator to build JSON decoders.
|
||||
|
||||
## Decoding fields
|
||||
|
||||
@docs required, requiredAt, optional, optionalAt, hardcoded, custom
|
||||
|
||||
## Beginning and ending pipelines
|
||||
|
||||
@docs decode, resolve
|
||||
|
||||
-}
|
||||
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
|
||||
|
||||
{-| Decode a required field.
|
||||
|
||||
import Json.Decode exposing (int, string, Decoder)
|
||||
import Decode.Pipeline exposing (decode, required)
|
||||
|
||||
|
||||
type alias User =
|
||||
{ id : Int
|
||||
, name : String
|
||||
, email : String
|
||||
}
|
||||
|
||||
|
||||
userDecoder : Decoder User
|
||||
userDecoder =
|
||||
decode User
|
||||
|> required "id" int
|
||||
|> required "name" string
|
||||
|> required "email" string
|
||||
|
||||
|
||||
result : Result String User
|
||||
result =
|
||||
Decode.decodeString
|
||||
userDecoder
|
||||
"""
|
||||
{"id": 123, "email": "sam@example.com", "name": "Sam"}
|
||||
"""
|
||||
-- Ok { id = 123, name = "Sam", email = "sam@example.com" }
|
||||
-}
|
||||
required : String -> Decoder a -> Decoder (a -> b) -> Decoder b
|
||||
required key valDecoder decoder =
|
||||
custom (Decode.field key valDecoder) decoder
|
||||
|
||||
|
||||
{-| Decode a required nested field.
|
||||
-}
|
||||
requiredAt : List String -> Decoder a -> Decoder (a -> b) -> Decoder b
|
||||
requiredAt path valDecoder decoder =
|
||||
custom (Decode.at path valDecoder) decoder
|
||||
|
||||
|
||||
{-| Decode a field that may be missing or have a null value. If the field is
|
||||
missing, then it decodes as the `fallback` value. If the field is present,
|
||||
then `valDecoder` is used to decode its value. If `valDecoder` fails on a
|
||||
`null` value, then the `fallback` is used as if the field were missing
|
||||
entirely.
|
||||
|
||||
import Json.Decode exposing (int, string, null, oneOf, Decoder)
|
||||
import Decode.Pipeline exposing (decode, required, optional)
|
||||
|
||||
|
||||
type alias User =
|
||||
{ id : Int
|
||||
, name : String
|
||||
, email : String
|
||||
}
|
||||
|
||||
|
||||
userDecoder : Decoder User
|
||||
userDecoder =
|
||||
decode User
|
||||
|> required "id" int
|
||||
|> optional "name" string "blah"
|
||||
|> required "email" string
|
||||
|
||||
|
||||
result : Result String User
|
||||
result =
|
||||
Decode.decodeString
|
||||
userDecoder
|
||||
"""
|
||||
{"id": 123, "email": "sam@example.com" }
|
||||
"""
|
||||
-- Ok { id = 123, name = "blah", email = "sam@example.com" }
|
||||
|
||||
Because `valDecoder` is given an opportunity to decode `null` values before
|
||||
resorting to the `fallback`, you can distinguish between missing and `null`
|
||||
values if you need to:
|
||||
|
||||
userDecoder2 =
|
||||
decode User
|
||||
|> required "id" int
|
||||
|> optional "name" (oneOf [ string, null "NULL" ]) "MISSING"
|
||||
|> required "email" string
|
||||
|
||||
-}
|
||||
optional : String -> Decoder a -> a -> Decoder (a -> b) -> Decoder b
|
||||
optional key valDecoder fallback decoder =
|
||||
custom (optionalDecoder (Decode.field key Decode.value) valDecoder fallback) decoder
|
||||
|
||||
|
||||
{-| Decode an optional nested field.
|
||||
-}
|
||||
optionalAt : List String -> Decoder a -> a -> Decoder (a -> b) -> Decoder b
|
||||
optionalAt path valDecoder fallback decoder =
|
||||
custom (optionalDecoder (Decode.at path Decode.value) valDecoder fallback) decoder
|
||||
|
||||
|
||||
optionalDecoder : Decoder Decode.Value -> Decoder a -> a -> Decoder a
|
||||
optionalDecoder pathDecoder valDecoder fallback =
|
||||
let
|
||||
nullOr decoder =
|
||||
Decode.oneOf [ decoder, Decode.null fallback ]
|
||||
|
||||
handleResult input =
|
||||
case Decode.decodeValue pathDecoder input of
|
||||
Ok rawValue ->
|
||||
-- The field was present, so now let's try to decode that value.
|
||||
-- (If it was present but fails to decode, this should and will fail!)
|
||||
case Decode.decodeValue (nullOr valDecoder) rawValue of
|
||||
Ok finalResult ->
|
||||
Decode.succeed finalResult
|
||||
|
||||
Err finalErr ->
|
||||
Decode.fail finalErr
|
||||
|
||||
Err _ ->
|
||||
-- The field was not present, so use the fallback.
|
||||
Decode.succeed fallback
|
||||
in
|
||||
Decode.value
|
||||
|> Decode.andThen handleResult
|
||||
|
||||
|
||||
{-| Rather than decoding anything, use a fixed value for the next step in the
|
||||
pipeline. `harcoded` does not look at the JSON at all.
|
||||
|
||||
import Json.Decode exposing (int, string, Decoder)
|
||||
import Decode.Pipeline exposing (decode, required)
|
||||
|
||||
|
||||
type alias User =
|
||||
{ id : Int
|
||||
, email : String
|
||||
, followers : Int
|
||||
}
|
||||
|
||||
|
||||
userDecoder : Decoder User
|
||||
userDecoder =
|
||||
decode User
|
||||
|> required "id" int
|
||||
|> required "email" string
|
||||
|> hardcoded 0
|
||||
|
||||
|
||||
result : Result String User
|
||||
result =
|
||||
Decode.decodeString
|
||||
userDecoder
|
||||
"""
|
||||
{"id": 123, "email": "sam@example.com"}
|
||||
"""
|
||||
-- Ok { id = 123, email = "sam@example.com", followers = 0 }
|
||||
-}
|
||||
hardcoded : a -> Decoder (a -> b) -> Decoder b
|
||||
hardcoded =
|
||||
Decode.succeed >> custom
|
||||
|
||||
|
||||
{-| Run the given decoder and feed its result into the pipeline at this point.
|
||||
|
||||
Consider this example.
|
||||
|
||||
import Json.Decode exposing (int, string, at, Decoder)
|
||||
import Decode.Pipeline exposing (decode, required, custom)
|
||||
|
||||
|
||||
type alias User =
|
||||
{ id : Int
|
||||
, name : String
|
||||
, email : String
|
||||
}
|
||||
|
||||
|
||||
userDecoder : Decoder User
|
||||
userDecoder =
|
||||
decode User
|
||||
|> required "id" int
|
||||
|> custom (at [ "profile", "name" ] string)
|
||||
|> required "email" string
|
||||
|
||||
|
||||
result : Result String User
|
||||
result =
|
||||
Decode.decodeString
|
||||
userDecoder
|
||||
"""
|
||||
{
|
||||
"id": 123,
|
||||
"email": "sam@example.com",
|
||||
"profile": {"name": "Sam"}
|
||||
}
|
||||
"""
|
||||
-- Ok { id = 123, name = "Sam", email = "sam@example.com" }
|
||||
-}
|
||||
custom : Decoder a -> Decoder (a -> b) -> Decoder b
|
||||
custom =
|
||||
Decode.map2 (|>)
|
||||
|
||||
|
||||
{-| Convert a `Decoder (Result x a)` into a `Decoder a`. Useful when you want
|
||||
to perform some custom processing just before completing the decoding operation.
|
||||
|
||||
import Json.Decode exposing (int, string, float, Decoder)
|
||||
import Decode.Pipeline exposing
|
||||
(decode, required, resolve)
|
||||
|
||||
|
||||
type alias User =
|
||||
{ id : Int
|
||||
, email : String
|
||||
}
|
||||
|
||||
|
||||
userDecoder : Decoder User
|
||||
userDecoder =
|
||||
let
|
||||
-- toDecoder gets run *after* all the
|
||||
-- (|> required ...) steps are done.
|
||||
toDecoder : Int -> String -> Int -> Decoder User
|
||||
toDecoder id email version =
|
||||
if version > 2 then
|
||||
succeed (User id email)
|
||||
else
|
||||
fail "This JSON is from a deprecated source. Please upgrade!"
|
||||
in
|
||||
decode toDecoder
|
||||
|> required "id" int
|
||||
|> required "email" string
|
||||
|> required "version" int -- version is part of toDecoder,
|
||||
|> resolve -- but it is not a part of User
|
||||
|
||||
|
||||
result : Result String User
|
||||
result =
|
||||
Decode.decodeString
|
||||
userDecoder
|
||||
"""
|
||||
{"id": 123, "email": "sam@example.com", "version": 1}
|
||||
"""
|
||||
-- Err "This JSON is from a deprecated source. Please upgrade!"
|
||||
-}
|
||||
resolve : Decoder (Decoder a) -> Decoder a
|
||||
resolve =
|
||||
Decode.andThen identity
|
||||
|
||||
|
||||
{-| Begin a decoding pipeline. This is a synonym for [Json.Decode.succeed](http://package.elm-lang.org/packages/elm-lang/core/latest/Json-Decode#succeed),
|
||||
intended to make things read more clearly.
|
||||
|
||||
import Json.Decode exposing (int, string, float, Decoder)
|
||||
import Json.Decode.Pipeline exposing (decode, required, optional)
|
||||
|
||||
|
||||
type alias User =
|
||||
{ id : Int
|
||||
, email : String
|
||||
, name : String
|
||||
}
|
||||
|
||||
|
||||
userDecoder : Decoder User
|
||||
userDecoder =
|
||||
decode User
|
||||
|> required "id" int
|
||||
|> required "email" string
|
||||
|> optional "name" string ""
|
||||
-}
|
||||
decode : a -> Decoder a
|
||||
decode =
|
||||
Decode.succeed
|
||||
@@ -0,0 +1 @@
|
||||
/elm-stuff/
|
||||
19
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/tests/Main.elm
vendored
Normal file
19
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/tests/Main.elm
vendored
Normal file
@@ -0,0 +1,19 @@
|
||||
port module Main exposing (..)
|
||||
|
||||
{-|
|
||||
Run the tests with node-test-runner:
|
||||
|
||||
https://github.com/rtfeldman/node-test-runner
|
||||
-}
|
||||
|
||||
import Tests
|
||||
import Test.Runner.Node exposing (run)
|
||||
import Json.Encode exposing (Value)
|
||||
|
||||
|
||||
main : Program Never
|
||||
main =
|
||||
run emit Tests.all
|
||||
|
||||
|
||||
port emit : ( String, Value ) -> Cmd msg
|
||||
114
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/tests/Tests.elm
vendored
Normal file
114
intro-to-elm/part7/tests/elm-stuff/packages/NoRedInk/elm-decode-pipeline/3.0.0/tests/Tests.elm
vendored
Normal file
@@ -0,0 +1,114 @@
|
||||
module Tests exposing (..)
|
||||
|
||||
import Test exposing (..)
|
||||
import Expect exposing (Expectation)
|
||||
import Json.Decode.Pipeline
|
||||
exposing
|
||||
( decode
|
||||
, required
|
||||
, requiredAt
|
||||
, optional
|
||||
, optionalAt
|
||||
, resolveResult
|
||||
)
|
||||
import Json.Decode exposing (Decoder, string, null)
|
||||
|
||||
|
||||
{-| Run some JSON through a Decoder and return the result.
|
||||
-}
|
||||
runWith : String -> Decoder a -> Result String a
|
||||
runWith =
|
||||
flip Json.Decode.decodeString
|
||||
|
||||
|
||||
isError : Result err ok -> Bool
|
||||
isError result =
|
||||
case result of
|
||||
Err _ ->
|
||||
True
|
||||
|
||||
Ok _ ->
|
||||
False
|
||||
|
||||
|
||||
expectErr : Result err ok -> Expectation
|
||||
expectErr result =
|
||||
isError result
|
||||
|> Expect.true ("Expected an Err but got " ++ toString result)
|
||||
|
||||
|
||||
all : Test
|
||||
all =
|
||||
describe
|
||||
"Json.Decode.Pipeline"
|
||||
[ test "should decode basic example" <|
|
||||
\() ->
|
||||
decode (,)
|
||||
|> required "a" string
|
||||
|> required "b" string
|
||||
|> runWith """{"a":"foo","b":"bar"}"""
|
||||
|> Expect.equal (Ok ( "foo", "bar" ))
|
||||
, test "should decode requiredAt fields" <|
|
||||
\() ->
|
||||
decode (,)
|
||||
|> requiredAt [ "a" ] string
|
||||
|> requiredAt [ "b", "c" ] string
|
||||
|> runWith """{"a":"foo","b":{"c":"bar"}}"""
|
||||
|> Expect.equal (Ok ( "foo", "bar" ))
|
||||
, test "should decode optionalAt fields" <|
|
||||
\() ->
|
||||
decode (,)
|
||||
|> optionalAt [ "a", "b" ] string "--"
|
||||
|> optionalAt [ "x", "y" ] string "--"
|
||||
|> runWith """{"a":{},"x":{"y":"bar"}}"""
|
||||
|> Expect.equal (Ok ( "--", "bar" ))
|
||||
, test "optional succeeds if the field is not present" <|
|
||||
\() ->
|
||||
decode (,)
|
||||
|> optional "a" string "--"
|
||||
|> optional "x" string "--"
|
||||
|> runWith """{"x":"five"}"""
|
||||
|> Expect.equal (Ok ( "--", "five" ))
|
||||
, test "optional succeeds with fallback if the field is present but null" <|
|
||||
\() ->
|
||||
decode (,)
|
||||
|> optional "a" string "--"
|
||||
|> optional "x" string "--"
|
||||
|> runWith """{"a":null,"x":"five"}"""
|
||||
|> Expect.equal (Ok ( "--", "five" ))
|
||||
, test "optional succeeds with result of the given decoder if the field is null and the decoder decodes nulls" <|
|
||||
\() ->
|
||||
decode (,)
|
||||
|> optional "a" (null "null") "--"
|
||||
|> optional "x" string "--"
|
||||
|> runWith """{"a":null,"x":"five"}"""
|
||||
|> Expect.equal (Ok ( "null", "five" ))
|
||||
, test "optional fails if the field is present but doesn't decode" <|
|
||||
\() ->
|
||||
decode (,)
|
||||
|> optional "a" string "--"
|
||||
|> optional "x" string "--"
|
||||
|> runWith """{"x":5}"""
|
||||
|> expectErr
|
||||
, test "optionalAt fails if the field is present but doesn't decode" <|
|
||||
\() ->
|
||||
decode (,)
|
||||
|> optionalAt [ "a", "b" ] string "--"
|
||||
|> optionalAt [ "x", "y" ] string "--"
|
||||
|> runWith """{"a":{},"x":{"y":5}}"""
|
||||
|> expectErr
|
||||
, test "resolveResult bubbles up decoded Err results" <|
|
||||
\() ->
|
||||
decode Err
|
||||
|> required "error" string
|
||||
|> resolveResult
|
||||
|> runWith """{"error":"invalid"}"""
|
||||
|> expectErr
|
||||
, test "resolveResult bubbles up decoded Ok results" <|
|
||||
\() ->
|
||||
decode Ok
|
||||
|> required "ok" string
|
||||
|> resolveResult
|
||||
|> runWith """{"ok":"valid"}"""
|
||||
|> Expect.equal (Ok "valid")
|
||||
]
|
||||
@@ -0,0 +1,17 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "Sample Elm Test",
|
||||
"repository": "https://github.com/user/project.git",
|
||||
"license": "BSD-3-Clause",
|
||||
"source-directories": [
|
||||
".",
|
||||
"../src"
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"dependencies": {
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-community/elm-test": "2.0.0 <= v < 3.0.0",
|
||||
"rtfeldman/node-test-runner": "1.0.0 <= v < 2.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/.gitignore
vendored
Normal file
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/.gitignore
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
# elm-package generated files
|
||||
elm-stuff/
|
||||
# elm-repl generated files
|
||||
repl-temp-*
|
||||
31
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/.travis.yml
vendored
Normal file
31
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/.travis.yml
vendored
Normal file
@@ -0,0 +1,31 @@
|
||||
sudo: false
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- tests/elm-stuff/build-artifacts
|
||||
|
||||
os:
|
||||
- osx
|
||||
- linux
|
||||
|
||||
env:
|
||||
matrix:
|
||||
- ELM_VERSION=0.18 TARGET_NODE_VERSION=node
|
||||
- ELM_VERSION=0.18 TARGET_NODE_VERSION=4.2
|
||||
|
||||
before_install:
|
||||
- if [ ${TRAVIS_OS_NAME} == "osx" ];
|
||||
then brew update; brew install nvm; mkdir ~/.nvm; export NVM_DIR=~/.nvm; source $(brew --prefix nvm)/nvm.sh;
|
||||
fi
|
||||
|
||||
install:
|
||||
- nvm install $TARGET_NODE_VERSION
|
||||
- nvm use $TARGET_NODE_VERSION
|
||||
- node --version
|
||||
- npm --version
|
||||
- npm install -g elm@$ELM_VERSION
|
||||
- npm install -g elm-test
|
||||
|
||||
|
||||
script:
|
||||
- elm-test
|
||||
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/LICENSE
vendored
Normal file
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/LICENSE
vendored
Normal file
@@ -0,0 +1,29 @@
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2016, Noah
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
9
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/README.md
vendored
Normal file
9
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/README.md
vendored
Normal file
@@ -0,0 +1,9 @@
|
||||
# elm-html-in-elm
|
||||
|
||||
|
||||
A pure Elm represention of Elm Html. This module has been taken from [elm-server-side-renderer](https://github.com/eeue56/elm-server-side-renderer) and is a pure representation of the Html structure used by VirtualDom. It is designed to allow you to inspect Html nodes
|
||||
|
||||
This package is used to support testing with [elm-html-test](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest).
|
||||
|
||||
This package is also used to support using Elm as to generate static files for
|
||||
your site with [elm-static-html](https://github.com/eeue56/elm-static-html)
|
||||
22
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/elm-package.json
vendored
Normal file
22
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/elm-package.json
vendored
Normal file
@@ -0,0 +1,22 @@
|
||||
{
|
||||
"version": "5.2.0",
|
||||
"summary": "A pure Elm representation of Elm Html",
|
||||
"repository": "https://github.com/eeue56/elm-html-in-elm.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": [
|
||||
"ElmHtml.Constants",
|
||||
"ElmHtml.InternalTypes",
|
||||
"ElmHtml.Markdown",
|
||||
"ElmHtml.ToString",
|
||||
"ElmHtml.ToElmString",
|
||||
"ElmHtml.ToHtml"
|
||||
],
|
||||
"dependencies": {
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
@@ -0,0 +1,43 @@
|
||||
module ElmHtml.Constants exposing (..)
|
||||
|
||||
{-|
|
||||
Constants for representing internal keys for Elm's vdom implementation
|
||||
|
||||
@docs styleKey, eventKey, attributeKey, attributeNamespaceKey, knownKeys
|
||||
|
||||
-}
|
||||
|
||||
|
||||
{-| Internal key for style
|
||||
-}
|
||||
styleKey : String
|
||||
styleKey =
|
||||
"STYLE"
|
||||
|
||||
|
||||
{-| Internal key for style
|
||||
-}
|
||||
eventKey : String
|
||||
eventKey =
|
||||
"EVENT"
|
||||
|
||||
|
||||
{-| Internal key for style
|
||||
-}
|
||||
attributeKey : String
|
||||
attributeKey =
|
||||
"ATTR"
|
||||
|
||||
|
||||
{-| Internal key for style
|
||||
-}
|
||||
attributeNamespaceKey : String
|
||||
attributeNamespaceKey =
|
||||
"ATTR_NS"
|
||||
|
||||
|
||||
{-| Keys that we are aware of and should pay attention to
|
||||
-}
|
||||
knownKeys : List String
|
||||
knownKeys =
|
||||
[ styleKey, eventKey, attributeKey, attributeNamespaceKey ]
|
||||
17
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/src/ElmHtml/Helpers.elm
vendored
Normal file
17
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/src/ElmHtml/Helpers.elm
vendored
Normal file
@@ -0,0 +1,17 @@
|
||||
module ElmHtml.Helpers exposing (..)
|
||||
|
||||
{-|
|
||||
Internal helpers for ElmHtml
|
||||
|
||||
@docs filterKnownKeys
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import ElmHtml.Constants exposing (..)
|
||||
|
||||
|
||||
{-| Filter out keys that we don't know
|
||||
-}
|
||||
filterKnownKeys : Dict String a -> Dict String a
|
||||
filterKnownKeys =
|
||||
Dict.filter (\key _ -> not (List.member key knownKeys))
|
||||
@@ -0,0 +1,581 @@
|
||||
module ElmHtml.InternalTypes
|
||||
exposing
|
||||
( Attribute(..)
|
||||
, AttributeRecord
|
||||
, CustomNodeRecord
|
||||
, ElementKind(..)
|
||||
, ElmHtml(..)
|
||||
, EventHandler
|
||||
, EventRecord
|
||||
, Facts
|
||||
, MarkdownNodeRecord
|
||||
, NamespacedAttributeRecord
|
||||
, NodeRecord
|
||||
, PropertyRecord
|
||||
, Tagger
|
||||
, TextTagRecord
|
||||
, decodeAttribute
|
||||
, decodeElmHtml
|
||||
, emptyFacts
|
||||
, toElementKind
|
||||
)
|
||||
|
||||
{-| Internal types used to represent Elm Html in pure Elm
|
||||
|
||||
@docs ElmHtml, TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord
|
||||
|
||||
@docs Facts, Tagger, EventHandler, ElementKind
|
||||
|
||||
@docs Attribute, AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord
|
||||
|
||||
@docs decodeElmHtml, emptyFacts, toElementKind, decodeAttribute
|
||||
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import ElmHtml.Constants exposing (..)
|
||||
import ElmHtml.Helpers exposing (..)
|
||||
import ElmHtml.Markdown exposing (..)
|
||||
import Html.Events
|
||||
import Json.Decode exposing (field)
|
||||
import Json.Encode
|
||||
|
||||
|
||||
{-| Type tree for representing Elm's Html
|
||||
|
||||
- TextTag is just a plain old bit of text.
|
||||
- NodeEntry is an actual HTML node, e.g a div
|
||||
- CustomNode are nodes defined to work with the renderer in some way, e.g webgl/markdown
|
||||
- MarkdownNode is just a wrapper for CustomNode designed just for markdown
|
||||
|
||||
-}
|
||||
type ElmHtml msg
|
||||
= TextTag TextTagRecord
|
||||
| NodeEntry (NodeRecord msg)
|
||||
| CustomNode (CustomNodeRecord msg)
|
||||
| MarkdownNode (MarkdownNodeRecord msg)
|
||||
| NoOp
|
||||
|
||||
|
||||
{-| Text tags just contain text
|
||||
-}
|
||||
type alias TextTagRecord =
|
||||
{ text : String }
|
||||
|
||||
|
||||
{-| A node contains the `tag` as a string, the children, the facts (e.g attributes) and descendantsCount
|
||||
-}
|
||||
type alias NodeRecord msg =
|
||||
{ tag : String
|
||||
, children : List (ElmHtml msg)
|
||||
, facts :
|
||||
Facts msg
|
||||
|
||||
--, namespace : String
|
||||
, descendantsCount : Int
|
||||
}
|
||||
|
||||
|
||||
{-| A markdown node contains facts (e.g attributes) and the model used by markdown
|
||||
-}
|
||||
type alias MarkdownNodeRecord msg =
|
||||
{ facts : Facts msg
|
||||
, model : MarkdownModel
|
||||
}
|
||||
|
||||
|
||||
{-| Custom nodes contain facts (e.g attributes) and a json value for the model
|
||||
-}
|
||||
type alias CustomNodeRecord msg =
|
||||
{ facts : Facts msg
|
||||
, model : Json.Decode.Value
|
||||
}
|
||||
|
||||
|
||||
{-| Tagger holds the map function when Html.Map is used, the tagger
|
||||
should then be applied to events comming from descendant nodes, it
|
||||
is basically a javascript function.
|
||||
-}
|
||||
type alias Tagger =
|
||||
Json.Decode.Value
|
||||
|
||||
|
||||
{-| EventHandler holds the function that is called when an event is
|
||||
triggered, it is basically a javascript object like this:
|
||||
|
||||
{ decoder: [Function] }
|
||||
|
||||
-}
|
||||
type alias EventHandler =
|
||||
Json.Decode.Value
|
||||
|
||||
|
||||
{-| Facts contain various dictionaries and values for a node
|
||||
|
||||
- styles are a mapping of rules
|
||||
- events may be a json object containing event handlers
|
||||
- attributes are pulled out into stringAttributes and boolAttributes - things with string values go into
|
||||
stringAttributes, things with bool values go into boolAttributes
|
||||
|
||||
-}
|
||||
type alias Facts msg =
|
||||
{ styles : Dict String String
|
||||
, events : Dict String (Json.Decode.Decoder msg)
|
||||
, attributeNamespace : Maybe Json.Decode.Value
|
||||
, stringAttributes : Dict String String
|
||||
, boolAttributes : Dict String Bool
|
||||
}
|
||||
|
||||
|
||||
{-| Type for representing the five kinds of elements according to HTML 5
|
||||
[spec](https://html.spec.whatwg.org/multipage/syntax.html#elements-2).
|
||||
Used to handle different rendering behavior depending on the type of element.
|
||||
-}
|
||||
type ElementKind
|
||||
= VoidElements
|
||||
| RawTextElements
|
||||
| EscapableRawTextElements
|
||||
| ForeignElements
|
||||
| NormalElements
|
||||
|
||||
|
||||
type HtmlContext msg
|
||||
= HtmlContext (List Tagger) (List Tagger -> EventHandler -> Json.Decode.Decoder msg)
|
||||
|
||||
|
||||
{-| Type for representing Elm's Attributes
|
||||
|
||||
- Attribute is an HTML attribute, like `Html.Attributes.colspan`. These values
|
||||
are applied using `element.setAttribute(key, value)` during a patch.
|
||||
- NamespacedAttribute has an namespace, like `Svg.Attributes.xlinkHref`
|
||||
- Property assigns a value to a node like `Html.Attributes.class`, and can
|
||||
hold any encoded value. Unlike attributes, where `element.setAttribute()` is
|
||||
used during the patch, properties are applied directly as
|
||||
`element[key] = value`.
|
||||
- Styles hold a list of key value pairs to be applied to the node's style set
|
||||
- Event contains a decoder for a msg and the `Html.Event.Options` for the event
|
||||
|
||||
-}
|
||||
type Attribute
|
||||
= Attribute AttributeRecord
|
||||
| NamespacedAttribute NamespacedAttributeRecord
|
||||
| Property PropertyRecord
|
||||
| Styles (List ( String, String ))
|
||||
| Event EventRecord
|
||||
|
||||
|
||||
{-| Attribute contains a string key and a string value
|
||||
-}
|
||||
type alias AttributeRecord =
|
||||
{ key : String
|
||||
, value : String
|
||||
}
|
||||
|
||||
|
||||
{-| NamespacedAttribute contains a string key, string namespace and string value
|
||||
-}
|
||||
type alias NamespacedAttributeRecord =
|
||||
{ key : String
|
||||
, value : String
|
||||
, namespace : String
|
||||
}
|
||||
|
||||
|
||||
{-| Property contains a string key and a value with an arbitrary type
|
||||
-}
|
||||
type alias PropertyRecord =
|
||||
{ key : String
|
||||
, value : Json.Decode.Value
|
||||
}
|
||||
|
||||
|
||||
{-| Event contains a string key, a decoder for a msg and event options
|
||||
-}
|
||||
type alias EventRecord =
|
||||
{ key : String
|
||||
, decoder : Json.Decode.Value
|
||||
, options : Html.Events.Options
|
||||
}
|
||||
|
||||
|
||||
{-| decode a json object into ElmHtml, you have to pass a function that decodes
|
||||
events from Html Nodes. If you don't want to decode event msgs, you can ignore it:
|
||||
|
||||
decodeElmHtml (\_ _ -> ()) jsonHtml
|
||||
|
||||
if you do want to decode them, you will probably need to write some native code
|
||||
like elm-html-test does to extract the function inside those.
|
||||
|
||||
-}
|
||||
decodeElmHtml : (List Tagger -> EventHandler -> Json.Decode.Decoder msg) -> Json.Decode.Decoder (ElmHtml msg)
|
||||
decodeElmHtml eventDecoder =
|
||||
contextDecodeElmHtml (HtmlContext [] eventDecoder)
|
||||
|
||||
|
||||
contextDecodeElmHtml : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg)
|
||||
contextDecodeElmHtml context =
|
||||
field "type" Json.Decode.string
|
||||
|> Json.Decode.andThen
|
||||
(\typeString ->
|
||||
case typeString of
|
||||
"text" ->
|
||||
Json.Decode.map TextTag decodeTextTag
|
||||
|
||||
"keyed-node" ->
|
||||
Json.Decode.map NodeEntry (decodeKeyedNode context)
|
||||
|
||||
"node" ->
|
||||
Json.Decode.map NodeEntry (decodeNode context)
|
||||
|
||||
"custom" ->
|
||||
decodeCustomNode context
|
||||
|
||||
"tagger" ->
|
||||
decodeTagger context
|
||||
|
||||
"thunk" ->
|
||||
field "node" (contextDecodeElmHtml context)
|
||||
|
||||
_ ->
|
||||
Json.Decode.fail ("No such type as " ++ typeString)
|
||||
)
|
||||
|
||||
|
||||
{-| decode text tag
|
||||
-}
|
||||
decodeTextTag : Json.Decode.Decoder TextTagRecord
|
||||
decodeTextTag =
|
||||
field "text" (Json.Decode.andThen (\text -> Json.Decode.succeed { text = text }) Json.Decode.string)
|
||||
|
||||
|
||||
{-| encode text tag
|
||||
-}
|
||||
encodeTextTag : TextTagRecord -> Json.Encode.Value
|
||||
encodeTextTag { text } =
|
||||
Json.Encode.object [ ( "text", Json.Encode.string text ) ]
|
||||
|
||||
|
||||
{-| decode a tagger
|
||||
-}
|
||||
decodeTagger : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg)
|
||||
decodeTagger (HtmlContext taggers eventDecoder) =
|
||||
Json.Decode.field "tagger" Json.Decode.value
|
||||
|> Json.Decode.andThen
|
||||
(\tagger ->
|
||||
let
|
||||
nodeDecoder =
|
||||
contextDecodeElmHtml (HtmlContext (taggers ++ [ tagger ]) eventDecoder)
|
||||
in
|
||||
Json.Decode.oneOf
|
||||
[ Json.Decode.at [ "node" ] nodeDecoder
|
||||
, Json.Decode.at [ "text" ] nodeDecoder
|
||||
, Json.Decode.at [ "custom" ] nodeDecoder
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
decodeKeyedNode : HtmlContext msg -> Json.Decode.Decoder (NodeRecord msg)
|
||||
decodeKeyedNode context =
|
||||
let
|
||||
-- elm stores keyed nodes as tuples
|
||||
-- we only want to decode the html, in the second property
|
||||
decodeSecondNode =
|
||||
Json.Decode.field "_1" (contextDecodeElmHtml context)
|
||||
in
|
||||
Json.Decode.map4 NodeRecord
|
||||
(Json.Decode.field "tag" Json.Decode.string)
|
||||
(Json.Decode.field "children" (Json.Decode.list decodeSecondNode))
|
||||
(Json.Decode.field "facts" (decodeFacts context))
|
||||
(Json.Decode.field "descendantsCount" Json.Decode.int)
|
||||
|
||||
|
||||
{-| decode a node record
|
||||
-}
|
||||
decodeNode : HtmlContext msg -> Json.Decode.Decoder (NodeRecord msg)
|
||||
decodeNode context =
|
||||
Json.Decode.map4 NodeRecord
|
||||
(field "tag" Json.Decode.string)
|
||||
(field "children" (Json.Decode.list (contextDecodeElmHtml context)))
|
||||
(field "facts" (decodeFacts context))
|
||||
(field "descendantsCount" Json.Decode.int)
|
||||
|
||||
|
||||
{-| encode a node record: currently does not support facts or children
|
||||
-}
|
||||
encodeNodeRecord : NodeRecord msg -> Json.Encode.Value
|
||||
encodeNodeRecord record =
|
||||
Json.Encode.object
|
||||
[ ( "tag", Json.Encode.string record.tag )
|
||||
|
||||
--, ( "children", Json.Encode.list encodeElmHtml)
|
||||
--, ( "facts", encodeFacts)
|
||||
, ( "descendantsCount", Json.Encode.int record.descendantsCount )
|
||||
]
|
||||
|
||||
|
||||
{-| decode custom node into either markdown or custom
|
||||
-}
|
||||
decodeCustomNode : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg)
|
||||
decodeCustomNode context =
|
||||
Json.Decode.oneOf
|
||||
[ Json.Decode.map MarkdownNode (decodeMarkdownNodeRecord context)
|
||||
, Json.Decode.map CustomNode (decodeCustomNodeRecord context)
|
||||
]
|
||||
|
||||
|
||||
{-| decode custom node record
|
||||
-}
|
||||
decodeCustomNodeRecord : HtmlContext msg -> Json.Decode.Decoder (CustomNodeRecord msg)
|
||||
decodeCustomNodeRecord context =
|
||||
Json.Decode.map2 CustomNodeRecord
|
||||
(field "facts" (decodeFacts context))
|
||||
(field "model" Json.Decode.value)
|
||||
|
||||
|
||||
{-| decode markdown node record
|
||||
-}
|
||||
decodeMarkdownNodeRecord : HtmlContext msg -> Json.Decode.Decoder (MarkdownNodeRecord msg)
|
||||
decodeMarkdownNodeRecord context =
|
||||
Json.Decode.map2 MarkdownNodeRecord
|
||||
(field "facts" (decodeFacts context))
|
||||
(field "model" decodeMarkdownModel)
|
||||
|
||||
|
||||
{-| decode the styles
|
||||
-}
|
||||
decodeStyles : Json.Decode.Decoder (Dict String String)
|
||||
decodeStyles =
|
||||
Json.Decode.oneOf
|
||||
[ field styleKey (Json.Decode.dict Json.Decode.string)
|
||||
, Json.Decode.succeed Dict.empty
|
||||
]
|
||||
|
||||
|
||||
{-| encode styles
|
||||
-}
|
||||
encodeStyles : Dict String String -> Json.Encode.Value
|
||||
encodeStyles stylesDict =
|
||||
let
|
||||
encodedDict =
|
||||
stylesDict
|
||||
|> Dict.toList
|
||||
|> List.map (\( k, v ) -> ( k, Json.Encode.string v ))
|
||||
in
|
||||
Json.Encode.object [ ( styleKey, Json.Encode.object encodedDict ) ]
|
||||
|
||||
|
||||
{-| grab things from attributes via a decoder, then anything that isn't filtered on
|
||||
the object
|
||||
-}
|
||||
decodeOthers : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a)
|
||||
decodeOthers otherDecoder =
|
||||
decodeAttributes otherDecoder
|
||||
|> Json.Decode.andThen
|
||||
(\attributes ->
|
||||
decodeDictFilterMap otherDecoder
|
||||
|> Json.Decode.map (filterKnownKeys >> Dict.union attributes)
|
||||
)
|
||||
|
||||
|
||||
{-| For a given decoder, keep the values from a dict that pass the decoder
|
||||
-}
|
||||
decodeDictFilterMap : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a)
|
||||
decodeDictFilterMap decoder =
|
||||
Json.Decode.dict Json.Decode.value
|
||||
|> Json.Decode.map
|
||||
(Dict.toList
|
||||
>> List.filterMap
|
||||
(\( key, value ) ->
|
||||
case Json.Decode.decodeValue decoder value of
|
||||
Err _ ->
|
||||
Nothing
|
||||
|
||||
Ok v ->
|
||||
Just ( key, v )
|
||||
)
|
||||
>> Dict.fromList
|
||||
)
|
||||
|
||||
|
||||
decodeAttributes : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a)
|
||||
decodeAttributes decoder =
|
||||
Json.Decode.oneOf
|
||||
[ Json.Decode.field attributeKey (decodeDictFilterMap decoder)
|
||||
, Json.Decode.succeed Dict.empty
|
||||
]
|
||||
|
||||
|
||||
decodeEvents : (EventHandler -> Json.Decode.Decoder msg) -> Json.Decode.Decoder (Dict String (Json.Decode.Decoder msg))
|
||||
decodeEvents taggedEventDecoder =
|
||||
Json.Decode.oneOf
|
||||
[ Json.Decode.field eventKey (Json.Decode.dict (Json.Decode.map taggedEventDecoder Json.Decode.value))
|
||||
, Json.Decode.succeed Dict.empty
|
||||
]
|
||||
|
||||
|
||||
{-| decode fact
|
||||
-}
|
||||
decodeFacts : HtmlContext msg -> Json.Decode.Decoder (Facts msg)
|
||||
decodeFacts (HtmlContext taggers eventDecoder) =
|
||||
Json.Decode.map5 Facts
|
||||
decodeStyles
|
||||
(decodeEvents (eventDecoder taggers))
|
||||
(Json.Decode.maybe (Json.Decode.field attributeNamespaceKey Json.Decode.value))
|
||||
(decodeOthers Json.Decode.string)
|
||||
(decodeOthers Json.Decode.bool)
|
||||
|
||||
|
||||
{-| Just empty facts
|
||||
-}
|
||||
emptyFacts : Facts msg
|
||||
emptyFacts =
|
||||
{ styles = Dict.empty
|
||||
, events = Dict.empty
|
||||
, attributeNamespace = Nothing
|
||||
, stringAttributes = Dict.empty
|
||||
, boolAttributes = Dict.empty
|
||||
}
|
||||
|
||||
|
||||
{-| Decode a JSON object into an Attribute. You have to pass a function that
|
||||
decodes events from event attributes. If you don't want to decode event msgs,
|
||||
you can ignore it:
|
||||
|
||||
decodeAttribute (\_ -> ()) jsonHtml
|
||||
|
||||
If you do want to decode them, you will probably need to write some native code
|
||||
like elm-html-test does to extract the function inside those.
|
||||
|
||||
-}
|
||||
decodeAttribute : Json.Decode.Decoder Attribute
|
||||
decodeAttribute =
|
||||
Json.Decode.field "key" Json.Decode.string
|
||||
|> Json.Decode.andThen
|
||||
(\key ->
|
||||
if key == attributeKey then
|
||||
Json.Decode.map2 AttributeRecord
|
||||
(Json.Decode.field "realKey" Json.Decode.string)
|
||||
(Json.Decode.field "value" Json.Decode.string)
|
||||
|> Json.Decode.map Attribute
|
||||
else if key == attributeNamespaceKey then
|
||||
Json.Decode.map3 NamespacedAttributeRecord
|
||||
(Json.Decode.field "realKey" Json.Decode.string)
|
||||
(Json.Decode.at [ "value", "value" ] Json.Decode.string)
|
||||
(Json.Decode.at [ "value", "namespace" ] Json.Decode.string)
|
||||
|> Json.Decode.map NamespacedAttribute
|
||||
else if key == styleKey then
|
||||
Json.Decode.map2 (,)
|
||||
(Json.Decode.field "_0" Json.Decode.string)
|
||||
(Json.Decode.field "_1" Json.Decode.string)
|
||||
|> elmListDecoder
|
||||
|> Json.Decode.field "value"
|
||||
|> Json.Decode.map Styles
|
||||
else if key == eventKey then
|
||||
Json.Decode.map3 EventRecord
|
||||
(Json.Decode.field "realKey" Json.Decode.string)
|
||||
(Json.Decode.at [ "value", "decoder" ] Json.Decode.value)
|
||||
(Json.Decode.at [ "value", "options" ] decodeOptions)
|
||||
|> Json.Decode.map Event
|
||||
else
|
||||
Json.Decode.field "value" Json.Decode.value
|
||||
|> Json.Decode.map (PropertyRecord key >> Property)
|
||||
)
|
||||
|
||||
|
||||
decodeOptions : Json.Decode.Decoder Html.Events.Options
|
||||
decodeOptions =
|
||||
Json.Decode.map2 Html.Events.Options
|
||||
(Json.Decode.field "stopPropagation" Json.Decode.bool)
|
||||
(Json.Decode.field "preventDefault" Json.Decode.bool)
|
||||
|
||||
|
||||
elmListDecoder : Json.Decode.Decoder a -> Json.Decode.Decoder (List a)
|
||||
elmListDecoder itemDecoder =
|
||||
elmListDecoderHelp itemDecoder []
|
||||
|> Json.Decode.map List.reverse
|
||||
|
||||
|
||||
elmListDecoderHelp : Json.Decode.Decoder a -> List a -> Json.Decode.Decoder (List a)
|
||||
elmListDecoderHelp itemDecoder items =
|
||||
Json.Decode.field "ctor" Json.Decode.string
|
||||
|> Json.Decode.andThen
|
||||
(\ctor ->
|
||||
case ctor of
|
||||
"[]" ->
|
||||
Json.Decode.succeed items
|
||||
|
||||
"::" ->
|
||||
Json.Decode.field "_0" itemDecoder
|
||||
|> Json.Decode.andThen
|
||||
(\value ->
|
||||
Json.Decode.field "_1" (elmListDecoderHelp itemDecoder (value :: items))
|
||||
)
|
||||
|
||||
_ ->
|
||||
Json.Decode.fail <| "Unrecognized constructor for an Elm List: " ++ ctor
|
||||
)
|
||||
|
||||
|
||||
{-| A list of Void elements as defined by the HTML5 specification. These
|
||||
elements must not have closing tags and most not be written as self closing
|
||||
either
|
||||
-}
|
||||
voidElements : List String
|
||||
voidElements =
|
||||
[ "area"
|
||||
, "base"
|
||||
, "br"
|
||||
, "col"
|
||||
, "embed"
|
||||
, "hr"
|
||||
, "img"
|
||||
, "input"
|
||||
, "link"
|
||||
, "meta"
|
||||
, "param"
|
||||
, "source"
|
||||
, "track"
|
||||
, "wbr"
|
||||
]
|
||||
|
||||
|
||||
{-| A list of all Raw Text Elements as defined by the HTML5 specification. They
|
||||
can contain only text and have restrictions on which characters can appear
|
||||
within its innerHTML
|
||||
-}
|
||||
rawTextElements : List String
|
||||
rawTextElements =
|
||||
[ "script", "style" ]
|
||||
|
||||
|
||||
{-| A list of all Escapable Raw Text Elements as defined by the HTML5
|
||||
specification. They can have text and character references, but the text must
|
||||
not contain an ambiguous ampersand along with addional restrictions:
|
||||
<https://html.spec.whatwg.org/multipage/syntax.html#cdata-rcdata-restrictions>
|
||||
-}
|
||||
escapableRawTextElements : List String
|
||||
escapableRawTextElements =
|
||||
[ "textarea", "title" ]
|
||||
|
||||
|
||||
|
||||
{- Foreign elements are elements from the MathML namespace and the
|
||||
SVG namespace. TODO: detect these nodes and handle them correctly. Right
|
||||
now they will just be treated as Normal elements.
|
||||
-}
|
||||
|
||||
|
||||
{-| Identify the kind of element. Helper to convert an tag name into a type for
|
||||
pattern matching.
|
||||
-}
|
||||
toElementKind : String -> ElementKind
|
||||
toElementKind element =
|
||||
if List.member element voidElements then
|
||||
VoidElements
|
||||
else if List.member element rawTextElements then
|
||||
RawTextElements
|
||||
else if List.member element escapableRawTextElements then
|
||||
EscapableRawTextElements
|
||||
else
|
||||
-- All other allowed HTML elements are normal elements
|
||||
NormalElements
|
||||
@@ -0,0 +1,70 @@
|
||||
module ElmHtml.Markdown exposing (..)
|
||||
|
||||
{-| Markdown helpers
|
||||
|
||||
@docs MarkdownOptions, MarkdownModel, baseMarkdownModel
|
||||
|
||||
@docs encodeOptions, encodeMarkdownModel, decodeMarkdownModel
|
||||
|
||||
-}
|
||||
|
||||
import Json.Encode
|
||||
import Json.Decode exposing (field)
|
||||
|
||||
|
||||
{-| Just a default markdown model
|
||||
-}
|
||||
baseMarkdownModel : MarkdownModel
|
||||
baseMarkdownModel =
|
||||
{ options =
|
||||
{ githubFlavored = Just { tables = False, breaks = False }
|
||||
, defaultHighlighting = Nothing
|
||||
, sanitize = False
|
||||
, smartypants = False
|
||||
}
|
||||
, markdown = ""
|
||||
}
|
||||
|
||||
|
||||
{-| options markdown expects
|
||||
-}
|
||||
type alias MarkdownOptions =
|
||||
{ githubFlavored : Maybe { tables : Bool, breaks : Bool }
|
||||
, defaultHighlighting : Maybe String
|
||||
, sanitize : Bool
|
||||
, smartypants : Bool
|
||||
}
|
||||
|
||||
|
||||
{-| An internal markdown model. Options are the things you give markdown, markdown is the string
|
||||
-}
|
||||
type alias MarkdownModel =
|
||||
{ options : MarkdownOptions
|
||||
, markdown : String
|
||||
}
|
||||
|
||||
|
||||
{-| We don't really care about encoding options right now
|
||||
TODO: we will if we want to represent things as we do for elm-html
|
||||
-}
|
||||
encodeOptions : MarkdownOptions -> Json.Decode.Value
|
||||
encodeOptions options =
|
||||
Json.Encode.null
|
||||
|
||||
|
||||
{-| encode markdown model
|
||||
-}
|
||||
encodeMarkdownModel : MarkdownModel -> Json.Decode.Value
|
||||
encodeMarkdownModel model =
|
||||
Json.Encode.object
|
||||
[ ( "options", encodeOptions model.options )
|
||||
, ( "markdown", Json.Encode.string model.markdown )
|
||||
]
|
||||
|
||||
|
||||
{-| decode a markdown model
|
||||
-}
|
||||
decodeMarkdownModel : Json.Decode.Decoder MarkdownModel
|
||||
decodeMarkdownModel =
|
||||
field "markdown" Json.Decode.string
|
||||
|> Json.Decode.map (MarkdownModel baseMarkdownModel.options)
|
||||
143
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/src/ElmHtml/ToElmString.elm
vendored
Normal file
143
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/src/ElmHtml/ToElmString.elm
vendored
Normal file
@@ -0,0 +1,143 @@
|
||||
module ElmHtml.ToElmString
|
||||
exposing
|
||||
( toElmString
|
||||
, nodeRecordToString
|
||||
, toElmStringWithOptions
|
||||
, FormatOptions
|
||||
, defaultFormatOptions
|
||||
)
|
||||
|
||||
{-| Convert ElmHtml to string of Elm code.
|
||||
|
||||
@docs nodeRecordToString, toElmString, toElmStringWithOptions
|
||||
|
||||
@docs FormatOptions, defaultFormatOptions
|
||||
|
||||
-}
|
||||
|
||||
import String
|
||||
import Dict exposing (Dict)
|
||||
import ElmHtml.InternalTypes exposing (..)
|
||||
|
||||
|
||||
{-| Formatting options to be used for converting to string
|
||||
-}
|
||||
type alias FormatOptions =
|
||||
{ indent : Int
|
||||
, newLines : Bool
|
||||
}
|
||||
|
||||
|
||||
{-| default formatting options
|
||||
-}
|
||||
defaultFormatOptions : FormatOptions
|
||||
defaultFormatOptions =
|
||||
{ indent = 0
|
||||
, newLines = False
|
||||
}
|
||||
|
||||
|
||||
nodeToLines : FormatOptions -> ElmHtml msg -> List String
|
||||
nodeToLines options nodeType =
|
||||
case nodeType of
|
||||
TextTag { text } ->
|
||||
[ "Html.text \"" ++ text ++ "\"" ]
|
||||
|
||||
NodeEntry record ->
|
||||
nodeRecordToString options record
|
||||
|
||||
CustomNode record ->
|
||||
[]
|
||||
|
||||
MarkdownNode record ->
|
||||
[ record.model.markdown ]
|
||||
|
||||
NoOp ->
|
||||
[]
|
||||
|
||||
|
||||
{-| Convert a given html node to a string based on the type
|
||||
-}
|
||||
toElmString : ElmHtml msg -> String
|
||||
toElmString =
|
||||
toElmStringWithOptions defaultFormatOptions
|
||||
|
||||
|
||||
{-| same as toElmString, but with options
|
||||
-}
|
||||
toElmStringWithOptions : FormatOptions -> ElmHtml msg -> String
|
||||
toElmStringWithOptions options =
|
||||
nodeToLines options
|
||||
>> String.join
|
||||
(if options.newLines then
|
||||
"\n"
|
||||
else
|
||||
""
|
||||
)
|
||||
|
||||
|
||||
{-| Convert a node record to a string. This basically takes the tag name, then
|
||||
pulls all the facts into tag declaration, then goes through the children and
|
||||
nests them under this one
|
||||
-}
|
||||
nodeRecordToString : FormatOptions -> NodeRecord msg -> List String
|
||||
nodeRecordToString options { tag, children, facts } =
|
||||
let
|
||||
openTag : List (Maybe String) -> String
|
||||
openTag extras =
|
||||
let
|
||||
trimmedExtras =
|
||||
List.filterMap (\x -> x) extras
|
||||
|> List.map String.trim
|
||||
|> List.filter ((/=) "")
|
||||
|
||||
filling =
|
||||
case trimmedExtras of
|
||||
[] ->
|
||||
""
|
||||
|
||||
more ->
|
||||
" " ++ (String.join " " more)
|
||||
in
|
||||
"Html." ++ tag ++ " [" ++ filling
|
||||
|
||||
childrenStrings =
|
||||
List.map (nodeToLines options) children
|
||||
|> List.concat
|
||||
|> List.map ((++) (String.repeat options.indent " "))
|
||||
|
||||
styles =
|
||||
case Dict.toList facts.styles of
|
||||
[] ->
|
||||
Nothing
|
||||
|
||||
styles ->
|
||||
styles
|
||||
|> List.map (\( key, value ) -> "(\"" ++ key ++ "\",\"" ++ value ++ "\")")
|
||||
|> String.join ", "
|
||||
|> (\styleString -> "Html.Attributes.style [" ++ styleString ++ "]")
|
||||
|> Just
|
||||
|
||||
classes =
|
||||
Dict.get "className" facts.stringAttributes
|
||||
|> Maybe.map (\name -> "Html.Attributes.class [\"" ++ name ++ "\"]")
|
||||
|
||||
stringAttributes =
|
||||
Dict.filter (\k v -> k /= "className") facts.stringAttributes
|
||||
|> Dict.toList
|
||||
|> List.map (\( k, v ) -> "Html.Attributes." ++ k ++ " \"" ++ v ++ "\"")
|
||||
|> String.join ", "
|
||||
|> Just
|
||||
|
||||
boolAttributes =
|
||||
Dict.toList facts.boolAttributes
|
||||
|> List.map (\( k, v ) -> "Html.Attributes.property \"" ++ k ++ "\" <| Json.Encode.bool " ++ toString v)
|
||||
|> String.join " "
|
||||
|> Just
|
||||
in
|
||||
[ openTag [ classes, styles, stringAttributes, boolAttributes ] ]
|
||||
++ [ " ] "
|
||||
, "[ "
|
||||
, String.join "" childrenStrings
|
||||
, "]"
|
||||
]
|
||||
82
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/src/ElmHtml/ToHtml.elm
vendored
Normal file
82
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/src/ElmHtml/ToHtml.elm
vendored
Normal file
@@ -0,0 +1,82 @@
|
||||
module ElmHtml.ToHtml exposing (toHtml, factsToAttributes)
|
||||
|
||||
{-| This module is particularly useful for putting parsed Html into Elm.Html at runtime.
|
||||
Estentially allowing the user to use tools like html-to-elm on their code.
|
||||
|
||||
@docs toHtml, factsToAttributes
|
||||
|
||||
-}
|
||||
|
||||
import String
|
||||
import Dict exposing (Dict)
|
||||
import ElmHtml.InternalTypes exposing (..)
|
||||
import Html
|
||||
import Html.Attributes
|
||||
import Html.Events
|
||||
import Json.Encode
|
||||
import Json.Decode
|
||||
|
||||
|
||||
{-| Turns ElmHtml into normal Elm Html
|
||||
-}
|
||||
toHtml : ElmHtml msg -> Html.Html msg
|
||||
toHtml elmHtml =
|
||||
case elmHtml of
|
||||
TextTag text ->
|
||||
Html.text text.text
|
||||
|
||||
NodeEntry { tag, children, facts } ->
|
||||
Html.node tag [] (List.map toHtml children)
|
||||
|
||||
CustomNode record ->
|
||||
let
|
||||
_ =
|
||||
Debug.log "Custom node is not supported" ""
|
||||
in
|
||||
Html.text ""
|
||||
|
||||
MarkdownNode record ->
|
||||
let
|
||||
_ =
|
||||
Debug.log "Markdown node is not supported" ""
|
||||
in
|
||||
Html.text ""
|
||||
|
||||
NoOp ->
|
||||
Html.text ""
|
||||
|
||||
|
||||
stylesToAttribute : Dict String String -> Html.Attribute msg
|
||||
stylesToAttribute =
|
||||
Dict.toList
|
||||
>> Html.Attributes.style
|
||||
|
||||
|
||||
eventsToAttributes : Dict String (Json.Decode.Decoder msg) -> List (Html.Attribute msg)
|
||||
eventsToAttributes =
|
||||
Dict.toList
|
||||
>> List.map (\( x, y ) -> Html.Events.on x y)
|
||||
|
||||
|
||||
stringAttributesToAttributes : Dict String String -> List (Html.Attribute msg)
|
||||
stringAttributesToAttributes =
|
||||
Dict.toList
|
||||
>> List.map (\( x, y ) -> Html.Attributes.attribute x y)
|
||||
|
||||
|
||||
boolAttributesToAttributes : Dict String Bool -> List (Html.Attribute msg)
|
||||
boolAttributesToAttributes =
|
||||
Dict.toList
|
||||
>> List.map (\( x, y ) -> Html.Attributes.property x (Json.Encode.bool y))
|
||||
|
||||
|
||||
{-| Turns a fact record into a list of attributes
|
||||
-}
|
||||
factsToAttributes : Facts msg -> List (Html.Attribute msg)
|
||||
factsToAttributes facts =
|
||||
List.concat
|
||||
[ [ stylesToAttribute facts.styles ]
|
||||
, eventsToAttributes facts.events
|
||||
, stringAttributesToAttributes facts.stringAttributes
|
||||
, boolAttributesToAttributes facts.boolAttributes
|
||||
]
|
||||
155
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/src/ElmHtml/ToString.elm
vendored
Normal file
155
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/src/ElmHtml/ToString.elm
vendored
Normal file
@@ -0,0 +1,155 @@
|
||||
module ElmHtml.ToString
|
||||
exposing
|
||||
( nodeToString
|
||||
, nodeRecordToString
|
||||
, nodeToStringWithOptions
|
||||
, FormatOptions
|
||||
, defaultFormatOptions
|
||||
)
|
||||
|
||||
{-| Convert ElmHtml to string.
|
||||
|
||||
@docs nodeRecordToString, nodeToString, nodeToStringWithOptions
|
||||
|
||||
@docs FormatOptions, defaultFormatOptions
|
||||
-}
|
||||
|
||||
import String
|
||||
import Dict exposing (Dict)
|
||||
import ElmHtml.InternalTypes exposing (..)
|
||||
|
||||
|
||||
{-| Formatting options to be used for converting to string
|
||||
-}
|
||||
type alias FormatOptions =
|
||||
{ indent : Int
|
||||
, newLines : Bool
|
||||
}
|
||||
|
||||
|
||||
{-| default formatting options
|
||||
-}
|
||||
defaultFormatOptions : FormatOptions
|
||||
defaultFormatOptions =
|
||||
{ indent = 0
|
||||
, newLines = False
|
||||
}
|
||||
|
||||
|
||||
nodeToLines : FormatOptions -> ElmHtml msg -> List String
|
||||
nodeToLines options nodeType =
|
||||
case nodeType of
|
||||
TextTag { text } ->
|
||||
[ text ]
|
||||
|
||||
NodeEntry record ->
|
||||
nodeRecordToString options record
|
||||
|
||||
CustomNode record ->
|
||||
[]
|
||||
|
||||
MarkdownNode record ->
|
||||
[ record.model.markdown ]
|
||||
|
||||
NoOp ->
|
||||
[]
|
||||
|
||||
|
||||
{-| Convert a given html node to a string based on the type
|
||||
-}
|
||||
nodeToString : ElmHtml msg -> String
|
||||
nodeToString =
|
||||
nodeToStringWithOptions defaultFormatOptions
|
||||
|
||||
|
||||
{-| same as nodeToString, but with options
|
||||
-}
|
||||
nodeToStringWithOptions : FormatOptions -> ElmHtml msg -> String
|
||||
nodeToStringWithOptions options =
|
||||
nodeToLines options
|
||||
>> String.join
|
||||
(if options.newLines then
|
||||
"\n"
|
||||
else
|
||||
""
|
||||
)
|
||||
|
||||
|
||||
{-| Convert a node record to a string. This basically takes the tag name, then
|
||||
pulls all the facts into tag declaration, then goes through the children and
|
||||
nests them under this one
|
||||
-}
|
||||
nodeRecordToString : FormatOptions -> NodeRecord msg -> List String
|
||||
nodeRecordToString options { tag, children, facts } =
|
||||
let
|
||||
openTag : List (Maybe String) -> String
|
||||
openTag extras =
|
||||
let
|
||||
trimmedExtras =
|
||||
List.filterMap (\x -> x) extras
|
||||
|> List.map String.trim
|
||||
|> List.filter ((/=) "")
|
||||
|
||||
filling =
|
||||
case trimmedExtras of
|
||||
[] ->
|
||||
""
|
||||
|
||||
more ->
|
||||
" " ++ (String.join " " more)
|
||||
in
|
||||
"<" ++ tag ++ filling ++ ">"
|
||||
|
||||
closeTag =
|
||||
"</" ++ tag ++ ">"
|
||||
|
||||
childrenStrings =
|
||||
List.map (nodeToLines options) children
|
||||
|> List.concat
|
||||
|> List.map ((++) (String.repeat options.indent " "))
|
||||
|
||||
styles =
|
||||
case Dict.toList facts.styles of
|
||||
[] ->
|
||||
Nothing
|
||||
|
||||
styles ->
|
||||
styles
|
||||
|> List.map (\( key, value ) -> key ++ ":" ++ value ++ ";")
|
||||
|> String.join ""
|
||||
|> (\styleString -> "style=\"" ++ styleString ++ "\"")
|
||||
|> Just
|
||||
|
||||
classes =
|
||||
Dict.get "className" facts.stringAttributes
|
||||
|> Maybe.map (\name -> "class=\"" ++ name ++ "\"")
|
||||
|
||||
stringAttributes =
|
||||
Dict.filter (\k v -> k /= "className") facts.stringAttributes
|
||||
|> Dict.toList
|
||||
|> List.map (\( k, v ) -> k ++ "=\"" ++ v ++ "\"")
|
||||
|> String.join " "
|
||||
|> Just
|
||||
|
||||
boolAttributes =
|
||||
Dict.toList facts.boolAttributes
|
||||
|> List.map (\( k, v ) -> k ++ "=" ++ (String.toLower <| toString v))
|
||||
|> String.join " "
|
||||
|> Just
|
||||
in
|
||||
case toElementKind tag of
|
||||
{- Void elements only have a start tag; end tags must not be
|
||||
specified for void elements.
|
||||
-}
|
||||
VoidElements ->
|
||||
[ openTag [ classes, styles, stringAttributes, boolAttributes ] ]
|
||||
|
||||
{- TODO: implement restrictions for RawTextElements,
|
||||
EscapableRawTextElements. Also handle ForeignElements correctly.
|
||||
For now just punt and use the previous behavior for all other
|
||||
element kinds.
|
||||
-}
|
||||
_ ->
|
||||
[ openTag [ classes, styles, stringAttributes, boolAttributes ] ]
|
||||
++ childrenStrings
|
||||
++ [ closeTag ]
|
||||
@@ -0,0 +1,16 @@
|
||||
var _eeue56$elm_html_in_elm$Native_HtmlAsJson = (function() {
|
||||
return {
|
||||
unsafeCoerce: function(a) {
|
||||
return a;
|
||||
},
|
||||
eventDecoder: function (event) {
|
||||
return event.decoder;
|
||||
},
|
||||
eventHandler: F2(function(eventName, html) {
|
||||
return html.facts.EVENT[eventName];
|
||||
}),
|
||||
taggerFunction: function(tagger) {
|
||||
return tagger;
|
||||
}
|
||||
};
|
||||
})();
|
||||
311
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/tests/Tests.elm
vendored
Normal file
311
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/tests/Tests.elm
vendored
Normal file
@@ -0,0 +1,311 @@
|
||||
module Tests exposing (..)
|
||||
|
||||
import Dict
|
||||
import ElmHtml.InternalTypes exposing (Attribute(..), ElmHtml(..), EventHandler, Facts, NodeRecord, Tagger, decodeAttribute, decodeElmHtml)
|
||||
import ElmHtml.ToHtml
|
||||
import ElmHtml.ToElmString exposing (toElmString)
|
||||
import Expect
|
||||
import Html exposing (Html, button, div, input, text)
|
||||
import Html.Attributes exposing (class, colspan, disabled, style, value)
|
||||
import Html.Events exposing (onCheck, onClick, onInput)
|
||||
import Json.Decode exposing (decodeValue)
|
||||
import Json.Encode
|
||||
import Native.HtmlAsJson
|
||||
import Svg.Attributes exposing (xlinkHref)
|
||||
import Test exposing (..)
|
||||
|
||||
|
||||
elmHtml : Test
|
||||
elmHtml =
|
||||
describe "ElmHtml parsing"
|
||||
[ test "parsing a node" <|
|
||||
\() ->
|
||||
div [] []
|
||||
|> fromHtml
|
||||
|> Expect.equal (Ok (NodeEntry decodedNode))
|
||||
, test "parsing a text" <|
|
||||
\() ->
|
||||
text "foo"
|
||||
|> fromHtml
|
||||
|> Expect.equal (Ok (TextTag { text = "foo" }))
|
||||
, test "parsing attributes" <|
|
||||
\() ->
|
||||
let
|
||||
facts =
|
||||
{ decodedFacts
|
||||
| stringAttributes = Dict.fromList [ ( "className", "foo" ), ( "value", "bar" ) ]
|
||||
, boolAttributes = Dict.fromList [ ( "disabled", True ) ]
|
||||
}
|
||||
|
||||
expected =
|
||||
{ decodedNode | tag = "button", facts = facts }
|
||||
in
|
||||
button [ class "foo", value "bar", disabled True ] []
|
||||
|> fromHtml
|
||||
|> Expect.equal (Ok (NodeEntry expected))
|
||||
, test "parsing children" <|
|
||||
\() ->
|
||||
let
|
||||
expected =
|
||||
{ decodedNode
|
||||
| children = [ NodeEntry decodedNode, TextTag { text = "foo" } ]
|
||||
, descendantsCount = 2
|
||||
}
|
||||
in
|
||||
div []
|
||||
[ div [] []
|
||||
, text "foo"
|
||||
]
|
||||
|> fromHtml
|
||||
|> Expect.equal (Ok (NodeEntry expected))
|
||||
, describe "parsing events"
|
||||
[ testParsingEvent "click" (onClick SomeMsg)
|
||||
, testParsingEvent "input" (onInput InputMsg)
|
||||
, testParsingEvent "change" (onCheck CheckMsg)
|
||||
]
|
||||
, describe "parsing Html.map"
|
||||
[ test "adds the correct tagger to a mapped button" <|
|
||||
\() ->
|
||||
let
|
||||
taggedNode =
|
||||
input [ onInput identity ] []
|
||||
|> Html.map (\msg -> msg ++ "bar")
|
||||
|> fromHtml
|
||||
in
|
||||
taggedNode
|
||||
|> Result.andThen (simulate "input" "{\"target\": {\"value\": \"foo\"}}")
|
||||
|> Expect.equal (Ok "foobar")
|
||||
, test "adds two taggers to a double mapped button with changing types" <|
|
||||
\() ->
|
||||
let
|
||||
taggedNode =
|
||||
input [ onInput identity ] []
|
||||
|> Html.map (\str -> [ str ] ++ [ "bar" ])
|
||||
|> Html.map (\list -> ( list, "baz" ))
|
||||
|> fromHtml
|
||||
in
|
||||
taggedNode
|
||||
|> Result.andThen (simulate "input" "{\"target\": {\"value\": \"foo\"}}")
|
||||
|> Expect.equal (Ok ( [ "foo", "bar" ], "baz" ))
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
elmHtmlToHtml : Test
|
||||
elmHtmlToHtml =
|
||||
describe "Turning the AST into Html"
|
||||
[ test "parsing a node" <|
|
||||
\() ->
|
||||
div [] []
|
||||
|> fromHtml
|
||||
|> Result.map ElmHtml.ToHtml.toHtml
|
||||
|> Expect.equal (Ok <| div [] [])
|
||||
, test "parsing a text" <|
|
||||
\() ->
|
||||
text "foo"
|
||||
|> fromHtml
|
||||
|> Result.map ElmHtml.ToHtml.toHtml
|
||||
|> Expect.equal (Ok <| text "foo")
|
||||
, test "parsing a text in a div" <|
|
||||
\() ->
|
||||
div [] [ text "foo" ]
|
||||
|> fromHtml
|
||||
|> Result.map ElmHtml.ToHtml.toHtml
|
||||
|> Expect.equal (Ok <| div [] [ text "foo" ])
|
||||
, test "parsing a text in a div in a div in a div " <|
|
||||
\() ->
|
||||
div [] [ div [] [ text "banana", div [] [ text "foo", text "bar" ] ] ]
|
||||
|> fromHtml
|
||||
|> Result.map ElmHtml.ToHtml.toHtml
|
||||
|> Expect.equal (Ok <| div [] [ div [] [ text "banana", div [] [ text "foo", text "bar" ] ] ])
|
||||
, test "parsing styles in a div" <|
|
||||
\() ->
|
||||
div [ Html.Attributes.style [ ( "background", "red" ) ] ] [ text "foo" ]
|
||||
|> fromHtml
|
||||
|> Result.map ElmHtml.ToHtml.toHtml
|
||||
|> Expect.equal (Ok <| div [ Html.Attributes.style [ ( "background", "red" ) ] ] [ text "foo" ])
|
||||
, test "parsing attributes a div" <|
|
||||
\() ->
|
||||
div [ Html.Attributes.name "fish", Html.Attributes.checked True ] [ text "foo" ]
|
||||
|> fromHtml
|
||||
|> Result.map ElmHtml.ToHtml.toHtml
|
||||
|> Expect.equal (Ok <| div [ Html.Attributes.name "fish", Html.Attributes.checked True ] [ text "foo" ])
|
||||
, test "parsing attributes in a nested div" <|
|
||||
\() ->
|
||||
div [ Html.Attributes.name "fish", Html.Attributes.checked True ] [ Html.li [ Html.Attributes.type_ "hello" ] [ text "foo" ] ]
|
||||
|> fromHtml
|
||||
|> Result.map ElmHtml.ToHtml.toHtml
|
||||
|> Expect.equal (Ok <| div [ Html.Attributes.name "fish", Html.Attributes.checked True ] [ Html.li [ Html.Attributes.type_ "hello" ] [ text "foo" ] ])
|
||||
, test "parsing events in a div" <|
|
||||
\() ->
|
||||
div [ Html.Events.onClick True ] []
|
||||
|> fromHtml
|
||||
|> Result.map ElmHtml.ToHtml.toHtml
|
||||
|> Expect.equal (Ok <| div [ Html.Events.onClick True ] [])
|
||||
]
|
||||
|
||||
|
||||
elmHtmlToElmString : Test
|
||||
elmHtmlToElmString =
|
||||
describe "Turning the AST into Elm, but as a string"
|
||||
[ test "parsing a node" <|
|
||||
\() ->
|
||||
div [] []
|
||||
|> fromHtml
|
||||
|> Result.map toElmString
|
||||
|> Expect.equal (Ok <| "Html.div [ ] [ ]")
|
||||
, test "parsing a text" <|
|
||||
\() ->
|
||||
text "foo"
|
||||
|> fromHtml
|
||||
|> Result.map toElmString
|
||||
|> Expect.equal (Ok <| "Html.text \"foo\"")
|
||||
, test "parsing a nested node" <|
|
||||
\() ->
|
||||
div [] [ div [] [ text "hello" ] ]
|
||||
|> fromHtml
|
||||
|> Result.map toElmString
|
||||
|> Expect.equal (Ok <| "Html.div [ ] [ Html.div [ ] [ Html.text \"hello\"]]")
|
||||
, test "parsing an attribute" <|
|
||||
\() ->
|
||||
div [ Html.Attributes.checked True ] [ text "hello" ]
|
||||
|> fromHtml
|
||||
|> Result.map toElmString
|
||||
|> Expect.equal (Ok <| "Html.div [ Html.Attributes.property \"checked\" <| Json.Encode.bool True ] [ Html.text \"hello\"]")
|
||||
]
|
||||
|
||||
|
||||
attributes : Test
|
||||
attributes =
|
||||
describe "Attribute parsing"
|
||||
[ test "parsing Attribute" <|
|
||||
\() ->
|
||||
colspan 1
|
||||
|> fromAttribute
|
||||
|> Expect.equal (Ok (Attribute { key = "colspan", value = "1" }))
|
||||
, test "parsing NamespacedAttribute" <|
|
||||
\() ->
|
||||
xlinkHref "#id"
|
||||
|> fromAttribute
|
||||
|> Expect.equal
|
||||
(Ok (NamespacedAttribute { key = "xlink:href", value = "#id", namespace = "http://www.w3.org/1999/xlink" }))
|
||||
, test "parsing Property" <|
|
||||
\() ->
|
||||
disabled True
|
||||
|> fromAttribute
|
||||
|> Expect.equal (Ok (Property { key = "disabled", value = Json.Encode.bool True }))
|
||||
, test "parsing Event" <|
|
||||
\() ->
|
||||
onClick ()
|
||||
|> fromAttribute
|
||||
|> Expect.equal
|
||||
(Ok (Event { key = "click", decoder = toJson (Json.Decode.succeed ()), options = Html.Events.defaultOptions }))
|
||||
, test "parsing Styles" <|
|
||||
\() ->
|
||||
style [ ( "margin", "0" ) ]
|
||||
|> fromAttribute
|
||||
|> Expect.equal (Ok (Styles [ ( "margin", "0" ) ]))
|
||||
]
|
||||
|
||||
|
||||
type Msg
|
||||
= SomeMsg
|
||||
| InputMsg String
|
||||
| CheckMsg Bool
|
||||
|
||||
|
||||
toJson : a -> Json.Decode.Value
|
||||
toJson =
|
||||
Native.HtmlAsJson.unsafeCoerce
|
||||
|
||||
|
||||
eventDecoder : EventHandler -> Json.Decode.Decoder msg
|
||||
eventDecoder eventHandler =
|
||||
Native.HtmlAsJson.eventDecoder eventHandler
|
||||
|
||||
|
||||
eventHandler : String -> Html a -> Json.Decode.Value
|
||||
eventHandler eventName node =
|
||||
Native.HtmlAsJson.eventHandler eventName node
|
||||
|
||||
|
||||
taggerFunction : Tagger -> (a -> msg)
|
||||
taggerFunction tagger =
|
||||
Native.HtmlAsJson.taggerFunction tagger
|
||||
|
||||
|
||||
taggedEventDecoder : List Tagger -> EventHandler -> Json.Decode.Decoder msg
|
||||
taggedEventDecoder taggers eventHandler =
|
||||
case taggers of
|
||||
[] ->
|
||||
eventDecoder eventHandler
|
||||
|
||||
[ tagger ] ->
|
||||
Json.Decode.map (taggerFunction tagger) (eventDecoder eventHandler)
|
||||
|
||||
tagger :: taggers ->
|
||||
Json.Decode.map (taggerFunction tagger) (taggedEventDecoder taggers eventHandler)
|
||||
|
||||
|
||||
fromAttribute : Html.Attribute a -> Result String Attribute
|
||||
fromAttribute attribute =
|
||||
toJson attribute
|
||||
|> decodeValue decodeAttribute
|
||||
|
||||
|
||||
decodedNode : NodeRecord msg
|
||||
decodedNode =
|
||||
{ tag = "div"
|
||||
, children = []
|
||||
, facts = decodedFacts
|
||||
, descendantsCount = 0
|
||||
}
|
||||
|
||||
|
||||
decodedFacts : Facts msg
|
||||
decodedFacts =
|
||||
{ styles = Dict.fromList []
|
||||
, events = Dict.fromList []
|
||||
, attributeNamespace = Nothing
|
||||
, stringAttributes = Dict.fromList []
|
||||
, boolAttributes = Dict.fromList []
|
||||
}
|
||||
|
||||
|
||||
fromHtml : Html a -> Result String (ElmHtml msg)
|
||||
fromHtml html =
|
||||
toJson html
|
||||
|> decodeValue (decodeElmHtml taggedEventDecoder)
|
||||
|
||||
|
||||
simulate : String -> String -> ElmHtml msg -> Result String msg
|
||||
simulate eventName event parsedHtml =
|
||||
case parsedHtml of
|
||||
NodeEntry node ->
|
||||
Dict.get eventName node.facts.events
|
||||
|> Result.fromMaybe "Tried to trigger event on something other than a NodeEntry"
|
||||
|> Result.andThen (\eventDecoder -> Json.Decode.decodeString eventDecoder event)
|
||||
|
||||
_ ->
|
||||
Err "Tried to trigger event on something other than a NodeEntry"
|
||||
|
||||
|
||||
testParsingEvent : String -> Html.Attribute a -> Test
|
||||
testParsingEvent eventName eventAttribute =
|
||||
test ("parsing " ++ eventName) <|
|
||||
\() ->
|
||||
let
|
||||
node =
|
||||
button [ eventAttribute ] []
|
||||
|
||||
facts =
|
||||
{ decodedFacts
|
||||
| events = Dict.fromList [ ( eventName, eventDecoder (eventHandler eventName node) ) ]
|
||||
}
|
||||
|
||||
expected =
|
||||
{ decodedNode | tag = "button", facts = facts }
|
||||
in
|
||||
node
|
||||
|> fromHtml
|
||||
|> Expect.equal (Ok (NodeEntry expected))
|
||||
19
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/tests/elm-package.json
vendored
Normal file
19
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-in-elm/5.2.0/tests/elm-package.json
vendored
Normal file
@@ -0,0 +1,19 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "Test Suites",
|
||||
"repository": "https://github.com/eeue56/elm-html-in-elm.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"../src",
|
||||
"."
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"native-modules": true,
|
||||
"dependencies": {
|
||||
"elm-community/elm-test": "4.0.0 <= v < 5.0.0",
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||
"elm-lang/svg": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/.gitignore
vendored
Normal file
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/.gitignore
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
# elm-package generated files
|
||||
elm-stuff/
|
||||
# elm-repl generated files
|
||||
repl-temp-*
|
||||
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/LICENSE
vendored
Normal file
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/LICENSE
vendored
Normal file
@@ -0,0 +1,29 @@
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2016, Noah
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
3
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/README.md
vendored
Normal file
3
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/README.md
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
# elm-html-query
|
||||
|
||||
Query things using a [ElmHtml](http://package.elm-lang.org/packages/eeue56/elm-html-in-elm/latest) representation. This project is used alongside [elm-html-test](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest) to implement Html-based tests in Elm.
|
||||
18
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/elm-package.json
vendored
Normal file
18
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/elm-package.json
vendored
Normal file
@@ -0,0 +1,18 @@
|
||||
{
|
||||
"version": "3.0.0",
|
||||
"summary": "Query for things inside ElmHtml",
|
||||
"repository": "https://github.com/eeue56/elm-html-query.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": [
|
||||
"ElmHtml.Query"
|
||||
],
|
||||
"dependencies": {
|
||||
"eeue56/elm-html-in-elm": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
350
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/src/ElmHtml/Query.elm
vendored
Normal file
350
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-query/3.0.0/src/ElmHtml/Query.elm
vendored
Normal file
@@ -0,0 +1,350 @@
|
||||
module ElmHtml.Query
|
||||
exposing
|
||||
( Selector(..)
|
||||
, query
|
||||
, queryAll
|
||||
, queryInNode
|
||||
, queryChildren
|
||||
, queryChildrenAll
|
||||
, queryById
|
||||
, queryByClassName
|
||||
, queryByClassList
|
||||
, queryByStyle
|
||||
, queryByTagName
|
||||
, queryByAttribute
|
||||
, queryByBoolAttribute
|
||||
, getChildren
|
||||
)
|
||||
|
||||
{-|
|
||||
Query things using ElmHtml
|
||||
|
||||
@docs Selector
|
||||
@docs query, queryAll, queryChildren, queryChildrenAll, queryInNode
|
||||
@docs queryById, queryByClassName, queryByClassList, queryByStyle, queryByTagName, queryByAttribute, queryByBoolAttribute
|
||||
@docs getChildren
|
||||
-}
|
||||
|
||||
import Dict
|
||||
import String
|
||||
import ElmHtml.InternalTypes exposing (..)
|
||||
|
||||
|
||||
{-| Selectors to query a Html element
|
||||
- Id, classname, classlist, tag are all what you'd expect
|
||||
- Attribute and bool attribute are attributes
|
||||
- ConainsText just searches inside for the given text
|
||||
-}
|
||||
type Selector
|
||||
= Id String
|
||||
| ClassName String
|
||||
| ClassList (List String)
|
||||
| Tag String
|
||||
| Attribute String String
|
||||
| BoolAttribute String Bool
|
||||
| Style (List ( String, String ))
|
||||
| ContainsText String
|
||||
| Multiple (List Selector)
|
||||
|
||||
|
||||
{-| Query for a node with a given tag in a Html element
|
||||
-}
|
||||
queryByTagName : String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByTagName tagname =
|
||||
query (Tag tagname)
|
||||
|
||||
|
||||
{-| Query for a node with a given id in a Html element
|
||||
-}
|
||||
queryById : String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryById id =
|
||||
query (Id id)
|
||||
|
||||
|
||||
{-| Query for a node with a given classname in a Html element
|
||||
-}
|
||||
queryByClassName : String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByClassName classname =
|
||||
query (ClassName classname)
|
||||
|
||||
|
||||
{-| Query for a node with all the given classnames in a Html element
|
||||
-}
|
||||
queryByClassList : List String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByClassList classList =
|
||||
query (ClassList classList)
|
||||
|
||||
|
||||
{-| Query for a node with the given style in a Html element
|
||||
-}
|
||||
queryByStyle : List ( String, String ) -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByStyle style =
|
||||
query (Style style)
|
||||
|
||||
|
||||
{-| Query for a node with a given attribute in a Html element
|
||||
-}
|
||||
queryByAttribute : String -> String -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByAttribute key value =
|
||||
query (Attribute key value)
|
||||
|
||||
|
||||
{-| Query for a node with a given attribute in a Html element
|
||||
-}
|
||||
queryByBoolAttribute : String -> Bool -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryByBoolAttribute key value =
|
||||
query (BoolAttribute key value)
|
||||
|
||||
|
||||
{-| Query an ElmHtml element using a selector, searching all children.
|
||||
-}
|
||||
query : Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
query selector =
|
||||
queryInNode selector
|
||||
|
||||
|
||||
{-| Query an ElmHtml node using multiple selectors, considering both the node itself
|
||||
as well as all of its descendants.
|
||||
-}
|
||||
queryAll : List Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryAll selectors =
|
||||
query (Multiple selectors)
|
||||
|
||||
|
||||
{-| Query an ElmHtml node using a selector, considering both the node itself
|
||||
as well as all of its descendants.
|
||||
-}
|
||||
queryInNode : Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryInNode =
|
||||
queryInNodeHelp Nothing
|
||||
|
||||
|
||||
{-| Query an ElmHtml node using a selector, considering both the node itself
|
||||
as well as all of its descendants.
|
||||
-}
|
||||
queryChildren : Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryChildren =
|
||||
queryInNodeHelp (Just 1)
|
||||
|
||||
|
||||
{-| Returns just the immediate children of an ElmHtml node
|
||||
-}
|
||||
getChildren : ElmHtml msg -> List (ElmHtml msg)
|
||||
getChildren elmHtml =
|
||||
case elmHtml of
|
||||
NodeEntry { children } ->
|
||||
children
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
|
||||
{-| Query to ensure an ElmHtml node has all selectors given, without considering
|
||||
any descendants lower than its immediate children.
|
||||
-}
|
||||
queryChildrenAll : List Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryChildrenAll selectors =
|
||||
queryInNodeHelp (Just 1) (Multiple selectors)
|
||||
|
||||
|
||||
queryInNodeHelp : Maybe Int -> Selector -> ElmHtml msg -> List (ElmHtml msg)
|
||||
queryInNodeHelp maxDescendantDepth selector node =
|
||||
case node of
|
||||
NodeEntry record ->
|
||||
let
|
||||
childEntries =
|
||||
descendInQuery maxDescendantDepth selector record.children
|
||||
in
|
||||
if predicateFromSelector selector node then
|
||||
node :: childEntries
|
||||
else
|
||||
childEntries
|
||||
|
||||
TextTag { text } ->
|
||||
case selector of
|
||||
ContainsText innerText ->
|
||||
if String.contains innerText text then
|
||||
[ node ]
|
||||
else
|
||||
[]
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
MarkdownNode { facts, model } ->
|
||||
if predicateFromSelector selector node then
|
||||
[ node ]
|
||||
else
|
||||
[]
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
|
||||
descendInQuery : Maybe Int -> Selector -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
descendInQuery maxDescendantDepth selector children =
|
||||
case maxDescendantDepth of
|
||||
Nothing ->
|
||||
-- No maximum, so continue.
|
||||
List.concatMap
|
||||
(queryInNodeHelp Nothing selector)
|
||||
children
|
||||
|
||||
Just depth ->
|
||||
if depth > 0 then
|
||||
-- Continue with maximum depth reduced by 1.
|
||||
List.concatMap
|
||||
(queryInNodeHelp (Just (depth - 1)) selector)
|
||||
children
|
||||
else
|
||||
[]
|
||||
|
||||
|
||||
predicateFromSelector : Selector -> ElmHtml msg -> Bool
|
||||
predicateFromSelector selector html =
|
||||
case html of
|
||||
NodeEntry record ->
|
||||
record
|
||||
|> nodeRecordPredicate selector
|
||||
|
||||
MarkdownNode markdownModel ->
|
||||
markdownModel
|
||||
|> markdownPredicate selector
|
||||
|
||||
_ ->
|
||||
False
|
||||
|
||||
|
||||
hasAllSelectors : List Selector -> ElmHtml msg -> Bool
|
||||
hasAllSelectors selectors record =
|
||||
List.map predicateFromSelector selectors
|
||||
|> List.map (\selector -> selector record)
|
||||
|> List.all identity
|
||||
|
||||
|
||||
hasAttribute : String -> String -> Facts msg -> Bool
|
||||
hasAttribute attribute query facts =
|
||||
case Dict.get attribute facts.stringAttributes of
|
||||
Just id ->
|
||||
id == query
|
||||
|
||||
Nothing ->
|
||||
False
|
||||
|
||||
|
||||
hasBoolAttribute : String -> Bool -> Facts msg -> Bool
|
||||
hasBoolAttribute attribute value facts =
|
||||
case Dict.get attribute facts.boolAttributes of
|
||||
Just id ->
|
||||
id == value
|
||||
|
||||
Nothing ->
|
||||
False
|
||||
|
||||
|
||||
hasClass : String -> Facts msg -> Bool
|
||||
hasClass query facts =
|
||||
List.member query (classnames facts)
|
||||
|
||||
|
||||
hasClasses : List String -> Facts msg -> Bool
|
||||
hasClasses classList facts =
|
||||
containsAll classList (classnames facts)
|
||||
|
||||
|
||||
hasStyle : List ( String, String ) -> Facts msg -> Bool
|
||||
hasStyle style facts =
|
||||
containsAll style (Dict.toList facts.styles)
|
||||
|
||||
|
||||
classnames : Facts msg -> List String
|
||||
classnames facts =
|
||||
Dict.get "className" facts.stringAttributes
|
||||
|> Maybe.withDefault ""
|
||||
|> String.split " "
|
||||
|
||||
|
||||
containsAll : List a -> List a -> Bool
|
||||
containsAll a b =
|
||||
b
|
||||
|> List.foldl (\i acc -> List.filter ((/=) i) acc) a
|
||||
|> List.isEmpty
|
||||
|
||||
|
||||
nodeRecordPredicate : Selector -> (NodeRecord msg -> Bool)
|
||||
nodeRecordPredicate selector =
|
||||
case selector of
|
||||
Id id ->
|
||||
.facts
|
||||
>> hasAttribute "id" id
|
||||
|
||||
ClassName classname ->
|
||||
.facts
|
||||
>> hasClass classname
|
||||
|
||||
ClassList classList ->
|
||||
.facts
|
||||
>> hasClasses classList
|
||||
|
||||
Tag tag ->
|
||||
.tag
|
||||
>> (==) tag
|
||||
|
||||
Attribute key value ->
|
||||
.facts
|
||||
>> hasAttribute key value
|
||||
|
||||
BoolAttribute key value ->
|
||||
.facts
|
||||
>> hasBoolAttribute key value
|
||||
|
||||
Style style ->
|
||||
.facts
|
||||
>> hasStyle style
|
||||
|
||||
ContainsText text ->
|
||||
always False
|
||||
|
||||
Multiple selectors ->
|
||||
NodeEntry
|
||||
>> hasAllSelectors selectors
|
||||
|
||||
|
||||
markdownPredicate : Selector -> (MarkdownNodeRecord msg -> Bool)
|
||||
markdownPredicate selector =
|
||||
case selector of
|
||||
Id id ->
|
||||
.facts
|
||||
>> hasAttribute "id" id
|
||||
|
||||
ClassName classname ->
|
||||
.facts
|
||||
>> hasClass classname
|
||||
|
||||
ClassList classList ->
|
||||
.facts
|
||||
>> hasClasses classList
|
||||
|
||||
Tag tag ->
|
||||
always False
|
||||
|
||||
Attribute key value ->
|
||||
.facts
|
||||
>> hasAttribute key value
|
||||
|
||||
BoolAttribute key value ->
|
||||
.facts
|
||||
>> hasBoolAttribute key value
|
||||
|
||||
Style style ->
|
||||
.facts
|
||||
>> hasStyle style
|
||||
|
||||
ContainsText text ->
|
||||
.model
|
||||
>> .markdown
|
||||
>> String.contains text
|
||||
|
||||
Multiple selectors ->
|
||||
MarkdownNode
|
||||
>> hasAllSelectors selectors
|
||||
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/.gitignore
vendored
Normal file
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/.gitignore
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
# elm-package generated files
|
||||
elm-stuff/
|
||||
# elm-repl generated files
|
||||
repl-temp-*
|
||||
31
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/.travis.yml
vendored
Normal file
31
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/.travis.yml
vendored
Normal file
@@ -0,0 +1,31 @@
|
||||
sudo: false
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- tests/elm-stuff/build-artifacts
|
||||
|
||||
os:
|
||||
- osx
|
||||
- linux
|
||||
|
||||
env:
|
||||
matrix:
|
||||
- ELM_VERSION=0.18 TARGET_NODE_VERSION=node
|
||||
- ELM_VERSION=0.18 TARGET_NODE_VERSION=4.2
|
||||
|
||||
before_install:
|
||||
- if [ ${TRAVIS_OS_NAME} == "osx" ];
|
||||
then brew update; brew install nvm; mkdir ~/.nvm; export NVM_DIR=~/.nvm; source $(brew --prefix nvm)/nvm.sh;
|
||||
fi
|
||||
|
||||
install:
|
||||
- nvm install $TARGET_NODE_VERSION
|
||||
- nvm use $TARGET_NODE_VERSION
|
||||
- node --version
|
||||
- npm --version
|
||||
- npm install -g elm@$ELM_VERSION
|
||||
- npm install -g elm-test@beta
|
||||
|
||||
|
||||
script:
|
||||
- elm-test
|
||||
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/LICENSE
vendored
Normal file
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/LICENSE
vendored
Normal file
@@ -0,0 +1,29 @@
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2016, Noah Hall, Richard Feldman
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
131
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/README.md
vendored
Normal file
131
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/README.md
vendored
Normal file
@@ -0,0 +1,131 @@
|
||||
# elm-html-test
|
||||
|
||||
Test views by writing expectations about `Html` values. [](https://travis-ci.org/eeue56/elm-html-test)
|
||||
|
||||
```elm
|
||||
import Html
|
||||
import Html.Attributes exposing (class)
|
||||
import Test exposing (test)
|
||||
import Test.Html.Query as Query
|
||||
import Test.Html.Selector exposing (text, tag)
|
||||
|
||||
|
||||
test "Button has the expected text" <|
|
||||
\() ->
|
||||
Html.div [ class "container" ]
|
||||
[ Html.button [] [ Html.text "I'm a button!" ] ]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "button" ]
|
||||
|> Query.has [ text "I'm a button!" ]
|
||||
```
|
||||
|
||||
These tests are designed to be written in a pipeline like this:
|
||||
|
||||
1. Call [`Query.fromHtml`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#fromHtml) on your [`Html`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html#Html) to begin querying it.
|
||||
2. Use queries like [`Query.find`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#find), [`Query.findAll`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#findAll), and [`Query.children`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#children) to find the elements to test.
|
||||
3. Create expectations using things like [`Query.has`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#has) and [`Query.count`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#count).
|
||||
|
||||
These are normal expectations, so you can use them with [`fuzz`](http://package.elm-lang.org/packages/elm-community/elm-test/latest/Test#fuzz) just as easily as with [`test`](http://package.elm-lang.org/packages/elm-community/elm-test/3.1.0/Test#test)!
|
||||
|
||||
## Querying
|
||||
|
||||
Queries come in two flavors: [`Single`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#Single) and [`Multiple`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#Multiple).
|
||||
|
||||
This is because some queries are expected to return a single result, whereas
|
||||
others may return multiple results.
|
||||
|
||||
If a `Single` query finds exactly one result, it will succeed and continue with
|
||||
any further querying or expectations. If it finds zero results, or more than one,
|
||||
the test will fail.
|
||||
|
||||
Since other querying and expectation functions are written in terms of `Single`
|
||||
and `Multiple`, the compiler can help make sure queries are connected as
|
||||
expected. For example, [`count`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#count) accepts a `Multiple`, because counting a single element does not make much sense!
|
||||
|
||||
If you have a `Multiple` and want to use an expectation that works on a `Single`,
|
||||
such as [`Query.has`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#has), you can use [`Query.each`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Query#each) to run the expectation on each of the elements in the `Multiple`.
|
||||
|
||||
## Selecting elements by `Html.Attribute msg`
|
||||
|
||||
Ordinary `Html.Attribute msg` values can be used to select elements using
|
||||
`Test.Html.Selector.attribute`. It is important when using this selector to
|
||||
understand its behavior.
|
||||
|
||||
- `Html.Attributes.class` and `Html.Attributes.classList` will work the same as
|
||||
[`Test.Html.Selector.classes`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Selector#classes),
|
||||
matching any element with at least the given classes. This behavior echoes
|
||||
that of `element.querySelectorAll('.my-class')` from JavaScript, where any
|
||||
element with at least `.my-class` will match the query.
|
||||
|
||||
- `Html.Attributes.style` will work the same way as
|
||||
[`Test.Html.Selector.styles`](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest/Test-Html-Selector#styles),
|
||||
matching any element with at least the given style properties.
|
||||
|
||||
- Any other `String` attributes and properties like `title`, or `Bool`
|
||||
attributes like `disabled` will match elements with the exact value for those
|
||||
attributes.
|
||||
|
||||
- Any attributes from `Html.Events`, or attributes with values that have types
|
||||
other than `String` or `Bool` will not match anything.
|
||||
|
||||
The example below demonstrates usage
|
||||
|
||||
```elm
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test exposing (test, describe)
|
||||
import Test.Html.Query as Query
|
||||
import Test.Html.Selector exposing (attribute, text)
|
||||
|
||||
tests =
|
||||
describe "attributes"
|
||||
[ test "the welcome <h1> says hello!" <|
|
||||
\() ->
|
||||
Html.div [] [ Html.h1 [ Attr.title "greeting" ] [ Html.text "Hello!" ] ]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ attribute <| Attr.title "greeting" ]
|
||||
|> Query.has [ text "Hello!" ]
|
||||
, test "the .Hello.World div has the class Hello" <|
|
||||
\() ->
|
||||
Html.div
|
||||
[ Attr.classList
|
||||
[ ( True, "Hello" )
|
||||
, ( True, "World" )
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.find
|
||||
[ attribute <|
|
||||
Attr.classList [ ( True, Hello ) ]
|
||||
]
|
||||
, test "the header is red" <|
|
||||
\() ->
|
||||
Html.header
|
||||
[ Attr.style
|
||||
[ ( "backround-color", "red" )
|
||||
, ( "color", "yellow" )
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.find
|
||||
[ attribute <|
|
||||
Attr.style [ ( "backround-color", "red" ) ]
|
||||
]
|
||||
]
|
||||
```
|
||||
|
||||
|
||||
## Releases
|
||||
| Version | Notes |
|
||||
| ------- | ----- |
|
||||
| [**5.1.2**](https://github.com/eeue56/elm-html-test/tree/5.1.2) | Fix bug with mapped and lazy views
|
||||
| [**5.1.1**](https://github.com/eeue56/elm-html-test/tree/5.1.1) | Fix children
|
||||
| [**5.1.0**](https://github.com/eeue56/elm-html-test/tree/5.1.0) | Add filtermap
|
||||
| [**5.0.1**](https://github.com/eeue56/elm-html-test/tree/5.0.1) | Fix bug with lazy views
|
||||
| [**5.0.0**](https://github.com/eeue56/elm-html-test/tree/5.0.0) | Allow querying by attributes
|
||||
| [**4.1.0**](https://github.com/eeue56/elm-html-test/tree/4.1.0) | Query styles
|
||||
| [**4.0.0**](https://github.com/eeue56/elm-html-test/tree/4.0.0) | Allow custom events
|
||||
| [**3.0.0**](https://github.com/eeue56/elm-html-test/tree/3.0.0) | Allow events to be testable
|
||||
| [**2.0.0**](https://github.com/eeue56/elm-html-test/tree/2.0.0) | Better support for events by @rogeriochaves
|
||||
| [**1.1.0**](https://github.com/eeue56/elm-html-test/tree/1.1.0) | Support for events by @rogeriochaves
|
||||
| [**1.0.0**](https://github.com/eeue56/elm-html-test/tree/1.0.0) | Initial release
|
||||
23
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/elm-package.json
vendored
Normal file
23
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/elm-package.json
vendored
Normal file
@@ -0,0 +1,23 @@
|
||||
{
|
||||
"version": "5.1.2",
|
||||
"summary": "Write tests for your Html.",
|
||||
"repository": "https://github.com/eeue56/elm-html-test.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": [
|
||||
"Test.Html.Selector",
|
||||
"Test.Html.Query",
|
||||
"Test.Html.Event"
|
||||
],
|
||||
"native-modules": true,
|
||||
"dependencies": {
|
||||
"eeue56/elm-html-in-elm": "5.1.0 <= v < 6.0.0",
|
||||
"eeue56/elm-html-query": "3.0.0 <= v < 4.0.0",
|
||||
"elm-community/elm-test": "4.0.0 <= v < 5.0.0",
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
46
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/examples/.travis.yml
vendored
Normal file
46
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/examples/.travis.yml
vendored
Normal file
@@ -0,0 +1,46 @@
|
||||
sudo: false
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- test/elm-stuff/build-artifacts
|
||||
- sysconfcpus
|
||||
|
||||
os:
|
||||
- osx
|
||||
- linux
|
||||
|
||||
env:
|
||||
matrix:
|
||||
- ELM_VERSION=0.18.0 TARGET_NODE_VERSION=node
|
||||
- ELM_VERSION=0.18.0 TARGET_NODE_VERSION=4.0
|
||||
|
||||
before_install:
|
||||
- if [ ${TRAVIS_OS_NAME} == "osx" ];
|
||||
then brew update; brew install nvm; mkdir ~/.nvm; export NVM_DIR=~/.nvm; source $(brew --prefix nvm)/nvm.sh;
|
||||
fi
|
||||
- echo -e "Host github.com\n\tStrictHostKeyChecking no\n" >> ~/.ssh/config
|
||||
- | # epic build time improvement - see https://github.com/elm-lang/elm-compiler/issues/1473#issuecomment-245704142
|
||||
if [ ! -d sysconfcpus/bin ];
|
||||
then
|
||||
git clone https://github.com/obmarg/libsysconfcpus.git;
|
||||
cd libsysconfcpus;
|
||||
./configure --prefix=$TRAVIS_BUILD_DIR/sysconfcpus;
|
||||
make && make install;
|
||||
cd ..;
|
||||
fi
|
||||
|
||||
install:
|
||||
- nvm install $TARGET_NODE_VERSION
|
||||
- nvm use $TARGET_NODE_VERSION
|
||||
- node --version
|
||||
- npm --version
|
||||
- cd tests
|
||||
- npm install -g elm@$ELM_VERSION elm-test
|
||||
- mv $(npm config get prefix)/bin/elm-make $(npm config get prefix)/bin/elm-make-old
|
||||
- printf '%s\n\n' '#!/bin/bash' 'echo "Running elm-make with sysconfcpus -n 2"' '$TRAVIS_BUILD_DIR/sysconfcpus/bin/sysconfcpus -n 2 elm-make-old "$@"' > $(npm config get prefix)/bin/elm-make
|
||||
- chmod +x $(npm config get prefix)/bin/elm-make
|
||||
- npm install
|
||||
- elm package install --yes
|
||||
|
||||
script:
|
||||
- elm-test
|
||||
57
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/examples/ExampleApp.elm
vendored
Normal file
57
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/examples/ExampleApp.elm
vendored
Normal file
@@ -0,0 +1,57 @@
|
||||
module ExampleApp exposing (..)
|
||||
|
||||
import Html exposing (..)
|
||||
import Html.Attributes exposing (..)
|
||||
import Html.Events exposing (onClick)
|
||||
import Html.Keyed as Keyed
|
||||
import Html.Lazy as Lazy
|
||||
|
||||
|
||||
type alias Model =
|
||||
()
|
||||
|
||||
|
||||
exampleModel : Model
|
||||
exampleModel =
|
||||
()
|
||||
|
||||
|
||||
type Msg
|
||||
= GoToHome
|
||||
| GoToExamples
|
||||
|
||||
|
||||
view : Model -> Html Msg
|
||||
view model =
|
||||
div [ class "container" ]
|
||||
[ header [ class "funky themed", id "heading" ]
|
||||
[ a [ href "http://elm-lang.org", onClick GoToHome ] [ text "home" ]
|
||||
, a [ href "http://elm-lang.org/examples", onClick GoToExamples ] [ text "examples" ]
|
||||
, a [ href "http://elm-lang.org/docs" ] [ text "docs" ]
|
||||
]
|
||||
, section [ class "funky themed", id "section" ]
|
||||
[ someList ]
|
||||
, footer [] [ text "this is the footer" ]
|
||||
]
|
||||
|
||||
|
||||
someList : Html Msg
|
||||
someList =
|
||||
Keyed.ul [ class "some-list" ]
|
||||
[ ( "1"
|
||||
, Lazy.lazy (\_ -> li [ class "list-item themed" ] [ text "first item" ])
|
||||
Nothing
|
||||
)
|
||||
, ( "2"
|
||||
, Lazy.lazy (\_ -> li [ class "list-item themed" ] [ text "second item" ])
|
||||
Nothing
|
||||
)
|
||||
, ( "3"
|
||||
, Lazy.lazy (\_ -> li [ class "list-item themed selected" ] [ text "third item" ])
|
||||
Nothing
|
||||
)
|
||||
, ( "4"
|
||||
, Lazy.lazy (\_ -> li [ class "list-item themed" ] [ text "fourth item" ])
|
||||
Nothing
|
||||
)
|
||||
]
|
||||
117
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/examples/FailingTests.elm
vendored
Normal file
117
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/examples/FailingTests.elm
vendored
Normal file
@@ -0,0 +1,117 @@
|
||||
port module Main exposing (..)
|
||||
|
||||
import ExampleApp exposing (Msg(..), exampleModel, view)
|
||||
import Expect
|
||||
import Json.Encode exposing (Value)
|
||||
import Test exposing (..)
|
||||
import Test.Html.Event as Event
|
||||
import Test.Html.Query as Query
|
||||
import Test.Html.Selector exposing (..)
|
||||
import Test.Runner.Node exposing (TestProgram, run)
|
||||
|
||||
|
||||
main : TestProgram
|
||||
main =
|
||||
[ testView
|
||||
]
|
||||
|> Test.concat
|
||||
|> run emit
|
||||
|
||||
|
||||
port emit : ( String, Value ) -> Cmd msg
|
||||
|
||||
|
||||
testView : Test
|
||||
testView =
|
||||
let
|
||||
output =
|
||||
view exampleModel
|
||||
|> Query.fromHtml
|
||||
in
|
||||
describe "view exampleModel"
|
||||
[ test "expect 4x <li> somewhere on the page" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.count (Expect.equal 4)
|
||||
, test "expect 4x <li> inside a <ul>" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "ul" ]
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.count (Expect.equal 4)
|
||||
, test "(this should fail) expect header to have 4 links in it, even though it has 3" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ id "heading" ]
|
||||
|> Query.findAll [ tag "a" ]
|
||||
|> Query.count (Expect.equal 4)
|
||||
, test "(this should fail) expect header to have one link in it, even though it has 3" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ id "heading" ]
|
||||
|> Query.find [ tag "a" ]
|
||||
|> Query.has [ tag "a" ]
|
||||
, test "(this should fail) expect header to have one <img> in it, even though it has none" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ id "heading" ]
|
||||
|> Query.find [ tag "img" ]
|
||||
|> Query.has [ tag "img" ]
|
||||
, test "(this should fail) expect footer to have a child" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "footer" ]
|
||||
|> Query.children []
|
||||
|> Query.each (Query.has [ tag "catapult" ])
|
||||
, test "(this should fail) expect footer's nonexistant child to be a catapult" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "footer" ]
|
||||
|> Query.children []
|
||||
|> Query.first
|
||||
|> Query.has [ tag "catapult" ]
|
||||
, test "expect footer to have footer text" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "footer" ]
|
||||
|> Query.has [ tag "footer", text "this is the footer" ]
|
||||
, test "(this should fail) expect footer to have text it doesn't have" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "footer" ]
|
||||
|> Query.has [ tag "footer", text "this is SPARTA!!!" ]
|
||||
, test "expect each <li> to have classes list-item and themed" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "ul" ]
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.each (Query.has [ classes [ "list-item", "themed" ] ])
|
||||
, test "expect first a to send GoToHome onClick" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "a" ]
|
||||
|> Query.first
|
||||
|> Events.simulate Click
|
||||
|> Expect.equal (Ok GoToHome)
|
||||
, test "(this should fail) expect first a to return GoToExamples on click, even though it returns GoToHome" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "a" ]
|
||||
|> Query.first
|
||||
|> Events.simulate Click
|
||||
|> Expect.equal (Ok GoToExamples)
|
||||
, test "(this should fail) expect first a to return a msg for a blur event, even though it doesn't have one" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "a" ]
|
||||
|> Query.first
|
||||
|> Events.simulate Blur
|
||||
|> Expect.equal (Ok GoToHome)
|
||||
, test "(this should fail) expect text to return a msg for click, even though it is a text" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ text "home" ]
|
||||
|> Events.simulate Click
|
||||
|> Expect.equal (Ok GoToHome)
|
||||
]
|
||||
22
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/examples/elm-package.json
vendored
Normal file
22
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/examples/elm-package.json
vendored
Normal file
@@ -0,0 +1,22 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "helpful summary of your project, less than 80 characters",
|
||||
"repository": "https://github.com/eeue56/elm-html-test.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
".",
|
||||
"../src"
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"native-modules": true,
|
||||
"dependencies": {
|
||||
"eeue56/elm-html-in-elm": "3.0.0 <= v < 4.0.0",
|
||||
"eeue56/elm-html-query": "1.1.0 <= v < 2.0.0",
|
||||
"elm-community/elm-test": "3.1.0 <= v < 4.0.0",
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||
"rtfeldman/html-test-runner": "2.0.0 <= v < 3.0.0",
|
||||
"rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
89
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Html/Inert.elm
vendored
Normal file
89
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Html/Inert.elm
vendored
Normal file
@@ -0,0 +1,89 @@
|
||||
module Html.Inert exposing (Node, parseAttribute, fromElmHtml, fromHtml, toElmHtml)
|
||||
|
||||
{-| Inert Html - that is, can't do anything with events.
|
||||
-}
|
||||
|
||||
import ElmHtml.InternalTypes exposing (ElmHtml(..), EventHandler, Facts, Tagger, decodeElmHtml, decodeAttribute)
|
||||
import Html exposing (Html)
|
||||
import Json.Decode
|
||||
import Native.HtmlAsJson
|
||||
|
||||
|
||||
type Node msg
|
||||
= Node (ElmHtml msg)
|
||||
|
||||
|
||||
fromHtml : Html msg -> Node msg
|
||||
fromHtml html =
|
||||
case Json.Decode.decodeValue (decodeElmHtml taggedEventDecoder) (toJson html) of
|
||||
Ok elmHtml ->
|
||||
Node elmHtml
|
||||
|
||||
Err str ->
|
||||
Debug.crash ("Error internally processing HTML for testing - please report this error message as a bug: " ++ str)
|
||||
|
||||
|
||||
fromElmHtml : ElmHtml msg -> Node msg
|
||||
fromElmHtml =
|
||||
Node
|
||||
|
||||
|
||||
{-| Convert a Html node to a Json string
|
||||
-}
|
||||
toJson : Html a -> Json.Decode.Value
|
||||
toJson node =
|
||||
Native.HtmlAsJson.toJson node
|
||||
|
||||
|
||||
toElmHtml : Node msg -> ElmHtml msg
|
||||
toElmHtml (Node elmHtml) =
|
||||
elmHtml
|
||||
|
||||
|
||||
impossibleMessage : String
|
||||
impossibleMessage =
|
||||
"An Inert Node fired an event handler. This should never happen! Please report this bug."
|
||||
|
||||
|
||||
attributeToJson : Html.Attribute a -> Json.Decode.Value
|
||||
attributeToJson attribute =
|
||||
Native.HtmlAsJson.attributeToJson attribute
|
||||
|
||||
|
||||
parseAttribute : Html.Attribute a -> ElmHtml.InternalTypes.Attribute
|
||||
parseAttribute attr =
|
||||
case Json.Decode.decodeValue decodeAttribute (attributeToJson attr) of
|
||||
Ok parsedAttribute ->
|
||||
parsedAttribute
|
||||
|
||||
Err str ->
|
||||
Debug.crash ("Error internally processing Attribute for testing - please report this error message as a bug: " ++ str)
|
||||
|
||||
|
||||
{-| Gets the function out of a tagger
|
||||
-}
|
||||
taggerFunction : Tagger -> (a -> msg)
|
||||
taggerFunction tagger =
|
||||
Native.HtmlAsJson.taggerFunction tagger
|
||||
|
||||
|
||||
{-| Gets the decoder out of an EventHandler
|
||||
-}
|
||||
eventDecoder : EventHandler -> Json.Decode.Decoder msg
|
||||
eventDecoder eventHandler =
|
||||
Native.HtmlAsJson.eventDecoder eventHandler
|
||||
|
||||
|
||||
{-| Applies the taggers over the event handlers to have the complete event decoder
|
||||
-}
|
||||
taggedEventDecoder : List Tagger -> EventHandler -> Json.Decode.Decoder msg
|
||||
taggedEventDecoder taggers eventHandler =
|
||||
case taggers of
|
||||
[] ->
|
||||
eventDecoder eventHandler
|
||||
|
||||
[ tagger ] ->
|
||||
Json.Decode.map (taggerFunction tagger) (eventDecoder eventHandler)
|
||||
|
||||
tagger :: taggers ->
|
||||
Json.Decode.map (taggerFunction tagger) (taggedEventDecoder taggers eventHandler)
|
||||
32
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Native/HtmlAsJson.js
vendored
Normal file
32
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Native/HtmlAsJson.js
vendored
Normal file
@@ -0,0 +1,32 @@
|
||||
var _eeue56$elm_html_test$Native_HtmlAsJson = (function() {
|
||||
function forceThunks(vNode) {
|
||||
if (typeof vNode !== "undefined" && vNode.ctor === "_Tuple2" && !vNode.node) {
|
||||
vNode._1 = forceThunks(vNode._1);
|
||||
}
|
||||
if (typeof vNode !== 'undefined' && vNode.type === 'thunk' && !vNode.node) {
|
||||
vNode.node = vNode.thunk.apply(vNode.thunk, vNode.args);
|
||||
}
|
||||
if (typeof vNode !== 'undefined' && vNode.type === 'tagger') {
|
||||
vNode.node = forceThunks(vNode.node);
|
||||
}
|
||||
if (typeof vNode !== 'undefined' && typeof vNode.children !== 'undefined') {
|
||||
vNode.children = vNode.children.map(forceThunks);
|
||||
}
|
||||
return vNode;
|
||||
}
|
||||
|
||||
return {
|
||||
toJson: function(html) {
|
||||
return forceThunks(html);
|
||||
},
|
||||
eventDecoder: function (event) {
|
||||
return event.decoder;
|
||||
},
|
||||
taggerFunction: function (tagger) {
|
||||
return tagger;
|
||||
},
|
||||
attributeToJson: function(attribute) {
|
||||
return attribute;
|
||||
}
|
||||
};
|
||||
})();
|
||||
@@ -0,0 +1,30 @@
|
||||
module Test.Html.Descendant exposing (isDescendant)
|
||||
|
||||
import Html exposing (Html)
|
||||
import ElmHtml.InternalTypes exposing (ElmHtml(..))
|
||||
import Html.Inert exposing (fromHtml, toElmHtml)
|
||||
|
||||
|
||||
isDescendant : List (ElmHtml msg) -> ElmHtml msg -> Bool
|
||||
isDescendant html potentialDescendant =
|
||||
case html of
|
||||
[] ->
|
||||
False
|
||||
|
||||
current :: rest ->
|
||||
if current == potentialDescendant then
|
||||
True
|
||||
else
|
||||
isDescendant
|
||||
(prependChildren current rest)
|
||||
potentialDescendant
|
||||
|
||||
|
||||
prependChildren : ElmHtml msg -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
prependChildren parentNode nodeList =
|
||||
case parentNode of
|
||||
NodeEntry { children } ->
|
||||
(List.concat [ children, nodeList ])
|
||||
|
||||
_ ->
|
||||
nodeList
|
||||
314
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Test/Html/Event.elm
vendored
Normal file
314
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Test/Html/Event.elm
vendored
Normal file
@@ -0,0 +1,314 @@
|
||||
module Test.Html.Event
|
||||
exposing
|
||||
( Event
|
||||
, simulate
|
||||
, expect
|
||||
, toResult
|
||||
, click
|
||||
, doubleClick
|
||||
, mouseDown
|
||||
, mouseUp
|
||||
, mouseEnter
|
||||
, mouseLeave
|
||||
, mouseOver
|
||||
, mouseOut
|
||||
, input
|
||||
, check
|
||||
, submit
|
||||
, blur
|
||||
, focus
|
||||
, custom
|
||||
)
|
||||
|
||||
{-| This module lets you simulate events on `Html` values and expect that
|
||||
they result in certain `Msg` values being sent to `update`.
|
||||
|
||||
|
||||
## Simulating Events
|
||||
|
||||
@docs Event, simulate, expect, toResult
|
||||
|
||||
|
||||
## Event Builders
|
||||
|
||||
@docs custom, click, doubleClick, mouseDown, mouseUp, mouseEnter, mouseLeave, mouseOver, mouseOut, input, check, submit, blur, focus
|
||||
|
||||
-}
|
||||
|
||||
import Dict
|
||||
import ElmHtml.InternalTypes exposing (ElmHtml, ElmHtml(..), Tagger)
|
||||
import Json.Decode as Decode exposing (Decoder)
|
||||
import Json.Encode as Encode exposing (Value)
|
||||
import Test.Html.Query as Query
|
||||
import Test.Html.Query.Internal as QueryInternal
|
||||
import Expect exposing (Expectation)
|
||||
|
||||
|
||||
{-| A simulated event.
|
||||
|
||||
See [`simulate`](#simulate).
|
||||
|
||||
-}
|
||||
type Event msg
|
||||
= Event ( String, Value ) (QueryInternal.Single msg)
|
||||
|
||||
|
||||
{-| Simulate an event on a node.
|
||||
|
||||
import Test.Html.Event as Event
|
||||
|
||||
type Msg
|
||||
= Change String
|
||||
|
||||
|
||||
test "Input produces expected Msg" <|
|
||||
\() ->
|
||||
Html.input [ onInput Change ] [ ]
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.input "cats")
|
||||
|> Event.expect (Change "cats")
|
||||
|
||||
-}
|
||||
simulate : ( String, Value ) -> Query.Single msg -> Event msg
|
||||
simulate =
|
||||
Event
|
||||
|
||||
|
||||
{-| Passes if the given message is triggered by the simulated event.
|
||||
|
||||
import Test.Html.Event as Event
|
||||
|
||||
type Msg
|
||||
= Change String
|
||||
|
||||
|
||||
test "Input produces expected Msg" <|
|
||||
\() ->
|
||||
Html.input [ onInput Change ] [ ]
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.input "cats")
|
||||
|> Event.expect (Change "cats")
|
||||
|
||||
-}
|
||||
expect : msg -> Event msg -> Expectation
|
||||
expect msg (Event event (QueryInternal.Single showTrace query)) =
|
||||
case toResult (Event event (QueryInternal.Single showTrace query)) of
|
||||
Err noEvent ->
|
||||
Expect.fail noEvent
|
||||
|> QueryInternal.failWithQuery showTrace "" query
|
||||
|
||||
Ok foundMsg ->
|
||||
foundMsg
|
||||
|> Expect.equal msg
|
||||
|> QueryInternal.failWithQuery showTrace ("Event.expectEvent: Expected the msg \x1B[32m" ++ toString msg ++ "\x1B[39m from the event \x1B[31m" ++ toString event ++ "\x1B[39m but could not find the event.") query
|
||||
|
||||
|
||||
{-| Returns a Result with the Msg produced by the event simulated on a node.
|
||||
Note that Event.expect gives nicer messages; this is generally more useful
|
||||
when testing that an event handler is *not* present.
|
||||
|
||||
import Test.Html.Event as Event
|
||||
|
||||
|
||||
test "Input produces expected Msg" <|
|
||||
\() ->
|
||||
Html.input [ onInput Change ] [ ]
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.input "cats")
|
||||
|> Event.toResult
|
||||
|> Expect.equal (Ok (Change "cats"))
|
||||
|
||||
-}
|
||||
toResult : Event msg -> Result String msg
|
||||
toResult (Event ( eventName, jsEvent ) (QueryInternal.Single showTrace query)) =
|
||||
let
|
||||
node =
|
||||
QueryInternal.traverse query
|
||||
|> Result.andThen (QueryInternal.verifySingle eventName)
|
||||
|> Result.mapError (QueryInternal.queryErrorToString query)
|
||||
in
|
||||
case node of
|
||||
Err msg ->
|
||||
Err msg
|
||||
|
||||
Ok single ->
|
||||
findEvent eventName single
|
||||
|> Result.andThen (\foundEvent -> Decode.decodeValue foundEvent jsEvent)
|
||||
|
||||
|
||||
|
||||
-- EVENTS --
|
||||
|
||||
|
||||
{-| A [`click`](https://developer.mozilla.org/en-US/docs/Web/Events/click) event.
|
||||
-}
|
||||
click : ( String, Value )
|
||||
click =
|
||||
( "click", emptyObject )
|
||||
|
||||
|
||||
{-| A [`dblclick`](https://developer.mozilla.org/en-US/docs/Web/Events/dblclick) event.
|
||||
-}
|
||||
doubleClick : ( String, Value )
|
||||
doubleClick =
|
||||
( "dblclick", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mousedown`](https://developer.mozilla.org/en-US/docs/Web/Events/mousedown) event.
|
||||
-}
|
||||
mouseDown : ( String, Value )
|
||||
mouseDown =
|
||||
( "mousedown", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseup`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseup) event.
|
||||
-}
|
||||
mouseUp : ( String, Value )
|
||||
mouseUp =
|
||||
( "mouseup", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseenter`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseenter) event.
|
||||
-}
|
||||
mouseEnter : ( String, Value )
|
||||
mouseEnter =
|
||||
( "mouseenter", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseleave`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseleave) event.
|
||||
-}
|
||||
mouseLeave : ( String, Value )
|
||||
mouseLeave =
|
||||
( "mouseleave", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseover`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseover) event.
|
||||
-}
|
||||
mouseOver : ( String, Value )
|
||||
mouseOver =
|
||||
( "mouseover", emptyObject )
|
||||
|
||||
|
||||
{-| A [`mouseout`](https://developer.mozilla.org/en-US/docs/Web/Events/mouseout) event.
|
||||
-}
|
||||
mouseOut : ( String, Value )
|
||||
mouseOut =
|
||||
( "mouseout", emptyObject )
|
||||
|
||||
|
||||
{-| An [`input`](https://developer.mozilla.org/en-US/docs/Web/Events/input) event.
|
||||
-}
|
||||
input : String -> ( String, Value )
|
||||
input value =
|
||||
( "input"
|
||||
, Encode.object
|
||||
[ ( "target"
|
||||
, Encode.object [ ( "value", Encode.string value ) ]
|
||||
)
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
{-| A [`change`](https://developer.mozilla.org/en-US/docs/Web/Events/change) event
|
||||
where `event.target.checked` is set to the given `Bool` value.
|
||||
-}
|
||||
check : Bool -> ( String, Value )
|
||||
check checked =
|
||||
( "change"
|
||||
, Encode.object
|
||||
[ ( "target"
|
||||
, Encode.object [ ( "checked", Encode.bool checked ) ]
|
||||
)
|
||||
]
|
||||
)
|
||||
|
||||
|
||||
{-| A [`submit`](https://developer.mozilla.org/en-US/docs/Web/Events/submit) event.
|
||||
-}
|
||||
submit : ( String, Value )
|
||||
submit =
|
||||
( "submit", emptyObject )
|
||||
|
||||
|
||||
{-| A [`blur`](https://developer.mozilla.org/en-US/docs/Web/Events/blur) event.
|
||||
-}
|
||||
blur : ( String, Value )
|
||||
blur =
|
||||
( "blur", emptyObject )
|
||||
|
||||
|
||||
{-| A [`focus`](https://developer.mozilla.org/en-US/docs/Web/Events/focus) event.
|
||||
-}
|
||||
focus : ( String, Value )
|
||||
focus =
|
||||
( "focus", emptyObject )
|
||||
|
||||
|
||||
{-| Simulate a custom event. The `String` is the event name, and the `Value` is the event object
|
||||
the browser would send to the event listener callback.
|
||||
|
||||
import Test.Html.Event as Event
|
||||
import Json.Encode as Encode exposing (Value)
|
||||
|
||||
|
||||
type Msg
|
||||
= Change String
|
||||
|
||||
|
||||
test "Input produces expected Msg" <|
|
||||
\() ->
|
||||
let
|
||||
simulatedEventObject : Value
|
||||
simulatedEventObject =
|
||||
Encode.object
|
||||
[ ( "target"
|
||||
, Encode.object [ ( "value", Encode.string "cats" ) ]
|
||||
)
|
||||
]
|
||||
in
|
||||
Html.input [ onInput Change ] [ ]
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.custom "input" simulatedEventObject)
|
||||
|> Event.expect (Change "cats")
|
||||
|
||||
-}
|
||||
custom : String -> Value -> ( String, Value )
|
||||
custom =
|
||||
(,)
|
||||
|
||||
|
||||
|
||||
-- INTERNAL --
|
||||
|
||||
|
||||
emptyObject : Value
|
||||
emptyObject =
|
||||
Encode.object []
|
||||
|
||||
|
||||
findEvent : String -> ElmHtml msg -> Result String (Decoder msg)
|
||||
findEvent eventName element =
|
||||
let
|
||||
elementOutput =
|
||||
QueryInternal.prettyPrint element
|
||||
|
||||
eventDecoder node =
|
||||
node.facts.events
|
||||
|> Dict.get eventName
|
||||
|> Result.fromMaybe ("Event.expectEvent: The event " ++ eventName ++ " does not exist on the found node.\n\n" ++ elementOutput)
|
||||
in
|
||||
case element of
|
||||
TextTag _ ->
|
||||
Err ("Found element is a text, which does not produce events, therefore could not simulate " ++ eventName ++ " on it. Text found: " ++ elementOutput)
|
||||
|
||||
NodeEntry node ->
|
||||
eventDecoder node
|
||||
|
||||
CustomNode node ->
|
||||
eventDecoder node
|
||||
|
||||
MarkdownNode node ->
|
||||
eventDecoder node
|
||||
|
||||
NoOp ->
|
||||
Err ("Unknown element found. Could not simulate " ++ eventName ++ " on it.")
|
||||
471
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Test/Html/Query.elm
vendored
Normal file
471
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Test/Html/Query.elm
vendored
Normal file
@@ -0,0 +1,471 @@
|
||||
module Test.Html.Query
|
||||
exposing
|
||||
( Multiple
|
||||
, Single
|
||||
, children
|
||||
, contains
|
||||
, count
|
||||
, each
|
||||
, find
|
||||
, findAll
|
||||
, first
|
||||
, fromHtml
|
||||
, has
|
||||
, hasNot
|
||||
, index
|
||||
, keep
|
||||
)
|
||||
|
||||
{-| Querying HTML structure.
|
||||
|
||||
@docs Single, Multiple, fromHtml
|
||||
|
||||
|
||||
## Querying
|
||||
|
||||
@docs find, findAll, children, first, index, keep
|
||||
|
||||
|
||||
## Expecting
|
||||
|
||||
@docs count, contains, has, hasNot, each
|
||||
|
||||
-}
|
||||
|
||||
import ElmHtml.InternalTypes exposing (ElmHtml)
|
||||
import Expect exposing (Expectation)
|
||||
import Html exposing (Html)
|
||||
import Html.Inert as Inert
|
||||
import Test.Html.Query.Internal as Internal exposing (QueryError(..), failWithQuery)
|
||||
import Test.Html.Selector.Internal as Selector exposing (Selector, selectorToString)
|
||||
|
||||
|
||||
{- DESIGN NOTES:
|
||||
|
||||
The reason for having `Query.index` and `Query.first` instead of doing them as
|
||||
selectors (which would let you do e.g. `Query.find [ first ]` to get the
|
||||
first child, instead of `Query.children [] |> Query.first` like you have to
|
||||
do now) is that it's not immediately obvious what a query like this would do:
|
||||
|
||||
Query.findAll [ first, tag "li" ]
|
||||
|
||||
Is that getting the first descendant, and then checking whether it's an <li>?
|
||||
Or is it finding the first <li> descendant? (Yes.) Also this is a findAll
|
||||
but it's only ever returning a single result despite being typed as a Multiple.
|
||||
|
||||
Arguably `id` could be treated the same way - since you *should* only have
|
||||
one id, *should* only ever return one result. However, in that case, it's
|
||||
possible that you have multiple IDs - and in that case you actually want the
|
||||
test to fail so you find out about the mistake!
|
||||
-}
|
||||
|
||||
|
||||
{-| A query that expects to find exactly one element.
|
||||
|
||||
Contrast with [`Multiple`](#Multiple).
|
||||
|
||||
-}
|
||||
type alias Single msg =
|
||||
Internal.Single msg
|
||||
|
||||
|
||||
{-| A query that may find any number of elements, including zero.
|
||||
|
||||
Contrast with [`Single`](#Single).
|
||||
|
||||
-}
|
||||
type alias Multiple msg =
|
||||
Internal.Multiple msg
|
||||
|
||||
|
||||
{-| Translate a `Html` value into a `Single` query. This is how queries
|
||||
typically begin.
|
||||
|
||||
import Html
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (text)
|
||||
|
||||
|
||||
test "Button has the expected text" <|
|
||||
\() ->
|
||||
Html.button [] [ Html.text "I'm a button!" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ text "I'm a button!" ]
|
||||
|
||||
-}
|
||||
fromHtml : Html msg -> Single msg
|
||||
fromHtml html =
|
||||
Internal.Query (Inert.fromHtml html) []
|
||||
|> Internal.Single True
|
||||
|
||||
|
||||
|
||||
-- TRAVERSAL --
|
||||
|
||||
|
||||
{-| Find the descendant elements which match all the given selectors.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag)
|
||||
import Expect
|
||||
|
||||
|
||||
test "The list has three items" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.count (Expect.equal 3)
|
||||
|
||||
-}
|
||||
findAll : List Selector -> Single msg -> Multiple msg
|
||||
findAll selectors (Internal.Single showTrace query) =
|
||||
Internal.FindAll selectors
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Multiple showTrace
|
||||
|
||||
|
||||
{-| Find the descendant elements of the result of `findAll` which match all the given selectors.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag)
|
||||
import Expect
|
||||
|
||||
|
||||
test "The list has three items" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ a [] [ text "first item" ]]
|
||||
, li [] [ a [] [ text "second item" ]]
|
||||
, li [] [ a [] [ text "third item" ]]
|
||||
, li [] [ button [] [ text "button" ]]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.keep ( tag "a" )
|
||||
|> Expect.all
|
||||
[ Query.each (Query.has [ tag "a" ])
|
||||
, Query.first >> Query.has [ text "first item" ]
|
||||
]
|
||||
|
||||
-}
|
||||
keep : Selector -> Multiple msg -> Multiple msg
|
||||
keep selector (Internal.Multiple showTrace query) =
|
||||
Internal.FindAll [ selector ]
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Multiple showTrace
|
||||
|
||||
|
||||
{-| Return the matched element's immediate child elements.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The <ul> only has <li> children" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [ class "item"] [ text "first item" ]
|
||||
, li [ class "item selected"] [ text "second item" ]
|
||||
, li [ class "item"] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ class "items" ]
|
||||
|> Query.children [ class "selected" ]
|
||||
|> Query.count (Expect.equal 1)
|
||||
|
||||
-}
|
||||
children : List Selector -> Single msg -> Multiple msg
|
||||
children selectors (Internal.Single showTrace query) =
|
||||
Internal.Children selectors
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Multiple showTrace
|
||||
|
||||
|
||||
{-| Find exactly one descendant element which matches all the given selectors.
|
||||
If no descendants match, or if more than one matches, the test will fail.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The list has both the classes 'items' and 'active'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "ul" ]
|
||||
|> Query.has [ classes [ "items", "active" ] ]
|
||||
|
||||
-}
|
||||
find : List Selector -> Single msg -> Single msg
|
||||
find selectors (Internal.Single showTrace query) =
|
||||
Internal.Find selectors
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Single showTrace
|
||||
|
||||
|
||||
{-| Return the first element in a match. If there were no matches, the test
|
||||
will fail.
|
||||
|
||||
`Query.first` is a shorthand for `Query.index 0` - they do the same thing.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The first <li> is called 'first item'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.first
|
||||
|> Query.has [ text "first item" ]
|
||||
|
||||
-}
|
||||
first : Multiple msg -> Single msg
|
||||
first (Internal.Multiple showTrace query) =
|
||||
Internal.First
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Single showTrace
|
||||
|
||||
|
||||
{-| Return the element in a match at the given index. For example,
|
||||
`Query.index 0` would match the first element, and `Query.index 1` would match
|
||||
the second element.
|
||||
|
||||
You can pass negative numbers to "wrap around" - for example, `Query.index -1`
|
||||
will match the last element, and `Query.index -2` will match the second-to-last.
|
||||
|
||||
If the index falls outside the bounds of the match, the test will fail.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The second <li> is called 'second item'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.index 1
|
||||
|> Query.has [ text "second item" ]
|
||||
|
||||
-}
|
||||
index : Int -> Multiple msg -> Single msg
|
||||
index position (Internal.Multiple showTrace query) =
|
||||
Internal.Index position
|
||||
|> Internal.prependSelector query
|
||||
|> Internal.Single showTrace
|
||||
|
||||
|
||||
|
||||
-- EXPECTATIONS --
|
||||
|
||||
|
||||
{-| Expect the number of elements matching the query fits the given expectation.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag)
|
||||
import Expect
|
||||
|
||||
|
||||
test "The list has three items" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.count (Expect.equal 3)
|
||||
|
||||
-}
|
||||
count : (Int -> Expectation) -> Multiple msg -> Expectation
|
||||
count expect ((Internal.Multiple showTrace query) as multiple) =
|
||||
(List.length >> expect >> failWithQuery showTrace "Query.count" query)
|
||||
|> Internal.multipleToExpectation multiple
|
||||
|
||||
|
||||
{-| Expect the element to have at least one descendant matching
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The list has two li: one with the text \"third item\" and \
|
||||
another one with \"first item\"" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.contains
|
||||
[ li [] [ text "third item" ]
|
||||
, li [] [ text "first item" ]
|
||||
]
|
||||
|
||||
-}
|
||||
contains : List (Html msg) -> Single msg -> Expectation
|
||||
contains expectedHtml (Internal.Single showTrace query) =
|
||||
let
|
||||
expectedElmHtml =
|
||||
List.map htmlToElm expectedHtml
|
||||
in
|
||||
Internal.contains
|
||||
expectedElmHtml
|
||||
query
|
||||
|> failWithQuery showTrace "Query.contains" query
|
||||
|
||||
|
||||
htmlToElm : Html msg -> ElmHtml msg
|
||||
htmlToElm =
|
||||
Inert.fromHtml >> Inert.toElmHtml
|
||||
|
||||
|
||||
{-| Expect the element to match all of the given selectors.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The list has both the classes 'items' and 'active'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "ul" ]
|
||||
|> Query.has [ tag "ul", classes [ "items", "active" ] ]
|
||||
|
||||
-}
|
||||
has : List Selector -> Single msg -> Expectation
|
||||
has selectors (Internal.Single showTrace query) =
|
||||
Internal.has selectors query
|
||||
|> failWithQuery showTrace ("Query.has " ++ Internal.joinAsList selectorToString selectors) query
|
||||
|
||||
|
||||
{-| Expect the element to **not** match all of the given selectors.
|
||||
|
||||
import Html exposing (div)
|
||||
import Html.Attributes as Attributes
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, class)
|
||||
|
||||
|
||||
test "The div element has no progress-bar class" <|
|
||||
\() ->
|
||||
div [ Attributes.class "button" ] []
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "div" ]
|
||||
|> Query.hasNot [ tag "div", class "progress-bar" ]
|
||||
|
||||
-}
|
||||
hasNot : List Selector -> Single msg -> Expectation
|
||||
hasNot selectors (Internal.Single showTrace query) =
|
||||
let
|
||||
queryName =
|
||||
"Query.hasNot " ++ Internal.joinAsList selectorToString selectors
|
||||
in
|
||||
Internal.hasNot selectors query
|
||||
|> failWithQuery showTrace queryName query
|
||||
|
||||
|
||||
{-| Expect that a [`Single`](#Single) expectation will hold true for each of the
|
||||
[`Multiple`](#Multiple) matched elements.
|
||||
|
||||
import Html exposing (div, ul, li)
|
||||
import Html.Attributes exposing (class)
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, classes)
|
||||
|
||||
|
||||
test "The list has both the classes 'items' and 'active'" <|
|
||||
\() ->
|
||||
div []
|
||||
[ ul [ class "items active" ]
|
||||
[ li [] [ text "first item" ]
|
||||
, li [] [ text "second item" ]
|
||||
, li [] [ text "third item" ]
|
||||
]
|
||||
]
|
||||
|> Query.fromHtml
|
||||
|> Query.findAll [ tag "ul" ]
|
||||
|> Query.each
|
||||
[ Query.has [ tag "ul" ]
|
||||
, Query.has [ classes [ "items", "active" ] ]
|
||||
]
|
||||
|
||||
-}
|
||||
each : (Single msg -> Expectation) -> Multiple msg -> Expectation
|
||||
each check (Internal.Multiple showTrace query) =
|
||||
Internal.expectAll check query
|
||||
|> failWithQuery showTrace "Query.each" query
|
||||
@@ -0,0 +1,559 @@
|
||||
module Test.Html.Query.Internal exposing (..)
|
||||
|
||||
import ElmHtml.InternalTypes exposing (ElmHtml(..))
|
||||
import ElmHtml.ToString exposing (nodeToStringWithOptions)
|
||||
import Expect exposing (Expectation)
|
||||
import Html.Inert as Inert exposing (Node)
|
||||
import Test.Html.Descendant as Descendant
|
||||
import Test.Html.Selector.Internal as InternalSelector exposing (Selector, selectorToString)
|
||||
import Test.Runner
|
||||
|
||||
|
||||
{-| Note: the selectors are stored in reverse order for better prepending perf.
|
||||
-}
|
||||
type Query msg
|
||||
= Query (Inert.Node msg) (List SelectorQuery)
|
||||
|
||||
|
||||
type SelectorQuery
|
||||
= Find (List Selector)
|
||||
| FindAll (List Selector)
|
||||
| Children (List Selector)
|
||||
-- First and Index are separate so we can report Query.first in error messages
|
||||
| First
|
||||
| Index Int
|
||||
|
||||
|
||||
{-| The Bool is `showTrace` - whether to show the Query.fromHtml trace at
|
||||
the beginning of the error message.
|
||||
|
||||
We need to track this so that Query.each can turn it off. Otherwise you get
|
||||
fromHtml printed twice - once at the very top, then again for the nested
|
||||
expectation that Query.each delegated to.
|
||||
|
||||
-}
|
||||
type Single msg
|
||||
= Single Bool (Query msg)
|
||||
|
||||
|
||||
{-| The Bool is `showTrace` - see `Single` for more info.
|
||||
-}
|
||||
type Multiple msg
|
||||
= Multiple Bool (Query msg)
|
||||
|
||||
|
||||
type QueryError
|
||||
= NoResultsForSingle String
|
||||
| MultipleResultsForSingle String Int
|
||||
|
||||
|
||||
toLines : String -> Query msg -> String -> List String
|
||||
toLines expectationFailure (Query node selectors) queryName =
|
||||
toLinesHelp expectationFailure [ Inert.toElmHtml node ] (List.reverse selectors) queryName []
|
||||
|> List.reverse
|
||||
|
||||
|
||||
prettyPrint : ElmHtml msg -> String
|
||||
prettyPrint =
|
||||
nodeToStringWithOptions { indent = 4, newLines = True }
|
||||
|
||||
|
||||
toOutputLine : Query msg -> String
|
||||
toOutputLine (Query node selectors) =
|
||||
prettyPrint (Inert.toElmHtml node)
|
||||
|
||||
|
||||
toLinesHelp : String -> List (ElmHtml msg) -> List SelectorQuery -> String -> List String -> List String
|
||||
toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results =
|
||||
let
|
||||
bailOut result =
|
||||
-- Bail out early so the last error message the user
|
||||
-- sees is Query.find rather than something like
|
||||
-- Query.has, to reflect how we didn't make it that far.
|
||||
String.join "\n\n\n✗ " [ result, expectationFailure ] :: results
|
||||
|
||||
recurse newElmHtmlList rest result =
|
||||
toLinesHelp
|
||||
expectationFailure
|
||||
newElmHtmlList
|
||||
rest
|
||||
queryName
|
||||
(result :: results)
|
||||
in
|
||||
case selectorQueries of
|
||||
[] ->
|
||||
String.join "\n\n" [ queryName, expectationFailure ] :: results
|
||||
|
||||
selectorQuery :: rest ->
|
||||
case selectorQuery of
|
||||
FindAll selectors ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAll selectors
|
||||
in
|
||||
("Query.findAll " ++ joinAsList selectorToString selectors)
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
|> recurse elements rest
|
||||
|
||||
Find selectors ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAll selectors
|
||||
|
||||
result =
|
||||
("Query.find " ++ joinAsList selectorToString selectors)
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
in
|
||||
if List.length elements == 1 then
|
||||
recurse elements rest result
|
||||
else
|
||||
bailOut result
|
||||
|
||||
Children selectors ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAllChildren selectors
|
||||
in
|
||||
("Query.children " ++ joinAsList selectorToString selectors)
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
|> recurse elements rest
|
||||
|
||||
First ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> List.head
|
||||
|> Maybe.map (\elem -> [ elem ])
|
||||
|> Maybe.withDefault []
|
||||
|
||||
result =
|
||||
"Query.first"
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
in
|
||||
if List.length elements == 1 then
|
||||
recurse elements rest result
|
||||
else
|
||||
bailOut result
|
||||
|
||||
Index index ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> getElementAt index
|
||||
|
||||
result =
|
||||
("Query.index " ++ toString index)
|
||||
|> withHtmlContext (getHtmlContext elements)
|
||||
in
|
||||
if List.length elements == 1 then
|
||||
recurse elements rest result
|
||||
else
|
||||
bailOut result
|
||||
|
||||
|
||||
withHtmlContext : String -> String -> String
|
||||
withHtmlContext htmlStr str =
|
||||
String.join "\n\n" [ str, htmlStr ]
|
||||
|
||||
|
||||
getHtmlContext : List (ElmHtml msg) -> String
|
||||
getHtmlContext elmHtmlList =
|
||||
if List.isEmpty elmHtmlList then
|
||||
"0 matches found for this query."
|
||||
else
|
||||
let
|
||||
maxDigits =
|
||||
elmHtmlList
|
||||
|> List.length
|
||||
|> toString
|
||||
|> String.length
|
||||
in
|
||||
elmHtmlList
|
||||
|> List.indexedMap (printIndented maxDigits)
|
||||
|> String.join "\n\n"
|
||||
|
||||
|
||||
joinAsList : (a -> String) -> List a -> String
|
||||
joinAsList toStr list =
|
||||
if List.isEmpty list then
|
||||
"[]"
|
||||
else
|
||||
"[ " ++ String.join ", " (List.map toStr list) ++ " ]"
|
||||
|
||||
|
||||
printIndented : Int -> Int -> ElmHtml msg -> String
|
||||
printIndented maxDigits index elmHtml =
|
||||
let
|
||||
caption =
|
||||
(toString (index + 1) ++ ")")
|
||||
|> String.padRight (maxDigits + 3) ' '
|
||||
|> String.append baseIndentation
|
||||
|
||||
indentation =
|
||||
String.repeat (String.length caption) " "
|
||||
in
|
||||
case String.split "\n" (prettyPrint elmHtml) of
|
||||
[] ->
|
||||
""
|
||||
|
||||
first :: rest ->
|
||||
rest
|
||||
|> List.map (String.append indentation)
|
||||
|> (::) (caption ++ first)
|
||||
|> String.join "\n"
|
||||
|
||||
|
||||
baseIndentation : String
|
||||
baseIndentation =
|
||||
" "
|
||||
|
||||
|
||||
prependSelector : Query msg -> SelectorQuery -> Query msg
|
||||
prependSelector (Query node selectors) selector =
|
||||
Query node (selector :: selectors)
|
||||
|
||||
|
||||
{-| This is a more efficient implementation of the following:
|
||||
|
||||
list
|
||||
|> Array.fromList
|
||||
|> Array.get index
|
||||
|> Maybe.map (\elem -> [ elem ])
|
||||
|> Maybe.withDefault []
|
||||
|
||||
It also supports wraparound via negative indeces, e.g. passing -1 for an index
|
||||
gets you the last element.
|
||||
|
||||
-}
|
||||
getElementAt : Int -> List a -> List a
|
||||
getElementAt index list =
|
||||
let
|
||||
length =
|
||||
List.length list
|
||||
in
|
||||
-- Avoid attempting % 0
|
||||
if length == 0 then
|
||||
[]
|
||||
else
|
||||
-- Support wraparound, e.g. passing -1 to get the last element.
|
||||
getElementAtHelp (index % length) list
|
||||
|
||||
|
||||
getElementAtHelp : Int -> List a -> List a
|
||||
getElementAtHelp index list =
|
||||
case list of
|
||||
[] ->
|
||||
[]
|
||||
|
||||
first :: rest ->
|
||||
if index == 0 then
|
||||
[ first ]
|
||||
else
|
||||
getElementAtHelp (index - 1) rest
|
||||
|
||||
|
||||
traverse : Query msg -> Result QueryError (List (ElmHtml msg))
|
||||
traverse (Query node selectorQueries) =
|
||||
traverseSelectors selectorQueries [ Inert.toElmHtml node ]
|
||||
|
||||
|
||||
traverseSelectors : List SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg))
|
||||
traverseSelectors selectorQueries elmHtmlList =
|
||||
List.foldr
|
||||
(traverseSelector >> Result.andThen)
|
||||
(Ok elmHtmlList)
|
||||
selectorQueries
|
||||
|
||||
|
||||
traverseSelector : SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg))
|
||||
traverseSelector selectorQuery elmHtmlList =
|
||||
case selectorQuery of
|
||||
Find selectors ->
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAll selectors
|
||||
|> verifySingle "Query.find"
|
||||
|> Result.map (\elem -> [ elem ])
|
||||
|
||||
FindAll selectors ->
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAll selectors
|
||||
|> Ok
|
||||
|
||||
Children selectors ->
|
||||
elmHtmlList
|
||||
|> List.concatMap getChildren
|
||||
|> InternalSelector.queryAllChildren selectors
|
||||
|> Ok
|
||||
|
||||
First ->
|
||||
elmHtmlList
|
||||
|> List.head
|
||||
|> Maybe.map (\elem -> Ok [ elem ])
|
||||
|> Maybe.withDefault (Err (NoResultsForSingle "Query.first"))
|
||||
|
||||
Index index ->
|
||||
let
|
||||
elements =
|
||||
elmHtmlList
|
||||
|> getElementAt index
|
||||
in
|
||||
if List.length elements == 1 then
|
||||
Ok elements
|
||||
else
|
||||
Err (NoResultsForSingle ("Query.index " ++ toString index))
|
||||
|
||||
|
||||
getChildren : ElmHtml msg -> List (ElmHtml msg)
|
||||
getChildren elmHtml =
|
||||
case elmHtml of
|
||||
NodeEntry { children } ->
|
||||
children
|
||||
|
||||
_ ->
|
||||
[]
|
||||
|
||||
|
||||
isElement : ElmHtml msg -> Bool
|
||||
isElement elmHtml =
|
||||
case elmHtml of
|
||||
NodeEntry _ ->
|
||||
True
|
||||
|
||||
_ ->
|
||||
False
|
||||
|
||||
|
||||
verifySingle : String -> List a -> Result QueryError a
|
||||
verifySingle queryName list =
|
||||
case list of
|
||||
[] ->
|
||||
Err (NoResultsForSingle queryName)
|
||||
|
||||
singleton :: [] ->
|
||||
Ok singleton
|
||||
|
||||
multiples ->
|
||||
Err (MultipleResultsForSingle queryName (List.length multiples))
|
||||
|
||||
|
||||
expectAll : (Single msg -> Expectation) -> Query msg -> Expectation
|
||||
expectAll check query =
|
||||
case traverse query of
|
||||
Ok list ->
|
||||
expectAllHelp 0 check list
|
||||
|
||||
Err error ->
|
||||
Expect.fail (queryErrorToString query error)
|
||||
|
||||
|
||||
expectAllHelp : Int -> (Single msg -> Expectation) -> List (ElmHtml msg) -> Expectation
|
||||
expectAllHelp successes check list =
|
||||
case list of
|
||||
[] ->
|
||||
Expect.pass
|
||||
|
||||
elmHtml :: rest ->
|
||||
let
|
||||
expectation =
|
||||
Query (Inert.fromElmHtml elmHtml) []
|
||||
|> Single False
|
||||
|> check
|
||||
in
|
||||
case Test.Runner.getFailure expectation of
|
||||
Just { given, message } ->
|
||||
let
|
||||
prefix =
|
||||
if successes > 0 then
|
||||
"Element #" ++ toString (successes + 1) ++ " failed this test:"
|
||||
else
|
||||
"The first element failed this test:"
|
||||
in
|
||||
[ prefix, message ]
|
||||
|> String.join "\n\n"
|
||||
|> Expect.fail
|
||||
|
||||
Nothing ->
|
||||
expectAllHelp (successes + 1) check rest
|
||||
|
||||
|
||||
multipleToExpectation : Multiple msg -> (List (ElmHtml msg) -> Expectation) -> Expectation
|
||||
multipleToExpectation (Multiple _ query) check =
|
||||
case traverse query of
|
||||
Ok list ->
|
||||
check list
|
||||
|
||||
Err error ->
|
||||
Expect.fail (queryErrorToString query error)
|
||||
|
||||
|
||||
queryErrorToString : Query msg -> QueryError -> String
|
||||
queryErrorToString query error =
|
||||
case error of
|
||||
NoResultsForSingle queryName ->
|
||||
queryName ++ " always expects to find 1 element, but it found 0 instead."
|
||||
|
||||
MultipleResultsForSingle queryName resultCount ->
|
||||
queryName
|
||||
++ " always expects to find 1 element, but it found "
|
||||
++ toString resultCount
|
||||
++ " instead.\n\n\nHINT: If you actually expected "
|
||||
++ toString resultCount
|
||||
++ " elements, use Query.findAll instead of Query.find."
|
||||
|
||||
|
||||
contains : List (ElmHtml msg) -> Query msg -> Expectation
|
||||
contains expectedDescendants query =
|
||||
case traverse query of
|
||||
Ok elmHtmlList ->
|
||||
let
|
||||
missing =
|
||||
missingDescendants elmHtmlList expectedDescendants
|
||||
|
||||
prettyPrint missingDescendants =
|
||||
String.join
|
||||
"\n\n---------------------------------------------\n\n"
|
||||
(List.indexedMap
|
||||
(\index descendant -> printIndented 3 index descendant)
|
||||
missingDescendants
|
||||
)
|
||||
in
|
||||
if List.isEmpty missing then
|
||||
Expect.pass
|
||||
else
|
||||
Expect.fail
|
||||
(String.join ""
|
||||
[ "\t✗ /"
|
||||
, toString <| List.length missing
|
||||
, "\\ missing descendants: \n\n"
|
||||
, prettyPrint missing
|
||||
]
|
||||
)
|
||||
|
||||
Err error ->
|
||||
Expect.fail (queryErrorToString query error)
|
||||
|
||||
|
||||
missingDescendants : List (ElmHtml msg) -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
missingDescendants elmHtmlList expected =
|
||||
let
|
||||
isMissing =
|
||||
\expectedDescendant ->
|
||||
not <| Descendant.isDescendant elmHtmlList expectedDescendant
|
||||
in
|
||||
List.filter isMissing expected
|
||||
|
||||
|
||||
has : List Selector -> Query msg -> Expectation
|
||||
has selectors query =
|
||||
case traverse query of
|
||||
Ok elmHtmlList ->
|
||||
if List.isEmpty (InternalSelector.queryAll selectors elmHtmlList) then
|
||||
selectors
|
||||
|> List.map (showSelectorOutcome elmHtmlList)
|
||||
|> String.join "\n"
|
||||
|> Expect.fail
|
||||
else
|
||||
Expect.pass
|
||||
|
||||
Err error ->
|
||||
Expect.fail (queryErrorToString query error)
|
||||
|
||||
|
||||
hasNot : List Selector -> Query msg -> Expectation
|
||||
hasNot selectors query =
|
||||
case traverse query of
|
||||
Ok [] ->
|
||||
Expect.pass
|
||||
|
||||
Ok elmHtmlList ->
|
||||
case InternalSelector.queryAll selectors elmHtmlList of
|
||||
[] ->
|
||||
Expect.pass
|
||||
|
||||
_ ->
|
||||
selectors
|
||||
|> List.map (showSelectorOutcomeInverse elmHtmlList)
|
||||
|> String.join "\n"
|
||||
|> Expect.fail
|
||||
|
||||
Err error ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
showSelectorOutcome : List (ElmHtml msg) -> Selector -> String
|
||||
showSelectorOutcome elmHtmlList selector =
|
||||
let
|
||||
outcome =
|
||||
case InternalSelector.queryAll [ selector ] elmHtmlList of
|
||||
[] ->
|
||||
"✗"
|
||||
|
||||
_ ->
|
||||
"✓"
|
||||
in
|
||||
String.join " " [ outcome, "has", selectorToString selector ]
|
||||
|
||||
|
||||
showSelectorOutcomeInverse : List (ElmHtml msg) -> Selector -> String
|
||||
showSelectorOutcomeInverse elmHtmlList selector =
|
||||
let
|
||||
outcome =
|
||||
case InternalSelector.queryAll [ selector ] elmHtmlList of
|
||||
[] ->
|
||||
"✓"
|
||||
|
||||
_ ->
|
||||
"✗"
|
||||
in
|
||||
String.join " " [ outcome, "has not", selectorToString selector ]
|
||||
|
||||
|
||||
|
||||
-- HELPERS --
|
||||
|
||||
|
||||
failWithQuery : Bool -> String -> Query msg -> Expectation -> Expectation
|
||||
failWithQuery showTrace queryName query expectation =
|
||||
case Test.Runner.getFailure expectation of
|
||||
Just { given, message } ->
|
||||
let
|
||||
lines =
|
||||
toLines message query queryName
|
||||
|> List.map prefixOutputLine
|
||||
|
||||
tracedLines =
|
||||
if showTrace then
|
||||
addQueryFromHtmlLine query :: lines
|
||||
else
|
||||
lines
|
||||
in
|
||||
tracedLines
|
||||
|> String.join "\n\n\n"
|
||||
|> Expect.fail
|
||||
|
||||
Nothing ->
|
||||
expectation
|
||||
|
||||
|
||||
addQueryFromHtmlLine : Query msg -> String
|
||||
addQueryFromHtmlLine query =
|
||||
String.join "\n\n"
|
||||
[ prefixOutputLine "Query.fromHtml"
|
||||
, toOutputLine query
|
||||
|> String.split "\n"
|
||||
|> List.map ((++) baseIndentation)
|
||||
|> String.join "\n"
|
||||
]
|
||||
|
||||
|
||||
prefixOutputLine : String -> String
|
||||
prefixOutputLine =
|
||||
(++) "▼ "
|
||||
306
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Test/Html/Selector.elm
vendored
Normal file
306
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/src/Test/Html/Selector.elm
vendored
Normal file
@@ -0,0 +1,306 @@
|
||||
module Test.Html.Selector
|
||||
exposing
|
||||
( Selector
|
||||
, all
|
||||
, attribute
|
||||
, checked
|
||||
, class
|
||||
, classes
|
||||
, disabled
|
||||
, exactClassName
|
||||
, id
|
||||
, selected
|
||||
, style
|
||||
, tag
|
||||
, text
|
||||
)
|
||||
|
||||
{-| Selecting HTML elements.
|
||||
|
||||
@docs Selector
|
||||
|
||||
|
||||
## General Selectors
|
||||
|
||||
@docs tag, text, attribute, all
|
||||
|
||||
|
||||
## Attributes
|
||||
|
||||
@docs id, class, classes, exactClassName, style, checked, selected, disabled
|
||||
|
||||
-}
|
||||
|
||||
import ElmHtml.InternalTypes
|
||||
import Html exposing (Attribute)
|
||||
import Html.Inert
|
||||
import Json.Decode
|
||||
import Test.Html.Selector.Internal as Internal exposing (..)
|
||||
|
||||
|
||||
{-| A selector used to filter sets of elements.
|
||||
-}
|
||||
type alias Selector =
|
||||
Internal.Selector
|
||||
|
||||
|
||||
{-| Combine the given selectors into one which requires all of them to match.
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (class, text, all, Selector)
|
||||
|
||||
|
||||
replyBtnSelector : Selector
|
||||
replyBtnSelector =
|
||||
all [ class "btn", text "Reply" ]
|
||||
|
||||
|
||||
test "Button has the class 'btn' and the text 'Reply'" <|
|
||||
\() ->
|
||||
Html.button [ Attr.class "btn btn-large" ] [ Html.text "Reply" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ replyBtnSelector ]
|
||||
|
||||
-}
|
||||
all : List Selector -> Selector
|
||||
all =
|
||||
All
|
||||
|
||||
|
||||
{-| Matches elements that have all the given classes (and possibly others as well).
|
||||
|
||||
When you only care about one class instead of several, you can use
|
||||
[`class`](#class) instead of passing this function a list with one value in it.
|
||||
|
||||
To match the element's exact class attribute string, use [`className`](#className).
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (classes)
|
||||
|
||||
|
||||
test "Button has the classes btn and btn-large" <|
|
||||
\() ->
|
||||
Html.button [ Attr.class "btn btn-large" ] [ Html.text "Reply" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ classes [ "btn", "btn-large" ] ]
|
||||
|
||||
-}
|
||||
classes : List String -> Selector
|
||||
classes =
|
||||
Classes
|
||||
|
||||
|
||||
{-| Matches elements that have the given class (and possibly others as well).
|
||||
|
||||
To match multiple classes at once, use [`classes`](#classes) instead.
|
||||
|
||||
To match the element's exact class attribute string, use [`className`](#className).
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (class)
|
||||
|
||||
|
||||
test "Button has the class btn-large" <|
|
||||
\() ->
|
||||
Html.button [ Attr.class "btn btn-large" ] [ Html.text "Reply" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ class "btn-large" ]
|
||||
|
||||
-}
|
||||
class : String -> Selector
|
||||
class =
|
||||
Class
|
||||
|
||||
|
||||
{-| Matches the element's exact class attribute string.
|
||||
|
||||
This is used less often than [`class`](#class), [`classes`](#classes) or
|
||||
[`attribute`](#attribute), which check for the *presence* of a class as opposed
|
||||
to matching the entire class attribute exactly.
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (exactClassName)
|
||||
|
||||
|
||||
test "Button has the exact class 'btn btn-large'" <|
|
||||
\() ->
|
||||
Html.button [ Attr.class "btn btn-large" ] [ Html.text "Reply" ]
|
||||
|> Query.fromHtml
|
||||
|> Query.has [ exactClassName "btn btn-large" ]
|
||||
|
||||
-}
|
||||
exactClassName : String -> Selector
|
||||
exactClassName =
|
||||
namedAttr "className"
|
||||
|
||||
|
||||
{-| Matches elements that have the given `id` attribute.
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (id, text)
|
||||
|
||||
|
||||
test "the welcome <h1> says hello!" <|
|
||||
\() ->
|
||||
Html.div []
|
||||
[ Html.h1 [ Attr.id "welcome" ] [ Html.text "Hello!" ] ]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ id "welcome" ]
|
||||
|> Query.has [ text "Hello!" ]
|
||||
|
||||
-}
|
||||
id : String -> Selector
|
||||
id =
|
||||
namedAttr "id"
|
||||
|
||||
|
||||
{-| Matches elements that have the given tag.
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (tag, text)
|
||||
|
||||
|
||||
test "the welcome <h1> says hello!" <|
|
||||
\() ->
|
||||
Html.div []
|
||||
[ Html.h1 [ Attr.id "welcome" ] [ Html.text "Hello!" ] ]
|
||||
|> Query.fromHtml
|
||||
|> Query.find [ tag "h1" ]
|
||||
|> Query.has [ text "Hello!" ]
|
||||
|
||||
-}
|
||||
tag : String -> Selector
|
||||
tag name =
|
||||
Tag name
|
||||
|
||||
|
||||
{-| Matches elements that have the given attribute in a way that makes sense
|
||||
given their semantics in `Html`.
|
||||
|
||||
See [Selecting elements by `Html.Attribute msg` in the README](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest#selecting-elements-by-html-attribute-msg-)
|
||||
|
||||
-}
|
||||
attribute : Attribute Never -> Selector
|
||||
attribute attr =
|
||||
case Html.Inert.parseAttribute attr of
|
||||
ElmHtml.InternalTypes.Attribute { key, value } ->
|
||||
if String.toLower key == "class" then
|
||||
value
|
||||
|> String.split " "
|
||||
|> Classes
|
||||
else
|
||||
namedAttr key value
|
||||
|
||||
ElmHtml.InternalTypes.Property { key, value } ->
|
||||
if key == "className" then
|
||||
value
|
||||
|> Json.Decode.decodeValue Json.Decode.string
|
||||
|> Result.map (String.split " ")
|
||||
|> Result.withDefault []
|
||||
|> Classes
|
||||
else
|
||||
value
|
||||
|> Json.Decode.decodeValue Json.Decode.string
|
||||
|> Result.map (namedAttr key)
|
||||
|> orElseLazy
|
||||
(\() ->
|
||||
value
|
||||
|> Json.Decode.decodeValue Json.Decode.bool
|
||||
|> Result.map (namedBoolAttr key)
|
||||
)
|
||||
|> Result.withDefault Invalid
|
||||
|
||||
ElmHtml.InternalTypes.Styles styles ->
|
||||
Style styles
|
||||
|
||||
_ ->
|
||||
Invalid
|
||||
|
||||
|
||||
{-| Matches elements that have all the given style properties (and possibly others as well).
|
||||
|
||||
import Html
|
||||
import Html.Attributes as Attr
|
||||
import Test.Html.Query as Query
|
||||
import Test exposing (test)
|
||||
import Test.Html.Selector exposing (classes)
|
||||
|
||||
|
||||
test "the Reply button has red text" <|
|
||||
\() ->
|
||||
Html.div []
|
||||
[ Html.button [ Attr.style [ ( "color", "red" ) ] ] [ Html.text "Reply" ] ]
|
||||
|> Query.has [ style [ ( "color", "red" ) ] ]
|
||||
|
||||
-}
|
||||
style : List ( String, String ) -> Selector
|
||||
style style =
|
||||
Style style
|
||||
|
||||
|
||||
{-| Matches elements that have a
|
||||
[`text`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#text)
|
||||
attribute with the given value.
|
||||
-}
|
||||
text : String -> Selector
|
||||
text =
|
||||
Internal.Text
|
||||
|
||||
|
||||
{-| Matches elements that have a
|
||||
[`selected`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#selected)
|
||||
attribute with the given value.
|
||||
-}
|
||||
selected : Bool -> Selector
|
||||
selected =
|
||||
namedBoolAttr "selected"
|
||||
|
||||
|
||||
{-| Matches elements that have a
|
||||
[`disabled`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#disabled)
|
||||
attribute with the given value.
|
||||
-}
|
||||
disabled : Bool -> Selector
|
||||
disabled =
|
||||
namedBoolAttr "disabled"
|
||||
|
||||
|
||||
{-| Matches elements that have a
|
||||
[`checked`](http://package.elm-lang.org/packages/elm-lang/html/latest/Html-Attributes#checked)
|
||||
attribute with the given value.
|
||||
-}
|
||||
checked : Bool -> Selector
|
||||
checked =
|
||||
namedBoolAttr "checked"
|
||||
|
||||
|
||||
|
||||
-- HELPERS
|
||||
|
||||
|
||||
orElseLazy : (() -> Result x a) -> Result x a -> Result x a
|
||||
orElseLazy fma mb =
|
||||
case mb of
|
||||
Err _ ->
|
||||
fma ()
|
||||
|
||||
Ok _ ->
|
||||
mb
|
||||
@@ -0,0 +1,136 @@
|
||||
module Test.Html.Selector.Internal exposing (..)
|
||||
|
||||
import ElmHtml.InternalTypes exposing (ElmHtml)
|
||||
import ElmHtml.Query
|
||||
|
||||
|
||||
type Selector
|
||||
= All (List Selector)
|
||||
| Classes (List String)
|
||||
| Class String
|
||||
| Attribute { name : String, value : String }
|
||||
| BoolAttribute { name : String, value : Bool }
|
||||
| Style (List ( String, String ))
|
||||
| Tag String
|
||||
| Text String
|
||||
| Invalid
|
||||
|
||||
|
||||
selectorToString : Selector -> String
|
||||
selectorToString criteria =
|
||||
case criteria of
|
||||
All list ->
|
||||
list
|
||||
|> List.map selectorToString
|
||||
|> String.join " "
|
||||
|
||||
Classes list ->
|
||||
"classes " ++ toString (String.join " " list)
|
||||
|
||||
Class class ->
|
||||
"class " ++ toString class
|
||||
|
||||
Attribute { name, value } ->
|
||||
"attribute "
|
||||
++ toString name
|
||||
++ " "
|
||||
++ toString value
|
||||
|
||||
BoolAttribute { name, value } ->
|
||||
"attribute "
|
||||
++ toString name
|
||||
++ " "
|
||||
++ toString value
|
||||
|
||||
Style style ->
|
||||
"styles " ++ styleToString style
|
||||
|
||||
Tag name ->
|
||||
"tag " ++ toString name
|
||||
|
||||
Text text ->
|
||||
"text " ++ toString text
|
||||
|
||||
Invalid ->
|
||||
"invalid"
|
||||
|
||||
|
||||
styleToString : List ( String, String ) -> String
|
||||
styleToString style =
|
||||
style
|
||||
|> List.map (\( k, v ) -> k ++ ":" ++ v ++ ";")
|
||||
|> String.join " "
|
||||
|
||||
|
||||
queryAll : List Selector -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
queryAll selectors list =
|
||||
case selectors of
|
||||
[] ->
|
||||
list
|
||||
|
||||
selector :: rest ->
|
||||
query ElmHtml.Query.query queryAll selector list
|
||||
|> queryAllChildren rest
|
||||
|
||||
|
||||
queryAllChildren : List Selector -> List (ElmHtml msg) -> List (ElmHtml msg)
|
||||
queryAllChildren selectors list =
|
||||
case selectors of
|
||||
[] ->
|
||||
list
|
||||
|
||||
selector :: rest ->
|
||||
query ElmHtml.Query.queryChildren queryAllChildren selector list
|
||||
|> queryAllChildren rest
|
||||
|
||||
|
||||
query :
|
||||
(ElmHtml.Query.Selector -> ElmHtml msg -> List (ElmHtml msg))
|
||||
-> (List Selector -> List (ElmHtml msg) -> List (ElmHtml msg))
|
||||
-> Selector
|
||||
-> List (ElmHtml msg)
|
||||
-> List (ElmHtml msg)
|
||||
query fn fnAll selector list =
|
||||
case selector of
|
||||
All selectors ->
|
||||
fnAll selectors list
|
||||
|
||||
Classes classes ->
|
||||
List.concatMap (fn (ElmHtml.Query.ClassList classes)) list
|
||||
|
||||
Class class ->
|
||||
List.concatMap (fn (ElmHtml.Query.ClassList [ class ])) list
|
||||
|
||||
Attribute { name, value } ->
|
||||
List.concatMap (fn (ElmHtml.Query.Attribute name value)) list
|
||||
|
||||
BoolAttribute { name, value } ->
|
||||
List.concatMap (fn (ElmHtml.Query.BoolAttribute name value)) list
|
||||
|
||||
Style style ->
|
||||
List.concatMap (fn (ElmHtml.Query.Style style)) list
|
||||
|
||||
Tag name ->
|
||||
List.concatMap (fn (ElmHtml.Query.Tag name)) list
|
||||
|
||||
Text text ->
|
||||
List.concatMap (fn (ElmHtml.Query.ContainsText text)) list
|
||||
|
||||
Invalid ->
|
||||
[]
|
||||
|
||||
|
||||
namedAttr : String -> String -> Selector
|
||||
namedAttr name value =
|
||||
Attribute
|
||||
{ name = name
|
||||
, value = value
|
||||
}
|
||||
|
||||
|
||||
namedBoolAttr : String -> Bool -> Selector
|
||||
namedBoolAttr name value =
|
||||
BoolAttribute
|
||||
{ name = name
|
||||
, value = value
|
||||
}
|
||||
64
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/Attributes.elm
vendored
Normal file
64
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/Attributes.elm
vendored
Normal file
@@ -0,0 +1,64 @@
|
||||
module Attributes exposing (..)
|
||||
|
||||
import Expect
|
||||
import Html.Attributes as Attr
|
||||
import Json.Encode as Encode
|
||||
import Test exposing (..)
|
||||
import Test.Html.Selector as Selector
|
||||
import Test.Html.Selector.Internal exposing (Selector(..), namedAttr, namedBoolAttr)
|
||||
|
||||
|
||||
all : Test
|
||||
all =
|
||||
describe "Selector.attribute"
|
||||
[ test "can generate a StringAttribute selector" <|
|
||||
\() ->
|
||||
Attr.title "test"
|
||||
|> Selector.attribute
|
||||
|> Expect.equal (namedAttr "title" "test")
|
||||
, test "works for things like `value` which are technically properties" <|
|
||||
\() ->
|
||||
Attr.value "test"
|
||||
|> Selector.attribute
|
||||
|> Expect.equal (namedAttr "value" "test")
|
||||
, test "can generate a BoolAttribute selector" <|
|
||||
\() ->
|
||||
Attr.checked True
|
||||
|> Selector.attribute
|
||||
|> Expect.equal (namedBoolAttr "checked" True)
|
||||
, test "can generate a Style selector" <|
|
||||
\() ->
|
||||
Attr.style [ ( "margin", "0" ) ]
|
||||
|> Selector.attribute
|
||||
|> Expect.equal (Style [ ( "margin", "0" ) ])
|
||||
, describe "classes" <|
|
||||
[ test "can generate a Classes selector" <|
|
||||
\() ->
|
||||
Attr.class "hello world"
|
||||
|> Selector.attribute
|
||||
|> Expect.equal (Classes [ "hello", "world" ])
|
||||
, test "catches a situation where the user passes classes using Html.Attr.attribute \"class\" \"the-class\"" <|
|
||||
\() ->
|
||||
Attr.attribute "class" "hello world"
|
||||
|> Selector.attribute
|
||||
|> Expect.equal (Classes [ "hello", "world" ])
|
||||
, test "can find a class attribute in a case insensitive manner" <|
|
||||
\() ->
|
||||
Attr.attribute "CLASS" "hello world"
|
||||
|> Selector.attribute
|
||||
|> Expect.equal (Classes [ "hello", "world" ])
|
||||
, test "finds className property only by exact match" <|
|
||||
\() ->
|
||||
Attr.property "classname" (Encode.string "hello world")
|
||||
|> Selector.attribute
|
||||
|> Expect.all
|
||||
[ Expect.notEqual (Classes [ "hello world" ])
|
||||
, Expect.equal (Attribute { name = "classname", value = "hello world" })
|
||||
]
|
||||
]
|
||||
, test "anything else fails" <|
|
||||
\() ->
|
||||
Attr.property "unknown" (Encode.int 1)
|
||||
|> Selector.attribute
|
||||
|> Expect.equal Invalid
|
||||
]
|
||||
89
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/Descendant.elm
vendored
Normal file
89
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/Descendant.elm
vendored
Normal file
@@ -0,0 +1,89 @@
|
||||
module Descendant exposing (..)
|
||||
|
||||
import Html exposing (Html)
|
||||
import Test exposing (..)
|
||||
import ElmHtml.InternalTypes exposing (ElmHtml(..))
|
||||
import Expect
|
||||
import Html exposing (..)
|
||||
import Html.Inert exposing (fromHtml, toElmHtml)
|
||||
import Test.Html.Query as Query exposing (Single)
|
||||
import Test.Html.Descendant exposing (isDescendant)
|
||||
|
||||
|
||||
wrapper : Html msg -> Html msg -> Bool
|
||||
wrapper html potentialDescendant =
|
||||
let
|
||||
elmHtml =
|
||||
[ htmlToElm html ]
|
||||
|
||||
potentialDescendantElmHtml =
|
||||
htmlToElm potentialDescendant
|
||||
in
|
||||
isDescendant elmHtml potentialDescendantElmHtml
|
||||
|
||||
|
||||
all : Test
|
||||
all =
|
||||
describe "Contains assertion"
|
||||
[ test "returns true if it contains the expected html once" <|
|
||||
\() ->
|
||||
let
|
||||
aSingleDescendant =
|
||||
someTitle "foo"
|
||||
|
||||
html =
|
||||
div [] [ aSingleDescendant ]
|
||||
in
|
||||
wrapper html aSingleDescendant
|
||||
|> Expect.true ""
|
||||
, test "returns true if it contains the expected html more than once" <|
|
||||
\() ->
|
||||
let
|
||||
aMultiInstanceDescendant =
|
||||
someTitle "foo"
|
||||
|
||||
html =
|
||||
div []
|
||||
[ aMultiInstanceDescendant
|
||||
, aMultiInstanceDescendant
|
||||
]
|
||||
in
|
||||
wrapper html aMultiInstanceDescendant
|
||||
|> Expect.true ""
|
||||
, test "return true if the node is a nested descendant" <|
|
||||
\() ->
|
||||
let
|
||||
aNestedDescendant =
|
||||
someTitle "foo"
|
||||
|
||||
html =
|
||||
div []
|
||||
[ div []
|
||||
[ div [] [ aNestedDescendant ]
|
||||
]
|
||||
]
|
||||
in
|
||||
wrapper html aNestedDescendant
|
||||
|> Expect.true ""
|
||||
, test "returns false if it does not contain the node" <|
|
||||
\() ->
|
||||
let
|
||||
notInHtml =
|
||||
img [] []
|
||||
|
||||
html =
|
||||
div [] [ someTitle "foo" ]
|
||||
in
|
||||
wrapper html notInHtml
|
||||
|> Expect.false ""
|
||||
]
|
||||
|
||||
|
||||
someTitle : String -> Html msg
|
||||
someTitle str =
|
||||
h1 [] [ text str ]
|
||||
|
||||
|
||||
htmlToElm : Html msg -> ElmHtml msg
|
||||
htmlToElm =
|
||||
toElmHtml << fromHtml
|
||||
172
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/Events.elm
vendored
Normal file
172
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/Events.elm
vendored
Normal file
@@ -0,0 +1,172 @@
|
||||
module Events exposing (..)
|
||||
|
||||
import Expect
|
||||
import Html exposing (Html, button, div, input, text)
|
||||
import Html.Attributes as Attr exposing (href)
|
||||
import Html.Events exposing (..)
|
||||
import Html.Keyed as Keyed
|
||||
import Html.Lazy as Lazy
|
||||
import Json.Decode exposing (Value)
|
||||
import Json.Encode as Encode
|
||||
import Test exposing (..)
|
||||
import Test.Html.Event as Event exposing (Event)
|
||||
import Test.Html.Query as Query exposing (Single)
|
||||
import Test.Html.Selector exposing (tag)
|
||||
|
||||
|
||||
all : Test
|
||||
all =
|
||||
describe "trigerring events"
|
||||
[ test "returns msg for click on element" <|
|
||||
\() ->
|
||||
Query.fromHtml sampleHtml
|
||||
|> Query.findAll [ tag "button" ]
|
||||
|> Query.first
|
||||
|> Event.simulate Event.click
|
||||
|> Event.expect SampleMsg
|
||||
, test "returns msg for click on lazy html" <|
|
||||
\() ->
|
||||
Query.fromHtml sampleLazyHtml
|
||||
|> Query.findAll [ tag "button" ]
|
||||
|> Query.first
|
||||
|> Event.simulate Event.click
|
||||
|> Event.expect SampleMsg
|
||||
, test "returns msg for click on mapped html" <|
|
||||
\() ->
|
||||
Query.fromHtml sampleMappedHtml
|
||||
|> Query.findAll [ tag "button" ]
|
||||
|> Query.first
|
||||
|> Event.simulate Event.click
|
||||
|> Event.expect MappedSampleMsg
|
||||
, test "returns msg for click on mapped lazy html" <|
|
||||
\() ->
|
||||
Query.fromHtml sampleMappedLazyHtml
|
||||
|> Query.findAll [ tag "button" ]
|
||||
|> Query.first
|
||||
|> Event.simulate Event.click
|
||||
|> Event.expect MappedSampleMsg
|
||||
, test "returns msg for click on mapped keyed html" <|
|
||||
\() ->
|
||||
Query.fromHtml sampleMappedKeyedHtml
|
||||
|> Query.findAll [ tag "button" ]
|
||||
|> Query.first
|
||||
|> Event.simulate Event.click
|
||||
|> Event.expect MappedSampleMsg
|
||||
, test "returns msg for click on deep mapped html" <|
|
||||
\() ->
|
||||
Query.fromHtml deepMappedHtml
|
||||
|> Query.findAll [ tag "input" ]
|
||||
|> Query.first
|
||||
|> Event.simulate (Event.input "foo")
|
||||
|> Event.expect (SampleInputMsg "foobar")
|
||||
, test "returns msg for input with transformation" <|
|
||||
\() ->
|
||||
input [ onInput (String.toUpper >> SampleInputMsg) ] []
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.input "cats")
|
||||
|> Event.expect (SampleInputMsg "CATS")
|
||||
, test "returns msg for check event" <|
|
||||
\() ->
|
||||
input [ onCheck SampleCheckedMsg ] []
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate (Event.check True)
|
||||
|> Event.expect (SampleCheckedMsg True)
|
||||
, test "returns msg for custom event" <|
|
||||
\() ->
|
||||
input [ on "keyup" (Json.Decode.map SampleKeyUpMsg keyCode) ] []
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate ( "keyup", Encode.object [ ( "keyCode", Encode.int 5 ) ] )
|
||||
|> Event.expect (SampleKeyUpMsg 5)
|
||||
, testEvent onDoubleClick Event.doubleClick
|
||||
, testEvent onMouseDown Event.mouseDown
|
||||
, testEvent onMouseUp Event.mouseUp
|
||||
, testEvent onMouseLeave Event.mouseLeave
|
||||
, testEvent onMouseOver Event.mouseOver
|
||||
, testEvent onMouseOut Event.mouseOut
|
||||
, testEvent onSubmit Event.submit
|
||||
, testEvent onBlur Event.blur
|
||||
, testEvent onFocus Event.focus
|
||||
, test "event result" <|
|
||||
\() ->
|
||||
Query.fromHtml sampleHtml
|
||||
|> Query.find [ tag "button" ]
|
||||
|> Event.simulate Event.click
|
||||
|> Event.toResult
|
||||
|> Expect.equal (Ok SampleMsg)
|
||||
]
|
||||
|
||||
|
||||
type Msg
|
||||
= SampleMsg
|
||||
| MappedSampleMsg
|
||||
| SampleInputMsg String
|
||||
| SampleCheckedMsg Bool
|
||||
| SampleKeyUpMsg Int
|
||||
|
||||
|
||||
sampleHtml : Html Msg
|
||||
sampleHtml =
|
||||
div [ Attr.class "container" ]
|
||||
[ button [ onClick SampleMsg ] [ text "click me" ]
|
||||
]
|
||||
|
||||
|
||||
sampleLazyHtml : Html Msg
|
||||
sampleLazyHtml =
|
||||
div [ Attr.class "container" ]
|
||||
[ Lazy.lazy
|
||||
(\str -> button [ onClick SampleMsg ] [ text str ])
|
||||
"click me"
|
||||
]
|
||||
|
||||
|
||||
sampleMappedHtml : Html Msg
|
||||
sampleMappedHtml =
|
||||
div [ Attr.class "container" ]
|
||||
[ Html.map (always MappedSampleMsg) (button [ onClick SampleMsg ] [ text "click me" ])
|
||||
]
|
||||
|
||||
|
||||
sampleMappedLazyHtml : Html Msg
|
||||
sampleMappedLazyHtml =
|
||||
div [ Attr.class "container" ]
|
||||
[ Html.map (always MappedSampleMsg) <|
|
||||
Lazy.lazy
|
||||
(\str -> button [ onClick SampleMsg ] [ text str ])
|
||||
"click me"
|
||||
]
|
||||
|
||||
|
||||
sampleMappedKeyedHtml : Html Msg
|
||||
sampleMappedKeyedHtml =
|
||||
div [ Attr.class "container" ]
|
||||
[ Html.map (always MappedSampleMsg) <|
|
||||
Keyed.node "button"
|
||||
[ onClick SampleMsg ]
|
||||
[ ( "key", text "click me" ) ]
|
||||
]
|
||||
|
||||
|
||||
deepMappedHtml : Html Msg
|
||||
deepMappedHtml =
|
||||
div []
|
||||
[ Html.map SampleInputMsg
|
||||
(div []
|
||||
[ Html.map (\msg -> msg ++ "bar")
|
||||
(div []
|
||||
[ input [ onInput identity ] []
|
||||
]
|
||||
)
|
||||
]
|
||||
)
|
||||
]
|
||||
|
||||
|
||||
testEvent : (Msg -> Html.Attribute Msg) -> ( String, Value ) -> Test
|
||||
testEvent testOn (( eventName, eventValue ) as event) =
|
||||
test ("returns msg for " ++ eventName ++ "(" ++ toString eventValue ++ ") event") <|
|
||||
\() ->
|
||||
input [ testOn SampleMsg ] []
|
||||
|> Query.fromHtml
|
||||
|> Event.simulate event
|
||||
|> Event.expect SampleMsg
|
||||
321
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/Queries.elm
vendored
Normal file
321
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/Queries.elm
vendored
Normal file
@@ -0,0 +1,321 @@
|
||||
module Queries exposing (..)
|
||||
|
||||
import Expect
|
||||
import Html exposing (Html, a, div, footer, header, li, section, span, ul)
|
||||
import Html.Attributes as Attr exposing (href)
|
||||
import Html.Lazy as Lazy
|
||||
import Test exposing (..)
|
||||
import Test.Html.Query as Query exposing (Single)
|
||||
import Test.Html.Selector exposing (..)
|
||||
|
||||
|
||||
htmlTests : Test
|
||||
htmlTests =
|
||||
describe "Html" <|
|
||||
List.map (\toTest -> toTest (Query.fromHtml sampleHtml)) testers
|
||||
|
||||
|
||||
lazyTests : Test
|
||||
lazyTests =
|
||||
describe "lazy Html" <|
|
||||
List.map (\toTest -> toTest (Query.fromHtml sampleLazyHtml)) testers
|
||||
|
||||
|
||||
testers : List (Single msg -> Test)
|
||||
testers =
|
||||
[ testFindAll
|
||||
, testKeep
|
||||
, testFind
|
||||
, testRoot
|
||||
, testFirst
|
||||
, testIndex
|
||||
, testChildren
|
||||
]
|
||||
|
||||
|
||||
testRoot : Single msg -> Test
|
||||
testRoot output =
|
||||
describe "root query without find or findAll"
|
||||
[ describe "finds itself" <|
|
||||
[ test "sees it's a <section class='root'>" <|
|
||||
\() ->
|
||||
output
|
||||
|> Expect.all
|
||||
[ Query.has [ class "root" ]
|
||||
, Query.has [ tag "section" ]
|
||||
]
|
||||
, test "recognizes its exact className" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.has [ exactClassName "root" ]
|
||||
, test "recognizes its class by classes" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.has [ classes [ "root" ] ]
|
||||
, test "recognizes its style by a single css property" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.has [ style [ ( "color", "red" ) ] ]
|
||||
, test "recognizes its style by multiple css properties" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.has [ style [ ( "color", "red" ), ( "background", "purple" ) ] ]
|
||||
, test "recognizes its style does not include a css property" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.hasNot [ style [ ( "color", "green" ) ] ]
|
||||
, test "recognizes if is has a specific descendant" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.contains [ someView "Such a title !" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
testFind : Single msg -> Test
|
||||
testFind output =
|
||||
describe "Query.find []"
|
||||
[ describe "finds the one child" <|
|
||||
[ test "sees it's a <div class='container'>" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find []
|
||||
|> Expect.all
|
||||
[ Query.has [ class "container" ]
|
||||
, Query.has [ tag "div" ]
|
||||
]
|
||||
, test "recognizes its exact className" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find []
|
||||
|> Query.has [ exactClassName "container" ]
|
||||
, test "recognizes its class by classes" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find []
|
||||
|> Query.has [ classes [ "container" ] ]
|
||||
, test "recognizes its style by style list" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.has [ style [ ( "color", "blue" ) ] ]
|
||||
, test "recognizes if is has a specific descendant" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find []
|
||||
|> Query.contains [ someView "Such a title !" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
testFindAll : Single msg -> Test
|
||||
testFindAll output =
|
||||
describe "Query.findAll []"
|
||||
[ describe "finds the one child" <|
|
||||
[ test "and only the one child" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll []
|
||||
|> Query.count (Expect.equal 1)
|
||||
, test "sees it's a <div class='container'>" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll []
|
||||
|> Expect.all
|
||||
[ Query.each (Query.has [ class "container" ])
|
||||
, Query.each (Query.has [ tag "div" ])
|
||||
]
|
||||
, test "recognizes its exact className" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll []
|
||||
|> Query.each (Query.has [ exactClassName "container" ])
|
||||
, test "recognizes its class by classes" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll []
|
||||
|> Query.each (Query.has [ classes [ "container" ] ])
|
||||
]
|
||||
, describe "finds multiple descendants"
|
||||
[ test "with tag selectors that return one match at the start" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "header" ]
|
||||
|> Query.count (Expect.equal 1)
|
||||
, test "with tag selectors that return multiple matches" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "section" ]
|
||||
|> Query.count (Expect.equal 2)
|
||||
, test "with tag selectors that return one match at the end" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "footer" ]
|
||||
|> Query.has [ text "this is the footer" ]
|
||||
, test "sees the nested div" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "div" ]
|
||||
|> Query.count (Expect.equal 2)
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
testKeep : Single msg -> Test
|
||||
testKeep output =
|
||||
describe "Query.keep"
|
||||
[ test "only keep a subsect of a result" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "section" ]
|
||||
|> Query.keep (tag "ul")
|
||||
|> Query.keep (class "list-item")
|
||||
|> Expect.all
|
||||
[ Query.each (Query.has [ tag "li" ])
|
||||
, Query.first >> Query.has [ text "first item" ]
|
||||
]
|
||||
, test "keep from the second section as well" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "section" ]
|
||||
|> Query.keep (class "nested-div")
|
||||
|> Query.first
|
||||
|> Query.has [ text "boring section" ]
|
||||
, test "keep elements from both matches" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "section" ]
|
||||
|> Query.keep (class "tooltip-questions")
|
||||
|> Query.count (Expect.equal 2)
|
||||
]
|
||||
|
||||
|
||||
testFirst : Single msg -> Test
|
||||
testFirst output =
|
||||
describe "Query.first"
|
||||
[ describe "finds the one child" <|
|
||||
[ test "sees it's a <div class='container'>" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll []
|
||||
|> Query.first
|
||||
|> Query.has [ tag "div", class "container" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
testIndex : Single msg -> Test
|
||||
testIndex output =
|
||||
describe "Query.index"
|
||||
[ describe "Query.index 0" <|
|
||||
[ test "sees it's a <div class='container'>" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll []
|
||||
|> Query.index 0
|
||||
|> Query.has [ tag "div", class "container" ]
|
||||
]
|
||||
, describe "Query.index -1" <|
|
||||
[ test "sees it's a <div class='container'>" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll []
|
||||
|> Query.index -1
|
||||
|> Query.has [ tag "div", class "container" ]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
testChildren : Single msg -> Test
|
||||
testChildren output =
|
||||
describe "Query.children"
|
||||
[ describe "on the root" <|
|
||||
[ test "sees the root has one child" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.children []
|
||||
|> Expect.all
|
||||
[ Query.count (Expect.equal 1)
|
||||
, Query.each (Query.hasNot [ class "root" ])
|
||||
]
|
||||
, test "doesn't see the nested div" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.children [ class "nested-div" ]
|
||||
|> Query.count (Expect.equal 0)
|
||||
, test "only children which match the selector get returned" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ class "some-list" ]
|
||||
|> Query.children [ class "selected" ]
|
||||
|> Query.count (Expect.equal 1)
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
sampleHtml : Html msg
|
||||
sampleHtml =
|
||||
section [ Attr.class "root", Attr.style [ ( "color", "red" ), ( "background", "purple" ), ( "font-weight", "bold" ) ] ]
|
||||
[ div [ Attr.class "container", Attr.style [ ( "color", "blue" ) ] ]
|
||||
[ header [ Attr.class "funky themed", Attr.id "heading" ]
|
||||
[ a [ href "http://elm-lang.org" ] [ Html.text "home" ]
|
||||
, a [ href "http://elm-lang.org/examples" ] [ Html.text "examples" ]
|
||||
, a [ href "http://elm-lang.org/docs" ] [ Html.text "docs" ]
|
||||
]
|
||||
, someView "Such a title !"
|
||||
, section [ Attr.class "funky themed", Attr.id "section" ]
|
||||
[ ul [ Attr.class "some-list" ]
|
||||
[ li [ Attr.class "list-item themed" ] [ Html.text "first item" ]
|
||||
, li [ Attr.class "list-item themed" ] [ Html.text "second item" ]
|
||||
, li [ Attr.class "list-item themed selected" ] [ Html.text "third item" ]
|
||||
, li [ Attr.class "list-item themed" ] [ Html.text "fourth item" ]
|
||||
, span [ Attr.class "tooltip-questions" ] [ Html.text "?" ]
|
||||
]
|
||||
]
|
||||
, section []
|
||||
[ div [ Attr.class "nested-div" ] [ Html.text "boring section" ]
|
||||
, span [ Attr.class "tooltip-questions" ] [ Html.text "?" ]
|
||||
]
|
||||
, footer []
|
||||
[ Html.text "this is the footer"
|
||||
, span [ Attr.class "tooltip-questions" ] [ Html.text "?" ]
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
sampleLazyHtml : Html msg
|
||||
sampleLazyHtml =
|
||||
section [ Attr.class "root", Attr.style [ ( "color", "red" ), ( "background", "purple" ), ( "font-weight", "bold" ) ] ]
|
||||
[ div [ Attr.class "container", Attr.style [ ( "color", "blue" ) ] ]
|
||||
[ header [ Attr.class "funky themed", Attr.id "heading" ]
|
||||
[ Lazy.lazy (\str -> a [ href "http://elm-lang.org" ] [ Html.text str ]) "home"
|
||||
, Lazy.lazy (\str -> a [ href "http://elm-lang.org/examples" ] [ Html.text str ]) "examples"
|
||||
, Lazy.lazy (\str -> a [ href "http://elm-lang.org/docs" ] [ Html.text str ]) "docs"
|
||||
]
|
||||
, someView "Such a title !"
|
||||
, section [ Attr.class "funky themed", Attr.id "section" ]
|
||||
[ ul [ Attr.class "some-list" ]
|
||||
[ Lazy.lazy (\str -> li [ Attr.class "list-item themed" ] [ Html.text str ]) "first item"
|
||||
, Lazy.lazy (\str -> li [ Attr.class "list-item themed" ] [ Html.text str ]) "second item"
|
||||
, Lazy.lazy (\str -> li [ Attr.class "list-item themed selected" ] [ Html.text str ]) "third item"
|
||||
, Lazy.lazy (\str -> li [ Attr.class "list-item themed" ] [ Html.text str ]) "fourth item"
|
||||
, Lazy.lazy (\str -> span [ Attr.class "tooltip-questions" ] [ Html.text str ]) "?"
|
||||
]
|
||||
]
|
||||
, section []
|
||||
[ div [ Attr.class "nested-div" ]
|
||||
[ Html.text "boring section"
|
||||
, Lazy.lazy (\str -> span [ Attr.class "tooltip-questions" ] [ Html.text str ]) "?"
|
||||
]
|
||||
]
|
||||
, footer []
|
||||
[ Lazy.lazy2 (\a b -> Html.text <| a ++ b) "this is " "the footer"
|
||||
, Lazy.lazy (\str -> span [ Attr.class "tooltip-questions" ] [ Html.text str ]) "?"
|
||||
]
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
someView : String -> Html msg
|
||||
someView str =
|
||||
Html.h1 [] [ Html.text str ]
|
||||
51
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/TestExample.elm
vendored
Normal file
51
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/TestExample.elm
vendored
Normal file
@@ -0,0 +1,51 @@
|
||||
module TestExample exposing (all)
|
||||
|
||||
import Expect
|
||||
import Html.Attributes exposing (href)
|
||||
import Test exposing (..)
|
||||
import Test.Html.Query as Query
|
||||
import Test.Html.Selector exposing (..)
|
||||
import ExampleApp exposing (exampleModel, view)
|
||||
|
||||
|
||||
all : Test
|
||||
all =
|
||||
let
|
||||
output =
|
||||
view exampleModel
|
||||
|> Query.fromHtml
|
||||
in
|
||||
describe "view exampleModel"
|
||||
[ test "expect 4x <li> somewhere on the page" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.count (Expect.equal 4)
|
||||
, test "expect 4x <li> inside a <ul>" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "ul" ]
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.count (Expect.equal 4)
|
||||
, test "expect header to have 3 links in it" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.findAll [ tag "a" ]
|
||||
|> Query.count (Expect.equal 3)
|
||||
, test "expect header to have a link to the Elm homepage" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ id "heading" ]
|
||||
|> Query.has [ attribute <| href "http://elm-lang.org" ]
|
||||
, test "expect footer to have footer text" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "footer" ]
|
||||
|> Query.has [ tag "footer", text "this is the footer" ]
|
||||
, test "expect each <li> to have classes list-item and themed" <|
|
||||
\() ->
|
||||
output
|
||||
|> Query.find [ tag "ul" ]
|
||||
|> Query.findAll [ tag "li" ]
|
||||
|> Query.each (Query.has [ classes [ "list-item", "themed" ] ])
|
||||
]
|
||||
21
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/elm-package.json
vendored
Normal file
21
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-html-test/5.1.2/tests/elm-package.json
vendored
Normal file
@@ -0,0 +1,21 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "helpful summary of your project, less than 80 characters",
|
||||
"repository": "https://github.com/eeue56/elm-html-test.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
".",
|
||||
"../src",
|
||||
"../examples"
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"native-modules": true,
|
||||
"dependencies": {
|
||||
"eeue56/elm-html-in-elm": "5.1.0 <= v < 6.0.0",
|
||||
"eeue56/elm-html-query": "3.0.0 <= v < 4.0.0",
|
||||
"elm-community/elm-test": "4.0.0 <= v < 5.0.0",
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/.gitignore
vendored
Normal file
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/.gitignore
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
# elm-package generated files
|
||||
elm-stuff
|
||||
# elm-repl generated files
|
||||
repl-temp-*
|
||||
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/LICENSE
vendored
Normal file
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/LICENSE
vendored
Normal file
@@ -0,0 +1,29 @@
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2017, Noah
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
9
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/README.md
vendored
Normal file
9
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/README.md
vendored
Normal file
@@ -0,0 +1,9 @@
|
||||
# elm-lazy-list
|
||||
|
||||
This package is used to represent an infinite list of values, to be computed as they are needed. It is mainly designed for use with Elm test.
|
||||
|
||||
|
||||
singleton 5
|
||||
|> cons 6
|
||||
-- only evaluated here!
|
||||
|> toList --> 6, 5
|
||||
16
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/elm-package.json
vendored
Normal file
16
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/elm-package.json
vendored
Normal file
@@ -0,0 +1,16 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "A lazy list of values in pure Elm",
|
||||
"repository": "https://github.com/eeue56/elm-lazy-list.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": ["Lazy.List"],
|
||||
"dependencies": {
|
||||
"eeue56/elm-lazy": "1.0.0 <= v < 2.0.0",
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
748
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/src/Lazy/List.elm
vendored
Normal file
748
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/src/Lazy/List.elm
vendored
Normal file
@@ -0,0 +1,748 @@
|
||||
module Lazy.List exposing (..)
|
||||
|
||||
{-| Lazy list implementation in Elm.
|
||||
|
||||
# Types
|
||||
@docs LazyList, LazyListView
|
||||
|
||||
# Constructors
|
||||
@docs cons, empty, singleton
|
||||
|
||||
# Query operations
|
||||
@docs isEmpty, head, tail, headAndTail, member, length
|
||||
|
||||
# Conversions
|
||||
@docs toList, fromList, toArray, fromArray
|
||||
|
||||
# Map-reduce et al.
|
||||
@docs map, zip, reduce, flatten, append, foldl, foldr
|
||||
|
||||
# Common operations
|
||||
@docs intersperse, interleave, reverse, cycle, iterate, repeat, take, takeWhile, drop, dropWhile
|
||||
|
||||
# Filtering operations
|
||||
@docs keepIf, dropIf, filterMap, unique
|
||||
|
||||
# Chaining operations
|
||||
@docs andMap, andThen
|
||||
|
||||
# Useful math stuff
|
||||
@docs numbers, sum, product
|
||||
|
||||
# All the maps!
|
||||
@docs map2, map3, map4, map5
|
||||
|
||||
# All the zips!
|
||||
@docs zip3, zip4, zip5
|
||||
|
||||
# All the Cartesian products!
|
||||
**Warning:** Calling these functions on large lists and then calling `toList` can easily overflow the stack. Consider
|
||||
passing the results to `take aConstantNumber`.
|
||||
|
||||
@docs product2, product3, product4, product5
|
||||
|
||||
# Infix Operators
|
||||
@docs (:::), (+++)
|
||||
|
||||
-}
|
||||
|
||||
import Array exposing (Array)
|
||||
import List
|
||||
import Random exposing (Generator, Seed)
|
||||
import Lazy exposing (Lazy, lazy, force)
|
||||
|
||||
|
||||
{-| Analogous to `List` type. This is the actual implementation type for the
|
||||
`LazyList` type. This type is exposed to the user if the user so wishes to
|
||||
do pattern matching or understand how the list type works. It is not
|
||||
recommended to work with this type directly. Try working solely with the
|
||||
provided functions in the package.
|
||||
-}
|
||||
type LazyListView a
|
||||
= Nil
|
||||
| Cons a (LazyList a)
|
||||
|
||||
|
||||
{-| Lazy List type.
|
||||
-}
|
||||
type alias LazyList a =
|
||||
Lazy (LazyListView a)
|
||||
|
||||
|
||||
{-| Create an empty list.
|
||||
-}
|
||||
empty : LazyList a
|
||||
empty =
|
||||
lazy <|
|
||||
\() -> Nil
|
||||
|
||||
|
||||
{-| Create a singleton list.
|
||||
-}
|
||||
singleton : a -> LazyList a
|
||||
singleton a =
|
||||
cons a empty
|
||||
|
||||
|
||||
{-| Detect if a list is empty or not.
|
||||
-}
|
||||
isEmpty : LazyList a -> Bool
|
||||
isEmpty list =
|
||||
case force list of
|
||||
Nil ->
|
||||
True
|
||||
|
||||
_ ->
|
||||
False
|
||||
|
||||
|
||||
{-| Add a value to the front of a list.
|
||||
-}
|
||||
cons : a -> LazyList a -> LazyList a
|
||||
cons a list =
|
||||
lazy <|
|
||||
\() ->
|
||||
Cons a list
|
||||
|
||||
|
||||
{-| Get the head of a list.
|
||||
-}
|
||||
head : LazyList a -> Maybe a
|
||||
head list =
|
||||
case force list of
|
||||
Nil ->
|
||||
Nothing
|
||||
|
||||
Cons first _ ->
|
||||
Just first
|
||||
|
||||
|
||||
{-| Get the tail of a list.
|
||||
-}
|
||||
tail : LazyList a -> Maybe (LazyList a)
|
||||
tail list =
|
||||
case force list of
|
||||
Nil ->
|
||||
Nothing
|
||||
|
||||
Cons _ rest ->
|
||||
Just rest
|
||||
|
||||
|
||||
{-| Get the head and tail of a list.
|
||||
-}
|
||||
headAndTail : LazyList a -> Maybe ( a, LazyList a )
|
||||
headAndTail list =
|
||||
case force list of
|
||||
Nil ->
|
||||
Nothing
|
||||
|
||||
Cons first rest ->
|
||||
Just ( first, rest )
|
||||
|
||||
|
||||
{-| Repeat a value ad infinitum.
|
||||
Be careful when you use this. The result of this is a truly infinite list.
|
||||
Do not try calling `reduce` or `toList` on an infinite list as it'll never
|
||||
finish computing. Make sure you then filter it down to a finite list with `head`
|
||||
or `take` or something.
|
||||
-}
|
||||
repeat : a -> LazyList a
|
||||
repeat a =
|
||||
lazy <|
|
||||
\() ->
|
||||
Cons a (repeat a)
|
||||
|
||||
|
||||
{-| Append a list to another list.
|
||||
-}
|
||||
append : LazyList a -> LazyList a -> LazyList a
|
||||
append list1 list2 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
force list2
|
||||
|
||||
Cons first rest ->
|
||||
force (first ::: rest +++ list2)
|
||||
|
||||
|
||||
{-| Interleave the elements of a list in another list. The two lists get
|
||||
interleaved at the end.
|
||||
-}
|
||||
interleave : LazyList a -> LazyList a -> LazyList a
|
||||
interleave list1 list2 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
force list2
|
||||
|
||||
Cons first1 rest1 ->
|
||||
case force list2 of
|
||||
Nil ->
|
||||
force list1
|
||||
|
||||
Cons first2 rest2 ->
|
||||
force (first1 ::: first2 ::: interleave rest1 rest2)
|
||||
|
||||
|
||||
{-| Places the given value between all members of the given list.
|
||||
-}
|
||||
intersperse : a -> LazyList a -> LazyList a
|
||||
intersperse a list =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
case force rest of
|
||||
Nil ->
|
||||
force (first ::: empty)
|
||||
|
||||
Cons second tail ->
|
||||
case force tail of
|
||||
Nil ->
|
||||
force (first ::: a ::: second ::: empty)
|
||||
|
||||
_ ->
|
||||
force (first ::: a ::: second ::: a ::: intersperse a tail)
|
||||
|
||||
|
||||
{-| Take a list and repeat it ad infinitum. This cycles a finite list
|
||||
by putting the front after the end of the list. This results in a no-op in
|
||||
the case of an infinite list.
|
||||
-}
|
||||
cycle : LazyList a -> LazyList a
|
||||
cycle list =
|
||||
list
|
||||
+++ (lazy <|
|
||||
\() ->
|
||||
force (cycle list)
|
||||
)
|
||||
|
||||
|
||||
{-| Create an infinite list of applications of a function on some value.
|
||||
|
||||
Equivalent to:
|
||||
|
||||
x ::: f x ::: f (f x) ::: f (f (f x)) ::: ... -- etc...
|
||||
-}
|
||||
iterate : (a -> a) -> a -> LazyList a
|
||||
iterate f a =
|
||||
lazy <|
|
||||
\() ->
|
||||
Cons a (iterate f (f a))
|
||||
|
||||
|
||||
{-| The infinite list of counting numbers.
|
||||
|
||||
i.e.:
|
||||
|
||||
1 ::: 2 ::: 3 ::: 4 ::: 5 ::: ... -- etc...
|
||||
-}
|
||||
numbers : LazyList number
|
||||
numbers =
|
||||
iterate ((+) 1) 1
|
||||
|
||||
|
||||
{-| Take at most `n` many values from a list.
|
||||
-}
|
||||
take : Int -> LazyList a -> LazyList a
|
||||
take n list =
|
||||
lazy <|
|
||||
\() ->
|
||||
if n <= 0 then
|
||||
Nil
|
||||
else
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
Cons first (take (n - 1) rest)
|
||||
|
||||
|
||||
{-| Take elements from a list as long as the predicate is satisfied.
|
||||
-}
|
||||
takeWhile : (a -> Bool) -> LazyList a -> LazyList a
|
||||
takeWhile predicate list =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
if predicate first then
|
||||
Cons first (takeWhile predicate rest)
|
||||
else
|
||||
Nil
|
||||
|
||||
|
||||
{-| Drop at most `n` many values from a list.
|
||||
-}
|
||||
drop : Int -> LazyList a -> LazyList a
|
||||
drop n list =
|
||||
lazy <|
|
||||
\() ->
|
||||
if n <= 0 then
|
||||
force list
|
||||
else
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
force (drop (n - 1) rest)
|
||||
|
||||
|
||||
{-| Drop elements from a list as long as the predicate is satisfied.
|
||||
-}
|
||||
dropWhile : (a -> Bool) -> LazyList a -> LazyList a
|
||||
dropWhile predicate list =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
if predicate first then
|
||||
force (dropWhile predicate rest)
|
||||
else
|
||||
force list
|
||||
|
||||
|
||||
{-| Test if a value is a member of a list.
|
||||
-}
|
||||
member : a -> LazyList a -> Bool
|
||||
member a list =
|
||||
case force list of
|
||||
Nil ->
|
||||
False
|
||||
|
||||
Cons first rest ->
|
||||
first == a || member a rest
|
||||
|
||||
|
||||
{-| Get the length of a lazy list.
|
||||
|
||||
Warning: This will not terminate if the list is infinite.
|
||||
-}
|
||||
length : LazyList a -> Int
|
||||
length =
|
||||
reduce (\_ n -> n + 1) 0
|
||||
|
||||
|
||||
{-| Remove all duplicates from a list and return a list of distinct elements.
|
||||
-}
|
||||
unique : LazyList a -> LazyList a
|
||||
unique list =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
if member first rest then
|
||||
force (unique rest)
|
||||
else
|
||||
Cons first (unique rest)
|
||||
|
||||
|
||||
{-| Keep all elements in a list that satisfy the given predicate.
|
||||
-}
|
||||
keepIf : (a -> Bool) -> LazyList a -> LazyList a
|
||||
keepIf predicate list =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
if predicate first then
|
||||
Cons first (keepIf predicate rest)
|
||||
else
|
||||
force (keepIf predicate rest)
|
||||
|
||||
|
||||
{-| Drop all elements in a list that satisfy the given predicate.
|
||||
-}
|
||||
dropIf : (a -> Bool) -> LazyList a -> LazyList a
|
||||
dropIf predicate =
|
||||
keepIf (\n -> not (predicate n))
|
||||
|
||||
|
||||
{-| Map a function that may fail over a lazy list, keeping only
|
||||
the values that were successfully transformed.
|
||||
-}
|
||||
filterMap : (a -> Maybe b) -> LazyList a -> LazyList b
|
||||
filterMap transform list =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
case transform first of
|
||||
Just val ->
|
||||
Cons val (filterMap transform rest)
|
||||
|
||||
Nothing ->
|
||||
force (filterMap transform rest)
|
||||
|
||||
|
||||
{-| Reduce a list with a given reducer and an initial value.
|
||||
|
||||
Example :
|
||||
reduce (+) 0 (1 ::: 2 ::: 3 ::: 4 ::: empty) == 10
|
||||
-}
|
||||
reduce : (a -> b -> b) -> b -> LazyList a -> b
|
||||
reduce reducer b list =
|
||||
case force list of
|
||||
Nil ->
|
||||
b
|
||||
|
||||
Cons first rest ->
|
||||
reduce reducer (reducer first b) rest
|
||||
|
||||
|
||||
{-| Analogous to `List.foldl`. Is an alias for `reduce`.
|
||||
-}
|
||||
foldl : (a -> b -> b) -> b -> LazyList a -> b
|
||||
foldl =
|
||||
reduce
|
||||
|
||||
|
||||
{-| Analogous to `List.foldr`.
|
||||
-}
|
||||
foldr : (a -> b -> b) -> b -> LazyList a -> b
|
||||
foldr reducer b list =
|
||||
Array.foldr reducer b (toArray list)
|
||||
|
||||
|
||||
{-| Get the sum of a list of numbers.
|
||||
-}
|
||||
sum : LazyList number -> number
|
||||
sum =
|
||||
reduce (+) 0
|
||||
|
||||
|
||||
{-| Get the product of a list of numbers.
|
||||
-}
|
||||
product : LazyList number -> number
|
||||
product =
|
||||
reduce (*) 1
|
||||
|
||||
|
||||
{-| Flatten a list of lists into a single list by appending all the inner
|
||||
lists into one big list.
|
||||
-}
|
||||
flatten : LazyList (LazyList a) -> LazyList a
|
||||
flatten list =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
force (first +++ flatten rest)
|
||||
|
||||
|
||||
{-| Chain list producing operations. Map then flatten.
|
||||
-}
|
||||
andThen : (a -> LazyList b) -> LazyList a -> LazyList b
|
||||
andThen f list =
|
||||
map f list |> flatten
|
||||
|
||||
|
||||
{-| Reverse a list.
|
||||
-}
|
||||
reverse : LazyList a -> LazyList a
|
||||
reverse =
|
||||
reduce cons empty
|
||||
|
||||
|
||||
{-| Map a function to a list.
|
||||
-}
|
||||
map : (a -> b) -> LazyList a -> LazyList b
|
||||
map f list =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first rest ->
|
||||
Cons (f first) (map f rest)
|
||||
|
||||
|
||||
{-| -}
|
||||
map2 : (a -> b -> c) -> LazyList a -> LazyList b -> LazyList c
|
||||
map2 f list1 list2 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first1 rest1 ->
|
||||
case force list2 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first2 rest2 ->
|
||||
Cons (f first1 first2) (map2 f rest1 rest2)
|
||||
|
||||
|
||||
{-| Known as `mapN` in some circles. Allows you to apply `map` in cases
|
||||
where then number of arguments are greater than 5.
|
||||
|
||||
The argument order is such that it works well with `|>` chains.
|
||||
-}
|
||||
andMap : LazyList a -> LazyList (a -> b) -> LazyList b
|
||||
andMap listVal listFuncs =
|
||||
map2 (<|) listFuncs listVal
|
||||
|
||||
|
||||
{-| -}
|
||||
map3 : (a -> b -> c -> d) -> LazyList a -> LazyList b -> LazyList c -> LazyList d
|
||||
map3 f list1 list2 list3 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first1 rest1 ->
|
||||
case force list2 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first2 rest2 ->
|
||||
case force list3 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first3 rest3 ->
|
||||
Cons (f first1 first2 first3) (map3 f rest1 rest2 rest3)
|
||||
|
||||
|
||||
{-| -}
|
||||
map4 : (a -> b -> c -> d -> e) -> LazyList a -> LazyList b -> LazyList c -> LazyList d -> LazyList e
|
||||
map4 f list1 list2 list3 list4 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first1 rest1 ->
|
||||
case force list2 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first2 rest2 ->
|
||||
case force list3 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first3 rest3 ->
|
||||
case force list4 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first4 rest4 ->
|
||||
Cons (f first1 first2 first3 first4) (map4 f rest1 rest2 rest3 rest4)
|
||||
|
||||
|
||||
{-| -}
|
||||
map5 : (a -> b -> c -> d -> e -> f) -> LazyList a -> LazyList b -> LazyList c -> LazyList d -> LazyList e -> LazyList f
|
||||
map5 f list1 list2 list3 list4 list5 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first1 rest1 ->
|
||||
case force list2 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first2 rest2 ->
|
||||
case force list3 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first3 rest3 ->
|
||||
case force list4 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first4 rest4 ->
|
||||
case force list5 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first5 rest5 ->
|
||||
Cons
|
||||
(f first1 first2 first3 first4 first5)
|
||||
(map5 f rest1 rest2 rest3 rest4 rest5)
|
||||
|
||||
|
||||
{-| -}
|
||||
zip : LazyList a -> LazyList b -> LazyList ( a, b )
|
||||
zip =
|
||||
map2 (,)
|
||||
|
||||
|
||||
{-| -}
|
||||
zip3 : LazyList a -> LazyList b -> LazyList c -> LazyList ( a, b, c )
|
||||
zip3 =
|
||||
map3 (,,)
|
||||
|
||||
|
||||
{-| -}
|
||||
zip4 : LazyList a -> LazyList b -> LazyList c -> LazyList d -> LazyList ( a, b, c, d )
|
||||
zip4 =
|
||||
map4 (,,,)
|
||||
|
||||
|
||||
{-| -}
|
||||
zip5 : LazyList a -> LazyList b -> LazyList c -> LazyList d -> LazyList e -> LazyList ( a, b, c, d, e )
|
||||
zip5 =
|
||||
map5 (,,,,)
|
||||
|
||||
|
||||
{-| Create a lazy list containing all possible pairs in the given lazy lists.
|
||||
-}
|
||||
product2 : LazyList a -> LazyList b -> LazyList ( a, b )
|
||||
product2 list1 list2 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first1 rest1 ->
|
||||
case force list2 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons _ _ ->
|
||||
force <| map ((,) first1) list2 +++ product2 rest1 list2
|
||||
|
||||
|
||||
{-| Create a lazy list containing all possible triples in the given lazy lists.
|
||||
-}
|
||||
product3 : LazyList a -> LazyList b -> LazyList c -> LazyList ( a, b, c )
|
||||
product3 list1 list2 list3 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first1 rest1 ->
|
||||
force <| map (\( b, c ) -> ( first1, b, c )) (product2 list2 list3) +++ product3 rest1 list2 list3
|
||||
|
||||
|
||||
{-| Create a lazy list containing all possible 4-tuples in the given lazy lists.
|
||||
-}
|
||||
product4 : LazyList a -> LazyList b -> LazyList c -> LazyList d -> LazyList ( a, b, c, d )
|
||||
product4 list1 list2 list3 list4 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first1 rest1 ->
|
||||
force <| map (\( b, c, d ) -> ( first1, b, c, d )) (product3 list2 list3 list4) +++ product4 rest1 list2 list3 list4
|
||||
|
||||
|
||||
{-| Create a lazy list containing all possible 5-tuples in the given lazy lists.
|
||||
-}
|
||||
product5 : LazyList a -> LazyList b -> LazyList c -> LazyList d -> LazyList e -> LazyList ( a, b, c, d, e )
|
||||
product5 list1 list2 list3 list4 list5 =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force list1 of
|
||||
Nil ->
|
||||
Nil
|
||||
|
||||
Cons first1 rest1 ->
|
||||
force <| map (\( b, c, d, e ) -> ( first1, b, c, d, e )) (product4 list2 list3 list4 list5) +++ product5 rest1 list2 list3 list4 list5
|
||||
|
||||
|
||||
{-| Convert a lazy list to a normal list.
|
||||
-}
|
||||
toList : LazyList a -> List a
|
||||
toList list =
|
||||
case force list of
|
||||
Nil ->
|
||||
[]
|
||||
|
||||
Cons first rest ->
|
||||
first :: toList rest
|
||||
|
||||
|
||||
{-| Convert a normal list to a lazy list.
|
||||
-}
|
||||
fromList : List a -> LazyList a
|
||||
fromList =
|
||||
List.foldr cons empty
|
||||
|
||||
|
||||
{-| Convert a lazy list to an array.
|
||||
-}
|
||||
toArray : LazyList a -> Array a
|
||||
toArray list =
|
||||
case force list of
|
||||
Nil ->
|
||||
Array.empty
|
||||
|
||||
Cons first rest ->
|
||||
Array.append (Array.push first Array.empty) (toArray rest)
|
||||
|
||||
|
||||
{-| Convert an array to a lazy list.
|
||||
-}
|
||||
fromArray : Array a -> LazyList a
|
||||
fromArray =
|
||||
Array.foldr cons empty
|
||||
|
||||
|
||||
|
||||
---------------------
|
||||
-- INFIX OPERATORS --
|
||||
---------------------
|
||||
|
||||
|
||||
infixr 5 :::
|
||||
|
||||
|
||||
{-| Alias for `cons`. Analogous to `::` for lists.
|
||||
-}
|
||||
(:::) : a -> LazyList a -> LazyList a
|
||||
(:::) =
|
||||
cons
|
||||
|
||||
|
||||
infixr 5 +++
|
||||
|
||||
|
||||
{-| Alias for `append`. Analogous to `++` for lists.
|
||||
-}
|
||||
(+++) : LazyList a -> LazyList a -> LazyList a
|
||||
(+++) =
|
||||
append
|
||||
32
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/tests/Example.elm
vendored
Normal file
32
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/tests/Example.elm
vendored
Normal file
@@ -0,0 +1,32 @@
|
||||
module Example exposing (..)
|
||||
|
||||
import Expect exposing (Expectation)
|
||||
import Fuzz exposing (Fuzzer, list, int, string)
|
||||
import Test exposing (..)
|
||||
import Lazy.List exposing (..)
|
||||
|
||||
|
||||
suite : Test
|
||||
suite =
|
||||
describe "List.lazy"
|
||||
[ test "Empty things are empty"
|
||||
(\_ ->
|
||||
empty
|
||||
|> isEmpty
|
||||
|> Expect.true "Empty is empty"
|
||||
)
|
||||
, test "A list of two things has two things"
|
||||
(\_ ->
|
||||
singleton 5
|
||||
|> cons 6
|
||||
|> toList
|
||||
|> Expect.equal [ 6, 5 ]
|
||||
)
|
||||
, test "The sum is correctly computed"
|
||||
(\_ ->
|
||||
singleton 10
|
||||
|> cons 6
|
||||
|> sum
|
||||
|> Expect.equal 16
|
||||
)
|
||||
]
|
||||
19
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/tests/elm-package.json
vendored
Normal file
19
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy-list/1.0.0/tests/elm-package.json
vendored
Normal file
@@ -0,0 +1,19 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "Test Suites",
|
||||
"repository": "https://github.com/user/project.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"../src",
|
||||
"."
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"dependencies": {
|
||||
"eeue56/elm-html-test": "4.1.0 <= v < 5.0.0",
|
||||
"eeue56/elm-lazy": "1.0.0 <= v < 2.0.0",
|
||||
"elm-community/elm-test": "4.0.0 <= v < 5.0.0",
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/.gitignore
vendored
Normal file
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/.gitignore
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
# elm-package generated files
|
||||
elm-stuff
|
||||
# elm-repl generated files
|
||||
repl-temp-*
|
||||
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/LICENSE
vendored
Normal file
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/LICENSE
vendored
Normal file
@@ -0,0 +1,29 @@
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2017, Noah
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
32
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/README.md
vendored
Normal file
32
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/README.md
vendored
Normal file
@@ -0,0 +1,32 @@
|
||||
# elm-lazy
|
||||
|
||||
|
||||
This library provides a way of putting of computations until they are needed, allowing for expensive calculations later.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
lazy (\() -> sum <| List.range 1 1000000)
|
||||
|
||||
It also gives you a way of storing a computed value so that you do not need to re-compute it.
|
||||
|
||||
lazySum : Int -> Lazy Int
|
||||
lazySum n =
|
||||
lazy (\() -> sum <| List.range 0 n)
|
||||
|
||||
|
||||
lazySums : List Int -> List (Lazy Int)
|
||||
lazySums sums =
|
||||
List.map lazySum sums
|
||||
|
||||
-- evaluates the head, before putting it back on the list
|
||||
evaluteCurrentSum : List (Lazy Int) -> List (Lazy Int)
|
||||
evaluteCurrentSum xs =
|
||||
case xs of
|
||||
head::rest -> Lazy.evaluate head :: rest
|
||||
_ -> []
|
||||
|
||||
|
||||
## Notes
|
||||
|
||||
|
||||
This is a library based originally on the old `Lazy` implementation. However, it is written entirely in pure Elm. The main difference is explicit memoization, as we no longer use side-effects to achieve laziness.
|
||||
171
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/benchmarks/CoreLazy.elm
vendored
Normal file
171
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/benchmarks/CoreLazy.elm
vendored
Normal file
@@ -0,0 +1,171 @@
|
||||
module CoreLazy
|
||||
exposing
|
||||
( Lazy
|
||||
, force
|
||||
, lazy
|
||||
, map
|
||||
, map2
|
||||
, map3
|
||||
, map4
|
||||
, map5
|
||||
, apply
|
||||
, andThen
|
||||
)
|
||||
|
||||
{-| This library lets you delay a computation until later.
|
||||
|
||||
# Basics
|
||||
@docs Lazy, lazy, force
|
||||
|
||||
# Mapping
|
||||
@docs map, map2, map3, map4, map5
|
||||
|
||||
# Chaining
|
||||
@docs apply, andThen
|
||||
-}
|
||||
|
||||
import Native.Lazy
|
||||
|
||||
|
||||
-- PRIMITIVES
|
||||
|
||||
|
||||
{-| A wrapper around a value that will be lazily evaluated.
|
||||
-}
|
||||
type Lazy a
|
||||
= Lazy (() -> a)
|
||||
|
||||
|
||||
{-| Delay the evaluation of a value until later. For example, maybe we will
|
||||
need to generate a very long list and find its sum, but we do not want to do
|
||||
it unless it is absolutely necessary.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
lazy (\() -> sum [1..1000000])
|
||||
|
||||
Now we only pay for `lazySum` if we actually need it.
|
||||
-}
|
||||
lazy : (() -> a) -> Lazy a
|
||||
lazy thunk =
|
||||
Lazy (Native.Lazy.memoize thunk)
|
||||
|
||||
|
||||
{-| Force the evaluation of a lazy value. This means we only pay for the
|
||||
computation when we need it. Here is a rather contrived example.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
lazy (\() -> List.sum [1..1000000])
|
||||
|
||||
sums : (Int, Int, Int)
|
||||
sums =
|
||||
(force lazySum, force lazySum, force lazySum)
|
||||
|
||||
We are forcing this computation three times. The cool thing is that the first
|
||||
time you `force` a value, the result is stored. This means you pay the cost on
|
||||
the first one, but all the rest are very cheap, basically just looking up a
|
||||
value in memory.
|
||||
-}
|
||||
force : Lazy a -> a
|
||||
force (Lazy thunk) =
|
||||
thunk ()
|
||||
|
||||
|
||||
|
||||
-- COMPOSING LAZINESS
|
||||
|
||||
|
||||
{-| Lazily apply a function to a lazy value.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
map List.sum (lazy (\() -> [1..1000000]))
|
||||
|
||||
The resulting lazy value will create a big list and sum it up when it is
|
||||
finally forced.
|
||||
-}
|
||||
map : (a -> b) -> Lazy a -> Lazy b
|
||||
map f a =
|
||||
lazy (\() -> f (force a))
|
||||
|
||||
|
||||
{-| Lazily apply a function to two lazy values.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
lazy (\() -> List.sum [1..1000000])
|
||||
|
||||
lazySumPair : Lazy (Int, Int)
|
||||
lazySumPair =
|
||||
map2 (,) lazySum lazySum
|
||||
|
||||
-}
|
||||
map2 : (a -> b -> result) -> Lazy a -> Lazy b -> Lazy result
|
||||
map2 f a b =
|
||||
lazy (\() -> f (force a) (force b))
|
||||
|
||||
|
||||
{-| -}
|
||||
map3 : (a -> b -> c -> result) -> Lazy a -> Lazy b -> Lazy c -> Lazy result
|
||||
map3 f a b c =
|
||||
lazy (\() -> f (force a) (force b) (force c))
|
||||
|
||||
|
||||
{-| -}
|
||||
map4 : (a -> b -> c -> d -> result) -> Lazy a -> Lazy b -> Lazy c -> Lazy d -> Lazy result
|
||||
map4 f a b c d =
|
||||
lazy (\() -> f (force a) (force b) (force c) (force d))
|
||||
|
||||
|
||||
{-| -}
|
||||
map5 : (a -> b -> c -> d -> e -> result) -> Lazy a -> Lazy b -> Lazy c -> Lazy d -> Lazy e -> Lazy result
|
||||
map5 f a b c d e =
|
||||
lazy (\() -> f (force a) (force b) (force c) (force d) (force e))
|
||||
|
||||
|
||||
{-| Lazily apply a lazy function to a lazy value. This is pretty rare on its
|
||||
own, but it lets you map as high as you want.
|
||||
|
||||
map3 f a b == f `map` a `apply` b `apply` c
|
||||
|
||||
It is not the most beautiful, but it is equivalent and will let you create
|
||||
`map9` quite easily if you really need it.
|
||||
-}
|
||||
apply : Lazy (a -> b) -> Lazy a -> Lazy b
|
||||
apply f x =
|
||||
lazy (\() -> (force f) (force x))
|
||||
|
||||
|
||||
{-| Lazily chain together lazy computations, for when you have a series of
|
||||
steps that all need to be performed lazily. This can be nice when you need to
|
||||
pattern match on a value, for example, when appending lazy lists:
|
||||
|
||||
type List a = Empty | Node a (Lazy (List a))
|
||||
|
||||
cons : a -> Lazy (List a) -> Lazy (List a)
|
||||
cons first rest =
|
||||
Lazy.map (Node first) rest
|
||||
|
||||
append : Lazy (List a) -> Lazy (List a) -> Lazy (List a)
|
||||
append lazyList1 lazyList2 =
|
||||
let
|
||||
appendHelp list1 =
|
||||
case list1 of
|
||||
Empty ->
|
||||
lazyList2
|
||||
|
||||
Node first rest ->
|
||||
cons first (append rest list2))
|
||||
in
|
||||
lazyList1
|
||||
|> Lazy.andThen appendHelp
|
||||
|
||||
|
||||
By using `andThen` we ensure that neither `lazyList1` or `lazyList2` are forced
|
||||
before they are needed. So as written, the `append` function delays the pattern
|
||||
matching until later.
|
||||
-}
|
||||
andThen : (a -> Lazy b) -> Lazy a -> Lazy b
|
||||
andThen callback a =
|
||||
lazy (\() -> force (callback (force a)))
|
||||
108
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/benchmarks/Main.elm
vendored
Normal file
108
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/benchmarks/Main.elm
vendored
Normal file
@@ -0,0 +1,108 @@
|
||||
module Main exposing (..)
|
||||
|
||||
import Benchmark exposing (..)
|
||||
import Benchmark.Runner exposing (BenchmarkProgram, program)
|
||||
import CoreLazy
|
||||
import Lazy
|
||||
|
||||
|
||||
basicInt : Lazy.Lazy Int
|
||||
basicInt =
|
||||
Lazy.lazy (\() -> 1)
|
||||
|
||||
|
||||
basicCoreInt : CoreLazy.Lazy Int
|
||||
basicCoreInt =
|
||||
CoreLazy.lazy (\() -> 1)
|
||||
|
||||
|
||||
bigThunk : () -> List Int
|
||||
bigThunk _ =
|
||||
List.range 0 10000
|
||||
|
||||
|
||||
complexThing : () -> Lazy.Lazy (List Int)
|
||||
complexThing _ =
|
||||
Lazy.lazy (\() -> List.range 0 10000)
|
||||
|
||||
|
||||
complexCoreThing : () -> CoreLazy.Lazy (List Int)
|
||||
complexCoreThing _ =
|
||||
CoreLazy.lazy (\() -> List.range 0 10000)
|
||||
|
||||
|
||||
suite : Benchmark
|
||||
suite =
|
||||
describe "Lazy"
|
||||
[ describe "force"
|
||||
[ benchmark1 "force" Lazy.force basicInt
|
||||
, Benchmark.compare "forcing a small int"
|
||||
(benchmark1 "eeue56" Lazy.force basicInt)
|
||||
(benchmark1 "core" CoreLazy.force basicCoreInt)
|
||||
, Benchmark.compare "forcing a large list"
|
||||
(benchmark "eeue56" (complexThing >> Lazy.force))
|
||||
(benchmark "core" (complexCoreThing >> CoreLazy.force))
|
||||
, Benchmark.compare "memoization"
|
||||
(benchmark1 "eeue56"
|
||||
(\thing ->
|
||||
let
|
||||
xs =
|
||||
Lazy.lazy thing
|
||||
|
||||
firstPass =
|
||||
Lazy.evaluate xs
|
||||
|
||||
secondPass =
|
||||
Lazy.evaluate firstPass
|
||||
in
|
||||
secondPass |> Lazy.force
|
||||
)
|
||||
bigThunk
|
||||
)
|
||||
(benchmark1 "core"
|
||||
(\thing ->
|
||||
let
|
||||
xs =
|
||||
CoreLazy.lazy thing
|
||||
|
||||
firstPass =
|
||||
CoreLazy.force xs
|
||||
|
||||
secondPass =
|
||||
CoreLazy.force xs
|
||||
in
|
||||
xs |> CoreLazy.force
|
||||
)
|
||||
bigThunk
|
||||
)
|
||||
, Benchmark.compare "memoization foldl"
|
||||
(benchmark1 "eeue56"
|
||||
(\thing ->
|
||||
List.foldl (\_ lazyThing -> Lazy.evaluate lazyThing) (Lazy.lazy thing) (List.range 0 5)
|
||||
|> Lazy.force
|
||||
)
|
||||
bigThunk
|
||||
)
|
||||
(benchmark1 "core"
|
||||
(\thing ->
|
||||
List.foldl
|
||||
(\_ lazyThing ->
|
||||
let
|
||||
_ =
|
||||
CoreLazy.force lazyThing
|
||||
in
|
||||
lazyThing
|
||||
)
|
||||
(CoreLazy.lazy thing)
|
||||
(List.range 0 5)
|
||||
|> CoreLazy.force
|
||||
)
|
||||
bigThunk
|
||||
)
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
main : BenchmarkProgram
|
||||
main =
|
||||
program suite
|
||||
20
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/benchmarks/Native/Lazy.js
vendored
Normal file
20
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/benchmarks/Native/Lazy.js
vendored
Normal file
@@ -0,0 +1,20 @@
|
||||
var _user$project$Native_Lazy = function() {
|
||||
|
||||
function memoize(thunk)
|
||||
{
|
||||
var value;
|
||||
var isForced = false;
|
||||
return function(tuple0) {
|
||||
if (!isForced) {
|
||||
value = thunk(tuple0);
|
||||
isForced = true;
|
||||
}
|
||||
return value;
|
||||
};
|
||||
}
|
||||
|
||||
return {
|
||||
memoize: memoize
|
||||
};
|
||||
|
||||
}();
|
||||
18
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/benchmarks/elm-package.json
vendored
Normal file
18
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/benchmarks/elm-package.json
vendored
Normal file
@@ -0,0 +1,18 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "helpful summary of your project, less than 80 characters",
|
||||
"repository": "https://github.com/user/project.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
".",
|
||||
"../src"
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"native-modules": true,
|
||||
"dependencies": {
|
||||
"BrianHicks/elm-benchmark": "1.0.2 <= v < 2.0.0",
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
15
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/elm-package.json
vendored
Normal file
15
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/elm-package.json
vendored
Normal file
@@ -0,0 +1,15 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "Laziness and optional memoization in pure Elm",
|
||||
"repository": "https://github.com/eeue56/elm-lazy.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": ["Lazy"],
|
||||
"dependencies": {
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
201
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/src/Lazy.elm
vendored
Normal file
201
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/src/Lazy.elm
vendored
Normal file
@@ -0,0 +1,201 @@
|
||||
module Lazy
|
||||
exposing
|
||||
( Lazy
|
||||
, force
|
||||
, lazy
|
||||
, evaluate
|
||||
, map
|
||||
, map2
|
||||
, map3
|
||||
, map4
|
||||
, map5
|
||||
, apply
|
||||
, andThen
|
||||
)
|
||||
|
||||
{-| This library lets you delay a computation until later.
|
||||
|
||||
# Basics
|
||||
@docs Lazy, lazy, force, evaluate
|
||||
|
||||
# Mapping
|
||||
@docs map, map2, map3, map4, map5
|
||||
|
||||
# Chaining
|
||||
@docs apply, andThen
|
||||
-}
|
||||
|
||||
-- PRIMITIVES
|
||||
|
||||
|
||||
{-| A wrapper around a value that will be lazily evaluated.
|
||||
-}
|
||||
type Lazy a
|
||||
= Lazy (() -> a)
|
||||
| Evaluated a
|
||||
|
||||
|
||||
{-| Delay the evaluation of a value until later. For example, maybe we will
|
||||
need to generate a very long list and find its sum, but we do not want to do
|
||||
it unless it is absolutely necessary.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
lazy (\() -> sum <| List.range 1 1000000 )
|
||||
|
||||
Now we only pay for `lazySum` if we actually need it.
|
||||
-}
|
||||
lazy : (() -> a) -> Lazy a
|
||||
lazy thunk =
|
||||
Lazy thunk
|
||||
|
||||
|
||||
{-| Force the evaluation of a lazy value. This means we only pay for the
|
||||
computation when we need it. Here is a rather contrived example.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
lazy (\() -> List.sum <| List.range 1 1000000)
|
||||
|
||||
sums : (Int, Int, Int)
|
||||
sums =
|
||||
(force lazySum, force lazySum, force lazySum)
|
||||
-}
|
||||
force : Lazy a -> a
|
||||
force piece =
|
||||
case piece of
|
||||
Evaluated a ->
|
||||
a
|
||||
|
||||
Lazy thunk ->
|
||||
thunk ()
|
||||
|
||||
|
||||
{-| Evaluate the lazy value if it has not already been evaluated. If it has,
|
||||
do nothing.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
lazy (\() -> List.sum <| List.range 1 1000000)
|
||||
|
||||
sums : (Int, Int, Int)
|
||||
sums =
|
||||
let
|
||||
evaledSum =
|
||||
evaluate lazySum
|
||||
in
|
||||
(force evaledSum, force evaledSum, force evaledSum)
|
||||
|
||||
This is mainly useful for cases where you may want to store a lazy value as a
|
||||
lazy value and pass it around. For example, in a list. Where possible, it is better to use
|
||||
`force` and simply store the computed value seperately.
|
||||
|
||||
-}
|
||||
evaluate : Lazy a -> Lazy a
|
||||
evaluate piece =
|
||||
case piece of
|
||||
Evaluated a ->
|
||||
Evaluated a
|
||||
|
||||
Lazy thunk ->
|
||||
thunk ()
|
||||
|> Evaluated
|
||||
|
||||
|
||||
|
||||
-- COMPOSING LAZINESS
|
||||
|
||||
|
||||
{-| Lazily apply a function to a lazy value.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
map List.sum (lazy (\() -> <| List.range 1 1000000)
|
||||
|
||||
The resulting lazy value will create a big list and sum it up when it is
|
||||
finally forced.
|
||||
-}
|
||||
map : (a -> b) -> Lazy a -> Lazy b
|
||||
map f a =
|
||||
lazy (\() -> f (force a))
|
||||
|
||||
|
||||
{-| Lazily apply a function to two lazy values.
|
||||
|
||||
lazySum : Lazy Int
|
||||
lazySum =
|
||||
lazy (\() -> List.sum <| List.range 1 1000000)
|
||||
|
||||
lazySumPair : Lazy (Int, Int)
|
||||
lazySumPair =
|
||||
map2 (,) lazySum lazySum
|
||||
|
||||
-}
|
||||
map2 : (a -> b -> result) -> Lazy a -> Lazy b -> Lazy result
|
||||
map2 f a b =
|
||||
lazy (\() -> f (force a) (force b))
|
||||
|
||||
|
||||
{-| -}
|
||||
map3 : (a -> b -> c -> result) -> Lazy a -> Lazy b -> Lazy c -> Lazy result
|
||||
map3 f a b c =
|
||||
lazy (\() -> f (force a) (force b) (force c))
|
||||
|
||||
|
||||
{-| -}
|
||||
map4 : (a -> b -> c -> d -> result) -> Lazy a -> Lazy b -> Lazy c -> Lazy d -> Lazy result
|
||||
map4 f a b c d =
|
||||
lazy (\() -> f (force a) (force b) (force c) (force d))
|
||||
|
||||
|
||||
{-| -}
|
||||
map5 : (a -> b -> c -> d -> e -> result) -> Lazy a -> Lazy b -> Lazy c -> Lazy d -> Lazy e -> Lazy result
|
||||
map5 f a b c d e =
|
||||
lazy (\() -> f (force a) (force b) (force c) (force d) (force e))
|
||||
|
||||
|
||||
{-| Lazily apply a lazy function to a lazy value. This is pretty rare on its
|
||||
own, but it lets you map as high as you want.
|
||||
|
||||
map3 f a b == f `map` a `apply` b `apply` c
|
||||
|
||||
It is not the most beautiful, but it is equivalent and will let you create
|
||||
`map9` quite easily if you really need it.
|
||||
-}
|
||||
apply : Lazy (a -> b) -> Lazy a -> Lazy b
|
||||
apply f x =
|
||||
lazy (\() -> (force f) (force x))
|
||||
|
||||
|
||||
{-| Lazily chain together lazy computations, for when you have a series of
|
||||
steps that all need to be performed lazily. This can be nice when you need to
|
||||
pattern match on a value, for example, when appending lazy lists:
|
||||
|
||||
type List a = Empty | Node a (Lazy (List a))
|
||||
|
||||
cons : a -> Lazy (List a) -> Lazy (List a)
|
||||
cons first rest =
|
||||
Lazy.map (Node first) rest
|
||||
|
||||
append : Lazy (List a) -> Lazy (List a) -> Lazy (List a)
|
||||
append lazyList1 lazyList2 =
|
||||
let
|
||||
appendHelp list1 =
|
||||
case list1 of
|
||||
Empty ->
|
||||
lazyList2
|
||||
|
||||
Node first rest ->
|
||||
cons first (append rest list2))
|
||||
in
|
||||
lazyList1
|
||||
|> Lazy.andThen appendHelp
|
||||
|
||||
|
||||
By using `andThen` we ensure that neither `lazyList1` or `lazyList2` are forced
|
||||
before they are needed. So as written, the `append` function delays the pattern
|
||||
matching until later.
|
||||
-}
|
||||
andThen : (a -> Lazy b) -> Lazy a -> Lazy b
|
||||
andThen callback a =
|
||||
lazy (\() -> force (callback (force a)))
|
||||
43
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/tests/Example.elm
vendored
Normal file
43
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/tests/Example.elm
vendored
Normal file
@@ -0,0 +1,43 @@
|
||||
module Example exposing (..)
|
||||
|
||||
import Lazy
|
||||
import Expect exposing (Expectation)
|
||||
import Fuzz exposing (Fuzzer, list, int, string)
|
||||
import Test exposing (..)
|
||||
|
||||
|
||||
suite : Test
|
||||
suite =
|
||||
describe "Laziness"
|
||||
[ fuzz int
|
||||
"lazy and force"
|
||||
(\x ->
|
||||
Lazy.lazy (\() -> x)
|
||||
|> Lazy.force
|
||||
|> Expect.equal x
|
||||
)
|
||||
, fuzz int
|
||||
"evaluate"
|
||||
(\x ->
|
||||
Lazy.lazy (\() -> x)
|
||||
|> Lazy.evaluate
|
||||
|> Lazy.force
|
||||
|> Expect.equal x
|
||||
)
|
||||
, fuzz int
|
||||
"map"
|
||||
(\x ->
|
||||
Lazy.lazy (\() -> x)
|
||||
|> Lazy.map (\x -> x + 1)
|
||||
|> Lazy.force
|
||||
|> Expect.equal (x + 1)
|
||||
)
|
||||
, fuzz2 int
|
||||
int
|
||||
"map2"
|
||||
(\x y ->
|
||||
Lazy.map2 (\x y -> x + y) (Lazy.lazy (\() -> x)) (Lazy.lazy (\() -> y))
|
||||
|> Lazy.force
|
||||
|> Expect.equal (x + y)
|
||||
)
|
||||
]
|
||||
18
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/tests/elm-package.json
vendored
Normal file
18
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-lazy/1.0.0/tests/elm-package.json
vendored
Normal file
@@ -0,0 +1,18 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "Test Suites",
|
||||
"repository": "https://github.com/user/project.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"../src",
|
||||
"."
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"dependencies": {
|
||||
"eeue56/elm-html-test": "4.1.0 <= v < 5.0.0",
|
||||
"elm-community/elm-test": "4.0.0 <= v < 5.0.0",
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/.gitignore
vendored
Normal file
4
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/.gitignore
vendored
Normal file
@@ -0,0 +1,4 @@
|
||||
# elm-package generated files
|
||||
elm-stuff
|
||||
# elm-repl generated files
|
||||
repl-temp-*
|
||||
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/LICENSE
vendored
Normal file
29
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/LICENSE
vendored
Normal file
@@ -0,0 +1,29 @@
|
||||
BSD 3-Clause License
|
||||
|
||||
Copyright (c) 2017, Noah
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of the copyright holder nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
1
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/README.md
vendored
Normal file
1
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/README.md
vendored
Normal file
@@ -0,0 +1 @@
|
||||
# elm-shrink
|
||||
18
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/elm-package.json
vendored
Normal file
18
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/elm-package.json
vendored
Normal file
@@ -0,0 +1,18 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "A shrinker for use with tests, written in pure Elm",
|
||||
"repository": "https://github.com/eeue56/elm-shrink.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": ["Shrink"],
|
||||
"dependencies": {
|
||||
|
||||
"eeue56/elm-lazy": "1.0.0 <= v < 2.0.0",
|
||||
"eeue56/elm-lazy-list": "1.0.0 <= v < 2.0.0",
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
467
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/src/Shrink.elm
vendored
Normal file
467
intro-to-elm/part7/tests/elm-stuff/packages/eeue56/elm-shrink/1.0.0/src/Shrink.elm
vendored
Normal file
@@ -0,0 +1,467 @@
|
||||
module Shrink exposing (Shrinker, shrink, noShrink, unit, bool, order, int, atLeastInt, float, atLeastFloat, char, atLeastChar, character, string, maybe, result, list, lazylist, array, tuple, tuple3, tuple4, tuple5, convert, keepIf, dropIf, merge, map, andMap)
|
||||
|
||||
{-| Library containing a collection of basic shrinking strategies and
|
||||
helper functions to help you construct shrinking strategies.
|
||||
|
||||
# Shrinking Basics
|
||||
@docs Shrinker, shrink
|
||||
|
||||
# Shrinkers
|
||||
@docs noShrink, unit, bool, order, int, atLeastInt, float, atLeastFloat, char, atLeastChar, character, string, maybe, result, lazylist, list, array, tuple, tuple3, tuple4, tuple5
|
||||
|
||||
# Functions on Shrinkers
|
||||
@docs convert, keepIf, dropIf, merge, map, andMap
|
||||
|
||||
-}
|
||||
|
||||
import Lazy.List exposing (LazyList, (:::), (+++), empty)
|
||||
import Lazy exposing (Lazy, force, lazy)
|
||||
import List
|
||||
import Array exposing (Array)
|
||||
import Char
|
||||
import String
|
||||
|
||||
|
||||
{-| The shrinker type.
|
||||
A shrinker is a function that takes a value and returns a list of values that
|
||||
are in some sense "smaller" than the given value. If there are no such values
|
||||
conceptually, then the shrinker should just return the empty list.
|
||||
-}
|
||||
type alias Shrinker a =
|
||||
a -> LazyList a
|
||||
|
||||
|
||||
{-| Perform shrinking. Takes a predicate that returns `True` if you want
|
||||
shrinking to continue (e.g. the test failed). Also takes a shrinker and a value
|
||||
to shrink. It returns the shrunken value, or the input value if no shrunken
|
||||
values that satisfy the predicate are found.
|
||||
-}
|
||||
shrink : (a -> Bool) -> Shrinker a -> a -> a
|
||||
shrink keepShrinking shrinker originalVal =
|
||||
let
|
||||
helper lazyList val =
|
||||
case force lazyList of
|
||||
Lazy.List.Nil ->
|
||||
val
|
||||
|
||||
Lazy.List.Cons head tail ->
|
||||
if keepShrinking head then
|
||||
helper (shrinker head) head
|
||||
else
|
||||
helper tail val
|
||||
in
|
||||
helper (shrinker originalVal) originalVal
|
||||
|
||||
|
||||
{-| Perform no shrinking. Equivalent to the empty lazy list.
|
||||
-}
|
||||
noShrink : Shrinker a
|
||||
noShrink _ =
|
||||
empty
|
||||
|
||||
|
||||
{-| Shrink the empty tuple. Equivalent to `noShrink`.
|
||||
-}
|
||||
unit : Shrinker ()
|
||||
unit =
|
||||
noShrink
|
||||
|
||||
|
||||
{-| Shrinker of bools.
|
||||
-}
|
||||
bool : Shrinker Bool
|
||||
bool b =
|
||||
case b of
|
||||
True ->
|
||||
False ::: empty
|
||||
|
||||
False ->
|
||||
empty
|
||||
|
||||
|
||||
{-| Shrinker of `Order` values.
|
||||
-}
|
||||
order : Shrinker Order
|
||||
order o =
|
||||
case o of
|
||||
GT ->
|
||||
EQ ::: LT ::: empty
|
||||
|
||||
LT ->
|
||||
EQ ::: empty
|
||||
|
||||
EQ ->
|
||||
empty
|
||||
|
||||
|
||||
{-| Shrinker of integers.
|
||||
-}
|
||||
int : Shrinker Int
|
||||
int n =
|
||||
if n < 0 then
|
||||
-n ::: Lazy.List.map ((*) -1) (seriesInt 0 -n)
|
||||
else
|
||||
seriesInt 0 n
|
||||
|
||||
|
||||
{-| Construct a shrinker of ints which considers the given int to
|
||||
be most minimal.
|
||||
-}
|
||||
atLeastInt : Int -> Shrinker Int
|
||||
atLeastInt min n =
|
||||
if n < 0 && n >= min then
|
||||
-n ::: Lazy.List.map ((*) -1) (seriesInt 0 -n)
|
||||
else
|
||||
seriesInt (max 0 min) n
|
||||
|
||||
|
||||
{-| Shrinker of floats.
|
||||
-}
|
||||
float : Shrinker Float
|
||||
float n =
|
||||
if n < 0 then
|
||||
-n ::: Lazy.List.map ((*) -1) (seriesFloat 0 -n)
|
||||
else
|
||||
seriesFloat 0 n
|
||||
|
||||
|
||||
{-| Construct a shrinker of floats which considers the given float to
|
||||
be most minimal.
|
||||
-}
|
||||
atLeastFloat : Float -> Shrinker Float
|
||||
atLeastFloat min n =
|
||||
if n < 0 && n >= min then
|
||||
-n ::: Lazy.List.map ((*) -1) (seriesFloat 0 -n)
|
||||
else
|
||||
seriesFloat (max 0 min) n
|
||||
|
||||
|
||||
{-| Shrinker of chars.
|
||||
-}
|
||||
char : Shrinker Char
|
||||
char =
|
||||
convert Char.fromCode Char.toCode int
|
||||
|
||||
|
||||
{-| Construct a shrinker of chars which considers the given char to
|
||||
be most minimal.
|
||||
-}
|
||||
atLeastChar : Char -> Shrinker Char
|
||||
atLeastChar char =
|
||||
convert Char.fromCode Char.toCode (atLeastInt (Char.toCode char))
|
||||
|
||||
|
||||
{-| Shrinker of chars which considers the empty space as the most
|
||||
minimal char and omits the control key codes.
|
||||
|
||||
Equivalent to:
|
||||
|
||||
atLeastChar (Char.fromCode 32)
|
||||
-}
|
||||
character : Shrinker Char
|
||||
character =
|
||||
atLeastChar (Char.fromCode 32)
|
||||
|
||||
|
||||
{-| Shrinker of strings. Considers the empty string to be the most
|
||||
minimal string and the space to be the most minimal char.
|
||||
|
||||
Equivalent to:
|
||||
|
||||
convert String.fromList String.toList (list character)
|
||||
-}
|
||||
string : Shrinker String
|
||||
string =
|
||||
convert String.fromList String.toList (list character)
|
||||
|
||||
|
||||
{-| Maybe shrinker constructor.
|
||||
Takes a shrinker of values and returns a shrinker of Maybes.
|
||||
-}
|
||||
maybe : Shrinker a -> Shrinker (Maybe a)
|
||||
maybe shrink m =
|
||||
case m of
|
||||
Just a ->
|
||||
Nothing ::: Lazy.List.map Just (shrink a)
|
||||
|
||||
Nothing ->
|
||||
empty
|
||||
|
||||
|
||||
{-| Result shrinker constructor. Takes a shrinker of errors and a shrinker of
|
||||
values and returns a shrinker of Results.
|
||||
-}
|
||||
result : Shrinker error -> Shrinker value -> Shrinker (Result error value)
|
||||
result shrinkError shrinkValue r =
|
||||
case r of
|
||||
Ok value ->
|
||||
Lazy.List.map Ok (shrinkValue value)
|
||||
|
||||
Err error ->
|
||||
Lazy.List.map Err (shrinkError error)
|
||||
|
||||
|
||||
{-| Lazy List shrinker constructor. Takes a shrinker of values and returns a
|
||||
shrinker of Lazy Lists. The lazy list being shrunk must be finite. (I mean
|
||||
really, how do you shrink infinity?)
|
||||
-}
|
||||
lazylist : Shrinker a -> Shrinker (LazyList a)
|
||||
lazylist shrink l =
|
||||
lazy <|
|
||||
\() ->
|
||||
let
|
||||
n : Int
|
||||
n =
|
||||
Lazy.List.length l
|
||||
|
||||
shrinkOne : LazyList a -> LazyList (LazyList a)
|
||||
shrinkOne l =
|
||||
lazy <|
|
||||
\() ->
|
||||
case force l of
|
||||
Lazy.List.Nil ->
|
||||
force empty
|
||||
|
||||
Lazy.List.Cons x xs ->
|
||||
force
|
||||
(Lazy.List.map (flip (:::) xs) (shrink x)
|
||||
+++ Lazy.List.map ((:::) x) (shrinkOne xs)
|
||||
)
|
||||
|
||||
removes : Int -> Int -> Shrinker (LazyList a)
|
||||
removes k n l =
|
||||
lazy <|
|
||||
\() ->
|
||||
if k > n then
|
||||
force empty
|
||||
else if Lazy.List.isEmpty l then
|
||||
force (empty ::: empty)
|
||||
else
|
||||
let
|
||||
first =
|
||||
Lazy.List.take k l
|
||||
|
||||
rest =
|
||||
Lazy.List.drop k l
|
||||
in
|
||||
force <|
|
||||
rest
|
||||
::: Lazy.List.map ((+++) first) (removes k (n - k) rest)
|
||||
in
|
||||
force <|
|
||||
Lazy.List.andThen (\k -> removes k n l)
|
||||
(Lazy.List.takeWhile (\x -> x > 0) (Lazy.List.iterate (\n -> n // 2) n))
|
||||
+++ shrinkOne l
|
||||
|
||||
|
||||
{-| List shrinker constructor.
|
||||
Takes a shrinker of values and returns a shrinker of Lists.
|
||||
-}
|
||||
list : Shrinker a -> Shrinker (List a)
|
||||
list shrink =
|
||||
convert Lazy.List.toList Lazy.List.fromList (lazylist shrink)
|
||||
|
||||
|
||||
{-| Array shrinker constructor.
|
||||
Takes a shrinker of values and returns a shrinker of Arrays.
|
||||
-}
|
||||
array : Shrinker a -> Shrinker (Array a)
|
||||
array shrink =
|
||||
convert Lazy.List.toArray Lazy.List.fromArray (lazylist shrink)
|
||||
|
||||
|
||||
{-| 2-Tuple shrinker constructor.
|
||||
Takes a tuple of shrinkers and returns a shrinker of tuples.
|
||||
-}
|
||||
tuple : ( Shrinker a, Shrinker b ) -> Shrinker ( a, b )
|
||||
tuple ( shrinkA, shrinkB ) ( a, b ) =
|
||||
Lazy.List.map ((,) a) (shrinkB b)
|
||||
+++ Lazy.List.map (flip (,) b) (shrinkA a)
|
||||
+++ Lazy.List.map2 (,) (shrinkA a) (shrinkB b)
|
||||
|
||||
|
||||
{-| 3-Tuple shrinker constructor.
|
||||
Takes a tuple of shrinkers and returns a shrinker of tuples.
|
||||
-}
|
||||
tuple3 : ( Shrinker a, Shrinker b, Shrinker c ) -> Shrinker ( a, b, c )
|
||||
tuple3 ( shrinkA, shrinkB, shrinkC ) ( a, b, c ) =
|
||||
Lazy.List.map (\c -> ( a, b, c )) (shrinkC c)
|
||||
+++ Lazy.List.map (\b -> ( a, b, c )) (shrinkB b)
|
||||
+++ Lazy.List.map (\a -> ( a, b, c )) (shrinkA a)
|
||||
+++ Lazy.List.map2 (\b c -> ( a, b, c )) (shrinkB b) (shrinkC c)
|
||||
+++ Lazy.List.map2 (\a c -> ( a, b, c )) (shrinkA a) (shrinkC c)
|
||||
+++ Lazy.List.map2 (\a b -> ( a, b, c )) (shrinkA a) (shrinkB b)
|
||||
+++ Lazy.List.map3 (,,) (shrinkA a) (shrinkB b) (shrinkC c)
|
||||
|
||||
|
||||
{-| 4-Tuple shrinker constructor.
|
||||
Takes a tuple of shrinkers and returns a shrinker of tuples.
|
||||
-}
|
||||
tuple4 : ( Shrinker a, Shrinker b, Shrinker c, Shrinker d ) -> Shrinker ( a, b, c, d )
|
||||
tuple4 ( shrinkA, shrinkB, shrinkC, shrinkD ) ( a, b, c, d ) =
|
||||
Lazy.List.map (\d -> ( a, b, c, d )) (shrinkD d)
|
||||
+++ Lazy.List.map (\c -> ( a, b, c, d )) (shrinkC c)
|
||||
+++ Lazy.List.map (\b -> ( a, b, c, d )) (shrinkB b)
|
||||
+++ Lazy.List.map (\a -> ( a, b, c, d )) (shrinkA a)
|
||||
+++ Lazy.List.map2 (\c d -> ( a, b, c, d )) (shrinkC c) (shrinkD d)
|
||||
+++ Lazy.List.map2 (\b d -> ( a, b, c, d )) (shrinkB b) (shrinkD d)
|
||||
+++ Lazy.List.map2 (\a d -> ( a, b, c, d )) (shrinkA a) (shrinkD d)
|
||||
+++ Lazy.List.map2 (\b c -> ( a, b, c, d )) (shrinkB b) (shrinkC c)
|
||||
+++ Lazy.List.map2 (\a c -> ( a, b, c, d )) (shrinkA a) (shrinkC c)
|
||||
+++ Lazy.List.map2 (\a b -> ( a, b, c, d )) (shrinkA a) (shrinkB b)
|
||||
+++ Lazy.List.map3 (\b c d -> ( a, b, c, d )) (shrinkB b) (shrinkC c) (shrinkD d)
|
||||
+++ Lazy.List.map3 (\a c d -> ( a, b, c, d )) (shrinkA a) (shrinkC c) (shrinkD d)
|
||||
+++ Lazy.List.map3 (\a b d -> ( a, b, c, d )) (shrinkA a) (shrinkB b) (shrinkD d)
|
||||
+++ Lazy.List.map3 (\a b c -> ( a, b, c, d )) (shrinkA a) (shrinkB b) (shrinkC c)
|
||||
+++ Lazy.List.map4 (,,,) (shrinkA a) (shrinkB b) (shrinkC c) (shrinkD d)
|
||||
|
||||
|
||||
{-| 5-Tuple shrinker constructor.
|
||||
Takes a tuple of shrinkers and returns a shrinker of tuples.
|
||||
-}
|
||||
tuple5 : ( Shrinker a, Shrinker b, Shrinker c, Shrinker d, Shrinker e ) -> Shrinker ( a, b, c, d, e )
|
||||
tuple5 ( shrinkA, shrinkB, shrinkC, shrinkD, shrinkE ) ( a, b, c, d, e ) =
|
||||
Lazy.List.map (\e -> ( a, b, c, d, e )) (shrinkE e)
|
||||
+++ Lazy.List.map (\d -> ( a, b, c, d, e )) (shrinkD d)
|
||||
+++ Lazy.List.map (\c -> ( a, b, c, d, e )) (shrinkC c)
|
||||
+++ Lazy.List.map (\b -> ( a, b, c, d, e )) (shrinkB b)
|
||||
+++ Lazy.List.map (\a -> ( a, b, c, d, e )) (shrinkA a)
|
||||
+++ Lazy.List.map2 (\d e -> ( a, b, c, d, e )) (shrinkD d) (shrinkE e)
|
||||
+++ Lazy.List.map2 (\c e -> ( a, b, c, d, e )) (shrinkC c) (shrinkE e)
|
||||
+++ Lazy.List.map2 (\b e -> ( a, b, c, d, e )) (shrinkB b) (shrinkE e)
|
||||
+++ Lazy.List.map2 (\a e -> ( a, b, c, d, e )) (shrinkA a) (shrinkE e)
|
||||
+++ Lazy.List.map2 (\c d -> ( a, b, c, d, e )) (shrinkC c) (shrinkD d)
|
||||
+++ Lazy.List.map2 (\b d -> ( a, b, c, d, e )) (shrinkB b) (shrinkD d)
|
||||
+++ Lazy.List.map2 (\a d -> ( a, b, c, d, e )) (shrinkA a) (shrinkD d)
|
||||
+++ Lazy.List.map2 (\b c -> ( a, b, c, d, e )) (shrinkB b) (shrinkC c)
|
||||
+++ Lazy.List.map2 (\a c -> ( a, b, c, d, e )) (shrinkA a) (shrinkC c)
|
||||
+++ Lazy.List.map2 (\a b -> ( a, b, c, d, e )) (shrinkA a) (shrinkB b)
|
||||
+++ Lazy.List.map3 (\a b c -> ( a, b, c, d, e )) (shrinkA a) (shrinkB b) (shrinkC c)
|
||||
+++ Lazy.List.map3 (\a b d -> ( a, b, c, d, e )) (shrinkA a) (shrinkB b) (shrinkD d)
|
||||
+++ Lazy.List.map3 (\a c d -> ( a, b, c, d, e )) (shrinkA a) (shrinkC c) (shrinkD d)
|
||||
+++ Lazy.List.map3 (\b c d -> ( a, b, c, d, e )) (shrinkB b) (shrinkC c) (shrinkD d)
|
||||
+++ Lazy.List.map3 (\a b e -> ( a, b, c, d, e )) (shrinkA a) (shrinkB b) (shrinkE e)
|
||||
+++ Lazy.List.map3 (\a c e -> ( a, b, c, d, e )) (shrinkA a) (shrinkC c) (shrinkE e)
|
||||
+++ Lazy.List.map3 (\b c e -> ( a, b, c, d, e )) (shrinkB b) (shrinkC c) (shrinkE e)
|
||||
+++ Lazy.List.map3 (\a d e -> ( a, b, c, d, e )) (shrinkA a) (shrinkD d) (shrinkE e)
|
||||
+++ Lazy.List.map3 (\b d e -> ( a, b, c, d, e )) (shrinkB b) (shrinkD d) (shrinkE e)
|
||||
+++ Lazy.List.map3 (\c d e -> ( a, b, c, d, e )) (shrinkC c) (shrinkD d) (shrinkE e)
|
||||
+++ Lazy.List.map4 (\b c d e -> ( a, b, c, d, e )) (shrinkB b) (shrinkC c) (shrinkD d) (shrinkE e)
|
||||
+++ Lazy.List.map4 (\a c d e -> ( a, b, c, d, e )) (shrinkA a) (shrinkC c) (shrinkD d) (shrinkE e)
|
||||
+++ Lazy.List.map4 (\a b d e -> ( a, b, c, d, e )) (shrinkA a) (shrinkB b) (shrinkD d) (shrinkE e)
|
||||
+++ Lazy.List.map4 (\a b c d -> ( a, b, c, d, e )) (shrinkA a) (shrinkB b) (shrinkC c) (shrinkD d)
|
||||
+++ Lazy.List.map5 (,,,,) (shrinkA a) (shrinkB b) (shrinkC c) (shrinkD d) (shrinkE e)
|
||||
|
||||
|
||||
|
||||
----------------------
|
||||
-- HELPER FUNCTIONS --
|
||||
----------------------
|
||||
|
||||
|
||||
{-| Convert a Shrinker of a's into a Shrinker of b's using two inverse functions.
|
||||
|
||||
If you use this function as follows:
|
||||
|
||||
shrinkerB = f g shrinkerA
|
||||
|
||||
Make sure that
|
||||
|
||||
`f(g(x)) == x` for all x
|
||||
|
||||
Or else this process will generate garbage.
|
||||
-}
|
||||
convert : (a -> b) -> (b -> a) -> Shrinker a -> Shrinker b
|
||||
convert f g shrink b =
|
||||
Lazy.List.map f (shrink (g b))
|
||||
|
||||
|
||||
{-| Filter out the results of a shrinker. The resulting shrinker
|
||||
will only produce shrinks which satisfy the given predicate.
|
||||
-}
|
||||
keepIf : (a -> Bool) -> Shrinker a -> Shrinker a
|
||||
keepIf predicate shrink a =
|
||||
Lazy.List.keepIf predicate (shrink a)
|
||||
|
||||
|
||||
{-| Filter out the results of a shrinker. The resulting shrinker
|
||||
will only throw away shrinks which satisfy the given predicate.
|
||||
-}
|
||||
dropIf : (a -> Bool) -> Shrinker a -> Shrinker a
|
||||
dropIf predicate =
|
||||
keepIf (not << predicate)
|
||||
|
||||
|
||||
{-| Merge two shrinkers. Generates all the values in the first
|
||||
shrinker, and then all the non-duplicated values in the second
|
||||
shrinker.
|
||||
-}
|
||||
merge : Shrinker a -> Shrinker a -> Shrinker a
|
||||
merge shrink1 shrink2 a =
|
||||
Lazy.List.unique (shrink1 a +++ shrink2 a)
|
||||
|
||||
|
||||
{-| Re-export of `Lazy.List.map`
|
||||
This is useful in order to compose shrinkers, especially when used in
|
||||
conjunction with `andMap`. For example:
|
||||
|
||||
type alias Vector =
|
||||
{ x : Float
|
||||
, y : Float
|
||||
, z : Float
|
||||
}
|
||||
|
||||
vector : Shrinker Vector
|
||||
vector {x,y,z} =
|
||||
Vector
|
||||
`map` float x
|
||||
`andMap` float y
|
||||
`andMap` float z
|
||||
-}
|
||||
map : (a -> b) -> LazyList a -> LazyList b
|
||||
map =
|
||||
Lazy.List.map
|
||||
|
||||
|
||||
{-| Apply a lazy list of functions on a lazy list of values.
|
||||
|
||||
The argument order is so that it is easy to use in `|>` chains.
|
||||
-}
|
||||
andMap : LazyList a -> LazyList (a -> b) -> LazyList b
|
||||
andMap =
|
||||
Lazy.List.andMap
|
||||
|
||||
|
||||
|
||||
-----------------------
|
||||
-- PRIVATE FUNCTIONS --
|
||||
-----------------------
|
||||
|
||||
|
||||
seriesInt : Int -> Int -> LazyList Int
|
||||
seriesInt low high =
|
||||
if low >= high then
|
||||
empty
|
||||
else if low == high - 1 then
|
||||
low ::: empty
|
||||
else
|
||||
let
|
||||
low_ =
|
||||
low + ((high - low) // 2)
|
||||
in
|
||||
low ::: seriesInt low_ high
|
||||
|
||||
|
||||
seriesFloat : Float -> Float -> LazyList Float
|
||||
seriesFloat low high =
|
||||
if low >= high - 0.0001 then
|
||||
if high /= 0.000001 then
|
||||
Lazy.List.singleton (low + 0.000001)
|
||||
else
|
||||
empty
|
||||
else
|
||||
let
|
||||
low_ =
|
||||
low + ((high - low) / 2)
|
||||
in
|
||||
low ::: seriesFloat low_ high
|
||||
5
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/.gitignore
vendored
Normal file
5
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/.gitignore
vendored
Normal file
@@ -0,0 +1,5 @@
|
||||
*~
|
||||
node_modules/
|
||||
elm-stuff/
|
||||
docs/
|
||||
*.html
|
||||
46
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/.travis.yml
vendored
Normal file
46
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/.travis.yml
vendored
Normal file
@@ -0,0 +1,46 @@
|
||||
sudo: false
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- test/elm-stuff/build-artifacts
|
||||
- sysconfcpus
|
||||
|
||||
os:
|
||||
- osx
|
||||
- linux
|
||||
|
||||
env:
|
||||
matrix:
|
||||
- ELM_VERSION=0.18.0 TARGET_NODE_VERSION=node
|
||||
- ELM_VERSION=0.18.0 TARGET_NODE_VERSION=4.0
|
||||
|
||||
before_install:
|
||||
- if [ ${TRAVIS_OS_NAME} == "osx" ];
|
||||
then brew update; brew install nvm; mkdir ~/.nvm; export NVM_DIR=~/.nvm; source $(brew --prefix nvm)/nvm.sh;
|
||||
fi
|
||||
- echo -e "Host github.com\n\tStrictHostKeyChecking no\n" >> ~/.ssh/config
|
||||
- | # epic build time improvement - see https://github.com/elm-lang/elm-compiler/issues/1473#issuecomment-245704142
|
||||
if [ ! -d sysconfcpus/bin ];
|
||||
then
|
||||
git clone https://github.com/obmarg/libsysconfcpus.git;
|
||||
cd libsysconfcpus;
|
||||
./configure --prefix=$TRAVIS_BUILD_DIR/sysconfcpus;
|
||||
make && make install;
|
||||
cd ..;
|
||||
fi
|
||||
|
||||
install:
|
||||
- nvm install $TARGET_NODE_VERSION
|
||||
- nvm use $TARGET_NODE_VERSION
|
||||
- node --version
|
||||
- npm --version
|
||||
- cd tests
|
||||
- npm install -g elm@$ELM_VERSION elm-test
|
||||
- mv $(npm config get prefix)/bin/elm-make $(npm config get prefix)/bin/elm-make-old
|
||||
- printf '%s\n\n' '#!/bin/bash' 'echo "Running elm-make with sysconfcpus -n 2"' '$TRAVIS_BUILD_DIR/sysconfcpus/bin/sysconfcpus -n 2 elm-make-old "$@"' > $(npm config get prefix)/bin/elm-make
|
||||
- chmod +x $(npm config get prefix)/bin/elm-make
|
||||
- npm install
|
||||
- elm package install --yes
|
||||
|
||||
script:
|
||||
- npm test
|
||||
27
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/LICENSE
vendored
Normal file
27
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/LICENSE
vendored
Normal file
@@ -0,0 +1,27 @@
|
||||
Copyright (c) 2016-2017 the Elm-test contributors
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer.
|
||||
|
||||
* Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
* Neither the name of elm-test nor the names of its
|
||||
contributors may be used to endorse or promote products derived from
|
||||
this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
152
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/README.md
vendored
Normal file
152
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/README.md
vendored
Normal file
@@ -0,0 +1,152 @@
|
||||
# elm-test [](http://travis-ci.org/elm-community/elm-test)
|
||||
|
||||
Write unit and fuzz tests for your Elm code, in Elm.
|
||||
|
||||
## Quick Start
|
||||
|
||||
Here are three example tests:
|
||||
|
||||
```elm
|
||||
suite : Test
|
||||
suite =
|
||||
describe "The String module"
|
||||
[ describe "String.reverse" -- Nest as many descriptions as you like.
|
||||
[ test "has no effect on a palindrome" <|
|
||||
\_ ->
|
||||
let
|
||||
palindrome =
|
||||
"hannah"
|
||||
in
|
||||
Expect.equal palindrome (String.reverse palindrome)
|
||||
|
||||
-- Expect.equal is designed to be used in pipeline style, like this.
|
||||
, test "reverses a known string" <|
|
||||
\_ ->
|
||||
"ABCDEFG"
|
||||
|> String.reverse
|
||||
|> Expect.equal "GFEDCBA"
|
||||
|
||||
-- fuzz runs the test 100 times with randomly-generated inputs!
|
||||
, fuzz string "restores the original string if you run it again" <|
|
||||
\randomlyGeneratedString ->
|
||||
randomlyGeneratedString
|
||||
|> String.reverse
|
||||
|> String.reverse
|
||||
|> Expect.equal randomlyGeneratedString
|
||||
]
|
||||
]
|
||||
```
|
||||
|
||||
This code uses a few common functions:
|
||||
|
||||
* [`describe`](http://package.elm-lang.org/packages/elm-community/elm-test/latest/Test#test) to add a description string to a list of tests
|
||||
* [`test`](http://package.elm-lang.org/packages/elm-community/elm-test/latest/Test#test) to write a unit test
|
||||
* [`Expect`](http://package.elm-lang.org/packages/elm-community/elm-test/latest/Expect) to determine if a test should pass or fail
|
||||
* [`fuzz`](http://package.elm-lang.org/packages/elm-community/elm-test/latest/Test#fuzz) to run a function that produces a test several times with randomly-generated inputs
|
||||
|
||||
Check out [a large real-world test suite](https://github.com/rtfeldman/elm-css/tree/master/tests) for more.
|
||||
|
||||
### Running tests locally
|
||||
|
||||
There are several ways you can run tests locally:
|
||||
|
||||
* [from your terminal](https://github.com/rtfeldman/node-test-runner) via `npm install -g elm-test`
|
||||
* [from your browser](https://github.com/elm-community/html-test-runner)
|
||||
|
||||
Here's how to set up and run your tests using the CLI test runner:
|
||||
|
||||
1. Run `npm install -g elm-test` if you haven't already.
|
||||
2. `cd` into the project's root directory that has your `elm-package.json`.
|
||||
3. Run `elm-test init`. It will create a `tests` directory inside this one,
|
||||
with some files in it.
|
||||
4. Copy all the dependencies from `elm-package.json` into
|
||||
`tests/elm-package.json`. These dependencies need to stay in sync, so make
|
||||
sure whenever you change your dependencies in your current
|
||||
`elm-package.json`, you make the same change to `tests/elm-package.json`.
|
||||
5. Run `elm-test`.
|
||||
6. Edit `tests/Example.elm` to introduce new tests.
|
||||
|
||||
### Running tests on CI
|
||||
|
||||
Here are some examples of running tests on CI servers:
|
||||
|
||||
* [`travis.yml`](https://github.com/rtfeldman/elm-css/blob/master/.travis.yml)
|
||||
* [`appveyor.yml`](https://github.com/rtfeldman/elm-css/blob/master/appveyor.yml)
|
||||
|
||||
### Not running tests
|
||||
|
||||
During development, you'll often want to focus on specific tests, silence failing tests, or jot down many ideas for tests that you can't implement all at once. We've got you covered with `skip`, `only`, and `todo`:
|
||||
|
||||
```elm
|
||||
wipSuite : Test
|
||||
wipSuite =
|
||||
describe "skip, only, and todo"
|
||||
[ only <| describe "Marking this test as `only` means no other tests will be run!"
|
||||
[ test "This test will be run" <|
|
||||
\_ -> 1 + 1 |> Expect.equal 2
|
||||
, skip <| test "This test will be skipped, even though it's in an only!" <|
|
||||
\_ -> 2 + 3 |> Expect.equal 4
|
||||
]
|
||||
, test "This test will be skipped because it has no only" <|
|
||||
\_ -> "left" |> Expect.equal "right"
|
||||
, todo "Make sure all splines are reticulated"
|
||||
]
|
||||
```
|
||||
|
||||
If you run this example, or any suite that uses one of these three functions, it will result in an _incomplete_ test run. No tests failed, but you also didn't run your entire suite, so we can't call it a success either. Incomplete test runs are reported to CI systems as indistinguishable from failed test runs, to safeguard against accidentally committing a gutted test suite!
|
||||
|
||||
## Strategies for effective testing
|
||||
|
||||
1. [Make impossible states unrepresentable](https://www.youtube.com/watch?v=IcgmSRJHu_8) so that you don't have to test that they can't occur.
|
||||
1. When doing TDD, treat compiler errors as a red test. So feel free to write the test you wish you had even if it means calling functions that don't exist yet!
|
||||
1. If your API is difficult for you to test, it will be difficult for someone else to use. You are your API's first client.
|
||||
1. Prefer fuzz tests to unit tests, where possible. If you have a union type with a small number of values, list them all and map over the list with a unit test for each. Unit tests are also great for when you know the edge cases, and for regression tests.
|
||||
1. If you're writing a library that wraps an existing standard or protocol, use examples from the specification or docs as unit tests.
|
||||
1. For simple functions, it's okay to copy the implementation to the test; this is a useful regression check. But if the implementation isn't obviously right, try to write tests that don't duplicate the suspect logic. The great thing about fuzz tests is that you don't have to arrive at the exact same value as the code under test, just state something that will be true of that value.
|
||||
1. Tests should be small and focused: call the code under test and set an expectation about the result. Setup code should be moved into reusable functions, or custom fuzzers. For example, a test to remove an element from a data structure should be given a nonempty data structure; it should not have to create one itself.
|
||||
1. If you find yourself inspecting the fuzzed input and making different expectations based on it, split each code path into its own test with a fuzzer that makes only the right kind of values.
|
||||
1. Consider using [elm-verify-examples](https://github.com/stoeffel/elm-verify-examples) to extract examples in your docs into unit tests.
|
||||
1. Not even your test modules can import unexposed functions, so test them only as the exposed interface uses them. Don't expose a function just to test it. Every exposed function should have tests. (If you practice TDD, this happens automatically!)
|
||||
1. How do you know when to stop testing? This is an engineering tradeoff without a perfect answer. If you don't feel confident in the correctness of your code, write more tests. If you feel you are wasting time testing better spent writing your application, stop writing tests for now.
|
||||
|
||||
### Application-specific techniques
|
||||
There are a few extra ideas that apply to testing webapps and reusable view packages:
|
||||
|
||||
1. Avoid importing your `Main` module. Most of your code belongs in other modules, so import those instead.
|
||||
1. Test your views using [elm-html-test](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest).
|
||||
1. To test effects, consider using [elm-testable](http://package.elm-lang.org/packages/rogeriochaves/elm-testable/latest).
|
||||
1. There is currently no Elm solution for integration or end-to-end testing. Use your favorite PhantomJS or Selenium webdriver, such as Capybara.
|
||||
|
||||
## Upgrading
|
||||
### From 3.1.0
|
||||
Make sure you grab the latest versions of the test runner that you are using:
|
||||
* `npm update -g elm-test`
|
||||
* `elm package install rtfeldman/html-test-runner`
|
||||
|
||||
`Fuzz.frequency` now fails the test if the frequency is invalid, rather than return a `Result`. If you are using this function, you can remove your `Err` handling code. More likely you are using `Fuzz.frequencyOrCrash`, which you can replace with `Fuzz.frequency`.
|
||||
|
||||
Instead of using `Test.filter` to avoid running tests, use `skip` and `only` (see above for documentation).
|
||||
|
||||
We now forbid tests and suites to have descriptions that are blank, or that are identical across siblings or parents and children. If you get failures from this, rename your tests to be clearer about what they're testing.
|
||||
|
||||
### From 0.17
|
||||
You will need to delete `elm-stuff` and `tests/elm-stuff`.
|
||||
|
||||
If you are using the Node runner, you will need to install the latest version (`npm update -g elm-test`) and pull down the new `Main.elm`: `curl -o tests/Main.elm https://raw.githubusercontent.com/rtfeldman/node-test-runner/3.0.1/templates/Main.elm`
|
||||
|
||||
### From 1.x and elm-check
|
||||
[`legacy-elm-test`](http://package.elm-lang.org/packages/rtfeldman/legacy-elm-test/latest) provides a
|
||||
drop-in replacement for the `ElmTest 1.0` API, except implemented in terms of
|
||||
the current `elm-test`. It also includes support for `elm-check` tests.
|
||||
|
||||
This lets you use the latest test runners right now, and upgrade incrementally.
|
||||
|
||||
## Releases
|
||||
| Version | Notes |
|
||||
| ------- | ----- |
|
||||
| [**4.0.0**](https://github.com/elm-community/elm-test/tree/4.0.0) | Add `only`, `skip`, `todo`; change `Fuzz.frequency` to fail rather than crash on bad input, disallow tests with blank or duplicate descriptions.
|
||||
| [**3.1.0**](https://github.com/elm-community/elm-test/tree/3.1.0) | Add `Expect.all`
|
||||
| [**3.0.0**](https://github.com/elm-community/elm-test/tree/3.0.0) | Update for Elm 0.18; switch the argument order of `Fuzz.andMap`.
|
||||
| [**2.1.0**](https://github.com/elm-community/elm-test/tree/2.1.0) | Switch to rose trees for `Fuzz.andThen`, other API additions.
|
||||
| [**2.0.0**](https://github.com/elm-community/elm-test/tree/2.0.0) | Scratch-rewrite to project-fuzzball
|
||||
| [**1.0.0**](https://github.com/elm-community/elm-test/tree/1.0.0) | ElmTest initial release
|
||||
88
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/benchmarks/Main.elm
vendored
Normal file
88
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/benchmarks/Main.elm
vendored
Normal file
@@ -0,0 +1,88 @@
|
||||
module Main exposing (..)
|
||||
|
||||
import Benchmark exposing (..)
|
||||
import Benchmark.Runner as Runner
|
||||
import Expect exposing (Expectation)
|
||||
import Random.Pcg
|
||||
import Snippets
|
||||
import Test.Internal exposing (Test(Labeled, Test))
|
||||
|
||||
|
||||
main : Runner.BenchmarkProgram
|
||||
main =
|
||||
Runner.program suite
|
||||
|
||||
|
||||
suite : Benchmark
|
||||
suite =
|
||||
describe "Fuzz"
|
||||
[ describe "int"
|
||||
[ benchmark "generating" (benchTest Snippets.intPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.intFail)
|
||||
]
|
||||
, describe "intRange"
|
||||
[ benchmark "generating" (benchTest Snippets.intRangePass)
|
||||
, benchmark "shrinking" (benchTest Snippets.intRangeFail)
|
||||
]
|
||||
, describe "string"
|
||||
[ benchmark "generating" (benchTest Snippets.stringPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.stringFail)
|
||||
]
|
||||
, describe "float"
|
||||
[ benchmark "generating" (benchTest Snippets.floatPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.floatFail)
|
||||
]
|
||||
, describe "bool"
|
||||
[ benchmark "generating" (benchTest Snippets.boolPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.boolFail)
|
||||
]
|
||||
, describe "char"
|
||||
[ benchmark "generating" (benchTest Snippets.charPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.charFail)
|
||||
]
|
||||
, describe "list of int"
|
||||
[ benchmark "generating" (benchTest Snippets.listIntPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.listIntFail)
|
||||
]
|
||||
, describe "maybe of int"
|
||||
[ benchmark "generating" (benchTest Snippets.maybeIntPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.maybeIntFail)
|
||||
]
|
||||
, describe "result of string and int"
|
||||
[ benchmark "generating" (benchTest Snippets.resultPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.resultFail)
|
||||
]
|
||||
, describe "map"
|
||||
[ benchmark "generating" (benchTest Snippets.mapPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.mapFail)
|
||||
]
|
||||
, describe "andMap"
|
||||
[ benchmark "generating" (benchTest Snippets.andMapPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.andMapFail)
|
||||
]
|
||||
, describe "map5"
|
||||
[ benchmark "generating" (benchTest Snippets.map5Pass)
|
||||
, benchmark "shrinking" (benchTest Snippets.map5Fail)
|
||||
]
|
||||
, describe "andThen"
|
||||
[ benchmark "generating" (benchTest Snippets.andThenPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.andThenFail)
|
||||
]
|
||||
, describe "conditional"
|
||||
[ benchmark "generating" (benchTest Snippets.conditionalPass)
|
||||
, benchmark "shrinking" (benchTest Snippets.conditionalFail)
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
benchTest : Test -> (() -> List Expectation)
|
||||
benchTest test =
|
||||
case test of
|
||||
Test fn ->
|
||||
\_ -> fn (Random.Pcg.initialSeed 0) 10
|
||||
|
||||
Labeled _ test ->
|
||||
benchTest test
|
||||
|
||||
test ->
|
||||
Debug.crash <| "No support for benchmarking this type of test: " ++ toString test
|
||||
34
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/benchmarks/README.md
vendored
Normal file
34
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/benchmarks/README.md
vendored
Normal file
@@ -0,0 +1,34 @@
|
||||
# Benchmarks for elm-test
|
||||
|
||||
These are some benchmarks of the elm-test library built using the excellent [elm-benchmark](https://github.com/BrianHicks/elm-benchmark).
|
||||
|
||||
## How to run
|
||||
|
||||
```sh
|
||||
cd ./benchmarks
|
||||
elm-make Main.elm
|
||||
open index.html
|
||||
```
|
||||
|
||||
## How to use
|
||||
These benchmarks can help get an idea of the performance impact of a change in the elm-test code.
|
||||
Beware however that a fifty percent performance increase in these benchmarks will most likely not translate to a fifty percent faster tests for users.
|
||||
In real word scenario's the execution of the test body will have a significant impact on the running time of the test suite, an aspect we're not testing here because it's different for every test suite.
|
||||
To get a feeling for the impact your change has on actual test run times try running some real test suites with and without your changes.
|
||||
|
||||
## Benchmarking complete test suites
|
||||
These are some examples of test suites that contain a lot of fuzzer tests:
|
||||
- [elm-benchmark](https://github.com/BrianHicks/elm-benchmark)
|
||||
- [elm-nonempty-list](https://github.com/mgold/elm-nonempty-list)
|
||||
- [json-elm-schema](https://github.com/NoRedInk/json-elm-schema)
|
||||
|
||||
A tool you can use for benchmarking the suite is [bench](https://github.com/Gabriel439/bench).
|
||||
|
||||
To run the tests using your modified code (this only works if your modified version is backwards compatible with the version of elm-test currenlty in use by the test suite):
|
||||
- In your test suite directories `elm-package.json`:
|
||||
- Remove the dependency on `elm-test`.
|
||||
- Add dependecies of `elm-test` as dependencies of the test suite itself.
|
||||
- Add the path to your changed elm-test src directory to your `source-directories`.
|
||||
It will be something like `/<projects-dir>/elm-test/src`.
|
||||
- Run `elm-test` once to trigger compilation.
|
||||
- Now run `elm-test` with your benchmarking tool.
|
||||
250
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/benchmarks/Snippets.elm
vendored
Normal file
250
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/benchmarks/Snippets.elm
vendored
Normal file
@@ -0,0 +1,250 @@
|
||||
module Snippets exposing (..)
|
||||
|
||||
import Expect exposing (Expectation)
|
||||
import Fuzz exposing (Fuzzer)
|
||||
import Test exposing (Test, fuzz)
|
||||
|
||||
|
||||
intPass : Test
|
||||
intPass =
|
||||
fuzz Fuzz.int "(passes) int" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
intFail : Test
|
||||
intFail =
|
||||
fuzz Fuzz.int "(fails) int" <|
|
||||
\numbers ->
|
||||
Expect.fail "Failed"
|
||||
|
||||
|
||||
intRangePass : Test
|
||||
intRangePass =
|
||||
fuzz (Fuzz.intRange 10 100) "(passes) intRange" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
intRangeFail : Test
|
||||
intRangeFail =
|
||||
fuzz (Fuzz.intRange 10 100) "(fails) intRange" <|
|
||||
\numbers ->
|
||||
Expect.fail "Failed"
|
||||
|
||||
|
||||
stringPass : Test
|
||||
stringPass =
|
||||
fuzz Fuzz.string "(passes) string" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
stringFail : Test
|
||||
stringFail =
|
||||
fuzz Fuzz.string "(fails) string" <|
|
||||
\numbers ->
|
||||
Expect.fail "Failed"
|
||||
|
||||
|
||||
floatPass : Test
|
||||
floatPass =
|
||||
fuzz Fuzz.float "(passes) float" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
floatFail : Test
|
||||
floatFail =
|
||||
fuzz Fuzz.float "(fails) float" <|
|
||||
\numbers ->
|
||||
Expect.fail "Failed"
|
||||
|
||||
|
||||
boolPass : Test
|
||||
boolPass =
|
||||
fuzz Fuzz.bool "(passes) bool" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
boolFail : Test
|
||||
boolFail =
|
||||
fuzz Fuzz.bool "(fails) bool" <|
|
||||
\numbers ->
|
||||
Expect.fail "Failed"
|
||||
|
||||
|
||||
charPass : Test
|
||||
charPass =
|
||||
fuzz Fuzz.char "(passes) char" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
charFail : Test
|
||||
charFail =
|
||||
fuzz Fuzz.char "(fails) char" <|
|
||||
\numbers ->
|
||||
Expect.fail "Failed"
|
||||
|
||||
|
||||
listIntPass : Test
|
||||
listIntPass =
|
||||
fuzz (Fuzz.list Fuzz.int) "(passes) list of int" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
listIntFail : Test
|
||||
listIntFail =
|
||||
fuzz (Fuzz.list Fuzz.int) "(fails) list of int" <|
|
||||
{- The empty list is the first value the list shrinker will try.
|
||||
If we immediately fail on that example than we're not doing a lot of shrinking.
|
||||
-}
|
||||
Expect.notEqual []
|
||||
|
||||
|
||||
maybeIntPass : Test
|
||||
maybeIntPass =
|
||||
fuzz (Fuzz.maybe Fuzz.int) "(passes) maybe of int" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
maybeIntFail : Test
|
||||
maybeIntFail =
|
||||
fuzz (Fuzz.maybe Fuzz.int) "(fails) maybe of int" <|
|
||||
\numbers ->
|
||||
Expect.fail "Failed"
|
||||
|
||||
|
||||
resultPass : Test
|
||||
resultPass =
|
||||
fuzz (Fuzz.result Fuzz.string Fuzz.int) "(passes) result of string and int" <|
|
||||
\_ ->
|
||||
Expect.pass
|
||||
|
||||
|
||||
resultFail : Test
|
||||
resultFail =
|
||||
fuzz (Fuzz.result Fuzz.string Fuzz.int) "(fails) result of string and int" <|
|
||||
\numbers ->
|
||||
Expect.fail "Failed"
|
||||
|
||||
|
||||
mapPass : Test
|
||||
mapPass =
|
||||
fuzz even "(passes) map" <|
|
||||
\_ -> Expect.pass
|
||||
|
||||
|
||||
mapFail : Test
|
||||
mapFail =
|
||||
fuzz even "(fails) map" <|
|
||||
\_ -> Expect.fail "Failed"
|
||||
|
||||
|
||||
andMapPass : Test
|
||||
andMapPass =
|
||||
fuzz person "(passes) andMap" <|
|
||||
\_ -> Expect.pass
|
||||
|
||||
|
||||
andMapFail : Test
|
||||
andMapFail =
|
||||
fuzz person "(fails) andMap" <|
|
||||
\_ -> Expect.fail "Failed"
|
||||
|
||||
|
||||
map5Pass : Test
|
||||
map5Pass =
|
||||
fuzz person2 "(passes) map5" <|
|
||||
\_ -> Expect.pass
|
||||
|
||||
|
||||
map5Fail : Test
|
||||
map5Fail =
|
||||
fuzz person2 "(fails) map5" <|
|
||||
\_ -> Expect.fail "Failed"
|
||||
|
||||
|
||||
andThenPass : Test
|
||||
andThenPass =
|
||||
fuzz (variableList 2 5 Fuzz.int) "(passes) andThen" <|
|
||||
\_ -> Expect.pass
|
||||
|
||||
|
||||
andThenFail : Test
|
||||
andThenFail =
|
||||
fuzz (variableList 2 5 Fuzz.int) "(fails) andThen" <|
|
||||
\_ -> Expect.fail "Failed"
|
||||
|
||||
|
||||
conditionalPass : Test
|
||||
conditionalPass =
|
||||
fuzz evenWithConditional "(passes) conditional" <|
|
||||
\_ -> Expect.pass
|
||||
|
||||
|
||||
conditionalFail : Test
|
||||
conditionalFail =
|
||||
fuzz evenWithConditional "(fails) conditional" <|
|
||||
\_ -> Expect.fail "Failed"
|
||||
|
||||
|
||||
type alias Person =
|
||||
{ firstName : String
|
||||
, lastName : String
|
||||
, age : Int
|
||||
, nationality : String
|
||||
, height : Float
|
||||
}
|
||||
|
||||
|
||||
person : Fuzzer Person
|
||||
person =
|
||||
Fuzz.map Person Fuzz.string
|
||||
|> Fuzz.andMap Fuzz.string
|
||||
|> Fuzz.andMap Fuzz.int
|
||||
|> Fuzz.andMap Fuzz.string
|
||||
|> Fuzz.andMap Fuzz.float
|
||||
|
||||
|
||||
person2 : Fuzzer Person
|
||||
person2 =
|
||||
Fuzz.map5 Person
|
||||
Fuzz.string
|
||||
Fuzz.string
|
||||
Fuzz.int
|
||||
Fuzz.string
|
||||
Fuzz.float
|
||||
|
||||
|
||||
even : Fuzzer Int
|
||||
even =
|
||||
Fuzz.map ((*) 2) Fuzz.int
|
||||
|
||||
|
||||
variableList : Int -> Int -> Fuzzer a -> Fuzzer (List a)
|
||||
variableList min max item =
|
||||
Fuzz.intRange min max
|
||||
|> Fuzz.andThen (\length -> List.repeat length item |> sequence)
|
||||
|
||||
|
||||
sequence : List (Fuzzer a) -> Fuzzer (List a)
|
||||
sequence fuzzers =
|
||||
List.foldl
|
||||
(Fuzz.map2 (::))
|
||||
(Fuzz.constant [])
|
||||
fuzzers
|
||||
|
||||
|
||||
evenWithConditional : Fuzzer Int
|
||||
evenWithConditional =
|
||||
Fuzz.intRange 1 6
|
||||
|> Fuzz.conditional
|
||||
{ retries = 3
|
||||
, fallback = (+) 1
|
||||
, condition = \n -> (n % 2) == 0
|
||||
}
|
||||
@@ -0,0 +1,21 @@
|
||||
{
|
||||
"version": "1.0.0",
|
||||
"summary": "helpful summary of your project, less than 80 characters",
|
||||
"repository": "https://github.com/user/project.git",
|
||||
"license": "BSD3",
|
||||
"source-directories": [
|
||||
".",
|
||||
"../src"
|
||||
],
|
||||
"exposed-modules": [],
|
||||
"dependencies": {
|
||||
"BrianHicks/elm-benchmark": "1.0.2 <= v < 2.0.0",
|
||||
"eeue56/elm-lazy-list": "1.0.0 <= v < 2.0.0",
|
||||
"eeue56/elm-shrink": "1.0.0 <= v < 2.0.0",
|
||||
"elm-lang/core": "5.1.1 <= v < 6.0.0",
|
||||
"elm-lang/html": "2.0.0 <= v < 3.0.0",
|
||||
"eeue56/elm-lazy": "1.0.0 <= v < 2.0.0",
|
||||
"mgold/elm-random-pcg": "5.0.0 <= v < 6.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
24
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/elm-package.json
vendored
Normal file
24
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/elm-package.json
vendored
Normal file
@@ -0,0 +1,24 @@
|
||||
{
|
||||
"version": "4.1.1",
|
||||
"summary": "Unit and Fuzz testing support with Console/Html/String outputs.",
|
||||
"repository": "https://github.com/elm-community/elm-test.git",
|
||||
"license": "BSD-3-Clause",
|
||||
"source-directories": [
|
||||
"src"
|
||||
],
|
||||
"exposed-modules": [
|
||||
"Test",
|
||||
"Test.Runner",
|
||||
"Test.Runner.Failure",
|
||||
"Expect",
|
||||
"Fuzz"
|
||||
],
|
||||
"dependencies": {
|
||||
"eeue56/elm-lazy-list": "1.0.0 <= v < 2.0.0",
|
||||
"eeue56/elm-shrink": "1.0.0 <= v < 2.0.0",
|
||||
"elm-lang/core": "5.0.0 <= v < 6.0.0",
|
||||
"eeue56/elm-lazy": "1.0.0 <= v < 2.0.0",
|
||||
"mgold/elm-random-pcg": "4.0.2 <= v < 6.0.0"
|
||||
},
|
||||
"elm-version": "0.18.0 <= v < 0.19.0"
|
||||
}
|
||||
819
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Expect.elm
vendored
Normal file
819
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Expect.elm
vendored
Normal file
@@ -0,0 +1,819 @@
|
||||
module Expect
|
||||
exposing
|
||||
( Expectation
|
||||
, FloatingPointTolerance(Absolute, AbsoluteOrRelative, Relative)
|
||||
, all
|
||||
, atLeast
|
||||
, atMost
|
||||
, equal
|
||||
, equalDicts
|
||||
, equalLists
|
||||
, equalSets
|
||||
, err
|
||||
, fail
|
||||
, false
|
||||
, greaterThan
|
||||
, lessThan
|
||||
, notEqual
|
||||
, notWithin
|
||||
, onFail
|
||||
, pass
|
||||
, true
|
||||
, within
|
||||
)
|
||||
|
||||
{-| A library to create `Expectation`s, which describe a claim to be tested.
|
||||
|
||||
|
||||
## Quick Reference
|
||||
|
||||
- [`equal`](#equal) `(arg2 == arg1)`
|
||||
- [`notEqual`](#notEqual) `(arg2 /= arg1)`
|
||||
- [`lessThan`](#lessThan) `(arg2 < arg1)`
|
||||
- [`atMost`](#atMost) `(arg2 <= arg1)`
|
||||
- [`greaterThan`](#greaterThan) `(arg2 > arg1)`
|
||||
- [`atLeast`](#atLeast) `(arg2 >= arg1)`
|
||||
- [`true`](#true) `(arg == True)`
|
||||
- [`false`](#false) `(arg == False)`
|
||||
- [Floating Point Comparisons](#floating-point-comparisons)
|
||||
|
||||
|
||||
## Basic Expectations
|
||||
|
||||
@docs Expectation, equal, notEqual, all
|
||||
|
||||
|
||||
## Numeric Comparisons
|
||||
|
||||
@docs lessThan, atMost, greaterThan, atLeast
|
||||
|
||||
|
||||
## Floating Point Comparisons
|
||||
|
||||
These functions allow you to compare `Float` values up to a specified rounding error, which may be relative, absolute,
|
||||
or both. For an in-depth look, see our [Guide to Floating Point Comparison](#guide-to-floating-point-comparison).
|
||||
|
||||
@docs FloatingPointTolerance, within, notWithin
|
||||
|
||||
|
||||
## Booleans
|
||||
|
||||
@docs true, false
|
||||
|
||||
|
||||
## Collections
|
||||
|
||||
@docs err, equalLists, equalDicts, equalSets
|
||||
|
||||
|
||||
## Customizing
|
||||
|
||||
These functions will let you build your own expectations.
|
||||
|
||||
@docs pass, fail, onFail
|
||||
|
||||
|
||||
## Guide to Floating Point Comparison
|
||||
|
||||
In general, if you are multiplying, you want relative tolerance, and if you're adding,
|
||||
you want absolute tolerance. If you are doing both, you want both kinds of tolerance,
|
||||
or to split the calculation into smaller parts for testing.
|
||||
|
||||
|
||||
### Absolute Tolerance
|
||||
|
||||
Let's say we want to figure out if our estimation of pi is precise enough.
|
||||
|
||||
Is `3.14` within `0.01` of `pi`? Yes, because `3.13 < pi < 3.15`.
|
||||
|
||||
test "3.14 approximates pi with absolute precision" <| \_ ->
|
||||
3.14 |> Expect.within (Absolute 0.01) pi
|
||||
|
||||
|
||||
### Relative Tolerance
|
||||
|
||||
What if we also want to know if our circle circumference estimation is close enough?
|
||||
|
||||
Let's say our circle has a radius of `r` meters. The formula for circle circumference is `C=2*r*pi`.
|
||||
To make the calculations a bit easier ([ahem](https://tauday.com/tau-manifesto)), we'll look at half the circumference; `C/2=r*pi`.
|
||||
Is `r * 3.14` within `0.01` of `r * pi`?
|
||||
That depends, what does `r` equal? If `r` is `0.01`mm, or `0.00001` meters, we're comparing
|
||||
`0.00001 * 3.14 - 0.01 < r * pi < 0.00001 * 3.14 + 0.01` or `-0.0099686 < 0.0000314159 < 0.0100314`.
|
||||
That's a huge tolerance! A circumference that is _a thousand times longer_ than we expected would pass that test!
|
||||
|
||||
On the other hand, if `r` is very large, we're going to need many more digits of pi.
|
||||
For an absolute tolerance of `0.01` and a pi estimation of `3.14`, this expectation only passes if `r < 2*pi`.
|
||||
|
||||
If we use a relative tolerance of `0.01` instead, the circle area comparison becomes much better. Is `r * 3.14` within
|
||||
`1%` of `r * pi`? Yes! In fact, three digits of pi approximation is always good enough for a 0.1% relative tolerance,
|
||||
as long as `r` isn't [too close to zero](https://en.wikipedia.org/wiki/Denormal_number).
|
||||
|
||||
fuzz
|
||||
(floatRange 0.000001 100000)
|
||||
"Circle half-circumference with relative tolerance"
|
||||
(\r -> r * 3.14 |> Expect.within (Relative 0.001) (r * pi))
|
||||
|
||||
|
||||
### Trouble with Numbers Near Zero
|
||||
|
||||
If you are adding things near zero, you probably want absolute tolerance. If you're comparing values between `-1` and `1`, you should consider using absolute tolerance.
|
||||
|
||||
For example: Is `1 + 2 - 3` within `1%` of `0`? Well, if `1`, `2` and `3` have any amount of rounding error, you might not get exactly zero. What is `1%` above and below `0`? Zero. We just lost all tolerance. Even if we hard-code the numbers, we might not get exactly zero; `0.1 + 0.2` rounds to a value just above `0.3`, since computers, counting in binary, cannot write down any of those three numbers using a finite number of digits, just like we cannot write `0.333...` exactly in base 10.
|
||||
|
||||
Another example is comparing values that are on either side of zero. `0.0001` is more than `100%` away from `-0.0001`. In fact, `infinity` is closer to `0.0001` than `0.0001` is to `-0.0001`, if you are using a relative tolerance. Twice as close, actually. So even though both `0.0001` and `-0.0001` could be considered very close to zero, they are very far apart relative to each other. The same argument applies for any number of zeroes.
|
||||
|
||||
-}
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import Set exposing (Set)
|
||||
import Test.Expectation
|
||||
import Test.Runner.Failure exposing (InvalidReason(..), Reason(..))
|
||||
|
||||
|
||||
{-| The result of a single test run: either a [`pass`](#pass) or a
|
||||
[`fail`](#fail).
|
||||
-}
|
||||
type alias Expectation =
|
||||
Test.Expectation.Expectation
|
||||
|
||||
|
||||
{-| Passes if the arguments are equal.
|
||||
|
||||
Expect.equal 0 (List.length [])
|
||||
|
||||
-- Passes because (0 == 0) is True
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because the expected value didn't split the space in "Betty Botter"
|
||||
String.split " " "Betty Botter bought some butter"
|
||||
|> Expect.equal [ "Betty Botter", "bought", "some", "butter" ]
|
||||
|
||||
{-
|
||||
|
||||
[ "Betty", "Botter", "bought", "some", "butter" ]
|
||||
╷
|
||||
│ Expect.equal
|
||||
╵
|
||||
[ "Betty Botter", "bought", "some", "butter" ]
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
equal : a -> a -> Expectation
|
||||
equal =
|
||||
equateWith "Expect.equal" (==)
|
||||
|
||||
|
||||
{-| Passes if the arguments are not equal.
|
||||
|
||||
-- Passes because (11 /= 100) is True
|
||||
90 + 10
|
||||
|> Expect.notEqual 11
|
||||
|
||||
|
||||
-- Fails because (100 /= 100) is False
|
||||
90 + 10
|
||||
|> Expect.notEqual 100
|
||||
|
||||
{-
|
||||
|
||||
100
|
||||
╷
|
||||
│ Expect.notEqual
|
||||
╵
|
||||
100
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
notEqual : a -> a -> Expectation
|
||||
notEqual =
|
||||
equateWith "Expect.notEqual" (/=)
|
||||
|
||||
|
||||
{-| Passes if the second argument is less than the first.
|
||||
|
||||
Expect.lessThan 1 (List.length [])
|
||||
|
||||
-- Passes because (0 < 1) is True
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because (0 < -1) is False
|
||||
List.length []
|
||||
|> Expect.lessThan -1
|
||||
|
||||
|
||||
{-
|
||||
|
||||
0
|
||||
╷
|
||||
│ Expect.lessThan
|
||||
╵
|
||||
-1
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
lessThan : comparable -> comparable -> Expectation
|
||||
lessThan =
|
||||
compareWith "Expect.lessThan" (<)
|
||||
|
||||
|
||||
{-| Passes if the second argument is less than or equal to the first.
|
||||
|
||||
Expect.atMost 1 (List.length [])
|
||||
|
||||
-- Passes because (0 <= 1) is True
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because (0 <= -3) is False
|
||||
List.length []
|
||||
|> Expect.atMost -3
|
||||
|
||||
{-
|
||||
|
||||
0
|
||||
╷
|
||||
│ Expect.atMost
|
||||
╵
|
||||
-3
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
atMost : comparable -> comparable -> Expectation
|
||||
atMost =
|
||||
compareWith "Expect.atMost" (<=)
|
||||
|
||||
|
||||
{-| Passes if the second argument is greater than the first.
|
||||
|
||||
Expect.greaterThan -2 List.length []
|
||||
|
||||
-- Passes because (0 > -2) is True
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because (0 > 1) is False
|
||||
List.length []
|
||||
|> Expect.greaterThan 1
|
||||
|
||||
{-
|
||||
|
||||
0
|
||||
╷
|
||||
│ Expect.greaterThan
|
||||
╵
|
||||
1
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
greaterThan : comparable -> comparable -> Expectation
|
||||
greaterThan =
|
||||
compareWith "Expect.greaterThan" (>)
|
||||
|
||||
|
||||
{-| Passes if the second argument is greater than or equal to the first.
|
||||
|
||||
Expect.atLeast -2 (List.length [])
|
||||
|
||||
-- Passes because (0 >= -2) is True
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because (0 >= 3) is False
|
||||
List.length []
|
||||
|> Expect.atLeast 3
|
||||
|
||||
{-
|
||||
|
||||
0
|
||||
╷
|
||||
│ Expect.atLeast
|
||||
╵
|
||||
3
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
atLeast : comparable -> comparable -> Expectation
|
||||
atLeast =
|
||||
compareWith "Expect.atLeast" (>=)
|
||||
|
||||
|
||||
{-| A type to describe how close a floating point number must be to the expected value for the test to pass. This may be
|
||||
specified as absolute or relative.
|
||||
|
||||
`AbsoluteOrRelative` tolerance uses a logical OR between the absolute (specified first) and relative tolerance. If you
|
||||
want a logical AND, use [`Expect.all`](#all).
|
||||
|
||||
-}
|
||||
type FloatingPointTolerance
|
||||
= Absolute Float
|
||||
| Relative Float
|
||||
| AbsoluteOrRelative Float Float
|
||||
|
||||
|
||||
{-| Passes if the second and third arguments are equal within a tolerance
|
||||
specified by the first argument. This is intended to avoid failing because of
|
||||
minor inaccuracies introduced by floating point arithmetic.
|
||||
|
||||
-- Fails because 0.1 + 0.2 == 0.30000000000000004 (0.1 is non-terminating in base 2)
|
||||
0.1 + 0.2 |> Expect.equal 0.3
|
||||
|
||||
-- So instead write this test, which passes
|
||||
0.1 + 0.2 |> Expect.within (Absolute 0.000000001) 0.3
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because 3.14 is not close enough to pi
|
||||
3.14 |> Expect.within (Absolute 0.0001) pi
|
||||
|
||||
{-
|
||||
|
||||
3.14
|
||||
╷
|
||||
│ Expect.within Absolute 0.0001
|
||||
╵
|
||||
3.141592653589793
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
within : FloatingPointTolerance -> Float -> Float -> Expectation
|
||||
within tolerance a b =
|
||||
nonNegativeToleranceError tolerance "within" <|
|
||||
compareWith ("Expect.within " ++ toString tolerance)
|
||||
(withinCompare tolerance)
|
||||
a
|
||||
b
|
||||
|
||||
|
||||
{-| Passes if (and only if) a call to `within` with the same arguments would have failed.
|
||||
-}
|
||||
notWithin : FloatingPointTolerance -> Float -> Float -> Expectation
|
||||
notWithin tolerance a b =
|
||||
nonNegativeToleranceError tolerance "notWithin" <|
|
||||
compareWith ("Expect.notWithin " ++ toString tolerance)
|
||||
(\a b -> not <| withinCompare tolerance a b)
|
||||
a
|
||||
b
|
||||
|
||||
|
||||
{-| Passes if the argument is 'True', and otherwise fails with the given message.
|
||||
|
||||
Expect.true "Expected the list to be empty." (List.isEmpty [])
|
||||
|
||||
-- Passes because (List.isEmpty []) is True
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because List.isEmpty returns False, but we expect True.
|
||||
List.isEmpty [ 42 ]
|
||||
|> Expect.true "Expected the list to be empty."
|
||||
|
||||
{-
|
||||
|
||||
Expected the list to be empty.
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
true : String -> Bool -> Expectation
|
||||
true message bool =
|
||||
if bool then
|
||||
pass
|
||||
else
|
||||
fail message
|
||||
|
||||
|
||||
{-| Passes if the argument is 'False', and otherwise fails with the given message.
|
||||
|
||||
Expect.false "Expected the list not to be empty." (List.isEmpty [ 42 ])
|
||||
|
||||
-- Passes because (List.isEmpty [ 42 ]) is False
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because (List.isEmpty []) is True
|
||||
List.isEmpty []
|
||||
|> Expect.false "Expected the list not to be empty."
|
||||
|
||||
{-
|
||||
|
||||
Expected the list not to be empty.
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
false : String -> Bool -> Expectation
|
||||
false message bool =
|
||||
if bool then
|
||||
fail message
|
||||
else
|
||||
pass
|
||||
|
||||
|
||||
{-| Passes if the
|
||||
[`Result`](http://package.elm-lang.org/packages/elm-lang/core/latest/Result) is
|
||||
an `Err` rather than `Ok`. This is useful for tests where you expect to get an
|
||||
error but you don't care about what the actual error is. If your possibly
|
||||
erroring function returns a `Maybe`, simply use `Expect.equal Nothing`.
|
||||
|
||||
-- Passes
|
||||
String.toInt "not an int"
|
||||
|> Expect.err
|
||||
|
||||
Test failures will be printed with the unexpected `Ok` value contrasting with
|
||||
any `Err`.
|
||||
|
||||
-- Fails
|
||||
String.toInt "20"
|
||||
|> Expect.err
|
||||
|
||||
{-
|
||||
|
||||
Ok 20
|
||||
╷
|
||||
│ Expect.err
|
||||
╵
|
||||
Err _
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
err : Result a b -> Expectation
|
||||
err result =
|
||||
case result of
|
||||
Ok _ ->
|
||||
{ description = "Expect.err"
|
||||
, reason = Comparison "Err _" (toString result)
|
||||
}
|
||||
|> Test.Expectation.fail
|
||||
|
||||
Err _ ->
|
||||
pass
|
||||
|
||||
|
||||
{-| Passes if the arguments are equal lists.
|
||||
|
||||
-- Passes
|
||||
[1, 2, 3]
|
||||
|> Expect.equalLists [1, 2, 3]
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which, and reports which index the lists first
|
||||
differed at or which list was longer:
|
||||
|
||||
-- Fails
|
||||
[ 1, 2, 4, 6 ]
|
||||
|> Expect.equalLists [ 1, 2, 5 ]
|
||||
|
||||
{-
|
||||
|
||||
[1,2,4,6]
|
||||
first diff at index index 2: +`4`, -`5`
|
||||
╷
|
||||
│ Expect.equalLists
|
||||
╵
|
||||
first diff at index index 2: +`5`, -`4`
|
||||
[1,2,5]
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
equalLists : List a -> List a -> Expectation
|
||||
equalLists expected actual =
|
||||
if expected == actual then
|
||||
pass
|
||||
else
|
||||
{ description = "Expect.equalLists"
|
||||
, reason = ListDiff (List.map toString expected) (List.map toString actual)
|
||||
}
|
||||
|> Test.Expectation.fail
|
||||
|
||||
|
||||
{-| Passes if the arguments are equal dicts.
|
||||
|
||||
-- Passes
|
||||
(Dict.fromList [ ( 1, "one" ), ( 2, "two" ) ])
|
||||
|> Expect.equalDicts (Dict.fromList [ ( 1, "one" ), ( 2, "two" ) ])
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which, and reports which keys were missing from
|
||||
or added to each dict:
|
||||
|
||||
-- Fails
|
||||
(Dict.fromList [ ( 1, "one" ), ( 2, "too" ) ])
|
||||
|> Expect.equalDicts (Dict.fromList [ ( 1, "one" ), ( 2, "two" ), ( 3, "three" ) ])
|
||||
|
||||
{-
|
||||
|
||||
Dict.fromList [(1,"one"),(2,"too")]
|
||||
diff: -[ (2,"two"), (3,"three") ] +[ (2,"too") ]
|
||||
╷
|
||||
│ Expect.equalDicts
|
||||
╵
|
||||
diff: +[ (2,"two"), (3,"three") ] -[ (2,"too") ]
|
||||
Dict.fromList [(1,"one"),(2,"two"),(3,"three")]
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
equalDicts : Dict comparable a -> Dict comparable a -> Expectation
|
||||
equalDicts expected actual =
|
||||
if Dict.toList expected == Dict.toList actual then
|
||||
pass
|
||||
else
|
||||
let
|
||||
differ dict k v diffs =
|
||||
if Dict.get k dict == Just v then
|
||||
diffs
|
||||
else
|
||||
( k, v ) :: diffs
|
||||
|
||||
missingKeys =
|
||||
Dict.foldr (differ actual) [] expected
|
||||
|
||||
extraKeys =
|
||||
Dict.foldr (differ expected) [] actual
|
||||
in
|
||||
reportCollectionFailure "Expect.equalDicts" expected actual missingKeys extraKeys
|
||||
|
||||
|
||||
{-| Passes if the arguments are equal sets.
|
||||
|
||||
-- Passes
|
||||
(Set.fromList [1, 2])
|
||||
|> Expect.equalSets (Set.fromList [1, 2])
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which, and reports which keys were missing from
|
||||
or added to each set:
|
||||
|
||||
-- Fails
|
||||
(Set.fromList [ 1, 2, 4, 6 ])
|
||||
|> Expect.equalSets (Set.fromList [ 1, 2, 5 ])
|
||||
|
||||
{-
|
||||
|
||||
Set.fromList [1,2,4,6]
|
||||
diff: -[ 5 ] +[ 4, 6 ]
|
||||
╷
|
||||
│ Expect.equalSets
|
||||
╵
|
||||
diff: +[ 5 ] -[ 4, 6 ]
|
||||
Set.fromList [1,2,5]
|
||||
|
||||
-}
|
||||
|
||||
-}
|
||||
equalSets : Set comparable -> Set comparable -> Expectation
|
||||
equalSets expected actual =
|
||||
if Set.toList expected == Set.toList actual then
|
||||
pass
|
||||
else
|
||||
let
|
||||
missingKeys =
|
||||
Set.diff expected actual
|
||||
|> Set.toList
|
||||
|
||||
extraKeys =
|
||||
Set.diff actual expected
|
||||
|> Set.toList
|
||||
in
|
||||
reportCollectionFailure "Expect.equalSets" expected actual missingKeys extraKeys
|
||||
|
||||
|
||||
{-| Always passes.
|
||||
|
||||
import Json.Decode exposing (decodeString, int)
|
||||
import Test exposing (test)
|
||||
import Expect
|
||||
|
||||
|
||||
test "Json.Decode.int can decode the number 42." <|
|
||||
\_ ->
|
||||
case decodeString int "42" of
|
||||
Ok _ ->
|
||||
Expect.pass
|
||||
|
||||
Err err ->
|
||||
Expect.fail err
|
||||
|
||||
-}
|
||||
pass : Expectation
|
||||
pass =
|
||||
Test.Expectation.Pass
|
||||
|
||||
|
||||
{-| Fails with the given message.
|
||||
|
||||
import Json.Decode exposing (decodeString, int)
|
||||
import Test exposing (test)
|
||||
import Expect
|
||||
|
||||
|
||||
test "Json.Decode.int can decode the number 42." <|
|
||||
\_ ->
|
||||
case decodeString int "42" of
|
||||
Ok _ ->
|
||||
Expect.pass
|
||||
|
||||
Err err ->
|
||||
Expect.fail err
|
||||
|
||||
-}
|
||||
fail : String -> Expectation
|
||||
fail str =
|
||||
Test.Expectation.fail { description = str, reason = Custom }
|
||||
|
||||
|
||||
{-| If the given expectation fails, replace its failure message with a custom one.
|
||||
|
||||
"something"
|
||||
|> Expect.equal "something else"
|
||||
|> Expect.onFail "thought those two strings would be the same"
|
||||
|
||||
-}
|
||||
onFail : String -> Expectation -> Expectation
|
||||
onFail str expectation =
|
||||
case expectation of
|
||||
Test.Expectation.Pass ->
|
||||
expectation
|
||||
|
||||
Test.Expectation.Fail failure ->
|
||||
Test.Expectation.Fail { failure | description = str, reason = Custom }
|
||||
|
||||
|
||||
{-| Passes if each of the given functions passes when applied to the subject.
|
||||
|
||||
Passing an empty list is assumed to be a mistake, so `Expect.all []`
|
||||
will always return a failed expectation no matter what else it is passed.
|
||||
|
||||
Expect.all
|
||||
[ Expect.greaterThan -2
|
||||
, Expect.lessThan 5
|
||||
]
|
||||
(List.length [])
|
||||
-- Passes because (0 > -2) is True and (0 < 5) is also True
|
||||
|
||||
Failures resemble code written in pipeline style, so you can tell
|
||||
which argument is which:
|
||||
|
||||
-- Fails because (0 < -10) is False
|
||||
List.length []
|
||||
|> Expect.all
|
||||
[ Expect.greaterThan -2
|
||||
, Expect.lessThan -10
|
||||
, Expect.equal 0
|
||||
]
|
||||
{-
|
||||
0
|
||||
╷
|
||||
│ Expect.lessThan
|
||||
╵
|
||||
-10
|
||||
-}
|
||||
|
||||
-}
|
||||
all : List (subject -> Expectation) -> subject -> Expectation
|
||||
all list query =
|
||||
if List.isEmpty list then
|
||||
Test.Expectation.fail
|
||||
{ reason = Invalid EmptyList
|
||||
, description = "Expect.all was given an empty list. You must make at least one expectation to have a valid test!"
|
||||
}
|
||||
else
|
||||
allHelp list query
|
||||
|
||||
|
||||
allHelp : List (subject -> Expectation) -> subject -> Expectation
|
||||
allHelp list query =
|
||||
case list of
|
||||
[] ->
|
||||
pass
|
||||
|
||||
check :: rest ->
|
||||
case check query of
|
||||
Test.Expectation.Pass ->
|
||||
allHelp rest query
|
||||
|
||||
outcome ->
|
||||
outcome
|
||||
|
||||
|
||||
|
||||
{---- Private helper functions ----}
|
||||
|
||||
|
||||
reportFailure : String -> String -> String -> Expectation
|
||||
reportFailure comparison expected actual =
|
||||
{ description = comparison
|
||||
, reason = Comparison (toString expected) (toString actual)
|
||||
}
|
||||
|> Test.Expectation.fail
|
||||
|
||||
|
||||
reportCollectionFailure : String -> a -> b -> List c -> List d -> Expectation
|
||||
reportCollectionFailure comparison expected actual missingKeys extraKeys =
|
||||
{ description = comparison
|
||||
, reason =
|
||||
{ expected = toString expected
|
||||
, actual = toString actual
|
||||
, extra = List.map toString extraKeys
|
||||
, missing = List.map toString missingKeys
|
||||
}
|
||||
|> CollectionDiff
|
||||
}
|
||||
|> Test.Expectation.fail
|
||||
|
||||
|
||||
{-| String arg is label, e.g. "Expect.equal".
|
||||
-}
|
||||
equateWith : String -> (a -> b -> Bool) -> b -> a -> Expectation
|
||||
equateWith =
|
||||
testWith Equality
|
||||
|
||||
|
||||
compareWith : String -> (a -> b -> Bool) -> b -> a -> Expectation
|
||||
compareWith =
|
||||
testWith Comparison
|
||||
|
||||
|
||||
testWith : (String -> String -> Reason) -> String -> (a -> b -> Bool) -> b -> a -> Expectation
|
||||
testWith makeReason label runTest expected actual =
|
||||
if runTest actual expected then
|
||||
pass
|
||||
else
|
||||
{ description = label
|
||||
, reason = makeReason (toString expected) (toString actual)
|
||||
}
|
||||
|> Test.Expectation.fail
|
||||
|
||||
|
||||
|
||||
{---- Private *floating point* helper functions ----}
|
||||
|
||||
|
||||
absolute : FloatingPointTolerance -> Float
|
||||
absolute tolerance =
|
||||
case tolerance of
|
||||
Absolute absolute ->
|
||||
absolute
|
||||
|
||||
AbsoluteOrRelative absolute _ ->
|
||||
absolute
|
||||
|
||||
_ ->
|
||||
0
|
||||
|
||||
|
||||
relative : FloatingPointTolerance -> Float
|
||||
relative tolerance =
|
||||
case tolerance of
|
||||
Relative relative ->
|
||||
relative
|
||||
|
||||
AbsoluteOrRelative _ relative ->
|
||||
relative
|
||||
|
||||
_ ->
|
||||
0
|
||||
|
||||
|
||||
nonNegativeToleranceError : FloatingPointTolerance -> String -> Expectation -> Expectation
|
||||
nonNegativeToleranceError tolerance name result =
|
||||
if absolute tolerance < 0 && relative tolerance < 0 then
|
||||
Test.Expectation.fail { description = "Expect." ++ name ++ " was given negative absolute and relative tolerances", reason = Custom }
|
||||
else if absolute tolerance < 0 then
|
||||
Test.Expectation.fail { description = "Expect." ++ name ++ " was given a negative absolute tolerance", reason = Custom }
|
||||
else if relative tolerance < 0 then
|
||||
Test.Expectation.fail { description = "Expect." ++ name ++ " was given a negative relative tolerance", reason = Custom }
|
||||
else
|
||||
result
|
||||
|
||||
|
||||
withinCompare : FloatingPointTolerance -> Float -> Float -> Bool
|
||||
withinCompare tolerance a b =
|
||||
let
|
||||
withinAbsoluteTolerance =
|
||||
a - absolute tolerance <= b && b <= a + absolute tolerance
|
||||
|
||||
withinRelativeTolerance =
|
||||
(a * (1 - relative tolerance) <= b && b <= a * (1 + relative tolerance))
|
||||
|| (b * (1 - relative tolerance) <= a && a <= b * (1 + relative tolerance))
|
||||
in
|
||||
(a == b) || withinAbsoluteTolerance || withinRelativeTolerance
|
||||
78
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Float.elm
vendored
Normal file
78
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Float.elm
vendored
Normal file
@@ -0,0 +1,78 @@
|
||||
module Float
|
||||
exposing
|
||||
( epsilon
|
||||
, infinity
|
||||
, maxAbsValue
|
||||
, minAbsNormal
|
||||
, minAbsValue
|
||||
, nan
|
||||
)
|
||||
|
||||
{-| Float contains useful constants related to 64 bit floating point numbers,
|
||||
as specified in IEEE 754-2008.
|
||||
|
||||
@docs epsilon, infinity, nan, minAbsNormal, minAbsValue, maxAbsValue
|
||||
|
||||
-}
|
||||
|
||||
|
||||
{-| Largest possible rounding error in a single 64 bit floating point
|
||||
calculation on an x86-x64 CPU. Also known as the Machine Epsilon.
|
||||
|
||||
If you do not know what tolerance you should use, use this number, multiplied
|
||||
by the number of floating point operations you're doing in your calculation.
|
||||
|
||||
According to the [MSDN system.double.epsilon documentation]
|
||||
(<https://msdn.microsoft.com/en-us/library/system.double.epsilon.aspx#Remarks>),
|
||||
ARM has a machine epsilon that is too small to represent in a 64 bit float,
|
||||
so we're simply ignoring that. On phones, tablets, raspberry pi's and other
|
||||
devices with ARM chips, you might get slightly better precision than we assume
|
||||
here.
|
||||
|
||||
-}
|
||||
epsilon : Float
|
||||
epsilon =
|
||||
2.0 ^ -52
|
||||
|
||||
|
||||
{-| Positive infinity. Negative infinity is just -infinity.
|
||||
-}
|
||||
infinity : Float
|
||||
infinity =
|
||||
1.0 / 0.0
|
||||
|
||||
|
||||
{-| Not a Number. NaN does not compare equal to anything, including itself.
|
||||
Any operation including NaN will result in NaN.
|
||||
-}
|
||||
nan : Float
|
||||
nan =
|
||||
0.0 / 0.0
|
||||
|
||||
|
||||
{-| Smallest possible value which still has full precision.
|
||||
|
||||
Values closer to zero are denormalized, which means that they are
|
||||
using some of the significant bits to emulate a slightly larger mantissa.
|
||||
The number of significant binary digits is proportional to the binary
|
||||
logarithm of the denormalized number; halving a denormalized number also
|
||||
halves the precision of that number.
|
||||
|
||||
-}
|
||||
minAbsNormal : Float
|
||||
minAbsNormal =
|
||||
2.0 ^ -1022
|
||||
|
||||
|
||||
{-| Smallest absolute value representable in a 64 bit float.
|
||||
-}
|
||||
minAbsValue : Float
|
||||
minAbsValue =
|
||||
2.0 ^ -1074
|
||||
|
||||
|
||||
{-| Largest finite absolute value representable in a 64 bit float.
|
||||
-}
|
||||
maxAbsValue : Float
|
||||
maxAbsValue =
|
||||
(2.0 - epsilon) * 2.0 ^ 1023
|
||||
748
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Fuzz.elm
vendored
Normal file
748
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Fuzz.elm
vendored
Normal file
@@ -0,0 +1,748 @@
|
||||
module Fuzz exposing (Fuzzer, andMap, andThen, array, bool, char, conditional, constant, custom, float, floatRange, frequency, int, intRange, invalid, list, map, map2, map3, map4, map5, maybe, oneOf, order, percentage, result, string, tuple, tuple3, tuple4, tuple5, unit)
|
||||
|
||||
{-| This is a library of _fuzzers_ you can use to supply values to your fuzz
|
||||
tests. You can typically pick out which ones you need according to their types.
|
||||
|
||||
A `Fuzzer a` knows how to create values of type `a` in two different ways. It
|
||||
can create them randomly, so that your test's expectations are run against many
|
||||
values. Fuzzers will often generate edge cases likely to find bugs. If the
|
||||
fuzzer can make your test fail, it also knows how to "shrink" that failing input
|
||||
into more minimal examples, some of which might also cause the tests to fail. In
|
||||
this way, fuzzers can usually find the smallest or simplest input that
|
||||
reproduces a bug.
|
||||
|
||||
|
||||
## Common Fuzzers
|
||||
|
||||
@docs bool, int, intRange, float, floatRange, percentage, string, maybe, result, list, array
|
||||
|
||||
|
||||
## Working with Fuzzers
|
||||
|
||||
@docs Fuzzer, constant, map, map2, map3, map4, map5, andMap, andThen, frequency, conditional
|
||||
@docs Fuzzer, oneOf, constant, map, map2, map3, map4, map5, andMap, andThen, frequency, conditional
|
||||
|
||||
|
||||
## Tuple Fuzzers
|
||||
|
||||
Instead of using a tuple, consider using `fuzzN`.
|
||||
@docs tuple, tuple3, tuple4, tuple5
|
||||
|
||||
|
||||
## Uncommon Fuzzers
|
||||
|
||||
@docs custom, char, unit, order, invalid
|
||||
|
||||
-}
|
||||
|
||||
import Array exposing (Array)
|
||||
import Char
|
||||
import Fuzz.Internal as Internal
|
||||
exposing
|
||||
( Fuzzer
|
||||
, Valid
|
||||
, ValidFuzzer
|
||||
, combineValid
|
||||
, invalidReason
|
||||
)
|
||||
import Lazy
|
||||
import Lazy.List exposing ((+++), LazyList)
|
||||
import Random.Pcg as Random exposing (Generator)
|
||||
import RoseTree exposing (RoseTree(..))
|
||||
import Shrink exposing (Shrinker)
|
||||
import Util exposing (..)
|
||||
|
||||
|
||||
{-| The representation of fuzzers is opaque. Conceptually, a `Fuzzer a`
|
||||
consists of a way to randomly generate values of type `a`, and a way to shrink
|
||||
those values.
|
||||
-}
|
||||
type alias Fuzzer a =
|
||||
Internal.Fuzzer a
|
||||
|
||||
|
||||
{-| Build a custom `Fuzzer a` by providing a `Generator a` and a `Shrinker a`.
|
||||
Generators are defined in [`mgold/elm-random-pcg`](http://package.elm-lang.org/packages/mgold/elm-random-pcg/latest),
|
||||
which is not core's Random module but has a compatible interface. Shrinkers are
|
||||
defined in [`elm-community/shrink`](http://package.elm-lang.org/packages/elm-community/shrink/latest/).
|
||||
|
||||
Here is an example for a record:
|
||||
|
||||
import Random.Pcg as Random
|
||||
import Shrink
|
||||
|
||||
type alias Position =
|
||||
{ x : Int, y : Int }
|
||||
|
||||
position : Fuzzer Position
|
||||
position =
|
||||
Fuzz.custom
|
||||
(Random.map2 Position (Random.int -100 100) (Random.int -100 100))
|
||||
(\{ x, y } -> Shrink.map Position (Shrink.int x) |> Shrink.andMap (Shrink.int y))
|
||||
|
||||
Here is an example for a custom union type, assuming there is already a `genName : Generator String` defined:
|
||||
|
||||
type Question
|
||||
= Name String
|
||||
| Age Int
|
||||
|
||||
question =
|
||||
let
|
||||
generator =
|
||||
Random.bool
|
||||
|> Random.andThen
|
||||
(\b ->
|
||||
if b then
|
||||
Random.map Name genName
|
||||
else
|
||||
Random.map Age (Random.int 0 120)
|
||||
)
|
||||
|
||||
shrinker question =
|
||||
case question of
|
||||
Name n ->
|
||||
Shrink.string n |> Shrink.map Name
|
||||
|
||||
Age i ->
|
||||
Shrink.int i |> Shrink.map Age
|
||||
in
|
||||
Fuzz.custom generator shrinker
|
||||
|
||||
It is not possible to extract the generator and shrinker from an existing fuzzer.
|
||||
|
||||
-}
|
||||
custom : Generator a -> Shrinker a -> Fuzzer a
|
||||
custom generator shrinker =
|
||||
let
|
||||
shrinkTree a =
|
||||
Rose a (Lazy.lazy <| \_ -> Lazy.force <| Lazy.List.map shrinkTree (shrinker a))
|
||||
in
|
||||
Ok <|
|
||||
Random.map shrinkTree generator
|
||||
|
||||
|
||||
{-| A fuzzer for the unit value. Unit is a type with only one value, commonly
|
||||
used as a placeholder.
|
||||
-}
|
||||
unit : Fuzzer ()
|
||||
unit =
|
||||
RoseTree.singleton ()
|
||||
|> Random.constant
|
||||
|> Ok
|
||||
|
||||
|
||||
{-| A fuzzer for bool values.
|
||||
-}
|
||||
bool : Fuzzer Bool
|
||||
bool =
|
||||
custom Random.bool Shrink.bool
|
||||
|
||||
|
||||
{-| A fuzzer for order values.
|
||||
-}
|
||||
order : Fuzzer Order
|
||||
order =
|
||||
let
|
||||
intToOrder i =
|
||||
if i == 0 then
|
||||
LT
|
||||
else if i == 1 then
|
||||
EQ
|
||||
else
|
||||
GT
|
||||
in
|
||||
custom (Random.map intToOrder (Random.int 0 2)) Shrink.order
|
||||
|
||||
|
||||
{-| A fuzzer for int values. It will never produce `NaN`, `Infinity`, or `-Infinity`.
|
||||
|
||||
It's possible for this fuzzer to generate any 32-bit integer, but it favors
|
||||
numbers between -50 and 50 and especially zero.
|
||||
|
||||
-}
|
||||
int : Fuzzer Int
|
||||
int =
|
||||
let
|
||||
generator =
|
||||
Random.frequency
|
||||
[ ( 3, Random.int -50 50 )
|
||||
, ( 0.2, Random.constant 0 )
|
||||
, ( 1, Random.int 0 (Random.maxInt - Random.minInt) )
|
||||
, ( 1, Random.int (Random.minInt - Random.maxInt) 0 )
|
||||
]
|
||||
in
|
||||
custom generator Shrink.int
|
||||
|
||||
|
||||
{-| A fuzzer for int values within between a given minimum and maximum value,
|
||||
inclusive. Shrunken values will also be within the range.
|
||||
|
||||
Remember that [Random.maxInt](http://package.elm-lang.org/packages/elm-lang/core/latest/Random#maxInt)
|
||||
is the maximum possible int value, so you can do `intRange x Random.maxInt` to get all
|
||||
the ints x or bigger.
|
||||
|
||||
-}
|
||||
intRange : Int -> Int -> Fuzzer Int
|
||||
intRange lo hi =
|
||||
if hi < lo then
|
||||
Err <| "Fuzz.intRange was given a lower bound of " ++ toString lo ++ " which is greater than the upper bound, " ++ toString hi ++ "."
|
||||
else
|
||||
custom
|
||||
(Random.frequency
|
||||
[ ( 8, Random.int lo hi )
|
||||
, ( 1, Random.constant lo )
|
||||
, ( 1, Random.constant hi )
|
||||
]
|
||||
)
|
||||
(Shrink.keepIf (\i -> i >= lo && i <= hi) Shrink.int)
|
||||
|
||||
|
||||
{-| A fuzzer for float values. It will never produce `NaN`, `Infinity`, or `-Infinity`.
|
||||
|
||||
It's possible for this fuzzer to generate any other floating-point value, but it
|
||||
favors numbers between -50 and 50, numbers between -1 and 1, and especially zero.
|
||||
|
||||
-}
|
||||
float : Fuzzer Float
|
||||
float =
|
||||
let
|
||||
generator =
|
||||
Random.frequency
|
||||
[ ( 3, Random.float -50 50 )
|
||||
, ( 0.5, Random.constant 0 )
|
||||
, ( 1, Random.float -1 1 )
|
||||
, ( 1, Random.float 0 (toFloat <| Random.maxInt - Random.minInt) )
|
||||
, ( 1, Random.float (toFloat <| Random.minInt - Random.maxInt) 0 )
|
||||
]
|
||||
in
|
||||
custom generator Shrink.float
|
||||
|
||||
|
||||
{-| A fuzzer for float values within between a given minimum and maximum
|
||||
value, inclusive. Shrunken values will also be within the range.
|
||||
-}
|
||||
floatRange : Float -> Float -> Fuzzer Float
|
||||
floatRange lo hi =
|
||||
if hi < lo then
|
||||
Err <| "Fuzz.floatRange was given a lower bound of " ++ toString lo ++ " which is greater than the upper bound, " ++ toString hi ++ "."
|
||||
else
|
||||
custom
|
||||
(Random.frequency
|
||||
[ ( 8, Random.float lo hi )
|
||||
, ( 1, Random.constant lo )
|
||||
, ( 1, Random.constant hi )
|
||||
]
|
||||
)
|
||||
(Shrink.keepIf (\i -> i >= lo && i <= hi) Shrink.float)
|
||||
|
||||
|
||||
{-| A fuzzer for percentage values. Generates random floats between `0.0` and
|
||||
`1.0`. It will test zero and one about 10% of the time each.
|
||||
-}
|
||||
percentage : Fuzzer Float
|
||||
percentage =
|
||||
let
|
||||
generator =
|
||||
Random.frequency
|
||||
[ ( 8, Random.float 0 1 )
|
||||
, ( 1, Random.constant 0 )
|
||||
, ( 1, Random.constant 1 )
|
||||
]
|
||||
in
|
||||
custom generator Shrink.float
|
||||
|
||||
|
||||
{-| A fuzzer for char values. Generates random ascii chars disregarding the control
|
||||
characters and the extended character set.
|
||||
-}
|
||||
char : Fuzzer Char
|
||||
char =
|
||||
custom asciiCharGenerator Shrink.character
|
||||
|
||||
|
||||
asciiCharGenerator : Generator Char
|
||||
asciiCharGenerator =
|
||||
Random.map Char.fromCode (Random.int 32 126)
|
||||
|
||||
|
||||
whitespaceCharGenerator : Generator Char
|
||||
whitespaceCharGenerator =
|
||||
Random.sample [ ' ', '\t', '\n' ] |> Random.map (Maybe.withDefault ' ')
|
||||
|
||||
|
||||
{-| Generates random printable ASCII strings of up to 1000 characters.
|
||||
|
||||
Shorter strings are more common, especially the empty string.
|
||||
|
||||
-}
|
||||
string : Fuzzer String
|
||||
string =
|
||||
let
|
||||
asciiGenerator : Generator String
|
||||
asciiGenerator =
|
||||
Random.frequency
|
||||
[ ( 3, Random.int 1 10 )
|
||||
, ( 0.2, Random.constant 0 )
|
||||
, ( 1, Random.int 11 50 )
|
||||
, ( 1, Random.int 50 1000 )
|
||||
]
|
||||
|> Random.andThen (lengthString asciiCharGenerator)
|
||||
|
||||
whitespaceGenerator : Generator String
|
||||
whitespaceGenerator =
|
||||
Random.int 1 10
|
||||
|> Random.andThen (lengthString whitespaceCharGenerator)
|
||||
in
|
||||
custom
|
||||
(Random.frequency
|
||||
[ ( 9, asciiGenerator )
|
||||
, ( 1, whitespaceGenerator )
|
||||
]
|
||||
)
|
||||
Shrink.string
|
||||
|
||||
|
||||
{-| Given a fuzzer of a type, create a fuzzer of a maybe for that type.
|
||||
-}
|
||||
maybe : Fuzzer a -> Fuzzer (Maybe a)
|
||||
maybe fuzzer =
|
||||
let
|
||||
toMaybe : Bool -> RoseTree a -> RoseTree (Maybe a)
|
||||
toMaybe useNothing tree =
|
||||
if useNothing then
|
||||
RoseTree.singleton Nothing
|
||||
else
|
||||
RoseTree.map Just tree |> RoseTree.addChild (RoseTree.singleton Nothing)
|
||||
in
|
||||
(Result.map << Random.map2 toMaybe) (Random.oneIn 4) fuzzer
|
||||
|
||||
|
||||
{-| Given fuzzers for an error type and a success type, create a fuzzer for
|
||||
a result.
|
||||
-}
|
||||
result : Fuzzer error -> Fuzzer value -> Fuzzer (Result error value)
|
||||
result fuzzerError fuzzerValue =
|
||||
let
|
||||
toResult : Bool -> RoseTree error -> RoseTree value -> RoseTree (Result error value)
|
||||
toResult useError errorTree valueTree =
|
||||
if useError then
|
||||
RoseTree.map Err errorTree
|
||||
else
|
||||
RoseTree.map Ok valueTree
|
||||
in
|
||||
(Result.map2 <| Random.map3 toResult (Random.oneIn 4)) fuzzerError fuzzerValue
|
||||
|
||||
|
||||
{-| Given a fuzzer of a type, create a fuzzer of a list of that type.
|
||||
Generates random lists of varying length, favoring shorter lists.
|
||||
-}
|
||||
list : Fuzzer a -> Fuzzer (List a)
|
||||
list fuzzer =
|
||||
let
|
||||
genLength =
|
||||
Random.frequency
|
||||
[ ( 1, Random.constant 0 )
|
||||
, ( 1, Random.constant 1 )
|
||||
, ( 3, Random.int 2 10 )
|
||||
, ( 2, Random.int 10 100 )
|
||||
, ( 0.5, Random.int 100 400 )
|
||||
]
|
||||
in
|
||||
fuzzer
|
||||
|> Result.map
|
||||
(\validFuzzer ->
|
||||
genLength
|
||||
|> Random.andThen (flip Random.list validFuzzer)
|
||||
|> Random.map listShrinkHelp
|
||||
)
|
||||
|
||||
|
||||
listShrinkHelp : List (RoseTree a) -> RoseTree (List a)
|
||||
listShrinkHelp listOfTrees =
|
||||
{- This extends listShrinkRecurse algorithm with an attempt to shrink directly to the empty list. -}
|
||||
listShrinkRecurse listOfTrees
|
||||
|> mapChildren (Lazy.List.cons <| RoseTree.singleton [])
|
||||
|
||||
|
||||
mapChildren : (LazyList (RoseTree a) -> LazyList (RoseTree a)) -> RoseTree a -> RoseTree a
|
||||
mapChildren fn (Rose root children) =
|
||||
Rose root (fn children)
|
||||
|
||||
|
||||
listShrinkRecurse : List (RoseTree a) -> RoseTree (List a)
|
||||
listShrinkRecurse listOfTrees =
|
||||
{- Shrinking a list of RoseTrees
|
||||
We need to do two things. First, shrink individual values. Second, shorten the list.
|
||||
To shrink individual values, we create every list copy of the input list where any
|
||||
one value is replaced by a shrunken form.
|
||||
To shorten the length of the list, remove elements at various positions in the list.
|
||||
In all cases, recurse! The goal is to make a little forward progress and then recurse.
|
||||
-}
|
||||
let
|
||||
n =
|
||||
List.length listOfTrees
|
||||
|
||||
root =
|
||||
List.map RoseTree.root listOfTrees
|
||||
|
||||
dropFirstHalf : List (RoseTree a) -> RoseTree (List a)
|
||||
dropFirstHalf list_ =
|
||||
List.drop (List.length list_ // 2) list_
|
||||
|> listShrinkRecurse
|
||||
|
||||
dropSecondHalf : List (RoseTree a) -> RoseTree (List a)
|
||||
dropSecondHalf list_ =
|
||||
List.take (List.length list_ // 2) list_
|
||||
|> listShrinkRecurse
|
||||
|
||||
halved : LazyList (RoseTree (List a))
|
||||
halved =
|
||||
-- The list halving shortcut is useful only for large lists.
|
||||
-- For small lists attempting to remove elements one by one is good enough.
|
||||
if n >= 8 then
|
||||
Lazy.lazy <|
|
||||
\_ ->
|
||||
Lazy.List.fromList [ dropFirstHalf listOfTrees, dropSecondHalf listOfTrees ]
|
||||
|> Lazy.force
|
||||
else
|
||||
Lazy.List.empty
|
||||
|
||||
shrinkOne prefix list =
|
||||
case list of
|
||||
[] ->
|
||||
Lazy.List.empty
|
||||
|
||||
(Rose x shrunkenXs) :: more ->
|
||||
Lazy.List.map (\childTree -> prefix ++ (childTree :: more) |> listShrinkRecurse) shrunkenXs
|
||||
|
||||
shrunkenVals =
|
||||
Lazy.lazy <|
|
||||
\_ ->
|
||||
Lazy.List.numbers
|
||||
|> Lazy.List.map (\i -> i - 1)
|
||||
|> Lazy.List.take n
|
||||
|> Lazy.List.andThen
|
||||
(\i -> shrinkOne (List.take i listOfTrees) (List.drop i listOfTrees))
|
||||
|> Lazy.force
|
||||
|
||||
shortened =
|
||||
Lazy.lazy <|
|
||||
\_ ->
|
||||
List.range 0 (n - 1)
|
||||
|> Lazy.List.fromList
|
||||
|> Lazy.List.map (\index -> removeOne index listOfTrees)
|
||||
|> Lazy.List.map listShrinkRecurse
|
||||
|> Lazy.force
|
||||
|
||||
removeOne index list =
|
||||
List.append
|
||||
(List.take index list)
|
||||
(List.drop (index + 1) list)
|
||||
in
|
||||
Rose root (halved +++ shortened +++ shrunkenVals)
|
||||
|
||||
|
||||
{-| Given a fuzzer of a type, create a fuzzer of an array of that type.
|
||||
Generates random arrays of varying length, favoring shorter arrays.
|
||||
-}
|
||||
array : Fuzzer a -> Fuzzer (Array a)
|
||||
array fuzzer =
|
||||
map Array.fromList (list fuzzer)
|
||||
|
||||
|
||||
{-| Turn a tuple of fuzzers into a fuzzer of tuples.
|
||||
-}
|
||||
tuple : ( Fuzzer a, Fuzzer b ) -> Fuzzer ( a, b )
|
||||
tuple ( fuzzerA, fuzzerB ) =
|
||||
map2 (,) fuzzerA fuzzerB
|
||||
|
||||
|
||||
{-| Turn a 3-tuple of fuzzers into a fuzzer of 3-tuples.
|
||||
-}
|
||||
tuple3 : ( Fuzzer a, Fuzzer b, Fuzzer c ) -> Fuzzer ( a, b, c )
|
||||
tuple3 ( fuzzerA, fuzzerB, fuzzerC ) =
|
||||
map3 (,,) fuzzerA fuzzerB fuzzerC
|
||||
|
||||
|
||||
{-| Turn a 4-tuple of fuzzers into a fuzzer of 4-tuples.
|
||||
-}
|
||||
tuple4 : ( Fuzzer a, Fuzzer b, Fuzzer c, Fuzzer d ) -> Fuzzer ( a, b, c, d )
|
||||
tuple4 ( fuzzerA, fuzzerB, fuzzerC, fuzzerD ) =
|
||||
map4 (,,,) fuzzerA fuzzerB fuzzerC fuzzerD
|
||||
|
||||
|
||||
{-| Turn a 5-tuple of fuzzers into a fuzzer of 5-tuples.
|
||||
-}
|
||||
tuple5 : ( Fuzzer a, Fuzzer b, Fuzzer c, Fuzzer d, Fuzzer e ) -> Fuzzer ( a, b, c, d, e )
|
||||
tuple5 ( fuzzerA, fuzzerB, fuzzerC, fuzzerD, fuzzerE ) =
|
||||
map5 (,,,,) fuzzerA fuzzerB fuzzerC fuzzerD fuzzerE
|
||||
|
||||
|
||||
{-| Create a fuzzer that only and always returns the value provided, and performs no shrinking. This is hardly random,
|
||||
and so this function is best used as a helper when creating more complicated fuzzers.
|
||||
-}
|
||||
constant : a -> Fuzzer a
|
||||
constant x =
|
||||
Ok <| Random.constant (RoseTree.singleton x)
|
||||
|
||||
|
||||
{-| Map a function over a fuzzer. This applies to both the generated and the shrunken values.
|
||||
-}
|
||||
map : (a -> b) -> Fuzzer a -> Fuzzer b
|
||||
map =
|
||||
Internal.map
|
||||
|
||||
|
||||
{-| Map over two fuzzers.
|
||||
-}
|
||||
map2 : (a -> b -> c) -> Fuzzer a -> Fuzzer b -> Fuzzer c
|
||||
map2 transform fuzzA fuzzB =
|
||||
(Result.map2 << Random.map2 << map2RoseTree) transform fuzzA fuzzB
|
||||
|
||||
|
||||
{-| Map over three fuzzers.
|
||||
-}
|
||||
map3 : (a -> b -> c -> d) -> Fuzzer a -> Fuzzer b -> Fuzzer c -> Fuzzer d
|
||||
map3 transform fuzzA fuzzB fuzzC =
|
||||
(Result.map3 << Random.map3 << map3RoseTree) transform fuzzA fuzzB fuzzC
|
||||
|
||||
|
||||
{-| Map over four fuzzers.
|
||||
-}
|
||||
map4 : (a -> b -> c -> d -> e) -> Fuzzer a -> Fuzzer b -> Fuzzer c -> Fuzzer d -> Fuzzer e
|
||||
map4 transform fuzzA fuzzB fuzzC fuzzD =
|
||||
(Result.map4 << Random.map4 << map4RoseTree) transform fuzzA fuzzB fuzzC fuzzD
|
||||
|
||||
|
||||
{-| Map over five fuzzers.
|
||||
-}
|
||||
map5 : (a -> b -> c -> d -> e -> f) -> Fuzzer a -> Fuzzer b -> Fuzzer c -> Fuzzer d -> Fuzzer e -> Fuzzer f
|
||||
map5 transform fuzzA fuzzB fuzzC fuzzD fuzzE =
|
||||
(Result.map5 << Random.map5 << map5RoseTree) transform fuzzA fuzzB fuzzC fuzzD fuzzE
|
||||
|
||||
|
||||
{-| Map over many fuzzers. This can act as mapN for N > 5.
|
||||
The argument order is meant to accommodate chaining:
|
||||
map f aFuzzer
|
||||
|> andMap anotherFuzzer
|
||||
|> andMap aThirdFuzzer
|
||||
Note that shrinking may be better using mapN.
|
||||
-}
|
||||
andMap : Fuzzer a -> Fuzzer (a -> b) -> Fuzzer b
|
||||
andMap =
|
||||
map2 (|>)
|
||||
|
||||
|
||||
{-| Create a fuzzer based on the result of another fuzzer.
|
||||
-}
|
||||
andThen : (a -> Fuzzer b) -> Fuzzer a -> Fuzzer b
|
||||
andThen =
|
||||
Internal.andThen
|
||||
|
||||
|
||||
{-| Conditionally filter a fuzzer to remove occasional undesirable
|
||||
input. Takes a limit for how many retries to attempt, and a fallback
|
||||
function to, if no acceptable input can be found, create one from an
|
||||
unacceptable one. Also takes a condition to determine if the input is
|
||||
acceptable or not, and finally the fuzzer itself.
|
||||
|
||||
A good number of max retries is ten. A large number of retries might
|
||||
blow the stack.
|
||||
|
||||
-}
|
||||
conditional : { retries : Int, fallback : a -> a, condition : a -> Bool } -> Fuzzer a -> Fuzzer a
|
||||
conditional opts fuzzer =
|
||||
Result.map (conditionalHelper opts) fuzzer
|
||||
|
||||
|
||||
conditionalHelper : { retries : Int, fallback : a -> a, condition : a -> Bool } -> ValidFuzzer a -> ValidFuzzer a
|
||||
conditionalHelper opts validFuzzer =
|
||||
if opts.retries <= 0 then
|
||||
Random.map
|
||||
(RoseTree.map opts.fallback >> RoseTree.filterBranches opts.condition)
|
||||
validFuzzer
|
||||
else
|
||||
validFuzzer
|
||||
|> Random.andThen
|
||||
(\tree ->
|
||||
case RoseTree.filter opts.condition tree of
|
||||
Just tree ->
|
||||
Random.constant tree
|
||||
|
||||
Nothing ->
|
||||
conditionalHelper { opts | retries = opts.retries - 1 } validFuzzer
|
||||
)
|
||||
|
||||
|
||||
{-| Create a new `Fuzzer` by providing a list of probabilistic weights to use
|
||||
with other fuzzers.
|
||||
For example, to create a `Fuzzer` that has a 1/4 chance of generating an int
|
||||
between -1 and -100, and a 3/4 chance of generating one between 1 and 100,
|
||||
you could do this:
|
||||
|
||||
Fuzz.frequency
|
||||
[ ( 1, Fuzz.intRange -100 -1 )
|
||||
, ( 3, Fuzz.intRange 1 100 )
|
||||
]
|
||||
|
||||
There are a few circumstances in which this function will return an invalid
|
||||
fuzzer, which causes it to fail any test that uses it:
|
||||
|
||||
- If you provide an empty list of frequencies
|
||||
- If any of the weights are less than 0
|
||||
- If the weights sum to 0
|
||||
|
||||
Be careful recursively using this fuzzer in its arguments. Often using `map`
|
||||
is a better way to do what you want. If you are fuzzing a tree-like data
|
||||
structure, you should include a depth limit so to avoid infinite recursion, like
|
||||
so:
|
||||
|
||||
type Tree
|
||||
= Leaf
|
||||
| Branch Tree Tree
|
||||
|
||||
tree : Int -> Fuzzer Tree
|
||||
tree i =
|
||||
if i <= 0 then
|
||||
Fuzz.constant Leaf
|
||||
else
|
||||
Fuzz.frequency
|
||||
[ ( 1, Fuzz.constant Leaf )
|
||||
, ( 2, Fuzz.map2 Branch (tree (i - 1)) (tree (i - 1)) )
|
||||
]
|
||||
|
||||
-}
|
||||
frequency : List ( Float, Fuzzer a ) -> Fuzzer a
|
||||
frequency list =
|
||||
if List.isEmpty list then
|
||||
invalid "You must provide at least one frequency pair."
|
||||
else if List.any (\( weight, _ ) -> weight < 0) list then
|
||||
invalid "No frequency weights can be less than 0."
|
||||
else if List.sum (List.map Tuple.first list) <= 0 then
|
||||
invalid "Frequency weights must sum to more than 0."
|
||||
else
|
||||
list
|
||||
|> List.map extractValid
|
||||
|> combineValid
|
||||
|> Result.map Random.frequency
|
||||
|
||||
|
||||
extractValid : ( a, Valid b ) -> Valid ( a, b )
|
||||
extractValid ( a, valid ) =
|
||||
Result.map ((,) a) valid
|
||||
|
||||
|
||||
{-| Choose one of the given fuzzers at random. Each fuzzer has an equal chance
|
||||
of being chosen; to customize the probabilities, use [`frequency`](#frequency).
|
||||
|
||||
Fuzz.oneOf
|
||||
[ Fuzz.intRange 0 3
|
||||
, Fuzz.intRange 7 9
|
||||
]
|
||||
|
||||
-}
|
||||
oneOf : List (Fuzzer a) -> Fuzzer a
|
||||
oneOf list =
|
||||
if List.isEmpty list then
|
||||
invalid "You must pass at least one Fuzzer to Fuzz.oneOf."
|
||||
else
|
||||
list
|
||||
|> List.map (\fuzzer -> ( 1, fuzzer ))
|
||||
|> frequency
|
||||
|
||||
|
||||
{-| A fuzzer that is invalid for the provided reason. Any fuzzers built with it
|
||||
are also invalid. Any tests using an invalid fuzzer fail.
|
||||
-}
|
||||
invalid : String -> Fuzzer a
|
||||
invalid reason =
|
||||
Err reason
|
||||
|
||||
|
||||
map2RoseTree : (a -> b -> c) -> RoseTree a -> RoseTree b -> RoseTree c
|
||||
map2RoseTree transform ((Rose root1 children1) as rose1) ((Rose root2 children2) as rose2) =
|
||||
{- Shrinking a pair of RoseTrees
|
||||
Recurse on all pairs created by substituting one element for any of its shrunken values.
|
||||
A weakness of this algorithm is that it expects that values can be shrunken independently.
|
||||
That is, to shrink from (a,b) to (a',b'), we must go through (a',b) or (a,b').
|
||||
"No pairs sum to zero" is a pathological predicate that cannot be shrunken this way.
|
||||
-}
|
||||
let
|
||||
root =
|
||||
transform root1 root2
|
||||
|
||||
shrink1 =
|
||||
Lazy.List.map (\subtree -> map2RoseTree transform subtree rose2) children1
|
||||
|
||||
shrink2 =
|
||||
Lazy.List.map (\subtree -> map2RoseTree transform rose1 subtree) children2
|
||||
in
|
||||
Rose root (shrink1 +++ shrink2)
|
||||
|
||||
|
||||
|
||||
-- The RoseTree 'mapN, n > 2' functions below follow the same strategy as map2RoseTree.
|
||||
-- They're implemented separately instead of in terms of `andMap` because this has significant perfomance benefits.
|
||||
|
||||
|
||||
map3RoseTree : (a -> b -> c -> d) -> RoseTree a -> RoseTree b -> RoseTree c -> RoseTree d
|
||||
map3RoseTree transform ((Rose root1 children1) as rose1) ((Rose root2 children2) as rose2) ((Rose root3 children3) as rose3) =
|
||||
let
|
||||
root =
|
||||
transform root1 root2 root3
|
||||
|
||||
shrink1 =
|
||||
Lazy.List.map (\childOf1 -> map3RoseTree transform childOf1 rose2 rose3) children1
|
||||
|
||||
shrink2 =
|
||||
Lazy.List.map (\childOf2 -> map3RoseTree transform rose1 childOf2 rose3) children2
|
||||
|
||||
shrink3 =
|
||||
Lazy.List.map (\childOf3 -> map3RoseTree transform rose1 rose2 childOf3) children3
|
||||
in
|
||||
Rose root (shrink1 +++ shrink2 +++ shrink3)
|
||||
|
||||
|
||||
map4RoseTree : (a -> b -> c -> d -> e) -> RoseTree a -> RoseTree b -> RoseTree c -> RoseTree d -> RoseTree e
|
||||
map4RoseTree transform ((Rose root1 children1) as rose1) ((Rose root2 children2) as rose2) ((Rose root3 children3) as rose3) ((Rose root4 children4) as rose4) =
|
||||
let
|
||||
root =
|
||||
transform root1 root2 root3 root4
|
||||
|
||||
shrink1 =
|
||||
Lazy.List.map (\childOf1 -> map4RoseTree transform childOf1 rose2 rose3 rose4) children1
|
||||
|
||||
shrink2 =
|
||||
Lazy.List.map (\childOf2 -> map4RoseTree transform rose1 childOf2 rose3 rose4) children2
|
||||
|
||||
shrink3 =
|
||||
Lazy.List.map (\childOf3 -> map4RoseTree transform rose1 rose2 childOf3 rose4) children3
|
||||
|
||||
shrink4 =
|
||||
Lazy.List.map (\childOf4 -> map4RoseTree transform rose1 rose2 rose3 childOf4) children4
|
||||
in
|
||||
Rose root (shrink1 +++ shrink2 +++ shrink3 +++ shrink4)
|
||||
|
||||
|
||||
map5RoseTree : (a -> b -> c -> d -> e -> f) -> RoseTree a -> RoseTree b -> RoseTree c -> RoseTree d -> RoseTree e -> RoseTree f
|
||||
map5RoseTree transform ((Rose root1 children1) as rose1) ((Rose root2 children2) as rose2) ((Rose root3 children3) as rose3) ((Rose root4 children4) as rose4) ((Rose root5 children5) as rose5) =
|
||||
let
|
||||
root =
|
||||
transform root1 root2 root3 root4 root5
|
||||
|
||||
shrink1 =
|
||||
Lazy.List.map (\childOf1 -> map5RoseTree transform childOf1 rose2 rose3 rose4 rose5) children1
|
||||
|
||||
shrink2 =
|
||||
Lazy.List.map (\childOf2 -> map5RoseTree transform rose1 childOf2 rose3 rose4 rose5) children2
|
||||
|
||||
shrink3 =
|
||||
Lazy.List.map (\childOf3 -> map5RoseTree transform rose1 rose2 childOf3 rose4 rose5) children3
|
||||
|
||||
shrink4 =
|
||||
Lazy.List.map (\childOf4 -> map5RoseTree transform rose1 rose2 rose3 childOf4 rose5) children4
|
||||
|
||||
shrink5 =
|
||||
Lazy.List.map (\childOf5 -> map5RoseTree transform rose1 rose2 rose3 rose4 childOf5) children5
|
||||
in
|
||||
Rose root (shrink1 +++ shrink2 +++ shrink3 +++ shrink4 +++ shrink5)
|
||||
109
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Fuzz/Internal.elm
vendored
Normal file
109
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Fuzz/Internal.elm
vendored
Normal file
@@ -0,0 +1,109 @@
|
||||
module Fuzz.Internal exposing (Fuzzer, Valid, ValidFuzzer, andThen, combineValid, invalidReason, map)
|
||||
|
||||
import Lazy
|
||||
import Lazy.List exposing ((:::), LazyList)
|
||||
import Random.Pcg as Random exposing (Generator)
|
||||
import RoseTree exposing (RoseTree(Rose))
|
||||
|
||||
|
||||
type alias Fuzzer a =
|
||||
Valid (ValidFuzzer a)
|
||||
|
||||
|
||||
type alias Valid a =
|
||||
Result String a
|
||||
|
||||
|
||||
type alias ValidFuzzer a =
|
||||
Generator (RoseTree a)
|
||||
|
||||
|
||||
combineValid : List (Valid a) -> Valid (List a)
|
||||
combineValid valids =
|
||||
case valids of
|
||||
[] ->
|
||||
Ok []
|
||||
|
||||
(Ok x) :: rest ->
|
||||
Result.map ((::) x) (combineValid rest)
|
||||
|
||||
(Err reason) :: _ ->
|
||||
Err reason
|
||||
|
||||
|
||||
map : (a -> b) -> Fuzzer a -> Fuzzer b
|
||||
map fn fuzzer =
|
||||
(Result.map << Random.map << RoseTree.map) fn fuzzer
|
||||
|
||||
|
||||
andThen : (a -> Fuzzer b) -> Fuzzer a -> Fuzzer b
|
||||
andThen fn fuzzer =
|
||||
let
|
||||
helper : (a -> Fuzzer b) -> RoseTree a -> ValidFuzzer b
|
||||
helper fn xs =
|
||||
RoseTree.map fn xs
|
||||
|> removeInvalid
|
||||
|> sequenceRoseTree
|
||||
|> Random.map RoseTree.flatten
|
||||
in
|
||||
Result.map (Random.andThen (helper fn)) fuzzer
|
||||
|
||||
|
||||
removeInvalid : RoseTree (Valid a) -> RoseTree a
|
||||
removeInvalid tree =
|
||||
case RoseTree.filterMap getValid tree of
|
||||
Just newTree ->
|
||||
newTree
|
||||
|
||||
Nothing ->
|
||||
Debug.crash "Returning an invalid fuzzer from `andThen` is currently unsupported"
|
||||
|
||||
|
||||
sequenceRoseTree : RoseTree (Generator a) -> Generator (RoseTree a)
|
||||
sequenceRoseTree (Rose root branches) =
|
||||
Random.map2
|
||||
Rose
|
||||
root
|
||||
(Lazy.List.map sequenceRoseTree branches |> sequenceLazyList)
|
||||
|
||||
|
||||
sequenceLazyList : LazyList (Generator a) -> Generator (LazyList a)
|
||||
sequenceLazyList xs =
|
||||
Random.independentSeed
|
||||
|> Random.map (runAll xs)
|
||||
|
||||
|
||||
runAll : LazyList (Generator a) -> Random.Seed -> LazyList a
|
||||
runAll xs seed =
|
||||
Lazy.lazy <|
|
||||
\_ ->
|
||||
case Lazy.force xs of
|
||||
Lazy.List.Nil ->
|
||||
Lazy.List.Nil
|
||||
|
||||
Lazy.List.Cons firstGenerator rest ->
|
||||
let
|
||||
( x, newSeed ) =
|
||||
Random.step firstGenerator seed
|
||||
in
|
||||
Lazy.List.Cons x (runAll rest newSeed)
|
||||
|
||||
|
||||
getValid : Valid a -> Maybe a
|
||||
getValid valid =
|
||||
case valid of
|
||||
Ok x ->
|
||||
Just x
|
||||
|
||||
Err _ ->
|
||||
Nothing
|
||||
|
||||
|
||||
invalidReason : Valid a -> Maybe String
|
||||
invalidReason valid =
|
||||
case valid of
|
||||
Ok _ ->
|
||||
Nothing
|
||||
|
||||
Err reason ->
|
||||
Just reason
|
||||
91
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/RoseTree.elm
vendored
Normal file
91
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/RoseTree.elm
vendored
Normal file
@@ -0,0 +1,91 @@
|
||||
module RoseTree exposing (..)
|
||||
|
||||
{-| RoseTree implementation in Elm using Lazy Lists.
|
||||
|
||||
This implementation is private to elm-test and has non-essential functions removed.
|
||||
If you need a complete RoseTree implementation, one can be found on elm-package.
|
||||
|
||||
-}
|
||||
|
||||
import Lazy.List as LazyList exposing ((+++), (:::), LazyList)
|
||||
|
||||
|
||||
{-| RoseTree type.
|
||||
A rosetree is a tree with a root whose children are themselves
|
||||
rosetrees.
|
||||
-}
|
||||
type RoseTree a
|
||||
= Rose a (LazyList (RoseTree a))
|
||||
|
||||
|
||||
{-| Make a singleton rosetree
|
||||
-}
|
||||
singleton : a -> RoseTree a
|
||||
singleton a =
|
||||
Rose a LazyList.empty
|
||||
|
||||
|
||||
{-| Get the root of a rosetree
|
||||
-}
|
||||
root : RoseTree a -> a
|
||||
root (Rose a _) =
|
||||
a
|
||||
|
||||
|
||||
{-| Get the children of a rosetree
|
||||
-}
|
||||
children : RoseTree a -> LazyList (RoseTree a)
|
||||
children (Rose _ c) =
|
||||
c
|
||||
|
||||
|
||||
{-| Add a child to the rosetree.
|
||||
-}
|
||||
addChild : RoseTree a -> RoseTree a -> RoseTree a
|
||||
addChild child (Rose a c) =
|
||||
Rose a (child ::: c)
|
||||
|
||||
|
||||
{-| Map a function over a rosetree
|
||||
-}
|
||||
map : (a -> b) -> RoseTree a -> RoseTree b
|
||||
map f (Rose a c) =
|
||||
Rose (f a) (LazyList.map (map f) c)
|
||||
|
||||
|
||||
filter : (a -> Bool) -> RoseTree a -> Maybe (RoseTree a)
|
||||
filter predicate tree =
|
||||
let
|
||||
maybeKeep x =
|
||||
if predicate x then
|
||||
Just x
|
||||
else
|
||||
Nothing
|
||||
in
|
||||
filterMap maybeKeep tree
|
||||
|
||||
|
||||
{-| filterMap a function over a rosetree
|
||||
-}
|
||||
filterMap : (a -> Maybe b) -> RoseTree a -> Maybe (RoseTree b)
|
||||
filterMap f (Rose a c) =
|
||||
case f a of
|
||||
Just newA ->
|
||||
Just <| Rose newA (LazyList.filterMap (filterMap f) c)
|
||||
|
||||
Nothing ->
|
||||
Nothing
|
||||
|
||||
|
||||
filterBranches : (a -> Bool) -> RoseTree a -> RoseTree a
|
||||
filterBranches predicate (Rose root branches) =
|
||||
Rose
|
||||
root
|
||||
(LazyList.filterMap (filter predicate) branches)
|
||||
|
||||
|
||||
{-| Flatten a rosetree of rosetrees.
|
||||
-}
|
||||
flatten : RoseTree (RoseTree a) -> RoseTree a
|
||||
flatten (Rose (Rose a c) cs) =
|
||||
Rose a (c +++ LazyList.map flatten cs)
|
||||
474
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test.elm
vendored
Normal file
474
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test.elm
vendored
Normal file
@@ -0,0 +1,474 @@
|
||||
module Test exposing (FuzzOptions, Test, concat, describe, fuzz, fuzz2, fuzz3, fuzz4, fuzz5, fuzzWith, only, skip, test, todo)
|
||||
|
||||
{-| A module containing functions for creating and managing tests.
|
||||
|
||||
@docs Test, test
|
||||
|
||||
|
||||
## Organizing Tests
|
||||
|
||||
@docs describe, concat, todo, skip, only
|
||||
|
||||
|
||||
## Fuzz Testing
|
||||
|
||||
@docs fuzz, fuzz2, fuzz3, fuzz4, fuzz5, fuzzWith, FuzzOptions
|
||||
|
||||
-}
|
||||
|
||||
import Expect exposing (Expectation)
|
||||
import Fuzz exposing (Fuzzer)
|
||||
import Set
|
||||
import Test.Fuzz
|
||||
import Test.Internal as Internal
|
||||
import Test.Runner.Failure exposing (InvalidReason(..), Reason(..))
|
||||
|
||||
|
||||
{-| A test which has yet to be evaluated. When evaluated, it produces one
|
||||
or more [`Expectation`](../Expect#Expectation)s.
|
||||
|
||||
See [`test`](#test) and [`fuzz`](#fuzz) for some ways to create a `Test`.
|
||||
|
||||
-}
|
||||
type alias Test =
|
||||
Internal.Test
|
||||
|
||||
|
||||
{-| Run each of the given tests.
|
||||
|
||||
concat [ testDecoder, testSorting ]
|
||||
|
||||
-}
|
||||
concat : List Test -> Test
|
||||
concat tests =
|
||||
if List.isEmpty tests then
|
||||
Internal.failNow
|
||||
{ description = "This `concat` has no tests in it. Let's give it some!"
|
||||
, reason = Invalid EmptyList
|
||||
}
|
||||
else
|
||||
case Internal.duplicatedName tests of
|
||||
Err duped ->
|
||||
Internal.failNow
|
||||
{ description = "A test group contains multiple tests named '" ++ duped ++ "'. Do some renaming so that tests have unique names."
|
||||
, reason = Invalid DuplicatedName
|
||||
}
|
||||
|
||||
Ok _ ->
|
||||
Internal.Batch tests
|
||||
|
||||
|
||||
{-| Apply a description to a list of tests.
|
||||
|
||||
import Test exposing (describe, test, fuzz)
|
||||
import Fuzz exposing (int)
|
||||
import Expect
|
||||
|
||||
|
||||
describe "List"
|
||||
[ describe "reverse"
|
||||
[ test "has no effect on an empty list" <|
|
||||
\_ ->
|
||||
List.reverse []
|
||||
|> Expect.equal []
|
||||
, fuzz int "has no effect on a one-item list" <|
|
||||
\num ->
|
||||
List.reverse [ num ]
|
||||
|> Expect.equal [ num ]
|
||||
]
|
||||
]
|
||||
|
||||
Passing an empty list will result in a failing test, because you either made a
|
||||
mistake or are creating a placeholder.
|
||||
|
||||
-}
|
||||
describe : String -> List Test -> Test
|
||||
describe untrimmedDesc tests =
|
||||
let
|
||||
desc =
|
||||
String.trim untrimmedDesc
|
||||
in
|
||||
if String.isEmpty desc then
|
||||
Internal.failNow
|
||||
{ description = "This `describe` has a blank description. Let's give it a useful one!"
|
||||
, reason = Invalid BadDescription
|
||||
}
|
||||
else if List.isEmpty tests then
|
||||
Internal.failNow
|
||||
{ description = "This `describe " ++ toString desc ++ "` has no tests in it. Let's give it some!"
|
||||
, reason = Invalid EmptyList
|
||||
}
|
||||
else
|
||||
case Internal.duplicatedName tests of
|
||||
Err duped ->
|
||||
Internal.failNow
|
||||
{ description = "The tests '" ++ desc ++ "' contain multiple tests named '" ++ duped ++ "'. Let's rename them so we know which is which."
|
||||
, reason = Invalid DuplicatedName
|
||||
}
|
||||
|
||||
Ok childrenNames ->
|
||||
if Set.member desc childrenNames then
|
||||
Internal.failNow
|
||||
{ description = "The test '" ++ desc ++ "' contains a child test of the same name. Let's rename them so we know which is which."
|
||||
, reason = Invalid DuplicatedName
|
||||
}
|
||||
else
|
||||
Internal.Labeled desc (Internal.Batch tests)
|
||||
|
||||
|
||||
{-| Return a [`Test`](#Test) that evaluates a single
|
||||
[`Expectation`](../Expect#Expectation).
|
||||
|
||||
import Test exposing (fuzz)
|
||||
import Expect
|
||||
|
||||
|
||||
test "the empty list has 0 length" <|
|
||||
\_ ->
|
||||
List.length []
|
||||
|> Expect.equal 0
|
||||
|
||||
-}
|
||||
test : String -> (() -> Expectation) -> Test
|
||||
test untrimmedDesc thunk =
|
||||
let
|
||||
desc =
|
||||
String.trim untrimmedDesc
|
||||
in
|
||||
if String.isEmpty desc then
|
||||
Internal.blankDescriptionFailure
|
||||
else
|
||||
Internal.Labeled desc (Internal.UnitTest (\() -> [ thunk () ]))
|
||||
|
||||
|
||||
{-| Returns a [`Test`](#Test) that is "TODO" (not yet implemented). These tests
|
||||
always fail, but test runners will only include them in their output if there
|
||||
are no other failures.
|
||||
|
||||
These tests aren't meant to be committed to version control. Instead, use them
|
||||
when you're brainstorming lots of tests you'd like to write, but you can't
|
||||
implement them all at once. When you replace `todo` with a real test, you'll be
|
||||
able to see if it fails without clutter from tests still not implemented. But,
|
||||
unlike leaving yourself comments, you'll be prompted to implement these tests
|
||||
because your suite will fail.
|
||||
|
||||
describe "a new thing"
|
||||
[ todo "does what is expected in the common case"
|
||||
, todo "correctly handles an edge case I just thought of"
|
||||
]
|
||||
|
||||
This functionality is similar to "pending" tests in other frameworks, except
|
||||
that a TODO test is considered failing but a pending test often is not.
|
||||
|
||||
-}
|
||||
todo : String -> Test
|
||||
todo desc =
|
||||
Internal.failNow
|
||||
{ description = desc
|
||||
, reason = TODO
|
||||
}
|
||||
|
||||
|
||||
{-| Returns a [`Test`](#Test) that causes other tests to be skipped, and
|
||||
only runs the given one.
|
||||
|
||||
Calls to `only` aren't meant to be committed to version control. Instead, use
|
||||
them when you want to focus on getting a particular subset of your tests to pass.
|
||||
If you use `only`, your entire test suite will fail, even if
|
||||
each of the individual tests pass. This is to help avoid accidentally
|
||||
committing a `only` to version control.
|
||||
|
||||
If you you use `only` on multiple tests, only those tests will run. If you
|
||||
put a `only` inside another `only`, only the outermost `only`
|
||||
will affect which tests gets run.
|
||||
|
||||
See also [`skip`](#skip). Note that `skip` takes precedence over `only`;
|
||||
if you use a `skip` inside an `only`, it will still get skipped, and if you use
|
||||
an `only` inside a `skip`, it will also get skipped.
|
||||
|
||||
describe "List"
|
||||
[ only <| describe "reverse"
|
||||
[ test "has no effect on an empty list" <|
|
||||
\_ ->
|
||||
List.reverse []
|
||||
|> Expect.equal []
|
||||
, fuzz int "has no effect on a one-item list" <|
|
||||
\num ->
|
||||
List.reverse [ num ]
|
||||
|> Expect.equal [ num ]
|
||||
]
|
||||
, test "This will not get run, because of the `only` above!" <|
|
||||
\_ ->
|
||||
List.length []
|
||||
|> Expect.equal 0
|
||||
]
|
||||
|
||||
-}
|
||||
only : Test -> Test
|
||||
only =
|
||||
Internal.Only
|
||||
|
||||
|
||||
{-| Returns a [`Test`](#Test) that gets skipped.
|
||||
|
||||
Calls to `skip` aren't meant to be committed to version control. Instead, use
|
||||
it when you want to focus on getting a particular subset of your tests to
|
||||
pass. If you use `skip`, your entire test suite will fail, even if
|
||||
each of the individual tests pass. This is to help avoid accidentally
|
||||
committing a `skip` to version control.
|
||||
|
||||
See also [`only`](#only). Note that `skip` takes precedence over `only`;
|
||||
if you use a `skip` inside an `only`, it will still get skipped, and if you use
|
||||
an `only` inside a `skip`, it will also get skipped.
|
||||
|
||||
describe "List"
|
||||
[ skip <| describe "reverse"
|
||||
[ test "has no effect on an empty list" <|
|
||||
\_ ->
|
||||
List.reverse []
|
||||
|> Expect.equal []
|
||||
, fuzz int "has no effect on a one-item list" <|
|
||||
\num ->
|
||||
List.reverse [ num ]
|
||||
|> Expect.equal [ num ]
|
||||
]
|
||||
, test "This is the only test that will get run; the other was skipped!" <|
|
||||
\_ ->
|
||||
List.length []
|
||||
|> Expect.equal 0
|
||||
]
|
||||
|
||||
-}
|
||||
skip : Test -> Test
|
||||
skip =
|
||||
Internal.Skipped
|
||||
|
||||
|
||||
{-| Options [`fuzzWith`](#fuzzWith) accepts. Currently there is only one but this
|
||||
API is designed so that it can accept more in the future.
|
||||
|
||||
|
||||
### `runs`
|
||||
|
||||
The number of times to run each fuzz test. (Default is 100.)
|
||||
|
||||
import Test exposing (fuzzWith)
|
||||
import Fuzz exposing (list, int)
|
||||
import Expect
|
||||
|
||||
|
||||
fuzzWith { runs = 350 } (list int) "List.length should always be positive" <|
|
||||
-- This anonymous function will be run 350 times, each time with a
|
||||
-- randomly-generated fuzzList value. (It will always be a list of ints
|
||||
-- because of (list int) above.)
|
||||
\fuzzList ->
|
||||
fuzzList
|
||||
|> List.length
|
||||
|> Expect.atLeast 0
|
||||
|
||||
-}
|
||||
type alias FuzzOptions =
|
||||
{ runs : Int }
|
||||
|
||||
|
||||
{-| Run a [`fuzz`](#fuzz) test with the given [`FuzzOptions`](#FuzzOptions).
|
||||
|
||||
Note that there is no `fuzzWith2`, but you can always pass more fuzz values in
|
||||
using [`Fuzz.tuple`](Fuzz#tuple), [`Fuzz.tuple3`](Fuzz#tuple3),
|
||||
for example like this:
|
||||
|
||||
import Test exposing (fuzzWith)
|
||||
import Fuzz exposing (tuple, list, int)
|
||||
import Expect
|
||||
|
||||
|
||||
fuzzWith { runs = 4200 }
|
||||
(tuple ( list int, int ))
|
||||
"List.reverse never influences List.member" <|
|
||||
\(nums, target) ->
|
||||
List.member target (List.reverse nums)
|
||||
|> Expect.equal (List.member target nums)
|
||||
|
||||
-}
|
||||
fuzzWith : FuzzOptions -> Fuzzer a -> String -> (a -> Expectation) -> Test
|
||||
fuzzWith options fuzzer desc getTest =
|
||||
if options.runs < 1 then
|
||||
Internal.failNow
|
||||
{ description = "Fuzz tests must have a run count of at least 1, not " ++ toString options.runs ++ "."
|
||||
, reason = Invalid NonpositiveFuzzCount
|
||||
}
|
||||
else
|
||||
fuzzWithHelp options (fuzz fuzzer desc getTest)
|
||||
|
||||
|
||||
fuzzWithHelp : FuzzOptions -> Test -> Test
|
||||
fuzzWithHelp options test =
|
||||
case test of
|
||||
Internal.UnitTest _ ->
|
||||
test
|
||||
|
||||
Internal.FuzzTest run ->
|
||||
Internal.FuzzTest (\seed _ -> run seed options.runs)
|
||||
|
||||
Internal.Labeled label subTest ->
|
||||
Internal.Labeled label (fuzzWithHelp options subTest)
|
||||
|
||||
Internal.Skipped subTest ->
|
||||
-- It's important to treat skipped tests exactly the same as normal,
|
||||
-- until after seed distribution has completed.
|
||||
fuzzWithHelp options subTest
|
||||
|> Internal.Only
|
||||
|
||||
Internal.Only subTest ->
|
||||
fuzzWithHelp options subTest
|
||||
|> Internal.Only
|
||||
|
||||
Internal.Batch tests ->
|
||||
tests
|
||||
|> List.map (fuzzWithHelp options)
|
||||
|> Internal.Batch
|
||||
|
||||
|
||||
{-| Take a function that produces a test, and calls it several (usually 100) times, using a randomly-generated input
|
||||
from a [`Fuzzer`](http://package.elm-lang.org/packages/elm-community/elm-test/latest/Fuzz) each time. This allows you to
|
||||
test that a property that should always be true is indeed true under a wide variety of conditions. The function also
|
||||
takes a string describing the test.
|
||||
|
||||
These are called "[fuzz tests](https://en.wikipedia.org/wiki/Fuzz_testing)" because of the randomness.
|
||||
You may find them elsewhere called [property-based tests](http://blog.jessitron.com/2013/04/property-based-testing-what-is-it.html),
|
||||
[generative tests](http://www.pivotaltracker.com/community/tracker-blog/generative-testing), or
|
||||
[QuickCheck-style tests](https://en.wikipedia.org/wiki/QuickCheck).
|
||||
|
||||
import Test exposing (fuzz)
|
||||
import Fuzz exposing (list, int)
|
||||
import Expect
|
||||
|
||||
|
||||
fuzz (list int) "List.length should always be positive" <|
|
||||
-- This anonymous function will be run 100 times, each time with a
|
||||
-- randomly-generated fuzzList value.
|
||||
\fuzzList ->
|
||||
fuzzList
|
||||
|> List.length
|
||||
|> Expect.atLeast 0
|
||||
|
||||
-}
|
||||
fuzz :
|
||||
Fuzzer a
|
||||
-> String
|
||||
-> (a -> Expectation)
|
||||
-> Test
|
||||
fuzz =
|
||||
Test.Fuzz.fuzzTest
|
||||
|
||||
|
||||
{-| Run a [fuzz test](#fuzz) using two random inputs.
|
||||
|
||||
This is a convenience function that lets you skip calling [`Fuzz.tuple`](Fuzz#tuple).
|
||||
|
||||
See [`fuzzWith`](#fuzzWith) for an example of writing this in tuple style.
|
||||
|
||||
import Test exposing (fuzz2)
|
||||
import Fuzz exposing (list, int)
|
||||
|
||||
|
||||
fuzz2 (list int) int "List.reverse never influences List.member" <|
|
||||
\nums target ->
|
||||
List.member target (List.reverse nums)
|
||||
|> Expect.equal (List.member target nums)
|
||||
|
||||
-}
|
||||
fuzz2 :
|
||||
Fuzzer a
|
||||
-> Fuzzer b
|
||||
-> String
|
||||
-> (a -> b -> Expectation)
|
||||
-> Test
|
||||
fuzz2 fuzzA fuzzB desc =
|
||||
let
|
||||
fuzzer =
|
||||
Fuzz.tuple ( fuzzA, fuzzB )
|
||||
in
|
||||
uncurry >> fuzz fuzzer desc
|
||||
|
||||
|
||||
{-| Run a [fuzz test](#fuzz) using three random inputs.
|
||||
|
||||
This is a convenience function that lets you skip calling [`Fuzz.tuple3`](Fuzz#tuple3).
|
||||
|
||||
-}
|
||||
fuzz3 :
|
||||
Fuzzer a
|
||||
-> Fuzzer b
|
||||
-> Fuzzer c
|
||||
-> String
|
||||
-> (a -> b -> c -> Expectation)
|
||||
-> Test
|
||||
fuzz3 fuzzA fuzzB fuzzC desc =
|
||||
let
|
||||
fuzzer =
|
||||
Fuzz.tuple3 ( fuzzA, fuzzB, fuzzC )
|
||||
in
|
||||
uncurry3 >> fuzz fuzzer desc
|
||||
|
||||
|
||||
{-| Run a [fuzz test](#fuzz) using four random inputs.
|
||||
|
||||
This is a convenience function that lets you skip calling [`Fuzz.tuple4`](Fuzz#tuple4).
|
||||
|
||||
-}
|
||||
fuzz4 :
|
||||
Fuzzer a
|
||||
-> Fuzzer b
|
||||
-> Fuzzer c
|
||||
-> Fuzzer d
|
||||
-> String
|
||||
-> (a -> b -> c -> d -> Expectation)
|
||||
-> Test
|
||||
fuzz4 fuzzA fuzzB fuzzC fuzzD desc =
|
||||
let
|
||||
fuzzer =
|
||||
Fuzz.tuple4 ( fuzzA, fuzzB, fuzzC, fuzzD )
|
||||
in
|
||||
uncurry4 >> fuzz fuzzer desc
|
||||
|
||||
|
||||
{-| Run a [fuzz test](#fuzz) using five random inputs.
|
||||
|
||||
This is a convenience function that lets you skip calling [`Fuzz.tuple5`](Fuzz#tuple5).
|
||||
|
||||
-}
|
||||
fuzz5 :
|
||||
Fuzzer a
|
||||
-> Fuzzer b
|
||||
-> Fuzzer c
|
||||
-> Fuzzer d
|
||||
-> Fuzzer e
|
||||
-> String
|
||||
-> (a -> b -> c -> d -> e -> Expectation)
|
||||
-> Test
|
||||
fuzz5 fuzzA fuzzB fuzzC fuzzD fuzzE desc =
|
||||
let
|
||||
fuzzer =
|
||||
Fuzz.tuple5 ( fuzzA, fuzzB, fuzzC, fuzzD, fuzzE )
|
||||
in
|
||||
uncurry5 >> fuzz fuzzer desc
|
||||
|
||||
|
||||
|
||||
-- INTERNAL HELPERS --
|
||||
|
||||
|
||||
uncurry3 : (a -> b -> c -> d) -> ( a, b, c ) -> d
|
||||
uncurry3 fn ( a, b, c ) =
|
||||
fn a b c
|
||||
|
||||
|
||||
uncurry4 : (a -> b -> c -> d -> e) -> ( a, b, c, d ) -> e
|
||||
uncurry4 fn ( a, b, c, d ) =
|
||||
fn a b c d
|
||||
|
||||
|
||||
uncurry5 : (a -> b -> c -> d -> e -> f) -> ( a, b, c, d, e ) -> f
|
||||
uncurry5 fn ( a, b, c, d, e ) =
|
||||
fn a b c d e
|
||||
@@ -0,0 +1,27 @@
|
||||
module Test.Expectation exposing (Expectation(..), fail, withGiven)
|
||||
|
||||
import Test.Runner.Failure exposing (Reason)
|
||||
|
||||
|
||||
type Expectation
|
||||
= Pass
|
||||
| Fail { given : Maybe String, description : String, reason : Reason }
|
||||
|
||||
|
||||
{-| Create a failure without specifying the given.
|
||||
-}
|
||||
fail : { description : String, reason : Reason } -> Expectation
|
||||
fail { description, reason } =
|
||||
Fail { given = Nothing, description = description, reason = reason }
|
||||
|
||||
|
||||
{-| Set the given (fuzz test input) of an expectation.
|
||||
-}
|
||||
withGiven : String -> Expectation -> Expectation
|
||||
withGiven newGiven expectation =
|
||||
case expectation of
|
||||
Fail failure ->
|
||||
Fail { failure | given = Just newGiven }
|
||||
|
||||
Pass ->
|
||||
expectation
|
||||
164
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test/Fuzz.elm
vendored
Normal file
164
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test/Fuzz.elm
vendored
Normal file
@@ -0,0 +1,164 @@
|
||||
module Test.Fuzz exposing (fuzzTest)
|
||||
|
||||
import Dict exposing (Dict)
|
||||
import Fuzz exposing (Fuzzer)
|
||||
import Fuzz.Internal exposing (ValidFuzzer)
|
||||
import Lazy.List
|
||||
import Random.Pcg as Random exposing (Generator)
|
||||
import RoseTree exposing (RoseTree(..))
|
||||
import Test.Expectation exposing (Expectation(..))
|
||||
import Test.Internal exposing (Test(..), blankDescriptionFailure, failNow)
|
||||
import Test.Runner.Failure exposing (InvalidReason(..), Reason(..))
|
||||
|
||||
|
||||
{-| Reject always-failing tests because of bad names or invalid fuzzers.
|
||||
-}
|
||||
fuzzTest : Fuzzer a -> String -> (a -> Expectation) -> Test
|
||||
fuzzTest fuzzer untrimmedDesc getExpectation =
|
||||
let
|
||||
desc =
|
||||
String.trim untrimmedDesc
|
||||
in
|
||||
if String.isEmpty desc then
|
||||
blankDescriptionFailure
|
||||
else
|
||||
case fuzzer of
|
||||
Err reason ->
|
||||
failNow
|
||||
{ description = reason
|
||||
, reason = Invalid InvalidFuzzer
|
||||
}
|
||||
|
||||
Ok validFuzzer ->
|
||||
-- Preliminary checks passed; run the fuzz test
|
||||
validatedFuzzTest validFuzzer desc getExpectation
|
||||
|
||||
|
||||
{-| Knowing that the fuzz test isn't obviously invalid, run the test and package up the results.
|
||||
-}
|
||||
validatedFuzzTest : ValidFuzzer a -> String -> (a -> Expectation) -> Test
|
||||
validatedFuzzTest fuzzer desc getExpectation =
|
||||
let
|
||||
run seed runs =
|
||||
let
|
||||
failures =
|
||||
getFailures fuzzer getExpectation seed runs
|
||||
in
|
||||
-- Make sure if we passed, we don't do any more work.
|
||||
if Dict.isEmpty failures then
|
||||
[ Pass ]
|
||||
else
|
||||
failures
|
||||
|> Dict.toList
|
||||
|> List.map formatExpectation
|
||||
in
|
||||
Labeled desc (FuzzTest run)
|
||||
|
||||
|
||||
type alias Failures =
|
||||
Dict String Expectation
|
||||
|
||||
|
||||
getFailures : ValidFuzzer a -> (a -> Expectation) -> Random.Seed -> Int -> Dict String Expectation
|
||||
getFailures fuzzer getExpectation initialSeed totalRuns =
|
||||
{- Fuzz test algorithm with memoization and opt-in RoseTrees:
|
||||
Generate a single value from the fuzzer's genVal random generator
|
||||
Determine if the value is memoized. If so, skip. Otherwise continue.
|
||||
Run the test on that value. If it fails:
|
||||
Generate the rosetree by passing the fuzzer False *and the same random seed*
|
||||
Find the new failure by looking at the children for any shrunken values:
|
||||
If a shrunken value causes a failure, recurse on its children
|
||||
If no shrunken value replicates the failure, use the root
|
||||
Whether it passes or fails, do this n times
|
||||
-}
|
||||
let
|
||||
genVal =
|
||||
Random.map RoseTree.root fuzzer
|
||||
|
||||
initialFailures =
|
||||
Dict.empty
|
||||
|
||||
helper currentSeed remainingRuns failures =
|
||||
let
|
||||
( value, nextSeed ) =
|
||||
Random.step genVal currentSeed
|
||||
|
||||
newFailures =
|
||||
findNewFailure fuzzer getExpectation failures currentSeed value
|
||||
in
|
||||
if remainingRuns <= 1 then
|
||||
newFailures
|
||||
else
|
||||
helper nextSeed (remainingRuns - 1) newFailures
|
||||
in
|
||||
helper initialSeed totalRuns initialFailures
|
||||
|
||||
|
||||
{-| Knowing that a value in not in the cache, determine if it causes the test to pass or fail.
|
||||
-}
|
||||
findNewFailure :
|
||||
ValidFuzzer a
|
||||
-> (a -> Expectation)
|
||||
-> Failures
|
||||
-> Random.Seed
|
||||
-> a
|
||||
-> Failures
|
||||
findNewFailure fuzzer getExpectation failures currentSeed value =
|
||||
case getExpectation value of
|
||||
Pass ->
|
||||
failures
|
||||
|
||||
failedExpectation ->
|
||||
let
|
||||
( rosetree, nextSeed ) =
|
||||
-- nextSeed is not used here because caller function has currentSeed
|
||||
Random.step fuzzer currentSeed
|
||||
in
|
||||
shrinkAndAdd rosetree getExpectation failedExpectation failures
|
||||
|
||||
|
||||
{-| Knowing that the rosetree's root already failed, finds the shrunken failure.
|
||||
Returns the updated failures dictionary.
|
||||
-}
|
||||
shrinkAndAdd :
|
||||
RoseTree a
|
||||
-> (a -> Expectation)
|
||||
-> Expectation
|
||||
-> Failures
|
||||
-> Failures
|
||||
shrinkAndAdd rootTree getExpectation rootsExpectation failures =
|
||||
let
|
||||
shrink : Expectation -> RoseTree a -> ( a, Expectation )
|
||||
shrink oldExpectation (Rose failingValue branches) =
|
||||
case Lazy.List.headAndTail branches of
|
||||
Just ( (Rose possiblyFailingValue _) as rosetree, moreLazyRoseTrees ) ->
|
||||
-- either way, recurse with the most recent failing expectation, and failing input with its list of shrunken values
|
||||
case getExpectation possiblyFailingValue of
|
||||
Pass ->
|
||||
shrink oldExpectation
|
||||
(Rose failingValue moreLazyRoseTrees)
|
||||
|
||||
newExpectation ->
|
||||
let
|
||||
( minimalValue, finalExpectation ) =
|
||||
shrink newExpectation rosetree
|
||||
in
|
||||
( minimalValue
|
||||
, finalExpectation
|
||||
)
|
||||
|
||||
Nothing ->
|
||||
( failingValue, oldExpectation )
|
||||
|
||||
(Rose failingValue _) =
|
||||
rootTree
|
||||
|
||||
( minimalValue, finalExpectation ) =
|
||||
shrink rootsExpectation rootTree
|
||||
in
|
||||
Dict.insert (toString minimalValue) finalExpectation failures
|
||||
|
||||
|
||||
formatExpectation : ( String, Expectation ) -> Expectation
|
||||
formatExpectation ( given, expectation ) =
|
||||
Test.Expectation.withGiven given expectation
|
||||
69
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test/Internal.elm
vendored
Normal file
69
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test/Internal.elm
vendored
Normal file
@@ -0,0 +1,69 @@
|
||||
module Test.Internal exposing (Test(..), blankDescriptionFailure, duplicatedName, failNow)
|
||||
|
||||
import Random.Pcg as Random exposing (Generator)
|
||||
import Set exposing (Set)
|
||||
import Test.Expectation exposing (Expectation(..))
|
||||
import Test.Runner.Failure exposing (InvalidReason(..), Reason(..))
|
||||
|
||||
|
||||
type Test
|
||||
= UnitTest (() -> List Expectation)
|
||||
| FuzzTest (Random.Seed -> Int -> List Expectation)
|
||||
| Labeled String Test
|
||||
| Skipped Test
|
||||
| Only Test
|
||||
| Batch (List Test)
|
||||
|
||||
|
||||
{-| Create a test that always fails for the given reason and description.
|
||||
-}
|
||||
failNow : { description : String, reason : Reason } -> Test
|
||||
failNow record =
|
||||
UnitTest
|
||||
(\() -> [ Test.Expectation.fail record ])
|
||||
|
||||
|
||||
blankDescriptionFailure : Test
|
||||
blankDescriptionFailure =
|
||||
failNow
|
||||
{ description = "This test has a blank description. Let's give it a useful one!"
|
||||
, reason = Invalid BadDescription
|
||||
}
|
||||
|
||||
|
||||
duplicatedName : List Test -> Result String (Set String)
|
||||
duplicatedName =
|
||||
let
|
||||
names : Test -> List String
|
||||
names test =
|
||||
case test of
|
||||
Labeled str _ ->
|
||||
[ str ]
|
||||
|
||||
Batch subtests ->
|
||||
List.concatMap names subtests
|
||||
|
||||
UnitTest _ ->
|
||||
[]
|
||||
|
||||
FuzzTest _ ->
|
||||
[]
|
||||
|
||||
Skipped subTest ->
|
||||
names subTest
|
||||
|
||||
Only subTest ->
|
||||
names subTest
|
||||
|
||||
insertOrFail : String -> Result String (Set String) -> Result String (Set String)
|
||||
insertOrFail newName =
|
||||
Result.andThen
|
||||
(\oldNames ->
|
||||
if Set.member newName oldNames then
|
||||
Err newName
|
||||
else
|
||||
Ok <| Set.insert newName oldNames
|
||||
)
|
||||
in
|
||||
List.concatMap names
|
||||
>> List.foldl insertOrFail (Ok Set.empty)
|
||||
532
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test/Runner.elm
vendored
Normal file
532
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test/Runner.elm
vendored
Normal file
@@ -0,0 +1,532 @@
|
||||
module Test.Runner
|
||||
exposing
|
||||
( Runner
|
||||
, SeededRunners(..)
|
||||
, Shrinkable
|
||||
, formatLabels
|
||||
, fromTest
|
||||
, fuzz
|
||||
, getFailure
|
||||
, getFailureReason
|
||||
, isTodo
|
||||
, shrink
|
||||
)
|
||||
|
||||
{-| This is an "experts only" module that exposes functions needed to run and
|
||||
display tests. A typical user will use an existing runner library for Node or
|
||||
the browser, which is implemented using this interface. A list of these runners
|
||||
can be found in the `README`.
|
||||
|
||||
|
||||
## Runner
|
||||
|
||||
@docs Runner, SeededRunners, fromTest
|
||||
|
||||
|
||||
## Expectations
|
||||
|
||||
@docs getFailure, getFailureReason, isTodo
|
||||
|
||||
|
||||
## Formatting
|
||||
|
||||
@docs formatLabels
|
||||
|
||||
|
||||
## Fuzzers
|
||||
|
||||
These functions give you the ability to run fuzzers separate of running fuzz tests.
|
||||
|
||||
@docs Shrinkable, fuzz, shrink
|
||||
|
||||
-}
|
||||
|
||||
import Bitwise
|
||||
import Char
|
||||
import Expect exposing (Expectation)
|
||||
import Fuzz exposing (Fuzzer)
|
||||
import Lazy.List as LazyList exposing (LazyList)
|
||||
import Random.Pcg as Random
|
||||
import RoseTree exposing (RoseTree(Rose))
|
||||
import String
|
||||
import Test exposing (Test)
|
||||
import Test.Expectation
|
||||
import Test.Internal as Internal
|
||||
import Test.Runner.Failure exposing (Reason(..))
|
||||
|
||||
|
||||
{-| An unevaluated test. Run it with [`run`](#run) to evaluate it into a
|
||||
list of `Expectation`s.
|
||||
-}
|
||||
type Runnable
|
||||
= Thunk (() -> List Expectation)
|
||||
|
||||
|
||||
{-| A function which, when evaluated, produces a list of expectations. Also a
|
||||
list of labels which apply to this outcome.
|
||||
-}
|
||||
type alias Runner =
|
||||
{ run : () -> List Expectation
|
||||
, labels : List String
|
||||
}
|
||||
|
||||
|
||||
{-| A structured test runner, incorporating:
|
||||
|
||||
- The expectations to run
|
||||
- The hierarchy of description strings that describe the results
|
||||
|
||||
-}
|
||||
type RunnableTree
|
||||
= Runnable Runnable
|
||||
| Labeled String RunnableTree
|
||||
| Batch (List RunnableTree)
|
||||
|
||||
|
||||
{-| Convert a `Test` into `SeededRunners`.
|
||||
|
||||
In order to run any fuzz tests that the `Test` may have, it requires a default run count as well
|
||||
as an initial `Random.Seed`. `100` is a good run count. To obtain a good random seed, pass a
|
||||
random 32-bit integer to `Random.initialSeed`. You can obtain such an integer by running
|
||||
`Math.floor(Math.random()*0xFFFFFFFF)` in Node. It's typically fine to hard-code this value into
|
||||
your Elm code; it's easy and makes your tests reproducible.
|
||||
|
||||
-}
|
||||
fromTest : Int -> Random.Seed -> Test -> SeededRunners
|
||||
fromTest runs seed test =
|
||||
if runs < 1 then
|
||||
Invalid ("Test runner run count must be at least 1, not " ++ toString runs)
|
||||
else
|
||||
let
|
||||
distribution =
|
||||
distributeSeeds runs seed test
|
||||
in
|
||||
if List.isEmpty distribution.only then
|
||||
if countAllRunnables distribution.skipped == 0 then
|
||||
distribution.all
|
||||
|> List.concatMap fromRunnableTree
|
||||
|> Plain
|
||||
else
|
||||
distribution.all
|
||||
|> List.concatMap fromRunnableTree
|
||||
|> Skipping
|
||||
else
|
||||
distribution.only
|
||||
|> List.concatMap fromRunnableTree
|
||||
|> Only
|
||||
|
||||
|
||||
countAllRunnables : List RunnableTree -> Int
|
||||
countAllRunnables =
|
||||
List.foldl (countRunnables >> (+)) 0
|
||||
|
||||
|
||||
countRunnables : RunnableTree -> Int
|
||||
countRunnables runnable =
|
||||
case runnable of
|
||||
Runnable _ ->
|
||||
1
|
||||
|
||||
Labeled _ runner ->
|
||||
countRunnables runner
|
||||
|
||||
Batch runners ->
|
||||
countAllRunnables runners
|
||||
|
||||
|
||||
run : Runnable -> List Expectation
|
||||
run (Thunk fn) =
|
||||
fn ()
|
||||
|
||||
|
||||
fromRunnableTree : RunnableTree -> List Runner
|
||||
fromRunnableTree =
|
||||
fromRunnableTreeHelp []
|
||||
|
||||
|
||||
fromRunnableTreeHelp : List String -> RunnableTree -> List Runner
|
||||
fromRunnableTreeHelp labels runner =
|
||||
case runner of
|
||||
Runnable runnable ->
|
||||
[ { labels = labels
|
||||
, run = \_ -> run runnable
|
||||
}
|
||||
]
|
||||
|
||||
Labeled label subRunner ->
|
||||
fromRunnableTreeHelp (label :: labels) subRunner
|
||||
|
||||
Batch runners ->
|
||||
List.concatMap (fromRunnableTreeHelp labels) runners
|
||||
|
||||
|
||||
type alias Distribution =
|
||||
{ seed : Random.Seed
|
||||
, only : List RunnableTree
|
||||
, all : List RunnableTree
|
||||
, skipped : List RunnableTree
|
||||
}
|
||||
|
||||
|
||||
{-| Test Runners which have had seeds distributed to them, and which are now
|
||||
either invalid or are ready to run. Seeded runners include some metadata:
|
||||
|
||||
- `Invalid` runners had a problem (e.g. two sibling tests had the same description) making them un-runnable.
|
||||
- `Only` runners can be run, but `Test.only` was used somewhere, so ultimately they will lead to a failed test run even if each test that gets run passes.
|
||||
- `Skipping` runners can be run, but `Test.skip` was used somewhere, so ultimately they will lead to a failed test run even if each test that gets run passes.
|
||||
- `Plain` runners are ready to run, and have none of these issues.
|
||||
|
||||
-}
|
||||
type SeededRunners
|
||||
= Plain (List Runner)
|
||||
| Only (List Runner)
|
||||
| Skipping (List Runner)
|
||||
| Invalid String
|
||||
|
||||
|
||||
emptyDistribution : Random.Seed -> Distribution
|
||||
emptyDistribution seed =
|
||||
{ seed = seed
|
||||
, all = []
|
||||
, only = []
|
||||
, skipped = []
|
||||
}
|
||||
|
||||
|
||||
{-| This breaks down a test into individual Runners, while assigning different
|
||||
random number seeds to them. Along the way it also does a few other things:
|
||||
|
||||
1. Collect any tests created with `Test.only` so later we can run only those.
|
||||
2. Collect any tests created with `Test.todo` so later we can fail the run.
|
||||
3. Validate that the run count is at least 1.
|
||||
|
||||
Some design notes:
|
||||
|
||||
1. `only` tests and `skip` tests do not affect seed distribution. This is
|
||||
important for the case where a user runs tests, sees one failure, and decides
|
||||
to isolate it by using both `only` and providing the same seed as before. If
|
||||
`only` changes seed distribution, then that test result might not reproduce!
|
||||
This would be very frustrating, as it would mean you could reproduce the
|
||||
failure when not using `only`, but it magically disappeared as soon as you
|
||||
tried to isolate it. The same logic applies to `skip`.
|
||||
|
||||
2. Theoretically this could become tail-recursive. However, the Labeled and Batch
|
||||
cases would presumably become very gnarly, and it's unclear whether there would
|
||||
be a performance benefit or penalty in the end. If some brave soul wants to
|
||||
attempt it for kicks, beware that this is not a performance optimization for
|
||||
the faint of heart. Practically speaking, it seems unlikely to be worthwhile
|
||||
unless somehow people start seeing stack overflows during seed distribution -
|
||||
which would presumably require some absurdly deeply nested `describe` calls.
|
||||
|
||||
-}
|
||||
distributeSeeds : Int -> Random.Seed -> Test -> Distribution
|
||||
distributeSeeds =
|
||||
distributeSeedsHelp False
|
||||
|
||||
|
||||
distributeSeedsHelp : Bool -> Int -> Random.Seed -> Test -> Distribution
|
||||
distributeSeedsHelp hashed runs seed test =
|
||||
case test of
|
||||
Internal.UnitTest run ->
|
||||
{ seed = seed
|
||||
, all = [ Runnable (Thunk (\_ -> run ())) ]
|
||||
, only = []
|
||||
, skipped = []
|
||||
}
|
||||
|
||||
Internal.FuzzTest run ->
|
||||
let
|
||||
( firstSeed, nextSeed ) =
|
||||
Random.step Random.independentSeed seed
|
||||
in
|
||||
{ seed = nextSeed
|
||||
, all = [ Runnable (Thunk (\_ -> run firstSeed runs)) ]
|
||||
, only = []
|
||||
, skipped = []
|
||||
}
|
||||
|
||||
Internal.Labeled description subTest ->
|
||||
-- This fixes https://github.com/elm-community/elm-test/issues/192
|
||||
-- The first time we hit a Labeled, we want to use the hash of
|
||||
-- that label, along with the original seed, as our starting
|
||||
-- point for distribution. Repeating this process more than
|
||||
-- once would be a waste.
|
||||
if hashed then
|
||||
let
|
||||
next =
|
||||
distributeSeedsHelp True runs seed subTest
|
||||
in
|
||||
{ seed = next.seed
|
||||
, all = List.map (Labeled description) next.all
|
||||
, only = List.map (Labeled description) next.only
|
||||
, skipped = List.map (Labeled description) next.skipped
|
||||
}
|
||||
else
|
||||
let
|
||||
intFromSeed =
|
||||
-- At this point, this seed will be the original
|
||||
-- one passed into distributeSeeds. We know this
|
||||
-- because the only other branch that does a
|
||||
-- Random.step on that seed is the Internal.Test
|
||||
-- branch, and you can't have a Labeled inside a
|
||||
-- Test, so that couldn't have come up yet.
|
||||
seed
|
||||
-- Convert the Seed back to an Int
|
||||
|> Random.step (Random.int 0 Random.maxInt)
|
||||
|> Tuple.first
|
||||
|
||||
hashedSeed =
|
||||
description
|
||||
-- Hash from String to Int
|
||||
|> fnvHashString fnvInit
|
||||
-- Incorporate the originally passed-in seed
|
||||
|> fnvHash intFromSeed
|
||||
-- Convert Int back to Seed
|
||||
|> Random.initialSeed
|
||||
|
||||
next =
|
||||
distributeSeedsHelp True runs hashedSeed subTest
|
||||
in
|
||||
-- Using seed instead of next.seed fixes https://github.com/elm-community/elm-test/issues/192
|
||||
-- by making it so that all the tests underneath this Label begin
|
||||
-- with the hashed seed, but subsequent sibling tests in this Batch
|
||||
-- get the same seed as before.
|
||||
{ seed = seed
|
||||
, all = List.map (Labeled description) next.all
|
||||
, only = List.map (Labeled description) next.only
|
||||
, skipped = List.map (Labeled description) next.skipped
|
||||
}
|
||||
|
||||
Internal.Skipped subTest ->
|
||||
let
|
||||
-- Go through the motions in order to obtain the seed, but then
|
||||
-- move everything to skipped.
|
||||
next =
|
||||
distributeSeedsHelp hashed runs seed subTest
|
||||
in
|
||||
{ seed = next.seed
|
||||
, all = []
|
||||
, only = []
|
||||
, skipped = next.all
|
||||
}
|
||||
|
||||
Internal.Only subTest ->
|
||||
let
|
||||
next =
|
||||
distributeSeedsHelp hashed runs seed subTest
|
||||
in
|
||||
-- `only` all the things!
|
||||
{ next | only = next.all }
|
||||
|
||||
Internal.Batch tests ->
|
||||
List.foldl (batchDistribute hashed runs) (emptyDistribution seed) tests
|
||||
|
||||
|
||||
batchDistribute : Bool -> Int -> Test -> Distribution -> Distribution
|
||||
batchDistribute hashed runs test prev =
|
||||
let
|
||||
next =
|
||||
distributeSeedsHelp hashed runs prev.seed test
|
||||
in
|
||||
{ seed = next.seed
|
||||
, all = prev.all ++ next.all
|
||||
, only = prev.only ++ next.only
|
||||
, skipped = prev.skipped ++ next.skipped
|
||||
}
|
||||
|
||||
|
||||
{-| FNV-1a initial hash value
|
||||
-}
|
||||
fnvInit : Int
|
||||
fnvInit =
|
||||
2166136261
|
||||
|
||||
|
||||
{-| FNV-1a helper for strings, using Char.toCode
|
||||
-}
|
||||
fnvHashString : Int -> String -> Int
|
||||
fnvHashString hash str =
|
||||
str |> String.toList |> List.map Char.toCode |> List.foldl fnvHash hash
|
||||
|
||||
|
||||
{-| FNV-1a implementation.
|
||||
-}
|
||||
fnvHash : Int -> Int -> Int
|
||||
fnvHash a b =
|
||||
Bitwise.xor a b * 16777619 |> Bitwise.shiftRightZfBy 0
|
||||
|
||||
|
||||
{-| **DEPRECATED.** Please use [`getFailureReason`](#getFailureReason) instead.
|
||||
This function will be removed in the next major version.
|
||||
|
||||
Return `Nothing` if the given [`Expectation`](#Expectation) is a [`pass`](#pass).
|
||||
|
||||
If it is a [`fail`](#fail), return a record containing the failure message,
|
||||
along with the given inputs if it was a fuzz test. (If no inputs were involved,
|
||||
the record's `given` field will be `Nothing`).
|
||||
|
||||
For example, if a fuzz test generates random integers, this might return
|
||||
`{ message = "it was supposed to be positive", given = "-1" }`
|
||||
|
||||
getFailure (Expect.fail "this failed")
|
||||
-- Just { message = "this failed", given = "" }
|
||||
|
||||
getFailure (Expect.pass)
|
||||
-- Nothing
|
||||
|
||||
-}
|
||||
getFailure : Expectation -> Maybe { given : Maybe String, message : String }
|
||||
getFailure expectation =
|
||||
case expectation of
|
||||
Test.Expectation.Pass ->
|
||||
Nothing
|
||||
|
||||
Test.Expectation.Fail { given, description, reason } ->
|
||||
Just
|
||||
{ given = given
|
||||
, message = Test.Runner.Failure.format description reason
|
||||
}
|
||||
|
||||
|
||||
{-| Return `Nothing` if the given [`Expectation`](#Expectation) is a [`pass`](#pass).
|
||||
|
||||
If it is a [`fail`](#fail), return a record containing the expectation
|
||||
description, the [`Reason`](#Reason) the test failed, and the given inputs if
|
||||
it was a fuzz test. (If it was not a fuzz test, the record's `given` field
|
||||
will be `Nothing`).
|
||||
|
||||
For example:
|
||||
|
||||
getFailureReason (Expect.equal 1 2)
|
||||
-- Just { reason = Equal 1 2, description = "Expect.equal", given = Nothing }
|
||||
|
||||
getFailureReason (Expect.equal 1 1)
|
||||
-- Nothing
|
||||
|
||||
-}
|
||||
getFailureReason :
|
||||
Expectation
|
||||
->
|
||||
Maybe
|
||||
{ given : Maybe String
|
||||
, description : String
|
||||
, reason : Reason
|
||||
}
|
||||
getFailureReason expectation =
|
||||
case expectation of
|
||||
Test.Expectation.Pass ->
|
||||
Nothing
|
||||
|
||||
Test.Expectation.Fail record ->
|
||||
Just record
|
||||
|
||||
|
||||
{-| Determine if an expectation was created by a call to `Test.todo`. Runners
|
||||
may treat these tests differently in their output.
|
||||
-}
|
||||
isTodo : Expectation -> Bool
|
||||
isTodo expectation =
|
||||
case expectation of
|
||||
Test.Expectation.Pass ->
|
||||
False
|
||||
|
||||
Test.Expectation.Fail { reason } ->
|
||||
reason == TODO
|
||||
|
||||
|
||||
{-| A standard way to format descriptions and test labels, to keep things
|
||||
consistent across test runner implementations.
|
||||
|
||||
The HTML, Node, String, and Log runners all use this.
|
||||
|
||||
What it does:
|
||||
|
||||
- drop any labels that are empty strings
|
||||
- format the first label differently from the others
|
||||
- reverse the resulting list
|
||||
|
||||
Example:
|
||||
|
||||
[ "the actual test that failed"
|
||||
, "nested description failure"
|
||||
, "top-level description failure"
|
||||
]
|
||||
|> formatLabels ((++) "↓ ") ((++) "✗ ")
|
||||
|
||||
{-
|
||||
[ "↓ top-level description failure"
|
||||
, "↓ nested description failure"
|
||||
, "✗ the actual test that failed"
|
||||
]
|
||||
-}
|
||||
|
||||
-}
|
||||
formatLabels :
|
||||
(String -> format)
|
||||
-> (String -> format)
|
||||
-> List String
|
||||
-> List format
|
||||
formatLabels formatDescription formatTest labels =
|
||||
case List.filter (not << String.isEmpty) labels of
|
||||
[] ->
|
||||
[]
|
||||
|
||||
test :: descriptions ->
|
||||
descriptions
|
||||
|> List.map formatDescription
|
||||
|> (::) (formatTest test)
|
||||
|> List.reverse
|
||||
|
||||
|
||||
type alias Shrunken a =
|
||||
{ down : LazyList (RoseTree a)
|
||||
, over : LazyList (RoseTree a)
|
||||
}
|
||||
|
||||
|
||||
{-| A `Shrinkable a` is an opaque type that allows you to obtain a value of type
|
||||
`a` that is smaller than the one you've previously obtained.
|
||||
-}
|
||||
type Shrinkable a
|
||||
= Shrinkable (Shrunken a)
|
||||
|
||||
|
||||
{-| Given a fuzzer, return a random generator to produce a value and a
|
||||
Shrinkable. The value is what a fuzz test would have received as input.
|
||||
-}
|
||||
fuzz : Fuzzer a -> Random.Generator ( a, Shrinkable a )
|
||||
fuzz fuzzer =
|
||||
case fuzzer of
|
||||
Ok validFuzzer ->
|
||||
validFuzzer
|
||||
|> Random.map
|
||||
(\(Rose root children) ->
|
||||
( root, Shrinkable { down = children, over = LazyList.empty } )
|
||||
)
|
||||
|
||||
Err reason ->
|
||||
Debug.crash <| "Cannot call `fuzz` with an invalid fuzzer: " ++ reason
|
||||
|
||||
|
||||
{-| Given a Shrinkable, attempt to shrink the value further. Pass `False` to
|
||||
indicate that the last value you've seen (from either `fuzz` or this function)
|
||||
caused the test to **fail**. This will attempt to find a smaller value. Pass
|
||||
`True` if the test passed. If you have already seen a failure, this will attempt
|
||||
to shrink that failure in another way. In both cases, it may be impossible to
|
||||
shrink the value, represented by `Nothing`.
|
||||
-}
|
||||
shrink : Bool -> Shrinkable a -> Maybe ( a, Shrinkable a )
|
||||
shrink causedPass (Shrinkable { down, over }) =
|
||||
let
|
||||
tryNext =
|
||||
if causedPass then
|
||||
over
|
||||
else
|
||||
down
|
||||
in
|
||||
case LazyList.headAndTail tryNext of
|
||||
Just ( Rose root children, tl ) ->
|
||||
Just ( root, Shrinkable { down = children, over = tl } )
|
||||
|
||||
Nothing ->
|
||||
Nothing
|
||||
174
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test/Runner/Failure.elm
vendored
Normal file
174
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Test/Runner/Failure.elm
vendored
Normal file
@@ -0,0 +1,174 @@
|
||||
module Test.Runner.Failure exposing (InvalidReason(..), Reason(..), format)
|
||||
|
||||
{-| The reason a test failed.
|
||||
|
||||
@docs Reason, InvalidReason, format
|
||||
|
||||
-}
|
||||
|
||||
|
||||
{-| The reason a test failed.
|
||||
|
||||
Test runners can use this to provide nice output, e.g. by doing diffs on the
|
||||
two parts of an `Expect.equal` failure.
|
||||
|
||||
-}
|
||||
type Reason
|
||||
= Custom
|
||||
| Equality String String
|
||||
| Comparison String String
|
||||
-- Expected, actual, (index of problem, expected element, actual element)
|
||||
| ListDiff (List String) (List String)
|
||||
{- I don't think we need to show the diff twice with + and - reversed. Just show it after the main vertical bar.
|
||||
"Extra" and "missing" are relative to the actual value.
|
||||
-}
|
||||
| CollectionDiff
|
||||
{ expected : String
|
||||
, actual : String
|
||||
, extra : List String
|
||||
, missing : List String
|
||||
}
|
||||
| TODO
|
||||
| Invalid InvalidReason
|
||||
|
||||
|
||||
{-| The reason a test run was invalid.
|
||||
|
||||
Test runners should report these to the user in whatever format is appropriate.
|
||||
|
||||
-}
|
||||
type InvalidReason
|
||||
= EmptyList
|
||||
| NonpositiveFuzzCount
|
||||
| InvalidFuzzer
|
||||
| BadDescription
|
||||
| DuplicatedName
|
||||
|
||||
|
||||
verticalBar : String -> String -> String -> String
|
||||
verticalBar comparison expected actual =
|
||||
[ actual
|
||||
, "╵"
|
||||
, "│ " ++ comparison
|
||||
, "╷"
|
||||
, expected
|
||||
]
|
||||
|> String.join "\n"
|
||||
|
||||
|
||||
{-| DEPRECATED. In the future, test runners should implement versions of this
|
||||
that make sense for their own environments.
|
||||
|
||||
Format test run failures in a reasonable way.
|
||||
|
||||
-}
|
||||
format : String -> Reason -> String
|
||||
format description reason =
|
||||
case reason of
|
||||
Custom ->
|
||||
description
|
||||
|
||||
Equality e a ->
|
||||
verticalBar description e a
|
||||
|
||||
Comparison e a ->
|
||||
verticalBar description e a
|
||||
|
||||
TODO ->
|
||||
description
|
||||
|
||||
Invalid BadDescription ->
|
||||
if description == "" then
|
||||
"The empty string is not a valid test description."
|
||||
else
|
||||
"This is an invalid test description: " ++ description
|
||||
|
||||
Invalid _ ->
|
||||
description
|
||||
|
||||
ListDiff expected actual ->
|
||||
listDiffToString 0
|
||||
description
|
||||
{ expected = expected
|
||||
, actual = actual
|
||||
}
|
||||
{ originalExpected = expected
|
||||
, originalActual = actual
|
||||
}
|
||||
|
||||
CollectionDiff { expected, actual, extra, missing } ->
|
||||
let
|
||||
extraStr =
|
||||
if List.isEmpty extra then
|
||||
""
|
||||
else
|
||||
"\nThese keys are extra: "
|
||||
++ (extra |> String.join ", " |> (\d -> "[ " ++ d ++ " ]"))
|
||||
|
||||
missingStr =
|
||||
if List.isEmpty missing then
|
||||
""
|
||||
else
|
||||
"\nThese keys are missing: "
|
||||
++ (missing |> String.join ", " |> (\d -> "[ " ++ d ++ " ]"))
|
||||
in
|
||||
String.join ""
|
||||
[ verticalBar description expected actual
|
||||
, "\n"
|
||||
, extraStr
|
||||
, missingStr
|
||||
]
|
||||
|
||||
|
||||
listDiffToString :
|
||||
Int
|
||||
-> String
|
||||
-> { expected : List String, actual : List String }
|
||||
-> { originalExpected : List String, originalActual : List String }
|
||||
-> String
|
||||
listDiffToString index description { expected, actual } originals =
|
||||
case ( expected, actual ) of
|
||||
( [], [] ) ->
|
||||
[ "Two lists were unequal previously, yet ended up equal later."
|
||||
, "This should never happen!"
|
||||
, "Please report this bug to https://github.com/elm-community/elm-test/issues - and include these lists: "
|
||||
, "\n"
|
||||
, toString originals.originalExpected
|
||||
, "\n"
|
||||
, toString originals.originalActual
|
||||
]
|
||||
|> String.join ""
|
||||
|
||||
( first :: _, [] ) ->
|
||||
verticalBar (description ++ " was shorter than")
|
||||
(toString originals.originalExpected)
|
||||
(toString originals.originalActual)
|
||||
|
||||
( [], first :: _ ) ->
|
||||
verticalBar (description ++ " was longer than")
|
||||
(toString originals.originalExpected)
|
||||
(toString originals.originalActual)
|
||||
|
||||
( firstExpected :: restExpected, firstActual :: restActual ) ->
|
||||
if firstExpected == firstActual then
|
||||
-- They're still the same so far; keep going.
|
||||
listDiffToString (index + 1)
|
||||
description
|
||||
{ expected = restExpected
|
||||
, actual = restActual
|
||||
}
|
||||
originals
|
||||
else
|
||||
-- We found elements that differ; fail!
|
||||
String.join ""
|
||||
[ verticalBar description
|
||||
(toString originals.originalExpected)
|
||||
(toString originals.originalActual)
|
||||
, "\n\nThe first diff is at index "
|
||||
, toString index
|
||||
, ": it was `"
|
||||
, firstActual
|
||||
, "`, but `"
|
||||
, firstExpected
|
||||
, "` was expected."
|
||||
]
|
||||
32
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Util.elm
vendored
Normal file
32
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/src/Util.elm
vendored
Normal file
@@ -0,0 +1,32 @@
|
||||
module Util exposing (..)
|
||||
|
||||
{-| This is where I'm sticking Random helper functions I don't want to add to Pcg.
|
||||
-}
|
||||
|
||||
import Array exposing (Array)
|
||||
import Random.Pcg exposing (..)
|
||||
import String
|
||||
|
||||
|
||||
rangeLengthList : Int -> Int -> Generator a -> Generator (List a)
|
||||
rangeLengthList minLength maxLength generator =
|
||||
int minLength maxLength
|
||||
|> andThen (\len -> list len generator)
|
||||
|
||||
|
||||
rangeLengthArray : Int -> Int -> Generator a -> Generator (Array a)
|
||||
rangeLengthArray minLength maxLength generator =
|
||||
rangeLengthList minLength maxLength generator
|
||||
|> map Array.fromList
|
||||
|
||||
|
||||
rangeLengthString : Int -> Int -> Generator Char -> Generator String
|
||||
rangeLengthString minLength maxLength charGenerator =
|
||||
int minLength maxLength
|
||||
|> andThen (lengthString charGenerator)
|
||||
|
||||
|
||||
lengthString : Generator Char -> Int -> Generator String
|
||||
lengthString charGenerator stringLength =
|
||||
list stringLength charGenerator
|
||||
|> map String.fromList
|
||||
128
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/tests/FloatWithinTests.elm
vendored
Normal file
128
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/tests/FloatWithinTests.elm
vendored
Normal file
@@ -0,0 +1,128 @@
|
||||
module FloatWithinTests exposing (floatWithinTests)
|
||||
|
||||
import Expect exposing (FloatingPointTolerance(Absolute, AbsoluteOrRelative, Relative))
|
||||
import Fuzz exposing (..)
|
||||
import Helpers exposing (..)
|
||||
import Test exposing (..)
|
||||
|
||||
|
||||
floatWithinTests : Test
|
||||
floatWithinTests =
|
||||
describe "Expect.within"
|
||||
[ describe "use-cases"
|
||||
[ fuzz float "pythagorean identity" <|
|
||||
\x ->
|
||||
sin x ^ 2 + cos x ^ 2 |> Expect.within (AbsoluteOrRelative 0.000001 0.00001) 1.0
|
||||
, test "floats known to not add exactly" <|
|
||||
\_ -> 0.1 + 0.2 |> Expect.within (Absolute 0.000000001) 0.3
|
||||
, test "approximation of pi" <|
|
||||
\_ -> 3.14 |> Expect.within (Absolute 0.01) pi
|
||||
, fuzz (floatRange 0.000001 100000) "relative tolerance of circle circumference using pi approximation" <|
|
||||
\radius ->
|
||||
(radius * pi)
|
||||
|> Expect.within (Relative 0.001) (radius * 3.14)
|
||||
, expectToFail <|
|
||||
test "approximation of pi is not considered too accurate" <|
|
||||
\_ -> 3.14 |> Expect.within (Absolute 0.001) pi
|
||||
, expectToFail <|
|
||||
fuzz (floatRange 0.000001 100000) "too high absolute tolerance of circle circumference using pi approximation" <|
|
||||
\radius ->
|
||||
(radius * pi)
|
||||
|> Expect.within (Absolute 0.001) (radius * 3.14)
|
||||
, expectToFail <|
|
||||
fuzz (floatRange 0.000001 100000) "too high relative tolerance of circle circumference using pi approximation" <|
|
||||
\radius ->
|
||||
(radius * pi)
|
||||
|> Expect.within (Relative 0.0001) (radius * 3.14)
|
||||
]
|
||||
, describe "edge-cases"
|
||||
[ fuzz2 float float "self equality" <|
|
||||
\epsilon value ->
|
||||
let
|
||||
eps =
|
||||
if epsilon /= 0 then
|
||||
epsilon
|
||||
else
|
||||
1
|
||||
in
|
||||
value |> Expect.within (Relative (abs eps)) value
|
||||
, fuzz float "NaN inequality" <|
|
||||
\epsilon ->
|
||||
let
|
||||
nan =
|
||||
0.0 / 0.0
|
||||
in
|
||||
nan |> Expect.notWithin (Relative (abs epsilon)) nan
|
||||
, fuzz2 float float "NaN does not equal anything" <|
|
||||
\epsilon a ->
|
||||
let
|
||||
nan =
|
||||
0.0 / 0.0
|
||||
in
|
||||
nan |> Expect.notWithin (Relative (abs epsilon)) a
|
||||
, fuzz float "Infinity equality" <|
|
||||
\epsilon ->
|
||||
let
|
||||
infinity =
|
||||
1.0 / 0.0
|
||||
in
|
||||
infinity |> Expect.within (Relative (abs epsilon)) infinity
|
||||
, fuzz float "Negative infinity equality" <|
|
||||
\epsilon ->
|
||||
let
|
||||
negativeInfinity =
|
||||
-1.0 / 0.0
|
||||
in
|
||||
negativeInfinity |> Expect.within (Relative (abs epsilon)) negativeInfinity
|
||||
, fuzz3 float float float "within and notWithin should never agree on relative tolerance" <|
|
||||
\epsilon a b ->
|
||||
let
|
||||
withinTest =
|
||||
a |> Expect.within (Relative (abs epsilon)) b
|
||||
|
||||
notWithinTest =
|
||||
a |> Expect.notWithin (Relative (abs epsilon)) b
|
||||
in
|
||||
different withinTest notWithinTest
|
||||
, fuzz3 float float float "within and notWithin should never agree on absolute tolerance" <|
|
||||
\epsilon a b ->
|
||||
let
|
||||
withinTest =
|
||||
a |> Expect.within (Absolute (abs epsilon)) b
|
||||
|
||||
notWithinTest =
|
||||
a |> Expect.notWithin (Absolute (abs epsilon)) b
|
||||
in
|
||||
different withinTest notWithinTest
|
||||
, fuzz4 float float float float "within and notWithin should never agree on absolute or relative tolerance" <|
|
||||
\absoluteEpsilon relativeEpsilon a b ->
|
||||
let
|
||||
withinTest =
|
||||
a |> Expect.within (AbsoluteOrRelative (abs absoluteEpsilon) (abs relativeEpsilon)) b
|
||||
|
||||
notWithinTest =
|
||||
a |> Expect.notWithin (AbsoluteOrRelative (abs absoluteEpsilon) (abs relativeEpsilon)) b
|
||||
in
|
||||
different withinTest notWithinTest
|
||||
, fuzz float "Zero equality" <|
|
||||
\epsilon -> 0.0 |> Expect.within (Relative (abs epsilon)) 0.0
|
||||
, fuzz3 float float float "within absolute commutativity" <|
|
||||
\epsilon a b ->
|
||||
same (Expect.within (Absolute (abs epsilon)) a b) (Expect.within (Absolute (abs epsilon)) b a)
|
||||
, fuzz3 float float float "notWithin absolute commutativity" <|
|
||||
\epsilon a b ->
|
||||
same (Expect.notWithin (Absolute (abs epsilon)) a b) (Expect.notWithin (Absolute (abs epsilon)) b a)
|
||||
, fuzz2 float float "within absolute reflexive" <|
|
||||
\epsilon a ->
|
||||
Expect.within (Absolute (abs epsilon)) a a
|
||||
, fuzz3 float float float "within relative commutativity" <|
|
||||
\epsilon a b ->
|
||||
same (Expect.within (Relative (abs epsilon)) a b) (Expect.within (Relative (abs epsilon)) b a)
|
||||
, fuzz3 float float float "notWithin relative commutativity" <|
|
||||
\epsilon a b ->
|
||||
same (Expect.notWithin (Relative (abs epsilon)) a b) (Expect.notWithin (Relative (abs epsilon)) b a)
|
||||
, fuzz2 float float "within relative reflexive" <|
|
||||
\epsilon a ->
|
||||
Expect.within (Relative (abs epsilon)) a a
|
||||
]
|
||||
]
|
||||
304
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/tests/FuzzerTests.elm
vendored
Normal file
304
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/tests/FuzzerTests.elm
vendored
Normal file
@@ -0,0 +1,304 @@
|
||||
module FuzzerTests exposing (fuzzerTests)
|
||||
|
||||
import Expect
|
||||
import Fuzz exposing (..)
|
||||
import Helpers exposing (..)
|
||||
import Lazy.List
|
||||
import Random.Pcg as Random
|
||||
import RoseTree
|
||||
import Test exposing (..)
|
||||
import Test.Runner
|
||||
|
||||
|
||||
die : Fuzzer Int
|
||||
die =
|
||||
Fuzz.intRange 1 6
|
||||
|
||||
|
||||
seed : Fuzzer Random.Seed
|
||||
seed =
|
||||
Fuzz.custom
|
||||
(Random.int Random.minInt Random.maxInt |> Random.map Random.initialSeed)
|
||||
(always Lazy.List.empty)
|
||||
|
||||
|
||||
fuzzerTests : Test
|
||||
fuzzerTests =
|
||||
describe "Fuzzer methods that use Debug.crash don't call it"
|
||||
[ describe "FuzzN (uses tupleN) testing string length properties"
|
||||
[ fuzz2 string string "fuzz2" <|
|
||||
\a b ->
|
||||
testStringLengthIsPreserved [ a, b ]
|
||||
, fuzz3 string string string "fuzz3" <|
|
||||
\a b c ->
|
||||
testStringLengthIsPreserved [ a, b, c ]
|
||||
, fuzz4 string string string string "fuzz4" <|
|
||||
\a b c d ->
|
||||
testStringLengthIsPreserved [ a, b, c, d ]
|
||||
, fuzz5 string string string string string "fuzz5" <|
|
||||
\a b c d e ->
|
||||
testStringLengthIsPreserved [ a, b, c, d, e ]
|
||||
]
|
||||
, fuzz
|
||||
(intRange 1 6)
|
||||
"intRange"
|
||||
(Expect.greaterThan 0)
|
||||
, fuzz
|
||||
(frequency [ ( 1, intRange 1 6 ), ( 1, intRange 1 20 ) ])
|
||||
"Fuzz.frequency"
|
||||
(Expect.greaterThan 0)
|
||||
, fuzz (result string int) "Fuzz.result" <| \r -> Expect.pass
|
||||
, fuzz (andThen (\i -> intRange 0 (2 ^ i)) (intRange 1 8))
|
||||
"Fuzz.andThen"
|
||||
(Expect.atMost 256)
|
||||
, fuzz
|
||||
(map2 (,) die die
|
||||
|> conditional
|
||||
{ retries = 10
|
||||
, fallback = \( a, b ) -> ( a, (b + 1) % 6 )
|
||||
, condition = \( a, b ) -> a /= b
|
||||
}
|
||||
)
|
||||
"conditional: reroll dice until they are not equal"
|
||||
<|
|
||||
\( roll1, roll2 ) ->
|
||||
roll1 |> Expect.notEqual roll2
|
||||
, fuzz seed "conditional: shrunken values all pass condition" <|
|
||||
\seed ->
|
||||
let
|
||||
evenInt : Fuzzer Int
|
||||
evenInt =
|
||||
Fuzz.intRange 0 10
|
||||
|> Fuzz.conditional
|
||||
{ retries = 3
|
||||
, fallback = (+) 1
|
||||
, condition = even
|
||||
}
|
||||
|
||||
even : Int -> Bool
|
||||
even n =
|
||||
(n % 2) == 0
|
||||
|
||||
shrinkable : Test.Runner.Shrinkable Int
|
||||
shrinkable =
|
||||
Test.Runner.fuzz evenInt
|
||||
|> flip Random.step seed
|
||||
|> Tuple.first
|
||||
|> Tuple.second
|
||||
|
||||
testShrinkable : Test.Runner.Shrinkable Int -> Expect.Expectation
|
||||
testShrinkable shrinkable =
|
||||
case Test.Runner.shrink False shrinkable of
|
||||
Nothing ->
|
||||
Expect.pass
|
||||
|
||||
Just ( value, next ) ->
|
||||
if even value then
|
||||
testShrinkable next
|
||||
else
|
||||
Expect.fail <| "Shrunken value does not pass conditional: " ++ toString value
|
||||
in
|
||||
testShrinkable shrinkable
|
||||
, describe "Whitebox testing using Fuzz.Internal"
|
||||
[ fuzz randomSeedFuzzer "the same value is generated with and without shrinking" <|
|
||||
\seed ->
|
||||
let
|
||||
step gen =
|
||||
Random.step gen seed
|
||||
|
||||
aFuzzer =
|
||||
tuple5
|
||||
( tuple ( list int, array float )
|
||||
, maybe bool
|
||||
, result unit char
|
||||
, tuple3
|
||||
( percentage
|
||||
, map2 (+) int int
|
||||
, frequency [ ( 1, constant True ), ( 3, constant False ) ]
|
||||
)
|
||||
, tuple3 ( intRange 0 100, floatRange -51 pi, map abs int )
|
||||
)
|
||||
|
||||
valNoShrink =
|
||||
aFuzzer |> Result.map (Random.map RoseTree.root >> step >> Tuple.first)
|
||||
|
||||
valWithShrink =
|
||||
aFuzzer |> Result.map (step >> Tuple.first >> RoseTree.root)
|
||||
in
|
||||
Expect.equal valNoShrink valWithShrink
|
||||
, shrinkingTests
|
||||
, manualFuzzerTests
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
shrinkingTests : Test
|
||||
shrinkingTests =
|
||||
testShrinking <|
|
||||
describe "tests that fail intentionally to test shrinking"
|
||||
[ fuzz2 int int "Every pair of ints has a zero" <|
|
||||
\i j ->
|
||||
(i == 0)
|
||||
|| (j == 0)
|
||||
|> Expect.true "(1,1)"
|
||||
, fuzz3 int int int "Every triple of ints has a zero" <|
|
||||
\i j k ->
|
||||
(i == 0)
|
||||
|| (j == 0)
|
||||
|| (k == 0)
|
||||
|> Expect.true "(1,1,1)"
|
||||
, fuzz4 int int int int "Every 4-tuple of ints has a zero" <|
|
||||
\i j k l ->
|
||||
(i == 0)
|
||||
|| (j == 0)
|
||||
|| (k == 0)
|
||||
|| (l == 0)
|
||||
|> Expect.true "(1,1,1,1)"
|
||||
, fuzz5 int int int int int "Every 5-tuple of ints has a zero" <|
|
||||
\i j k l m ->
|
||||
(i == 0)
|
||||
|| (j == 0)
|
||||
|| (k == 0)
|
||||
|| (l == 0)
|
||||
|| (m == 0)
|
||||
|> Expect.true "(1,1,1,1,1)"
|
||||
, fuzz (list int) "All lists are sorted" <|
|
||||
\aList ->
|
||||
let
|
||||
checkPair l =
|
||||
case l of
|
||||
a :: b :: more ->
|
||||
if a > b then
|
||||
False
|
||||
else
|
||||
checkPair (b :: more)
|
||||
|
||||
_ ->
|
||||
True
|
||||
in
|
||||
checkPair aList |> Expect.true "[1,0]|[0,-1]"
|
||||
, fuzz (intRange 1 8 |> andThen (\i -> intRange 0 (2 ^ i))) "Fuzz.andThen shrinks a number" <|
|
||||
\i ->
|
||||
i <= 2 |> Expect.true "3"
|
||||
]
|
||||
|
||||
|
||||
type alias ShrinkResult a =
|
||||
Maybe ( a, Test.Runner.Shrinkable a )
|
||||
|
||||
|
||||
manualFuzzerTests : Test
|
||||
manualFuzzerTests =
|
||||
describe "Test.Runner.{fuzz, shrink}"
|
||||
[ fuzz randomSeedFuzzer "Claim there are no even numbers" <|
|
||||
\seed ->
|
||||
let
|
||||
-- fuzzer is guaranteed to produce an even number
|
||||
fuzzer =
|
||||
Fuzz.intRange 2 10000
|
||||
|> Fuzz.map
|
||||
(\n ->
|
||||
if failsTest n then
|
||||
n
|
||||
else
|
||||
n + 1
|
||||
)
|
||||
|
||||
failsTest n =
|
||||
n % 2 == 0
|
||||
|
||||
pair =
|
||||
Random.step (Test.Runner.fuzz fuzzer) seed
|
||||
|> Tuple.first
|
||||
|> Just
|
||||
|
||||
unfold acc maybePair =
|
||||
case maybePair of
|
||||
Just ( valN, shrinkN ) ->
|
||||
if failsTest valN then
|
||||
unfold (valN :: acc) (Test.Runner.shrink False shrinkN)
|
||||
else
|
||||
unfold acc (Test.Runner.shrink True shrinkN)
|
||||
|
||||
Nothing ->
|
||||
acc
|
||||
in
|
||||
unfold [] pair
|
||||
|> Expect.all
|
||||
[ List.all failsTest >> Expect.true "Not all elements were even"
|
||||
, List.head
|
||||
>> Maybe.map (Expect.all [ Expect.lessThan 5, Expect.atLeast 0 ])
|
||||
>> Maybe.withDefault (Expect.fail "Did not cause failure")
|
||||
, List.reverse >> List.head >> Expect.equal (Maybe.map Tuple.first pair)
|
||||
]
|
||||
, fuzz randomSeedFuzzer "No strings contain the letter e" <|
|
||||
\seed ->
|
||||
let
|
||||
-- fuzzer is guaranteed to produce a string with the letter e
|
||||
fuzzer =
|
||||
map2 (\pre suf -> pre ++ "e" ++ suf) string string
|
||||
|
||||
failsTest =
|
||||
String.contains "e"
|
||||
|
||||
pair =
|
||||
Random.step (Test.Runner.fuzz fuzzer) seed
|
||||
|> Tuple.first
|
||||
|> Just
|
||||
|
||||
unfold acc maybePair =
|
||||
case maybePair of
|
||||
Just ( valN, shrinkN ) ->
|
||||
if failsTest valN then
|
||||
unfold (valN :: acc) (Test.Runner.shrink False shrinkN)
|
||||
else
|
||||
unfold acc (Test.Runner.shrink True shrinkN)
|
||||
|
||||
Nothing ->
|
||||
acc
|
||||
in
|
||||
unfold [] pair
|
||||
|> Expect.all
|
||||
[ List.all failsTest >> Expect.true "Not all contained the letter e"
|
||||
, List.head >> Expect.equal (Just "e")
|
||||
, List.reverse >> List.head >> Expect.equal (Maybe.map Tuple.first pair)
|
||||
]
|
||||
, fuzz randomSeedFuzzer "List shrinker finds the smallest counter example" <|
|
||||
\seed ->
|
||||
let
|
||||
fuzzer : Fuzzer (List Int)
|
||||
fuzzer =
|
||||
Fuzz.list Fuzz.int
|
||||
|
||||
allEven : List Int -> Bool
|
||||
allEven xs =
|
||||
List.all (\x -> x % 2 == 0) xs
|
||||
|
||||
initialShrink : ShrinkResult (List Int)
|
||||
initialShrink =
|
||||
Random.step (Test.Runner.fuzz fuzzer) seed
|
||||
|> Tuple.first
|
||||
|> Just
|
||||
|
||||
shrink : Maybe (List Int) -> ShrinkResult (List Int) -> Maybe (List Int)
|
||||
shrink shrunken lastShrink =
|
||||
case lastShrink of
|
||||
Just ( valN, shrinkN ) ->
|
||||
shrink
|
||||
(if allEven valN then
|
||||
shrunken
|
||||
else
|
||||
Just valN
|
||||
)
|
||||
(Test.Runner.shrink (allEven valN) shrinkN)
|
||||
|
||||
Nothing ->
|
||||
shrunken
|
||||
in
|
||||
case shrink Nothing initialShrink of
|
||||
Just shrunken ->
|
||||
Expect.equal [ 1 ] shrunken
|
||||
|
||||
Nothing ->
|
||||
Expect.pass
|
||||
]
|
||||
159
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/tests/Helpers.elm
vendored
Normal file
159
intro-to-elm/part7/tests/elm-stuff/packages/elm-community/elm-test/4.2.0/tests/Helpers.elm
vendored
Normal file
@@ -0,0 +1,159 @@
|
||||
module Helpers exposing (different, expectPass, expectToFail, randomSeedFuzzer, same, succeeded, testShrinking, testStringLengthIsPreserved)
|
||||
|
||||
import Expect
|
||||
import Fuzz exposing (Fuzzer)
|
||||
import Random.Pcg as Random
|
||||
import Shrink
|
||||
import Test exposing (Test)
|
||||
import Test.Expectation exposing (Expectation(..))
|
||||
import Test.Internal as Internal
|
||||
import Test.Runner.Failure exposing (Reason(..))
|
||||
|
||||
|
||||
expectPass : a -> Expectation
|
||||
expectPass _ =
|
||||
Expect.pass
|
||||
|
||||
|
||||
testStringLengthIsPreserved : List String -> Expectation
|
||||
testStringLengthIsPreserved strings =
|
||||
strings
|
||||
|> List.map String.length
|
||||
|> List.sum
|
||||
|> Expect.equal (String.length (List.foldl (++) "" strings))
|
||||
|
||||
|
||||
expectToFail : Test -> Test
|
||||
expectToFail =
|
||||
expectFailureHelper (always Nothing)
|
||||
|
||||
|
||||
succeeded : Expectation -> Bool
|
||||
succeeded expectation =
|
||||
case expectation of
|
||||
Pass ->
|
||||
True
|
||||
|
||||
Fail _ ->
|
||||
False
|
||||
|
||||
|
||||
passesToFails :
|
||||
({ reason : Reason
|
||||
, description : String
|
||||
, given : Maybe String
|
||||
}
|
||||
-> Maybe String
|
||||
)
|
||||
-> List Expectation
|
||||
-> List Expectation
|
||||
passesToFails f expectations =
|
||||
expectations
|
||||
|> List.filterMap (passToFail f)
|
||||
|> List.map Expect.fail
|
||||
|> (\list ->
|
||||
if List.isEmpty list then
|
||||
[ Expect.pass ]
|
||||
else
|
||||
list
|
||||
)
|
||||
|
||||
|
||||
passToFail :
|
||||
({ reason : Reason
|
||||
, description : String
|
||||
, given : Maybe String
|
||||
}
|
||||
-> Maybe String
|
||||
)
|
||||
-> Expectation
|
||||
-> Maybe String
|
||||
passToFail f expectation =
|
||||
case expectation of
|
||||
Pass ->
|
||||
Just "Expected this test to fail, but it passed!"
|
||||
|
||||
Fail record ->
|
||||
f record
|
||||
|
||||
|
||||
expectFailureHelper : ({ description : String, given : Maybe String, reason : Reason } -> Maybe String) -> Test -> Test
|
||||
expectFailureHelper f test =
|
||||
case test of
|
||||
Internal.UnitTest runTest ->
|
||||
Internal.UnitTest <|
|
||||
\() ->
|
||||
passesToFails f (runTest ())
|
||||
|
||||
Internal.FuzzTest runTest ->
|
||||
Internal.FuzzTest <|
|
||||
\seed runs ->
|
||||
passesToFails f (runTest seed runs)
|
||||
|
||||
Internal.Labeled desc labeledTest ->
|
||||
Internal.Labeled desc (expectFailureHelper f labeledTest)
|
||||
|
||||
Internal.Batch tests ->
|
||||
Internal.Batch (List.map (expectFailureHelper f) tests)
|
||||
|
||||
Internal.Skipped subTest ->
|
||||
expectFailureHelper f subTest
|
||||
|> Internal.Skipped
|
||||
|
||||
Internal.Only subTest ->
|
||||
expectFailureHelper f subTest
|
||||
|> Internal.Only
|
||||
|
||||
|
||||
testShrinking : Test -> Test
|
||||
testShrinking =
|
||||
let
|
||||
handleFailure { given, description } =
|
||||
let
|
||||
acceptable =
|
||||
String.split "|" description
|
||||
in
|
||||
case given of
|
||||
Nothing ->
|
||||
Just "Expected this test to have a given value!"
|
||||
|
||||
Just g ->
|
||||
if List.member g acceptable then
|
||||
Nothing
|
||||
else
|
||||
Just <| "Got shrunken value " ++ g ++ " but expected " ++ String.join " or " acceptable
|
||||
in
|
||||
expectFailureHelper handleFailure
|
||||
|
||||
|
||||
{-| get a good distribution of random seeds, and don't shrink our seeds!
|
||||
-}
|
||||
randomSeedFuzzer : Fuzzer Random.Seed
|
||||
randomSeedFuzzer =
|
||||
Fuzz.custom (Random.int 0 0xFFFFFFFF) Shrink.noShrink |> Fuzz.map Random.initialSeed
|
||||
|
||||
|
||||
same : Expectation -> Expectation -> Expectation
|
||||
same a b =
|
||||
case ( a, b ) of
|
||||
( Test.Expectation.Pass, Test.Expectation.Pass ) ->
|
||||
Test.Expectation.Pass
|
||||
|
||||
( Test.Expectation.Fail _, Test.Expectation.Fail _ ) ->
|
||||
Test.Expectation.Pass
|
||||
|
||||
( a, b ) ->
|
||||
Test.Expectation.fail { description = "expected both arguments to fail, or both to succeed", reason = Equality (toString a) (toString b) }
|
||||
|
||||
|
||||
different : Expectation -> Expectation -> Expectation
|
||||
different a b =
|
||||
case ( a, b ) of
|
||||
( Test.Expectation.Pass, Test.Expectation.Fail _ ) ->
|
||||
Test.Expectation.Pass
|
||||
|
||||
( Test.Expectation.Fail _, Test.Expectation.Pass ) ->
|
||||
Test.Expectation.Pass
|
||||
|
||||
( a, b ) ->
|
||||
Test.Expectation.fail { description = "expected one argument to fail", reason = Equality (toString a) (toString b) }
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user