git.iko.soy/typeable/elm-ui
on 2c582df help sign in
typeable/elm-ui/tests-rendering/src/Testable/Runner.elm
565 lines 16 kB history raw
1port module Testable.Runner exposing (Msg, TestableProgram, program, show)
3{-| -}
5import Browser
6import Dict exposing (Dict)
7import Element
8import Element.Background as Background
9import Element.Border as Border
10import Element.Events as Events
11import Element.Font as Font
12import Html exposing (Html)
13import Html.Attributes
14import Process
15import Task
16import Testable
17import Time
20show : Testable.Element msg -> Html msg
21show =
22 Testable.toHtml
25type alias TestableProgram =
26 Program () (Model Msg) Msg
29palette =
30 { white = Element.rgb 1 1 1
31 , red = Element.rgb 1 0 0
32 , green = Element.rgb 0 1 0
33 , black = Element.rgb 0 0 0
34 , lightGrey = Element.rgb 0.7 0.7 0.7
35 }
38program : List ( String, Testable.Element Msg ) -> TestableProgram
39program tests =
40 let
41 ( current, upcoming ) =
42 case tests of
43 [] ->
44 ( Nothing, [] )
46 cur :: remaining ->
47 ( Just cur, remaining )
48 in
49 Browser.element
50 { init =
51 always
52 ( { current = current
53 , upcoming = upcoming
54 , finished = []
55 , selected = 0
56 , highlightDomId = Nothing
57 }
58 , Task.perform (always Analyze)
59 (Process.sleep 64
60 |> Task.andThen
61 (always Time.now)
62 )
63 )
64 , view = view
65 , update = update
66 , subscriptions = subscriptions
67 }
70subscriptions : Model Msg -> Sub Msg
71subscriptions model =
72 Sub.batch
73 [ styles RefreshBoundingBox
74 ]
77type alias Model msg =
78 { current : Maybe ( String, Testable.Element msg )
79 , upcoming : List ( String, Testable.Element msg )
80 , finished : List (WithResults (Testable.Element msg))
81 , selected : Int
82 , highlightDomId : Maybe String
83 }
86type alias WithResults thing =
87 { element : thing
88 , label : String
89 , results :
90 List Testable.LayoutTest
91 }
94encodeForReport :
95 List (WithResults (Testable.Element msg))
96 ->
97 List
98 { label : String
99 , results :
100 List
101 { description : String
102 , passing : Bool
103 , todo : Bool
104 }
105 }
106encodeForReport withResults =
107 let
108 prepareExpectation layoutTest exp =
109 case exp of
110 Testable.Todo description ->
111 { description = description
112 , passing = False
113 , todo = True
114 }
116 Testable.Expect details ->
117 { description = details.description
118 , passing = details.result
119 , todo = False
120 }
122 prepareNode layoutTest =
123 List.map (prepareExpectation layoutTest) layoutTest.expectations
125 prepare { label, results } =
126 { label = label
127 , results = List.concatMap prepareNode results
128 }
129 in
130 List.map prepare withResults
133type Msg
134 = NoOp
135 | Analyze
136 | Select Int
137 | HighlightDomID (Maybe String)
138 | RefreshBoundingBox
139 (List
140 { id : String
141 , bbox : Testable.BoundingBox
142 , style : List ( String, String )
143 , isVisible : Bool
144 , textMetrics : List Testable.TextMetrics
145 }
146 )
149runTest : Dict String Testable.Found -> String -> Testable.Element msg -> WithResults (Testable.Element msg)
150runTest boxes label element =
151 let
152 results =
153 Testable.runTests boxes element
154 in
155 { element = element
156 , label = label
157 , results = results
158 }
161update : Msg -> Model Msg -> ( Model Msg, Cmd Msg )
162update msg model =
163 case msg of
164 NoOp ->
165 ( model, Cmd.none )
167 HighlightDomID newId ->
168 ( { model | highlightDomId = newId }
169 , Cmd.none
170 )
172 Select index ->
173 ( { model | selected = index }
174 , Cmd.none
175 )
177 RefreshBoundingBox boxes ->
178 case model.current of
179 Nothing ->
180 ( model
181 , Cmd.none
182 )
184 Just ( label, current ) ->
185 let
186 toTuple box =
187 ( box.id
188 , { style = Dict.fromList box.style
189 , bbox = box.bbox
190 , isVisible = box.isVisible
191 , textMetrics = box.textMetrics
192 }
193 )
195 foundData =
196 boxes
197 |> List.map toTuple
198 |> Dict.fromList
200 currentResults =
201 runTest foundData label current
202 in
203 case model.upcoming of
204 [] ->
205 ( { model
206 | current = Nothing
207 , finished = model.finished ++ [ currentResults ]
208 }
209 , report (encodeForReport (currentResults :: model.finished))
210 )
212 newCurrent :: remaining ->
213 ( { model
214 | finished = model.finished ++ [ currentResults ]
215 , current = Just newCurrent
216 , upcoming = remaining
217 }
218 , Task.perform (always Analyze)
219 (Process.sleep 64
220 |> Task.andThen
221 (always Time.now)
222 )
223 )
225 Analyze ->
226 case model.current of
227 Nothing ->
228 ( model
229 , Cmd.none
230 )
232 Just ( label, current ) ->
233 ( model
234 , analyze (Testable.getIds current)
235 )
238view : Model Msg -> Html.Html Msg
239view model =
240 case model.current of
241 Nothing ->
242 if List.isEmpty model.upcoming then
243 let
244 selected =
245 getByIndex model.selected model.finished
247 -- |> Debug.log "selected"
248 in
249 Element.layout
250 [ Font.size 16
251 , Element.inFront (Element.html (viewElementHighlight model))
252 , Element.height Element.fill
253 ]
254 <|
255 Element.row [ Element.width Element.fill, Element.height Element.fill ]
256 [ Element.el
257 [ Element.width
258 (Element.fill
259 |> Element.maximum 900
260 )
261 , Element.alignTop
262 , Element.height Element.fill
263 , Element.scrollbars
264 ]
265 (Element.el
266 [ Element.centerX
267 , Element.padding 100
268 , Border.dashed
269 , Border.width 2
270 , Border.color palette.lightGrey
271 , Font.size 20
272 , Element.inFront
273 (Element.el
274 [ Font.size 14
275 , Font.color palette.lightGrey
276 ]
277 (Element.text "test case")
278 )
279 ]
280 (case selected of
281 Nothing ->
282 Element.text "nothing selected"
284 Just sel ->
285 Testable.toElement sel.element
286 )
287 )
288 , Element.column
289 [ Element.spacing 20
290 , Element.padding 20
291 , Element.width Element.fill
292 , Element.height Element.fill
293 , Element.scrollbarY
294 ]
295 (List.indexedMap (viewResult model.selected) model.finished)
296 ]
298 else
299 Html.text ""
301 Just ( label, current ) ->
302 Testable.toHtml current
305getByIndex i ls =
306 List.foldl
307 (\elem ( index, found ) ->
308 if i == index then
309 ( index + 1, Just elem )
311 else
312 ( index + 1, found )
313 )
314 ( 0, Nothing )
315 ls
316 |> Tuple.second
319viewElementHighlight model =
320 case model.highlightDomId of
321 Nothing ->
322 Html.text ""
324 Just highlightDomId ->
325 let
326 elementHighlight =
327 highlightDomId ++ " { outline: solid black; }"
329 testId =
330 highlightDomId
331 |> String.dropLeft 1
332 |> String.append "#tests-"
334 testHighlight =
335 testId ++ " { outline: dashed black; }"
337 styleSheet =
338 String.join "\n"
339 [ elementHighlight
340 , testHighlight
341 ]
342 in
343 Html.node "style"
344 []
345 [ Html.text styleSheet
346 ]
349viewResult : Int -> Int -> WithResults (Testable.Element Msg) -> Element.Element Msg
350viewResult selectedIndex index testable =
351 if index == selectedIndex then
352 Element.column
353 [ Element.alignLeft
354 , Element.spacing 16
355 ]
356 [ Element.el [ Font.size 24 ] (Element.text testable.label)
357 , Element.column
358 [ Element.alignLeft, Element.spacing 16 ]
359 (testable.results
360 |> groupBy .elementDomId
361 |> List.map (expandDetails >> viewLayoutTestGroup)
362 )
363 ]
365 else
366 let
367 isExpectationPassing result =
368 case result of
369 Testable.Todo label ->
370 True
372 Testable.Expect details ->
373 details.result
375 isPassing layoutTest =
376 List.all isExpectationPassing layoutTest.expectations
378 ( passing, failing ) =
379 List.partition isPassing testable.results
380 in
381 Element.column
382 [ Element.alignLeft
383 , Element.spacing 16
384 , Element.pointer
385 , Events.onClick (Select index)
386 ]
387 [ Element.row [ Element.spacing 16 ]
388 [ Element.el [ Font.size 24 ] (Element.text testable.label)
389 , Element.text (String.fromInt (List.length passing) ++ " passing")
390 , let
391 failingCount =
392 List.length failing
393 in
394 if failingCount == 0 then
395 Element.none
397 else
398 Element.text (String.fromInt (List.length failing) ++ " failing")
399 ]
400 ]
403expandDetails group =
404 case group.members of
405 [] ->
406 { id = group.id
407 , elementType = Testable.EmptyType
408 , members = group.members
409 }
411 top :: _ ->
412 { id = group.id
413 , elementType = top.elementType
414 , members = group.members
415 }
418groupBy fn list =
419 groupWhile (\one two -> fn one == fn two) list
420 |> List.map
421 (\( fst, remaining ) ->
422 { id = fn fst
423 , members = fst :: remaining
424 }
425 )
428groupWhile : (a -> a -> Bool) -> List a -> List ( a, List a )
429groupWhile isSameGroup items =
430 List.foldr
431 (\x acc ->
432 case acc of
433 [] ->
434 [ ( x, [] ) ]
436 ( y, restOfGroup ) :: groups ->
437 if isSameGroup x y then
438 ( x, y :: restOfGroup ) :: groups
440 else
441 ( x, [] ) :: acc
442 )
443 []
444 items
447viewLayoutTestGroup group =
448 let
449 testId =
450 group.id
451 |> String.dropLeft 1
452 |> String.append "tests-"
453 in
454 Element.column
455 [ Element.spacing 8
456 , Element.htmlAttribute (Html.Attributes.id testId)
457 , Events.onMouseEnter (HighlightDomID (Just group.id))
458 , Events.onMouseLeave (HighlightDomID Nothing)
459 , Element.htmlAttribute (Html.Attributes.style "user-select" "none")
460 ]
461 [ Element.row [ Element.spacing 16 ]
462 [ Element.el [] (Element.text (Testable.elementTypeToString group.elementType))
463 , Element.el [ Font.color palette.lightGrey ] (Element.text group.id)
464 ]
465 , Element.column
466 [ Element.spacing 8
467 , Element.paddingXY 32 0
468 ]
469 (List.map viewLayoutTest group.members)
470 ]
473type alias Grouped thing =
474 { id : String
475 , members : List thing
476 }
479viewLayoutTest layoutTest =
480 Element.column
481 [ Element.spacing 8
482 ]
483 [ Element.row [ Element.spacing 8 ]
484 [ Element.el [ Font.bold ] (Element.text layoutTest.label)
486 -- , Element.el [ Font.color palette.lightGrey ] (Element.text layoutTest.elementDomId)
487 ]
488 , Element.column [ Element.spacing 8 ]
489 (List.map viewLayoutExpectation layoutTest.expectations)
490 ]
493viewLayoutExpectation expectation =
494 case expectation of
495 Testable.Todo label ->
496 Element.row [ Element.spacing 4 ]
497 [ todo, Element.text label ]
499 Testable.Expect details ->
500 if details.result then
501 Element.row [ Element.spacing 4 ]
502 [ pass, Element.text details.description ]
504 else
505 Element.row [ Element.spacing 4 ]
506 [ fail, Element.text details.description ]
509badge color text =
510 Element.el
511 [ Background.color color
512 , Font.color palette.black
513 , Element.paddingXY 4 8
514 , Border.rounded 2
515 ]
516 (Element.text text)
519todo =
520 badge palette.lightGrey "todo"
523pass =
524 badge palette.green "pass"
527fail =
528 badge palette.red "fail"
531formatKeyValue : String -> String -> String
532formatKeyValue key val =
533 key ++ ": " ++ val
536port report :
537 List
538 { label : String
539 , results :
540 List
541 { description : String
542 , passing : Bool
543 , todo : Bool
544 }
545 }
546 -> Cmd msg
549port test : String -> Cmd msg
552port analyze : List String -> Cmd msg
555port styles :
556 (List
557 { id : String
558 , bbox : Testable.BoundingBox
559 , style : List ( String, String )
560 , isVisible : Bool
561 , textMetrics : List Testable.TextMetrics
562 }
563 -> msg
564 )
565 -> Sub msg