├── .gitignore ├── src ├── Test │ └── Runner │ │ ├── Html │ │ ├── View.elm │ │ └── App.elm │ │ ├── Html.elm │ │ └── Exploration.elm └── View.elm ├── tests ├── Main.elm ├── elm-package.json ├── Fixtures.elm └── TestRunnerExplorationTest.elm ├── README.md ├── elm-package.json ├── LICENSE └── example └── Main.elm /.gitignore: -------------------------------------------------------------------------------- 1 | # elm-package generated files 2 | elm-stuff/ 3 | # elm-repl generated files 4 | repl-temp-* 5 | -------------------------------------------------------------------------------- /src/Test/Runner/Html/View.elm: -------------------------------------------------------------------------------- 1 | module Test.Runner.Html.View exposing (..) 2 | 3 | import Test.Runner.Exploration as Runner 4 | import Time exposing (Time) 5 | 6 | 7 | type alias Model = 8 | Maybe ( Time, Runner.Status ) 9 | -------------------------------------------------------------------------------- /tests/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (..) 2 | 3 | import Test.Runner.Html 4 | import TestRunnerExplorationTest 5 | 6 | 7 | main : Test.Runner.Html.TestProgram 8 | main = 9 | Test.Runner.Html.run TestRunnerExplorationTest.suite 10 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DEPRECATED 2 | 3 | Elm 0.19 brought some changes to test dependencies that we cannot accommodate in this package. 4 | We now recommend you use the CLI runner: https://github.com/elm-explorations/test#running-tests-locally 5 | 6 | For more discussion, see [Issue #9](https://github.com/elm-community/html-test-runner/pull/9#issuecomment-416431420). 7 | The old README content follows: 8 | 9 | > # html-test-runner 10 | > Run elm-test suites in the browser 11 | > 12 | > ## Try it 13 | > 14 | > 1. `elm-reactor` 15 | > 2. Visit [http://localhost:8000/example/Main.elm](http://localhost:8000/example/Main.elm) 16 | -------------------------------------------------------------------------------- /tests/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.3", 3 | "summary": "Run elm-test tests in a browser.", 4 | "repository": "https://github.com/elm-community/html-test-runner.git", 5 | "license": "BSD-3-Clause", 6 | "source-directories": [ 7 | ".", 8 | "../src" 9 | ], 10 | "exposed-modules": [], 11 | "dependencies": { 12 | "elm-community/elm-test": "4.1.0 <= v < 5.0.0", 13 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 14 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 15 | "mgold/elm-random-pcg": "4.0.2 <= v < 6.0.0", 16 | "mdgriffith/style-elements": "4.2.1 <= v < 5.0.0" 17 | }, 18 | "elm-version": "0.18.0 <= v < 0.19.0" 19 | } 20 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.7", 3 | "summary": "Run elm-test tests in a browser.", 4 | "repository": "https://github.com/elm-community/html-test-runner.git", 5 | "license": "BSD-3-Clause", 6 | "source-directories": [ 7 | "src" 8 | ], 9 | "exposed-modules": [ 10 | "Test.Runner.Html" 11 | ], 12 | "dependencies": { 13 | "elm-community/elm-test": "4.1.0 <= v < 5.0.0", 14 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 15 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 16 | "mdgriffith/style-elements": "4.2.1 <= v < 5.0.0", 17 | "mgold/elm-random-pcg": "4.0.2 <= v < 6.0.0" 18 | }, 19 | "elm-version": "0.18.0 <= v < 0.19.0" 20 | } 21 | -------------------------------------------------------------------------------- /tests/Fixtures.elm: -------------------------------------------------------------------------------- 1 | module Fixtures exposing (..) 2 | 3 | import Expect 4 | import Test exposing (..) 5 | 6 | 7 | type alias Fixture = 8 | () -> Test 9 | 10 | 11 | noTests : Fixture 12 | noTests () = 13 | describe "nothing" [] 14 | 15 | 16 | todoWithFailingTest : Fixture 17 | todoWithFailingTest () = 18 | describe "todo then failing" 19 | [ test "done" (\_ -> Expect.fail "just cause") 20 | , todo "haven't done this yet" 21 | ] 22 | 23 | 24 | todoWithPassingTest : Fixture 25 | todoWithPassingTest () = 26 | describe "todo then passing" 27 | [ test "done" (\_ -> Expect.pass) 28 | , todo "haven't done this yet" 29 | ] 30 | 31 | 32 | oneTest : Fixture 33 | oneTest () = 34 | describe "a" 35 | [ describe "very" 36 | [ describe "nested" 37 | [ test "test" (\_ -> Expect.equal 1 1) ] 38 | ] 39 | ] 40 | 41 | 42 | twoTests : Fixture 43 | twoTests () = 44 | describe "both" 45 | [ test "one" (\_ -> Expect.pass) 46 | , test "two" (\_ -> Expect.fail "message") 47 | ] 48 | 49 | 50 | noTestsDescription : String 51 | noTestsDescription = 52 | "This `describe \"nothing\"` has no tests in it. Let's give it some!" 53 | -------------------------------------------------------------------------------- /src/Test/Runner/Html.elm: -------------------------------------------------------------------------------- 1 | module Test.Runner.Html exposing (TestProgram, run, runWithOptions) 2 | 3 | {-| HTML Runner 4 | 5 | Runs tests in a browser and reports the results in the DOM. You can bring up 6 | one of these tests in elm-reactor to have it run and show outputs. 7 | 8 | @docs run, runWithOptions, TestProgram 9 | 10 | -} 11 | 12 | import Html 13 | import Random.Pcg as Random 14 | import Test exposing (Test) 15 | import Test.Runner.Html.App as App 16 | import Test.Runner.Html.View as View 17 | import View as View 18 | 19 | 20 | {-| A program which will run tests and report their results. 21 | -} 22 | type alias TestProgram = 23 | Program Never App.Model App.Msg 24 | 25 | 26 | {-| Run the test and report the results. 27 | 28 | Fuzz tests use a default run count of 100, and an initial seed based on the 29 | system time when the test runs begin. 30 | 31 | -} 32 | run : Test -> TestProgram 33 | run = 34 | runWithOptions Nothing Nothing 35 | 36 | 37 | {-| Run the test using the provided options. If `Nothing` is provided for either 38 | `runs` or `seed`, it will fall back on the options used in [`run`](#run). 39 | -} 40 | runWithOptions : Maybe Int -> Maybe Random.Seed -> Test -> TestProgram 41 | runWithOptions runs seed test = 42 | Html.program 43 | { init = App.init (Maybe.withDefault 100 runs) seed test 44 | , update = App.update 45 | , view = App.present >> View.view 46 | , subscriptions = \_ -> Sub.none 47 | } 48 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016, Richard Feldman 2 | Copyright (c) 2017, Kofi Gumbs 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation 13 | and/or other materials provided with the distribution. 14 | 15 | * Neither the name of html-test-runner nor the names of its 16 | contributors may be used to endorse or promote products derived from 17 | this software without specific prior written permission. 18 | 19 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 20 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 21 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 22 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 23 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 24 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 25 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 26 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 27 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 28 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 29 | -------------------------------------------------------------------------------- /src/Test/Runner/Html/App.elm: -------------------------------------------------------------------------------- 1 | module Test.Runner.Html.App 2 | exposing 3 | ( Model 4 | , Msg(..) 5 | , init 6 | , present 7 | , update 8 | ) 9 | 10 | import Expect exposing (Expectation) 11 | import Process 12 | import Random.Pcg as Random 13 | import Task 14 | import Test exposing (Test) 15 | import Test.Runner.Exploration as Runner 16 | import Test.Runner.Html.View as View 17 | import Time exposing (Time) 18 | 19 | 20 | type Model 21 | = NotStarted (Maybe Random.Seed) Int Test 22 | | Started Time Time Runner.Status 23 | 24 | 25 | type Msg 26 | = Dispatch Time 27 | 28 | 29 | dispatch : Cmd Msg 30 | dispatch = 31 | Process.sleep 0 32 | |> Task.andThen (\_ -> Time.now) 33 | |> Task.perform Dispatch 34 | 35 | 36 | start : Int -> Test -> Random.Seed -> Runner.Status 37 | start runs test seed = 38 | Runner.fromTest runs seed test 39 | |> Runner.step 40 | 41 | 42 | init : Int -> Maybe Random.Seed -> Test -> ( Model, Cmd Msg ) 43 | init runs maybeSeed test = 44 | ( NotStarted maybeSeed runs test, dispatch ) 45 | 46 | 47 | update : Msg -> Model -> ( Model, Cmd Msg ) 48 | update (Dispatch now) model = 49 | case model of 50 | NotStarted Nothing runs test -> 51 | ( floor now 52 | |> Random.initialSeed 53 | |> start runs test 54 | |> Started now now 55 | , dispatch 56 | ) 57 | 58 | NotStarted (Just seed) runs test -> 59 | ( Started now now (start runs test seed) 60 | , dispatch 61 | ) 62 | 63 | Started startTime _ (Runner.Running { next }) -> 64 | ( Started startTime now (Runner.step next) 65 | , dispatch 66 | ) 67 | 68 | Started startTime _ status -> 69 | ( Started startTime now status 70 | , Cmd.none 71 | ) 72 | 73 | 74 | present : Model -> View.Model 75 | present model = 76 | case model of 77 | NotStarted _ _ _ -> 78 | Nothing 79 | 80 | Started startTime now status -> 81 | Just ( now - startTime, status ) 82 | -------------------------------------------------------------------------------- /src/Test/Runner/Exploration.elm: -------------------------------------------------------------------------------- 1 | module Test.Runner.Exploration 2 | exposing 3 | ( Failure 4 | , Reason(..) 5 | , Runner 6 | , Status(..) 7 | , formatFailure 8 | , fromTest 9 | , step 10 | ) 11 | 12 | import Expect 13 | import Random.Pcg 14 | import Test 15 | import Test.Runner 16 | 17 | 18 | type Runner 19 | = Runner Internals 20 | 21 | 22 | type alias Internals = 23 | { passed : Int 24 | , failures : List Failure 25 | , todos : List Failure 26 | , queue : List Test.Runner.Runner 27 | , incomplete : Maybe Reason 28 | } 29 | 30 | 31 | type Status 32 | = Running 33 | { passed : Int 34 | , remaining : Int 35 | , failures : List Failure 36 | , next : Runner 37 | } 38 | | Pass Int 39 | | Fail Int (List Failure) 40 | | Todo Int (List Failure) 41 | | Incomplete Int Reason 42 | 43 | 44 | type Reason 45 | = Skip 46 | | Only 47 | | Custom String 48 | 49 | 50 | type Failure 51 | = Failure (List String) (List { given : Maybe String, message : String }) 52 | 53 | 54 | fromTest : Int -> Random.Pcg.Seed -> Test.Test -> Runner 55 | fromTest runs seed test = 56 | let 57 | new queue incomplete = 58 | Runner 59 | { passed = 0 60 | , failures = [] 61 | , todos = [] 62 | , queue = queue 63 | , incomplete = incomplete 64 | } 65 | in 66 | case Test.Runner.fromTest runs seed test of 67 | Test.Runner.Plain queue -> 68 | new queue Nothing 69 | 70 | Test.Runner.Only queue -> 71 | new queue (Just Only) 72 | 73 | Test.Runner.Skipping queue -> 74 | new queue (Just Skip) 75 | 76 | Test.Runner.Invalid reason -> 77 | new [] (Just (Custom reason)) 78 | 79 | 80 | formatFailure : 81 | (String -> a) 82 | -> (String -> a) 83 | -> Failure 84 | -> ( List a, List { given : Maybe String, message : String } ) 85 | formatFailure formatFirst formatLast (Failure labels errors) = 86 | ( Test.Runner.formatLabels formatFirst formatLast labels, errors ) 87 | 88 | 89 | step : Runner -> Status 90 | step (Runner internals) = 91 | case 92 | ( internals.incomplete 93 | , internals.todos 94 | , internals.failures 95 | , internals.queue 96 | ) 97 | of 98 | ( Nothing, [], [], [] ) -> 99 | Pass internals.passed 100 | 101 | ( Nothing, todos, [], [] ) -> 102 | Todo internals.passed todos 103 | 104 | ( Just reason, _, [], [] ) -> 105 | Incomplete internals.passed reason 106 | 107 | ( _, _, failures, [] ) -> 108 | Fail internals.passed failures 109 | 110 | ( _, _, _, next :: queue ) -> 111 | next.run () 112 | |> fromExpectation { internals | queue = queue } next.labels 113 | 114 | 115 | fromExpectation : Internals -> List String -> List Expect.Expectation -> Status 116 | fromExpectation internals labels expectations = 117 | let 118 | ( todos, failures ) = 119 | List.foldr partition ( [], [] ) expectations 120 | 121 | partition e = 122 | case ( Test.Runner.isTodo e, Test.Runner.getFailure e ) of 123 | ( True, Just result ) -> 124 | Tuple.mapFirst ((::) result) 125 | 126 | ( False, Just result ) -> 127 | Tuple.mapSecond ((::) result) 128 | 129 | ( _, Nothing ) -> 130 | identity 131 | in 132 | if not <| List.isEmpty failures then 133 | toRunning 134 | { internals 135 | | failures = internals.failures ++ [ Failure labels failures ] 136 | } 137 | else if not <| List.isEmpty todos then 138 | toRunning 139 | { internals 140 | | todos = internals.todos ++ [ Failure labels todos ] 141 | } 142 | else 143 | toRunning 144 | { internals 145 | | passed = internals.passed + 1 146 | } 147 | 148 | 149 | toRunning : Internals -> Status 150 | toRunning internals = 151 | Running 152 | { passed = internals.passed 153 | , remaining = List.length internals.queue 154 | , failures = internals.failures 155 | , next = Runner internals 156 | } 157 | -------------------------------------------------------------------------------- /example/Main.elm: -------------------------------------------------------------------------------- 1 | module HtmlRunnerExample exposing (..) 2 | 3 | {-| HOW TO RUN THIS EXAMPLE 4 | 5 | 1. Run elm-reactor from the same directory as your tests' elm-package.json. (For example, if you have tests/elm-package.json, then cd into tests/ and 6 | run elm-reactor.) 7 | 2. Visit and bring up this file. 8 | 9 | -} 10 | 11 | import Char 12 | import Expect 13 | import Fuzz exposing (..) 14 | import String 15 | import Test exposing (..) 16 | import Test.Runner.Html 17 | 18 | 19 | main : Test.Runner.Html.TestProgram 20 | main = 21 | [ testWithoutNums 22 | , testOxfordify 23 | , noDescription 24 | , testExpectations 25 | , testFailingFuzzTests 26 | , testFuzz 27 | ] 28 | |> concat 29 | |> Test.Runner.Html.run 30 | 31 | 32 | withoutNums : String -> String 33 | withoutNums = 34 | String.filter (\ch -> not (Char.isDigit ch || ch == '.')) 35 | 36 | 37 | testWithoutNums : Test 38 | testWithoutNums = 39 | describe "withoutNums" 40 | [ fuzzWith { runs = 100 } (tuple3 ( string, float, string )) "adding numbers to strings has no effect" <| 41 | \( prefix, num, suffix ) -> 42 | withoutNums (prefix ++ toString num ++ suffix) 43 | |> Expect.equal (withoutNums (prefix ++ suffix)) 44 | ] 45 | 46 | 47 | testExpectations : Test 48 | testExpectations = 49 | describe "basic expectations" 50 | [ test "this should succeed" <| 51 | \() -> 52 | "blah" 53 | |> Expect.equal " blah" 54 | , test "this should fail" <| 55 | \() -> 56 | "something" 57 | |> Expect.equal "someting else" 58 | , test "another failure" <| 59 | \() -> 60 | "forty-two" 61 | |> Expect.equal "forty-three" 62 | ] 63 | 64 | 65 | 66 | {- After this point, we're really just showing that Richard's proposed API compiles. -} 67 | 68 | 69 | {-| stubbed function under test 70 | -} 71 | oxfordify : a -> b -> c -> String 72 | oxfordify _ _ _ = 73 | "Alice, Bob, and Claire" 74 | 75 | 76 | noDescription : Test 77 | noDescription = 78 | test "" <| 79 | \() -> 80 | Expect.equal "No description" "Whatsoever!" 81 | 82 | 83 | testFuzz : Test 84 | testFuzz = 85 | describe "fuzzing" 86 | [ fuzz2 string string "empty list etc" <| 87 | \name punctuation -> 88 | oxfordify "This sentence is empty" "." [] 89 | |> Expect.equal "" 90 | |> Expect.onFail "given an empty list, did not return an empty string" 91 | , fuzz2 string string "further testing" <| 92 | \name punctuation -> 93 | oxfordify "This sentence contains " "." [ "one item" ] 94 | |> Expect.equal "This sentence contains one item." 95 | , fuzz2 string string "custom onFail here" <| 96 | \name punctuation -> 97 | oxfordify "This sentence contains " "." [ "one item", "two item" ] 98 | |> Expect.equal "This sentence contains one item and two item." 99 | |> Expect.onFail "given an empty list, did not return an empty string" 100 | , fuzz2 string string "This is a test." <| 101 | \name punctuation -> 102 | oxfordify "This sentence contains " "." [ "one item", "two item", "three item" ] 103 | |> Expect.equal "This sentence contains one item, two item, and three item." 104 | |> Expect.onFail "given a list of length 3, did not return an oxford-style sentence" 105 | ] 106 | 107 | 108 | testFailingFuzzTests : Test 109 | testFailingFuzzTests = 110 | describe "the first element in this fuzz tuple" 111 | [ fuzz2 string string "is always \"foo\"" <| 112 | \str1 str2 -> 113 | str1 114 | |> Expect.equal "foo" 115 | ] 116 | 117 | 118 | testOxfordify : Test 119 | testOxfordify = 120 | describe "oxfordify" 121 | [ describe "given an empty sentence" 122 | [ test "returns an empty string" <| 123 | \() -> 124 | oxfordify "This sentence is empty" "." [] 125 | |> Expect.equal "" 126 | ] 127 | , describe "given a sentence with one item" 128 | [ test "still contains one item" <| 129 | \() -> 130 | oxfordify "This sentence contains " "." [ "one item" ] 131 | |> Expect.equal "This sentence contains one item." 132 | ] 133 | , describe "given a sentence with multiple items" 134 | [ test "returns an oxford-style sentence" <| 135 | \() -> 136 | oxfordify "This sentence contains " "." [ "one item", "two item" ] 137 | |> Expect.equal "This sentence contains one item and two item." 138 | , test "returns an oxford-style sentence" <| 139 | \() -> 140 | oxfordify "This sentence contains " "." [ "one item", "two item", "three item" ] 141 | |> Expect.equal "This sentence contains one item, two item, and three item." 142 | ] 143 | ] 144 | 145 | 146 | testShrinkables : Test 147 | testShrinkables = 148 | describe "Some tests that should fail and produce shrunken values" 149 | [ describe "a randomly generated integer" 150 | [ fuzz int "is for sure exactly 0" <| Expect.equal 0 151 | , fuzz int "is <42" <| Expect.lessThan 42 152 | , fuzz int "is also >42" <| Expect.greaterThan 42 153 | ] 154 | , describe "a randomly generated string" 155 | [ fuzz string "equals its reverse" <| 156 | \str -> 157 | Expect.equal str (String.reverse str) 158 | ] 159 | ] 160 | -------------------------------------------------------------------------------- /tests/TestRunnerExplorationTest.elm: -------------------------------------------------------------------------------- 1 | module TestRunnerExplorationTest exposing (suite) 2 | 3 | import Expect 4 | import Fixtures 5 | import Random.Pcg as Random 6 | import Test exposing (..) 7 | import Test.Runner.Exploration as Runner exposing (Runner) 8 | 9 | 10 | suite : Test 11 | suite = 12 | describe "Test.Runner.Exploration" 13 | [ test "fails when describe has no tests" <| 14 | \_ -> 15 | run Fixtures.noTests 16 | |> expect 17 | { steps = 2 18 | , passed = 0 19 | , status = Fail 20 | , failures = 21 | [ ( [] 22 | , [ { given = Nothing 23 | , message = Fixtures.noTestsDescription 24 | } 25 | ] 26 | ) 27 | ] 28 | } 29 | , test "passing one nested test" <| 30 | \_ -> 31 | run Fixtures.oneTest 32 | |> expect 33 | { steps = 2 34 | , passed = 1 35 | , status = Pass 36 | , failures = [] 37 | } 38 | , test "increments test counter" <| 39 | \_ -> 40 | run Fixtures.twoTests 41 | |> expect 42 | { steps = 1 43 | , passed = 1 44 | , status = Running 45 | , failures = [] 46 | } 47 | , test "captures failures" <| 48 | \_ -> 49 | run Fixtures.twoTests 50 | |> expect 51 | { steps = 2 52 | , passed = 1 53 | , status = Running 54 | , failures = 55 | [ ( [ "both", "two" ] 56 | , [ { given = Nothing 57 | , message = "message" 58 | } 59 | ] 60 | ) 61 | ] 62 | } 63 | , test "doesn't show todo with failure" <| 64 | \_ -> 65 | run Fixtures.todoWithFailingTest 66 | |> expect 67 | { steps = 3 68 | , passed = 0 69 | , status = Fail 70 | , failures = 71 | [ ( [ "todo then failing", "done" ] 72 | , [ { given = Nothing 73 | , message = "just cause" 74 | } 75 | ] 76 | ) 77 | ] 78 | } 79 | , test "shows todo with passing" <| 80 | \_ -> 81 | run Fixtures.todoWithPassingTest 82 | |> expect 83 | { steps = 3 84 | , passed = 1 85 | , status = Todo 86 | , failures = 87 | [ ( [ "todo then passing" ] 88 | , [ { given = Nothing 89 | , message = "haven't done this yet" 90 | } 91 | ] 92 | ) 93 | ] 94 | } 95 | , test "shows only in isolation" <| 96 | \_ -> 97 | run (Fixtures.oneTest >> only) 98 | |> expect 99 | { steps = 2 100 | , passed = 1 101 | , status = IncompleteOnly 102 | , failures = [] 103 | } 104 | , test "shows skip in isolation" <| 105 | \_ -> 106 | run (Fixtures.noTests >> skip) 107 | |> expect 108 | { steps = 1 109 | , passed = 0 110 | , status = IncompleteSkip 111 | , failures = [] 112 | } 113 | , test "invalid test shows custom reason" <| 114 | \_ -> 115 | Runner.fromTest 0 (Random.initialSeed -1) (describe "asdf" []) 116 | |> expect 117 | { steps = 1 118 | , passed = 0 119 | , status = IncompleteCustom 120 | , failures = [] 121 | } 122 | ] 123 | 124 | 125 | 126 | -- HELPERS 127 | 128 | 129 | type TestResult 130 | = Running 131 | | Fail 132 | | Todo 133 | | Pass 134 | | IncompleteSkip 135 | | IncompleteOnly 136 | | IncompleteCustom 137 | 138 | 139 | run : (() -> Test) -> Runner 140 | run f = 141 | Runner.fromTest 100 (Random.initialSeed 1) (f ()) 142 | 143 | 144 | expect : 145 | { steps : Int 146 | , passed : Int 147 | , status : TestResult 148 | , failures : 149 | List 150 | ( List String 151 | , List 152 | { given : Maybe String 153 | , message : String 154 | } 155 | ) 156 | } 157 | -> Runner 158 | -> Expect.Expectation 159 | expect final runner = 160 | let 161 | format = 162 | List.map (Runner.formatFailure identity identity) 163 | 164 | expectFinal passed failures = 165 | Expect.all 166 | [ .passed >> flip Expect.equal passed 167 | , .failures >> flip Expect.equal (format failures) 168 | ] 169 | final 170 | in 171 | case ( final.steps, final.status, Runner.step runner ) of 172 | ( 1, Running, Runner.Running { passed, failures } ) -> 173 | expectFinal passed failures 174 | 175 | ( 1, Fail, Runner.Fail passed failures ) -> 176 | expectFinal passed failures 177 | 178 | ( 1, Todo, Runner.Todo passed failures ) -> 179 | expectFinal passed failures 180 | 181 | ( 1, Pass, Runner.Pass passed ) -> 182 | Expect.equal passed final.passed 183 | 184 | ( 1, IncompleteSkip, Runner.Incomplete passed Runner.Skip ) -> 185 | Expect.equal passed final.passed 186 | 187 | ( 1, IncompleteOnly, Runner.Incomplete passed Runner.Only ) -> 188 | Expect.equal passed final.passed 189 | 190 | ( 1, IncompleteCustom, Runner.Incomplete passed (Runner.Custom _) ) -> 191 | Expect.equal passed final.passed 192 | 193 | ( steps, _, Runner.Running { next } ) -> 194 | expect { final | steps = steps - 1 } next 195 | 196 | _ -> 197 | Expect.fail <| 198 | "Given: " 199 | ++ toString runner 200 | ++ "\nExpected: " 201 | ++ toString final 202 | -------------------------------------------------------------------------------- /src/View.elm: -------------------------------------------------------------------------------- 1 | module View exposing (view) 2 | 3 | import Color exposing (Color, rgb) 4 | import Element exposing (..) 5 | import Element.Attributes exposing (..) 6 | import Html exposing (Html) 7 | import String 8 | import Style exposing (..) 9 | import Style.Border as Border 10 | import Style.Color as Color 11 | import Style.Font as Font 12 | import Test.Runner.Exploration as Runner 13 | import Test.Runner.Html.View as View 14 | import Time exposing (Time) 15 | 16 | 17 | view : View.Model -> Html a 18 | view model = 19 | Element.viewport styleSheet (app model) 20 | 21 | 22 | type Styles 23 | = None 24 | | App 25 | | Header Palette 26 | | Description Palette 27 | 28 | 29 | type Palette 30 | = Primary 31 | | Secondary 32 | | Accent 33 | | Background 34 | | Good 35 | | Bad 36 | | Warning 37 | 38 | 39 | color : Palette -> Color 40 | color palette = 41 | case palette of 42 | Primary -> 43 | rgb 41 60 75 44 | 45 | Secondary -> 46 | -- gray color on elm blog is rgb 221 221 221 but it doesn't meet 47 | -- accessibility standards for contrast http://webaim.org/resources/contrastchecker/ 48 | rgb 84 84 84 49 | 50 | Accent -> 51 | rgb 96 181 204 52 | 53 | Background -> 54 | rgb 255 255 255 55 | 56 | Good -> 57 | rgb 0 100 0 58 | 59 | Bad -> 60 | rgb 179 0 0 61 | 62 | Warning -> 63 | rgb 122 67 0 64 | 65 | 66 | withColor : 67 | (Palette -> class) 68 | -> List (Property class variation) 69 | -> List (Style class variation) 70 | withColor toStyle attributes = 71 | let 72 | withColorHelp p = 73 | style 74 | (toStyle p) 75 | (Color.text (color p) :: attributes) 76 | in 77 | List.map withColorHelp 78 | [ Primary 79 | , Secondary 80 | , Accent 81 | , Background 82 | , Good 83 | , Bad 84 | , Warning 85 | ] 86 | 87 | 88 | styleSheet : StyleSheet Styles variation 89 | styleSheet = 90 | [ [ style None 91 | [] 92 | , style App 93 | [ Color.text (color Primary) 94 | , Color.border (color Accent) 95 | , Font.typeface 96 | [ Font.font "Source Sans Pro" 97 | , Font.font "Trebuchet MS" 98 | , Font.font "Lucida Grande" 99 | , Font.font "Bitstream Vera Sans" 100 | , Font.font "Helvetica Neue" 101 | , Font.sansSerif 102 | ] 103 | , Border.top 8 104 | ] 105 | ] 106 | , withColor Description 107 | [] 108 | , withColor Header 109 | [ Font.size 24 110 | , Font.bold 111 | ] 112 | ] 113 | |> List.concat 114 | |> Style.styleSheet 115 | 116 | 117 | app : View.Model -> Element Styles variations msg 118 | app model = 119 | let 120 | wrapper nested = 121 | row App 122 | [ padding 20 ] 123 | [ el None [ width fill ] empty 124 | , el None [ width (px 960) ] nested 125 | , el None [ width fill ] empty 126 | ] 127 | in 128 | wrapper <| 129 | case model of 130 | Nothing -> 131 | "Loading Tests..." 132 | |> text 133 | |> header (Header Primary) [ paddingBottom 24 ] 134 | |> summary [] 135 | 136 | Just ( duration, Runner.Pass passed ) -> 137 | ( Good, "Test Run Passed" ) 138 | |> finished duration passed [] 139 | |> summary [] 140 | 141 | Just ( duration, Runner.Todo passed failures ) -> 142 | ( Warning, "Test Run Incomplete: TODO's remaining" ) 143 | |> finished duration passed failures 144 | |> summary failures 145 | 146 | Just ( duration, Runner.Incomplete passed Runner.Only ) -> 147 | ( Warning, "Test Run Incomplete: Test.only was used" ) 148 | |> finished duration passed [] 149 | |> summary [] 150 | 151 | Just ( duration, Runner.Incomplete passed Runner.Skip ) -> 152 | ( Warning, "Test Run Incomplete: Test.skip was used" ) 153 | |> finished duration passed [] 154 | |> summary [] 155 | 156 | Just ( duration, Runner.Incomplete passed (Runner.Custom reason) ) -> 157 | ( Warning, "Test Run Incomplete: " ++ reason ) 158 | |> finished duration passed [] 159 | |> summary [] 160 | 161 | Just ( duration, Runner.Fail passed failures ) -> 162 | ( Bad, "Test Run Failed" ) 163 | |> finished duration passed failures 164 | |> summary failures 165 | 166 | Just ( duration, Runner.Running { passed, failures, remaining } ) -> 167 | running (passed + List.length failures) remaining 168 | |> summary failures 169 | 170 | 171 | running : Int -> Int -> Element Styles variations msg 172 | running completed remaining = 173 | column None 174 | [] 175 | [ header (Header Primary) [ paddingBottom 24 ] (text "Running Tests...") 176 | , row None [] [ text (toString completed ++ " completed") ] 177 | , row None [] [ text (toString remaining ++ " remaining") ] 178 | ] 179 | 180 | 181 | finished : Time -> Int -> List a -> ( Palette, String ) -> Element Styles variation msg 182 | finished duration passed failures ( headlineColor, headlineText ) = 183 | column None 184 | [] 185 | [ header (Header headlineColor) [ paddingBottom 24 ] (text headlineText) 186 | , row None 187 | [] 188 | [ table None 189 | [ spacing 10 ] 190 | [ [ bold "Duration", bold "Passed", bold "Failed" ] 191 | , [ text (formattedDuration duration) 192 | , text (toString passed) 193 | , text (toString (List.length failures)) 194 | ] 195 | ] 196 | ] 197 | ] 198 | 199 | 200 | summary : List Runner.Failure -> Element Styles variation msg -> Element Styles variation msg 201 | summary failures message = 202 | column None 203 | [] 204 | [ wrappedRow None [] [ message ] 205 | , wrappedRow None [] [ allFailures failures ] 206 | ] 207 | 208 | 209 | allFailures : List Runner.Failure -> Element Styles variation msg 210 | allFailures failures = 211 | List.map (oneFailure >> node "li") failures 212 | |> column None 213 | [ spacing 10 214 | , padding 10 215 | ] 216 | |> node "ol" 217 | 218 | 219 | oneFailure : Runner.Failure -> Element Styles variations msg 220 | oneFailure failure = 221 | let 222 | ( labels, expectations ) = 223 | Runner.formatFailure 224 | (coloredLabel '↓' Secondary) 225 | (coloredLabel '✗' Bad) 226 | failure 227 | 228 | inContext { given, message } = 229 | column None 230 | [ spacing 10 ] 231 | [ wrappedRow None [] [ whenJust given givenCode ] 232 | , wrappedRow None [] [ code None message ] 233 | ] 234 | in 235 | el None 236 | [ inlineStyle 237 | [ ( "display", "list-item" ) 238 | , ( "margin", "10px" ) 239 | , ( "padding", "10px" ) 240 | ] 241 | ] 242 | <| 243 | column None 244 | [ spacing 5 ] 245 | (labels ++ [ spacer 3 ] ++ List.map inContext expectations) 246 | 247 | 248 | givenCode : String -> Element Styles variations msg 249 | givenCode value = 250 | code None ("Given " ++ value) 251 | 252 | 253 | coloredLabel : Char -> Palette -> String -> Element Styles variation msg 254 | coloredLabel char textColor str = 255 | column (Description textColor) 256 | [] 257 | [ text (String.cons char (String.cons ' ' str)) ] 258 | 259 | 260 | formattedDuration : Time -> String 261 | formattedDuration time = 262 | toString time ++ " ms" 263 | 264 | 265 | code : style -> String -> Element style variations msg 266 | code style str = 267 | node "pre" <| 268 | el style 269 | [ inlineStyle 270 | [ ( "white-space", "pre-wrap" ) 271 | , ( "font-family", "monospace" ) 272 | ] 273 | ] 274 | (text str) 275 | --------------------------------------------------------------------------------