git.iko.soy/typeable/elm-ui
on d188db2 help sign in
typeable/elm-ui/tests-rendering/src/Testable/Element.elm
1455 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 _ _ ->
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 spacingValue =
725 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
726 in
727 [ expectRoundedEquality
728 { expected = totalChildren + verticalPadding + spacingValue
729 , found = context.self.bbox.height
730 }
731 ]
733 Testable.TextColumn _ _ ->
734 []
736 Testable.Paragraph _ _ ->
737 []
739 Testable.Text _ ->
740 []
742 Testable.Empty ->
743 []
744 }
747width : Length -> Testable.Attr msg
748width len =
749 widthHelper Nothing Nothing len
752height : Length -> Testable.Attr msg
753height len =
754 heightHelper Nothing Nothing len
757spacing : Int -> Testable.Attr msg
758spacing space =
759 Testable.Batch
760 [ Testable.Spacing space
761 , Testable.LabeledTest
762 { label = "spacing: " ++ String.fromInt space
763 , attr = Element.spacing space
764 , id = Testable.NoId
765 , test =
766 \found ->
767 let
768 findDistance child total =
769 List.concatMap
770 (\otherChild ->
771 let
772 horizontal =
773 round <|
774 child.bbox.left
775 - otherChild.bbox.right
777 vertical =
778 round <|
779 child.bbox.top
780 - otherChild.bbox.bottom
781 in
782 [ if horizontal > 0 then
783 horizontal
785 else
786 space
787 , if vertical > 0 then
788 vertical
790 else
791 space
792 ]
793 )
794 found.children
795 ++ total
797 distances =
798 List.foldl findDistance [] found.children
800 allAreSpaced =
801 List.foldl
802 (\x wrong ->
803 if not (x >= space) then
804 x :: wrong
806 else
807 wrong
808 )
809 []
810 distances
811 in
812 [ Testable.true
813 ("All children are at least "
814 ++ String.fromInt space
815 ++ " pixels apart."
816 ++ Debug.toString allAreSpaced
817 ++ " are not though"
818 )
819 (allAreSpaced == [])
820 ]
821 }
822 ]
825{-| alignLeft needs to account for
827 - parent padding
828 - elements to the left
829 - spacing value
831in order to calculate the expected result.
833Also need parent rendering context if this is to work with wrapped rows in the future.
835All sibling elements
837-}
838alignLeft : Testable.Attr msg
839alignLeft =
840 Testable.LabeledTest
841 { label = "alignLeft"
842 , attr = Element.alignLeft
843 , id = Testable.NoId
844 , test =
845 \found ->
846 [ if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
847 Testable.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
849 else if
850 List.member found.parentLayout
851 [ Testable.IsNearby Testable.InFront
852 , Testable.IsNearby Testable.Behind
853 , Testable.IsNearby Testable.Above
854 , Testable.IsNearby Testable.Below
855 ]
856 then
857 expectRoundedEquality
858 { found = found.self.bbox.left
859 , expected = found.parent.bbox.left
860 }
862 else if List.length found.siblings == 0 then
863 expectRoundedEquality
864 { found = found.self.bbox.left
865 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
866 }
868 else
869 case found.parentLayout of
870 Testable.InRow ->
871 let
872 siblingsOnLeft =
873 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
875 spacings =
876 toFloat (List.length siblingsOnLeft * found.parentSpacing)
878 widthsOnLeft =
879 siblingsOnLeft
880 |> List.map (.width << .bbox)
881 |> List.sum
882 in
883 expectRoundedEquality
884 { found = found.self.bbox.left
885 , expected = found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings)
886 }
888 _ ->
889 expectRoundedEquality
890 { found = found.self.bbox.left
891 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
892 }
893 ]
894 }
897{-| -}
898centerX : Testable.Attr msg
899centerX =
900 Testable.LabeledTest
901 { label = "centerX"
902 , attr = Element.centerX
903 , id = Testable.NoId
904 , test =
905 \found ->
906 let
907 selfCenter : Float
908 selfCenter =
909 found.self.bbox.left + (found.self.bbox.width / 2)
911 parentCenter : Float
912 parentCenter =
913 found.parent.bbox.left + (found.parent.bbox.width / 2)
914 in
915 if List.member found.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
916 [ Testable.true "centerX doesn't apply to elements that are onLeft or onRight" True ]
918 else if List.length found.siblings == 0 then
919 [ expectRoundedEquality
920 { found = selfCenter
921 , expected = parentCenter
922 }
923 ]
925 else
926 case found.parentLayout of
927 Testable.InRow ->
928 let
929 siblingsOnLeft =
930 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
932 siblingsOnRight =
933 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
935 widthsOnLeft : Float
936 widthsOnLeft =
937 siblingsOnLeft
938 |> List.map (.width << .bbox)
939 |> List.sum
940 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
942 widthsOnRight =
943 siblingsOnRight
944 |> List.map (.width << .bbox)
945 |> List.sum
946 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
948 expectedCenter : Float
949 expectedCenter =
950 found.parent.bbox.left
951 + widthsOnLeft
952 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
953 / 2
954 )
955 in
956 [ expectRoundedEquality
957 { found = selfCenter
958 , expected = expectedCenter
959 }
960 ]
962 _ ->
963 [ expectRoundedEquality
964 { found = selfCenter
965 , expected = parentCenter
966 }
967 ]
968 }
971{-| -}
972alignRight : Testable.Attr msg
973alignRight =
974 Testable.LabeledTest
975 { label = "alignRight"
976 , attr = Element.alignRight
977 , id = Testable.NoId
978 , test =
979 \found ->
980 if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
981 [ Testable.true "alignRight doesn't apply to elements that are onLeft or onRight" True ]
983 else if
984 List.member found.parentLayout
985 [ Testable.IsNearby Testable.InFront
986 , Testable.IsNearby Testable.Behind
987 , Testable.IsNearby Testable.Above
988 , Testable.IsNearby Testable.Below
989 ]
990 then
991 [ expectRoundedEquality
992 { found = found.self.bbox.right
993 , expected = found.parent.bbox.right
994 }
995 ]
997 else if List.length found.siblings == 0 then
998 [ expectRoundedEquality
999 { found = found.self.bbox.right
1000 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1004 else
1005 case found.parentLayout of
1006 Testable.InRow ->
1007 let
1008 siblingsOnRight =
1009 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1011 spacings =
1012 toFloat (List.length siblingsOnRight * found.parentSpacing)
1014 widthsOnRight =
1015 siblingsOnRight
1016 |> List.map (.width << .bbox)
1017 |> List.sum
1018 in
1019 [ expectRoundedEquality
1020 { found = found.self.bbox.right
1021 , expected = found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings)
1025 _ ->
1026 [ expectRoundedEquality
1027 { found = found.self.bbox.right
1028 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1034{-| -}
1035alignTop : Testable.Attr msg
1036alignTop =
1037 Testable.LabeledTest
1038 { label = "alignTop"
1039 , attr = Element.alignTop
1040 , id = Testable.NoId
1041 , test =
1042 \found ->
1043 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1044 [ Testable.true "alignTop doesn't apply to elements that are above or below" True ]
1046 else if
1047 List.member found.parentLayout
1048 [ Testable.IsNearby Testable.InFront
1049 , Testable.IsNearby Testable.Behind
1050 , Testable.IsNearby Testable.OnRight
1051 , Testable.IsNearby Testable.OnLeft
1053 then
1054 [ expectRoundedEquality
1055 { found = found.self.bbox.top
1056 , expected = found.parent.bbox.top
1060 else if List.length found.siblings == 0 then
1061 [ expectRoundedEquality
1062 { found = found.self.bbox.top
1063 , expected = found.parent.bbox.top + found.parent.bbox.padding.top
1067 else
1068 case found.parentLayout of
1069 Testable.InColumn ->
1070 let
1071 siblingsAbove =
1072 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1074 spacings =
1075 toFloat (List.length siblingsAbove * found.parentSpacing)
1077 heightsAbove =
1078 siblingsAbove
1079 |> List.map (.height << .bbox)
1080 |> List.sum
1081 in
1082 [ expectRoundedEquality
1083 { found = found.self.bbox.top
1084 , expected = found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings)
1088 _ ->
1089 [ expectRoundedEquality
1090 { found = found.self.bbox.top
1091 , expected = found.parent.bbox.top
1097{-| -}
1098alignBottom : Testable.Attr msg
1099alignBottom =
1100 Testable.LabeledTest
1101 { label = "alignBottom"
1102 , attr = Element.alignBottom
1103 , id = Testable.NoId
1104 , test =
1105 \found ->
1106 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1107 [ Testable.true "alignBottom doesn't apply to elements that are above or below" True ]
1109 else if
1110 List.member found.parentLayout
1111 [ Testable.IsNearby Testable.InFront
1112 , Testable.IsNearby Testable.Behind
1113 , Testable.IsNearby Testable.OnRight
1114 , Testable.IsNearby Testable.OnLeft
1116 then
1117 [ expectRoundedEquality
1118 { found = found.self.bbox.bottom
1119 , expected = found.parent.bbox.bottom
1123 else if List.length found.siblings == 0 then
1124 [ expectRoundedEquality
1125 { found = found.self.bbox.bottom
1126 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1130 else
1131 case found.parentLayout of
1132 Testable.InColumn ->
1133 let
1134 siblingsBelow =
1135 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1137 spacings =
1138 toFloat (List.length siblingsBelow * found.parentSpacing)
1140 heightsBelow =
1141 siblingsBelow
1142 |> List.map (.height << .bbox)
1143 |> List.sum
1144 in
1145 [ expectRoundedEquality
1146 { found = found.self.bbox.bottom
1147 , expected = found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings)
1151 _ ->
1152 [ expectRoundedEquality
1153 { found = found.self.bbox.bottom
1154 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1160expectRoundedEquality : { expected : Float, found : Float } -> Testable.LayoutExpectation
1161expectRoundedEquality { expected, found } =
1162 Testable.true
1163 ("expected " ++ floatToString expected ++ ", found " ++ floatToString found)
1164 (abs (expected - found) < 1)
1167floatToString : Float -> String
1168floatToString x =
1169 String.fromFloat (toFloat (round (x * 100)) / 100)
1172{-| -}
1173centerY : Testable.Attr msg
1174centerY =
1175 Testable.LabeledTest
1176 { label = "centerY"
1177 , attr = Element.centerY
1178 , id = Testable.NoId
1179 , test =
1180 \found ->
1181 let
1182 selfCenter =
1183 found.self.bbox.top + (found.self.bbox.height / 2)
1185 parentCenter =
1186 found.parent.bbox.top + (found.parent.bbox.height / 2)
1187 in
1188 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1189 [ Testable.true "centerY doesn't apply to elements that are above or below" True ]
1191 else if List.length found.siblings == 0 then
1192 [ expectRoundedEquality
1193 { found = selfCenter
1194 , expected = parentCenter
1198 else
1199 case found.parentLayout of
1200 Testable.InColumn ->
1201 let
1202 siblingsOnTop =
1203 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1205 siblingsBelow =
1206 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1208 heightsAbove : Float
1209 heightsAbove =
1210 siblingsOnTop
1211 |> List.map (.height << .bbox)
1212 |> List.sum
1213 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1215 heightsBelow =
1216 siblingsBelow
1217 |> List.map (.height << .bbox)
1218 |> List.sum
1219 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1221 expectedCenter : Float
1222 expectedCenter =
1223 found.parent.bbox.top
1224 + heightsAbove
1225 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1226 / 2
1228 in
1229 [ expectRoundedEquality
1230 { found = selfCenter
1231 , expected = expectedCenter
1235 _ ->
1236 [ expectRoundedEquality
1237 { found = selfCenter
1238 , expected = parentCenter
1244{-| -}
1245above : Testable.Element msg -> Testable.Attr msg
1246above element =
1247 Testable.Nearby
1248 { location = Testable.Above
1249 , element = element
1250 , label = "above"
1251 , test =
1252 \found ->
1253 [ expectRoundedEquality
1254 { found = found.self.bbox.bottom
1255 , expected = found.parent.bbox.top
1261{-| -}
1262below : Testable.Element msg -> Testable.Attr msg
1263below element =
1264 Testable.Nearby
1265 { location = Testable.Below
1266 , element = element
1267 , label = "below"
1268 , test =
1269 \found ->
1270 [ expectRoundedEquality
1271 { found = found.self.bbox.top
1272 , expected = found.parent.bbox.bottom
1278{-| -}
1279onRight : Testable.Element msg -> Testable.Attr msg
1280onRight element =
1281 Testable.Nearby
1282 { location = Testable.OnRight
1283 , element = element
1284 , label = "onRight"
1285 , test =
1286 \found ->
1287 [ expectRoundedEquality
1288 { found = found.self.bbox.left
1289 , expected = found.parent.bbox.right
1295{-| -}
1296onLeft : Testable.Element msg -> Testable.Attr msg
1297onLeft element =
1298 Testable.Nearby
1299 { location = Testable.OnLeft
1300 , element = element
1301 , label = "onLeft"
1302 , test =
1303 \found ->
1304 [ expectRoundedEquality
1305 { found = found.self.bbox.right
1306 , expected = found.parent.bbox.left
1312compare x vs y =
1313 vs (round x) (round y) || vs (floor x) (floor y)
1316{-| -}
1317inFront : Testable.Element msg -> Testable.Attr msg
1318inFront element =
1319 Testable.Nearby
1320 { location = Testable.InFront
1321 , element = element
1322 , label = "inFront"
1323 , test =
1324 \found ->
1325 [ withinHelper found ]
1329withinHelper found =
1330 let
1331 horizontalCheck =
1332 if found.self.bbox.width > found.parent.bbox.width then
1333 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1334 || compare found.self.bbox.left (>=) found.parent.bbox.left
1337 else
1338 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1339 , compare found.self.bbox.left (>=) found.parent.bbox.left
1342 verticalCheck =
1343 if found.self.bbox.width > found.parent.bbox.width then
1344 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1345 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1348 else
1349 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1350 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1352 in
1353 Testable.true "within the confines of the parent"
1354 (List.all ((==) True)
1355 (List.concat
1356 [ horizontalCheck
1357 , verticalCheck
1363{-| -}
1364behindContent : Testable.Element msg -> Testable.Attr msg
1365behindContent element =
1366 Testable.Nearby
1367 { location = Testable.Behind
1368 , element = element
1369 , label = "behindContent"
1370 , test =
1371 \found ->
1372 [ withinHelper found ]
1377{- Implicit width/height calcualtions -}
1380implicitWidthHeightShrink attrs =
1381 let
1382 withImplicits =
1383 implicitTest (widthHelper Nothing Nothing Shrink)
1384 :: implicitTest (heightHelper Nothing Nothing Shrink)
1385 :: attrs
1386 in
1387 skipOverridden withImplicits
1390attrId attr =
1391 case attr of
1392 Testable.LabeledTest details ->
1393 details.id
1395 Testable.AttrTest details ->
1396 details.id
1398 _ ->
1399 Testable.NoId
1402skipOverridden ls =
1403 List.foldr
1404 (\attr ( found, caught ) ->
1405 let
1406 ( skip, has ) =
1407 case attrId attr of
1408 Testable.NoId ->
1409 ( False, found )
1411 Testable.IsWidth ->
1412 ( found.hasWidth
1413 , { hasWidth = True
1414 , hasHeight = found.hasHeight
1418 Testable.IsHeight ->
1419 ( found.hasHeight
1420 , { hasWidth = found.hasWidth
1421 , hasHeight = True
1424 in
1425 ( has
1426 , if skip then
1427 caught
1429 else
1430 attr :: caught
1433 ( { hasWidth = False
1434 , hasHeight = False
1436 , []
1438 ls
1439 |> Tuple.second
1440 |> List.reverse
1443{-| This is taking a normal test and rmoving its ability to attach a real `Element` attribute.
1445implicitTest attr =
1446 case attr of
1447 Testable.LabeledTest details ->
1448 Testable.AttrTest
1449 { test = details.test
1450 , label = "Implicit -> " ++ details.label
1451 , id = details.id
1454 otherwise ->
1455 otherwise