diff --git a/CHANGELOG.md b/CHANGELOG.md
index 92ae989..801abbe 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,11 @@
+## 4.1.0
+
+New features:
+
+ - Added `ProgramTest.getViewHtml` for extracting the rendered view HTML as a string
+ - Added `ProgramTest.getModel` for extracting the current model value
+
+
## 4.0.0
- Upgrade to elm-explorations/test 2.0.0
diff --git a/src/ProgramTest.elm b/src/ProgramTest.elm
index 92d8d19..b280b26 100644
--- a/src/ProgramTest.elm
+++ b/src/ProgramTest.elm
@@ -28,6 +28,7 @@ module ProgramTest exposing
, simulateLastEffect
, fail, createFailed
, getOutgoingPortValues
+ , getViewHtml, getModel
, elmMajorVersionHack_4
)
@@ -196,6 +197,15 @@ These functions may be useful if you are writing your own custom assertion funct
@docs getOutgoingPortValues
+## Extracting values
+
+These functions extract the current view or model from a `ProgramTest` as values.
+They are intended for tooling authors building snapshot testing or other custom
+test workflows.
+
+@docs getViewHtml, getModel
+
+
# Elm language workaround
@docs elmMajorVersionHack_4
@@ -215,7 +225,11 @@ import MultiDict
import ProgramTest.ComplexQuery as ComplexQuery exposing (ComplexQuery)
import ProgramTest.EffectSimulation as EffectSimulation exposing (EffectSimulation)
import ProgramTest.Failure as Failure exposing (Failure(..))
+import ProgramTest.HtmlHighlighter as HtmlHighlighter
+import ProgramTest.HtmlRenderer as HtmlRenderer
import ProgramTest.Program as Program exposing (Program)
+import ProgramTest.TestHtmlHacks as TestHtmlHacks
+import ProgramTest.TestHtmlParser exposing (FailureReport(..), Step(..))
import Result.Extra
import SimulatedEffect exposing (SimulatedEffect, SimulatedSub, SimulatedTask)
import String.Extra
@@ -1923,6 +1937,123 @@ expectModel assertion =
>> done
+{-| Get the rendered HTML of the current view (or a portion of it) as a String.
+
+The first argument is a list of
+[`Test.Html.Selector`](https://package.elm-lang.org/packages/elm-explorations/test/latest/Test-Html-Selector)s
+to narrow down to a specific element. Use `[]` to get the full view HTML.
+
+This is useful for tooling authors building snapshot testing or other custom
+test workflows where you need the rendered output as a value rather than
+making specific assertions about the view structure.
+
+ ProgramTest.createSandbox
+ { init = CounterApp.init
+ , update = CounterApp.update
+ , view = CounterApp.view
+ }
+ |> ProgramTest.start ()
+ |> ProgramTest.clickButton "+"
+ |> ProgramTest.getViewHtml []
+ --> Ok "
..."
+ -- Or narrow down to a specific element:
+ |> ProgramTest.getViewHtml [ Selector.id "main-content" ]
+
+Returns `Err` with a description of the failure if the `ProgramTest` has
+already entered a failure state, or if the selectors match zero or more than
+one element.
+
+-}
+getViewHtml : List Selector -> ProgramTest model msg effect -> Result String String
+getViewHtml selectors programTest =
+ case programTest of
+ Created created ->
+ case created.state of
+ Ok state ->
+ let
+ querySingle =
+ Program.renderView created.program state.currentModel
+
+ targetQuery =
+ if List.isEmpty selectors then
+ querySingle
+
+ else
+ querySingle |> Query.find selectors
+ in
+ case targetQuery |> Query.has [] |> Test.Runner.getFailureReason of
+ Just reason ->
+ Err ("getViewHtml: " ++ reason.description)
+
+ Nothing ->
+ case TestHtmlHacks.forceFailureReport [] targetQuery of
+ Ok (QueryFailure rootNode steps _) ->
+ let
+ node =
+ case List.reverse steps of
+ (FindStep narrowedNode) :: _ ->
+ narrowedNode
+
+ [] ->
+ rootNode
+
+ highlighted =
+ HtmlHighlighter.highlight (\_ _ _ -> True) node
+ in
+ Ok (HtmlRenderer.render identity 0 [ highlighted ] |> String.trimRight)
+
+ Ok (EventFailure _ _) ->
+ Err "getViewHtml: unexpected internal error (EventFailure)"
+
+ Err err ->
+ Err ("getViewHtml: could not parse view HTML: " ++ err)
+
+ Err failure ->
+ Err (Failure.toString failure.reason)
+
+ FailedToCreate failure ->
+ Err (Failure.toString failure)
+
+
+{-| Get the current model from a `ProgramTest`.
+
+When possible, you should prefer making assertions about the rendered view
+(see [`expectView`](#expectView)) or external requests made by your program,
+as testing at the level that users interact with your program makes tests
+more resilient to implementation changes.
+
+However, this can be useful for tooling authors building snapshot testing
+or other custom test workflows:
+
+ ProgramTest.createSandbox
+ { init = App.init
+ , update = App.update
+ , view = App.view
+ }
+ |> ProgramTest.start ()
+ |> ProgramTest.clickButton "Submit"
+ |> ProgramTest.getModel
+ --> Ok { submitted = True, ... }
+
+Returns `Err` with a description of the failure if the `ProgramTest` has
+already entered a failure state.
+
+-}
+getModel : ProgramTest model msg effect -> Result String model
+getModel programTest =
+ case programTest of
+ Created created ->
+ case created.state of
+ Ok state ->
+ Ok state.currentModel
+
+ Err failure ->
+ Err (Failure.toString failure.reason)
+
+ FailedToCreate failure ->
+ Err (Failure.toString failure)
+
+
{-| Simulate the outcome of the last effect produced by the program being tested
by providing a function that can convert the last effect into `msg`s.
diff --git a/src/ProgramTest/TestHtmlHacks.elm b/src/ProgramTest/TestHtmlHacks.elm
index c3f2a07..9a8f263 100644
--- a/src/ProgramTest/TestHtmlHacks.elm
+++ b/src/ProgramTest/TestHtmlHacks.elm
@@ -1,4 +1,4 @@
-module ProgramTest.TestHtmlHacks exposing (getPassingSelectors, parseFailureReport, parseFailureReportWithoutHtml, parseSimulateFailure, renderHtml)
+module ProgramTest.TestHtmlHacks exposing (forceFailureReport, getPassingSelectors, parseFailureReport, parseFailureReportWithoutHtml, parseSimulateFailure, renderHtml)
import Html.Parser
import Parser
diff --git a/src/ProgramTest/TestHtmlParser.elm b/src/ProgramTest/TestHtmlParser.elm
index 8cf3a24..631e994 100644
--- a/src/ProgramTest/TestHtmlParser.elm
+++ b/src/ProgramTest/TestHtmlParser.elm
@@ -12,7 +12,7 @@ type FailureReport html
type Step html
- = FindStep (List Selector) html
+ = FindStep html
type Selector
@@ -88,7 +88,7 @@ stepParser parseHtml =
Parser.oneOf
[ Parser.succeed FindStep
|. Parser.keyword "▼ Query.find "
- |= selectorsParser
+ |. Parser.chompUntil "\n"
|. Parser.symbol "\n\n 1) "
|= parseHtml
]
diff --git a/tests/ProgramTest/TestHtmlHacksTest.elm b/tests/ProgramTest/TestHtmlHacksTest.elm
index 26613f4..06d249a 100644
--- a/tests/ProgramTest/TestHtmlHacksTest.elm
+++ b/tests/ProgramTest/TestHtmlHacksTest.elm
@@ -144,9 +144,6 @@ all =
|> Expect.equal
(Ok
[ FindStep
- [ Tag "label"
- , Containing [ TestHtmlParser.Text "Field 1" ]
- ]
(Element "label"
[]
[ Html.Parser.Text "Field 1"
diff --git a/tests/ProgramTestTests/GetModelTest.elm b/tests/ProgramTestTests/GetModelTest.elm
new file mode 100644
index 0000000..003ef35
--- /dev/null
+++ b/tests/ProgramTestTests/GetModelTest.elm
@@ -0,0 +1,107 @@
+module ProgramTestTests.GetModelTest exposing (all)
+
+import Expect
+import Html
+import Html.Events exposing (onClick)
+import ProgramTest exposing (ProgramTest)
+import Test exposing (..)
+
+
+type alias Model =
+ { count : Int
+ , label : String
+ }
+
+
+type Msg
+ = Increment
+ | SetLabel String
+
+
+start : ProgramTest Model Msg ()
+start =
+ ProgramTest.createSandbox
+ { init = { count = 0, label = "initial" }
+ , update =
+ \msg model ->
+ case msg of
+ Increment ->
+ { model | count = model.count + 1 }
+
+ SetLabel s ->
+ { model | label = s }
+ , view =
+ \model ->
+ Html.div []
+ [ Html.span [] [ Html.text (String.fromInt model.count) ]
+ , Html.button [ onClick Increment ] [ Html.text "+" ]
+ ]
+ }
+ |> ProgramTest.start ()
+
+
+all : Test
+all =
+ describe "getModel"
+ [ test "returns the initial model" <|
+ \() ->
+ start
+ |> ProgramTest.getModel
+ |> Expect.equal (Ok { count = 0, label = "initial" })
+ , test "returns the model after interactions" <|
+ \() ->
+ start
+ |> ProgramTest.clickButton "+"
+ |> ProgramTest.clickButton "+"
+ |> ProgramTest.clickButton "+"
+ |> ProgramTest.getModel
+ |> Result.map .count
+ |> Expect.equal (Ok 3)
+ , test "returns Err when the ProgramTest is in a failed state" <|
+ \() ->
+ start
+ |> ProgramTest.clickButton "nonexistent button"
+ |> ProgramTest.getModel
+ |> isErr
+ |> Expect.equal True
+ , test "error message describes the original failure" <|
+ \() ->
+ start
+ |> ProgramTest.clickButton "nonexistent button"
+ |> ProgramTest.getModel
+ |> Result.mapError (String.contains "nonexistent button")
+ |> Expect.equal (Err True)
+ , test "returns Err for a program that failed to create" <|
+ \() ->
+ ProgramTest.createFailed "setup" "bad config"
+ |> ProgramTest.getModel
+ |> isErr
+ |> Expect.equal True
+ , test "returns the model after update" <|
+ \() ->
+ start
+ |> ProgramTest.update (SetLabel "updated")
+ |> ProgramTest.getModel
+ |> Result.map .label
+ |> Expect.equal (Ok "updated")
+ , test "returns the model from a worker program" <|
+ \() ->
+ ProgramTest.createWorker
+ { init = \() -> ( "worker-init", () )
+ , update = \msg model -> ( model ++ ";" ++ msg, () )
+ }
+ |> ProgramTest.start ()
+ |> ProgramTest.update "hello"
+ |> ProgramTest.getModel
+ |> Expect.equal (Ok "worker-init;hello")
+ ]
+
+
+isErr : Result a b -> Bool
+isErr result =
+ case result of
+ Err _ ->
+ True
+
+ Ok _ ->
+ False
diff --git a/tests/ProgramTestTests/GetViewHtmlTest.elm b/tests/ProgramTestTests/GetViewHtmlTest.elm
new file mode 100644
index 0000000..45c6496
--- /dev/null
+++ b/tests/ProgramTestTests/GetViewHtmlTest.elm
@@ -0,0 +1,210 @@
+module ProgramTestTests.GetViewHtmlTest exposing (all)
+
+import Expect exposing (Expectation)
+import Html
+import Html.Attributes exposing (class, id)
+import Html.Events exposing (onClick)
+import ProgramTest exposing (ProgramTest)
+import Test exposing (..)
+import Test.Html.Selector as Selector
+
+
+type alias Model =
+ { count : Int }
+
+
+type Msg
+ = Increment
+ | Decrement
+
+
+start : ProgramTest Model Msg ()
+start =
+ ProgramTest.createSandbox
+ { init = { count = 0 }
+ , update =
+ \msg model ->
+ case msg of
+ Increment ->
+ { model | count = model.count + 1 }
+
+ Decrement ->
+ { model | count = model.count - 1 }
+ , view =
+ \model ->
+ Html.div [ class "counter" ]
+ [ Html.button [ onClick Decrement ] [ Html.text "-" ]
+ , Html.span [] [ Html.text (String.fromInt model.count) ]
+ , Html.button [ onClick Increment ] [ Html.text "+" ]
+ ]
+ }
+ |> ProgramTest.start ()
+
+
+all : Test
+all =
+ describe "getViewHtml"
+ [ describe "with empty selector list (full view)"
+ [ test "returns the rendered HTML of the initial view" <|
+ \() ->
+ start
+ |> ProgramTest.getViewHtml []
+ |> expectOkHtml """
+
+
+
+ 0
+
+
+
+"""
+ , test "returns the rendered HTML after interactions" <|
+ \() ->
+ start
+ |> ProgramTest.clickButton "+"
+ |> ProgramTest.clickButton "+"
+ |> ProgramTest.clickButton "+"
+ |> ProgramTest.getViewHtml []
+ |> Result.map (String.contains "3")
+ |> Expect.equal (Ok True)
+ , test "returns Err when the ProgramTest is in a failed state" <|
+ \() ->
+ start
+ |> ProgramTest.clickButton "nonexistent button"
+ |> ProgramTest.getViewHtml []
+ |> isErr
+ |> Expect.equal True
+ , test "error message describes the original failure" <|
+ \() ->
+ start
+ |> ProgramTest.clickButton "nonexistent button"
+ |> ProgramTest.getViewHtml []
+ |> Result.mapError (String.contains "nonexistent button")
+ |> Expect.equal (Err True)
+ , test "returns Err for a program that failed to create" <|
+ \() ->
+ ProgramTest.createFailed "setup" "bad config"
+ |> ProgramTest.getViewHtml []
+ |> isErr
+ |> Expect.equal True
+ , test "works with a simple view" <|
+ \() ->
+ ProgramTest.createSandbox
+ { init = ()
+ , update = \() () -> ()
+ , view = \() -> Html.p [] [ Html.text "hello" ]
+ }
+ |> ProgramTest.start ()
+ |> ProgramTest.getViewHtml []
+ |> expectOkHtml """
+