Add part7

This commit is contained in:
Richard Feldman
2018-05-05 04:54:47 -04:00
parent f6bef58e3d
commit 825dea437b
575 changed files with 79140 additions and 0 deletions

View File

@@ -0,0 +1,4 @@
# elm-package generated files
elm-stuff/
# elm-repl generated files
repl-temp-*

View 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.

View 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
}
```
---
[![NoRedInk](https://cloud.githubusercontent.com/assets/1094080/9069346/99522418-3a9d-11e5-8175-1c2bfd7a2ffe.png)][team]
[team]: http://noredink.com/about/team

View 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"
}

View File

@@ -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

View File

@@ -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

View File

@@ -0,0 +1 @@
/elm-stuff/

View 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

View 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")
]

View File

@@ -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"
}

View File

@@ -0,0 +1,4 @@
# elm-package generated files
elm-stuff/
# elm-repl generated files
repl-temp-*

View 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

View 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.

View 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)

View 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"
}

View File

@@ -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 ]

View 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))

View File

@@ -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

View File

@@ -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)

View 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
, "]"
]

View 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
]

View 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 ]

View File

@@ -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;
}
};
})();

View 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))

View 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"
}

View File

@@ -0,0 +1,4 @@
# elm-package generated files
elm-stuff/
# elm-repl generated files
repl-temp-*

View 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.

View 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.

View 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"
}

View 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

View File

@@ -0,0 +1,4 @@
# elm-package generated files
elm-stuff/
# elm-repl generated files
repl-temp-*

View 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

View 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.

View File

@@ -0,0 +1,131 @@
# elm-html-test
Test views by writing expectations about `Html` values. [![Build Status](https://travis-ci.org/eeue56/elm-html-test.svg?branch=master)](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

View 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"
}

View 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

View 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
)
]

View 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)
]

View 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"
}

View 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)

View 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;
}
};
})();

View File

@@ -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

View 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.")

View 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

View File

@@ -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 =
(++) " "

View 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

View File

@@ -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
}

View 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
]

View 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

View 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

View 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 ]

View 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" ] ])
]

View 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"
}

View File

@@ -0,0 +1,4 @@
# elm-package generated files
elm-stuff
# elm-repl generated files
repl-temp-*

View 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.

View 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

View 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"
}

View 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

View 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
)
]

View 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"
}

View File

@@ -0,0 +1,4 @@
# elm-package generated files
elm-stuff
# elm-repl generated files
repl-temp-*

View 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.

View 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.

View 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)))

View 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

View 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
};
}();

View 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"
}

View 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"
}

View 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)))

View 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)
)
]

View 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"
}

View File

@@ -0,0 +1,4 @@
# elm-package generated files
elm-stuff
# elm-repl generated files
repl-temp-*

View 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.

View File

@@ -0,0 +1 @@
# elm-shrink

View 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"
}

View 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

View File

@@ -0,0 +1,5 @@
*~
node_modules/
elm-stuff/
docs/
*.html

View 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

View 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.

View File

@@ -0,0 +1,152 @@
# elm-test [![Travis build Status](https://travis-ci.org/elm-community/elm-test.svg?branch=master)](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

View 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

View 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.

View 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
}

View File

@@ -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"
}

View 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"
}

View 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

View 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

View 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)

View 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

View 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)

View 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

View File

@@ -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

View 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

View 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)

View 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

View 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."
]

View 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

View 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
]
]

View 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
]

View 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