git.iko.soy/typeable/elm-ui
on be0eaaa help sign in
typeable/elm-ui/tests-rendering/src/Testable/Runner.elm
470 lines 13 kB history raw
1port module Testable.Runner exposing (TestableProgram, program, show)
3{-| -}
5import Browser
6import Char
7import Dict exposing (Dict)
8import Element
9import Element.Background as Background
10import Element.Border as Border
11import Element.Font as Font
12import Html exposing (Html)
13import Parser exposing ((|.), (|=))
14import Process
15import Random
16import Set
17import Task
18import Test.Runner
19import Test.Runner.Failure as Failure
20import Testable
21import Time
24show : Testable.Element msg -> Html msg
25show =
26 Testable.render
29type alias TestableProgram =
30 Program () (Model Msg) Msg
33palette =
34 { white = Element.rgb 1 1 1
35 , red = Element.rgb 1 0 0
36 , green = Element.rgb 0 1 0
37 , black = Element.rgb 0 0 0
38 , lightGrey = Element.rgb 0.7 0.7 0.7
39 }
42program : List ( String, Testable.Element Msg ) -> TestableProgram
43program tests =
44 let
45 ( current, upcoming ) =
46 case tests of
47 [] ->
48 ( Nothing, [] )
50 cur :: remaining ->
51 ( Just cur, remaining )
52 in
53 Browser.document
54 { init =
55 always
56 ( { current = current
57 , upcoming = upcoming
58 , finished = []
59 }
60 , Task.perform (always Analyze)
61 (Process.sleep 32
62 |> Task.andThen
63 (always Time.now)
64 )
65 )
66 , view = view
67 , update = update
68 , subscriptions = subscriptions
69 }
72subscriptions : Model Msg -> Sub Msg
73subscriptions model =
74 Sub.batch
75 [ styles RefreshBoundingBox
76 ]
79type alias Model msg =
80 { current : Maybe ( String, Testable.Element msg )
81 , upcoming : List ( String, Testable.Element msg )
82 , finished : List (WithResults (Testable.Element msg))
83 }
86type alias WithResults thing =
87 { element : thing
88 , label : String
89 , results :
90 List
91 ( String
92 , Maybe
93 { given : Maybe String
94 , description : String
95 , reason : Failure.Reason
96 }
97 )
98 }
101prepareResults :
102 List (WithResults (Testable.Element msg))
103 ->
104 List
105 { label : String
106 , results :
107 List
108 ( String
109 , Maybe
110 { given : Maybe String
111 , description : String
112 }
113 )
114 }
115prepareResults withResults =
116 let
117 prepareNode ( x, maybeResult ) =
118 ( x
119 , case maybeResult of
120 Nothing ->
121 Nothing
123 Just res ->
124 Just
125 { given = res.given
126 , description = res.description
127 }
128 )
130 prepare { label, results } =
131 { label = label
132 , results = List.map prepareNode results
133 }
134 in
135 List.map prepare withResults
138type Msg
139 = NoOp
140 | Analyze
141 | RefreshBoundingBox
142 (List
143 { id : String
144 , bbox : Testable.BoundingBox
145 , isVisible : Bool
146 , style : List ( String, String )
147 }
148 )
151runTest : Dict String Testable.Found -> String -> Testable.Element msg -> WithResults (Testable.Element msg)
152runTest boxes label element =
153 let
154 tests =
155 Testable.toTest label boxes element
157 seed =
158 Random.initialSeed 227852860
160 results =
161 Testable.runTests seed tests
162 in
163 { element = element
164 , label = label
165 , results = results
166 }
169update : Msg -> Model Msg -> ( Model Msg, Cmd Msg )
170update msg model =
171 case msg of
172 NoOp ->
173 ( model, Cmd.none )
175 RefreshBoundingBox boxes ->
176 case model.current of
177 Nothing ->
178 ( model
179 , Cmd.none
180 )
182 Just ( label, current ) ->
183 let
184 toTuple box =
185 ( box.id
186 , { style = Dict.fromList box.style
187 , bbox = box.bbox
188 , isVisible = box.isVisible
189 }
190 )
192 foundData =
193 boxes
194 |> List.map toTuple
195 |> Dict.fromList
197 currentResults =
198 runTest foundData label current
199 in
200 case model.upcoming of
201 [] ->
202 ( { model
203 | current = Nothing
204 , finished = model.finished ++ [ currentResults ]
205 }
206 , report (prepareResults (currentResults :: model.finished))
207 )
209 newCurrent :: remaining ->
210 ( { model
211 | finished = model.finished ++ [ currentResults ]
212 , current = Just newCurrent
213 , upcoming = remaining
214 }
215 , Task.perform (always Analyze)
216 (Process.sleep 32
217 |> Task.andThen
218 (always Time.now)
219 )
220 )
222 Analyze ->
223 case model.current of
224 Nothing ->
225 ( model
226 , Cmd.none
227 )
229 Just ( label, current ) ->
230 ( model
231 , analyze (Testable.getIds current)
232 )
235view : Model Msg -> Browser.Document Msg
236view model =
237 case model.current of
238 Nothing ->
239 if List.isEmpty model.upcoming then
240 { title = "tests finished"
241 , body =
242 [ case model.finished of
243 [] ->
244 Element.layout [] <|
245 Element.column
246 [ Element.spacing 20
247 , Element.padding 20
248 , Element.width (Element.px 800)
250 -- , Background.color Color.grey
251 ]
252 [ Element.none ]
254 finished :: remaining ->
255 if False then
256 viewResultsInline finished
258 else
259 Element.layout [] <|
260 Element.column
261 [ Element.spacing 20
262 , Element.padding 20
263 , Element.width (Element.px 800)
264 ]
265 (List.map viewResult (finished :: remaining))
266 ]
267 }
269 else
270 { title = "tests finished"
271 , body = []
272 }
274 Just ( label, current ) ->
275 { title = "running"
276 , body =
277 [ Testable.render current ]
278 }
281viewResultsInline : WithResults (Testable.Element Msg) -> Html Msg
282viewResultsInline testable =
283 Html.div
284 []
285 [ viewResultsAnnotationStylesheet testable.results
286 , Testable.render testable.element
287 ]
290{-| Our ID is part of our label. This could be fixed farther down the chain, but I think it'd be pretty involved.
292So, now we can just parse the id out of the label.
294-}
295parseId str =
296 str
297 |> Parser.run
298 (Parser.succeed identity
299 |. Parser.chompWhile (\c -> c /= '#')
300 |= Parser.variable
301 { start = \c -> c == '#'
302 , inner = \c -> Char.isAlphaNum c || c == '-'
303 , reserved = Set.empty
304 }
305 )
306 |> Result.toMaybe
309viewResultsAnnotationStylesheet results =
310 let
311 toStyleClass ( label, maybeFailure ) =
312 case maybeFailure of
313 Nothing ->
314 ""
316 Just failure ->
317 case parseId label of
318 Nothing ->
319 Debug.log "NO ID FOUND" label
321 Just id ->
322 id ++ " { background-color:red; outline: dashed; };"
324 styleSheet =
325 results
326 |> List.map toStyleClass
327 |> String.join ""
328 in
329 Html.node "style"
330 []
331 [ Html.text styleSheet
332 ]
335viewResult : WithResults (Testable.Element Msg) -> Element.Element Msg
336viewResult testable =
337 let
338 isPassing result =
339 case Tuple.second result of
340 Nothing ->
341 True
343 Just _ ->
344 False
346 ( passing, failing ) =
347 List.partition isPassing testable.results
349 viewSingle result =
350 case result of
351 ( label, Nothing ) ->
352 Element.el
353 [ Background.color palette.green
354 , Font.color palette.black
355 , Element.paddingXY 20 10
356 , Element.alignLeft
357 , Border.rounded 3
358 ]
359 <|
360 Element.text ("Success! - " ++ label)
362 ( label, Just ({ given, description } as reason) ) ->
363 Element.column
364 [ Background.color palette.red
365 , Font.color palette.black
366 , Element.paddingXY 20 10
367 , Element.alignLeft
368 , Element.width Element.shrink
370 -- , Element.spacing 25
371 , Border.rounded 3
372 ]
373 [ Element.el [ Element.width Element.fill ] <| Element.text label
374 , Element.el [ Element.width Element.fill ] <| Element.text (viewReason reason)
375 ]
376 in
377 Element.column
378 [ Border.width 1
379 , Border.color palette.lightGrey
380 , Element.padding 20
381 , Element.height Element.shrink
382 , Element.alignLeft
383 , Element.spacing 16
384 ]
385 [ Element.el [ Font.bold, Font.size 64 ] (Element.text testable.label)
386 , Element.column [ Element.alignLeft, Element.spacing 20 ]
387 (failing
388 |> List.map viewSingle
389 )
390 , Element.el
391 [ Element.alignLeft
392 , Element.spacing 20
393 , Background.color palette.green
394 , Font.color palette.black
395 , Element.paddingXY 20 10
396 , Element.alignLeft
397 , Border.rounded 3
398 ]
399 (Element.text (String.fromInt (List.length passing) ++ " tests passing!"))
400 ]
403viewReason { description, reason } =
404 case reason of
405 Failure.Custom ->
406 description
408 Failure.Equality one two ->
409 description ++ " " ++ one ++ " " ++ two
411 Failure.Comparison one two ->
412 description ++ " " ++ one ++ " " ++ two
414 Failure.ListDiff expected actual ->
415 "expected\n"
416 ++ String.join " \n" expected
417 ++ "actual\n"
418 ++ String.join " \n" actual
420 Failure.CollectionDiff { expected, actual, extra, missing } ->
421 String.join "\n"
422 [ formatKeyValue "expected" expected
423 , formatKeyValue "actual" actual
424 , formatKeyValue "extra" (String.join ", " extra)
425 , formatKeyValue "missing" (String.join ", " missing)
426 ]
428 Failure.TODO ->
429 description
431 Failure.Invalid _ ->
432 description
435formatKeyValue : String -> String -> String
436formatKeyValue key val =
437 key ++ ": " ++ val
440port report :
441 List
442 { label : String
443 , results :
444 List
445 ( String
446 , Maybe
447 { given : Maybe String
448 , description : String
449 }
450 )
451 }
452 -> Cmd msg
455port test : String -> Cmd msg
458port analyze : List String -> Cmd msg
461port styles :
462 (List
463 { id : String
464 , bbox : Testable.BoundingBox
465 , style : List ( String, String )
466 , isVisible : Bool
467 }
468 -> msg
469 )
470 -> Sub msg