├── .gitignore ├── src ├── Elmer │ ├── Navigation │ │ └── Internal.elm │ ├── Internal.elm │ ├── Value │ │ ├── Encode.elm │ │ └── Native.elm │ ├── Runtime │ │ ├── Command │ │ │ ├── Fail.elm │ │ │ ├── Generate.elm │ │ │ ├── MapState.elm │ │ │ ├── Defer.elm │ │ │ ├── Stub.elm │ │ │ └── Task.elm │ │ ├── Types.elm │ │ ├── Promise │ │ │ ├── Types.elm │ │ │ └── Runner.elm │ │ ├── Task.elm │ │ ├── Command.elm │ │ ├── Intention.elm │ │ └── Promise.elm │ ├── Html │ │ ├── Event │ │ │ ├── Types.elm │ │ │ ├── HandlerQuery.elm │ │ │ ├── Description.elm │ │ │ └── Processor.elm │ │ ├── Target.elm │ │ ├── Selector │ │ │ └── Printer.elm │ │ ├── Types.elm │ │ ├── Element │ │ │ ├── Printer.elm │ │ │ └── Internal.elm │ │ ├── Query.elm │ │ └── Element.elm │ ├── Program │ │ └── Matchers.elm │ ├── Command │ │ └── Internal.elm │ ├── Task.elm │ ├── Spy │ │ ├── Call.elm │ │ ├── Arg.elm │ │ ├── Function.elm │ │ └── Internal.elm │ ├── Message.elm │ ├── Message │ │ └── Failure.elm │ ├── Runtime.elm │ ├── Context.elm │ ├── Effects.elm │ ├── TestState.elm │ ├── Navigation.elm │ └── Program.elm └── Elm │ └── Kernel │ ├── Value.js │ └── Function.js ├── tests ├── src │ ├── Elmer │ │ ├── UrlHelpers.elm │ │ ├── TestApps │ │ │ ├── WorkerTestApp.elm │ │ │ ├── DocumentTestApp.elm │ │ │ ├── FocusTestApp.elm │ │ │ ├── SimpleTestApp.elm │ │ │ ├── TimeTestApp.elm │ │ │ ├── MessageTestApp.elm │ │ │ ├── SpyFakeTestApp.elm │ │ │ ├── InitTestApp.elm │ │ │ ├── PortTestApp.elm │ │ │ ├── ApplicationTestApp.elm │ │ │ ├── CustomElementTestApp.elm │ │ │ ├── LazyTestApp.elm │ │ │ ├── EventPropagationTestApp.elm │ │ │ ├── HtmlKeyedTestApp.elm │ │ │ ├── TripleComponentTestApp.elm │ │ │ ├── SpyTestApp.elm │ │ │ ├── NavigationTestApp.elm │ │ │ ├── SubscriptionTestApp.elm │ │ │ ├── ComponentTestApp.elm │ │ │ └── MouseTestApp.elm │ │ ├── TripleComponentTests.elm │ │ ├── WorkerTests.elm │ │ ├── RandomTests.elm │ │ ├── TestStateTests.elm │ │ ├── MessageTests.elm │ │ ├── PortTests.elm │ │ ├── GivenCommandTests.elm │ │ ├── FocusEventTests.elm │ │ ├── HtmlCustomTests.elm │ │ ├── BrowserTests.elm │ │ ├── SpySpanTests.elm │ │ ├── DocumentTests.elm │ │ ├── HtmlLazyTests.elm │ │ ├── SpyFakeTests.elm │ │ ├── TestHelpers.elm │ │ ├── ComponentTests.elm │ │ ├── HtmlKeyedTests.elm │ │ ├── ApplicationTests.elm │ │ ├── HtmlTests.elm │ │ ├── FailureTests.elm │ │ ├── RuntimeTests.elm │ │ └── EventTests.elm │ ├── Tests.elm │ └── Main.elm ├── testableModules.json ├── prepareElmJson.js ├── runTests.js ├── test.sh ├── elm.json ├── testReporter.js └── packageRegistryWriter.js ├── package.json ├── LICENSE └── elm.json /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff 2 | documentation.json 3 | node_modules 4 | tests/elm_home 5 | tests/elm.js 6 | tests/versions.dat 7 | -------------------------------------------------------------------------------- /src/Elmer/Navigation/Internal.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Navigation.Internal exposing 2 | ( NavigationState(..) 3 | ) 4 | 5 | 6 | type NavigationState 7 | = NavigationTaggers 8 | | Location 9 | -------------------------------------------------------------------------------- /src/Elmer/Internal.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Internal exposing 2 | ( boolToString 3 | ) 4 | 5 | 6 | boolToString : Bool -> String 7 | boolToString bool = 8 | case bool of 9 | True -> 10 | "true" 11 | False -> 12 | "false" 13 | -------------------------------------------------------------------------------- /tests/src/Elmer/UrlHelpers.elm: -------------------------------------------------------------------------------- 1 | module Elmer.UrlHelpers exposing (..) 2 | 3 | import Url exposing (Url) 4 | 5 | 6 | asUrl : String -> Url 7 | asUrl urlString = 8 | case Url.fromString urlString of 9 | Just url -> 10 | url 11 | Nothing -> 12 | Debug.todo <| "Could not parse url: " ++ urlString -------------------------------------------------------------------------------- /tests/testableModules.json: -------------------------------------------------------------------------------- 1 | { 2 | "exposed-modules": [ 3 | "Elmer.Html.Types", 4 | "Elmer.Html.Node", 5 | "Elmer.Html.Element.Printer", 6 | "Elmer.Html.Selector.Printer", 7 | "Elmer.TestState", 8 | "Elmer.Spy.Arg", 9 | "Elmer.Runtime", 10 | "Elmer.Errors" 11 | ] 12 | } -------------------------------------------------------------------------------- /tests/prepareElmJson.js: -------------------------------------------------------------------------------- 1 | const fs = require('fs') 2 | 3 | const testableModulesFile = process.argv[2] 4 | const inputFile = process.argv[3] 5 | const outputFile = process.argv[4] 6 | 7 | let testableModulesJson = JSON.parse(fs.readFileSync(testableModulesFile)) 8 | let elmJson = JSON.parse(fs.readFileSync(inputFile)) 9 | 10 | elmJson["exposed-modules"] = elmJson["exposed-modules"].concat(testableModulesJson["exposed-modules"]) 11 | 12 | fs.writeFileSync(outputFile, JSON.stringify(elmJson, null, 2)) 13 | 14 | -------------------------------------------------------------------------------- /src/Elmer/Value/Encode.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Value.Encode exposing 2 | ( for 3 | , encode 4 | ) 5 | 6 | import Json.Encode as Encode 7 | import Elmer.Value.Native as Native 8 | 9 | type Value 10 | = Value 11 | 12 | for : a -> Value 13 | for = 14 | Native.cast 15 | 16 | encode : Value -> List (String, Value) -> b 17 | encode ctor args = 18 | ( "$", Native.wrap ctor ) :: (List.map (\(key, value) -> (key, Native.wrap value)) args) 19 | |> Encode.object 20 | |> Native.unwrap 21 | |> Native.cast 22 | -------------------------------------------------------------------------------- /tests/runTests.js: -------------------------------------------------------------------------------- 1 | const Elm = require("./elm.js") 2 | const reporter = require("./testReporter") 3 | 4 | 5 | var app = Elm.Elm.Main.init(); 6 | 7 | app.ports.sendTestEvent.subscribe((event) => { 8 | if (event === "DONE") { 9 | reporter.testSuiteDidFinish() 10 | } 11 | }) 12 | 13 | app.ports.sendTestResult.subscribe((testResult) => { 14 | reporter.testDidFinish(testResult) 15 | app.ports.runNextTest.send(null) 16 | }) 17 | 18 | reporter.testSuiteWillStart() 19 | app.ports.runNextTest.send(null) 20 | 21 | 22 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Command/Fail.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Command.Fail exposing 2 | ( with 3 | , commandRunner 4 | , name 5 | ) 6 | 7 | import Elmer.Runtime.Types exposing (..) 8 | import Elmer.Runtime.Intention as Intention 9 | import Elmer.Context as Context exposing (Context) 10 | 11 | 12 | name : String 13 | name = 14 | "Elmer_Fail" 15 | 16 | commandRunner : CommandRunner model subMsg msg 17 | commandRunner command _ = 18 | let 19 | message = Intention.cmdValue command 20 | in 21 | CommandError message 22 | 23 | with : String -> Cmd msg 24 | with = 25 | Intention.toCmd name 26 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Types.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Types exposing 2 | ( CommandResult(..) 3 | , CommandEffect 4 | , CommandRunner 5 | , RuntimeResult 6 | ) 7 | 8 | import Elmer.Context exposing (Context) 9 | 10 | type CommandResult model msg 11 | = CommandSuccess (CommandEffect model msg) 12 | | CommandError String 13 | 14 | type alias CommandEffect model msg = 15 | Context model msg -> (Context model msg, Cmd msg) 16 | 17 | type alias CommandRunner model subMsg msg = 18 | Cmd subMsg -> (subMsg -> msg) -> CommandResult model msg 19 | 20 | type alias RuntimeResult model msg = 21 | Result String (Context model msg) 22 | -------------------------------------------------------------------------------- /tests/test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -ex 4 | 5 | export ELM="../node_modules/.bin/elm" 6 | export ELMER_VERSION="6.0.0" 7 | export ELM_HOME="$(pwd)"/elm_home 8 | export ELM_PACKAGES_HOME="${ELM_HOME}/0.19.0/package" 9 | export ELMER_HOME="${ELM_PACKAGES_HOME}/elm-explorations/elmer/${ELMER_VERSION}" 10 | 11 | rm -f elm.js 12 | rm -rf elm-stuff 13 | rm -rf ${ELMER_HOME} 14 | 15 | mkdir -p ${ELMER_HOME} 16 | 17 | cp -R ../src ${ELMER_HOME}/ 18 | node ./prepareElmJson.js ./testableModules.json ../elm.json ${ELMER_HOME}/elm.json 19 | 20 | node ./packageRegistryWriter.js ${ELM_PACKAGES_HOME}/versions.dat 21 | 22 | ${ELM} make src/Main.elm --output elm.js 23 | 24 | node runTests.js 25 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/WorkerTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.WorkerTestApp exposing (..) 2 | 3 | type Msg 4 | = ReceivedData String 5 | 6 | type alias Model = 7 | { data: String 8 | } 9 | 10 | -- port incomingData : (String -> msg) -> Sub msg 11 | incomingData : (String -> msg) -> Sub msg 12 | incomingData _ = 13 | Sub.none 14 | 15 | initialModel : Model 16 | initialModel = 17 | { data = "" 18 | } 19 | 20 | update : Msg -> Model -> (Model, Cmd Msg) 21 | update msg model = 22 | case msg of 23 | ReceivedData data -> 24 | ( { model | data = data }, Cmd.none ) 25 | 26 | subscriptions : Model -> Sub Msg 27 | subscriptions model = 28 | incomingData ReceivedData 29 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "elmer", 3 | "version": "1.0.0", 4 | "description": "A test framework for Elm", 5 | "main": "index.js", 6 | "directories": { 7 | "test": "tests" 8 | }, 9 | "scripts": { 10 | "build:docs": "elm make --docs=documentation.json" 11 | }, 12 | "repository": { 13 | "type": "git", 14 | "url": "git+https://github.com/brian-watkins/elmer.git" 15 | }, 16 | "author": "Brian Watkins", 17 | "license": "MIT", 18 | "bugs": { 19 | "url": "https://github.com/brian-watkins/elmer/issues" 20 | }, 21 | "homepage": "https://github.com/brian-watkins/elmer#readme", 22 | "devDependencies": { 23 | "elm": "^0.19.0-bugfix6" 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /src/Elmer/Html/Event/Types.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Event.Types exposing 2 | ( EventHandlerQuery 3 | , EventHandler 4 | , EventResult 5 | , EventJson 6 | , EventDescription 7 | ) 8 | 9 | import Html exposing (Html) 10 | import Elmer.Html.Types exposing (..) 11 | 12 | type alias EventHandlerQuery msg = 13 | Html msg -> HtmlElement msg -> List (HtmlEventHandler msg) 14 | 15 | type alias EventHandler msg = 16 | EventJson -> EventResult msg 17 | 18 | type alias EventResult msg = 19 | Result String (HtmlEventValue msg) 20 | 21 | type alias EventJson = 22 | String 23 | 24 | type alias EventDescription msg = 25 | { handlers : EventHandlerQuery msg 26 | , eventJson : EventJson 27 | , eventType: String 28 | } 29 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Promise/Types.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Promise.Types exposing 2 | ( Promise(..) 3 | , Resolution(..) 4 | , Continuation 5 | , Promised 6 | ) 7 | 8 | import Json.Decode as Json exposing (Value) 9 | 10 | 11 | type Promise msg 12 | = Complete (Resolution msg) 13 | | Continue (Continuation msg) 14 | | AndDo (Cmd msg) (Promise msg) 15 | | Defer (Promise msg) 16 | 17 | 18 | type alias Continuation msg = 19 | { next : Promise msg 20 | , onResolve : Maybe (Value -> Value) 21 | , onReject : Maybe (Value -> Value) 22 | } 23 | 24 | 25 | type Resolution msg 26 | = Resolved Value 27 | | Rejected Value 28 | | Aborted (Cmd msg) 29 | 30 | 31 | type alias Promised msg = 32 | { resolution: Resolution msg 33 | , shouldDefer: Bool 34 | , commands: List (Cmd msg) 35 | } 36 | -------------------------------------------------------------------------------- /tests/elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "/Users/bwatkins/work/elmer/tests/src" 5 | ], 6 | "elm-version": "0.19.0", 7 | "dependencies": { 8 | "direct": { 9 | "elm/browser": "1.0.1", 10 | "elm/core": "1.0.0", 11 | "elm/html": "1.0.0", 12 | "elm/json": "1.0.0", 13 | "elm/random": "1.0.0", 14 | "elm/time": "1.0.0", 15 | "elm/url": "1.0.0", 16 | "elm-explorations/elmer": "6.0.0", 17 | "elm-explorations/markdown": "1.0.0", 18 | "elm-explorations/test": "1.1.0" 19 | }, 20 | "indirect": { 21 | "elm/virtual-dom": "1.0.0" 22 | } 23 | }, 24 | "test-dependencies": { 25 | "direct": {}, 26 | "indirect": {} 27 | } 28 | } -------------------------------------------------------------------------------- /src/Elm/Kernel/Value.js: -------------------------------------------------------------------------------- 1 | /* 2 | */ 3 | 4 | function _Value_global(name) { 5 | return eval(name) 6 | } 7 | 8 | function _Value_cast(value) { 9 | return value 10 | } 11 | 12 | function _Value_nativeType(value) { 13 | var type = typeof(value) 14 | if (type === "number") { 15 | if (Number.isInteger(value)) { 16 | type = "int" 17 | } else { 18 | type = "float" 19 | } 20 | } 21 | return type 22 | } 23 | 24 | var _Value_assign = F2(function(name, value) { 25 | eval(name + " = value") 26 | return value 27 | }) 28 | 29 | var _Value_print = F2(function(label, value) { 30 | console.log(label, value) 31 | return value 32 | }) 33 | 34 | function _Value_wrap(value) { 35 | return { '$': 0, 'a': value } 36 | } 37 | 38 | function _Value_unwrap(value) { 39 | if (value.$ === 0) { 40 | return value.a 41 | } 42 | return value 43 | } -------------------------------------------------------------------------------- /src/Elmer/Runtime/Command/Generate.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Command.Generate exposing 2 | ( with 3 | , commandRunner 4 | , name 5 | ) 6 | 7 | import Elmer.Runtime.Types exposing (..) 8 | import Elmer.Runtime.Intention as Intention 9 | import Elmer.Context as Context exposing (Context) 10 | 11 | 12 | name : String 13 | name = 14 | "Elmer_Generate" 15 | 16 | 17 | with : (Context model msg -> Cmd msg) -> Cmd msg 18 | with = 19 | Intention.toCmd name 20 | 21 | 22 | commandRunner : CommandRunner model subMsg msg 23 | commandRunner command _ = 24 | let 25 | generator = Intention.cmdValue command 26 | in 27 | CommandSuccess (generateCommand generator) 28 | 29 | 30 | generateCommand : (Context model msg -> Cmd msg) -> Context model msg -> ( Context model msg, Cmd msg ) 31 | generateCommand generator context = 32 | ( context, generator context ) 33 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/DocumentTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.DocumentTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Browser exposing (Document) 6 | 7 | 8 | type Msg 9 | = Msg 10 | 11 | type alias Model = 12 | { name : String } 13 | 14 | init : () -> ( Model, Cmd Msg ) 15 | init _ = 16 | ( { name = "Cool Dude" }, Cmd.none ) 17 | 18 | view : Model -> Document Msg 19 | view model = 20 | { title = "Fun Title" 21 | , body = [ pageView model ] 22 | } 23 | 24 | pageView : Model -> Html Msg 25 | pageView model = 26 | Html.div [] 27 | [ Html.div [ Attr.id "some-element" ] 28 | [ Html.text "Fun Stuff" ] 29 | ] 30 | 31 | update : Msg -> Model -> (Model, Cmd Msg) 32 | update msg model = 33 | ( model, Cmd.none ) 34 | 35 | subscriptions : Model -> Sub Msg 36 | subscriptions _ = 37 | Sub.none 38 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Command/MapState.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Command.MapState exposing 2 | ( with 3 | , commandRunner 4 | , name 5 | ) 6 | 7 | import Elmer.Runtime.Intention as Intention 8 | import Elmer.Runtime.Types exposing (..) 9 | import Elmer.Context as Context exposing (Context) 10 | 11 | 12 | name : String 13 | name = 14 | "Elmer_MapState" 15 | 16 | 17 | with : typeId -> (Maybe a -> a) -> Cmd msg 18 | with typeId mapper = 19 | Intention.toCmd name { typeId = typeId, mapper = mapper } 20 | 21 | 22 | commandRunner : CommandRunner model subMsg msg 23 | commandRunner command tagger = 24 | CommandSuccess (storeStateCommand <| Cmd.map tagger command) 25 | 26 | 27 | storeStateCommand : Cmd msg -> Context model msg -> ( Context model msg, Cmd msg ) 28 | storeStateCommand command context = 29 | ( Context.updateState command context 30 | , Cmd.none 31 | ) 32 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/FocusTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.FocusTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events exposing (onFocus, onBlur) 6 | 7 | type alias Model = 8 | { isFocused : Bool 9 | , isBlurred : Bool 10 | } 11 | 12 | type Msg 13 | = Focused 14 | | Blurred 15 | 16 | defaultModel : Model 17 | defaultModel = 18 | { isFocused = False 19 | , isBlurred = False 20 | } 21 | 22 | view : Model -> Html Msg 23 | view model = 24 | Html.div [ Attr.id "root" ] 25 | [ Html.input [ Attr.id "name-field", Attr.type_ "text", onFocus Focused, onBlur Blurred ] [] ] 26 | 27 | update : Msg -> Model -> ( Model, Cmd Msg ) 28 | update msg model = 29 | case msg of 30 | Focused -> 31 | ( { model | isFocused = True }, Cmd.none ) 32 | Blurred -> 33 | ( { model | isBlurred = True }, Cmd.none ) 34 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Command/Defer.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Command.Defer exposing 2 | ( with 3 | , clear 4 | , fromContext 5 | ) 6 | 7 | import Elmer.Context as Context exposing (Context) 8 | import Elmer.Runtime.Command.MapState as MapState 9 | 10 | 11 | type DeferState 12 | = DeferredCommands 13 | 14 | 15 | clear : Cmd msg 16 | clear = 17 | MapState.with DeferredCommands <| 18 | \_ -> [] 19 | 20 | 21 | fromContext : Context model msg -> List (Cmd msg) 22 | fromContext context = 23 | Context.state DeferredCommands context 24 | |> Maybe.withDefault [] 25 | 26 | 27 | with : Cmd msg -> Cmd msg 28 | with command = 29 | MapState.with DeferredCommands <| 30 | updateStateWithDeferredCommand command 31 | 32 | 33 | updateStateWithDeferredCommand : Cmd msg -> Maybe (List (Cmd msg)) -> List (Cmd msg) 34 | updateStateWithDeferredCommand command state = 35 | Maybe.withDefault [] state 36 | |> (::) command 37 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/SimpleTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.SimpleTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | 6 | type alias Model = 7 | { name : String } 8 | 9 | type Msg = Msg 10 | 11 | defaultModel : Model 12 | defaultModel = 13 | { name = "Cool Person" } 14 | 15 | view : Model -> Html Msg 16 | view model = 17 | Html.div 18 | [ Attr.id "root", Attr.class "styled no-events" ] 19 | [ Html.text "Some text" ] 20 | 21 | viewWithChildren : Model -> Html Msg 22 | viewWithChildren model = 23 | Html.div [ Attr.id "root", Attr.class "styled" ] 24 | [ Html.div [] [ Html.text "Some text" ] 25 | , Html.div [] [ Html.div [] [ Html.text "Child text" ] ] 26 | ] 27 | 28 | textView : Model -> Html Msg 29 | textView model = 30 | Html.text "Some text" 31 | 32 | update : Msg -> Model -> ( Model, Cmd Msg ) 33 | update msg model = 34 | ( model, Cmd.none ) 35 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Command/Stub.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Command.Stub exposing 2 | ( with 3 | , commandRunner 4 | , name 5 | ) 6 | 7 | import Elmer.Runtime.Types exposing (..) 8 | import Elmer.Runtime.Intention as Intention 9 | import Elmer.Context as Context exposing (Context) 10 | import Elmer.Runtime.Command.Fail as Fail 11 | import Elmer.Errors as Errors 12 | 13 | 14 | name : String 15 | name = 16 | "Elmer_Stub" 17 | 18 | 19 | with : msg -> Cmd msg 20 | with = 21 | Intention.toCmd name 22 | 23 | 24 | commandRunner : CommandRunner model subMsg msg 25 | commandRunner command tagger = 26 | let 27 | msg = 28 | Intention.cmdValue command 29 | |> tagger 30 | in 31 | processStub msg 32 | |> CommandSuccess 33 | 34 | 35 | processStub : msg -> CommandEffect model msg 36 | processStub msg context = 37 | case Context.update msg context of 38 | Just tuple -> 39 | tuple 40 | Nothing -> 41 | (context, Fail.with <| Errors.print Errors.noModel) -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/TimeTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.TimeTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events exposing (onClick) 6 | import Time exposing (Posix) 7 | import Task exposing (Task) 8 | 9 | type alias Model = 10 | { time : Int } 11 | 12 | type Msg 13 | = GetTime 14 | | NewTime Posix 15 | 16 | defaultModel : Model 17 | defaultModel = 18 | { time = 0 } 19 | 20 | view : Model -> Html Msg 21 | view model = 22 | Html.div [Attr.id "root"] 23 | [ Html.div [ Attr.id "currentTime" ] [ Html.text ("Time: " ++ (String.fromInt model.time)) ] 24 | , Html.div [ Attr.class "button", onClick GetTime ] [ Html.text "Click me for the time!" ] 25 | ] 26 | 27 | update : Msg -> Model -> ( Model, Cmd Msg ) 28 | update msg model = 29 | case msg of 30 | GetTime -> 31 | ( model, Task.perform NewTime Time.now ) 32 | NewTime time -> 33 | ( { model | time = Time.posixToMillis time }, Cmd.none ) 34 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/MessageTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.MessageTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | 6 | type alias Model = 7 | { firstMessage : String 8 | , secondMessage : String 9 | } 10 | 11 | defaultModel : Model 12 | defaultModel = 13 | { firstMessage = "" 14 | , secondMessage = "" 15 | } 16 | 17 | type Msg 18 | = RenderFirstMessage String 19 | | RenderSecondMessage String 20 | 21 | view : Model -> Html Msg 22 | view model = 23 | Html.div [ Attr.id "root" ] 24 | [ Html.div [ Attr.id "first-message" ] 25 | [ Html.text model.firstMessage ] 26 | , Html.div [ Attr.id "second-message" ] 27 | [ Html.text model.secondMessage ] 28 | ] 29 | 30 | update : Msg -> Model -> ( Model, Cmd Msg ) 31 | update msg model = 32 | case msg of 33 | RenderFirstMessage str -> 34 | ( { model | firstMessage = str }, Cmd.none ) 35 | RenderSecondMessage str -> 36 | ( { model | secondMessage = str }, Cmd.none ) 37 | -------------------------------------------------------------------------------- /src/Elmer/Html/Target.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Target exposing 2 | ( forHtml 3 | , forElement 4 | , forContext 5 | ) 6 | 7 | import Elmer.Context as Context exposing (Context) 8 | import Elmer.Html.Node as Node 9 | import Elmer.Html.Types exposing (HtmlTarget(..), HtmlSelectorGroup, HtmlElement, HtmlState(..)) 10 | import Html exposing (Html) 11 | 12 | 13 | forHtml : HtmlSelectorGroup msg -> Html msg -> HtmlTarget msg 14 | forHtml selector html = 15 | HtmlTarget 16 | { selector = selector 17 | , element = 18 | Node.from html 19 | |> Node.asElement 20 | } 21 | 22 | 23 | forElement : HtmlSelectorGroup msg -> HtmlElement msg -> HtmlTarget msg 24 | forElement selector element = 25 | HtmlTarget 26 | { selector = selector 27 | , element = Just element 28 | } 29 | 30 | 31 | forContext : Context model msg -> Maybe (HtmlTarget msg) 32 | forContext context = 33 | Maybe.map2 (\selector view -> forHtml selector view) 34 | (Context.state TargetSelector context) 35 | (Context.render context) 36 | -------------------------------------------------------------------------------- /tests/src/Elmer/TripleComponentTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TripleComponentTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | 6 | import Elmer exposing (..) 7 | import Elmer.Html.Event as Event 8 | import Elmer.Html.Matchers as Matchers exposing (element, hasText) 9 | import Elmer.Html.Selector as Sel exposing (..) 10 | import Elmer.Spy as Spy 11 | import Elmer.Command as Command 12 | import Elmer.Html as Markup 13 | import Elmer.Navigation as ElmerNav 14 | 15 | import Elmer.TestApps.TripleComponentTestApp as App exposing (..) 16 | 17 | all : Test 18 | all = 19 | Test.concat 20 | [ appTests 21 | ] 22 | 23 | 24 | appTests : Test 25 | appTests = 26 | describe "Triple component" 27 | [ test "it handles a click from the grandchild component" <| 28 | \() -> 29 | Elmer.given App.defaultModel App.view App.update 30 | |> Markup.target << by [ Sel.tag "button" ] 31 | |> Event.click 32 | |> Markup.target << by [ Sel.id "grand-child-name" ] 33 | |> Markup.expect (element <| hasText "Handled Click") 34 | ] 35 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Task.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Task exposing 2 | ( mapState 3 | , abortWith 4 | , abandon 5 | , defer 6 | ) 7 | 8 | import Json.Encode as Encode exposing (Value) 9 | import Elmer.Value.Encode as Value 10 | import Task exposing (Task) 11 | import Elmer.Runtime.Command.MapState 12 | 13 | 14 | defer : Task x a -> Task x a 15 | defer task = 16 | Value.encode (Value.for 1003) 17 | [ ( "task", Value.for task ) 18 | ] 19 | 20 | 21 | mapState : typeId -> (Maybe a -> a) -> Task x b -> Task x b 22 | mapState typeId mapper = 23 | andDo <| 24 | Elmer.Runtime.Command.MapState.with typeId mapper 25 | 26 | 27 | andDo : Cmd msg -> Task x a -> Task x a 28 | andDo command task = 29 | Value.encode (Value.for 1001) 30 | [ ( "task", Value.for task ) 31 | , ( "command", Value.for command ) 32 | ] 33 | 34 | 35 | abortWith : Cmd msg -> Task x a 36 | abortWith command = 37 | Value.encode (Value.for 1002) 38 | [ ( "command", Value.for command ) 39 | ] 40 | 41 | 42 | abandon : Task x a 43 | abandon = 44 | abortWith Cmd.none 45 | -------------------------------------------------------------------------------- /src/Elmer/Html/Selector/Printer.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Selector.Printer exposing 2 | ( printGroup 3 | , print 4 | ) 5 | 6 | {-| Exposed for testing 7 | 8 | @docs printGroup, print 9 | 10 | -} 11 | 12 | import Elmer.Html.Types exposing (HtmlSelectorGroup(..), HtmlSelector) 13 | 14 | {-| 15 | -} 16 | printGroup : HtmlSelectorGroup msg -> String 17 | printGroup selectorGroup = 18 | case selectorGroup of 19 | ElementWith selectors -> 20 | "by " ++ printSelectors selectors 21 | DescendantsOf selectors group -> 22 | "descendants of " ++ printSelectors selectors ++ " " ++ printGroup group 23 | ChildrenOf selectors group -> 24 | "children of " ++ printSelectors selectors ++ " " ++ printGroup group 25 | 26 | 27 | printSelectors : List (HtmlSelector msg) -> String 28 | printSelectors selectors = 29 | let 30 | selectorText = 31 | List.map print selectors 32 | |> String.join ", " 33 | in 34 | "[ " ++ selectorText ++ " ]" 35 | 36 | {-| 37 | -} 38 | print : HtmlSelector msg -> String 39 | print selector = 40 | selector.description -------------------------------------------------------------------------------- /tests/src/Elmer/WorkerTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.WorkerTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer 6 | import Elmer.Subscription as Subscription 7 | import Elmer.Spy as Spy exposing (Spy, andCallFake) 8 | import Elmer.Program 9 | import Elmer.TestApps.WorkerTestApp as App 10 | 11 | 12 | all : Test 13 | all = 14 | Test.concat 15 | [ workerTests 16 | ] 17 | 18 | 19 | fakeSub : Spy 20 | fakeSub = 21 | Spy.observe (\_ -> App.incomingData) 22 | |> andCallFake (\tagger -> 23 | Subscription.fake "fake-sub" tagger 24 | ) 25 | 26 | workerTests : Test 27 | workerTests = 28 | describe "given" 29 | [ test "it create a TestState for the worker" <| 30 | \() -> 31 | Elmer.Program.givenWorker App.update 32 | |> Spy.use [ fakeSub ] 33 | |> Elmer.Program.init (\() -> (App.initialModel, Cmd.none)) 34 | |> Subscription.with (\() -> App.subscriptions) 35 | |> Subscription.send "fake-sub" "Yo" 36 | |> Elmer.expectModel (\model -> 37 | Expect.equal model.data "Yo" 38 | ) 39 | ] 40 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2016 Brian Watkins 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /src/Elmer/Value/Native.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Value.Native exposing 2 | ( global 3 | , cast 4 | , nativeType 5 | , assign 6 | , wrap 7 | , unwrap 8 | , decode 9 | , decoder 10 | , field 11 | , constructor 12 | ) 13 | 14 | import Json.Decode as Json 15 | import Elm.Kernel.Value 16 | 17 | 18 | constructor : Json.Decoder Int 19 | constructor = 20 | Json.field "$" Json.int 21 | 22 | 23 | field : String -> Json.Decoder a 24 | field key = 25 | Json.field key decoder 26 | 27 | 28 | decoder : Json.Decoder a 29 | decoder = 30 | Json.map unwrap Json.value 31 | 32 | 33 | decode : Json.Decoder a -> v -> Result Json.Error b 34 | decode valueDecoder value = 35 | wrap value 36 | |> Json.decodeValue valueDecoder 37 | |> Result.map unwrap 38 | 39 | 40 | cast : a -> b 41 | cast = 42 | Elm.Kernel.Value.cast 43 | 44 | 45 | nativeType : a -> String 46 | nativeType = 47 | Elm.Kernel.Value.nativeType 48 | 49 | 50 | assign : String -> v -> v 51 | assign = 52 | Elm.Kernel.Value.assign 53 | 54 | 55 | global : String -> a 56 | global = 57 | Elm.Kernel.Value.global 58 | 59 | 60 | wrap : a -> v 61 | wrap = 62 | Elm.Kernel.Value.wrap 63 | 64 | 65 | unwrap : a -> v 66 | unwrap = 67 | Elm.Kernel.Value.unwrap -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "package", 3 | "name": "elm-explorations/elmer", 4 | "summary": "Behavior-driven development for Elm Html applications", 5 | "license": "MIT", 6 | "version": "6.0.0", 7 | "exposed-modules": [ 8 | "Elmer", 9 | "Elmer.Html", 10 | "Elmer.Html.Matchers", 11 | "Elmer.Html.Event", 12 | "Elmer.Html.Element", 13 | "Elmer.Html.Selector", 14 | "Elmer.Navigation", 15 | "Elmer.Command", 16 | "Elmer.Message", 17 | "Elmer.Message.Failure", 18 | "Elmer.Value", 19 | "Elmer.Program", 20 | "Elmer.Program.Matchers", 21 | "Elmer.Effects", 22 | "Elmer.Spy", 23 | "Elmer.Spy.Matchers", 24 | "Elmer.Subscription", 25 | "Elmer.Task" 26 | ], 27 | "elm-version": "0.19.0 <= v < 0.20.0", 28 | "dependencies": { 29 | "elm/browser": "1.0.0 <= v < 2.0.0", 30 | "elm/core": "1.0.0 <= v < 2.0.0", 31 | "elm/html": "1.0.0 <= v < 2.0.0", 32 | "elm/json": "1.0.0 <= v < 2.0.0", 33 | "elm/random": "1.0.0 <= v < 2.0.0", 34 | "elm/url": "1.0.0 <= v < 2.0.0", 35 | "elm-explorations/test": "1.0.0 <= v < 2.0.0" 36 | }, 37 | "test-dependencies": {} 38 | } -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/SpyFakeTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.SpyFakeTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events as Events 6 | 7 | type alias Model = 8 | { name: String 9 | , number: Int 10 | } 11 | 12 | type Msg 13 | = FetchName 14 | | FetchedName String 15 | 16 | type alias Dependencies = 17 | { fetchName : (String -> Msg) -> String -> Cmd Msg 18 | , getNumber : String -> Int 19 | } 20 | 21 | initialModel : Model 22 | initialModel = 23 | { name = "" 24 | , number = 0 25 | } 26 | 27 | view : Model -> Html Msg 28 | view model = 29 | Html.div [] 30 | [ Html.button [ Attr.id "fetch-name-button", Events.onClick FetchName ] 31 | [ Html.text "Click for name" ] 32 | , Html.div [] 33 | [ Html.text <| "Name" ++ model.name ] 34 | , Html.div [] 35 | [ Html.text <| "Your number is: " ++ String.fromInt model.number ] 36 | ] 37 | 38 | update : Dependencies -> Msg -> Model -> (Model, Cmd Msg) 39 | update deps message model = 40 | case message of 41 | FetchName -> 42 | ( model 43 | , deps.fetchName FetchedName "Cool Dude" 44 | ) 45 | FetchedName name -> 46 | ( { model 47 | | name = name 48 | , number = deps.getNumber name 49 | } 50 | , Cmd.none 51 | ) 52 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/InitTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.InitTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Task exposing (Task) 6 | 7 | 8 | type alias Model = 9 | { name : String 10 | , baseUrl : String 11 | , token : String 12 | } 13 | 14 | type Msg 15 | = TokenRequest (Result String String) 16 | | Tag String 17 | 18 | defaultModel : String -> Model 19 | defaultModel baseUrl = 20 | { name = "Cool Person" 21 | , baseUrl = baseUrl 22 | , token = "" 23 | } 24 | 25 | type alias Flags = 26 | { baseUrl: String 27 | } 28 | 29 | init : Flags -> ( Model, Cmd Msg ) 30 | init flags = 31 | ( defaultModel flags.baseUrl, requestTokenTask "/fun/token" |> Task.attempt TokenRequest ) 32 | 33 | requestTokenTask : String -> Task String String 34 | requestTokenTask path = 35 | Task.succeed "Succeed" 36 | 37 | view : Model -> Html Msg 38 | view model = 39 | Html.div [ Attr.id "base-url" ] 40 | [ Html.text model.baseUrl ] 41 | 42 | update : Msg -> Model -> ( Model, Cmd Msg ) 43 | update msg model = 44 | case msg of 45 | TokenRequest result -> 46 | case result of 47 | Ok token -> 48 | ( { model | token = token }, Cmd.none ) 49 | _ -> 50 | ( model, Cmd.none ) 51 | _ -> 52 | ( model, Cmd.none ) 53 | -------------------------------------------------------------------------------- /tests/src/Elmer/RandomTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.RandomTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer exposing (exactly) 6 | import Elmer.Command as Command 7 | import Elmer.Spy as Spy exposing (Spy, andCallFake) 8 | import Elmer.Command as Command 9 | import Random 10 | 11 | 12 | all : Test 13 | all = 14 | Test.concat 15 | [ randomTest 16 | ] 17 | 18 | 19 | type TestMsg 20 | = RandomInt Int 21 | 22 | 23 | randomCommand : (Int -> TestMsg) -> Cmd TestMsg 24 | randomCommand tagger = 25 | Random.int 0 10 26 | |> Random.andThen (\i -> Random.int i 10) 27 | |> Random.generate tagger 28 | 29 | 30 | randomGenerateSpy : Spy 31 | randomGenerateSpy = 32 | Spy.observe (\_ -> Random.generate) 33 | |> andCallFake (\tagger generator -> 34 | Random.initialSeed 27852 35 | |> Random.step generator 36 | |> Tuple.first 37 | |> tagger 38 | |> Command.fake 39 | ) 40 | 41 | 42 | randomTest : Test 43 | randomTest = 44 | describe "when a random value is requested" 45 | [ test "it returns a value provided by the generator" <| 46 | \() -> 47 | Command.given (\_ -> randomCommand RandomInt) 48 | |> Spy.use [ randomGenerateSpy ] 49 | |> Command.expectMessages (exactly 1 <| 50 | Expect.equal <| RandomInt 8 51 | ) 52 | ] 53 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/PortTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.PortTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events as Events 6 | 7 | -- port sendJsData : String -> Cmd msg 8 | sendJsData : String -> Cmd msg 9 | sendJsData _ = 10 | Cmd.none 11 | 12 | -- port receiveJsData : (String -> msg) -> Sub msg 13 | receiveJsData : (String -> msg) -> Sub msg 14 | receiveJsData _ = 15 | Sub.none 16 | 17 | 18 | type alias Model = 19 | { name : String 20 | , jsData : String 21 | } 22 | 23 | type Msg 24 | = HandleClick 25 | | ReceivedData String 26 | 27 | defaultModel : Model 28 | defaultModel = 29 | { name = "Cool Person" 30 | , jsData = "" 31 | } 32 | 33 | view : Model -> Html Msg 34 | view model = 35 | Html.div [ Attr.id "root" ] 36 | [ Html.div [ Attr.id "send-port-command-button", Events.onClick HandleClick ] 37 | [ Html.text "Click me!" ] 38 | , Html.div [ Attr.id "js-data" ] 39 | [ Html.text model.jsData ] 40 | ] 41 | 42 | update : Msg -> Model -> ( Model, Cmd Msg ) 43 | update msg model = 44 | case msg of 45 | HandleClick -> 46 | ( model, sendJsData "Hey!" ) 47 | ReceivedData message -> 48 | ( { model | jsData = message }, Cmd.none ) 49 | 50 | subscriptions : Model -> Sub Msg 51 | subscriptions model = 52 | receiveJsData ReceivedData 53 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/ApplicationTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.ApplicationTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events exposing (onClick) 6 | import Browser exposing (Document, UrlRequest) 7 | import Browser.Navigation as Navigation 8 | import Url exposing (Url) 9 | import Time 10 | import Task 11 | 12 | type Msg 13 | = OnUrlRequest UrlRequest 14 | | OnUrlChange Url 15 | | FunTaskResult String 16 | 17 | type alias Model = 18 | { name : String } 19 | 20 | init : () -> Url -> Navigation.Key -> ( Model, Cmd Msg ) 21 | init _ _ _ = 22 | ( { name = "Cool Dude" }, Cmd.none ) 23 | 24 | view : Model -> Document Msg 25 | view model = 26 | { title = "Fun Title" 27 | , body = [ pageView model ] 28 | } 29 | 30 | pageView : Model -> Html Msg 31 | pageView model = 32 | Html.div [] 33 | [ Html.div [ Attr.id "some-element" ] 34 | [ Html.text "Fun Stuff" ] 35 | ] 36 | 37 | update : Msg -> Model -> (Model, Cmd Msg) 38 | update msg model = 39 | ( model, Cmd.none ) 40 | 41 | subscriptions : Model -> Sub Msg 42 | subscriptions _ = 43 | Sub.none 44 | 45 | funCommand : (String -> Msg) -> String -> Cmd Msg 46 | funCommand tagger message = 47 | Time.now 48 | |> Task.map Time.posixToMillis 49 | |> Task.map (\millis -> message ++ String.fromInt millis) 50 | |> Task.perform tagger -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/CustomElementTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.CustomElementTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events as Events 6 | import Markdown 7 | 8 | type Msg 9 | = DoSomething 10 | | HandleBubbledEvent 11 | 12 | type alias Model = 13 | { name : String 14 | , markdown : String 15 | } 16 | 17 | defaultModel : String -> Model 18 | defaultModel markdown = 19 | { name = "Dude" 20 | , markdown = markdown 21 | } 22 | 23 | view : Model -> Html Msg 24 | view model = 25 | Html.div [ Events.onClick HandleBubbledEvent ] 26 | [ Markdown.toHtml 27 | [ Attr.id "markdown-content" 28 | , Attr.attribute "data-attr" "funStuff" 29 | , Attr.style "position" "absolute" 30 | , Events.onClick DoSomething 31 | ] 32 | model.markdown 33 | ] 34 | 35 | bubbleView : Model -> Html Msg 36 | bubbleView model = 37 | Html.div [ Events.onClick HandleBubbledEvent ] 38 | [ Markdown.toHtml 39 | [ Attr.id "markdown-content" 40 | , Attr.attribute "data-attr" model.name 41 | , Attr.style "position" "absolute" 42 | ] 43 | model.markdown 44 | ] 45 | 46 | 47 | update : Msg -> Model -> (Model, Cmd Msg) 48 | update msg model = 49 | case msg of 50 | DoSomething -> 51 | ( model, Cmd.none ) 52 | HandleBubbledEvent -> 53 | ( { model | name = "Bubbled" }, Cmd.none ) 54 | -------------------------------------------------------------------------------- /src/Elmer/Program/Matchers.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Program.Matchers exposing 2 | ( expectTitle 3 | ) 4 | 5 | {-| Make expectations about the Document generated by a view function. 6 | 7 | # Document Matchers 8 | @docs expectTitle 9 | 10 | -} 11 | 12 | import Expect 13 | import Elmer exposing (Matcher) 14 | import Elmer.TestState as TestState 15 | import Elmer.Context as Context exposing (Context, View(..)) 16 | import Elmer.Errors as Errors exposing (failWith) 17 | 18 | 19 | {-| Expect that a document has some title. 20 | -} 21 | expectTitle : String -> Matcher (Elmer.TestState model msg) 22 | expectTitle expectedTitle = 23 | TestState.mapToExpectation <| 24 | \context -> 25 | case Context.model context of 26 | Just model -> 27 | case renderTitle model context of 28 | Just actualTitle -> 29 | if expectedTitle == actualTitle then 30 | Expect.pass 31 | else 32 | failWith <| Errors.wrongTitle expectedTitle actualTitle 33 | Nothing -> 34 | failWith <| Errors.noTitle expectedTitle 35 | Nothing -> 36 | failWith Errors.noModel 37 | 38 | 39 | renderTitle : model -> Context model msg -> Maybe String 40 | renderTitle model context = 41 | case Context.view context of 42 | DocumentView view -> 43 | view model 44 | |> .title 45 | |> Just 46 | HtmlView _ -> 47 | Nothing -------------------------------------------------------------------------------- /tests/src/Elmer/TestStateTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestStateTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer.TestState as TestState 6 | import Elmer.TestApps.SimpleTestApp as SimpleApp 7 | import Elmer 8 | 9 | 10 | all : Test 11 | all = 12 | Test.concat 13 | [ mapToExpectationTests 14 | ] 15 | 16 | 17 | mapToExpectationTests = 18 | describe "mapToExpectaion" 19 | [ describe "when there is an upstream error" 20 | [ test "it fails with the upstream error" <| 21 | \() -> 22 | TestState.mapToExpectation (\_ -> Expect.pass) (TestState.failure "Failed!") 23 | |> Expect.equal (Expect.fail "Failed!") 24 | ] 25 | , describe "when there is no upstream failure" 26 | [ describe "when the mapper fails" 27 | [ test "it fails" <| 28 | \() -> 29 | let 30 | initialState = Elmer.given SimpleApp.defaultModel SimpleApp.view SimpleApp.update 31 | in 32 | TestState.mapToExpectation (\_ -> Expect.fail "I failed!") initialState 33 | |> Expect.equal (Expect.fail "I failed!") 34 | ] 35 | , describe "when the mapper passes" 36 | [ test "it passes" <| 37 | \() -> 38 | Elmer.given SimpleApp.defaultModel SimpleApp.view SimpleApp.update 39 | |> TestState.mapToExpectation (\context -> 40 | Expect.pass 41 | ) 42 | |> Expect.equal (Expect.pass) 43 | ] 44 | ] 45 | ] 46 | -------------------------------------------------------------------------------- /tests/testReporter.js: -------------------------------------------------------------------------------- 1 | var reporter = () => { 2 | 3 | var total = 0 4 | var passed = 0 5 | var failed = 0 6 | 7 | var failureMessages = [] 8 | 9 | var testSuiteWillStart = () => { 10 | console.log("Running tests ...") 11 | } 12 | 13 | var testDidFinish = (testResult) => { 14 | total += 1 15 | if (testResult.messages.length === 0) { 16 | passed += 1 17 | } else { 18 | failed += 1 19 | failureMessages.push({ 20 | description: testResult.descriptions.reverse().join(", "), 21 | message: testResult.messages.join("\n") 22 | }) 23 | } 24 | } 25 | 26 | var testSuiteDidFinish = () => { 27 | console.log("Test suite finished.") 28 | console.log() 29 | failureMessages.forEach((failure) => { 30 | console.log("-----------------------\n") 31 | console.log("Test failed:", failure.description) 32 | console.log() 33 | console.log(failure.message) 34 | console.log() 35 | }) 36 | console.log("-----------------------\n") 37 | console.log("Total tests:", total) 38 | console.log("Passed:", passed) 39 | console.log("Failed:", failed) 40 | console.log() 41 | } 42 | 43 | return { 44 | testSuiteWillStart, 45 | testSuiteDidFinish, 46 | testDidFinish 47 | } 48 | } 49 | 50 | module.exports = reporter() -------------------------------------------------------------------------------- /src/Elm/Kernel/Function.js: -------------------------------------------------------------------------------- 1 | /* 2 | */ 3 | 4 | function _Function_globalIdentifier(fun) { 5 | var name = null; 6 | try { 7 | var re = /return ([\w$]+);/ 8 | name = re.exec(fun.toString())[1] 9 | } catch (e) {} 10 | 11 | return name; 12 | } 13 | 14 | var elmer_fakeFunctions = {} 15 | 16 | var _Function_activate = F3(function(name, calls, func) { 17 | elmer_fakeFunctions[name] = { 18 | impl: func, 19 | calls: calls 20 | } 21 | 22 | return func 23 | }) 24 | 25 | function _Function_deactivate(name) { 26 | var calls = elmer_fakeFunctions[name].calls 27 | 28 | delete elmer_fakeFunctions[name] 29 | 30 | return calls 31 | } 32 | 33 | function _Function_isActive(name) { 34 | return elmer_fakeFunctions[name] ? true : false 35 | } 36 | 37 | var elmer_storeArg = function(name, arg, currentCall) { 38 | var callList = elmer_fakeFunctions[name].calls 39 | var callId = currentCall 40 | 41 | if (callId === undefined) { 42 | callId = callList.length 43 | callList[callId] = [] 44 | } 45 | 46 | callList[callId].push(arg) 47 | 48 | return callId 49 | } 50 | 51 | var elmer_recordable = function(name, func, currentCall) { 52 | return function() { 53 | var callId = elmer_storeArg(name, arguments[0], currentCall) 54 | 55 | var next = func.apply(this, arguments) 56 | if (typeof(next) !== "function") { 57 | return next 58 | } 59 | 60 | return elmer_recordable(name, next, callId) 61 | } 62 | } 63 | 64 | var _Function_recordable = F2(elmer_recordable) 65 | 66 | -------------------------------------------------------------------------------- /src/Elmer/Command/Internal.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Command.Internal exposing 2 | ( CommandState(..) 3 | , testStateWithCommand 4 | ) 5 | 6 | import Elmer.TestState as TestState exposing (TestState, TestStateExtension(..)) 7 | import Elmer.Context as Context exposing (Context, Update, View(..)) 8 | import Elmer.Runtime.Command as RuntimeCommand 9 | import Elmer.Runtime as Runtime 10 | import Html exposing (Html) 11 | import Expect 12 | 13 | 14 | type CommandState 15 | = Messages 16 | 17 | 18 | testStateWithCommand : (() -> Cmd msg) -> TestState () msg 19 | testStateWithCommand commandGenerator = 20 | Context.default (HtmlView emptyView) messageCollectorUpdate 21 | |> Context.withModel () 22 | |> withCommandGenerator commandGenerator 23 | |> TestState.with 24 | 25 | 26 | emptyView : model -> Html msg 27 | emptyView model = 28 | Html.text "" 29 | 30 | 31 | messageCollectorUpdate : msg -> model -> (model, Cmd msg) 32 | messageCollectorUpdate msg model = 33 | ( model 34 | , RuntimeCommand.mapState Messages <| 35 | \state -> 36 | Maybe.withDefault [] state 37 | |> (::) msg 38 | ) 39 | 40 | 41 | withCommandGenerator : (() -> Cmd msg) -> Context model msg -> Context model msg 42 | withCommandGenerator generator context = 43 | RuntimeCommand.mapState MapBeforeExpectationExtension (\state -> 44 | Maybe.withDefault [] state 45 | |> (::) (beforeExpectationExtension generator) 46 | ) 47 | |> Context.updateStateFor context 48 | 49 | 50 | beforeExpectationExtension : (() -> Cmd msg) -> Context model msg -> TestState model msg 51 | beforeExpectationExtension commandGenerator context = 52 | Runtime.performCommand (commandGenerator ()) context 53 | |> TestState.fromRuntimeResult 54 | -------------------------------------------------------------------------------- /src/Elmer/Html/Event/HandlerQuery.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Event.HandlerQuery exposing 2 | ( bubbling 3 | , inert 4 | , forSubmitEvent 5 | ) 6 | 7 | import Elmer.Html.Event.Types exposing (..) 8 | import Elmer.Html.Types exposing (..) 9 | import Elmer.Html.Element.Internal as HtmlInternal 10 | import Elmer.Html.Query as Query 11 | import Elmer.Html.Target as Target 12 | import Elmer.Html.Selector as Selector 13 | import Html exposing (Html) 14 | 15 | 16 | bubbling : String -> EventHandlerQuery msg 17 | bubbling eventType _ element = 18 | List.append element.eventHandlers element.inheritedEventHandlers 19 | |> filterByEventType eventType 20 | 21 | 22 | inert : String -> EventHandlerQuery msg 23 | inert eventType _ element = 24 | element.eventHandlers 25 | |> filterByEventType eventType 26 | 27 | 28 | forSubmitEvent : EventHandlerQuery msg 29 | forSubmitEvent view element = 30 | if triggersSubmit element then 31 | case HtmlInternal.attribute "form" element of 32 | Just formId -> 33 | case formFor formId view of 34 | Just formElement -> 35 | inert "submit" view formElement 36 | Nothing -> 37 | [] 38 | Nothing -> 39 | bubbling "submit" view element 40 | else 41 | [] 42 | 43 | 44 | triggersSubmit : HtmlElement msg -> Bool 45 | triggersSubmit element = 46 | HtmlInternal.isSubmitInput element || HtmlInternal.isSubmitButton element 47 | 48 | 49 | formFor : String -> Html msg -> Maybe (HtmlElement msg) 50 | formFor formId html = 51 | Target.forHtml (ElementWith [ Selector.id formId ]) html 52 | |> Query.findElement 53 | |> Result.toMaybe 54 | 55 | 56 | filterByEventType : String -> List (HtmlEventHandler msg) -> List (HtmlEventHandler msg) 57 | filterByEventType eventType = 58 | List.filter (\e -> e.eventType == eventType) 59 | -------------------------------------------------------------------------------- /tests/src/Elmer/MessageTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.MessageTests exposing (all) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer.Message as Message 6 | 7 | 8 | all : Test 9 | all = 10 | Test.concat 11 | [ formatTests 12 | ] 13 | 14 | 15 | formatTests : Test 16 | formatTests = 17 | describe "Message.format" 18 | [ describe "when there is no example" 19 | [ test "it prints the description" <| 20 | \() -> 21 | let 22 | message = 23 | [ Message.note "Fun stuff" ] 24 | |> Message.format 25 | in 26 | Expect.equal message "Fun stuff" 27 | ] 28 | , describe "when there is an example" 29 | [ test "it prints the description and the example" <| 30 | \() -> 31 | let 32 | message = 33 | [ Message.fact "Fun Stuff" "Fun Example" ] 34 | |> Message.format 35 | in 36 | Expect.equal message "Fun Stuff\n\n\tFun Example" 37 | ] 38 | , describe "when the example has multiple lines" 39 | [ test "it prints the formatted example" <| 40 | \() -> 41 | let 42 | message = 43 | [ Message.fact "Fun Stuff" "Fun Example\nSuper Example\nRadical Example\n" ] 44 | |> Message.format 45 | in 46 | Expect.equal message "Fun Stuff\n\n\tFun Example\n\tSuper Example\n\tRadical Example" 47 | ] 48 | , describe "when there are multiple messages" 49 | [ test "it prints all the messages" <| 50 | \() -> 51 | let 52 | messages = 53 | [ Message.fact "Fun Stuff" "Fun Example" 54 | , Message.fact "Fun Stuff 2" "Fun Example2" 55 | ] 56 | in 57 | Message.format messages 58 | |> Expect.equal "Fun Stuff\n\n\tFun Example\n\nFun Stuff 2\n\n\tFun Example2" 59 | ] 60 | ] 61 | 62 | -------------------------------------------------------------------------------- /tests/src/Elmer/PortTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.PortTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer.TestApps.PortTestApp as App 6 | import Elmer.Spy as Spy exposing (andCallFake) 7 | import Elmer.Spy.Matchers exposing (wasCalled) 8 | import Elmer.Subscription as Subscription 9 | import Elmer 10 | import Elmer.Html as Markup 11 | import Elmer.Html.Event as Event 12 | import Elmer.Html.Matchers exposing (..) 13 | import Elmer.Html.Selector as Sel exposing (..) 14 | 15 | 16 | all : Test 17 | all = 18 | Test.concat 19 | [ portCommandTests 20 | , portSubscriptionTests 21 | ] 22 | 23 | 24 | portCommandTests : Test 25 | portCommandTests = 26 | describe "port command spy" 27 | [ test "it calls the spy associated with the port command" <| 28 | \() -> 29 | let 30 | spy = 31 | Spy.observe (\_ -> App.sendJsData) 32 | |> andCallFake (\_ -> Cmd.none) 33 | in 34 | Elmer.given App.defaultModel App.view App.update 35 | |> Spy.use [ spy ] 36 | |> Markup.target << by [ id "send-port-command-button" ] 37 | |> Event.click 38 | |> Spy.expect (\_ -> App.sendJsData) (wasCalled 1) 39 | ] 40 | 41 | portSubscriptionTests : Test 42 | portSubscriptionTests = 43 | describe "port subscription spy" 44 | [ test "it uses the subscription spy to send messages" <| 45 | \() -> 46 | let 47 | spy = 48 | Spy.observe (\_ -> App.receiveJsData) 49 | |> andCallFake (\tagger -> Subscription.fake "fakeReceive" tagger) 50 | in 51 | Elmer.given App.defaultModel App.view App.update 52 | |> Spy.use [ spy ] 53 | |> Subscription.with (\_ -> App.subscriptions) 54 | |> Subscription.send "fakeReceive" "some fake data" 55 | |> Markup.target << by [ id "js-data" ] 56 | |> Markup.expect (element <| hasText "some fake data") 57 | ] 58 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/LazyTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.LazyTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events as Events 6 | import Html.Lazy exposing (lazy, lazy2, lazy3) 7 | 8 | 9 | type alias Model = 10 | { name : String } 11 | 12 | 13 | type Msg 14 | = DoClick 15 | | DoSpecialClick String 16 | 17 | 18 | defaultModel : Model 19 | defaultModel = 20 | { name = "Cool Person" } 21 | 22 | 23 | update : Msg -> Model -> ( Model, Cmd Msg ) 24 | update msg model = 25 | case msg of 26 | DoClick -> 27 | ( { model | name = "Awesome Person" }, Cmd.none ) 28 | DoSpecialClick modifier -> 29 | ( { model | name = modifier ++ " " ++ model.name }, Cmd.none ) 30 | 31 | 32 | view : Model -> Html Msg 33 | view model = 34 | Html.div 35 | [ Attr.id "root", Attr.class "styled no-events", Events.onClick DoClick ] 36 | [ Html.div [ Attr.id "name-text" ] 37 | [ lazy subView model ] 38 | ] 39 | 40 | 41 | subView : Model -> Html Msg 42 | subView model = 43 | Html.div [ Attr.id "lazy-div" ] 44 | [ Html.text <| "Some name: " ++ model.name 45 | ] 46 | 47 | 48 | lazyView2 : Model -> Html Msg 49 | lazyView2 model = 50 | Html.div 51 | [ Attr.id "root", Attr.class "styled no-events" ] 52 | [ lazy2 subView2 model "bowling" ] 53 | 54 | 55 | subView2 : Model -> String -> Html Msg 56 | subView2 model activity = 57 | Html.div [ Attr.id "lazy-div", Events.onClick <| DoSpecialClick "Happy" ] 58 | [ Html.text <| model.name ++ " likes " ++ activity 59 | ] 60 | 61 | 62 | lazyView3 : Model -> Html Msg 63 | lazyView3 model = 64 | Html.div 65 | [ Attr.id "root", Attr.class "styled no-events" ] 66 | [ lazy3 subView3 model "bowling" 5 ] 67 | 68 | 69 | subView3 : Model -> String -> Int -> Html Msg 70 | subView3 model activity times = 71 | model.name ++ " likes " ++ activity ++ " " ++ (String.fromInt times) ++ " times a week!" 72 | |> Html.text 73 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Command.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Command exposing 2 | ( commandRunner 3 | , mapState 4 | , generate 5 | , fail 6 | , stub 7 | , defer 8 | ) 9 | 10 | 11 | import Elmer.Runtime.Intention as Intention 12 | import Elmer.Runtime.Types exposing (..) 13 | import Elmer.Runtime.Command.Task as Promise 14 | import Elmer.Runtime.Command.MapState as MapState 15 | import Elmer.Runtime.Command.Generate as Generate 16 | import Elmer.Runtime.Command.Fail as Fail 17 | import Elmer.Runtime.Command.Stub as Stub 18 | import Elmer.Runtime.Command.Defer as Defer 19 | import Elmer.Context as Context exposing (Context) 20 | import Elmer.Message exposing (..) 21 | import Dict exposing (Dict) 22 | 23 | 24 | commandRunners : Dict String (CommandRunner model subMsg msg) 25 | commandRunners = 26 | Dict.fromList 27 | [ ( Fail.name, Fail.commandRunner ) 28 | , ( Stub.name, Stub.commandRunner ) 29 | , ( Generate.name, Generate.commandRunner ) 30 | , ( MapState.name, MapState.commandRunner ) 31 | , ( Promise.name, Promise.commandRunner ) 32 | ] 33 | 34 | 35 | commandRunner : String -> CommandRunner model subMsg msg 36 | commandRunner name = 37 | Dict.get name commandRunners 38 | |> Maybe.withDefault (unknownCommandRunner name) 39 | 40 | 41 | mapState : typeId -> (Maybe a -> a) -> Cmd msg 42 | mapState = 43 | MapState.with 44 | 45 | 46 | generate : (Context model msg -> Cmd msg) -> Cmd msg 47 | generate = 48 | Generate.with 49 | 50 | 51 | fail : String -> Cmd msg 52 | fail = 53 | Fail.with 54 | 55 | 56 | stub : msg -> Cmd msg 57 | stub = 58 | Stub.with 59 | 60 | 61 | defer : Cmd msg -> Cmd msg 62 | defer = 63 | Defer.with 64 | 65 | 66 | unknownCommandRunner : String -> CommandRunner model subMsg msg 67 | unknownCommandRunner commandName _ _ = 68 | CommandError <| 69 | format <| 70 | [ fact "Elmer encountered a command it does not know how to run" commandName 71 | , note "Try sending a stubbed or dummy command instead" 72 | ] 73 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Command/Task.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Command.Task exposing 2 | ( commandRunner 3 | , name 4 | ) 5 | 6 | import Elmer.Runtime.Intention as Intention 7 | import Elmer.Runtime.Types exposing (..) 8 | import Elmer.Runtime.Command.Fail as Fail 9 | import Elmer.Runtime.Command.Defer as Defer 10 | import Elmer.Runtime.Command.Stub as Stub 11 | import Elmer.Value as Value 12 | import Elmer.Value.Native as Native 13 | import Elmer.Runtime.Promise as Promise 14 | import Elmer.Runtime.Promise.Runner as PromiseRunner 15 | import Elmer.Runtime.Promise.Types exposing (..) 16 | import Json.Decode as Json 17 | 18 | 19 | name : String 20 | name = 21 | "Task" 22 | 23 | 24 | commandRunner : CommandRunner model subMsg msg 25 | commandRunner command tagger = 26 | let 27 | taskResult = 28 | Intention.cmdValue command 29 | |> Value.decode (Value.firstArg Promise.decoder) 30 | in 31 | case taskResult of 32 | Ok promise -> 33 | CommandSuccess <| 34 | \context -> 35 | ( context 36 | , PromiseRunner.run promise 37 | |> promiseCommand tagger 38 | ) 39 | Err msg -> 40 | CommandError <| 41 | "Error decoding Task: " ++ Json.errorToString msg 42 | 43 | 44 | promiseCommand : (subMsg -> msg) -> Promised msg -> Cmd msg 45 | promiseCommand tagger promised = 46 | (toCommand tagger promised.resolution) :: promised.commands 47 | |> Cmd.batch 48 | |> deferIf promised.shouldDefer 49 | 50 | 51 | deferIf : Bool -> Cmd msg -> Cmd msg 52 | deferIf shouldDefer command = 53 | if shouldDefer then 54 | Defer.with command 55 | else 56 | command 57 | 58 | 59 | toCommand : (subMsg -> msg) -> Resolution msg -> Cmd msg 60 | toCommand tagger resolution = 61 | case resolution of 62 | Resolved promiseValue -> 63 | Native.cast promiseValue 64 | |> tagger 65 | |> Stub.with 66 | Rejected _ -> 67 | "Encountered a task failure, but no error handler has been specified. This should not happen." 68 | |> Fail.with 69 | Aborted command -> 70 | command 71 | -------------------------------------------------------------------------------- /src/Elmer/Task.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Task exposing 2 | ( failTest 3 | , defer 4 | ) 5 | 6 | {-| Functions to produce Tasks to use during a test. 7 | 8 | To work with Tasks during a test, you should 9 | 10 | 1. Stub any functions that generate a Task with `Task.succeed` or `Task.fail` 11 | 2. That's it. 12 | 13 | For example, you could write a test that exercises code using `Browser.Dom.focus` like so: 14 | 15 | focusStub : Spy 16 | focusStub = 17 | Elmer.Spy.observe (\_ -> Browser.Dom.focus) 18 | |> Elmer.Spy.andCallFake (\_ -> 19 | Task.succeed () 20 | ) 21 | 22 | myTest : Test 23 | myTest = 24 | test "it does something awesome" <| 25 | \() -> 26 | Elmer.given testModel testView testUpdate 27 | |> Spy.use [ focusStub ] 28 | |> etc ... 29 | 30 | In this case, the focusStub would allow you to simulate the success of the task produced by 31 | `Browser.Dom.focus`. 32 | 33 | Elmer knows how to process Tasks in general (eg, functions like `Task.map`, `Task.andThen`, etc), 34 | so you only need to stub functions that produce Tasks from modules other than the elm/core `Task` module. 35 | 36 | # Special Tasks 37 | @docs failTest, defer 38 | 39 | -} 40 | 41 | import Task exposing (Task) 42 | import Elmer.Runtime.Task as RuntimeTask 43 | import Elmer.Command as Command 44 | 45 | 46 | {-| Generate a Task that will cause the test to fail with the given message. 47 | -} 48 | failTest : String -> Task x a 49 | failTest failureMessage = 50 | Command.fail failureMessage 51 | |> RuntimeTask.abortWith 52 | 53 | 54 | {-| Defer a task for later processing. 55 | 56 | You might want to describe the behavior that occurs after a task 57 | is sent but before its effect is processed -- for example, you could 58 | indicate that network activity is occurring while waiting for a request to complete. 59 | 60 | When a deferred task is processed, any effect associated with that task will *not* be sent 61 | to the `update` function until `Elmer.resolveDeferred` is called. 62 | -} 63 | defer : Task x a -> Task x a 64 | defer = 65 | RuntimeTask.defer -------------------------------------------------------------------------------- /tests/src/Elmer/GivenCommandTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.GivenCommandTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer exposing (exactly) 6 | import Elmer.Spy as Spy exposing (Spy, andCallFake) 7 | import Elmer.Spy.Matchers exposing (wasCalledWith, stringArg) 8 | import Elmer.Command as Command 9 | import Elmer.Message exposing (..) 10 | import Task 11 | 12 | 13 | all : Test 14 | all = 15 | Test.concat 16 | [ spyTests 17 | , expectMessageTests 18 | ] 19 | 20 | 21 | spyTests : Test 22 | spyTests = 23 | describe "when the test for a given command uses a spy" 24 | [ test "it satisfies expectations about the spy" <| 25 | \() -> 26 | Command.given (\() -> spyCommand "hello") 27 | |> Spy.use [ testPortSpy ] 28 | |> Spy.expect (\_ -> testPortCommand) ( 29 | wasCalledWith [ stringArg "hello" ] 30 | ) 31 | ] 32 | 33 | 34 | testPortSpy : Spy 35 | testPortSpy = 36 | Spy.observe (\_ -> testPortCommand) 37 | |> andCallFake (\_ -> Cmd.none) 38 | 39 | 40 | testPortCommand : String -> Cmd msg 41 | testPortCommand _ = 42 | Cmd.none 43 | 44 | spyCommand : String -> Cmd Msg 45 | spyCommand message = 46 | testPortCommand message 47 | 48 | 49 | type Msg 50 | = TestResult (Result String Int) 51 | 52 | 53 | expectMessageTests : Test 54 | expectMessageTests = 55 | describe "when a given command results in a message" 56 | [ describe "when the processing the command is successful" 57 | [ test "it records the messages" <| 58 | \() -> 59 | Command.given (\() -> Task.succeed 17 |> Task.attempt TestResult) 60 | |> Command.expectMessages ( 61 | exactly 1 <| Expect.equal (TestResult <| Ok 17) 62 | ) 63 | ] 64 | , describe "when processing the command results in a test failure" 65 | [ test "it records the messages" <| 66 | \() -> 67 | Command.given (\_ -> Command.fail "Failed!") 68 | |> Command.expectMessages ( 69 | exactly 1 <| Expect.equal (TestResult <| Ok 17) 70 | ) 71 | |> Expect.equal (Expect.fail "Failed!") 72 | ] 73 | ] 74 | -------------------------------------------------------------------------------- /src/Elmer/Spy/Call.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Spy.Call exposing 2 | ( asString 3 | , matches 4 | , argThatFailures 5 | ) 6 | 7 | import Test.Runner 8 | import Expect 9 | import Elmer.Spy.Arg as Arg exposing (Arg(..), ArgValue(..)) 10 | import Elmer.Message.Failure as Failure 11 | 12 | 13 | matches : List Arg -> List Arg -> Bool 14 | matches expected actual = 15 | case expected of 16 | [] -> 17 | List.isEmpty actual 18 | x :: xs -> 19 | case actual of 20 | [] -> 21 | False 22 | y :: ys -> 23 | case x of 24 | AnyArg -> 25 | matches xs ys 26 | ArgThat matcher -> 27 | case Arg.value y of 28 | Nothing -> 29 | False 30 | Just val -> 31 | if Expect.pass == (matcher val) then 32 | matches xs ys 33 | else 34 | False 35 | arg -> 36 | if arg == y then 37 | matches xs ys 38 | else 39 | False 40 | 41 | 42 | argThatFailures : List Arg -> List Arg -> List String 43 | argThatFailures expected actual = 44 | case expected of 45 | [] -> 46 | [] 47 | x :: xs -> 48 | case actual of 49 | [] -> 50 | [] 51 | y :: ys -> 52 | case x of 53 | ArgThat matcher -> 54 | case Arg.value y of 55 | Nothing -> 56 | "argThat cannot be used to match arguments that are functions" :: 57 | argThatFailures xs ys 58 | Just val -> 59 | case Test.Runner.getFailureReason <| matcher val of 60 | Just failure -> 61 | Failure.format [ failure ] :: 62 | argThatFailures xs ys 63 | Nothing -> 64 | argThatFailures xs ys 65 | arg -> 66 | argThatFailures xs ys 67 | 68 | 69 | asString : List Arg -> String 70 | asString args = 71 | "[ " 72 | ++ String.join "\n, " (List.map Arg.asString args) 73 | ++ "\n]" 74 | -------------------------------------------------------------------------------- /tests/packageRegistryWriter.js: -------------------------------------------------------------------------------- 1 | const fs = require('fs') 2 | 3 | const writeInt = (num) => { 4 | const buffer = Buffer.alloc(1) 5 | buffer.writeInt8(num) 6 | 7 | return buffer; 8 | } 9 | 10 | const writeLong = (num) => { 11 | const buffer = Buffer.alloc(8) 12 | let cursor = buffer.writeInt32BE(0) 13 | buffer.writeInt32BE(num, cursor) 14 | 15 | return buffer 16 | } 17 | 18 | const writeString = (str) => { 19 | const buffer = Buffer.alloc(str.length + 8) 20 | let cursor = buffer.writeInt32BE(0) 21 | cursor = buffer.writeInt32BE(str.length, cursor) 22 | buffer.write(str, cursor) 23 | 24 | return buffer 25 | } 26 | 27 | const writePackageRegistry = async (filename, registry) => { 28 | var wstream = fs.createWriteStream(filename); 29 | await wstream.write(writeLong(0)); 30 | await wstream.write(writeLong(registry.length)); 31 | for (var i = 0; i < registry.length; i++) { 32 | const entry = registry[i] 33 | await wstream.write(writeString(entry.name.author)) 34 | await wstream.write(writeString(entry.name.project)) 35 | await wstream.write(writeLong(entry.versions.length)) 36 | for (var v = 0; v < entry.versions.length; v++) { 37 | const version = entry.versions[v] 38 | await wstream.write(writeInt(version.major)) 39 | await wstream.write(writeInt(version.minor)) 40 | await wstream.write(writeInt(version.patch)) 41 | } 42 | } 43 | await wstream.end(); 44 | } 45 | 46 | const version = (major, minor, patch) => { 47 | return { 48 | major, 49 | minor, 50 | patch 51 | } 52 | } 53 | 54 | const entry = (author, project, versions) => { 55 | return { 56 | name: { 57 | author, 58 | project 59 | }, 60 | versions 61 | } 62 | } 63 | 64 | const registry = [ 65 | entry("elm-explorations", "elmer", [ version(6, 0, 0) ]) 66 | ] 67 | 68 | if (process.argv.length != 3) { 69 | console.log("node ./packageRegistryWriter.js ") 70 | process.exit() 71 | } 72 | 73 | const filename = process.argv[2] 74 | 75 | console.log(`Writing package registry to ${filename} ...`) 76 | writePackageRegistry(filename, registry).then(() => { 77 | console.log("Done!") 78 | }) 79 | -------------------------------------------------------------------------------- /tests/src/Elmer/FocusEventTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.FocusEventTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Elmer.TestApps.FocusTestApp as App 5 | import Expect 6 | import Elmer 7 | import Elmer.EventTests as EventTests 8 | import Elmer.TestState as TestState exposing (TestState) 9 | import Elmer.Html.Event as Event 10 | import Elmer.Command as Command 11 | import Elmer.Html as Markup 12 | import Elmer.Html.Selector exposing (..) 13 | 14 | 15 | all : Test 16 | all = 17 | Test.concat 18 | [ focusTests 19 | , blurTests 20 | ] 21 | 22 | focusTests : Test 23 | focusTests = 24 | describe "focus" 25 | [ EventTests.standardEventBehavior "focus" Event.focus 26 | , EventTests.propagationBehavior Event.focus "focus" 27 | , let 28 | initialModel = App.defaultModel 29 | initialState = Elmer.given initialModel App.view App.update 30 | in 31 | describe "the focus event" 32 | [ test "at first the element is not focused" <| 33 | \() -> 34 | Expect.equal initialModel.isFocused False 35 | , test "the event updates the model" <| 36 | \() -> 37 | initialState 38 | |> Markup.target << by [ id "name-field" ] 39 | |> Event.focus 40 | |> Elmer.expectModel (\model -> 41 | Expect.equal model.isFocused True 42 | ) 43 | ] 44 | ] 45 | 46 | blurTests : Test 47 | blurTests = 48 | describe "blur" 49 | [ EventTests.standardEventBehavior "blur" Event.blur 50 | , EventTests.propagationBehavior Event.blur "blur" 51 | , let 52 | initialModel = App.defaultModel 53 | initialState = Elmer.given initialModel App.view App.update 54 | in 55 | describe "the blur event" 56 | [ test "at first the element is not blurred" <| 57 | \() -> 58 | Expect.equal initialModel.isBlurred False 59 | , test "the event updates the model" <| 60 | \() -> 61 | initialState 62 | |> Markup.target << by [ id "name-field" ] 63 | |> Event.blur 64 | |> Elmer.expectModel (\model -> 65 | Expect.equal model.isBlurred True 66 | ) 67 | ] 68 | ] 69 | -------------------------------------------------------------------------------- /src/Elmer/Html/Types.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Types exposing 2 | ( HtmlSelector 3 | , HtmlSelectorGroup(..) 4 | , HtmlState(..) 5 | , HtmlNode(..) 6 | , HtmlElement 7 | , HtmlEventHandler 8 | , HtmlEventValue 9 | , HtmlFact(..) 10 | , HtmlTarget(..) 11 | , Selection 12 | ) 13 | 14 | {-| Types for working with Html. Exposed for Testing only 15 | 16 | @docs HtmlState, HtmlNode, HtmlElement, HtmlEventHandler, HtmlEventValue, HtmlFact, HtmlTarget, HtmlSelectorGroup, HtmlSelector, Selection 17 | 18 | -} 19 | 20 | import Json.Decode as Json 21 | import Dict exposing (Dict) 22 | 23 | {-| HtmlState 24 | -} 25 | type HtmlState = 26 | TargetSelector 27 | 28 | {-| HtmlNode 29 | -} 30 | type HtmlNode msg 31 | = Element (HtmlElement msg) 32 | | Text String 33 | 34 | {-| HtmlElement 35 | -} 36 | type alias HtmlElement msg = 37 | { tag : String 38 | , properties : Dict String HtmlFact 39 | , attributes : Dict String String 40 | , styles : Dict String String 41 | , children : List (HtmlNode msg) 42 | , inheritedEventHandlers : List (HtmlEventHandler msg) 43 | , eventHandlers : List (HtmlEventHandler msg) 44 | } 45 | 46 | {-| HtmlEventHandler 47 | -} 48 | type alias HtmlEventHandler msg = 49 | { eventType : String 50 | , decoder : Json.Decoder (HtmlEventValue msg) 51 | } 52 | 53 | {-| 54 | -} 55 | type alias HtmlEventValue msg = 56 | { message : msg 57 | , stopPropagation : Bool 58 | , preventDefault : Bool 59 | } 60 | 61 | 62 | {-| HtmlFact 63 | -} 64 | type HtmlFact 65 | = StringValue String 66 | | BoolValue Bool 67 | 68 | 69 | {-| HtmlTarget 70 | -} 71 | type HtmlTarget msg = 72 | HtmlTarget (Selection msg) 73 | 74 | {-| 75 | -} 76 | type alias Selection msg = 77 | { selector : HtmlSelectorGroup msg 78 | , element : Maybe (HtmlElement msg) 79 | } 80 | 81 | 82 | {-| HtmlSelector 83 | -} 84 | type HtmlSelectorGroup msg 85 | = ElementWith (List (HtmlSelector msg)) 86 | | DescendantsOf (List (HtmlSelector msg)) (HtmlSelectorGroup msg) 87 | | ChildrenOf (List (HtmlSelector msg)) (HtmlSelectorGroup msg) 88 | 89 | 90 | {-| 91 | -} 92 | type alias HtmlSelector msg = 93 | { description : String 94 | , predicate : HtmlElement msg -> Bool 95 | } 96 | -------------------------------------------------------------------------------- /tests/src/Elmer/HtmlCustomTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.HtmlCustomTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer 6 | import Elmer.Html as Markup 7 | import Elmer.Html.Event as Event 8 | import Elmer.Html.Element as Element 9 | import Elmer.Html.Selector as Sel exposing (by) 10 | import Elmer.Html.Matchers exposing (element, hasText, hasAttribute, hasStyle, listensForEvent) 11 | import Elmer.TestApps.CustomElementTestApp as App 12 | 13 | 14 | all : Test 15 | all = 16 | Test.concat 17 | [ customElementTests 18 | ] 19 | 20 | customElementTests : Test 21 | customElementTests = 22 | describe "custom element" 23 | [ test "it creates a div for the custom content with the expected property" <| 24 | \() -> 25 | Elmer.given testModel App.view App.update 26 | |> Markup.target << by [ Sel.id "markdown-content" ] 27 | |> Markup.expect (element <| \el -> Expect.equal "div" <| Element.tag el) 28 | , test "it creates a div for the custom content with the expected attributes" <| 29 | \() -> 30 | Elmer.given testModel App.view App.update 31 | |> Markup.target << by [ Sel.id "markdown-content" ] 32 | |> Markup.expect (element <| hasAttribute ("data-attr", "funStuff")) 33 | , test "it creates a div for the custom content with the expected styles" <| 34 | \() -> 35 | Elmer.given testModel App.view App.update 36 | |> Markup.target << by [ Sel.id "markdown-content" ] 37 | |> Markup.expect (element <| hasStyle ("position", "absolute")) 38 | , test "it creates a div for the custom content with the expected event handlers" <| 39 | \() -> 40 | Elmer.given testModel App.view App.update 41 | |> Markup.target << by [ Sel.id "markdown-content" ] 42 | |> Markup.expect (element <| listensForEvent "click") 43 | , test "it creates a div that bubbles events as necessary" <| 44 | \() -> 45 | Elmer.given testModel App.bubbleView App.update 46 | |> Markup.target << by [ Sel.id "markdown-content" ] 47 | |> Event.click 48 | |> Markup.expect (element <| hasAttribute ("data-attr", "Bubbled")) 49 | ] 50 | 51 | testModel : App.Model 52 | testModel = 53 | App.defaultModel <| """ 54 | 55 | # Some Cool Title 56 | 57 | Then some cool text. 58 | 59 | """ -------------------------------------------------------------------------------- /src/Elmer/Html/Event/Description.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Event.Description exposing 2 | ( forMouseEvent 3 | , forInertMouseEvent 4 | , forSubmitEvent 5 | , forInputEventWith 6 | , forCheckEvent 7 | , forBasicEvent 8 | , forEvent 9 | ) 10 | 11 | import Elmer.Html.Event.Types exposing (..) 12 | import Elmer.Html.Event.HandlerQuery as EventHandlerQuery 13 | import Elmer.Internal as Internal 14 | 15 | 16 | create : String -> EventHandlerQuery msg -> EventJson -> EventDescription msg 17 | create eventType query event = 18 | { handlers = query 19 | , eventJson = event 20 | , eventType = eventType 21 | } 22 | 23 | 24 | forEvent : String -> EventJson -> EventDescription msg 25 | forEvent eventName eventJson = 26 | eventJson 27 | |> create eventName (EventHandlerQuery.bubbling eventName) 28 | 29 | 30 | forBasicEvent : String -> EventDescription msg 31 | forBasicEvent eventName = 32 | basicEventJson 33 | |> forEvent eventName 34 | 35 | 36 | forInputEventWith : String -> EventDescription msg 37 | forInputEventWith value = 38 | inputEventJson value 39 | |> forEvent "input" 40 | 41 | 42 | forCheckEvent : Bool -> EventDescription msg 43 | forCheckEvent doCheck = 44 | checkEventJson doCheck 45 | |> forEvent "change" 46 | 47 | 48 | forSubmitEvent : EventDescription msg 49 | forSubmitEvent = 50 | basicEventJson 51 | |> create "submit" EventHandlerQuery.forSubmitEvent 52 | 53 | 54 | forMouseEvent : String -> EventDescription msg 55 | forMouseEvent eventName = 56 | mouseEventJson 57 | |> forEvent eventName 58 | 59 | 60 | forInertMouseEvent : String -> EventDescription msg 61 | forInertMouseEvent eventName = 62 | mouseEventJson 63 | |> create eventName (EventHandlerQuery.inert eventName) 64 | 65 | 66 | basicEventJson : EventJson 67 | basicEventJson = 68 | "{}" 69 | 70 | 71 | mouseEventJson : String 72 | mouseEventJson = 73 | "{\"pageX\":0,\"pageY\":0}" 74 | 75 | 76 | checkEventJson : Bool -> EventJson 77 | checkEventJson doCheck = 78 | Internal.boolToString doCheck 79 | |> withTemplate "{\"target\":{\"checked\":?}}" 80 | 81 | 82 | inputEventJson : String -> EventJson 83 | inputEventJson = 84 | withTemplate "{\"target\":{\"value\":\"?\"}}" 85 | 86 | 87 | withTemplate : String -> String -> String 88 | withTemplate template value = 89 | String.replace "?" value template 90 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/EventPropagationTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.EventPropagationTestApp exposing (..) 2 | 3 | import Html exposing (Html, Attribute) 4 | import Html.Attributes as Attr 5 | import Html.Events exposing (..) 6 | import Json.Decode as Json 7 | 8 | type alias Model = 9 | { eventCount : Int } 10 | 11 | type Msg 12 | = HandleBasicEvent 13 | | HandleInputEvent String 14 | | HandleBooleanEvent Bool 15 | 16 | defaultModel : Model 17 | defaultModel = 18 | { eventCount = 0 } 19 | 20 | view : Model -> Html Msg 21 | view model = 22 | Html.div (eventHandlers "root") 23 | [ Html.div (eventHandlers "parent") 24 | [ Html.div (eventHandlers "child") 25 | [ Html.div [ Attr.id "no-events" ] [ Html.text "Something" ] 26 | ] 27 | ] 28 | ] 29 | 30 | viewWithNonPropagatingEvent : String -> Model -> Html Msg 31 | viewWithNonPropagatingEvent eventName model = 32 | Html.div (eventHandlers "root") 33 | [ Html.div [ Attr.id "parent", nonPropagatingEvent eventName HandleBasicEvent ] 34 | [ Html.div (eventHandlers "child") 35 | [ Html.div [ Attr.id "no-events" ] [ Html.text "Something" ] 36 | ] 37 | ] 38 | ] 39 | 40 | update : Msg -> Model -> ( Model, Cmd Msg ) 41 | update msg model = 42 | case msg of 43 | HandleBasicEvent -> 44 | ( { model | eventCount = model.eventCount + 1 }, Cmd.none ) 45 | HandleInputEvent _ -> 46 | ( { model | eventCount = model.eventCount + 1 }, Cmd.none ) 47 | HandleBooleanEvent _ -> 48 | ( { model | eventCount = model.eventCount + 1 }, Cmd.none ) 49 | 50 | eventHandlers : String -> List (Attribute Msg) 51 | eventHandlers name = 52 | [ Attr.id name 53 | , onClick HandleBasicEvent 54 | , onDoubleClick HandleBasicEvent 55 | , onMouseDown HandleBasicEvent 56 | , onMouseUp HandleBasicEvent 57 | , onMouseEnter HandleBasicEvent 58 | , onMouseLeave HandleBasicEvent 59 | , onMouseOver HandleBasicEvent 60 | , onMouseOut HandleBasicEvent 61 | , onFocus HandleBasicEvent 62 | , onBlur HandleBasicEvent 63 | , onInput HandleInputEvent 64 | , onCheck HandleBooleanEvent 65 | ] 66 | 67 | nonPropagatingEvent : String -> Msg -> Attribute Msg 68 | nonPropagatingEvent name msg = 69 | custom name (Json.succeed 70 | { message = msg 71 | , stopPropagation = True 72 | , preventDefault = False 73 | } 74 | ) 75 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Promise/Runner.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Promise.Runner exposing 2 | ( run 3 | ) 4 | 5 | import Elmer.Runtime.Promise.Types exposing (..) 6 | import Elmer.Runtime.Promise as Promise 7 | import Json.Decode as Json exposing (Value) 8 | import Elmer.Value as Value 9 | import Elmer.Value.Native as Native 10 | 11 | 12 | emptyState : Promised msg 13 | emptyState = 14 | { resolution = Promise.failWith "No resolution" 15 | , shouldDefer = False 16 | , commands = [] 17 | } 18 | 19 | 20 | run : Promise msg -> Promised msg 21 | run promise = 22 | resolve promise emptyState 23 | 24 | 25 | resolve : Promise msg -> Promised msg -> Promised msg 26 | resolve promise promised = 27 | case promise of 28 | Complete resolution -> 29 | { promised | resolution = resolution } 30 | Continue continuation -> 31 | let 32 | promisedContinuation = resolve continuation.next promised 33 | in 34 | case promisedContinuation.resolution of 35 | Resolved value -> 36 | handleCallback value continuation.onResolve promisedContinuation 37 | Rejected value -> 38 | handleCallback value continuation.onReject promisedContinuation 39 | Aborted command -> 40 | promisedContinuation 41 | AndDo command next -> 42 | resolve next { promised | commands = command :: promised.commands } 43 | Defer deferred -> 44 | resolve deferred { promised | shouldDefer = True } 45 | 46 | 47 | handleCallback : Value -> Maybe (Value -> Value) -> Promised msg -> Promised msg 48 | handleCallback value maybeCallback promised = 49 | maybeCallback 50 | |> Maybe.map (applyCallback value promised) 51 | |> Maybe.withDefault promised 52 | 53 | 54 | applyCallback : Value -> Promised msg -> (Value -> Value) -> Promised msg 55 | applyCallback value promised callback = 56 | callback value 57 | |> Value.decode Promise.decoder 58 | |> unwrapOrFail 59 | |> resolveFor promised 60 | 61 | resolveFor : Promised msg -> Promise msg -> Promised msg 62 | resolveFor promised promise = 63 | resolve promise promised 64 | 65 | unwrapOrFail : Result Json.Error (Promise msg) -> Promise msg 66 | unwrapOrFail result = 67 | case result of 68 | Ok value -> 69 | value 70 | Err msg -> 71 | "Error decoding promise: " ++ Json.errorToString msg 72 | |> Promise.failWith 73 | |> Complete 74 | -------------------------------------------------------------------------------- /tests/src/Elmer/BrowserTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.BrowserTests exposing (all) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer 6 | import Elmer.Program 7 | import Elmer.Spy as Spy 8 | import Elmer.TestState as TestState exposing (TestState) 9 | import Elmer.Command as Command 10 | import Elmer.Html 11 | import Elmer.Html.Matchers exposing (element, hasText) 12 | import Elmer.Html.Selector as Sel exposing (by) 13 | import Elmer.Message exposing (..) 14 | import Elmer.TestApps.InitTestApp as InitApp 15 | import Task 16 | import Time 17 | 18 | 19 | all : Test 20 | all = 21 | Test.concat 22 | [ initTests 23 | ] 24 | 25 | 26 | initTests : Test 27 | initTests = 28 | describe "init" 29 | [ describe "when there is a faiure" 30 | [ test "it fails" <| 31 | \() -> 32 | let 33 | initialState = TestState.failure "You failed!" 34 | in 35 | Elmer.Program.init (\() -> (InitApp.defaultModel "", Cmd.none)) initialState 36 | |> Expect.equal (TestState.failure "You failed!") 37 | ] 38 | , describe "when there is no failure" <| 39 | let 40 | taskSpy = 41 | Spy.observe (\_ -> InitApp.requestTokenTask) 42 | |> Spy.andCallFake (\_ -> Task.succeed "Spy Token!") 43 | 44 | state = Elmer.Program.givenElement InitApp.view InitApp.update 45 | |> Spy.use [ taskSpy ] 46 | |> Elmer.Program.init (\() -> InitApp.init { baseUrl = "http://fun.com/api" }) 47 | in 48 | [ test "it sets the model" <| 49 | \() -> 50 | state 51 | |> Elmer.Html.target << by [ Sel.id "base-url" ] 52 | |> Elmer.Html.expect (element <| hasText "http://fun.com/api") 53 | , test "it sends the command" <| 54 | \() -> 55 | state 56 | |> Elmer.expectModel (\model -> 57 | Expect.equal "Spy Token!" model.token 58 | ) 59 | ] 60 | , describe "when the command fails" 61 | [ test "it fails" <| 62 | \() -> 63 | let 64 | state = 65 | Elmer.Program.givenElement InitApp.view InitApp.update 66 | |> Elmer.Program.init ( \() -> 67 | ( InitApp.defaultModel "" 68 | , Command.fail "Failed!" 69 | ) 70 | ) 71 | in 72 | Expect.equal state (TestState.failure <| 73 | format 74 | [ note "Failed!" 75 | ] 76 | ) 77 | ] 78 | ] 79 | 80 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/HtmlKeyedTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.HtmlKeyedTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events as Events 6 | import Html.Keyed as Keyed 7 | import Html.Lazy exposing (lazy) 8 | 9 | type alias Model = 10 | { name : String } 11 | 12 | type Msg 13 | = DoClick 14 | | DoSpecialClick String 15 | 16 | defaultModel : Model 17 | defaultModel = 18 | { name = "orange" } 19 | 20 | view : Model -> Html Msg 21 | view model = 22 | Html.div 23 | [ Attr.id "root", Events.onClick DoClick ] 24 | [ Keyed.ol [ Attr.id "fruit-list" ] 25 | [ ( "ol-1", Html.li [] [ Html.text "apple" ] ) 26 | , ( "ol-2", Html.li [] [ Html.text "pear" ] ) 27 | , ( "ol-3", Html.li [] [ Html.text model.name ] ) 28 | ] 29 | ] 30 | 31 | 32 | view2 : Model -> Html Msg 33 | view2 model = 34 | Html.div 35 | [ Attr.id "root" ] 36 | [ Keyed.ol [ Attr.id "fruit-list" ] 37 | [ ( "ol-1", Html.li [] [ Html.text "apple" ] ) 38 | , ( "ol-2", Html.li [ Attr.id "special-node", Events.onClick <| DoSpecialClick "popcorn" ] [ Html.text "pear" ] ) 39 | , ( "ol-3", Html.li [] [ Html.text model.name ] ) 40 | ] 41 | ] 42 | 43 | viewLazyNode : Model -> Html Msg 44 | viewLazyNode model = 45 | Html.div 46 | [ Attr.id "root", Events.onClick DoClick ] 47 | [ Keyed.ol [ Attr.id "fruit-list" ] 48 | [ ( "ol-1", Html.li [] [ Html.text "apple" ] ) 49 | , ( "ol-2", Html.li [] [ lazy lazyLi model ] ) 50 | , ( "ol-3", Html.li [] [ Html.text model.name ] ) 51 | ] 52 | ] 53 | 54 | lazyLi : Model -> Html Msg 55 | lazyLi model = 56 | Html.div [ Attr.id "lazy-div" ] 57 | [ Html.text "chocolate" 58 | ] 59 | 60 | lazyKeyedView : Model -> Html Msg 61 | lazyKeyedView model = 62 | Html.div [ Attr.id "root" ] 63 | [ lazy lazyKeyed model ] 64 | 65 | lazyKeyed : Model -> Html Msg 66 | lazyKeyed model = 67 | Keyed.ol [ Attr.id "fruit-list" ] 68 | [ ( "ol-1", Html.li [] [ Html.text "apple" ] ) 69 | , ( "ol-2", Html.li [] [ Html.text "grapes" ] ) 70 | , ( "ol-3", Html.li [] [ Html.text model.name ] ) 71 | ] 72 | 73 | 74 | update : Msg -> Model -> ( Model, Cmd Msg ) 75 | update msg model = 76 | case msg of 77 | DoClick -> 78 | ( { model | name = "pineapple" } 79 | , Cmd.none 80 | ) 81 | DoSpecialClick food -> 82 | ( { model | name = food } 83 | , Cmd.none 84 | ) 85 | -------------------------------------------------------------------------------- /src/Elmer/Message.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Message exposing 2 | ( Message 3 | , note 4 | , fact 5 | , format 6 | ) 7 | 8 | {-| Functions for producing messages that explain why a test has failed. 9 | 10 | Note that these functions are mainly useful when writing extensions to Elmer 11 | or custom matchers. 12 | 13 | @docs Message, note, fact, format 14 | 15 | -} 16 | 17 | {-| Represents a message explaining why a test has failed. 18 | -} 19 | type Message = 20 | Message 21 | { statement: String 22 | , detail: Maybe String 23 | } 24 | 25 | 26 | {-| Produce a message that consists in one line of text. 27 | 28 | -} 29 | note : String -> Message 30 | note desc = 31 | Message 32 | { statement = desc 33 | , detail = Nothing 34 | } 35 | 36 | 37 | {-| Produce a message that consists in a description of the failure 38 | plus details about what exactly failed or why. 39 | 40 | [ fact "Expected" "something" 41 | , fact "to equal" "nothing" 42 | ] 43 | |> Message.format 44 | 45 | will produce text that looks something like: 46 | 47 | Expected 48 | 49 | something 50 | 51 | to equal 52 | 53 | nothing 54 | 55 | -} 56 | fact : String -> String -> Message 57 | fact stmt detail = 58 | Message 59 | { statement = stmt 60 | , detail = Just detail 61 | } 62 | 63 | 64 | {-| Produce a string from a list of messages. 65 | 66 | [ fact "Expected" "something" 67 | , fact "to equal" "nothing" 68 | , note "but it does not." 69 | ] 70 | |> Message.format 71 | 72 | will produce text that looks something like: 73 | 74 | Expected 75 | 76 | something 77 | 78 | to equal 79 | 80 | nothing 81 | 82 | but it does not. 83 | 84 | -} 85 | format : List Message -> String 86 | format messages = 87 | List.map formatMessage messages 88 | |> joinMessages 89 | 90 | 91 | formatMessage : Message -> String 92 | formatMessage (Message msg) = 93 | case msg.detail of 94 | Just detail -> 95 | msg.statement ++ "\n\n" ++ (formatDetail detail) 96 | Nothing -> 97 | msg.statement 98 | 99 | 100 | formatDetail : String -> String 101 | formatDetail detail = 102 | String.split "\n" detail 103 | |> List.foldl (\s msg -> msg ++ "\t" ++ s ++ "\n") "" 104 | |> String.trimRight 105 | 106 | 107 | joinMessages : List String -> String 108 | joinMessages = 109 | String.join "\n\n" -------------------------------------------------------------------------------- /src/Elmer/Spy/Arg.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Spy.Arg exposing 2 | ( Arg(..) 3 | , ArgValue 4 | , asString 5 | , value 6 | , decoder 7 | ) 8 | 9 | {-| Exposed for testing 10 | 11 | @docs Arg, ArgValue, asString, value, decoder 12 | 13 | -} 14 | 15 | import Expect 16 | import Json.Decode as Json exposing (Decoder) 17 | import Elmer.Value.Native as Native 18 | import Elmer.Internal as Internal 19 | 20 | 21 | {-| 22 | -} 23 | type Arg 24 | = StringArg String 25 | | IntArg Int 26 | | FloatArg Float 27 | | BoolArg Bool 28 | | TypedArg ArgValue 29 | | FunctionArg 30 | | AnyArg 31 | | ArgThat (ArgValue -> Expect.Expectation) 32 | 33 | 34 | {-| 35 | -} 36 | type ArgValue 37 | = ArgValue 38 | 39 | 40 | {-| 41 | -} 42 | value : Arg -> Maybe ArgValue 43 | value arg = 44 | case arg of 45 | StringArg str -> 46 | Just <| Native.cast str 47 | IntArg num -> 48 | Just <| Native.cast num 49 | FloatArg num -> 50 | Just <| Native.cast num 51 | BoolArg bool -> 52 | Just <| Native.cast bool 53 | TypedArg typed -> 54 | Just <| Native.cast typed 55 | FunctionArg -> 56 | Nothing 57 | AnyArg -> 58 | Just <| Native.cast never 59 | ArgThat _ -> 60 | Just <| Native.cast never 61 | 62 | 63 | {-| 64 | -} 65 | asString : Arg -> String 66 | asString arg = 67 | case arg of 68 | StringArg str -> 69 | "\"" ++ str ++ "\"" 70 | IntArg num -> 71 | String.fromInt num 72 | FloatArg num -> 73 | String.fromFloat num 74 | BoolArg bool -> 75 | Internal.boolToString bool 76 | TypedArg typed -> 77 | Debug.toString typed 78 | FunctionArg -> 79 | "" 80 | AnyArg -> 81 | "" 82 | ArgThat _ -> 83 | "" 84 | 85 | 86 | {-| 87 | -} 88 | decoder : Decoder Arg 89 | decoder = 90 | Native.decoder 91 | |> Json.map (\arg -> (Native.nativeType arg, arg)) 92 | |> Json.map (\(argType, val) -> 93 | case argType of 94 | "string" -> 95 | StringArg <| Native.cast val 96 | "int" -> 97 | IntArg <| Native.cast val 98 | "float" -> 99 | FloatArg <| Native.cast val 100 | "object" -> 101 | TypedArg <| Native.cast val 102 | "boolean" -> 103 | BoolArg <| Native.cast val 104 | "function" -> 105 | FunctionArg 106 | _ -> 107 | AnyArg 108 | ) 109 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/TripleComponentTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.TripleComponentTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events exposing (onClick) 6 | 7 | 8 | -- Models 9 | 10 | type alias Model = 11 | { childModel: ChildModel 12 | } 13 | 14 | type alias ChildModel = 15 | { grandChildModel: GrandChildModel 16 | } 17 | 18 | type alias GrandChildModel = 19 | { name: String 20 | } 21 | 22 | defaultModel : Model 23 | defaultModel = 24 | { childModel = defaultChildModel 25 | } 26 | 27 | defaultChildModel : ChildModel 28 | defaultChildModel = 29 | { grandChildModel = defaultGrandChildModel 30 | } 31 | 32 | defaultGrandChildModel : GrandChildModel 33 | defaultGrandChildModel = 34 | { name = "Not Clicked" 35 | } 36 | 37 | -- Msgs 38 | 39 | type Msg = 40 | ChildMsgWrapper ChildMsg 41 | 42 | type ChildMsg = 43 | GrandChildMsgWrapper GrandChildMsg 44 | 45 | type GrandChildMsg = 46 | HandleClick String 47 | 48 | -- Updates 49 | 50 | update : Msg -> Model -> (Model, Cmd Msg) 51 | update msg model = 52 | case msg of 53 | ChildMsgWrapper childMsg -> 54 | let 55 | (childModel, childCmd) = childUpdate childMsg model.childModel 56 | in 57 | ( { model | childModel = childModel }, Cmd.map ChildMsgWrapper childCmd ) 58 | 59 | childUpdate : ChildMsg -> ChildModel -> (ChildModel, Cmd ChildMsg) 60 | childUpdate msg model = 61 | case msg of 62 | GrandChildMsgWrapper grandChildMsg -> 63 | let 64 | (grandChildModel, grandChildCmd) = grandChildUpdate grandChildMsg model.grandChildModel 65 | in 66 | ( { model | grandChildModel = grandChildModel }, Cmd.map GrandChildMsgWrapper grandChildCmd ) 67 | 68 | grandChildUpdate : GrandChildMsg -> GrandChildModel -> (GrandChildModel, Cmd GrandChildMsg) 69 | grandChildUpdate msg model = 70 | case msg of 71 | HandleClick name -> 72 | ( { model | name = name }, Cmd.none ) 73 | 74 | -- Views 75 | 76 | view : Model -> Html Msg 77 | view model = 78 | Html.div [ Attr.id "parent-view" ] 79 | [ Html.map ChildMsgWrapper <| childView model.childModel ] 80 | 81 | childView : ChildModel -> Html ChildMsg 82 | childView model = 83 | Html.div [ Attr.id "child-view" ] 84 | [ Html.map GrandChildMsgWrapper <| grandChildView model.grandChildModel ] 85 | 86 | grandChildView : GrandChildModel -> Html GrandChildMsg 87 | grandChildView model = 88 | Html.div [ Attr.id "grand-child-view" ] 89 | [ Html.div [ Attr.id "grand-child-name" ] 90 | [ Html.text model.name ] 91 | , Html.button [ onClick <| HandleClick "Handled Click" ] 92 | [ Html.text "Click Me"] 93 | ] 94 | -------------------------------------------------------------------------------- /tests/src/Elmer/SpySpanTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.SpySpanTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer 6 | import Elmer.Spy as Spy exposing (Spy, andCallThrough) 7 | import Elmer.Spy.Matchers exposing (..) 8 | import Elmer.Command as Command 9 | import Elmer.Html as Markup 10 | import Elmer.Html.Matchers exposing (element, hasText) 11 | import Elmer.Html.Selector as Sel exposing (..) 12 | import Elmer.Html.Event as Event 13 | import Html exposing (Html) 14 | import Html.Attributes as Attr 15 | import Html.Events as Events 16 | 17 | 18 | all : Test 19 | all = 20 | Test.concat 21 | [ spanTests 22 | ] 23 | 24 | 25 | spanTests : Test 26 | spanTests = 27 | describe "when calls to a spy span multiple test state steps" <| 28 | let 29 | testState = 30 | Elmer.given defaultModel view update 31 | |> Spy.use [ multiStepFunctionSpy ] 32 | |> Markup.target << by [ id "input-field" ] 33 | |> Event.input "Some text" 34 | |> Markup.target << by [ id "submit-button" ] 35 | |> Event.click 36 | in 37 | [ test "it works as expected" <| 38 | \() -> 39 | testState 40 | |> Markup.target << by [ id "result" ] 41 | |> Markup.expect (element <| hasText "Some text AND 17") 42 | , test "it records all the calls" <| 43 | \() -> 44 | testState 45 | |> Spy.expect (\_ -> multiStepFunction) ( 46 | Elmer.expectAll 47 | [ wasCalledWith [ stringArg "Some text", intArg 17 ] 48 | ] 49 | ) 50 | ] 51 | 52 | 53 | multiStepFunctionSpy : Spy 54 | multiStepFunctionSpy = 55 | Spy.observe (\_ -> multiStepFunction) 56 | |> andCallThrough 57 | 58 | 59 | multiStepFunction : String -> Int -> String 60 | multiStepFunction word num = 61 | word ++ " AND " ++ String.fromInt num 62 | 63 | 64 | type Msg 65 | = GotInput String 66 | | ClickedButton 67 | 68 | type alias Model = 69 | { text: String 70 | , count: Int 71 | , someFunc: (Int -> String) 72 | } 73 | 74 | defaultModel : Model 75 | defaultModel = 76 | { text = "" 77 | , count = 17 78 | , someFunc = \_ -> "" 79 | } 80 | 81 | view : Model -> Html Msg 82 | view model = 83 | Html.div [] 84 | [ Html.div [ Attr.id "result" ] 85 | [ Html.text <| model.text ] 86 | , Html.input [ Attr.id "input-field", Events.onInput GotInput ] 87 | [] 88 | , Html.button [ Attr.id "submit-button", Events.onClick ClickedButton ] 89 | [ Html.text "Click me!" ] 90 | ] 91 | 92 | update : Msg -> Model -> (Model, Cmd Msg) 93 | update msg model = 94 | case msg of 95 | GotInput val -> 96 | ({ model | text = val, someFunc = multiStepFunction val }, Cmd.none) 97 | ClickedButton -> 98 | ({ model | text = model.someFunc model.count }, Cmd.none) 99 | -------------------------------------------------------------------------------- /tests/src/Elmer/DocumentTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.DocumentTests exposing (all) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer.Program 6 | import Elmer.Program.Matchers exposing (expectTitle) 7 | import Elmer.TestState as TestState 8 | import Elmer 9 | import Elmer.Navigation as Navigation 10 | import Elmer.Html as Markup 11 | import Elmer.Html.Matchers exposing (element, hasText) 12 | import Elmer.Html.Selector as Sel exposing (by) 13 | import Elmer.Errors as Errors 14 | import Elmer.UrlHelpers as UrlHelpers 15 | import Elmer.TestHelpers exposing (expectError) 16 | import Elmer.TestApps.DocumentTestApp as App 17 | import Elmer.TestApps.SimpleTestApp as SimpleApp 18 | 19 | 20 | all : Test 21 | all = 22 | Test.concat 23 | [ givenDocumentTests 24 | , expectTitleTests 25 | ] 26 | 27 | 28 | givenDocumentTests : Test 29 | givenDocumentTests = 30 | describe "given a document" 31 | [ test "it creates a TestState" <| 32 | \() -> 33 | Elmer.Program.givenDocument App.view App.update 34 | |> Elmer.Program.init (\() -> App.init ()) 35 | |> Markup.target << by [ Sel.id "some-element" ] 36 | |> Markup.expect (element <| hasText "Fun Stuff") 37 | ] 38 | 39 | 40 | expectTitleTests : Test 41 | expectTitleTests = 42 | describe "expect application title" 43 | [ describe "when there is an upstream failure" 44 | [ test "it shows the failure" <| 45 | \() -> 46 | TestState.failure "Failed!" 47 | |> expectTitle "Something" 48 | |> Expect.equal (Expect.fail "Failed!") 49 | ] 50 | , describe "when the view function does not result in a document" 51 | [ test "it fails" <| 52 | \() -> 53 | Elmer.given SimpleApp.defaultModel SimpleApp.view SimpleApp.update 54 | |> expectTitle "Document Title" 55 | |> expectError (Errors.noTitle "Document Title") 56 | ] 57 | , describe "when no model has been set via init" 58 | [ test "it fails" <| 59 | \() -> 60 | Elmer.Program.givenDocument App.view App.update 61 | |> expectTitle "Wrong Title" 62 | |> expectError Errors.noModel 63 | ] 64 | , describe "when the title is not what is expected" 65 | [ test "it fails" <| 66 | \() -> 67 | Elmer.Program.givenDocument App.view App.update 68 | |> Elmer.Program.init (\() -> App.init ()) 69 | |> expectTitle "Wrong Title" 70 | |> expectError (Errors.wrongTitle "Wrong Title" "Fun Title") 71 | ] 72 | , describe "when the expected title matches the title" 73 | [ test "it passes" <| 74 | \() -> 75 | Elmer.Program.givenDocument App.view App.update 76 | |> Elmer.Program.init (\() -> App.init ()) 77 | |> expectTitle "Fun Title" 78 | ] 79 | ] 80 | -------------------------------------------------------------------------------- /tests/src/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (all) 2 | 3 | import Test exposing (..) 4 | 5 | import Elmer.HtmlTests as HtmlTests 6 | import Elmer.HtmlQueryTests as HtmlQueryTests 7 | import Elmer.HtmlMatcherTests as HtmlMatcherTests 8 | import Elmer.EventTests as EventTests 9 | import Elmer.InputEventTests as InputEventTests 10 | import Elmer.FocusEventTests as FocusEventTests 11 | import Elmer.MouseEventTests as MouseEventTests 12 | import Elmer.HtmlLazyTests as HtmlLazyTests 13 | import Elmer.HtmlKeyedTests as HtmlKeyedTests 14 | import Elmer.ElementTests as ElementTests 15 | import Elmer.ElmerTests as ElmerTests 16 | import Elmer.SpyTests as SpyTests 17 | import Elmer.SpyMatcherTests as SpyMatcherTests 18 | import Elmer.SpyFakeTests as SpyFakeTests 19 | import Elmer.CommandTests as CommandTests 20 | import Elmer.TaskTests as TaskTests 21 | import Elmer.RuntimeTests as RuntimeTests 22 | import Elmer.GivenCommandTests as GivenCommandTests 23 | import Elmer.FailureTests as FailureTests 24 | import Elmer.SubscriptionTests as SubscriptionTests 25 | import Elmer.TestStateTests as TestsStateTests 26 | import Elmer.PortTests as PortTests 27 | import Elmer.RandomTests as RandomTests 28 | import Elmer.WorkerTests as WorkerTests 29 | import Elmer.TripleComponentTests as TripleComponentTests 30 | import Elmer.ApplicationTests as ApplicationTests 31 | import Elmer.DocumentTests as DocumentTests 32 | import Elmer.NavigationTests as NavigationTests 33 | import Elmer.ComponentTests as ComponentTests 34 | import Elmer.BrowserTests as BrowserTests 35 | import Elmer.HtmlCustomTests as HtmlCustomTests 36 | import Elmer.SpySpanTests as SpySpanTests 37 | import Elmer.ValueTests as ValueTests 38 | import Elmer.EffectsTests as EffectsTests 39 | import Elmer.MessageTests as MessageTests 40 | 41 | all : Test 42 | all = 43 | Test.concat 44 | [ BrowserTests.all 45 | , ComponentTests.all 46 | , NavigationTests.all 47 | , DocumentTests.all 48 | , ApplicationTests.all 49 | , TripleComponentTests.all 50 | , WorkerTests.all 51 | , RandomTests.all 52 | , PortTests.all 53 | , TestsStateTests.all 54 | , SubscriptionTests.all 55 | , FailureTests.all 56 | , GivenCommandTests.all 57 | , RuntimeTests.all 58 | , TaskTests.all 59 | , CommandTests.all 60 | , SpyFakeTests.all 61 | , SpyMatcherTests.all 62 | , SpyTests.all 63 | , SpySpanTests.all 64 | , ElementTests.all 65 | , ElmerTests.all 66 | , HtmlKeyedTests.all 67 | , HtmlLazyTests.all 68 | , HtmlCustomTests.all 69 | , HtmlTests.all 70 | , HtmlQueryTests.all 71 | , HtmlMatcherTests.all 72 | , EventTests.all 73 | , InputEventTests.all 74 | , FocusEventTests.all 75 | , MouseEventTests.all 76 | , ValueTests.all 77 | , EffectsTests.all 78 | , MessageTests.all 79 | ] -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/SpyTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.SpyTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events as Events 6 | 7 | type alias Model = 8 | { name : String 9 | , anotherName : String 10 | } 11 | 12 | type Msg 13 | = HandleClick 14 | | HandleMultiArgClick 15 | | SuccessiveArgClick 16 | 17 | defaultModel : Model 18 | defaultModel = 19 | { name = "Cool Person" 20 | , anotherName = "Super" 21 | } 22 | 23 | view : Model -> Html Msg 24 | view model = 25 | Html.div 26 | [ Attr.id "root", Attr.class "styled no-events" ] 27 | [ Html.div [ Attr.id "title" ] [ Html.text <| titleText "Some Title" ] 28 | , Html.div [ Attr.id "button", Events.onClick HandleClick ] [ Html.text "Click me to clear!" ] 29 | , Html.div [ Attr.id "multi-arg-button", Events.onClick HandleMultiArgClick ] [ Html.text "Click me!" ] 30 | , Html.div [ Attr.id "successive-arg-button", Events.onClick SuccessiveArgClick ] [ Html.text "Click me!" ] 31 | , Html.div [ Attr.id "name" ] [ Html.text <| "Name: " ++ model.name ] 32 | , Html.div [ Attr.id "footer" ] [ Html.text footerText ] 33 | ] 34 | 35 | update : Msg -> Model -> ( Model, Cmd Msg ) 36 | update msg model = 37 | case msg of 38 | HandleClick -> 39 | ( clearName "Default Name" model, Cmd.none ) 40 | HandleMultiArgClick -> 41 | ( { model | name = combineNames "Dr." "Awesome" "Dude" }, Cmd.none ) 42 | SuccessiveArgClick -> 43 | let 44 | combineFunc = combineNames "Mrs." "Funny" 45 | in 46 | ( { model | name = combineFunc "Animal" }, Cmd.none ) 47 | 48 | titleText : String -> String 49 | titleText name = 50 | "A Title: " ++ name 51 | 52 | footerText : String 53 | footerText = 54 | "This is the footer" 55 | 56 | combineNames : String -> String -> String -> String 57 | combineNames kind firstName lastName = 58 | kind ++ firstName ++ lastName 59 | 60 | clearName : String -> Model -> Model 61 | clearName default model = 62 | { model | name = default } 63 | 64 | type alias TestRecord = 65 | { kind : String 66 | , duration : Float 67 | } 68 | 69 | type FunKind 70 | = Flower String 71 | | Fruit String 72 | | Game String 73 | 74 | type alias Flags = 75 | { name : String 76 | , times : Int 77 | , floatArg : Float 78 | , boolArg : Bool 79 | , recordArg : TestRecord 80 | , unionTypeArg : FunKind 81 | , unionTypeTagger : (String -> FunKind) 82 | } 83 | 84 | makeModel : String -> Int -> Float -> Bool -> TestRecord -> FunKind -> (String -> FunKind) -> Model 85 | makeModel name times floatArg boolArg recordArg unionArg tagger = 86 | { name = name 87 | , anotherName = name 88 | } 89 | 90 | init : Flags -> ( Model, Cmd Msg ) 91 | init flags = 92 | ( makeModel flags.name flags.times flags.floatArg flags.boolArg flags.recordArg flags.unionTypeArg flags.unionTypeTagger, Cmd.none ) 93 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/NavigationTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.NavigationTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events exposing (onClick) 6 | import Browser.Navigation as Navigation 7 | import Browser exposing (Document, UrlRequest(..)) 8 | import Url exposing (Url) 9 | 10 | import Elmer.Navigation 11 | 12 | 13 | type alias Model = 14 | { error: String 15 | , navigationKey : Navigation.Key 16 | } 17 | 18 | type Msg 19 | = DoPushUrl 20 | | DoReplaceUrl 21 | | DoLoadUrl 22 | | DoPushBadUrl 23 | | DoReplaceBadUrl 24 | | OnUrlRequest UrlRequest 25 | | OnUrlChange Url 26 | 27 | 28 | init : () -> Url -> Navigation.Key -> ( Model, Cmd Msg ) 29 | init _ url key = 30 | ( { error = "" 31 | , navigationKey = key 32 | } 33 | , Cmd.none 34 | ) 35 | 36 | defaultModel : Model 37 | defaultModel = 38 | { error = "" 39 | , navigationKey = Elmer.Navigation.fakeKey 40 | } 41 | 42 | view : Model -> Document Msg 43 | view model = 44 | { title = "Navigation Test App" 45 | , body = [ pageView model ] 46 | } 47 | 48 | pageView : Model -> Html Msg 49 | pageView model = 50 | Html.div [ Attr.id "root" ] 51 | [ Html.div [ Attr.id "pushUrlButton", onClick DoPushUrl ] [ Html.text "Click to navigate!" ] 52 | , Html.div [ Attr.id "replaceUrlButton", onClick DoReplaceUrl ] [ Html.text "Click to also navigate!" ] 53 | , Html.div [ Attr.id "loadUrlButton", onClick DoLoadUrl ] [ Html.text "Click to load a new url!" ] 54 | , Html.div [ Attr.id "pushBadUrl", onClick DoPushBadUrl ] [ Html.text "Click for bad url!" ] 55 | , Html.div [ Attr.id "replaceBadUrl", onClick DoReplaceBadUrl ] [ Html.text "Click for bad url!" ] 56 | , Html.div [ Attr.class "error" ] [ Html.text model.error ] 57 | ] 58 | 59 | update : Msg -> Model -> ( Model, Cmd Msg ) 60 | update msg model = 61 | case msg of 62 | DoPushUrl -> 63 | ( model, Navigation.pushUrl model.navigationKey "http://fun.com/fun.html" ) 64 | DoReplaceUrl -> 65 | ( model, Navigation.replaceUrl model.navigationKey "http://fun.com/awesome.html" ) 66 | DoLoadUrl -> 67 | ( model, Navigation.load "http://somewhere.com/anotherPlace.html" ) 68 | DoPushBadUrl -> 69 | ( model, Navigation.pushUrl model.navigationKey "kdshjfkdsjhfksd" ) 70 | DoReplaceBadUrl -> 71 | ( model, Navigation.replaceUrl model.navigationKey "kdshjfkdsjhfksd" ) 72 | OnUrlRequest urlRequest -> 73 | case urlRequest of 74 | Internal url -> 75 | ( model, Navigation.pushUrl model.navigationKey <| Url.toString url ) 76 | External location -> 77 | ( model, Navigation.load location ) 78 | OnUrlChange url -> 79 | if url.path == "/api/view" then 80 | ( { model | error = "No error" }, Cmd.none ) 81 | else 82 | ( { model | error = "Unknown path: " ++ url.path }, Cmd.none ) 83 | 84 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Intention.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Intention exposing 2 | ( Intention(..) 3 | , cmdValue 4 | , subValue 5 | , toCmd 6 | , toSub 7 | , cmdData 8 | , subData 9 | ) 10 | 11 | import Json.Decode as Json 12 | import Elmer.Value as Value 13 | import Elmer.Value.Native as Native 14 | 15 | type Intention a msg subMsg 16 | = Leaf (LeafData a) 17 | | Tree (TreeData a subMsg msg) 18 | | Batch (List a) 19 | | Unknown 20 | 21 | type alias TreeData a subMsg msg = 22 | { tree : a 23 | , tagger : subMsg -> msg 24 | } 25 | 26 | type alias LeafData a = 27 | { intention : a 28 | , home : String 29 | } 30 | 31 | 32 | cmdData : Cmd msg -> Intention (Cmd msg) msg subMsg 33 | cmdData cmd = 34 | decode (intentionDecoder cmd) cmd 35 | 36 | 37 | cmdValue : Cmd a -> b 38 | cmdValue = 39 | decode intentionValueDecoder 40 | 41 | 42 | subData : Sub msg -> Intention (Sub msg) msg subMsg 43 | subData sub = 44 | decode (intentionDecoder sub) sub 45 | 46 | 47 | subValue : Sub a -> b 48 | subValue = 49 | decode intentionValueDecoder 50 | 51 | 52 | decode : Json.Decoder a -> v -> b 53 | decode decoder value = 54 | case Value.decode decoder value of 55 | Ok v -> 56 | v 57 | Err msg -> 58 | "Could not decode intention value: " ++ Json.errorToString msg 59 | |> Debug.todo 60 | 61 | 62 | toCmd : String -> a -> Cmd msg 63 | toCmd = 64 | toIntention 65 | 66 | 67 | toSub : String -> a -> Sub msg 68 | toSub = 69 | toIntention 70 | 71 | 72 | toIntention : String -> a -> b 73 | toIntention = 74 | Native.global "_Platform_leaf" 75 | 76 | 77 | intentionDecoder : v -> Json.Decoder (Intention v msg subMsg) 78 | intentionDecoder value = 79 | Native.constructor 80 | |> Json.andThen (\ctor -> 81 | case ctor of 82 | 1 -> 83 | Native.field "k" 84 | |> Json.map (\home -> 85 | Leaf { intention = value, home = home } 86 | ) 87 | 2 -> 88 | Native.field "m" 89 | |> Json.map Batch 90 | 3 -> 91 | Json.map2 (\tree tagger -> 92 | Tree ({ tree = tree, tagger = tagger }) 93 | ) 94 | (Native.field "o") 95 | (Native.field "n") 96 | unknownType -> 97 | "Unknown intention type: " ++ String.fromInt unknownType 98 | |> Debug.todo 99 | ) 100 | 101 | 102 | intentionValueDecoder : Json.Decoder (a -> b) 103 | intentionValueDecoder = 104 | Native.constructor 105 | |> Json.andThen (\ctor -> 106 | case ctor of 107 | 1 -> 108 | Native.field "l" 109 | 3 -> 110 | Json.field "o" intentionValueDecoder 111 | unknownType -> 112 | "Unknown intention type: " ++ String.fromInt unknownType 113 | |> Debug.todo 114 | ) 115 | -------------------------------------------------------------------------------- /src/Elmer/Message/Failure.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Message.Failure exposing 2 | ( Failure 3 | , format 4 | ) 5 | 6 | {-| Format a test failure reason from 7 | the [elm-explorations/test](https://package.elm-lang.org/packages/elm-explorations/test/latest/) 8 | package. 9 | 10 | Note that these functions are mainly useful when writing extensions to Elmer 11 | or custom matchers. 12 | 13 | @docs Failure, format 14 | 15 | -} 16 | 17 | import Test.Runner.Failure 18 | 19 | {-| Represents a failure reason from the 20 | [elm-explorations/test](https://package.elm-lang.org/packages/elm-explorations/test/latest/) package. 21 | 22 | You can obtain a failure reason with `Test.Runner.getFailureReason`. 23 | 24 | See [the elm-explorations/test docs](https://package.elm-lang.org/packages/elm-explorations/test/latest/Test-Runner#getFailureReason) 25 | for more information. 26 | 27 | -} 28 | type alias Failure = 29 | { given: Maybe String 30 | , description: String 31 | , reason: Test.Runner.Failure.Reason 32 | } 33 | 34 | 35 | {-| Format a list of `Failure` values as a string. 36 | -} 37 | format : List Failure -> String 38 | format failures = 39 | List.map formatFailure failures 40 | |> joinMessages 41 | 42 | 43 | formatFailure : Failure -> String 44 | formatFailure failure = 45 | case failure.reason of 46 | Test.Runner.Failure.Custom -> 47 | failure.description 48 | Test.Runner.Failure.Equality one two -> 49 | case failure.description of 50 | "Expect.equal" -> 51 | one ++ " is not equal to " ++ two 52 | "Expect.notEqual" -> 53 | one ++ " is equal to " ++ two 54 | otherEquality -> 55 | otherEquality ++ " failed between " ++ two ++ " and " ++ one 56 | Test.Runner.Failure.Comparison one two -> 57 | case failure.description of 58 | "Expect.lessThan" -> 59 | two ++ " is not less than " ++ one 60 | "Expect.atMost" -> 61 | two ++ " is not at most " ++ one 62 | "Expect.greaterThan" -> 63 | two ++ " is not greater than " ++ one 64 | "Expect.atLeast" -> 65 | two ++ " is not at least " ++ one 66 | "Expect.err" -> 67 | two ++ " is not an Err" 68 | otherComparison -> 69 | otherComparison ++ " failed between " ++ two ++ " and " ++ one 70 | Test.Runner.Failure.ListDiff one two -> 71 | formatList two 72 | ++ "\n\nis not equal to\n\n" 73 | ++ formatList one 74 | Test.Runner.Failure.CollectionDiff data -> 75 | "Expected\n\n" 76 | ++ data.expected 77 | ++ "\n\nbut the actual value is\n\n" 78 | ++ data.actual 79 | _ -> 80 | "Failure " ++ Debug.toString failure 81 | 82 | 83 | failureToString : Failure -> String 84 | failureToString reason = 85 | reason.description 86 | 87 | 88 | formatList : List String -> String 89 | formatList list = 90 | "[ " ++ (String.join ", " list) ++ " ]" 91 | 92 | 93 | joinMessages : List String -> String 94 | joinMessages = 95 | String.join "\n\n" 96 | -------------------------------------------------------------------------------- /src/Elmer/Runtime.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime exposing 2 | ( performUpdate 3 | , performCommand 4 | ) 5 | 6 | {-| Exposed for Testing 7 | 8 | @docs performUpdate, performCommand 9 | 10 | -} 11 | 12 | import Elmer.Context as Context exposing (Context) 13 | import Elmer.Runtime.Types exposing (..) 14 | import Elmer.Runtime.Command as RuntimeCommand 15 | import Elmer.Runtime.Intention as Intention exposing (Intention(..)) 16 | import Elmer.Errors as Errors 17 | 18 | 19 | 20 | {-| 21 | -} 22 | performUpdate : msg -> Context model msg -> RuntimeResult model msg 23 | performUpdate message context = 24 | case Context.update message context of 25 | Just ( updatedContext, command ) -> 26 | performCommand command updatedContext 27 | Nothing -> 28 | Err <| Errors.print Errors.noModel 29 | 30 | 31 | {-| 32 | -} 33 | performCommand : Cmd msg -> Context model msg -> RuntimeResult model msg 34 | performCommand command context = 35 | let 36 | commandResults = 37 | runCommand identity command 38 | in 39 | List.foldl reduceCommandResults (Ok context) commandResults 40 | 41 | 42 | reduceCommandResults : CommandResult model msg -> RuntimeResult model msg -> RuntimeResult model msg 43 | reduceCommandResults commandResult currentResult = 44 | case currentResult of 45 | Ok context -> 46 | case commandResult of 47 | CommandSuccess commandEffect -> 48 | let 49 | ( updatedContext, updatedCommand ) = processCommandEffect commandEffect context 50 | in 51 | if updatedCommand == Cmd.none then 52 | Ok updatedContext 53 | else 54 | performCommand updatedCommand updatedContext 55 | CommandError errorMessage -> 56 | Err errorMessage 57 | Err errorMessage -> 58 | Err errorMessage 59 | 60 | 61 | processCommandEffect : CommandEffect model msg -> Context model msg -> ( Context model msg, Cmd msg ) 62 | processCommandEffect commandEffect context = 63 | commandEffect context 64 | 65 | 66 | runCommand : (subMsg -> msg) -> Cmd subMsg -> List (CommandResult model msg) 67 | runCommand tagger command = 68 | case Intention.cmdData command of 69 | Leaf data -> 70 | let 71 | runner = RuntimeCommand.commandRunner data.home 72 | commandResult = runner data.intention tagger 73 | in 74 | [ commandResult ] 75 | 76 | Tree data -> 77 | let 78 | composedTagger = composeFunctions tagger data.tagger 79 | in 80 | runCommand (composedTagger) data.tree 81 | 82 | Batch commands -> 83 | List.concat (List.map (\c -> runCommand tagger c) commands) 84 | 85 | Unknown -> 86 | let 87 | commandResult = CommandSuccess (\testState -> ( testState, Cmd.none )) 88 | in 89 | [ commandResult ] 90 | 91 | 92 | composeFunctions : (msg -> parentMsg) -> (subMsg -> msg) -> (subMsg -> parentMsg) 93 | composeFunctions f g = 94 | f << g 95 | -------------------------------------------------------------------------------- /tests/src/Elmer/HtmlLazyTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.HtmlLazyTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer.TestState as TestState exposing (TestState) 6 | import Elmer.Html as Markup 7 | import Elmer.Html.Event as Event 8 | import Elmer 9 | import Elmer.Html.Matchers as Matchers exposing (..) 10 | import Elmer.Html.Selector as S exposing (..) 11 | import Html.Attributes as Attr 12 | import Html exposing (Html) 13 | import Elmer.TestApps.LazyTestApp as App 14 | 15 | 16 | all : Test 17 | all = 18 | Test.concat 19 | [ lazyTests 20 | , lazy2Tests 21 | , lazy3Tests 22 | ] 23 | 24 | lazyTests : Test 25 | lazyTests = 26 | describe "When a view uses lazy" 27 | [ test "it renders the lazy html" <| 28 | \() -> 29 | Elmer.given App.defaultModel App.view App.update 30 | |> Markup.target << by [ id "lazy-div" ] 31 | |> Markup.expect (element <| hasText "Some name: Cool Person") 32 | , test "it passes inherited events" <| 33 | \() -> 34 | Elmer.given App.defaultModel App.view App.update 35 | |> Markup.target << by [ id "lazy-div" ] 36 | |> Event.click 37 | |> Markup.expect (element <| hasText "Some name: Awesome Person") 38 | , test "it maps events from lazy html" <| 39 | \() -> 40 | Elmer.given defaultWrappedModel wrappedView wrappedUpdate 41 | |> Markup.target << by [ id "lazy-div" ] 42 | |> Event.click 43 | |> Markup.expect (element <| hasText "Happy Cool Person likes bowling") 44 | ] 45 | 46 | 47 | lazy2Tests : Test 48 | lazy2Tests = 49 | describe "When a view uses lazy2" 50 | [ test "it renders the lazy html" <| 51 | \() -> 52 | Elmer.given App.defaultModel App.lazyView2 App.update 53 | |> Markup.target << by [ id "lazy-div" ] 54 | |> Markup.expect (element <| hasText "Cool Person likes bowling") 55 | ] 56 | 57 | 58 | lazy3Tests : Test 59 | lazy3Tests = 60 | describe "When a view uses lazy3" 61 | [ test "it renders the lazy html" <| 62 | \() -> 63 | Elmer.given App.defaultModel App.lazyView3 App.update 64 | |> Markup.target << by [ id "root" ] 65 | |> Markup.expect (element <| hasText "Cool Person likes bowling 5 times a week!") 66 | ] 67 | 68 | 69 | -- Test app for Html.Map and Cmd.map 70 | 71 | type TestMsg 72 | = AppMsg App.Msg 73 | 74 | type alias TestModel = 75 | { appModel : App.Model 76 | } 77 | 78 | defaultWrappedModel : TestModel 79 | defaultWrappedModel = 80 | { appModel = App.defaultModel 81 | } 82 | 83 | wrappedView : TestModel -> Html TestMsg 84 | wrappedView model = 85 | Html.div [ Attr.id "app-view" ] 86 | [ Html.map AppMsg <| App.lazyView2 model.appModel ] 87 | 88 | wrappedUpdate : TestMsg -> TestModel -> ( TestModel, Cmd TestMsg ) 89 | wrappedUpdate msg model = 90 | case msg of 91 | AppMsg appMsg -> 92 | let 93 | ( updatedModel, updatedCommand ) = App.update appMsg model.appModel 94 | in 95 | ( { model | appModel = updatedModel } 96 | , Cmd.map AppMsg updatedCommand 97 | ) 98 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/SubscriptionTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.SubscriptionTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Time exposing (Posix, utc) 6 | 7 | type alias Model = 8 | { time : Posix 9 | , minuteTime : Posix 10 | , childModel : ChildModel 11 | } 12 | 13 | defaultModel : Model 14 | defaultModel = 15 | { time = Time.millisToPosix 0 16 | , minuteTime = Time.millisToPosix 0 17 | , childModel = defaultChildModel 18 | } 19 | 20 | type Msg 21 | = NewTime Posix 22 | | NewMinute Posix 23 | | Child ChildMsg 24 | 25 | view : Model -> Html Msg 26 | view model = 27 | Html.div [ Attr.id "root" ] 28 | [ Html.div [ Attr.id "time" ] [ Html.text ( (formatTime model.time) ++ " seconds" ) ] 29 | , Html.div [ Attr.id "minute" ] [ Html.text ( (formatMinutes model.minuteTime) ++ " minutes" ) ] 30 | , Html.map Child (childView model.childModel) 31 | ] 32 | 33 | formatTime : Posix -> String 34 | formatTime time = 35 | Time.toSecond utc time 36 | |> String.fromInt 37 | 38 | formatMinutes : Posix -> String 39 | formatMinutes time = 40 | Time.toMinute utc time 41 | |> String.fromInt 42 | 43 | update : Msg -> Model -> ( Model, Cmd Msg ) 44 | update msg model = 45 | case msg of 46 | NewTime time -> 47 | ( { model | time = time }, Cmd.none ) 48 | NewMinute time -> 49 | ( { model | minuteTime = time }, Cmd.none ) 50 | Child childMsg -> 51 | let 52 | ( childModel, childCmd ) = childUpdate childMsg model.childModel 53 | in 54 | ( { model | childModel = childModel }, Cmd.none ) 55 | 56 | subscriptions : Model -> Sub Msg 57 | subscriptions model = 58 | Time.every 1000 NewTime 59 | 60 | batchedSubscriptions : Model -> Sub Msg 61 | batchedSubscriptions model = 62 | Sub.batch 63 | [ Time.every 1000 NewTime 64 | , Time.every (60 * 1000) NewMinute 65 | ] 66 | 67 | mappedSubscriptions : Model -> Sub Msg 68 | mappedSubscriptions model = 69 | Sub.map Child (childSubscriptions model.childModel) 70 | 71 | 72 | -- Child Component 73 | 74 | type ChildMsg 75 | = NewHour Posix 76 | | NewMilli Posix 77 | 78 | type alias ChildModel = 79 | { hours: Posix } 80 | 81 | defaultChildModel : ChildModel 82 | defaultChildModel = 83 | { hours = Time.millisToPosix 0 } 84 | 85 | childView : ChildModel -> Html ChildMsg 86 | childView model = 87 | Html.div [ Attr.id "child" ] 88 | [ Html.div [ Attr.id "child-hours" ] [ Html.text ((formatHour model.hours) ++ " hours") ] 89 | ] 90 | 91 | childUpdate : ChildMsg -> ChildModel -> ( ChildModel, Cmd ChildMsg ) 92 | childUpdate msg model = 93 | case msg of 94 | NewHour time -> 95 | ( { model | hours = time }, Cmd.none ) 96 | NewMilli time -> 97 | ( model, Cmd.none ) 98 | 99 | formatHour : Posix -> String 100 | formatHour time = 101 | Time.toHour utc time 102 | |> String.fromInt 103 | 104 | childSubscriptions : ChildModel -> Sub ChildMsg 105 | childSubscriptions model = 106 | Sub.batch 107 | [ Time.every (60 * 60 * 1000) NewHour 108 | , Time.every 1 NewMilli 109 | ] 110 | -------------------------------------------------------------------------------- /src/Elmer/Context.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Context exposing 2 | ( Context 3 | , View(..) 4 | , Update 5 | , default 6 | , model 7 | , withModel 8 | , view 9 | , render 10 | , update 11 | , state 12 | , updateState 13 | , updateStateFor 14 | ) 15 | 16 | import Elmer.Runtime.Intention as Intention 17 | import Html exposing (Html) 18 | import Browser exposing (Document) 19 | 20 | 21 | type View model msg 22 | = HtmlView (model -> Html msg) 23 | | DocumentView (model -> Document msg) 24 | 25 | 26 | type alias Update model msg = 27 | msg -> model -> ( model, Cmd msg ) 28 | 29 | 30 | type Context model msg 31 | = Context (ContextInfo model msg) 32 | 33 | 34 | type alias ContextInfo model msg = 35 | { model : Maybe model 36 | , view : View model msg 37 | , update : Update model msg 38 | , state : List (Cmd msg) 39 | } 40 | 41 | 42 | default : View model msg -> Update model msg -> Context model msg 43 | default viewFunction updateFunction = 44 | Context 45 | { model = Nothing 46 | , view = viewFunction 47 | , update = updateFunction 48 | , state = [] 49 | } 50 | 51 | 52 | model : Context model msg -> Maybe model 53 | model (Context context) = 54 | context.model 55 | 56 | 57 | withModel : model -> Context model msg -> Context model msg 58 | withModel modelValue (Context context) = 59 | Context 60 | { context | model = Just modelValue } 61 | 62 | 63 | view : Context model msg -> View model msg 64 | view (Context context) = 65 | context.view 66 | 67 | 68 | render : Context model msg -> Maybe (Html msg) 69 | render (Context context) = 70 | Maybe.map (htmlRenderable context) context.model 71 | 72 | 73 | htmlRenderable : ContextInfo model msg -> model -> Html msg 74 | htmlRenderable context = 75 | case context.view of 76 | HtmlView viewFunction -> 77 | viewFunction 78 | DocumentView viewFunction -> 79 | \modelValue -> 80 | viewFunction modelValue 81 | |> .body 82 | |> Html.node "body" [] 83 | 84 | 85 | update : msg -> Context model msg -> Maybe (Context model msg, Cmd msg) 86 | update message (Context context) = 87 | Maybe.map (\modelValue -> 88 | let 89 | ( updatedModel, command ) = 90 | context.update message modelValue 91 | 92 | updatedContext = 93 | { context | model = Just updatedModel } 94 | in 95 | ( Context updatedContext, command ) 96 | ) context.model 97 | 98 | 99 | state : typeId -> Context model msg -> Maybe a 100 | state typeId (Context context) = 101 | context.state 102 | |> List.filter (\cmd -> typeId == (Intention.cmdValue cmd |> .typeId)) 103 | |> List.map (\cmd -> Intention.cmdValue cmd |> .mapper) 104 | |> List.foldl (\mapper val -> Just <| mapper val) Nothing 105 | 106 | 107 | updateState : Cmd msg -> Context model msg -> Context model msg 108 | updateState command (Context context) = 109 | Context 110 | { context | state = context.state ++ [ command ] } 111 | 112 | 113 | updateStateFor : Context model msg -> Cmd msg -> Context model msg 114 | updateStateFor context command = 115 | updateState command context -------------------------------------------------------------------------------- /tests/src/Elmer/SpyFakeTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.SpyFakeTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer 6 | import Elmer.Spy as Spy 7 | import Elmer.Spy.Matchers exposing (..) 8 | import Elmer.Command as Command 9 | import Elmer.Html as Markup 10 | import Elmer.Html.Selector as Sel exposing (..) 11 | import Elmer.Html.Event as Event 12 | import Elmer.TestApps.SpyFakeTestApp as App 13 | import Task 14 | 15 | 16 | all : Test 17 | all = 18 | Test.concat 19 | [ createWithTests 20 | ] 21 | 22 | 23 | createWithTests : Test 24 | createWithTests = 25 | describe "createWith" 26 | [ describe "when a fake function is used" 27 | [ test "it records the call" <| 28 | \() -> 29 | let 30 | fake = 31 | Spy.observe (\_ -> myFake) 32 | |> Spy.andCallThrough 33 | 34 | dependencies = 35 | { fetchName = Spy.inject (\_ -> myFake) 36 | , getNumber = (\_ -> 33) 37 | } 38 | in 39 | Elmer.given App.initialModel App.view (App.update dependencies) 40 | |> Spy.use [ fake ] 41 | |> Markup.target << by [ id "fetch-name-button" ] 42 | |> Event.click 43 | |> Spy.expect (\_ -> myFake) ( 44 | wasCalledWith [ functionArg, stringArg "Cool Dude" ] 45 | ) 46 | ] 47 | , describe "when more than one fake function is used" <| 48 | let 49 | funFake = 50 | Spy.observe (\_ -> myFake) 51 | |> Spy.andCallThrough 52 | 53 | awesomeFake = 54 | Spy.observe (\_ -> constantFake) 55 | |> Spy.andCallFake (\_ -> 17) 56 | 57 | dependencies = 58 | { fetchName = Spy.inject (\_ -> myFake) 59 | , getNumber = Spy.inject (\_ -> constantFake) 60 | } 61 | 62 | state = 63 | Elmer.given App.initialModel App.view (App.update dependencies) 64 | |> Spy.use [ funFake, awesomeFake ] 65 | |> Markup.target << by [ id "fetch-name-button" ] 66 | |> Event.click 67 | |> Event.click 68 | in 69 | [ test "it records the call for the first" <| 70 | \() -> 71 | state 72 | |> Spy.expect (\_ -> myFake) ( 73 | wasCalledWith [ functionArg, stringArg "Cool Dude" ] 74 | ) 75 | , test "it records the number of calls for the first spy" <| 76 | \() -> 77 | state 78 | |> Spy.expect (\_ -> myFake) ( 79 | wasCalled 2 80 | ) 81 | , test "it records the call for the second" <| 82 | \() -> 83 | state 84 | |> Spy.expect (\_ -> constantFake) ( 85 | wasCalledWith [ stringArg "Cool Dude" ] 86 | ) 87 | , test "it records the number of calls for the second spy" <| 88 | \() -> 89 | state 90 | |> Spy.expect (\_ -> constantFake) ( 91 | wasCalled 2 92 | ) 93 | ] 94 | ] 95 | 96 | 97 | myFake tagger word = 98 | tagger word 99 | |> Command.fake 100 | 101 | 102 | constantFake thing = 103 | 0 104 | -------------------------------------------------------------------------------- /src/Elmer/Html/Element/Printer.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Element.Printer exposing 2 | ( print 3 | ) 4 | 5 | {-| Exposed for testing 6 | 7 | @docs print 8 | 9 | -} 10 | 11 | import Elmer.Internal as Internal 12 | import Elmer.Html.Types exposing (..) 13 | import Dict 14 | 15 | 16 | {-| 17 | -} 18 | print : HtmlElement msg -> String 19 | print node = 20 | (printElement "" (Element node)) 21 | 22 | 23 | printElement : String -> HtmlNode msg -> String 24 | printElement indentation element = 25 | case element of 26 | Element node -> 27 | let 28 | childIndentation = indentation ++ " " 29 | facts = printFacts node 30 | events = printEvents node 31 | children = List.map (printElement childIndentation) node.children 32 | |> String.join "\n" 33 | in 34 | indentation ++ "- " ++ node.tag ++ " " ++ facts ++ " " ++ events ++ "\n" 35 | ++ children 36 | Text text -> 37 | indentation ++ "- " ++ text 38 | 39 | 40 | printEvents : HtmlElement msg -> String 41 | printEvents element = 42 | if List.isEmpty element.eventHandlers then 43 | "" 44 | else 45 | let 46 | eventString = List.map .eventType element.eventHandlers 47 | |> String.join ", " 48 | in 49 | "[ " ++ eventString ++ " ]" 50 | 51 | 52 | printFacts : HtmlElement msg -> String 53 | printFacts element = 54 | let 55 | factsList = 56 | attributesToStrings element ++ 57 | propertiesToStrings element ++ 58 | stylesToString element 59 | in 60 | if List.isEmpty factsList then 61 | "" 62 | else 63 | let 64 | factString = String.join ", " factsList 65 | in 66 | if String.isEmpty factString then 67 | "" 68 | else 69 | "{ " ++ factString ++ " }" 70 | 71 | 72 | propertiesToStrings : HtmlElement msg -> List String 73 | propertiesToStrings element = 74 | element.properties 75 | |> Dict.toList 76 | |> List.map factToString 77 | 78 | 79 | factToString : (String, HtmlFact) -> String 80 | factToString (key, fact) = 81 | case fact of 82 | StringValue value -> 83 | stringFactToString (key, value) 84 | BoolValue value -> 85 | boolFactToString (key, value) 86 | 87 | 88 | attributesToStrings : HtmlElement msg -> List String 89 | attributesToStrings element = 90 | element.attributes 91 | |> Dict.toList 92 | |> List.map stringFactToString 93 | 94 | 95 | stringFactToString : (String, String) -> String 96 | stringFactToString (key, value) = 97 | key ++ " = '" ++ value ++ "'" 98 | 99 | 100 | boolFactToString : (String, Bool) -> String 101 | boolFactToString (key, value) = 102 | key ++ " = " ++ Internal.boolToString value 103 | 104 | 105 | stylesToString : HtmlElement msg -> List String 106 | stylesToString element = 107 | let 108 | styleString = 109 | element.styles 110 | |> Dict.toList 111 | |> List.map styleFactToString 112 | |> String.join "; " 113 | in 114 | if String.isEmpty styleString then 115 | [] 116 | else 117 | [ stringFactToString ("style", styleString) ] 118 | 119 | 120 | styleFactToString : (String, String) -> String 121 | styleFactToString (key, value) = 122 | key ++ ": " ++ value -------------------------------------------------------------------------------- /src/Elmer/Html/Element/Internal.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Element.Internal exposing 2 | ( tag 3 | , elementId 4 | , classList 5 | , allAttrs 6 | , attributes 7 | , attribute 8 | , properties 9 | , property 10 | , styles 11 | , hasProperty 12 | , isCheckbox 13 | , isSubmitButton 14 | , isSubmitInput 15 | , texts 16 | , childElements 17 | ) 18 | 19 | import Json.Decode as Json 20 | import Elmer.Html.Types exposing (..) 21 | import Elmer.Internal as Internal 22 | import Dict exposing (Dict) 23 | 24 | 25 | tag : HtmlElement msg -> String 26 | tag element = 27 | element.tag 28 | 29 | 30 | texts : HtmlElement msg -> List String 31 | texts element = 32 | List.filterMap (\el -> 33 | case el of 34 | Element _ -> 35 | Nothing 36 | Text text -> 37 | Just text 38 | ) element.children 39 | 40 | 41 | childElements : HtmlElement msg -> List (HtmlElement msg) 42 | childElements element = 43 | List.filterMap (\el -> 44 | case el of 45 | Element child -> 46 | Just child 47 | Text _ -> 48 | Nothing 49 | ) element.children 50 | 51 | 52 | elementId : HtmlElement msg -> Maybe String 53 | elementId = 54 | property "id" 55 | 56 | 57 | classList : HtmlElement msg -> List String 58 | classList node = 59 | case property "className" node of 60 | Just classes -> 61 | String.split " " classes 62 | 63 | Nothing -> 64 | [] 65 | 66 | 67 | property : String -> HtmlElement msg -> Maybe String 68 | property name element = 69 | properties element 70 | |> Dict.get name 71 | 72 | 73 | hasProperty : (String, String) -> HtmlElement msg -> Bool 74 | hasProperty (key, value) element = 75 | property key element 76 | |> Maybe.withDefault "" 77 | |> (==) value 78 | 79 | 80 | properties : HtmlElement msg -> Dict String String 81 | properties element = 82 | element.properties 83 | |> Dict.toList 84 | |> List.filterMap (\(key, fact) -> 85 | case fact of 86 | StringValue value -> 87 | Just (key, value) 88 | BoolValue value -> 89 | Just (key, Internal.boolToString value) 90 | ) 91 | |> Dict.fromList 92 | 93 | 94 | styles : HtmlElement msg -> Dict String String 95 | styles element = 96 | element.styles 97 | 98 | 99 | attributes : HtmlElement msg -> Dict String String 100 | attributes element = 101 | element.attributes 102 | 103 | 104 | attribute : String -> HtmlElement msg -> Maybe String 105 | attribute name element = 106 | attributes element 107 | |> Dict.get name 108 | 109 | 110 | allAttrs : HtmlElement msg -> Dict String String 111 | allAttrs element = 112 | Dict.union (attributes element) (properties element) 113 | 114 | 115 | isCheckbox : HtmlElement msg -> Bool 116 | isCheckbox element = 117 | element.tag == "input" && 118 | ( property "type" element |> Maybe.withDefault "" ) == "checkbox" 119 | 120 | 121 | isSubmitInput : HtmlElement msg -> Bool 122 | isSubmitInput element = 123 | element.tag == "input" && 124 | hasProperty ("type", "submit") element 125 | 126 | 127 | isSubmitButton : HtmlElement msg -> Bool 128 | isSubmitButton element = 129 | element.tag == "button" && 130 | ( hasProperty ("type", "") element || 131 | hasProperty ("type", "submit") element 132 | ) 133 | -------------------------------------------------------------------------------- /src/Elmer/Runtime/Promise.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Runtime.Promise exposing 2 | ( decoder 3 | , failWith 4 | ) 5 | 6 | import Json.Decode as Json exposing (Value) 7 | import Elmer.Value.Native as Native 8 | import Elmer.Runtime.Command.Fail as Fail 9 | import Elmer.Runtime.Promise.Types exposing (..) 10 | 11 | 12 | decoder : Json.Decoder (Promise msg) 13 | decoder = 14 | Json.oneOf 15 | [ Json.lazy (\_ -> Json.map Continue decodeContinuation) 16 | , Json.map Complete decodeResolution 17 | , Json.lazy (\_ -> decodeElmerPromise) 18 | ] 19 | 20 | 21 | decodeContinuation : Json.Decoder (Continuation msg) 22 | decodeContinuation = 23 | decodeConstructorAndThen <| 24 | \ctor -> 25 | case ctor of 26 | 3 -> 27 | decodeAndThen 28 | 4 -> 29 | decodeOnError 30 | unknown -> 31 | "Unknown decodeContinuation constructor: " ++ String.fromInt unknown 32 | |> Json.fail 33 | 34 | 35 | decodeAndThen : Json.Decoder (Continuation msg) 36 | decodeAndThen = 37 | Json.map3 Continuation 38 | nextPromiseDecoder 39 | (Json.map Just <| callbackDecoder) 40 | (Json.succeed Nothing) 41 | 42 | 43 | decodeOnError : Json.Decoder (Continuation msg) 44 | decodeOnError = 45 | Json.map3 Continuation 46 | nextPromiseDecoder 47 | (Json.succeed Nothing) 48 | (Json.map Just <| callbackDecoder) 49 | 50 | 51 | nextPromiseDecoder : Json.Decoder (Promise msg) 52 | nextPromiseDecoder = 53 | Json.field "d" (Json.lazy (\_ -> decoder)) 54 | 55 | 56 | callbackDecoder : Json.Decoder (Value -> Value) 57 | callbackDecoder = 58 | Json.field "b" Native.decoder 59 | 60 | 61 | decodeResolution : Json.Decoder (Resolution msg) 62 | decodeResolution = 63 | decodeConstructorAndThen <| 64 | \ctor -> 65 | case ctor of 66 | 0 -> -- Succeed 67 | Json.map Resolved valueDecoder 68 | 1 -> -- Fail 69 | Json.map Rejected valueDecoder 70 | 2 -> -- Native Binding 71 | failWith "Encountered a native task.\nStub any task-generating functions with Task.succeed or Task.fail as necessary." 72 | |> Json.succeed 73 | unknown -> 74 | Json.fail <| "Unknown Resolution constructor: " ++ String.fromInt unknown 75 | 76 | 77 | valueDecoder : Json.Decoder Value 78 | valueDecoder = 79 | Json.field "a" Native.decoder 80 | 81 | 82 | decodeElmerPromise : Json.Decoder (Promise msg) 83 | decodeElmerPromise = 84 | decodeConstructorAndThen <| 85 | \ctor -> 86 | case ctor of 87 | 1001 -> 88 | Json.map2 AndDo 89 | (Json.field "command" Native.decoder) 90 | (Json.field "task" (Json.lazy (\_ -> decoder))) 91 | 1002 -> 92 | Json.map (Complete << Aborted) <| Json.field "command" Native.decoder 93 | 1003 -> 94 | Json.map Defer 95 | (Json.field "task" (Json.lazy (\_ -> decoder))) 96 | unknown -> 97 | "Unknown andDo constructor: " ++ String.fromInt unknown 98 | |> Json.fail 99 | 100 | 101 | decodeConstructorAndThen : (Int -> Json.Decoder a) -> Json.Decoder a 102 | decodeConstructorAndThen generateDecoder = 103 | Native.constructor 104 | |> Json.andThen generateDecoder 105 | 106 | 107 | failWith : String -> Resolution msg 108 | failWith message = 109 | Fail.with message 110 | |> Aborted 111 | -------------------------------------------------------------------------------- /src/Elmer/Effects.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Effects exposing 2 | ( push 3 | , pushWithTask 4 | , expect 5 | , use 6 | ) 7 | 8 | {-| Functions for working with effects during a test. 9 | 10 | Functions that return `Cmd` values to the Elm runtime may have side effects that you 11 | want to track during a test. For instance, the `Elmer.Http` module will keep track of 12 | requests that would be sent when the Elm runtime processes a given command so you can 13 | make expectations about them later. 14 | 15 | Note that these functions are mainly useful when writing extensions to Elmer 16 | or custom matchers. 17 | 18 | # Record Effects 19 | @docs push, pushWithTask 20 | 21 | # Working with Effects 22 | @docs expect, use 23 | 24 | -} 25 | 26 | import Expect 27 | import Elmer.TestState as TestState exposing (TestState) 28 | import Elmer.Context as Context 29 | import Elmer.Runtime.Command as RuntimeCommand 30 | import Elmer.Runtime.Task as RuntimeTask 31 | import Elmer.Errors as Errors 32 | import Task exposing (Task) 33 | 34 | 35 | {-| Create a command that records an effect. 36 | 37 | Provide a custom type as an 'effectId' and then a function that produces the 38 | new value for the stored effects based on what has (or has not) been stored already. 39 | 40 | This function produces a command that should be sent to the Elmer runtime, either in 41 | the normal course of code that's exercised during the test or directly 42 | via `Elmer.Command.send`. 43 | 44 | For example, suppose you have an effect id like: 45 | 46 | type Effects = 47 | Effects 48 | 49 | You could record effects like so: 50 | 51 | testState 52 | |> Command.send (\_ -> 53 | push Effects (\_ -> "Hello!") 54 | ) 55 | 56 | -} 57 | push : effectId -> (Maybe a -> a) -> Cmd msg 58 | push = 59 | RuntimeCommand.mapState 60 | 61 | 62 | {-| Create a task that records an effect when the given task is processed. 63 | -} 64 | pushWithTask : effectId -> (Maybe a -> a) -> Task x b -> Task x b 65 | pushWithTask = 66 | RuntimeTask.mapState 67 | 68 | 69 | {-| Use a recorded effect during a test. 70 | 71 | This function allows you to access the currently recorded effects during a test to produce 72 | further steps in that test. For example, if your test stored a list of effects with the id `Effects` 73 | then you could clear that list like so: 74 | 75 | testState 76 | |> use Effects (\_ state -> 77 | state 78 | |> Command.send (\_ -> 79 | Effects.push Effects (\_ -> []) 80 | ) 81 | ) 82 | 83 | -} 84 | use : effectId -> (Maybe a -> TestState model msg -> TestState model msg) -> TestState model msg -> TestState model msg 85 | use effectId mapper testState = 86 | testState 87 | |> TestState.mapWithoutSpies ( 88 | \context -> 89 | mapper (Context.state effectId context) testState 90 | ) 91 | 92 | 93 | {-| Make an expectation about stored effects. 94 | 95 | testState 96 | |> Command.send (\_ -> 97 | push Effects (\_ -> "Hello!") 98 | ) 99 | |> expect Effects (\maybeEffect -> 100 | Maybe.withDefault "" maybeEffect 101 | |> Expect.equal "Hello!" 102 | ) 103 | 104 | -} 105 | expect : effectId -> (Maybe a -> Expect.Expectation) -> TestState model msg -> Expect.Expectation 106 | expect effectId mapper = 107 | TestState.mapToExpectation <| 108 | \context -> 109 | Context.state effectId context 110 | |> mapper 111 | -------------------------------------------------------------------------------- /src/Elmer/Html/Query.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Query exposing 2 | ( findElement 3 | , findElements 4 | ) 5 | 6 | 7 | import Elmer.Html.Types exposing (..) 8 | import Elmer.Html.Element.Printer as ElementPrinter 9 | import Elmer.Html.Selector.Printer as SelectorPrinter 10 | import Elmer.Html.Element.Internal as Html_ 11 | import Elmer.Errors as Errors 12 | 13 | 14 | findElement : HtmlTarget msg -> Result String (HtmlElement msg) 15 | findElement (HtmlTarget selection) = 16 | selection.element 17 | |> Maybe.andThen (\rootElement -> 18 | find matchAllDescendants selection.selector rootElement 19 | |> List.head 20 | ) 21 | |> Result.fromMaybe (queryErrorMessage selection) 22 | 23 | 24 | findElements : HtmlTarget msg -> List (HtmlElement msg) 25 | findElements (HtmlTarget selection) = 26 | selection.element 27 | |> Maybe.map (find matchAllDescendants selection.selector) 28 | |> Maybe.withDefault [] 29 | 30 | 31 | type alias ElementMatcher msg = 32 | HtmlSelectorGroup msg -> List (HtmlSelector msg) -> HtmlElement msg -> List (HtmlElement msg) 33 | 34 | 35 | find : ElementMatcher msg -> HtmlSelectorGroup msg -> HtmlElement msg -> List (HtmlElement msg) 36 | find matcher selector element = 37 | case selector of 38 | ElementWith selectors -> 39 | if List.isEmpty selectors then 40 | [] 41 | else 42 | matcher selector selectors element 43 | DescendantsOf selectors next -> 44 | findWithin matcher selectors element 45 | |> List.concatMap (find matchAllDescendants next) 46 | ChildrenOf selectors next -> 47 | findWithin matcher selectors element 48 | |> List.concatMap (find matchElementOnly next) 49 | 50 | 51 | findWithin : ElementMatcher msg -> List (HtmlSelector msg) -> HtmlElement msg -> List (HtmlElement msg) 52 | findWithin matcher selectors element = 53 | find matcher (ElementWith selectors) element 54 | |> List.concatMap Html_.childElements 55 | 56 | 57 | matchElementOnly : HtmlSelectorGroup msg -> List (HtmlSelector msg) -> HtmlElement msg -> List (HtmlElement msg) 58 | matchElementOnly _ selectors element = 59 | if matches selectors element then 60 | [ element ] 61 | else 62 | [] 63 | 64 | 65 | matchAllDescendants : HtmlSelectorGroup msg -> List (HtmlSelector msg) -> HtmlElement msg -> List (HtmlElement msg) 66 | matchAllDescendants selector selectors element = 67 | if matches selectors element then 68 | element :: 69 | descendantsThatMatch selector element 70 | else 71 | descendantsThatMatch selector element 72 | 73 | 74 | descendantsThatMatch : HtmlSelectorGroup msg -> HtmlElement msg -> List (HtmlElement msg) 75 | descendantsThatMatch selector element = 76 | Html_.childElements element 77 | |> List.concatMap (find matchAllDescendants selector) 78 | 79 | 80 | matches : List (HtmlSelector msg) -> HtmlElement msg -> Bool 81 | matches selectors element = 82 | List.map .predicate selectors 83 | |> List.foldl (\sel result -> 84 | case result of 85 | True -> 86 | sel element 87 | False -> 88 | False 89 | ) True 90 | 91 | 92 | queryErrorMessage : Selection msg -> String 93 | queryErrorMessage selection = 94 | elementToString selection.element 95 | |> Errors.elementNotFound (SelectorPrinter.printGroup selection.selector) 96 | |> Errors.print 97 | 98 | 99 | elementToString : Maybe (HtmlElement msg) -> String 100 | elementToString maybeElement = 101 | case maybeElement of 102 | Just element -> 103 | ElementPrinter.print element 104 | Nothing -> 105 | "" 106 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestHelpers.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestHelpers exposing (..) 2 | 3 | import Expect exposing (Expectation) 4 | import Elmer.Html.Types exposing (..) 5 | import Dict exposing (Dict) 6 | import Json.Decode as Json 7 | import Html exposing (Html) 8 | import Html.Attributes as Attr 9 | import Html.Events as Events 10 | import Elmer.Html.Node as Node 11 | import Elmer.Html.Element.Printer as HtmlPrinter 12 | import Elmer.Errors as Errors exposing (CustomError) 13 | import Json.Encode as Encode 14 | import Json.Decode as Json 15 | 16 | 17 | expectError : CustomError -> Expectation -> Expectation 18 | expectError expected actual = 19 | Expect.equal (Errors.failWith expected) actual 20 | 21 | 22 | printHtml : Html msg -> String 23 | printHtml html = 24 | case Node.from html of 25 | Element element -> 26 | HtmlPrinter.print element 27 | Text text -> 28 | "" 29 | 30 | 31 | toElement : Html msg -> HtmlElement msg 32 | toElement html = 33 | case 34 | html 35 | |> Node.from 36 | |> Node.asElement 37 | of 38 | Just element -> 39 | element 40 | Nothing -> 41 | Debug.todo "Could not parse html!" 42 | 43 | 44 | emptyNode : String -> HtmlElement msg 45 | emptyNode tagName = 46 | Html.node tagName [] [] 47 | |> toElement 48 | 49 | 50 | nodeWithTexts : List String -> HtmlElement msg 51 | nodeWithTexts texts = 52 | List.map Html.text texts 53 | |> Html.div [] 54 | |> toElement 55 | 56 | 57 | nodeWithAttributes : List (Html.Attribute msg) -> HtmlElement msg 58 | nodeWithAttributes attrs = 59 | Html.div attrs [] 60 | |> toElement 61 | 62 | 63 | nodeWithClass : String -> HtmlElement msg 64 | nodeWithClass className = 65 | nodeWithAttributes 66 | [ Attr.class className 67 | , Attr.class "funClass" 68 | ] 69 | 70 | 71 | nodeWithId : String -> HtmlElement msg 72 | nodeWithId id = 73 | nodeWithAttributes 74 | [ Attr.id id 75 | ] 76 | 77 | 78 | nodeWithClassAndId : String -> String -> HtmlElement msg 79 | nodeWithClassAndId className id = 80 | nodeWithAttributes 81 | [ Attr.id id 82 | , Attr.class className 83 | , Attr.class "funClass" 84 | ] 85 | 86 | 87 | nodeWithText : String -> HtmlElement msg 88 | nodeWithText text = 89 | Html.div [] 90 | [ Html.text text 91 | ] 92 | |> toElement 93 | 94 | 95 | nodeWithList : HtmlElement msg 96 | nodeWithList = 97 | Html.ul [] 98 | [ Html.li [] [] 99 | , Html.li [] [] 100 | , Html.li [] [] 101 | ] 102 | |> toElement 103 | 104 | 105 | nodeWithMultipleChildren : String -> HtmlElement msg 106 | nodeWithMultipleChildren text = 107 | Html.div [] 108 | [ Html.text "fun stuff" 109 | , Html.div [] [] 110 | , Html.text text 111 | ] 112 | |> toElement 113 | 114 | 115 | nodeWithNestedChildren : String -> HtmlElement msg 116 | nodeWithNestedChildren text = 117 | Html.div [] 118 | [ Html.text "fun stuff" 119 | , Html.div [] [] 120 | , Html.text "another sibling" 121 | , Html.div [] 122 | [ Html.text text 123 | ] 124 | ] 125 | |> toElement 126 | 127 | 128 | nodeWithProperty : (String, String) -> HtmlElement msg 129 | nodeWithProperty (name, value) = 130 | Html.div 131 | [ Attr.property name <| Encode.string value 132 | ] [] 133 | |> toElement 134 | 135 | 136 | nodeWithBooleanProperty : (String, Bool) -> HtmlElement msg 137 | nodeWithBooleanProperty (name, value) = 138 | Html.div 139 | [ Attr.property name <| Encode.bool value 140 | ] [] 141 | |> toElement 142 | 143 | 144 | nodeWithEvents : List String -> HtmlElement String 145 | nodeWithEvents events = 146 | Html.div 147 | ( List.map toEventHandler events) 148 | [] 149 | |> toElement 150 | 151 | toEventHandler : String -> Html.Attribute String 152 | toEventHandler event = 153 | Events.on event <| Json.succeed "fakeEvent" 154 | -------------------------------------------------------------------------------- /src/Elmer/Spy/Function.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Spy.Function exposing 2 | ( Function 3 | , Argument 4 | , globalIdentifier 5 | , functionIdentifier 6 | , from 7 | , replace 8 | , withFake 9 | , activateSpy 10 | , deactivateSpy 11 | ) 12 | 13 | import Json.Decode as Json exposing (Value) 14 | import Json.Encode as Encode 15 | import Elm.Kernel.Function 16 | import Elmer.Value.Native as Native 17 | import Elmer.Errors as Errors 18 | 19 | 20 | type alias Function = 21 | { alias: String 22 | , identifier: String 23 | , original: Value 24 | , fake: Value 25 | } 26 | 27 | type alias Argument = 28 | Encode.Value 29 | 30 | globalIdentifier : (() -> a) -> Maybe String 31 | globalIdentifier namingThunk = 32 | Elm.Kernel.Function.globalIdentifier namingThunk 33 | |> Native.decode identifierDecoder 34 | |> Result.withDefault Nothing 35 | 36 | 37 | readableIdentifier : String -> String 38 | readableIdentifier globalId = 39 | String.split "$" globalId 40 | |> List.drop 2 41 | |> String.join "." 42 | 43 | 44 | functionIdentifier : (() -> a) -> Maybe String 45 | functionIdentifier identifier = 46 | globalIdentifier identifier 47 | |> Maybe.map readableIdentifier 48 | 49 | 50 | from : (() -> a) -> Result String Function 51 | from namingThunk = 52 | globalIdentifier namingThunk 53 | |> Result.fromMaybe (Errors.print <| Errors.unableToIdentifySpy) 54 | |> Result.andThen (\globalId -> 55 | let 56 | functionAlias = 57 | readableIdentifier globalId 58 | in 59 | if Elm.Kernel.Function.isActive functionAlias then 60 | Errors.spyAlreadyObserved functionAlias 61 | |> Errors.print 62 | |> Err 63 | else 64 | Ok 65 | { alias = functionAlias 66 | , identifier = globalId 67 | , original = Native.global globalId 68 | , fake = 69 | Native.global globalId 70 | |> recordable functionAlias 71 | } 72 | ) 73 | 74 | 75 | replace : (() -> a) -> b -> Maybe Function 76 | replace namingThunk value = 77 | globalIdentifier namingThunk 78 | |> Maybe.andThen (\globalId -> 79 | if isValue globalId then 80 | Just 81 | { alias = globalId 82 | , identifier = globalId 83 | , original = Native.global globalId 84 | , fake = Native.cast value 85 | } 86 | else 87 | Nothing 88 | ) 89 | 90 | 91 | isValue : String -> Bool 92 | isValue globalId = 93 | Native.global globalId 94 | |> Native.nativeType 95 | |> (/=) "function" 96 | 97 | 98 | recordable : String -> (a -> b) -> Value 99 | recordable = 100 | Elm.Kernel.Function.recordable 101 | 102 | 103 | identifierDecoder : Json.Decoder (Maybe String) 104 | identifierDecoder = 105 | Json.nullable Json.string 106 | 107 | 108 | withFake : (a -> b) -> Function -> Function 109 | withFake fake function = 110 | { function 111 | | fake = 112 | Native.cast fake 113 | |> recordable function.alias 114 | } 115 | 116 | 117 | activateSpy : List (List Argument) -> Function -> Function 118 | activateSpy calls function = 119 | let 120 | callValues = 121 | Encode.list (Encode.list identity) calls 122 | |> Native.unwrap 123 | in 124 | Native.assign function.identifier function.fake 125 | |> Elm.Kernel.Function.activate function.alias callValues 126 | |> always function 127 | 128 | 129 | deactivateSpy : Function -> List (List Argument) 130 | deactivateSpy function = 131 | Native.assign function.identifier function.original 132 | |> always (Elm.Kernel.Function.deactivate function.alias) 133 | |> Native.decode (Json.list <| Json.list argumentDecoder) 134 | |> Result.withDefault [] 135 | 136 | 137 | argumentDecoder : Json.Decoder Argument 138 | argumentDecoder = 139 | Json.value 140 | -------------------------------------------------------------------------------- /tests/src/Elmer/ComponentTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.ComponentTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | 6 | import Elmer exposing (..) 7 | import Elmer.Html.Event as Event 8 | import Elmer.Html.Matchers as Matchers exposing (element, hasText) 9 | import Elmer.Html.Selector as Sel exposing (by) 10 | import Elmer.Spy as Spy 11 | import Elmer.Command as Command 12 | import Elmer.Html as Markup 13 | import Elmer.Navigation as ElmerNav 14 | import Elmer.UrlHelpers as UrlHelpers 15 | import Elmer.Program 16 | import Elmer.TestApps.ComponentTestApp as App exposing (..) 17 | 18 | 19 | all : Test 20 | all = 21 | Test.concat 22 | [ mapCommandTest 23 | ] 24 | 25 | 26 | subTask : Cmd App.MsgB 27 | subTask = 28 | Command.fake (HaveFun "bowling") 29 | 30 | 31 | mapCommandTest = 32 | describe "Map Command" 33 | [ describe "within a single component" 34 | [ test "it handles a map command" <| 35 | \() -> 36 | let 37 | initialState = Elmer.given App.defaultModel App.view App.simpleUpdate 38 | mapCommand = \() -> Cmd.map DoFun subTask 39 | in 40 | Command.send mapCommand initialState 41 | |> Markup.target << by [ Sel.id "root" ] 42 | |> Markup.expect (element <| hasText "Fun: bowling") 43 | , test "it handles a click event" <| 44 | \() -> 45 | let 46 | initialState = Elmer.given App.defaultModel App.view App.simpleUpdate 47 | mapCommand = \() -> Cmd.map DoFun subTask 48 | in 49 | Command.send mapCommand initialState 50 | |> Markup.target << by [ Sel.id "click-display" ] 51 | |> Event.click 52 | |> Markup.target << by [ Sel.id "root" ] 53 | |> Markup.expect (element <| hasText "Fun: click") 54 | ] 55 | , describe "when a child component is used by the parent" 56 | [ test "it handles a mapped map command" <| 57 | \() -> 58 | let 59 | initialState = 60 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.parentDocument App.parentUpdate 61 | |> Elmer.Program.init (\_ -> App.init () (UrlHelpers.asUrl "http://localhost/fun.html") ElmerNav.fakeKey) 62 | mapCommand = Cmd.map DoFun subTask 63 | parentMapCommand = \() -> Cmd.map MsgAWrapper mapCommand 64 | in 65 | Command.send parentMapCommand initialState 66 | |> Markup.target << by [ Sel.id "child-view" ] 67 | |> Markup.expect (element <| hasText "Fun: bowling") 68 | , test "it handles a mapped message from the child view" <| 69 | \() -> 70 | let 71 | initialState = 72 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.parentDocument App.parentUpdate 73 | |> Elmer.Program.init (\_ -> App.init () (UrlHelpers.asUrl "http://localhost/fun.html") ElmerNav.fakeKey) 74 | mapCommand = Cmd.map DoFun subTask 75 | parentMapCommand = \() -> Cmd.map MsgAWrapper mapCommand 76 | in 77 | Command.send parentMapCommand initialState 78 | |> Markup.target << by [ Sel.id "click-display" ] 79 | |> Event.click 80 | |> Markup.target << by [ Sel.id "child-view" ] 81 | |> Markup.expect (element <| hasText "Fun: click") 82 | , describe "when the mapped command has a custom update method" 83 | [ test "it handles a mapped message from the child view" <| 84 | \() -> 85 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.parentDocument App.parentUpdate 86 | |> Spy.use [ ElmerNav.spy ] 87 | |> Elmer.Program.init (\_ -> App.init () (UrlHelpers.asUrl "http://localhost/fun.html") ElmerNav.fakeKey) 88 | |> Markup.target << by [ Sel.id "change-location" ] 89 | |> Event.click 90 | |> Markup.target << by [ Sel.id "fun-stuff" ] 91 | |> Markup.expect (element <| hasText "Fun things!") 92 | ] 93 | ] 94 | ] 95 | -------------------------------------------------------------------------------- /src/Elmer/TestState.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestState exposing 2 | ( TestState 3 | , TestStateExtension(..) 4 | , map 5 | , mapWithoutSpies 6 | , mapToExpectation 7 | , with 8 | , failure 9 | , fromRuntimeResult 10 | ) 11 | 12 | {-| Exposed for testing 13 | 14 | @docs TestState, TestStateExtension, map, mapWithoutSpies, mapToExpectation, with, failure, fromRuntimeResult 15 | 16 | -} 17 | 18 | import Elmer.Context as Context exposing (..) 19 | import Elmer.Spy.Internal as Spy_ exposing (Spy) 20 | import Elmer.Runtime.Types exposing (RuntimeResult) 21 | import Expect 22 | 23 | {-| 24 | -} 25 | type TestState model msg 26 | = Ready (Context model msg) 27 | | Failed String 28 | 29 | {-| 30 | -} 31 | type TestStateExtension 32 | = MapBeforeExpectationExtension 33 | 34 | 35 | {-| 36 | -} 37 | with : Context model msg -> TestState model msg 38 | with context = 39 | Ready context 40 | 41 | 42 | {-| 43 | -} 44 | failure : String -> TestState model msg 45 | failure message = 46 | Failed message 47 | 48 | 49 | {-| 50 | -} 51 | fromRuntimeResult : RuntimeResult model msg -> TestState model msg 52 | fromRuntimeResult result = 53 | case result of 54 | Ok context -> 55 | with context 56 | Err message -> 57 | failure message 58 | 59 | 60 | abstractMap : (String -> a) -> (Context model msg -> a) -> TestState model msg -> a 61 | abstractMap failureMapper mapper testState = 62 | case testState of 63 | Ready context -> 64 | mapper context 65 | Failed message -> 66 | failureMapper message 67 | 68 | 69 | {-| 70 | -} 71 | map : (Context model msg -> TestState model msg) -> TestState model msg -> TestState model msg 72 | map mapper = 73 | abstractMap Failed <| 74 | spyMapExtension mapper 75 | 76 | 77 | spyMapExtension : (Context model msg -> TestState model msg) -> Context model msg -> TestState model msg 78 | spyMapExtension mapper context = 79 | let 80 | contextWithSpies = Spy_.withSpies (Spy_.activate <| Spy_.spiesFrom context) context 81 | in 82 | mapper contextWithSpies 83 | |> testStateWithDeactivatedSpies contextWithSpies 84 | 85 | 86 | testStateWithDeactivatedSpies : Context model msg -> TestState model msg -> TestState model msg 87 | testStateWithDeactivatedSpies contextWithSpies = 88 | abstractMap 89 | (\message -> 90 | Failed message 91 | |> deactivateSpies contextWithSpies 92 | ) 93 | (\context -> 94 | context 95 | |> Spy_.withSpies (Spy_.deactivate <| Spy_.spiesFrom context) 96 | |> with 97 | ) 98 | 99 | 100 | {-| 101 | -} 102 | mapWithoutSpies : (Context model msg -> TestState model msg) -> TestState model msg -> TestState model msg 103 | mapWithoutSpies mapper = 104 | abstractMap Failed <| 105 | \context -> 106 | mapper context 107 | 108 | 109 | {-| 110 | -} 111 | mapToExpectation : (Context model msg -> Expect.Expectation) -> TestState model msg -> Expect.Expectation 112 | mapToExpectation mapper testState = 113 | mapBeforeExpectation testState 114 | |> abstractMap Expect.fail (spyExpectationExtension <| mapper) 115 | 116 | 117 | mapBeforeExpectation : TestState model msg -> TestState model msg 118 | mapBeforeExpectation = 119 | map <| 120 | \context -> 121 | Context.state MapBeforeExpectationExtension context 122 | |> Maybe.withDefault [] 123 | |> List.foldr mapWithoutSpies (with context) 124 | 125 | 126 | spyExpectationExtension : (Context model msg -> Expect.Expectation) -> Context model msg -> Expect.Expectation 127 | spyExpectationExtension mapper context = 128 | let 129 | contextWithSpies = 130 | Spy_.withSpies (Spy_.activate <| Spy_.spiesFrom context) context 131 | in 132 | mapper contextWithSpies 133 | |> deactivateSpies contextWithSpies 134 | 135 | 136 | deactivateSpies : Context model msg -> a -> a 137 | deactivateSpies context subject = 138 | let 139 | uninstalled = Spy_.deactivate <| Spy_.spiesFrom context 140 | in 141 | subject 142 | -------------------------------------------------------------------------------- /tests/src/Elmer/HtmlKeyedTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.HtmlKeyedTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer.TestState as TestState exposing (TestState) 6 | import Elmer.Html as Markup 7 | import Elmer.Html.Event as Event 8 | import Elmer exposing (expectAll, hasLength, exactly) 9 | import Elmer.Html.Matchers as Matchers exposing (..) 10 | import Elmer.Html.Selector as Sel exposing (..) 11 | import Elmer.Html.Types exposing (..) 12 | import Html.Attributes as Attr 13 | import Html exposing (Html) 14 | import Elmer.TestApps.HtmlKeyedTestApp as App 15 | 16 | 17 | all : Test 18 | all = 19 | Test.concat 20 | [ keyedTests 21 | ] 22 | 23 | 24 | keyedTests : Test 25 | keyedTests = 26 | describe "keyed nodes" 27 | [ test "it renders the keyed nodes" <| 28 | \() -> 29 | Elmer.given App.defaultModel App.view App.update 30 | |> Markup.target << descendantsOf [ id "fruit-list" ] << by [ tag "li" ] 31 | |> Markup.expect (elements <| expectAll 32 | [ hasLength 3 33 | , exactly 1 <| hasText "apple" 34 | , exactly 1 <| hasText "pear" 35 | , exactly 1 <| hasText "orange" 36 | ] 37 | ) 38 | , test "it handles inherited events" <| 39 | \() -> 40 | Elmer.given App.defaultModel App.view App.update 41 | |> Markup.target << descendantsOf [ id "fruit-list" ] << by [ tag "li" ] 42 | |> Event.click 43 | |> Markup.expect (elements <| expectAll 44 | [ hasLength 3 45 | , exactly 1 <| hasText "apple" 46 | , exactly 1 <| hasText "pear" 47 | , exactly 1 <| hasText "pineapple" 48 | ] 49 | ) 50 | , test "it maps events for keyed nodes" <| 51 | \() -> 52 | Elmer.given defaultWrappedModel wrappedView wrappedUpdate 53 | |> Markup.target << by [ id "special-node" ] 54 | |> Event.click 55 | |> Markup.target << descendantsOf [ id "fruit-list" ] << by [ tag "li" ] 56 | |> Markup.expect (elements <| expectAll 57 | [ hasLength 3 58 | , exactly 1 <| hasText "apple" 59 | , exactly 1 <| hasText "pear" 60 | , exactly 1 <| hasText "popcorn" 61 | ] 62 | ) 63 | , test "it handles lazy keyed nodes" <| 64 | \() -> 65 | Elmer.given App.defaultModel App.viewLazyNode App.update 66 | |> Markup.target << descendantsOf [ id "fruit-list" ] << by [ tag "li" ] 67 | |> Markup.expect (elements <| expectAll 68 | [ hasLength 3 69 | , exactly 1 <| hasText "apple" 70 | , exactly 1 <| hasText "chocolate" 71 | , exactly 1 <| hasText "orange" 72 | ] 73 | ) 74 | , test "it lazily handles keyed nodes" <| 75 | \() -> 76 | Elmer.given App.defaultModel App.lazyKeyedView App.update 77 | |> Markup.target << descendantsOf [ id "fruit-list" ] << by [ tag "li" ] 78 | |> Markup.expect (elements <| expectAll 79 | [ hasLength 3 80 | , exactly 1 <| hasText "apple" 81 | , exactly 1 <| hasText "grapes" 82 | , exactly 1 <| hasText "orange" 83 | ] 84 | ) 85 | ] 86 | 87 | 88 | -- Test app for Html.Map and Cmd.map 89 | 90 | type TestMsg 91 | = AppMsg App.Msg 92 | 93 | type alias TestModel = 94 | { appModel : App.Model 95 | } 96 | 97 | defaultWrappedModel : TestModel 98 | defaultWrappedModel = 99 | { appModel = App.defaultModel 100 | } 101 | 102 | wrappedView : TestModel -> Html TestMsg 103 | wrappedView model = 104 | Html.div [ Attr.id "app-view" ] 105 | [ Html.map AppMsg <| App.view2 model.appModel ] 106 | 107 | wrappedUpdate : TestMsg -> TestModel -> ( TestModel, Cmd TestMsg ) 108 | wrappedUpdate msg model = 109 | case msg of 110 | AppMsg appMsg -> 111 | let 112 | ( updatedModel, updatedCommand ) = App.update appMsg model.appModel 113 | in 114 | ( { model | appModel = updatedModel } 115 | , Cmd.map AppMsg updatedCommand 116 | ) 117 | -------------------------------------------------------------------------------- /tests/src/Elmer/ApplicationTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.ApplicationTests exposing (all) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer 6 | import Elmer.TestState as TestState exposing (..) 7 | import Elmer.Html as Markup 8 | import Elmer.Html.Matchers exposing (element, hasText) 9 | import Elmer.Html.Event as Event 10 | import Elmer.Html.Selector as Selector exposing (by) 11 | import Elmer.Program 12 | import Elmer.Program.Matchers exposing (expectTitle) 13 | import Elmer.TestApps.ApplicationTestApp as App 14 | import Elmer.Navigation as Navigation 15 | import Elmer.Subscription as Subscription 16 | import Elmer.Command as Command 17 | import Elmer.Spy as Spy exposing (andCallFake) 18 | import Elmer.Errors as Errors 19 | import Elmer.UrlHelpers as UrlHelpers 20 | import Elmer.TestHelpers exposing (expectError) 21 | import Url exposing (Url) 22 | 23 | 24 | all : Test 25 | all = 26 | Test.concat 27 | [ applicationTests 28 | , noInitTests 29 | ] 30 | 31 | 32 | applicationTests : Test 33 | applicationTests = 34 | describe "given an application" 35 | [ describe "when init is called" 36 | [ test "it creates a TestState" <| 37 | \() -> 38 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.view App.update 39 | |> Elmer.Program.init (\() -> App.init () (UrlHelpers.asUrl "http://localhost/app/fun") Navigation.fakeKey) 40 | |> Markup.target << by [ Selector.id "some-element" ] 41 | |> Markup.expect (element <| hasText "Fun Stuff") 42 | , test "it can handle title expectations" <| 43 | \() -> 44 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.view App.update 45 | |> Elmer.Program.init (\() -> App.init () (UrlHelpers.asUrl "http://localhost/app/fun") Navigation.fakeKey) 46 | |> expectTitle "Fun Title" 47 | ] 48 | ] 49 | 50 | 51 | noInitTests : Test 52 | noInitTests = 53 | describe "when init is not called" 54 | [ describe "when expecting an element" 55 | [ test "it shows an error" <| 56 | \() -> 57 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.view App.update 58 | |> Markup.target << by [ Selector.id "some-element" ] 59 | |> Markup.expect (element <| hasText "Fun Stuff") 60 | |> expectError Errors.noModel 61 | ] 62 | , describe "when simulating an event" 63 | [ test "it shows an error" <| 64 | \() -> 65 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.view App.update 66 | |> Markup.target << by [ Selector.id "some-element" ] 67 | |> Event.click 68 | |> Markup.expect (element <| hasText "Fun Stuff") 69 | |> expectError Errors.noModel 70 | ] 71 | , describe "when making an expectation about the model" 72 | [ test "it shows an error" <| 73 | \() -> 74 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.view App.update 75 | |> Elmer.expectModel (\model -> Expect.fail "Should not get here") 76 | |> expectError Errors.noModel 77 | ] 78 | , describe "when registering subscriptions" 79 | [ test "it shows an error" <| 80 | \() -> 81 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.view App.update 82 | |> Subscription.with (\_ -> App.subscriptions) 83 | |> Elmer.expectModel (\model -> Expect.fail "Should not get here") 84 | |> expectError Errors.noModel 85 | ] 86 | , describe "when processing a stubbed command" 87 | [ test "it shows an error" <| 88 | \() -> 89 | let 90 | funStub = 91 | Spy.observe (\_ -> App.funCommand) 92 | |> andCallFake (\tagger message -> Command.fake <| tagger <| "FAKE: " ++ message) 93 | in 94 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.view App.update 95 | |> Spy.use [ funStub ] 96 | |> Command.send (\_ -> App.funCommand App.FunTaskResult "hey!") 97 | |> Elmer.expectModel (\model -> Expect.fail "Should not get here") 98 | |> expectError Errors.noModel 99 | ] 100 | ] 101 | -------------------------------------------------------------------------------- /tests/src/Elmer/HtmlTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.HtmlTests exposing (all) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | import Elmer.TestState as TestState exposing (TestState) 6 | import Elmer.Html as Markup 7 | import Elmer 8 | import Elmer.Html.Matchers as Matchers exposing (..) 9 | import Elmer.Html.Selector as Sel exposing (..) 10 | import Elmer.TestHelpers exposing (..) 11 | import Elmer.TestApps.SimpleTestApp as SimpleApp 12 | import Elmer.TestApps.SpyTestApp as SpyApp 13 | import Elmer.Spy as Spy 14 | import Elmer.Spy.Matchers exposing (wasCalled, wasCalledWith, typedArg) 15 | import Html.Attributes as Attr 16 | import Html exposing (Html) 17 | 18 | 19 | all : Test 20 | all = 21 | Test.concat 22 | [ targetTests 23 | , expectTests 24 | , childNodeTests 25 | , renderTests 26 | ] 27 | 28 | 29 | targetTests = 30 | describe "target" 31 | [ describe "when there is an upstream failure" 32 | [ test "it returns the failure" <| 33 | \() -> 34 | TestState.failure "upstream failure" 35 | |> Markup.target << by [ class "button" ] 36 | |> Expect.equal (TestState.failure "upstream failure") 37 | ] 38 | ] 39 | 40 | expectTests = 41 | describe "expect" 42 | [ describe "when there is an upstream failure" 43 | [ test "it fails with the error message" <| 44 | \() -> 45 | let 46 | initialState = TestState.failure "upstream failure" 47 | in 48 | initialState 49 | |> Markup.expect (\context -> Expect.fail "Should not get here") 50 | |> Expect.equal (Expect.fail "upstream failure") 51 | , describe "when the matcher uses expectNot" 52 | [ test "it fails with the right message" <| 53 | \() -> 54 | let 55 | initialState = TestState.failure "upstream failure" 56 | in 57 | initialState 58 | |> Markup.target << by [ Sel.id "no-element" ] 59 | |> Markup.expect (Elmer.expectNot elementExists) 60 | |> Expect.equal (Expect.fail "upstream failure") 61 | ] 62 | ] 63 | , describe "when there is no targeted element" 64 | [ test "it fails" <| 65 | \() -> 66 | Elmer.given SimpleApp.defaultModel SimpleApp.view SimpleApp.update 67 | |> Markup.expect (\context -> Expect.fail "Should not get here") 68 | |> Expect.equal (Expect.fail "No expectations could be made because no Html has been targeted.\n\nUse Elmer.Html.target to identify the Html you want to describe.") 69 | ] 70 | , describe "when there is a targeted element" 71 | [ test "it defines the HtmlContext based on the selector and the rendered view" <| 72 | \() -> 73 | Elmer.given SimpleApp.defaultModel SimpleApp.view SimpleApp.update 74 | |> Markup.target << by [ Sel.id "root" ] 75 | |> Markup.expect (element <| hasId "root") 76 | ] 77 | ] 78 | 79 | childNodeTests = 80 | describe "nodes with children" 81 | [ describe "when there is a child node with text" 82 | [ test "it finds the text" <| 83 | \() -> 84 | let 85 | initialState = Elmer.given SimpleApp.defaultModel SimpleApp.viewWithChildren SimpleApp.update 86 | in 87 | initialState 88 | |> Markup.target << by [ Sel.id "root" ] 89 | |> Markup.expect (element <| hasText "Child text") 90 | |> Expect.equal Expect.pass 91 | ] 92 | ] 93 | 94 | renderTests = 95 | describe "render" 96 | [ describe "when there is an upstream failure" 97 | [ test "it passes on the failure" <| 98 | \() -> 99 | let 100 | initialState = TestState.failure "You failed!" 101 | in 102 | initialState 103 | |> Markup.render 104 | |> Expect.equal initialState 105 | ] 106 | , describe "when there is no upstream failure" 107 | [ test "it renders the view" <| 108 | \() -> 109 | let 110 | spy = 111 | Spy.observe (\_ -> SimpleApp.view) 112 | |> Spy.andCallThrough 113 | in 114 | Elmer.given SimpleApp.defaultModel (\model -> SimpleApp.view model) SimpleApp.update 115 | |> Spy.use [ spy ] 116 | |> Markup.render 117 | |> Spy.expect (\_ -> SimpleApp.view) ( 118 | wasCalledWith [ typedArg SimpleApp.defaultModel ] 119 | ) 120 | ] 121 | ] 122 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/ComponentTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.ComponentTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events exposing (onClick) 6 | import Browser.Navigation as Navigation 7 | import Browser exposing (Document, UrlRequest(..)) 8 | import Url exposing (Url) 9 | 10 | type MsgA 11 | = DoFun MsgB 12 | | DoStuff String 13 | | DoClick 14 | | DoChangeLocation String 15 | 16 | type MsgB 17 | = HaveFun String 18 | | HaveError String 19 | 20 | type MsgC 21 | = MsgAWrapper MsgA 22 | | Error String 23 | | OnUrlRequest UrlRequest 24 | | OnUrlChange Url 25 | 26 | type alias Model = 27 | { fun: String 28 | } 29 | 30 | defaultModel : Model 31 | defaultModel = 32 | { fun = "Reading" 33 | } 34 | 35 | update : Navigation.Key -> MsgA -> Model -> (Model, Cmd MsgA) 36 | update navigationKey message model = 37 | case message of 38 | DoFun bMessage -> 39 | case bMessage of 40 | HaveFun text -> 41 | ( { model | fun = text }, Cmd.none ) 42 | HaveError error -> 43 | ( model, Cmd.none ) 44 | DoStuff stuff -> 45 | ( model, Cmd.none ) 46 | DoClick -> 47 | ( { model | fun = "click" }, Cmd.none ) 48 | DoChangeLocation location -> 49 | ( model, Navigation.pushUrl navigationKey location ) 50 | 51 | simpleUpdate : MsgA -> Model -> (Model, Cmd MsgA) 52 | simpleUpdate msg model = 53 | case msg of 54 | DoFun bMessage -> 55 | case bMessage of 56 | HaveFun text -> 57 | ( { model | fun = text }, Cmd.none ) 58 | HaveError error -> 59 | ( model, Cmd.none ) 60 | DoStuff stuff -> 61 | ( model, Cmd.none ) 62 | DoClick -> 63 | ( { model | fun = "click" }, Cmd.none ) 64 | DoChangeLocation _ -> 65 | ( model, Cmd.none ) 66 | 67 | 68 | view : Model -> Html MsgA 69 | view model = 70 | Html.div [ Attr.id "root" ] 71 | [ Html.p [] 72 | [ Html.text "Here's something fun ..." 73 | ] 74 | , Html.div [ Attr.id "click-display", onClick DoClick ] 75 | [ Html.text ("Fun: " ++ model.fun) 76 | ] 77 | , Html.div [ Attr.id "change-location", onClick (DoChangeLocation "http://fun.com/fun.html") ] 78 | [ Html.text "Click for fun" 79 | ] 80 | ] 81 | 82 | type Route 83 | = NotFound String 84 | | DefaultRoute 85 | | FunRoute 86 | 87 | type alias ParentModel = 88 | { childModel: Model 89 | , route: Route 90 | , navigationKey: Navigation.Key 91 | } 92 | 93 | parentUpdate : MsgC -> ParentModel -> (ParentModel, Cmd MsgC) 94 | parentUpdate message model = 95 | case message of 96 | MsgAWrapper msgA -> 97 | let 98 | (updatedChildModel, childCommand) = update model.navigationKey msgA model.childModel 99 | in 100 | ( { model | childModel = updatedChildModel }, Cmd.map MsgAWrapper childCommand ) 101 | Error _ -> 102 | ( model, Cmd.none ) 103 | OnUrlRequest urlRequest -> 104 | case urlRequest of 105 | Internal url -> 106 | ( model, Navigation.pushUrl model.navigationKey (Url.toString url) ) 107 | External _ -> 108 | ( model, Cmd.none ) 109 | OnUrlChange url -> 110 | if url.host == "fun.com" && url.path == "/fun.html" then 111 | ( { model | route = FunRoute }, Cmd.none ) 112 | else 113 | ( { model | route = NotFound <| "Unknown url: " ++ Url.toString url }, Cmd.none ) 114 | 115 | 116 | parentDocument : ParentModel -> Document MsgC 117 | parentDocument model = 118 | { title = "Component Test App" 119 | , body = [ parentView model ] 120 | } 121 | 122 | 123 | parentView : ParentModel -> Html MsgC 124 | parentView model = 125 | case model.route of 126 | DefaultRoute -> 127 | Html.div [ Attr.id "parent-root"] 128 | [ Html.p [] [ Html.text "Parent view"] 129 | , Html.div [ Attr.id "child-view" ] 130 | [ Html.map MsgAWrapper (view model.childModel) ] 131 | ] 132 | FunRoute -> 133 | Html.div [ Attr.id "fun-stuff" ] 134 | [ Html.p [] [ Html.text "Fun things!" ] ] 135 | NotFound message -> 136 | Html.div [ Attr.id "not-found-error" ] 137 | [ Html.p [] [ Html.text ("Page not found" ++ message) ] ] 138 | 139 | 140 | init : () -> Url -> Navigation.Key -> (ParentModel, Cmd MsgC) 141 | init _ url key = 142 | ( { childModel = defaultModel 143 | , route = DefaultRoute 144 | , navigationKey = key 145 | } 146 | , Cmd.none 147 | ) 148 | -------------------------------------------------------------------------------- /tests/src/Main.elm: -------------------------------------------------------------------------------- 1 | port module Main exposing (..) 2 | 3 | import Platform 4 | import Test exposing (..) 5 | import Expect exposing (Expectation) 6 | import Test.Runner exposing (Runner, SeededRunners(..)) 7 | import Test.Runner.Failure as Failure exposing (Reason) 8 | import Random 9 | import Task 10 | 11 | import Tests 12 | 13 | port sendTestResult : TestResult -> Cmd msg 14 | port sendTestEvent : String -> Cmd msg 15 | port runNextTest : (() -> msg) -> Sub msg 16 | 17 | type alias Flags = 18 | {} 19 | 20 | type alias Model = 21 | { runners: List Runner 22 | } 23 | 24 | type Msg 25 | = RunNext () 26 | | RunTest Runner 27 | 28 | type alias TestResult = 29 | { descriptions: List String 30 | , messages: List String 31 | } 32 | 33 | 34 | init : () -> ( Model, Cmd Msg ) 35 | init _ = 36 | let 37 | seeded = 38 | Test.Runner.fromTest 100 (Random.initialSeed 1999) Tests.all 39 | in 40 | ( { runners = runnersFrom seeded }, Cmd.none ) 41 | 42 | 43 | runnersFrom : SeededRunners -> List Runner 44 | runnersFrom seeded = 45 | case seeded of 46 | Plain runners -> 47 | runners 48 | Only runners -> 49 | runners 50 | _ -> 51 | [] 52 | 53 | 54 | update : Msg -> Model -> ( Model, Cmd Msg ) 55 | update msg model = 56 | case msg of 57 | RunNext _ -> 58 | case model.runners of 59 | [] -> 60 | ( model, sendTestEvent "DONE" ) 61 | runner :: remaining -> 62 | ( { model | runners = remaining } 63 | , Task.perform RunTest (Task.succeed runner) 64 | ) 65 | 66 | RunTest runner -> 67 | ( model 68 | , sendTestResult <| runTest runner 69 | ) 70 | 71 | 72 | runTest : Runner -> TestResult 73 | runTest runner = 74 | { descriptions = runner.labels 75 | , messages = 76 | runner.run () 77 | |> List.filterMap errorMessage 78 | } 79 | 80 | 81 | errorMessage : Expectation -> Maybe String 82 | errorMessage expectation = 83 | case Test.Runner.getFailureReason expectation of 84 | Just failure -> 85 | Just <| formatFailure failure 86 | Nothing -> 87 | Nothing 88 | 89 | 90 | subscriptions : Model -> Sub Msg 91 | subscriptions model = 92 | runNextTest RunNext 93 | 94 | 95 | main : Program () Model Msg 96 | main = 97 | Platform.worker 98 | { init = init 99 | , update = update 100 | , subscriptions = subscriptions 101 | } 102 | 103 | 104 | 105 | 106 | ---- 107 | 108 | type alias Failure = 109 | { given : Maybe String 110 | , description : String 111 | , reason : Reason 112 | } 113 | 114 | formatFailure : Failure -> String 115 | formatFailure failure = 116 | case failure.reason of 117 | Failure.Custom -> 118 | failure.description 119 | Failure.Equality one two -> 120 | case failure.description of 121 | "Expect.equal" -> 122 | one ++ " is not equal to " ++ two 123 | "Expect.notEqual" -> 124 | one ++ " is equal to " ++ two 125 | otherEquality -> 126 | otherEquality ++ " failed between " ++ two ++ " and " ++ one 127 | Failure.Comparison one two -> 128 | case failure.description of 129 | "Expect.lessThan" -> 130 | two ++ " is not less than " ++ one 131 | "Expect.atMost" -> 132 | two ++ " is not at most " ++ one 133 | "Expect.greaterThan" -> 134 | two ++ " is not greater than " ++ one 135 | "Expect.atLeast" -> 136 | two ++ " is not at least " ++ one 137 | "Expect.err" -> 138 | two ++ " is not an Err" 139 | otherComparison -> 140 | otherComparison ++ " failed between " ++ two ++ " and " ++ one 141 | Failure.ListDiff one two -> 142 | formatList two 143 | ++ "\n\nis not equal to\n\n" 144 | ++ formatList one 145 | Failure.CollectionDiff data -> 146 | "Expected\n\n" 147 | ++ data.expected 148 | ++ "\n\nbut the actual value is\n\n" 149 | ++ data.actual 150 | _ -> 151 | "Failure " ++ failureToString failure 152 | 153 | failureToString : Failure -> String 154 | failureToString reason = 155 | reason.description 156 | 157 | formatList : List String -> String 158 | formatList list = 159 | "[ " ++ (String.join ", " list) ++ " ]" 160 | -------------------------------------------------------------------------------- /tests/src/Elmer/FailureTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.FailureTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Test.Runner 5 | import Test.Runner.Failure as ElmTestFailure 6 | import Expect 7 | import Elmer.Message.Failure as Failure 8 | import Dict 9 | import Set 10 | 11 | 12 | all : Test 13 | all = 14 | Test.concat 15 | [ formatFailureTests 16 | ] 17 | 18 | 19 | takeFailureMessage : Expect.Expectation -> String 20 | takeFailureMessage expectation = 21 | Test.Runner.getFailureReason expectation 22 | |> Maybe.withDefault 23 | { given = Nothing 24 | , description = "default" 25 | , reason = ElmTestFailure.Custom 26 | } 27 | |> List.singleton 28 | |> Failure.format 29 | 30 | formatFailureTests : Test 31 | formatFailureTests = 32 | describe "format failure" 33 | [ describe "custom" 34 | [ test "it prints the custom failure" <| 35 | \() -> 36 | Expect.fail "my-failure-description" 37 | |> takeFailureMessage 38 | |> Expect.equal "my-failure-description" 39 | , test "it prints the true failure" <| 40 | \() -> 41 | Expect.true "Expect to be true" False 42 | |> takeFailureMessage 43 | |> Expect.equal "Expect to be true" 44 | , test "it prints the false failure" <| 45 | \() -> 46 | Expect.false "Expect to be false" True 47 | |> takeFailureMessage 48 | |> Expect.equal "Expect to be false" 49 | ] 50 | , describe "equality" 51 | [ test "it prints the equality failure" <| 52 | \() -> 53 | Expect.equal 19 20 54 | |> takeFailureMessage 55 | |> Expect.equal "19 is not equal to 20" 56 | , test "it prints the inequality failure" <| 57 | \() -> 58 | Expect.notEqual 20 20 59 | |> takeFailureMessage 60 | |> Expect.equal "20 is equal to 20" 61 | ] 62 | , describe "comparison" 63 | [ test "it prints the less than failure" <| 64 | \() -> 65 | Expect.lessThan 19 20 66 | |> takeFailureMessage 67 | |> Expect.equal "20 is not less than 19" 68 | , test "it prints the at most failure" <| 69 | \() -> 70 | Expect.atMost 19 20 71 | |> takeFailureMessage 72 | |> Expect.equal "20 is not at most 19" 73 | , test "it prints the greater than failure" <| 74 | \() -> 75 | Expect.greaterThan 20 19 76 | |> takeFailureMessage 77 | |> Expect.equal "19 is not greater than 20" 78 | , test "it prints the at least failure" <| 79 | \() -> 80 | Expect.atLeast 20 19 81 | |> takeFailureMessage 82 | |> Expect.equal "19 is not at least 20" 83 | , test "it prints the err failure" <| 84 | \() -> 85 | Expect.err (Ok "Blah") 86 | |> takeFailureMessage 87 | |> Expect.equal "Ok \"Blah\" is not an Err" 88 | , test "it prints the unknown comparison failure" <| 89 | \() -> 90 | [ { given = Nothing 91 | , description = "some weird comparison" 92 | , reason = ElmTestFailure.Comparison "87" "bbb" 93 | } 94 | ] 95 | |> Failure.format 96 | |> Expect.equal "some weird comparison failed between bbb and 87" 97 | ] 98 | , describe "list diff" 99 | [ test "it prints the list diff failure" <| 100 | \() -> 101 | Expect.equalLists [ 1, 2 ] [ 3, 4 ] 102 | |> takeFailureMessage 103 | |> Expect.equal "[ 3, 4 ]\n\nis not equal to\n\n[ 1, 2 ]" 104 | ] 105 | , describe "collection diff" 106 | [ test "it prints the equal dicts failure" <| 107 | \() -> 108 | Expect.equalDicts (Dict.fromList [ (1, "one") ]) (Dict.fromList [ (2, "two") ]) 109 | |> takeFailureMessage 110 | |> Expect.equal "Expected\n\nDict.fromList [(1,\"one\")]\n\nbut the actual value is\n\nDict.fromList [(2,\"two\")]" 111 | , test "it prints the equal sets failure" <| 112 | \() -> 113 | Expect.equalSets (Set.fromList [ 1 ]) (Set.fromList [ 2 ]) 114 | |> takeFailureMessage 115 | |> Expect.equal "Expected\n\nSet.fromList [1]\n\nbut the actual value is\n\nSet.fromList [2]" 116 | ] 117 | , describe "failures we don't care about" 118 | [ test "it prints the full failure reason" <| 119 | \() -> 120 | [ { given = Nothing 121 | , description = "Something" 122 | , reason = ElmTestFailure.TODO 123 | } 124 | ] 125 | |> Failure.format 126 | |> Expect.equal "Failure { description = \"Something\", given = Nothing, reason = TODO }" 127 | ] 128 | ] 129 | -------------------------------------------------------------------------------- /tests/src/Elmer/TestApps/MouseTestApp.elm: -------------------------------------------------------------------------------- 1 | module Elmer.TestApps.MouseTestApp exposing (..) 2 | 3 | import Html exposing (Html) 4 | import Html.Attributes as Attr 5 | import Html.Events as Events exposing 6 | ( onClick 7 | , onDoubleClick 8 | , onMouseDown 9 | , onMouseUp 10 | , onMouseEnter 11 | , onMouseLeave 12 | , onMouseOver 13 | , onMouseOut 14 | ) 15 | import Json.Decode as Json 16 | 17 | type alias Model = 18 | { clicks : Int 19 | , doubleClicks : Int 20 | , mouseDowns : Int 21 | , mouseUps : Int 22 | , mouseEnters : Int 23 | , mouseLeaves : Int 24 | , mouseOvers : Int 25 | , mouseOuts : Int 26 | , position : Maybe MousePosition 27 | } 28 | 29 | type Msg 30 | = DoClick 31 | | DoDoubleClick 32 | | DoMouseDown 33 | | DoMouseUp 34 | | DoMouseEnter 35 | | DoMouseLeave 36 | | DoMouseOver 37 | | DoMouseOut 38 | | RecordPosition MousePosition 39 | 40 | type alias MousePosition = 41 | { x: Int 42 | , y: Int 43 | } 44 | 45 | defaultModel : Model 46 | defaultModel = 47 | { clicks = 0 48 | , doubleClicks = 0 49 | , mouseDowns = 0 50 | , mouseUps = 0 51 | , mouseEnters = 0 52 | , mouseLeaves = 0 53 | , mouseOvers = 0 54 | , mouseOuts = 0 55 | , position = Nothing 56 | } 57 | 58 | view : Model -> Html Msg 59 | view model = 60 | Html.div [Attr.id "root", Attr.class "no-events"] 61 | [ Html.div 62 | [ Attr.class "button" 63 | , onClick DoClick 64 | , onDoubleClick DoDoubleClick 65 | , onMouseDown DoMouseDown 66 | , onMouseUp DoMouseUp 67 | , onMouseOver DoMouseOver 68 | , onMouseOut DoMouseOut 69 | ] [ Html.text "Click me!" ] 70 | , Html.div [ Attr.id "click-counter" ] [ Html.text ((String.fromInt model.clicks) ++ " clicks!") ] 71 | ] 72 | 73 | viewForPosition : Model -> Html Msg 74 | viewForPosition model = 75 | Html.div 76 | [ Attr.id "root" 77 | ] 78 | [ Html.div 79 | [ Attr.class "button" 80 | , onMouseEvent "click" RecordPosition 81 | , onMouseEvent "mousedown" RecordPosition 82 | , onMouseEvent "mouseup" RecordPosition 83 | , onMouseEvent "mouseover" RecordPosition 84 | , onMouseEvent "mouseout" RecordPosition 85 | ] 86 | [ Html.text "Click me!" ] 87 | , Html.div [ Attr.id "click-counter" ] [ Html.text ((String.fromInt model.clicks) ++ " clicks!") ] 88 | , Html.div 89 | [ Attr.id "enter-leave-element" 90 | , onMouseEvent "mouseenter" RecordPosition 91 | , onMouseEvent "mouseleave" RecordPosition 92 | ] 93 | [ Html.div [ Attr.id "child-element" ] [ Html.text "Mouse over me please!" ] ] 94 | ] 95 | 96 | viewForMouseEnterLeave : Model -> Html Msg 97 | viewForMouseEnterLeave model = 98 | Html.div [ Attr.id "root" ] 99 | [ Html.div [ Attr.class "no-events" ] [ Html.text "no events" ] 100 | , Html.div [ Attr.id "event-parent", onMouseEnter DoMouseEnter, onMouseLeave DoMouseLeave ] 101 | [ Html.ul [] 102 | [ Html.li 103 | [ Attr.attribute "data-option" "1" 104 | , onMouseEnter DoMouseEnter 105 | , onMouseLeave DoMouseLeave 106 | ] [ Html.text "Option 1" ] 107 | , Html.li [ Attr.attribute "data-option" "2" ] [ Html.text "Option 2" ] 108 | , Html.li [ Attr.attribute "data-option" "3" ] [ Html.text "Option 3" ] 109 | ] 110 | ] 111 | ] 112 | 113 | onMouseEvent : String -> (MousePosition -> Msg) -> Html.Attribute Msg 114 | onMouseEvent eventType tagger = 115 | Events.on eventType <| Json.map tagger mousePositionDecoder 116 | 117 | mousePositionDecoder : Json.Decoder MousePosition 118 | mousePositionDecoder = 119 | Json.map2 MousePosition 120 | ( Json.field "pageX" Json.int ) 121 | ( Json.field "pageY" Json.int ) 122 | 123 | update : Msg -> Model -> ( Model, Cmd Msg ) 124 | update msg model = 125 | case msg of 126 | DoClick -> 127 | ( { model | clicks = model.clicks + 1 }, Cmd.none ) 128 | RecordPosition position -> 129 | ( { model | position = Just position }, Cmd.none ) 130 | DoDoubleClick -> 131 | ( { model | doubleClicks = model.doubleClicks + 1 }, Cmd.none ) 132 | DoMouseDown -> 133 | ( { model | mouseDowns = model.mouseDowns + 1 }, Cmd.none ) 134 | DoMouseUp -> 135 | ( { model | mouseUps = model.mouseUps + 1 }, Cmd.none ) 136 | DoMouseEnter -> 137 | ( { model | mouseEnters = model.mouseEnters + 1 }, Cmd.none ) 138 | DoMouseLeave -> 139 | ( { model | mouseLeaves = model.mouseLeaves + 1 }, Cmd.none ) 140 | DoMouseOver -> 141 | ( { model | mouseOvers = model.mouseOvers + 1 }, Cmd.none ) 142 | DoMouseOut -> 143 | ( { model | mouseOuts = model.mouseOuts + 1 }, Cmd.none ) 144 | -------------------------------------------------------------------------------- /src/Elmer/Spy/Internal.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Spy.Internal exposing 2 | ( Spy(..) 3 | , Calls 4 | , create 5 | , replaceValue 6 | , activate 7 | , deactivate 8 | , calls 9 | , spiesFrom 10 | , withSpies 11 | , withSpiesFor 12 | , registerFake 13 | ) 14 | 15 | import Elmer.Context as Context exposing (Context) 16 | import Elmer.Runtime.Command as RuntimeCommand 17 | import Elmer.Spy.Function as Function exposing (Function) 18 | import Elmer.Spy.Arg as Arg exposing (Arg) 19 | import Json.Decode as Json 20 | import Elmer.Value as Value 21 | import Expect 22 | 23 | 24 | type alias Calls = 25 | { name : String 26 | , calls : List (List Arg) 27 | } 28 | 29 | 30 | type Spy 31 | = Uninstalled (() -> Spy) 32 | | Active SpyValue 33 | | Inactive SpyValue 34 | | Error SpyError 35 | | Batch (List Spy) 36 | 37 | 38 | type alias SpyValue = 39 | { name: String 40 | , function: Function 41 | , calls: List (List Function.Argument) 42 | } 43 | 44 | type alias SpyError = 45 | { reason: String 46 | } 47 | 48 | create : (() -> a) -> Spy 49 | create namingFunc = 50 | case Function.from namingFunc of 51 | Ok function -> 52 | recordCalls 53 | { name = function.alias 54 | , function = function 55 | , calls = [] 56 | } 57 | Err message -> 58 | Error 59 | { reason = message 60 | } 61 | 62 | 63 | replaceValue : (() -> a) -> b -> Spy 64 | replaceValue namingFunc value = 65 | case Function.replace namingFunc value of 66 | Just function -> 67 | recordCalls 68 | { name = function.alias 69 | , function = function 70 | , calls = [] 71 | } 72 | Nothing -> 73 | let 74 | valueName = 75 | Function.functionIdentifier namingFunc 76 | in 77 | case valueName of 78 | Just name -> 79 | Error 80 | { reason = name ++ " is a function, but your test is treating it as a value to be replaced" 81 | } 82 | Nothing -> 83 | Error 84 | { reason = "Unable to identify a value to replace" 85 | } 86 | 87 | 88 | recordCalls : SpyValue -> Spy 89 | recordCalls spy = 90 | Active 91 | { spy | function = Function.activateSpy spy.calls spy.function } 92 | 93 | 94 | calls : String -> List Spy -> Maybe Calls 95 | calls name spies = 96 | List.filterMap (\spy -> 97 | case spy of 98 | Active spyValue -> 99 | callsIfName name spyValue 100 | Inactive spyValue -> 101 | callsIfName name spyValue 102 | _ -> 103 | Nothing 104 | ) spies 105 | |> List.head 106 | 107 | 108 | callsIfName : String -> SpyValue -> Maybe Calls 109 | callsIfName name spyValue = 110 | if spyValue.name == name then 111 | Just <| callRecord spyValue 112 | else 113 | Nothing 114 | 115 | 116 | callRecord : SpyValue -> Calls 117 | callRecord spyValue = 118 | { name = spyValue.name 119 | , calls = decodeArguments spyValue.calls 120 | } 121 | 122 | 123 | decodeArguments : List (List Function.Argument) -> List (List Arg) 124 | decodeArguments = 125 | List.map <| List.map <| 126 | \arg -> 127 | Json.decodeValue Arg.decoder arg 128 | |> Result.withDefault Arg.AnyArg 129 | 130 | 131 | registerFake : (a -> b) -> SpyValue -> Spy 132 | registerFake fake spy = 133 | Active 134 | { spy | function = Function.withFake fake spy.function 135 | } 136 | 137 | 138 | activate : List Spy -> List Spy 139 | activate spies = 140 | List.map (\spy -> 141 | case spy of 142 | Uninstalled installer -> 143 | [ installer () ] 144 | Inactive spyValue -> 145 | [ recordCalls spyValue ] 146 | Batch batched -> 147 | activate batched 148 | _ -> 149 | [ spy ] 150 | ) spies 151 | |> List.concat 152 | 153 | 154 | deactivateOne : Spy -> Spy 155 | deactivateOne spy = 156 | case spy of 157 | Active spyValue -> 158 | Inactive 159 | { spyValue | calls = Function.deactivateSpy spyValue.function } 160 | _ -> 161 | spy 162 | 163 | 164 | deactivate : List Spy -> List Spy 165 | deactivate = 166 | List.map deactivateOne 167 | 168 | 169 | type SpyState 170 | = Spies 171 | 172 | 173 | spiesFrom : Context model msg -> List Spy 174 | spiesFrom context = 175 | Context.state Spies context 176 | |> Maybe.withDefault [] 177 | 178 | 179 | withSpies : List Spy -> Context model msg -> Context model msg 180 | withSpies spies context = 181 | RuntimeCommand.mapState Spies (\_ -> spies) 182 | |> Context.updateStateFor context 183 | 184 | withSpiesFor : Context model msg -> List Spy -> Context model msg 185 | withSpiesFor context spies = 186 | withSpies spies context -------------------------------------------------------------------------------- /src/Elmer/Navigation.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Navigation 2 | exposing 3 | ( fakeKey 4 | , expectLocation 5 | , spy 6 | ) 7 | 8 | {-| Functions for describing the navigation behavior of Elm Html programs created with `Browser.application`. 9 | 10 | # Make Expectations about the Current Location 11 | @docs spy, expectLocation 12 | 13 | # Get a Fake Navigation Key 14 | @docs fakeKey 15 | 16 | -} 17 | 18 | import Elmer.Spy as Spy exposing (Spy, andCallFake) 19 | import Elmer.Command as Command 20 | import Elmer.Runtime.Command as RuntimeCommand 21 | import Elmer.TestState as TestState exposing (TestState) 22 | import Elmer.Context as Context exposing (Context) 23 | import Elmer.Errors as Errors exposing (failWith) 24 | import Elmer.Effects as Effects 25 | import Elmer exposing (Matcher) 26 | import Elmer.Value.Encode as Value 27 | import Elmer.Navigation.Internal exposing (..) 28 | import Expect 29 | import Browser.Navigation as Navigation 30 | import Html exposing (Html) 31 | import Browser exposing (UrlRequest) 32 | import Browser.Navigation exposing (Key) 33 | import Url exposing (Url) 34 | 35 | 36 | {-| Generate a fake `Browser.Navigation.Key` value. 37 | 38 | Use this value when calling the init function of a `Browser.application` program during a test. 39 | -} 40 | fakeKey : Navigation.Key 41 | fakeKey = 42 | Value.encode (Value.for "Key") [] 43 | 44 | 45 | {-| Stub `Browser.Navigation.pushUrl` and `Browser.Navigation.replaceUrl` with a function that 46 | records the location as it is set. 47 | 48 | You must use this function with `Elmer.Spy.use` in order to make expectations 49 | about the location. 50 | 51 | Suppose you want to test a home button that sets the 52 | location to `/home` when clicked: 53 | 54 | testState 55 | |> Spy.use [ Navigation.spy ] 56 | |> Elmer.Html.target 57 | << by [ id "home-button" ] 58 | |> Elmer.Html.Event.click 59 | |> Elmer.Navigation.expectLocation "/home" 60 | 61 | -} 62 | spy : Spy 63 | spy = 64 | Spy.batch 65 | [ Spy.observe (\_ -> Browser.Navigation.pushUrl) 66 | |> andCallFake (fakeNavigateCommand "Browser.Navigation.pushUrl") 67 | , Spy.observe (\_ -> Browser.Navigation.replaceUrl) 68 | |> andCallFake (fakeNavigateCommand "Browser.Navigation.replaceUrl") 69 | ] 70 | 71 | 72 | generateUrlChangeCommand : String -> String -> Context model msg -> Cmd msg 73 | generateUrlChangeCommand functionName urlString context = 74 | case Context.state NavigationTaggers context of 75 | Just { onUrlRequest, onUrlChange } -> 76 | case Url.fromString urlString of 77 | Just url -> 78 | Command.fake <| onUrlChange url 79 | Nothing -> 80 | Command.fail <| Errors.print <| Errors.badUrl functionName urlString 81 | Nothing -> 82 | Command.fail <| Errors.print <| Errors.navigationSpyRequiresApplication functionName urlString 83 | 84 | 85 | fakeNavigateCommand : String -> Key -> String -> Cmd msg 86 | fakeNavigateCommand functionName _ url = 87 | let 88 | parseCommand = RuntimeCommand.generate <| generateUrlChangeCommand functionName url 89 | stateCommand = Effects.push Location (\_ -> url) 90 | in 91 | Cmd.batch [ stateCommand, parseCommand ] 92 | 93 | 94 | {-| Expect that the current location is equal to the given string. 95 | 96 | This expectation must be used in conjunction with `spy` above, and your `TestState` must be 97 | created with `Elmer.Program.givenApplication`. 98 | 99 | Suppose your app calls `Browser.Navigation.pushUrl` when an element is clicked. You can describe 100 | this behavior as follows: 101 | 102 | Elmer.Program.givenApplication App.OnUrlRequest App.OnUrlChange App.view App.update 103 | |> Elmer.Spy.use [ Elmer.Navigation.spy ] 104 | |> Elmer.Program.init (\_ -> 105 | App.init testFlags testUrl Elmer.Navigation.fakeKey 106 | ) 107 | |> Elmer.Html.target 108 | << by [ id "some-element" ] 109 | |> Elmer.Html.Event.click 110 | |> Elmer.Navigation.expectLocation 111 | "http://mydomain.com/funStuff.html" 112 | 113 | Note that `expectLocation` will only match on urls provided via `Browser.Navigation.pushUrl` or 114 | `Browser.Navigation.replaceUrl`. In particular, `expectLocation` will not match the url provided 115 | as part of the call to `Elmer.init` that provides the initial model and command values. 116 | -} 117 | expectLocation : String -> Matcher (Elmer.TestState model msg) 118 | expectLocation expectedURL = 119 | Effects.expect Location <| \maybeLocation -> 120 | case maybeLocation of 121 | Just location -> 122 | Expect.equal location expectedURL 123 | |> Expect.onFail (Errors.print <| Errors.wrongLocation expectedURL location) 124 | Nothing -> 125 | failWith <| Errors.noLocation expectedURL 126 | -------------------------------------------------------------------------------- /tests/src/Elmer/RuntimeTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.RuntimeTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Expect 5 | 6 | import Html exposing (Html) 7 | import Elmer exposing (..) 8 | import Elmer.TestState as TestState exposing (TestState) 9 | import Elmer.TestApps.MessageTestApp as App 10 | import Elmer.Runtime as Runtime 11 | import Elmer.Html.Matchers as Matchers exposing (element, hasText) 12 | import Elmer.Html.Selector as Sel exposing (..) 13 | import Elmer.Command as Command 14 | import Elmer.Html as Markup 15 | import Elmer.Message exposing (..) 16 | import Task 17 | import Time 18 | 19 | 20 | all : Test 21 | all = 22 | Test.concat 23 | [ batchCommandTest 24 | , batchCommandFailureTest 25 | , mappedBatchCommandTest 26 | , unknownCommandTest 27 | ] 28 | 29 | 30 | sendFirstMessage : String -> Cmd App.Msg 31 | sendFirstMessage str = 32 | Command.fake (App.RenderFirstMessage str) 33 | 34 | sendSecondMessage : String -> Cmd App.Msg 35 | sendSecondMessage str = 36 | Command.fake (App.RenderSecondMessage str) 37 | 38 | batchCommandTest : Test 39 | batchCommandTest = 40 | let 41 | initialState = Elmer.given App.defaultModel App.view App.update 42 | batchCommandThunk = \() -> 43 | Cmd.batch 44 | [ sendFirstMessage "Cool stuff!" 45 | , sendSecondMessage "Fun stuff!" 46 | ] 47 | result = Command.send batchCommandThunk initialState 48 | in 49 | describe "when a batch command is sent" 50 | [ test "it processes the first command" <| 51 | \() -> 52 | result 53 | |> Markup.target << by [ id "first-message" ] 54 | |> Markup.expect (element <| hasText "Cool stuff!") 55 | , test "it processes the second command" <| 56 | \() -> 57 | result 58 | |> Markup.target << by [ id "second-message" ] 59 | |> Markup.expect (element <| hasText "Fun stuff!") 60 | ] 61 | 62 | batchCommandFailureTest : Test 63 | batchCommandFailureTest = 64 | let 65 | initialState = Elmer.given App.defaultModel App.view App.update 66 | batchCommandThunk = \() -> 67 | Cmd.batch 68 | [ sendFirstMessage "Cool stuff!" 69 | , Command.fail "It failed!" 70 | , sendSecondMessage "Fun stuff!" 71 | ] 72 | result = Command.send batchCommandThunk initialState 73 | in 74 | describe "when a batched command fails" 75 | [ test "it reports the failure" <| 76 | \() -> 77 | Expect.equal (TestState.failure "It failed!") result 78 | ] 79 | 80 | mappedBatchCommandTest : Test 81 | mappedBatchCommandTest = 82 | let 83 | testModel = { appModel = App.defaultModel } 84 | initialState = Elmer.given testModel parentView parentUpdate 85 | batchCommand = Cmd.batch 86 | [ sendFirstMessage "Cool stuff!" 87 | , sendSecondMessage "Fun stuff!" 88 | ] 89 | result = Command.send (\() -> Cmd.map AppMsg batchCommand) initialState 90 | in 91 | describe "when a batched command is mapped" 92 | [ test "it maps the first command" <| 93 | \() -> 94 | result 95 | |> Markup.target << by [ id "first-message" ] 96 | |> Markup.expect (element <| hasText "Cool stuff!") 97 | , test "it maps the second command" <| 98 | \() -> 99 | result 100 | |> Markup.target << by [ id "second-message" ] 101 | |> Markup.expect (element <| hasText "Fun stuff!") 102 | ] 103 | 104 | type ParentMsg 105 | = AppMsg App.Msg 106 | 107 | type alias ParentModel = 108 | { appModel : App.Model } 109 | 110 | parentView : ParentModel -> Html ParentMsg 111 | parentView parentModel = 112 | Html.map AppMsg (App.view parentModel.appModel) 113 | 114 | parentUpdate : ParentMsg -> ParentModel -> ( ParentModel, Cmd ParentMsg ) 115 | parentUpdate parentMsg model = 116 | case parentMsg of 117 | AppMsg appMsg -> 118 | let 119 | ( updatedAppModel, updatedAppCmd ) = App.update appMsg model.appModel 120 | updatedModel = { model | appModel = updatedAppModel } 121 | updatedCmd = Cmd.map AppMsg updatedAppCmd 122 | in 123 | ( updatedModel, updatedCmd ) 124 | 125 | 126 | unknownCommandTest : Test 127 | unknownCommandTest = 128 | describe "when the runtime receives an unknown command" 129 | [ test "it fails" <| 130 | \() -> 131 | let 132 | initialState = Elmer.given App.defaultModel App.view App.update 133 | unknownCommandThunk = \() -> Task.perform App.RenderFirstMessage (Time.now |> Task.map (Time.posixToMillis >> String.fromInt)) 134 | in 135 | Command.send unknownCommandThunk initialState 136 | |> Expect.equal (TestState.failure ( format 137 | [ note "Encountered a native task.\nStub any task-generating functions with Task.succeed or Task.fail as necessary." 138 | ] 139 | )) 140 | ] 141 | -------------------------------------------------------------------------------- /src/Elmer/Html/Element.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Element exposing 2 | ( id 3 | , tag 4 | , target 5 | , classList 6 | , property 7 | , boolProperty 8 | , properties 9 | , attributes 10 | , styles 11 | , texts 12 | , children 13 | , toString 14 | ) 15 | 16 | {-| Functions for working directly with HtmlElements. 17 | 18 | # Element Characteristics 19 | @docs tag, id, classList, styles, property, boolProperty, properties, attributes, texts, children 20 | 21 | # Target Descendants 22 | @docs target 23 | 24 | # Debugging 25 | @docs toString 26 | 27 | -} 28 | 29 | 30 | import Elmer.Html 31 | import Elmer.Html.Element.Internal as Internal 32 | import Elmer.Html.Target as Target 33 | import Elmer.Html.Element.Printer as HtmlPrinter 34 | import Elmer.Html.Selector as Selector 35 | import Elmer.Html.Types exposing (HtmlSelectorGroup(..)) 36 | import Dict exposing (Dict) 37 | 38 | 39 | {-| Target descendants of an element. 40 | 41 | Use this function in conjunction with `HtmlTarget` matchers like `element` or `elements` 42 | to make expectations about descendants of an element. 43 | 44 | Elmer.given someModel view update 45 | |> Elmer.Html.target 46 | << by [ id "some-element" ] 47 | |> Elmer.Html.expect (Elmer.Html.Matchers.element <| 48 | \element -> 49 | element 50 | |> target << by [ tag "div" ] 51 | |> Elmer.Html.Matchers.elements ( 52 | Elmer.hasLength 3 53 | ) 54 | ) 55 | 56 | Note that `Elmer.Html.target << descendantsOf [ id "some-element" ] << by [ tag "div" ]` would allow you to write the 57 | same expectation. Use `Element.target` for complex expectations about nested elements. 58 | 59 | -} 60 | target : (HtmlSelectorGroup msg, Elmer.Html.HtmlElement msg) -> Elmer.Html.HtmlTarget msg 61 | target (selectors, element) = 62 | Target.forElement selectors element 63 | 64 | 65 | {-| Represent an `HtmlElement` as a String. 66 | -} 67 | toString : Elmer.Html.HtmlElement msg -> String 68 | toString node = 69 | HtmlPrinter.print node 70 | 71 | 72 | {-| Get the tag of the element 73 | -} 74 | tag : Elmer.Html.HtmlElement msg -> String 75 | tag = 76 | Internal.tag 77 | 78 | 79 | {-| Get the value of the element's `id` attribute, if it is defined. 80 | -} 81 | id : Elmer.Html.HtmlElement msg -> Maybe String 82 | id = 83 | Internal.elementId 84 | 85 | 86 | {-| Get a list of classes applied to this element. 87 | -} 88 | classList : Elmer.Html.HtmlElement msg -> List String 89 | classList = 90 | Internal.classList 91 | 92 | 93 | {-| Get the `Html.text` values that are children of this element. 94 | -} 95 | texts : Elmer.Html.HtmlElement msg -> List String 96 | texts = 97 | Internal.texts 98 | 99 | 100 | {-| Get the Html elements that are children of this element. 101 | 102 | Note that `Html.text` values are excluded. Use `texts` to get those. 103 | -} 104 | children : Elmer.Html.HtmlElement msg -> List (Elmer.Html.HtmlElement msg) 105 | children = 106 | Internal.childElements 107 | 108 | 109 | {-| Get this element's styles as a `Dict`. 110 | -} 111 | styles : Elmer.Html.HtmlElement msg -> Dict String String 112 | styles = 113 | Internal.styles 114 | 115 | 116 | {-| Get the value of a particular property belonging to this 117 | element, if that property is defined. 118 | -} 119 | property : String -> Elmer.Html.HtmlElement msg -> Maybe String 120 | property name = 121 | Internal.property name 122 | 123 | 124 | {-| Get the boolean value of a particular property belonging to 125 | this element, if that property is defined. 126 | 127 | If the property is defined, but its value is not boolean, then 128 | `Nothing` is returned. 129 | -} 130 | boolProperty : String -> Elmer.Html.HtmlElement msg -> Maybe Bool 131 | boolProperty name element = 132 | property name element 133 | |> Maybe.andThen toBool 134 | 135 | 136 | toBool : String -> Maybe Bool 137 | toBool str = 138 | case str of 139 | "true" -> 140 | Just True 141 | "false" -> 142 | Just False 143 | _ -> 144 | Nothing 145 | 146 | 147 | {-| Get this element's properties as a `Dict`. 148 | 149 | On the difference between attributes and properties, 150 | see [this](https://github.com/elm/html/blob/master/properties-vs-attributes.md). 151 | -} 152 | properties : Elmer.Html.HtmlElement msg -> Dict String String 153 | properties = 154 | Internal.properties 155 | 156 | 157 | {-| Get this element's attributes as a `Dict`. If you define a custom attribute 158 | for an Html element, you can find it with this function. 159 | 160 | Elmer.given someModel view update 161 | |> target << by [ id "some-element" ] 162 | |> expect (element <| \element -> 163 | attributes element 164 | |> Dict.get "data-attribute" 165 | |> Expect.notEqual Nothing 166 | ) 167 | -} 168 | attributes : Elmer.Html.HtmlElement msg -> Dict String String 169 | attributes = 170 | Internal.attributes 171 | -------------------------------------------------------------------------------- /src/Elmer/Program.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Program exposing 2 | ( givenElement 3 | , givenApplication 4 | , givenDocument 5 | , givenWorker 6 | , init 7 | ) 8 | 9 | {-| Functions for working with Elm programs. 10 | 11 | # Test an Elm Html Sandbox or Element Program 12 | @docs givenElement 13 | 14 | # Test an Elm Html Application 15 | @docs givenApplication 16 | 17 | # Test an Elm Html Document 18 | @docs givenDocument 19 | 20 | # Test am Elm Worker Program 21 | @docs givenWorker 22 | 23 | # Initialize an Elm program 24 | @docs init 25 | 26 | -} 27 | 28 | import Elmer exposing (TestState) 29 | import Elmer.Context as Context exposing (View(..)) 30 | import Elmer.TestState as TestState 31 | import Elmer.Navigation.Internal exposing (NavigationState(..)) 32 | import Elmer.Effects as Effects 33 | import Elmer.Runtime as Runtime 34 | import Browser exposing (UrlRequest, Document) 35 | import Url exposing (Url) 36 | import Html exposing (Html) 37 | 38 | 39 | 40 | {-| Initialize a `TestState` with the basic requirements for a program created with 41 | `Browser.sandbox` or `Browser.element`. 42 | 43 | The arguments are: 44 | 45 | 1. View function 46 | 2. Update function 47 | 48 | You'll need to call `Elmer.Program.init` with the program's `init` function to properly 49 | start your test. 50 | -} 51 | givenElement : ( model -> Html msg ) 52 | -> ( msg -> model -> ( model, Cmd msg ) ) 53 | -> TestState model msg 54 | givenElement view update = 55 | Context.default (HtmlView view) update 56 | |> TestState.with 57 | 58 | 59 | {-| Initialize a `TestState` with the basic requirements for a program 60 | created with `Browser.application`. 61 | 62 | The arguments are: 63 | 64 | 1. Function that maps a new `Browser.UrlRequest` to a `msg` 65 | 2. Function that maps a `Url` to a `msg` when the url changes 66 | 3. View function that results in a `Browser.Document` 67 | 4. Update function 68 | 69 | You'll need to call `Elmer.Program.init` with the program's `init` function to properly 70 | start your test. 71 | -} 72 | givenApplication : (UrlRequest -> msg) -> (Url -> msg) -> (model -> Document msg) -> (msg -> model -> (model, Cmd msg)) -> TestState model msg 73 | givenApplication onUrlRequest onUrlChange view update = 74 | Context.default (DocumentView view) update 75 | |> Context.updateState (storeNavigationTaggersCommand onUrlRequest onUrlChange) 76 | |> TestState.with 77 | 78 | 79 | storeNavigationTaggersCommand : (UrlRequest -> msg) -> (Url -> msg) -> Cmd msg 80 | storeNavigationTaggersCommand onUrlRequest onUrlChange = 81 | Effects.push NavigationTaggers <| 82 | \_ -> 83 | { onUrlRequest = onUrlRequest 84 | , onUrlChange = onUrlChange 85 | } 86 | 87 | 88 | {-| Initialize a `TestState` with the basic requirements for a program 89 | created with `Browser.document`. 90 | 91 | The arguments are: 92 | 93 | 1. View function that results in a `Browser.Document` 94 | 2. Update function. 95 | 96 | You'll need to call `Elmer.Program.init` with the program's `init` function to properly 97 | start your test. 98 | -} 99 | givenDocument : (model -> Document msg) -> (msg -> model -> (model, Cmd msg)) -> TestState model msg 100 | givenDocument view update = 101 | Context.default (DocumentView view) update 102 | |> TestState.with 103 | 104 | 105 | {-| Initialize a `TestState` with the basic requirements for 106 | a headless worker program created with `Platform.worker`. 107 | 108 | The argument is an update function. 109 | 110 | You'll need to call `Elmer.Program.init` with the program's `init` function to properly 111 | start your test. 112 | -} 113 | givenWorker : ( msg -> model -> ( model, Cmd msg ) ) -> TestState model msg 114 | givenWorker update = 115 | Context.default (HtmlView emptyView) update 116 | |> TestState.with 117 | 118 | emptyView : model -> Html msg 119 | emptyView _ = 120 | Html.text "" 121 | 122 | 123 | {-| Update the test context with the given model and Cmd. 124 | 125 | Provide a function that calls a program's `init` function and returns a model and a command. 126 | The resuling model will become the current model for the system under test and the given command 127 | will be executed. 128 | 129 | Elmer.Program.givenDocument MyDocument.view MyDocument.update 130 | |> init (\() -> MyDocument.init) 131 | |> Elmer.Html.target 132 | << by [ id "title" ] 133 | |> Elmer.Html.expectElementExists 134 | 135 | Note: If your test requires any spies, call `Spy.use` before your call to `init` so the spies will 136 | be available whan the supplied function is evaluated. 137 | -} 138 | init : (() -> (model, Cmd msg)) -> TestState model msg -> TestState model msg 139 | init initThunk = 140 | TestState.map <| 141 | \context -> 142 | let 143 | (initModel, initCommand) = initThunk () 144 | updatedContext = Context.withModel initModel context 145 | in 146 | Runtime.performCommand initCommand updatedContext 147 | |> TestState.fromRuntimeResult 148 | -------------------------------------------------------------------------------- /tests/src/Elmer/EventTests.elm: -------------------------------------------------------------------------------- 1 | module Elmer.EventTests exposing (..) 2 | 3 | import Test exposing (..) 4 | import Elmer.TestApps.SimpleTestApp as SimpleApp 5 | import Elmer.TestApps.InputTestApp as InputApp 6 | import Elmer.TestApps.EventPropagationTestApp as EventApp 7 | import Expect 8 | import Elmer 9 | import Elmer.TestState as TestState exposing (TestState) 10 | import Elmer.Html.Event as Event 11 | import Elmer.Html.Selector as Sel 12 | import Elmer.TestHelpers exposing (printHtml) 13 | import Elmer.Errors as Errors 14 | import Elmer.Command as Command 15 | import Elmer.Html as Markup 16 | 17 | 18 | all : Test 19 | all = 20 | Test.concat 21 | [ customEventTests 22 | ] 23 | 24 | standardEventBehavior : String -> (TestState SimpleApp.Model SimpleApp.Msg -> TestState SimpleApp.Model SimpleApp.Msg) -> Test 25 | standardEventBehavior eventTypes eventFunction = 26 | describe "Event Behavior" 27 | [ describe "when there is an upstream failure" 28 | [ test "it passes on the error" <| 29 | \() -> 30 | let 31 | initialState = TestState.failure "upstream failure" 32 | in 33 | eventFunction initialState 34 | |> Expect.equal initialState 35 | ] 36 | , describe "when there is no target node" 37 | [ test "it returns an upstream failure" <| 38 | \() -> 39 | let 40 | initialState = Elmer.given SimpleApp.defaultModel SimpleApp.view SimpleApp.update 41 | in 42 | eventFunction initialState 43 | |> Expect.equal (TestState.failure "No element has been targeted. Use Elmer.Html.target to identify an element to receive the event.") 44 | ] 45 | , describe "when the targeted element is not found" 46 | [ test "it returns a failure" <| 47 | \() -> 48 | Elmer.given SimpleApp.defaultModel SimpleApp.view SimpleApp.update 49 | |> Markup.target << Sel.by [ Sel.id "nothing" ] 50 | |> eventFunction 51 | |> Expect.equal (TestState.failure <| 52 | Errors.print <| 53 | Errors.elementNotFound "by [ id 'nothing' ]" <| 54 | printHtml (SimpleApp.view SimpleApp.defaultModel) 55 | ) 56 | ] 57 | , describe "when the event handler is not found" 58 | [ test "it returns an event not found error" <| 59 | \() -> 60 | Elmer.given SimpleApp.defaultModel SimpleApp.view SimpleApp.update 61 | |> Markup.target << Sel.by [ Sel.class "no-events" ] 62 | |> eventFunction 63 | |> Expect.equal (TestState.failure <| 64 | Errors.print <| 65 | Errors.eventHandlerNotFound eventTypes "by [ class 'no-events' ]" 66 | ) 67 | ] 68 | ] 69 | 70 | multiEventPropagationBehavior : Int -> Int -> (TestState EventApp.Model EventApp.Msg -> TestState EventApp.Model EventApp.Msg) -> String -> Test 71 | multiEventPropagationBehavior allEvents nonPropagatingEvents eventFunc eventName = 72 | describe (eventName ++ " event propagation tests") 73 | [ describe "when there is no event handler on the target element" 74 | [ test "the event bubbles up through all the ancestors" <| 75 | \() -> 76 | let 77 | state = Elmer.given EventApp.defaultModel EventApp.view EventApp.update 78 | |> Markup.target << Sel.by [ Sel.id "no-events" ] 79 | |> eventFunc 80 | in 81 | Elmer.expectModel (\model -> 82 | Expect.equal model.eventCount allEvents 83 | ) state 84 | ] 85 | , describe "when an event handler has stopPropagation set to True" 86 | [ test "the event stops at the non-propagating event handler" <| 87 | \() -> 88 | let 89 | state = Elmer.given EventApp.defaultModel (EventApp.viewWithNonPropagatingEvent eventName) EventApp.update 90 | |> Markup.target << Sel.by [ Sel.id "no-events" ] 91 | |> eventFunc 92 | in 93 | Elmer.expectModel (\model -> 94 | Expect.equal model.eventCount nonPropagatingEvents 95 | ) state 96 | ] 97 | ] 98 | 99 | propagationBehavior : (TestState EventApp.Model EventApp.Msg -> TestState EventApp.Model EventApp.Msg) -> String -> Test 100 | propagationBehavior = 101 | multiEventPropagationBehavior 3 2 102 | 103 | customEventTests = 104 | let 105 | keyUpEventJson = "{\"keyCode\":65}" 106 | in 107 | describe "custom event tests" 108 | [ standardEventBehavior "keyup" (Event.trigger "keyup" keyUpEventJson) 109 | , describe "when the event succeeds" 110 | [ test "it updates the model accordingly" <| 111 | \() -> 112 | Elmer.given InputApp.defaultModel InputApp.view InputApp.update 113 | |> Markup.target << Sel.by [ Sel.tag "input", Sel.attribute ("name", "first-name") ] 114 | |> Event.trigger "keyup" keyUpEventJson 115 | |> Elmer.expectModel (\model -> 116 | Expect.equal model.lastLetter 65 117 | ) 118 | ] 119 | ] 120 | -------------------------------------------------------------------------------- /src/Elmer/Html/Event/Processor.elm: -------------------------------------------------------------------------------- 1 | module Elmer.Html.Event.Processor exposing 2 | ( processEvents 3 | , processEventsWhen 4 | ) 5 | 6 | import Elmer.Html.Event.Types exposing (..) 7 | import Elmer.Html.Types exposing (..) 8 | import Elmer.Html.Selector.Printer as Selector 9 | import Elmer.TestState as TestState exposing (TestState) 10 | import Elmer.Context as Context exposing (Context) 11 | import Elmer.Runtime as Runtime 12 | import Elmer.Errors as Errors 13 | import Json.Decode as Json 14 | import Elmer.Html.Query as Query 15 | import Elmer.Html.Target as Target 16 | import Html exposing (Html) 17 | 18 | 19 | processEventsWhen : List (EventDescription msg) -> (Result String (HtmlElement msg) -> Result String (HtmlElement msg)) -> TestState model msg -> TestState model msg 20 | processEventsWhen eventDescriptions assertions = 21 | TestState.map (\context -> 22 | targetedElement context 23 | |> assertions 24 | |> Result.andThen (hasHandlersFor eventDescriptions context) 25 | |> Result.andThen (apply eventDescriptions context) 26 | |> toTestState 27 | ) 28 | 29 | 30 | processEvents : List (EventDescription msg) -> TestState model msg -> TestState model msg 31 | processEvents eventDescriptions = 32 | processEventsWhen eventDescriptions identity 33 | 34 | 35 | hasHandlersFor : List (EventDescription msg) -> Context model msg -> HtmlElement msg -> Result String (HtmlElement msg) 36 | hasHandlersFor eventDescriptions context element = 37 | let 38 | handlers = List.map (\ed -> ed.handlers (renderViewWithDefault context) element) eventDescriptions 39 | |> List.concat 40 | in 41 | if List.isEmpty handlers then 42 | let 43 | eventTypes = 44 | List.map .eventType eventDescriptions 45 | |> String.join ", " 46 | selector = 47 | targetedSelector context 48 | |> Maybe.map Selector.printGroup 49 | |> Maybe.withDefault "" 50 | in 51 | Err <| 52 | Errors.print <| Errors.eventHandlerNotFound eventTypes selector 53 | else 54 | Ok element 55 | 56 | 57 | apply : List (EventDescription msg) -> Context model msg -> HtmlElement msg -> Result String (Context model msg) 58 | apply eventDescriptionList context element = 59 | List.foldl (\evtDescr result -> 60 | Result.andThen (\ctxt -> 61 | collectEventHandlers evtDescr.handlers ctxt element 62 | |> bubbleEvent evtDescr.eventJson (Ok ctxt) 63 | ) result 64 | ) (Ok context) eventDescriptionList 65 | 66 | 67 | targetedSelector : Context model msg -> Maybe (HtmlSelectorGroup msg) 68 | targetedSelector = 69 | Context.state TargetSelector 70 | 71 | 72 | targetedElement : Context model msg -> Result String (HtmlElement msg) 73 | targetedElement context = 74 | case targetedSelector context of 75 | Just selector -> 76 | case Context.render context of 77 | Just view -> 78 | Query.findElement <| Target.forHtml selector view 79 | Nothing -> 80 | Err <| Errors.print Errors.noModel 81 | Nothing -> 82 | Err <| Errors.print <| Errors.noElementTargetedForEvent 83 | 84 | 85 | prepareHandler : HtmlEventHandler msg -> EventHandler msg 86 | prepareHandler eventHandler eventJson = 87 | Json.decodeString eventHandler.decoder eventJson 88 | |> Result.mapError Debug.toString 89 | 90 | 91 | collectEventHandlers : EventHandlerQuery msg -> Context model msg -> HtmlElement msg -> List (EventHandler msg) 92 | collectEventHandlers eventHandlerQuery context element = 93 | eventHandlerQuery (renderViewWithDefault context) element 94 | |> List.map prepareHandler 95 | 96 | 97 | bubbleEvent : EventJson -> Result String (Context model msg) -> List (EventHandler msg) -> Result String (Context model msg) 98 | bubbleEvent event contextResult eventHandlers = 99 | case eventHandlers of 100 | [] -> 101 | contextResult 102 | eventHandler :: remaining -> 103 | case eventHandler event of 104 | Ok eventValue -> 105 | let 106 | result = 107 | Result.andThen (Runtime.performUpdate eventValue.message) contextResult 108 | in 109 | if eventValue.stopPropagation == True then 110 | result 111 | else 112 | bubbleEvent event result remaining 113 | Err error -> 114 | Err error 115 | 116 | 117 | toTestState : Result String (Context model msg) -> TestState model msg 118 | toTestState contextResult = 119 | case contextResult of 120 | Ok context -> 121 | TestState.with context 122 | Err message -> 123 | TestState.failure message 124 | 125 | 126 | renderViewWithDefault : Context model msg -> Html msg 127 | renderViewWithDefault context = 128 | Context.render context 129 | |> Maybe.withDefault (Html.text "") 130 | 131 | 132 | takeUpTo : (a -> Bool) -> List a -> List a 133 | takeUpTo predicate elements = 134 | case elements of 135 | [] -> 136 | [] 137 | x :: xs -> 138 | if not <| predicate x then 139 | x :: takeUpTo predicate xs 140 | else 141 | [ x ] 142 | --------------------------------------------------------------------------------