git.iko.soy/typeable/elm-ui
on d5c8a94 help sign in
typeable/elm-ui/tests-rendering/src/Testable/Runner.elm
607 lines 16 kB history raw
1port module Testable.Runner exposing
2 ( Msg
3 , Testable
4 , TestableProgram
5 , program
6 , rename
7 , show
8 , testable
9 )
11{-| -}
13import Browser
14import Dict exposing (Dict)
15import Element
16import Element.Background as Background
17import Element.Border as Border
18import Element.Events as Events
19import Element.Font as Font
20import Html exposing (Html)
21import Html.Attributes
22import Process
23import Task
24import Testable
25import Time
28show : Testable.Element msg -> Html msg
29show =
30 Testable.toHtml
33type alias TestableProgram =
34 Program () (Model Msg) Msg
37{-| This should be a real type, but I'm too busy atm.
38-}
39type alias Testable =
40 ( String, Testable.Element Msg )
43rename : String -> Testable -> Testable
44rename newName ( _, el ) =
45 ( newName, el )
48testable : String -> Testable.Element Msg -> Testable
49testable =
50 Tuple.pair
53palette =
54 { white = Element.rgb 1 1 1
55 , red = Element.rgb 1 0 0
56 , green = Element.rgb 0 1 0
57 , black = Element.rgb 0 0 0
58 , lightGrey = Element.rgb 0.7 0.7 0.7
59 }
62program : List Testable -> TestableProgram
63program tests =
64 let
65 ( current, upcoming ) =
66 case tests of
67 [] ->
68 ( Nothing, [] )
70 cur :: remaining ->
71 ( Just cur, remaining )
72 in
73 Browser.element
74 { init =
75 always
76 ( { current = current
77 , upcoming = upcoming
78 , finished = []
79 , selected = 0
80 , highlightDomId = Nothing
81 }
82 , Task.perform (always Analyze)
83 (Process.sleep 64
84 |> Task.andThen
85 (always Time.now)
86 )
87 )
88 , view = view
89 , update = update
90 , subscriptions = subscriptions
91 }
94subscriptions : Model Msg -> Sub Msg
95subscriptions model =
96 Sub.batch
97 [ styles RefreshBoundingBox
98 ]
101type alias Model msg =
102 { current : Maybe ( String, Testable.Element msg )
103 , upcoming : List ( String, Testable.Element msg )
104 , finished : List (WithResults (Testable.Element msg))
105 , selected : Int
106 , highlightDomId : Maybe String
107 }
110type alias WithResults thing =
111 { index : Int
112 , element : thing
113 , label : String
114 , results :
115 List Testable.LayoutTest
116 }
119encodeForReport :
120 List (WithResults (Testable.Element msg))
121 ->
122 List
123 { label : String
124 , results :
125 List
126 { description : String
127 , passing : Bool
128 , todo : Bool
129 }
130 }
131encodeForReport withResults =
132 let
133 prepareExpectation layoutTest exp =
134 case exp of
135 Testable.Todo description ->
136 { description = description
137 , passing = False
138 , todo = True
139 }
141 Testable.Expect details ->
142 { description = details.description
143 , passing = details.result
144 , todo = False
145 }
147 prepareNode layoutTest =
148 List.map (prepareExpectation layoutTest) layoutTest.expectations
150 prepare { label, results } =
151 { label = label
152 , results = List.concatMap prepareNode results
153 }
154 in
155 List.map prepare withResults
158type Msg
159 = NoOp
160 | Analyze
161 | Select Int
162 | HighlightDomID (Maybe String)
163 | RefreshBoundingBox
164 (List
165 { id : String
166 , bbox : Testable.BoundingBox
167 , style : List ( String, String )
168 , isVisible : Bool
169 , textMetrics : List Testable.TextMetrics
170 }
171 )
174runTest : Int -> Dict String Testable.Found -> String -> Testable.Element msg -> WithResults (Testable.Element msg)
175runTest index boxes label element =
176 let
177 results =
178 Testable.runTests boxes element
179 in
180 { index = index
181 , element = element
182 , label = label
183 , results = results
184 }
187update : Msg -> Model Msg -> ( Model Msg, Cmd Msg )
188update msg model =
189 case msg of
190 NoOp ->
191 ( model, Cmd.none )
193 HighlightDomID newId ->
194 ( { model | highlightDomId = newId }
195 , Cmd.none
196 )
198 Select index ->
199 ( { model | selected = index }
200 , Cmd.none
201 )
203 RefreshBoundingBox boxes ->
204 case model.current of
205 Nothing ->
206 ( model
207 , Cmd.none
208 )
210 Just ( label, current ) ->
211 let
212 toTuple box =
213 ( box.id
214 , { style = Dict.fromList box.style
215 , bbox = box.bbox
216 , isVisible = box.isVisible
217 , textMetrics = box.textMetrics
218 }
219 )
221 foundData =
222 boxes
223 |> List.map toTuple
224 |> Dict.fromList
226 currentResults =
227 runTest (List.length model.finished) foundData label current
228 in
229 case model.upcoming of
230 [] ->
231 ( { model
232 | current = Nothing
233 , finished = model.finished ++ [ currentResults ]
234 }
235 , report (encodeForReport (currentResults :: model.finished))
236 )
238 newCurrent :: remaining ->
239 ( { model
240 | finished = model.finished ++ [ currentResults ]
241 , current = Just newCurrent
242 , upcoming = remaining
243 }
244 , Task.perform (always Analyze)
245 (Process.sleep 64
246 |> Task.andThen
247 (always Time.now)
248 )
249 )
251 Analyze ->
252 case model.current of
253 Nothing ->
254 ( model
255 , Cmd.none
256 )
258 Just ( label, current ) ->
259 ( model
260 , analyze (Testable.getIds current)
261 )
264view : Model Msg -> Html.Html Msg
265view model =
266 case model.current of
267 Nothing ->
268 if List.isEmpty model.upcoming then
269 let
270 selected =
271 getByIndex model.selected model.finished
272 in
273 Element.layout
274 [ Font.size 16
275 , Element.inFront (Element.html (viewElementHighlight model))
276 , Element.height Element.fill
277 ]
278 <|
279 Element.row [ Element.width Element.fill, Element.height Element.fill ]
280 [ Element.el
281 [ Element.width
282 (Element.fill
283 |> Element.maximum 900
284 )
285 , Element.alignTop
286 , Element.height Element.fill
287 , Element.scrollbars
288 ]
289 (Element.el
290 [ Element.centerX
291 , Element.padding 100
292 , Border.dashed
293 , Border.width 2
294 , Border.color palette.lightGrey
295 , Font.size 20
296 , Element.inFront
297 (Element.el
298 [ Font.size 14
299 , Font.color palette.lightGrey
300 ]
301 (Element.text "test case")
302 )
303 ]
304 (case selected of
305 Nothing ->
306 Element.text "nothing selected"
308 Just sel ->
309 Testable.toElement sel.element
310 )
311 )
312 , Element.column
313 [ Element.spacing 20
314 , Element.padding 20
315 , Element.width Element.fill
316 , Element.height Element.fill
317 , Element.scrollbarY
318 ]
319 (model.finished
320 |> List.sortBy hasFailure
321 |> List.map (viewResult model.selected)
322 )
323 ]
325 else
326 Html.text ""
328 Just ( label, current ) ->
329 Testable.toHtml current
332getByIndex i ls =
333 List.foldl
334 (\elem ( index, found ) ->
335 if i == index then
336 ( index + 1, Just elem )
338 else
339 ( index + 1, found )
340 )
341 ( 0, Nothing )
342 ls
343 |> Tuple.second
346viewElementHighlight model =
347 case model.highlightDomId of
348 Nothing ->
349 Html.text ""
351 Just highlightDomId ->
352 let
353 elementHighlight =
354 highlightDomId ++ " { outline: solid black; }"
356 testId =
357 highlightDomId
358 |> String.dropLeft 1
359 |> String.append "#tests-"
361 testHighlight =
362 testId ++ " { outline: dashed black; }"
364 styleSheet =
365 String.join "\n"
366 [ elementHighlight
367 , testHighlight
368 ]
369 in
370 Html.node "style"
371 []
372 [ Html.text styleSheet
373 ]
376hasFailure : WithResults (Testable.Element Msg) -> Int
377hasFailure myTest =
378 if
379 List.any
380 (not << isPassing)
381 myTest.results
382 then
383 0
385 else
386 1
389isExpectationPassing result =
390 case result of
391 Testable.Todo label ->
392 True
394 Testable.Expect details ->
395 details.result
398isPassing layoutTest =
399 List.all isExpectationPassing layoutTest.expectations
402viewResult : Int -> WithResults (Testable.Element Msg) -> Element.Element Msg
403viewResult selectedIndex myTest =
404 if myTest.index == selectedIndex then
405 Element.column
406 [ Element.alignLeft
407 , Element.spacing 16
408 ]
409 [ Element.el [ Font.size 24 ] (Element.text myTest.label)
410 , Element.column
411 [ Element.alignLeft, Element.spacing 16 ]
412 (myTest.results
413 |> groupBy .elementDomId
414 |> List.map (expandDetails >> viewLayoutTestGroup)
415 )
416 ]
418 else
419 let
420 ( passing, failing ) =
421 List.partition isPassing myTest.results
422 in
423 Element.column
424 [ Element.alignLeft
425 , Element.spacing 16
426 , Element.pointer
427 , Events.onClick (Select myTest.index)
428 ]
429 [ Element.row [ Element.spacing 16 ]
430 [ Element.el [ Font.size 16 ] (Element.text myTest.label)
431 , Element.text (String.fromInt (List.length passing) ++ " passing")
432 , let
433 failingCount =
434 List.length failing
435 in
436 if failingCount == 0 then
437 Element.none
439 else
440 Element.text (String.fromInt (List.length failing) ++ " failing")
441 ]
442 ]
445expandDetails group =
446 case group.members of
447 [] ->
448 { id = group.id
449 , elementType = Testable.EmptyType
450 , members = group.members
451 }
453 top :: _ ->
454 { id = group.id
455 , elementType = top.elementType
456 , members = group.members
457 }
460groupBy fn list =
461 groupWhile (\one two -> fn one == fn two) list
462 |> List.map
463 (\( fst, remaining ) ->
464 { id = fn fst
465 , members = fst :: remaining
466 }
467 )
470groupWhile : (a -> a -> Bool) -> List a -> List ( a, List a )
471groupWhile isSameGroup items =
472 List.foldr
473 (\x acc ->
474 case acc of
475 [] ->
476 [ ( x, [] ) ]
478 ( y, restOfGroup ) :: groups ->
479 if isSameGroup x y then
480 ( x, y :: restOfGroup ) :: groups
482 else
483 ( x, [] ) :: acc
484 )
485 []
486 items
489viewLayoutTestGroup group =
490 let
491 testId =
492 group.id
493 |> String.dropLeft 1
494 |> String.append "tests-"
495 in
496 Element.column
497 [ Element.spacing 8
498 , Element.htmlAttribute (Html.Attributes.id testId)
499 , Events.onMouseEnter (HighlightDomID (Just group.id))
500 , Events.onMouseLeave (HighlightDomID Nothing)
501 , Element.htmlAttribute (Html.Attributes.style "user-select" "none")
502 ]
503 [ Element.row [ Element.spacing 16 ]
504 [ Element.el [] (Element.text (Testable.elementTypeToString group.elementType))
505 , Element.el [ Font.color palette.lightGrey ] (Element.text group.id)
506 ]
507 , Element.column
508 [ Element.spacing 8
509 , Element.paddingXY 32 0
510 ]
511 (List.map viewLayoutTest group.members)
512 ]
515type alias Grouped thing =
516 { id : String
517 , members : List thing
518 }
521viewLayoutTest layoutTest =
522 Element.column
523 [ Element.spacing 8
524 ]
525 [ Element.row [ Element.spacing 8 ]
526 [ Element.el [ Font.bold ] (Element.text layoutTest.label)
528 -- , Element.el [ Font.color palette.lightGrey ] (Element.text layoutTest.elementDomId)
529 ]
530 , Element.column [ Element.spacing 8 ]
531 (List.map viewLayoutExpectation layoutTest.expectations)
532 ]
535viewLayoutExpectation expectation =
536 case expectation of
537 Testable.Todo label ->
538 Element.row [ Element.spacing 4 ]
539 [ todo, Element.text label ]
541 Testable.Expect details ->
542 if details.result then
543 Element.row [ Element.spacing 4 ]
544 [ pass, Element.text details.description ]
546 else
547 Element.row [ Element.spacing 4 ]
548 [ fail, Element.text details.description ]
551badge color text =
552 Element.el
553 [ Background.color color
554 , Font.color palette.black
555 , Element.paddingXY 4 8
556 , Border.rounded 2
557 ]
558 (Element.text text)
561todo =
562 badge palette.lightGrey "todo"
565pass =
566 badge palette.green "pass"
569fail =
570 badge palette.red "fail"
573formatKeyValue : String -> String -> String
574formatKeyValue key val =
575 key ++ ": " ++ val
578port report :
579 List
580 { label : String
581 , results :
582 List
583 { description : String
584 , passing : Bool
585 , todo : Bool
586 }
587 }
588 -> Cmd msg
591port test : String -> Cmd msg
594port analyze : List String -> Cmd msg
597port styles :
598 (List
599 { id : String
600 , bbox : Testable.BoundingBox
601 , style : List ( String, String )
602 , isVisible : Bool
603 , textMetrics : List Testable.TextMetrics
604 }
605 -> msg
606 )
607 -> Sub msg