Add ProgramTest.getViewHtml and ProgramTest.getModel for use with other testing workflows like snapshots.

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

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 "<div class=\"counter\">..."
+        -- 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.
 

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

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
         ]

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"

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