git.iko.soy/typeable/elm-ui
on 1ceefdb help sign in
typeable/elm-ui/tests-rendering/src/Testable/Element.elm
1458 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 rowAttrs _ ->
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 spacingAmount =
456 Testable.getSpacingFromAttributes rowAttrs
458 totalSpacing =
459 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
460 in
461 [ expectRoundedEquality
462 { expected = totalChildren + horizontalPadding + totalSpacing
463 , found = context.self.bbox.width
464 }
465 ]
467 Testable.Column _ _ ->
468 -- The width of the column is the width of the widest child.
469 let
470 childWidth child =
471 child.bbox.width
472 + context.self.bbox.padding.left
473 + context.self.bbox.padding.right
475 textChildren =
476 List.map
477 (\txt ->
478 txt.width
479 + context.self.bbox.padding.left
480 + context.self.bbox.padding.right
481 )
482 context.self.textMetrics
484 allChildren =
485 context.children
486 |> List.map childWidth
487 |> List.append textChildren
488 in
489 [ expectRoundedEquality
490 { expected = Maybe.withDefault 0 (List.maximum allChildren)
491 , found = context.self.bbox.width
492 }
493 ]
495 Testable.TextColumn _ _ ->
496 []
498 Testable.Paragraph _ _ ->
499 -- This should be the size it's text,
500 -- unless it takes up all available space, in which case it should wrap.
501 let
502 childWidth child =
503 child.bbox.width
505 totalChildren =
506 context.children
507 |> List.map childWidth
508 |> List.append (List.map .width context.self.textMetrics)
509 |> List.sum
511 horizontalPadding =
512 context.self.bbox.padding.left + context.self.bbox.padding.right
513 in
514 [ expectRoundedEquality
515 { expected = totalChildren + horizontalPadding
516 , found = context.self.bbox.width
517 }
518 ]
520 Testable.Text _ ->
521 []
523 Testable.Empty ->
524 []
525 }
528heightHelper maybeMin maybeMax len =
529 let
530 addMin l =
531 case maybeMin of
532 Nothing ->
533 l
535 Just minPx ->
536 l |> Element.minimum minPx
538 addMax l =
539 case maybeMax of
540 Nothing ->
541 l
543 Just maxPx ->
544 l |> Element.maximum maxPx
546 minLabel =
547 case maybeMin of
548 Nothing ->
549 ""
551 Just i ->
552 " min:" ++ String.fromInt i
554 maxLabel =
555 case maybeMax of
556 Nothing ->
557 ""
559 Just i ->
560 " max:" ++ String.fromInt i
562 minMaxTest actualheight =
563 case ( maybeMin, maybeMax ) of
564 ( Nothing, Nothing ) ->
565 True
567 ( Just lower, Nothing ) ->
568 lower <= actualheight
570 ( Just lower, Just higher ) ->
571 lower <= actualheight && actualheight <= higher
573 ( Nothing, Just higher ) ->
574 actualheight <= higher
575 in
576 case len of
577 Minimum m newLen ->
578 heightHelper (Just m) maybeMax newLen
580 Maximum m newLen ->
581 heightHelper maybeMin (Just m) newLen
583 Px val ->
584 -- Pixel values should ignore min and max?
585 Testable.LabeledTest
586 { label = "height " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
587 , attr =
588 Element.height
589 (Element.px val
590 |> addMin
591 |> addMax
592 )
593 , id = Testable.IsHeight
594 , test =
595 \found ->
596 [ Testable.true ("exact height is exact: " ++ String.fromInt (floor found.self.bbox.height) ++ "," ++ String.fromInt val)
597 (floor found.self.bbox.height == val)
598 , Testable.true "min/max holds true"
599 (minMaxTest (floor found.self.bbox.height))
600 ]
601 }
603 Fill portion ->
604 Testable.LabeledTest
605 { label = "height fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
606 , attr =
607 Element.height
608 (Element.fillPortion portion
609 |> addMin
610 |> addMax
611 )
612 , id = Testable.IsHeight
613 , test =
614 \context ->
615 [ if List.member context.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
616 Testable.true "height fill doesn't apply to above/below elements" True
618 else
619 let
620 parentAvailableHeight =
621 context.parent.bbox.height - (context.self.bbox.padding.top + context.self.bbox.padding.bottom)
622 in
623 case context.parentLayout of
624 Testable.IsNearby _ ->
625 Testable.true "Nearby Element has fill height"
626 ((floor context.parent.bbox.height == floor context.self.bbox.height)
627 || minMaxTest (floor context.self.bbox.height)
628 )
630 Testable.InColumn ->
631 Testable.true "Element within column has fill height"
632 ((floor parentAvailableHeight == floor context.self.bbox.height)
633 || minMaxTest (floor context.self.bbox.height)
634 )
636 Testable.InEl ->
637 Testable.true "Element within el has fill height" <|
638 (floor parentAvailableHeight == floor context.self.bbox.height)
639 || minMaxTest (floor context.self.bbox.height)
641 _ ->
642 let
643 spacePerPortion =
644 parentAvailableHeight / toFloat (List.length context.siblings + 1)
645 in
646 Testable.true "el has fill height" <|
647 (floor spacePerPortion == floor context.self.bbox.height)
648 || minMaxTest (floor context.self.bbox.height)
649 ]
650 }
652 Shrink ->
653 Testable.LabeledTest
654 { label = "height shrink" ++ minLabel ++ maxLabel
655 , attr =
656 Element.height
657 (Element.shrink
658 |> addMin
659 |> addMax
660 )
661 , id = Testable.IsHeight
662 , test =
663 \context ->
664 case context.selfElement of
665 Testable.El _ _ ->
666 let
667 childHeight child =
668 -- TODO: add margin values to heights
669 child.bbox.height
671 totalChildren =
672 context.children
673 |> List.map childHeight
674 |> List.append (List.map Testable.textHeight context.self.textMetrics)
675 |> List.sum
677 verticalPadding =
678 context.self.bbox.padding.top + context.self.bbox.padding.bottom
680 spacingValue =
681 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
682 in
683 [ expectRoundedEquality
684 { expected = totalChildren + verticalPadding + spacingValue
685 , found = context.self.bbox.height
686 }
687 ]
689 Testable.Row _ _ ->
690 let
691 childHeight child =
692 child.bbox.height
694 totalChildren =
695 context.children
696 |> List.map childHeight
697 |> List.append (List.map Testable.textHeight context.self.textMetrics)
698 |> List.maximum
699 |> Maybe.withDefault 0
701 verticalPadding =
702 context.self.bbox.padding.top + context.self.bbox.padding.bottom
703 in
704 [ expectRoundedEquality
705 { expected = totalChildren + verticalPadding
706 , found = context.self.bbox.height
707 }
708 ]
710 Testable.Column colAttrs _ ->
711 let
712 childHeight child =
713 child.bbox.height
715 totalChildren =
716 context.children
717 |> List.map childHeight
718 |> List.append (List.map Testable.textHeight context.self.textMetrics)
719 |> List.sum
721 verticalPadding =
722 context.self.bbox.padding.top + context.self.bbox.padding.bottom
724 spacingAmount =
725 Testable.getSpacingFromAttributes colAttrs
727 totalSpacing =
728 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
729 in
730 [ expectRoundedEquality
731 { expected = totalChildren + verticalPadding + totalSpacing
732 , found = context.self.bbox.height
733 }
734 ]
736 Testable.TextColumn _ _ ->
737 []
739 Testable.Paragraph _ _ ->
740 []
742 Testable.Text _ ->
743 []
745 Testable.Empty ->
746 []
747 }
750width : Length -> Testable.Attr msg
751width len =
752 widthHelper Nothing Nothing len
755height : Length -> Testable.Attr msg
756height len =
757 heightHelper Nothing Nothing len
760spacing : Int -> Testable.Attr msg
761spacing space =
762 Testable.Batch
763 [ Testable.Spacing space
764 , Testable.LabeledTest
765 { label = "spacing: " ++ String.fromInt space
766 , attr = Element.spacing space
767 , id = Testable.NoId
768 , test =
769 \found ->
770 let
771 findDistance child total =
772 List.concatMap
773 (\otherChild ->
774 let
775 horizontal =
776 round <|
777 child.bbox.left
778 - otherChild.bbox.right
780 vertical =
781 round <|
782 child.bbox.top
783 - otherChild.bbox.bottom
784 in
785 [ if horizontal > 0 then
786 horizontal
788 else
789 space
790 , if vertical > 0 then
791 vertical
793 else
794 space
795 ]
796 )
797 found.children
798 ++ total
800 distances =
801 List.foldl findDistance [] found.children
803 allAreSpaced =
804 List.foldl
805 (\x wrong ->
806 if not (x >= space) then
807 x :: wrong
809 else
810 wrong
811 )
812 []
813 distances
814 in
815 [ Testable.true
816 ("All children are at least "
817 ++ String.fromInt space
818 ++ " pixels apart."
819 ++ Debug.toString allAreSpaced
820 ++ " are not though"
821 )
822 (allAreSpaced == [])
823 ]
824 }
825 ]
828{-| alignLeft needs to account for
830 - parent padding
831 - elements to the left
832 - spacing value
834in order to calculate the expected result.
836Also need parent rendering context if this is to work with wrapped rows in the future.
838All sibling elements
840-}
841alignLeft : Testable.Attr msg
842alignLeft =
843 Testable.LabeledTest
844 { label = "alignLeft"
845 , attr = Element.alignLeft
846 , id = Testable.NoId
847 , test =
848 \found ->
849 [ if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
850 Testable.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
852 else if
853 List.member found.parentLayout
854 [ Testable.IsNearby Testable.InFront
855 , Testable.IsNearby Testable.Behind
856 , Testable.IsNearby Testable.Above
857 , Testable.IsNearby Testable.Below
858 ]
859 then
860 expectRoundedEquality
861 { found = found.self.bbox.left
862 , expected = found.parent.bbox.left
863 }
865 else if List.length found.siblings == 0 then
866 expectRoundedEquality
867 { found = found.self.bbox.left
868 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
869 }
871 else
872 case found.parentLayout of
873 Testable.InRow ->
874 let
875 siblingsOnLeft =
876 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
878 spacings =
879 toFloat (List.length siblingsOnLeft * found.parentSpacing)
881 widthsOnLeft =
882 siblingsOnLeft
883 |> List.map (.width << .bbox)
884 |> List.sum
885 in
886 expectRoundedEquality
887 { found = found.self.bbox.left
888 , expected = found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings)
889 }
891 _ ->
892 expectRoundedEquality
893 { found = found.self.bbox.left
894 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
895 }
896 ]
897 }
900{-| -}
901centerX : Testable.Attr msg
902centerX =
903 Testable.LabeledTest
904 { label = "centerX"
905 , attr = Element.centerX
906 , id = Testable.NoId
907 , test =
908 \found ->
909 let
910 selfCenter : Float
911 selfCenter =
912 found.self.bbox.left + (found.self.bbox.width / 2)
914 parentCenter : Float
915 parentCenter =
916 found.parent.bbox.left + (found.parent.bbox.width / 2)
917 in
918 if List.member found.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
919 [ Testable.true "centerX doesn't apply to elements that are onLeft or onRight" True ]
921 else if List.length found.siblings == 0 then
922 [ expectRoundedEquality
923 { found = selfCenter
924 , expected = parentCenter
925 }
926 ]
928 else
929 case found.parentLayout of
930 Testable.InRow ->
931 let
932 siblingsOnLeft =
933 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
935 siblingsOnRight =
936 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
938 widthsOnLeft : Float
939 widthsOnLeft =
940 siblingsOnLeft
941 |> List.map (.width << .bbox)
942 |> List.sum
943 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
945 widthsOnRight =
946 siblingsOnRight
947 |> List.map (.width << .bbox)
948 |> List.sum
949 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
951 expectedCenter : Float
952 expectedCenter =
953 found.parent.bbox.left
954 + widthsOnLeft
955 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
956 / 2
957 )
958 in
959 [ expectRoundedEquality
960 { found = selfCenter
961 , expected = expectedCenter
962 }
963 ]
965 _ ->
966 [ expectRoundedEquality
967 { found = selfCenter
968 , expected = parentCenter
969 }
970 ]
971 }
974{-| -}
975alignRight : Testable.Attr msg
976alignRight =
977 Testable.LabeledTest
978 { label = "alignRight"
979 , attr = Element.alignRight
980 , id = Testable.NoId
981 , test =
982 \found ->
983 if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
984 [ Testable.true "alignRight doesn't apply to elements that are onLeft or onRight" True ]
986 else if
987 List.member found.parentLayout
988 [ Testable.IsNearby Testable.InFront
989 , Testable.IsNearby Testable.Behind
990 , Testable.IsNearby Testable.Above
991 , Testable.IsNearby Testable.Below
992 ]
993 then
994 [ expectRoundedEquality
995 { found = found.self.bbox.right
996 , expected = found.parent.bbox.right
997 }
998 ]
1000 else if List.length found.siblings == 0 then
1001 [ expectRoundedEquality
1002 { found = found.self.bbox.right
1003 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1007 else
1008 case found.parentLayout of
1009 Testable.InRow ->
1010 let
1011 siblingsOnRight =
1012 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1014 spacings =
1015 toFloat (List.length siblingsOnRight * found.parentSpacing)
1017 widthsOnRight =
1018 siblingsOnRight
1019 |> List.map (.width << .bbox)
1020 |> List.sum
1021 in
1022 [ expectRoundedEquality
1023 { found = found.self.bbox.right
1024 , expected = found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings)
1028 _ ->
1029 [ expectRoundedEquality
1030 { found = found.self.bbox.right
1031 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1037{-| -}
1038alignTop : Testable.Attr msg
1039alignTop =
1040 Testable.LabeledTest
1041 { label = "alignTop"
1042 , attr = Element.alignTop
1043 , id = Testable.NoId
1044 , test =
1045 \found ->
1046 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1047 [ Testable.true "alignTop doesn't apply to elements that are above or below" True ]
1049 else if
1050 List.member found.parentLayout
1051 [ Testable.IsNearby Testable.InFront
1052 , Testable.IsNearby Testable.Behind
1053 , Testable.IsNearby Testable.OnRight
1054 , Testable.IsNearby Testable.OnLeft
1056 then
1057 [ expectRoundedEquality
1058 { found = found.self.bbox.top
1059 , expected = found.parent.bbox.top
1063 else if List.length found.siblings == 0 then
1064 [ expectRoundedEquality
1065 { found = found.self.bbox.top
1066 , expected = found.parent.bbox.top + found.parent.bbox.padding.top
1070 else
1071 case found.parentLayout of
1072 Testable.InColumn ->
1073 let
1074 siblingsAbove =
1075 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1077 spacings =
1078 toFloat (List.length siblingsAbove * found.parentSpacing)
1080 heightsAbove =
1081 siblingsAbove
1082 |> List.map (.height << .bbox)
1083 |> List.sum
1084 in
1085 [ expectRoundedEquality
1086 { found = found.self.bbox.top
1087 , expected = found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings)
1091 _ ->
1092 [ expectRoundedEquality
1093 { found = found.self.bbox.top
1094 , expected = found.parent.bbox.top
1100{-| -}
1101alignBottom : Testable.Attr msg
1102alignBottom =
1103 Testable.LabeledTest
1104 { label = "alignBottom"
1105 , attr = Element.alignBottom
1106 , id = Testable.NoId
1107 , test =
1108 \found ->
1109 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1110 [ Testable.true "alignBottom doesn't apply to elements that are above or below" True ]
1112 else if
1113 List.member found.parentLayout
1114 [ Testable.IsNearby Testable.InFront
1115 , Testable.IsNearby Testable.Behind
1116 , Testable.IsNearby Testable.OnRight
1117 , Testable.IsNearby Testable.OnLeft
1119 then
1120 [ expectRoundedEquality
1121 { found = found.self.bbox.bottom
1122 , expected = found.parent.bbox.bottom
1126 else if List.length found.siblings == 0 then
1127 [ expectRoundedEquality
1128 { found = found.self.bbox.bottom
1129 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1133 else
1134 case found.parentLayout of
1135 Testable.InColumn ->
1136 let
1137 siblingsBelow =
1138 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1140 spacings =
1141 toFloat (List.length siblingsBelow * found.parentSpacing)
1143 heightsBelow =
1144 siblingsBelow
1145 |> List.map (.height << .bbox)
1146 |> List.sum
1147 in
1148 [ expectRoundedEquality
1149 { found = found.self.bbox.bottom
1150 , expected = found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings)
1154 _ ->
1155 [ expectRoundedEquality
1156 { found = found.self.bbox.bottom
1157 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1163expectRoundedEquality : { expected : Float, found : Float } -> Testable.LayoutExpectation
1164expectRoundedEquality { expected, found } =
1165 Testable.true
1166 ("expected " ++ floatToString expected ++ ", found " ++ floatToString found)
1167 (abs (expected - found) < 1)
1170floatToString : Float -> String
1171floatToString x =
1172 String.fromFloat (toFloat (round (x * 100)) / 100)
1175{-| -}
1176centerY : Testable.Attr msg
1177centerY =
1178 Testable.LabeledTest
1179 { label = "centerY"
1180 , attr = Element.centerY
1181 , id = Testable.NoId
1182 , test =
1183 \found ->
1184 let
1185 selfCenter =
1186 found.self.bbox.top + (found.self.bbox.height / 2)
1188 parentCenter =
1189 found.parent.bbox.top + (found.parent.bbox.height / 2)
1190 in
1191 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1192 [ Testable.true "centerY doesn't apply to elements that are above or below" True ]
1194 else if List.length found.siblings == 0 then
1195 [ expectRoundedEquality
1196 { found = selfCenter
1197 , expected = parentCenter
1201 else
1202 case found.parentLayout of
1203 Testable.InColumn ->
1204 let
1205 siblingsOnTop =
1206 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1208 siblingsBelow =
1209 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1211 heightsAbove : Float
1212 heightsAbove =
1213 siblingsOnTop
1214 |> List.map (.height << .bbox)
1215 |> List.sum
1216 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1218 heightsBelow =
1219 siblingsBelow
1220 |> List.map (.height << .bbox)
1221 |> List.sum
1222 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1224 expectedCenter : Float
1225 expectedCenter =
1226 found.parent.bbox.top
1227 + heightsAbove
1228 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1229 / 2
1231 in
1232 [ expectRoundedEquality
1233 { found = selfCenter
1234 , expected = expectedCenter
1238 _ ->
1239 [ expectRoundedEquality
1240 { found = selfCenter
1241 , expected = parentCenter
1247{-| -}
1248above : Testable.Element msg -> Testable.Attr msg
1249above element =
1250 Testable.Nearby
1251 { location = Testable.Above
1252 , element = element
1253 , label = "above"
1254 , test =
1255 \found ->
1256 [ expectRoundedEquality
1257 { found = found.self.bbox.bottom
1258 , expected = found.parent.bbox.top
1264{-| -}
1265below : Testable.Element msg -> Testable.Attr msg
1266below element =
1267 Testable.Nearby
1268 { location = Testable.Below
1269 , element = element
1270 , label = "below"
1271 , test =
1272 \found ->
1273 [ expectRoundedEquality
1274 { found = found.self.bbox.top
1275 , expected = found.parent.bbox.bottom
1281{-| -}
1282onRight : Testable.Element msg -> Testable.Attr msg
1283onRight element =
1284 Testable.Nearby
1285 { location = Testable.OnRight
1286 , element = element
1287 , label = "onRight"
1288 , test =
1289 \found ->
1290 [ expectRoundedEquality
1291 { found = found.self.bbox.left
1292 , expected = found.parent.bbox.right
1298{-| -}
1299onLeft : Testable.Element msg -> Testable.Attr msg
1300onLeft element =
1301 Testable.Nearby
1302 { location = Testable.OnLeft
1303 , element = element
1304 , label = "onLeft"
1305 , test =
1306 \found ->
1307 [ expectRoundedEquality
1308 { found = found.self.bbox.right
1309 , expected = found.parent.bbox.left
1315compare x vs y =
1316 vs (round x) (round y) || vs (floor x) (floor y)
1319{-| -}
1320inFront : Testable.Element msg -> Testable.Attr msg
1321inFront element =
1322 Testable.Nearby
1323 { location = Testable.InFront
1324 , element = element
1325 , label = "inFront"
1326 , test =
1327 \found ->
1328 [ withinHelper found ]
1332withinHelper found =
1333 let
1334 horizontalCheck =
1335 if found.self.bbox.width > found.parent.bbox.width then
1336 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1337 || compare found.self.bbox.left (>=) found.parent.bbox.left
1340 else
1341 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1342 , compare found.self.bbox.left (>=) found.parent.bbox.left
1345 verticalCheck =
1346 if found.self.bbox.width > found.parent.bbox.width then
1347 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1348 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1351 else
1352 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1353 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1355 in
1356 Testable.true "within the confines of the parent"
1357 (List.all ((==) True)
1358 (List.concat
1359 [ horizontalCheck
1360 , verticalCheck
1366{-| -}
1367behindContent : Testable.Element msg -> Testable.Attr msg
1368behindContent element =
1369 Testable.Nearby
1370 { location = Testable.Behind
1371 , element = element
1372 , label = "behindContent"
1373 , test =
1374 \found ->
1375 [ withinHelper found ]
1380{- Implicit width/height calcualtions -}
1383implicitWidthHeightShrink attrs =
1384 let
1385 withImplicits =
1386 implicitTest (widthHelper Nothing Nothing Shrink)
1387 :: implicitTest (heightHelper Nothing Nothing Shrink)
1388 :: attrs
1389 in
1390 skipOverridden withImplicits
1393attrId attr =
1394 case attr of
1395 Testable.LabeledTest details ->
1396 details.id
1398 Testable.AttrTest details ->
1399 details.id
1401 _ ->
1402 Testable.NoId
1405skipOverridden ls =
1406 List.foldr
1407 (\attr ( found, caught ) ->
1408 let
1409 ( skip, has ) =
1410 case attrId attr of
1411 Testable.NoId ->
1412 ( False, found )
1414 Testable.IsWidth ->
1415 ( found.hasWidth
1416 , { hasWidth = True
1417 , hasHeight = found.hasHeight
1421 Testable.IsHeight ->
1422 ( found.hasHeight
1423 , { hasWidth = found.hasWidth
1424 , hasHeight = True
1427 in
1428 ( has
1429 , if skip then
1430 caught
1432 else
1433 attr :: caught
1436 ( { hasWidth = False
1437 , hasHeight = False
1439 , []
1441 ls
1442 |> Tuple.second
1443 |> List.reverse
1446{-| This is taking a normal test and rmoving its ability to attach a real `Element` attribute.
1448implicitTest attr =
1449 case attr of
1450 Testable.LabeledTest details ->
1451 Testable.AttrTest
1452 { test = details.test
1453 , label = "Implicit -> " ++ details.label
1454 , id = details.id
1457 otherwise ->
1458 otherwise