git.iko.soy/typeable/elm-ui
on 79f5e1e help sign in
typeable/elm-ui/tests-rendering/src/Testable/Element.elm
1452 lines 52 kB history raw
1module Testable.Element exposing
2 ( Length(..)
3 , above
4 , alignBottom
5 , alignLeft
6 , alignRight
7 , alignTop
8 , alpha
9 , behindContent
10 , below
11 , centerX
12 , centerY
13 , column
14 , el
15 , expectRoundedEquality
16 , fill
17 , fillPortion
18 , height
19 , inFront
20 , isVisible
21 , label
22 , layout
23 , maximum
24 , minimum
25 , moveDown
26 , moveLeft
27 , moveRight
28 , moveUp
29 , none
30 , onLeft
31 , onRight
32 , padding
33 , paddingXY
34 , paragraph
35 , px
36 , rgb
37 , rgba
38 , row
39 , shrink
40 , spacing
41 , text
42 , textColumn
43 , transparent
44 , width
45 )
47{-| This module should mirror the top level `Element` api, with one important distinction.
49The resulting `Element msg` structure can either be rendered to Html or transformed into a test suite that can be run.
51In order to run the test:
53 - render html
54 - gather information from the browser
55 - generate tests
57-}
59import Dict
60import Element
61import Html.Attributes
62import Testable
63import Testable.Runner
66layout : List (Testable.Attr msg) -> Testable.Element Testable.Runner.Msg -> Testable.Runner.TestableProgram
67layout attrs elem =
68 Testable.Runner.program
69 [ ( "Tests Run", elem )
70 ]
73text : String -> Testable.Element msg
74text =
75 Testable.Text
78el : List (Testable.Attr msg) -> Testable.Element msg -> Testable.Element msg
79el attrs =
80 Testable.El (implicitWidthHeightShrink attrs)
83row : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
84row attrs =
85 Testable.Row (implicitWidthHeightShrink attrs)
88column : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
89column attrs =
90 Testable.Column (implicitWidthHeightShrink attrs)
93none : Testable.Element msg
94none =
95 Testable.Empty
98paragraph : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
99paragraph attrs =
100 Testable.Paragraph (implicitWidthHeightShrink attrs)
103textColumn : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
104textColumn attrs =
105 Testable.TextColumn (implicitWidthHeightShrink attrs)
108{-| Old labeling mechanism that i removed to hastily
109-}
110label str =
111 Testable.Batch []
114moveUp x =
115 Testable.Attr (Element.moveUp x)
118moveDown x =
119 Testable.Attr (Element.moveDown x)
122moveRight x =
123 Testable.Attr (Element.moveRight x)
126moveLeft x =
127 Testable.Attr (Element.moveLeft x)
130type Length
131 = Px Int
132 | Fill Int
133 | Shrink
134 | Minimum Int Length
135 | Maximum Int Length
138minimum =
139 Minimum
142maximum =
143 Maximum
146rgb =
147 Element.rgb
150rgba =
151 Element.rgba
154px : Int -> Length
155px =
156 Px
159fill : Length
160fill =
161 Fill 1
164shrink : Length
165shrink =
166 Shrink
169fillPortion : Int -> Length
170fillPortion =
171 Fill
174transparent : Bool -> Testable.Attr msg
175transparent on =
176 Testable.LabeledTest
177 { label =
178 if on then
179 "transparent"
181 else
182 "opaque"
183 , attr = Element.transparent on
184 , id = Testable.NoId
185 , test =
186 \context ->
187 let
188 selfTransparency =
189 context.self.style
190 |> Dict.get "opacity"
191 |> Maybe.withDefault "notfound"
193 value =
194 if on then
195 "0"
197 else
198 "1"
199 in
200 [ Testable.equal value selfTransparency ]
201 }
204{-| -}
205isVisible : Testable.Attr msg
206isVisible =
207 Testable.AttrTest
208 { label = "is-visible"
209 , id = Testable.NoId
210 , test =
211 \context ->
212 [ Testable.equal context.self.isVisible True ]
213 }
216{-| -}
217alpha : Float -> Testable.Attr msg
218alpha a =
219 Testable.LabeledTest
220 { label = "alpha-" ++ String.fromFloat a
221 , attr = Element.alpha a
222 , id = Testable.NoId
223 , test =
224 \context ->
225 let
226 selfTransparency =
227 context.self.style
228 |> Dict.get "opacity"
229 |> Maybe.withDefault "notfound"
230 in
231 [ Testable.equal (String.fromFloat a) selfTransparency ]
232 }
235{-| -}
236padding : Int -> Testable.Attr msg
237padding pad =
238 Testable.LabeledTest
239 { label = "padding " ++ String.fromInt pad
240 , attr = Element.padding pad
241 , id = Testable.NoId
242 , test =
243 \found ->
244 [ Testable.true ("Padding " ++ String.fromInt pad ++ " is present")
245 (List.all ((==) pad)
246 [ floor found.self.bbox.padding.left
247 , floor found.self.bbox.padding.right
248 , floor found.self.bbox.padding.top
249 , floor found.self.bbox.padding.bottom
250 ]
251 )
252 ]
253 }
256{-| -}
257paddingXY : Int -> Int -> Testable.Attr msg
258paddingXY x y =
259 Testable.LabeledTest
260 { label = "paddingXY " ++ String.fromInt x ++ ", " ++ String.fromInt y
261 , attr = Element.paddingXY x y
262 , id = Testable.NoId
263 , test =
264 \found ->
265 [ Testable.true ("PaddingXY (" ++ String.fromInt x ++ ", " ++ String.fromInt y ++ ") is present")
266 (List.all ((==) x)
267 [ floor found.self.bbox.padding.left
268 , floor found.self.bbox.padding.right
269 ]
270 && List.all ((==) y)
271 [ floor found.self.bbox.padding.top
272 , floor found.self.bbox.padding.bottom
273 ]
274 )
275 ]
276 }
279widthHelper maybeMin maybeMax len =
280 let
281 addMin l =
282 case maybeMin of
283 Nothing ->
284 l
286 Just minPx ->
287 l |> Element.minimum minPx
289 addMax l =
290 case maybeMax of
291 Nothing ->
292 l
294 Just maxPx ->
295 l |> Element.maximum maxPx
297 minLabel =
298 case maybeMin of
299 Nothing ->
300 ""
302 Just i ->
303 " min:" ++ String.fromInt i
305 maxLabel =
306 case maybeMax of
307 Nothing ->
308 ""
310 Just i ->
311 " max:" ++ String.fromInt i
313 minMaxTest actualWidth =
314 case ( maybeMin, maybeMax ) of
315 ( Nothing, Nothing ) ->
316 True
318 ( Just lower, Nothing ) ->
319 lower <= actualWidth
321 ( Just lower, Just higher ) ->
322 lower <= actualWidth && actualWidth <= higher
324 ( Nothing, Just higher ) ->
325 actualWidth <= higher
326 in
327 case len of
328 Minimum m newLen ->
329 widthHelper (Just m) maybeMax newLen
331 Maximum m newLen ->
332 widthHelper maybeMin (Just m) newLen
334 Px val ->
335 -- Pixel values should ignore min and max?
336 Testable.LabeledTest
337 { label = "width " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
338 , id = Testable.IsWidth
339 , attr =
340 Element.width
341 (Element.px val
342 |> addMin
343 |> addMax
344 )
345 , test =
346 \found ->
347 [ Testable.true "exact width is exact" (floor found.self.bbox.width == val)
348 , Testable.true "min/max is upheld" (minMaxTest (floor found.self.bbox.width))
349 ]
350 }
352 Fill portion ->
353 Testable.LabeledTest
354 { label =
355 if portion == 1 then
356 "width fill" ++ minLabel ++ maxLabel
358 else
359 "width fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
360 , id = Testable.IsWidth
361 , attr =
362 Element.width
363 (Element.fillPortion portion
364 |> addMin
365 |> addMax
366 )
367 , test =
368 \context ->
369 if List.member context.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
370 [ Testable.true "width fill doesn't apply to onright/onleft elements" True ]
372 else
373 let
374 parentAvailableWidth =
375 context.parent.bbox.width - (context.self.bbox.padding.left + context.self.bbox.padding.right)
376 in
377 [ case context.parentLayout of
378 Testable.IsNearby _ ->
379 Testable.true "Nearby Element has fill width"
380 ((floor context.parent.bbox.width == floor context.self.bbox.width)
381 || minMaxTest (floor context.self.bbox.width)
382 )
384 Testable.InColumn ->
385 Testable.true "Element within column has fill width"
386 ((floor parentAvailableWidth == floor context.self.bbox.width)
387 || minMaxTest (floor context.self.bbox.width)
388 )
390 Testable.InEl ->
391 Testable.true "Element within element has fill width" <|
392 (floor parentAvailableWidth == floor context.self.bbox.width)
393 || minMaxTest (floor context.self.bbox.width)
395 _ ->
396 let
397 spacePerPortion =
398 parentAvailableWidth / toFloat (List.length context.siblings + 1)
399 in
400 Testable.true "element has fill width" <|
401 (floor spacePerPortion == floor context.self.bbox.width)
402 || minMaxTest (floor context.self.bbox.width)
403 ]
404 }
406 Shrink ->
407 Testable.LabeledTest
408 { label = "width shrink" ++ minLabel ++ maxLabel
409 , attr =
410 Element.width
411 (Element.shrink
412 |> addMin
413 |> addMax
414 )
415 , id = Testable.IsWidth
416 , test =
417 \context ->
418 case context.selfElement of
419 Testable.El _ _ ->
420 let
421 childWidth child =
422 child.bbox.width
424 totalChildren =
425 context.children
426 |> List.map childWidth
427 |> List.append (List.map .width context.self.textMetrics)
428 |> List.sum
430 horizontalPadding =
431 context.self.bbox.padding.left + context.self.bbox.padding.right
432 in
433 [ expectRoundedEquality
434 { expected = totalChildren + horizontalPadding
435 , found = context.self.bbox.width
436 }
437 ]
439 Testable.Row _ _ ->
440 -- width of row is the sum of all children widths
441 -- both text elements and others.
442 let
443 childWidth child =
444 child.bbox.width
446 totalChildren =
447 context.children
448 |> List.map childWidth
449 |> List.append (List.map .width context.self.textMetrics)
450 |> List.sum
452 horizontalPadding =
453 context.self.bbox.padding.left + context.self.bbox.padding.right
455 spacingValue =
456 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
457 in
458 [ expectRoundedEquality
459 { expected = totalChildren + horizontalPadding + spacingValue
460 , found = context.self.bbox.width
461 }
462 ]
464 Testable.Column _ _ ->
465 -- The width of the column is the width of the widest child.
466 let
467 childWidth child =
468 child.bbox.width
469 + context.self.bbox.padding.left
470 + context.self.bbox.padding.right
472 textChildren =
473 List.map
474 (\txt ->
475 txt.width
476 + context.self.bbox.padding.left
477 + context.self.bbox.padding.right
478 )
479 context.self.textMetrics
481 allChildren =
482 context.children
483 |> List.map childWidth
484 |> List.append textChildren
485 in
486 [ expectRoundedEquality
487 { expected = Maybe.withDefault 0 (List.maximum allChildren)
488 , found = context.self.bbox.width
489 }
490 ]
492 Testable.TextColumn _ _ ->
493 []
495 Testable.Paragraph _ _ ->
496 -- This should be the size it's text,
497 -- unless it takes up all available space, in which case it should wrap.
498 let
499 childWidth child =
500 child.bbox.width
502 totalChildren =
503 context.children
504 |> List.map childWidth
505 |> List.append (List.map .width context.self.textMetrics)
506 |> List.sum
508 horizontalPadding =
509 context.self.bbox.padding.left + context.self.bbox.padding.right
510 in
511 [ expectRoundedEquality
512 { expected = totalChildren + horizontalPadding
513 , found = context.self.bbox.width
514 }
515 ]
517 Testable.Text _ ->
518 []
520 Testable.Empty ->
521 []
522 }
525heightHelper maybeMin maybeMax len =
526 let
527 addMin l =
528 case maybeMin of
529 Nothing ->
530 l
532 Just minPx ->
533 l |> Element.minimum minPx
535 addMax l =
536 case maybeMax of
537 Nothing ->
538 l
540 Just maxPx ->
541 l |> Element.maximum maxPx
543 minLabel =
544 case maybeMin of
545 Nothing ->
546 ""
548 Just i ->
549 " min:" ++ String.fromInt i
551 maxLabel =
552 case maybeMax of
553 Nothing ->
554 ""
556 Just i ->
557 " max:" ++ String.fromInt i
559 minMaxTest actualheight =
560 case ( maybeMin, maybeMax ) of
561 ( Nothing, Nothing ) ->
562 True
564 ( Just lower, Nothing ) ->
565 lower <= actualheight
567 ( Just lower, Just higher ) ->
568 lower <= actualheight && actualheight <= higher
570 ( Nothing, Just higher ) ->
571 actualheight <= higher
572 in
573 case len of
574 Minimum m newLen ->
575 heightHelper (Just m) maybeMax newLen
577 Maximum m newLen ->
578 heightHelper maybeMin (Just m) newLen
580 Px val ->
581 -- Pixel values should ignore min and max?
582 Testable.LabeledTest
583 { label = "height " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
584 , attr =
585 Element.height
586 (Element.px val
587 |> addMin
588 |> addMax
589 )
590 , id = Testable.IsHeight
591 , test =
592 \found ->
593 [ Testable.true ("exact height is exact: " ++ String.fromInt (floor found.self.bbox.height) ++ "," ++ String.fromInt val)
594 (floor found.self.bbox.height == val)
595 , Testable.true "min/max holds true"
596 (minMaxTest (floor found.self.bbox.height))
597 ]
598 }
600 Fill portion ->
601 Testable.LabeledTest
602 { label = "height fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
603 , attr =
604 Element.height
605 (Element.fillPortion portion
606 |> addMin
607 |> addMax
608 )
609 , id = Testable.IsHeight
610 , test =
611 \context ->
612 [ if List.member context.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
613 Testable.true "height fill doesn't apply to above/below elements" True
615 else
616 let
617 parentAvailableHeight =
618 context.parent.bbox.height - (context.self.bbox.padding.top + context.self.bbox.padding.bottom)
619 in
620 case context.parentLayout of
621 Testable.IsNearby _ ->
622 Testable.true "Nearby Element has fill height"
623 ((floor context.parent.bbox.height == floor context.self.bbox.height)
624 || minMaxTest (floor context.self.bbox.height)
625 )
627 Testable.InColumn ->
628 Testable.true "Element within column has fill height"
629 ((floor parentAvailableHeight == floor context.self.bbox.height)
630 || minMaxTest (floor context.self.bbox.height)
631 )
633 Testable.InEl ->
634 Testable.true "Element within el has fill height" <|
635 (floor parentAvailableHeight == floor context.self.bbox.height)
636 || minMaxTest (floor context.self.bbox.height)
638 _ ->
639 let
640 spacePerPortion =
641 parentAvailableHeight / toFloat (List.length context.siblings + 1)
642 in
643 Testable.true "el has fill height" <|
644 (floor spacePerPortion == floor context.self.bbox.height)
645 || minMaxTest (floor context.self.bbox.height)
646 ]
647 }
649 Shrink ->
650 Testable.LabeledTest
651 { label = "height shrink" ++ minLabel ++ maxLabel
652 , attr =
653 Element.height
654 (Element.shrink
655 |> addMin
656 |> addMax
657 )
658 , id = Testable.IsHeight
659 , test =
660 \context ->
661 case context.selfElement of
662 Testable.El _ _ ->
663 let
664 childHeight child =
665 -- TODO: add margin values to heights
666 child.bbox.height
668 totalChildren =
669 context.children
670 |> List.map childHeight
671 |> List.append (List.map Testable.textHeight context.self.textMetrics)
672 |> List.sum
674 verticalPadding =
675 context.self.bbox.padding.top + context.self.bbox.padding.bottom
677 spacingValue =
678 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
679 in
680 [ expectRoundedEquality
681 { expected = totalChildren + verticalPadding + spacingValue
682 , found = context.self.bbox.height
683 }
684 ]
686 Testable.Row _ _ ->
687 let
688 childHeight child =
689 child.bbox.height
691 totalChildren =
692 context.children
693 |> List.map childHeight
694 |> List.append (List.map Testable.textHeight context.self.textMetrics)
695 |> List.maximum
696 |> Maybe.withDefault 0
698 verticalPadding =
699 context.self.bbox.padding.top + context.self.bbox.padding.bottom
700 in
701 [ expectRoundedEquality
702 { expected = totalChildren + verticalPadding
703 , found = context.self.bbox.height
704 }
705 ]
707 Testable.Column _ _ ->
708 let
709 childHeight child =
710 child.bbox.height
712 totalChildren =
713 context.children
714 |> List.map childHeight
715 |> List.append (List.map Testable.textHeight context.self.textMetrics)
716 |> List.sum
718 verticalPadding =
719 context.self.bbox.padding.top + context.self.bbox.padding.bottom
721 spacingValue =
722 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
723 in
724 [ expectRoundedEquality
725 { expected = totalChildren + verticalPadding + spacingValue
726 , found = context.self.bbox.height
727 }
728 ]
730 Testable.TextColumn _ _ ->
731 []
733 Testable.Paragraph _ _ ->
734 []
736 Testable.Text _ ->
737 []
739 Testable.Empty ->
740 []
741 }
744width : Length -> Testable.Attr msg
745width len =
746 widthHelper Nothing Nothing len
749height : Length -> Testable.Attr msg
750height len =
751 heightHelper Nothing Nothing len
754spacing : Int -> Testable.Attr msg
755spacing space =
756 Testable.Batch
757 [ Testable.Spacing space
758 , Testable.LabeledTest
759 { label = "spacing: " ++ String.fromInt space
760 , attr = Element.spacing space
761 , id = Testable.NoId
762 , test =
763 \found ->
764 let
765 findDistance child total =
766 List.concatMap
767 (\otherChild ->
768 let
769 horizontal =
770 round <|
771 child.bbox.left
772 - otherChild.bbox.right
774 vertical =
775 round <|
776 child.bbox.top
777 - otherChild.bbox.bottom
778 in
779 [ if horizontal > 0 then
780 horizontal
782 else
783 space
784 , if vertical > 0 then
785 vertical
787 else
788 space
789 ]
790 )
791 found.children
792 ++ total
794 distances =
795 List.foldl findDistance [] found.children
797 allAreSpaced =
798 List.foldl
799 (\x wrong ->
800 if not (x >= space) then
801 x :: wrong
803 else
804 wrong
805 )
806 []
807 distances
808 in
809 [ Testable.true
810 ("All children are at least "
811 ++ String.fromInt space
812 ++ " pixels apart."
813 ++ Debug.toString allAreSpaced
814 ++ " are not though"
815 )
816 (allAreSpaced == [])
817 ]
818 }
819 ]
822{-| alignLeft needs to account for
824 - parent padding
825 - elements to the left
826 - spacing value
828in order to calculate the expected result.
830Also need parent rendering context if this is to work with wrapped rows in the future.
832All sibling elements
834-}
835alignLeft : Testable.Attr msg
836alignLeft =
837 Testable.LabeledTest
838 { label = "alignLeft"
839 , attr = Element.alignLeft
840 , id = Testable.NoId
841 , test =
842 \found ->
843 [ if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
844 Testable.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
846 else if
847 List.member found.parentLayout
848 [ Testable.IsNearby Testable.InFront
849 , Testable.IsNearby Testable.Behind
850 , Testable.IsNearby Testable.Above
851 , Testable.IsNearby Testable.Below
852 ]
853 then
854 expectRoundedEquality
855 { found = found.self.bbox.left
856 , expected = found.parent.bbox.left
857 }
859 else if List.length found.siblings == 0 then
860 expectRoundedEquality
861 { found = found.self.bbox.left
862 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
863 }
865 else
866 case found.parentLayout of
867 Testable.InRow ->
868 let
869 siblingsOnLeft =
870 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
872 spacings =
873 toFloat (List.length siblingsOnLeft * found.parentSpacing)
875 widthsOnLeft =
876 siblingsOnLeft
877 |> List.map (.width << .bbox)
878 |> List.sum
879 in
880 expectRoundedEquality
881 { found = found.self.bbox.left
882 , expected = found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings)
883 }
885 _ ->
886 expectRoundedEquality
887 { found = found.self.bbox.left
888 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
889 }
890 ]
891 }
894{-| -}
895centerX : Testable.Attr msg
896centerX =
897 Testable.LabeledTest
898 { label = "centerX"
899 , attr = Element.centerX
900 , id = Testable.NoId
901 , test =
902 \found ->
903 let
904 selfCenter : Float
905 selfCenter =
906 found.self.bbox.left + (found.self.bbox.width / 2)
908 parentCenter : Float
909 parentCenter =
910 found.parent.bbox.left + (found.parent.bbox.width / 2)
911 in
912 if List.member found.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
913 [ Testable.true "centerX doesn't apply to elements that are onLeft or onRight" True ]
915 else if List.length found.siblings == 0 then
916 [ expectRoundedEquality
917 { found = selfCenter
918 , expected = parentCenter
919 }
920 ]
922 else
923 case found.parentLayout of
924 Testable.InRow ->
925 let
926 siblingsOnLeft =
927 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
929 siblingsOnRight =
930 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
932 widthsOnLeft : Float
933 widthsOnLeft =
934 siblingsOnLeft
935 |> List.map (.width << .bbox)
936 |> List.sum
937 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
939 widthsOnRight =
940 siblingsOnRight
941 |> List.map (.width << .bbox)
942 |> List.sum
943 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
945 expectedCenter : Float
946 expectedCenter =
947 found.parent.bbox.left
948 + widthsOnLeft
949 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
950 / 2
951 )
952 in
953 [ expectRoundedEquality
954 { found = selfCenter
955 , expected = expectedCenter
956 }
957 ]
959 _ ->
960 [ expectRoundedEquality
961 { found = selfCenter
962 , expected = parentCenter
963 }
964 ]
965 }
968{-| -}
969alignRight : Testable.Attr msg
970alignRight =
971 Testable.LabeledTest
972 { label = "alignRight"
973 , attr = Element.alignRight
974 , id = Testable.NoId
975 , test =
976 \found ->
977 if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
978 [ Testable.true "alignRight doesn't apply to elements that are onLeft or onRight" True ]
980 else if
981 List.member found.parentLayout
982 [ Testable.IsNearby Testable.InFront
983 , Testable.IsNearby Testable.Behind
984 , Testable.IsNearby Testable.Above
985 , Testable.IsNearby Testable.Below
986 ]
987 then
988 [ expectRoundedEquality
989 { found = found.self.bbox.right
990 , expected = found.parent.bbox.right
991 }
992 ]
994 else if List.length found.siblings == 0 then
995 [ expectRoundedEquality
996 { found = found.self.bbox.right
997 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
998 }
999 ]
1001 else
1002 case found.parentLayout of
1003 Testable.InRow ->
1004 let
1005 siblingsOnRight =
1006 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1008 spacings =
1009 toFloat (List.length siblingsOnRight * found.parentSpacing)
1011 widthsOnRight =
1012 siblingsOnRight
1013 |> List.map (.width << .bbox)
1014 |> List.sum
1015 in
1016 [ expectRoundedEquality
1017 { found = found.self.bbox.right
1018 , expected = found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings)
1022 _ ->
1023 [ expectRoundedEquality
1024 { found = found.self.bbox.right
1025 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1031{-| -}
1032alignTop : Testable.Attr msg
1033alignTop =
1034 Testable.LabeledTest
1035 { label = "alignTop"
1036 , attr = Element.alignTop
1037 , id = Testable.NoId
1038 , test =
1039 \found ->
1040 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1041 [ Testable.true "alignTop doesn't apply to elements that are above or below" True ]
1043 else if
1044 List.member found.parentLayout
1045 [ Testable.IsNearby Testable.InFront
1046 , Testable.IsNearby Testable.Behind
1047 , Testable.IsNearby Testable.OnRight
1048 , Testable.IsNearby Testable.OnLeft
1050 then
1051 [ expectRoundedEquality
1052 { found = found.self.bbox.top
1053 , expected = found.parent.bbox.top
1057 else if List.length found.siblings == 0 then
1058 [ expectRoundedEquality
1059 { found = found.self.bbox.top
1060 , expected = found.parent.bbox.top + found.parent.bbox.padding.top
1064 else
1065 case found.parentLayout of
1066 Testable.InColumn ->
1067 let
1068 siblingsAbove =
1069 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1071 spacings =
1072 toFloat (List.length siblingsAbove * found.parentSpacing)
1074 heightsAbove =
1075 siblingsAbove
1076 |> List.map (.height << .bbox)
1077 |> List.sum
1078 in
1079 [ expectRoundedEquality
1080 { found = found.self.bbox.top
1081 , expected = found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings)
1085 _ ->
1086 [ expectRoundedEquality
1087 { found = found.self.bbox.top
1088 , expected = found.parent.bbox.top
1094{-| -}
1095alignBottom : Testable.Attr msg
1096alignBottom =
1097 Testable.LabeledTest
1098 { label = "alignBottom"
1099 , attr = Element.alignBottom
1100 , id = Testable.NoId
1101 , test =
1102 \found ->
1103 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1104 [ Testable.true "alignBottom doesn't apply to elements that are above or below" True ]
1106 else if
1107 List.member found.parentLayout
1108 [ Testable.IsNearby Testable.InFront
1109 , Testable.IsNearby Testable.Behind
1110 , Testable.IsNearby Testable.OnRight
1111 , Testable.IsNearby Testable.OnLeft
1113 then
1114 [ expectRoundedEquality
1115 { found = found.self.bbox.bottom
1116 , expected = found.parent.bbox.bottom
1120 else if List.length found.siblings == 0 then
1121 [ expectRoundedEquality
1122 { found = found.self.bbox.bottom
1123 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1127 else
1128 case found.parentLayout of
1129 Testable.InColumn ->
1130 let
1131 siblingsBelow =
1132 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1134 spacings =
1135 toFloat (List.length siblingsBelow * found.parentSpacing)
1137 heightsBelow =
1138 siblingsBelow
1139 |> List.map (.height << .bbox)
1140 |> List.sum
1141 in
1142 [ expectRoundedEquality
1143 { found = found.self.bbox.bottom
1144 , expected = found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings)
1148 _ ->
1149 [ expectRoundedEquality
1150 { found = found.self.bbox.bottom
1151 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1157expectRoundedEquality : { expected : Float, found : Float } -> Testable.LayoutExpectation
1158expectRoundedEquality { expected, found } =
1159 Testable.true
1160 ("expected " ++ floatToString expected ++ ", found " ++ floatToString found)
1161 (abs (expected - found) < 1)
1164floatToString : Float -> String
1165floatToString x =
1166 String.fromFloat (toFloat (round (x * 100)) / 100)
1169{-| -}
1170centerY : Testable.Attr msg
1171centerY =
1172 Testable.LabeledTest
1173 { label = "centerY"
1174 , attr = Element.centerY
1175 , id = Testable.NoId
1176 , test =
1177 \found ->
1178 let
1179 selfCenter =
1180 found.self.bbox.top + (found.self.bbox.height / 2)
1182 parentCenter =
1183 found.parent.bbox.top + (found.parent.bbox.height / 2)
1184 in
1185 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1186 [ Testable.true "centerY doesn't apply to elements that are above or below" True ]
1188 else if List.length found.siblings == 0 then
1189 [ expectRoundedEquality
1190 { found = selfCenter
1191 , expected = parentCenter
1195 else
1196 case found.parentLayout of
1197 Testable.InColumn ->
1198 let
1199 siblingsOnTop =
1200 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1202 siblingsBelow =
1203 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1205 heightsAbove : Float
1206 heightsAbove =
1207 siblingsOnTop
1208 |> List.map (.height << .bbox)
1209 |> List.sum
1210 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1212 heightsBelow =
1213 siblingsBelow
1214 |> List.map (.height << .bbox)
1215 |> List.sum
1216 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1218 expectedCenter : Float
1219 expectedCenter =
1220 found.parent.bbox.top
1221 + heightsAbove
1222 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1223 / 2
1225 in
1226 [ expectRoundedEquality
1227 { found = selfCenter
1228 , expected = expectedCenter
1232 _ ->
1233 [ expectRoundedEquality
1234 { found = selfCenter
1235 , expected = parentCenter
1241{-| -}
1242above : Testable.Element msg -> Testable.Attr msg
1243above element =
1244 Testable.Nearby
1245 { location = Testable.Above
1246 , element = element
1247 , label = "above"
1248 , test =
1249 \found ->
1250 [ expectRoundedEquality
1251 { found = found.self.bbox.bottom
1252 , expected = found.parent.bbox.top
1258{-| -}
1259below : Testable.Element msg -> Testable.Attr msg
1260below element =
1261 Testable.Nearby
1262 { location = Testable.Below
1263 , element = element
1264 , label = "below"
1265 , test =
1266 \found ->
1267 [ expectRoundedEquality
1268 { found = found.self.bbox.top
1269 , expected = found.parent.bbox.bottom
1275{-| -}
1276onRight : Testable.Element msg -> Testable.Attr msg
1277onRight element =
1278 Testable.Nearby
1279 { location = Testable.OnRight
1280 , element = element
1281 , label = "onRight"
1282 , test =
1283 \found ->
1284 [ expectRoundedEquality
1285 { found = found.self.bbox.left
1286 , expected = found.parent.bbox.right
1292{-| -}
1293onLeft : Testable.Element msg -> Testable.Attr msg
1294onLeft element =
1295 Testable.Nearby
1296 { location = Testable.OnLeft
1297 , element = element
1298 , label = "onLeft"
1299 , test =
1300 \found ->
1301 [ expectRoundedEquality
1302 { found = found.self.bbox.right
1303 , expected = found.parent.bbox.left
1309compare x vs y =
1310 vs (round x) (round y) || vs (floor x) (floor y)
1313{-| -}
1314inFront : Testable.Element msg -> Testable.Attr msg
1315inFront element =
1316 Testable.Nearby
1317 { location = Testable.InFront
1318 , element = element
1319 , label = "inFront"
1320 , test =
1321 \found ->
1322 [ withinHelper found ]
1326withinHelper found =
1327 let
1328 horizontalCheck =
1329 if found.self.bbox.width > found.parent.bbox.width then
1330 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1331 || compare found.self.bbox.left (>=) found.parent.bbox.left
1334 else
1335 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1336 , compare found.self.bbox.left (>=) found.parent.bbox.left
1339 verticalCheck =
1340 if found.self.bbox.width > found.parent.bbox.width then
1341 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1342 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1345 else
1346 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1347 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1349 in
1350 Testable.true "within the confines of the parent"
1351 (List.all ((==) True)
1352 (List.concat
1353 [ horizontalCheck
1354 , verticalCheck
1360{-| -}
1361behindContent : Testable.Element msg -> Testable.Attr msg
1362behindContent element =
1363 Testable.Nearby
1364 { location = Testable.Behind
1365 , element = element
1366 , label = "behindContent"
1367 , test =
1368 \found ->
1369 [ withinHelper found ]
1374{- Implicit width/height calcualtions -}
1377implicitWidthHeightShrink attrs =
1378 let
1379 withImplicits =
1380 implicitTest (widthHelper Nothing Nothing Shrink)
1381 :: implicitTest (heightHelper Nothing Nothing Shrink)
1382 :: attrs
1383 in
1384 skipOverridden withImplicits
1387attrId attr =
1388 case attr of
1389 Testable.LabeledTest details ->
1390 details.id
1392 Testable.AttrTest details ->
1393 details.id
1395 _ ->
1396 Testable.NoId
1399skipOverridden ls =
1400 List.foldr
1401 (\attr ( found, caught ) ->
1402 let
1403 ( skip, has ) =
1404 case attrId attr of
1405 Testable.NoId ->
1406 ( False, found )
1408 Testable.IsWidth ->
1409 ( found.hasWidth
1410 , { hasWidth = True
1411 , hasHeight = found.hasHeight
1415 Testable.IsHeight ->
1416 ( found.hasHeight
1417 , { hasWidth = found.hasWidth
1418 , hasHeight = True
1421 in
1422 ( has
1423 , if skip then
1424 caught
1426 else
1427 attr :: caught
1430 ( { hasWidth = False
1431 , hasHeight = False
1433 , []
1435 ls
1436 |> Tuple.second
1437 |> List.reverse
1440{-| This is taking a normal test and rmoving its ability to attach a real `Element` attribute.
1442implicitTest attr =
1443 case attr of
1444 Testable.LabeledTest details ->
1445 Testable.AttrTest
1446 { test = details.test
1447 , label = "Implicit -> " ++ details.label
1448 , id = details.id
1451 otherwise ->
1452 otherwise