git.iko.soy/typeable/elm-ui
on d6d2a8a help sign in
typeable/elm-ui/tests-rendering/src/Testable/Element.elm
1328 lines 45 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 =
100 Testable.Paragraph
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.location [ 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.location 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 let
419 childWidth child =
420 -- TODO: add margin values to widths
421 child.bbox.width
423 totalChildren =
424 context.children
425 |> List.map childWidth
426 |> List.sum
428 horizontalPadding =
429 context.self.bbox.padding.left + context.self.bbox.padding.right
431 spacingValue =
432 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
433 in
434 if totalChildren == 0 then
435 -- TODO: The issue is that we have a hard time measuring `text` elements
436 -- So if a element has a text child, then it's width isn't going to show up in the system.
437 [ Testable.Todo "Calculate text size for width-shrink calculation"
438 ]
440 else
441 -- This fails if this element is actually a column
442 -- So we need to capture what this element is in order to do this calculation.
443 [ expectRoundedEquality
444 { expected = totalChildren + horizontalPadding + spacingValue
445 , found = context.self.bbox.width
446 }
447 ]
448 }
451heightHelper maybeMin maybeMax len =
452 let
453 addMin l =
454 case maybeMin of
455 Nothing ->
456 l
458 Just minPx ->
459 l |> Element.minimum minPx
461 addMax l =
462 case maybeMax of
463 Nothing ->
464 l
466 Just maxPx ->
467 l |> Element.maximum maxPx
469 minLabel =
470 case maybeMin of
471 Nothing ->
472 ""
474 Just i ->
475 " min:" ++ String.fromInt i
477 maxLabel =
478 case maybeMax of
479 Nothing ->
480 ""
482 Just i ->
483 " max:" ++ String.fromInt i
485 minMaxTest actualheight =
486 case ( maybeMin, maybeMax ) of
487 ( Nothing, Nothing ) ->
488 True
490 ( Just lower, Nothing ) ->
491 lower <= actualheight
493 ( Just lower, Just higher ) ->
494 lower <= actualheight && actualheight <= higher
496 ( Nothing, Just higher ) ->
497 actualheight <= higher
498 in
499 case len of
500 Minimum m newLen ->
501 heightHelper (Just m) maybeMax newLen
503 Maximum m newLen ->
504 heightHelper maybeMin (Just m) newLen
506 Px val ->
507 -- Pixel values should ignore min and max?
508 Testable.LabeledTest
509 { label = "height " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
510 , attr =
511 Element.height
512 (Element.px val
513 |> addMin
514 |> addMax
515 )
516 , id = Testable.IsHeight
517 , test =
518 \found ->
519 [ Testable.true ("exact height is exact: " ++ String.fromInt (floor found.self.bbox.height) ++ "," ++ String.fromInt val)
520 (floor found.self.bbox.height == val)
521 , Testable.true "min/max holds true"
522 (minMaxTest (floor found.self.bbox.height))
523 ]
524 }
526 Fill portion ->
527 Testable.LabeledTest
528 { label = "height fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
529 , attr =
530 Element.height
531 (Element.fillPortion portion
532 |> addMin
533 |> addMax
534 )
535 , id = Testable.IsHeight
536 , test =
537 \context ->
538 [ if List.member context.location [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
539 Testable.true "height fill doesn't apply to above/below elements" True
541 else
542 let
543 parentAvailableHeight =
544 context.parent.bbox.height - (context.self.bbox.padding.top + context.self.bbox.padding.bottom)
545 in
546 case context.location of
547 Testable.IsNearby _ ->
548 Testable.true "Nearby Element has fill height"
549 ((floor context.parent.bbox.height == floor context.self.bbox.height)
550 || minMaxTest (floor context.self.bbox.height)
551 )
553 Testable.InColumn ->
554 Testable.true "Element within column has fill height"
555 ((floor parentAvailableHeight == floor context.self.bbox.height)
556 || minMaxTest (floor context.self.bbox.height)
557 )
559 Testable.InEl ->
560 Testable.true "Element within el has fill height" <|
561 (floor parentAvailableHeight == floor context.self.bbox.height)
562 || minMaxTest (floor context.self.bbox.height)
564 _ ->
565 let
566 spacePerPortion =
567 parentAvailableHeight / toFloat (List.length context.siblings + 1)
568 in
569 Testable.true "el has fill height" <|
570 (floor spacePerPortion == floor context.self.bbox.height)
571 || minMaxTest (floor context.self.bbox.height)
572 ]
573 }
575 Shrink ->
576 Testable.LabeledTest
577 { label = "height shrink" ++ minLabel ++ maxLabel
578 , attr =
579 Element.height
580 (Element.shrink
581 |> addMin
582 |> addMax
583 )
584 , id = Testable.IsHeight
585 , test =
586 \context ->
587 let
588 childHeight child =
589 -- TODO: add margin values to heights
590 child.bbox.height
592 totalChildren =
593 context.children
594 |> List.map childHeight
595 |> List.sum
597 verticalPadding =
598 context.self.bbox.padding.top + context.self.bbox.padding.bottom
600 spacingValue =
601 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
602 in
603 if totalChildren == 0 then
604 -- TODO: The issue is that we have a hard time measuring `text` elements
605 -- So if a element has a text child, then it's height isn't going to show up in the system.
606 [ Testable.Todo "Calculate expected height shrink"
607 ]
609 else
610 -- This fails if this element is actually a column
611 -- So we need to capture what this element is in order to do this calculation.
612 [ expectRoundedEquality
613 { expected = totalChildren + verticalPadding + spacingValue
614 , found = context.self.bbox.height
615 }
616 ]
617 }
620width : Length -> Testable.Attr msg
621width len =
622 widthHelper Nothing Nothing len
625height : Length -> Testable.Attr msg
626height len =
627 heightHelper Nothing Nothing len
630spacing : Int -> Testable.Attr msg
631spacing space =
632 Testable.Batch
633 [ Testable.Spacing space
634 , Testable.LabeledTest
635 { label = "spacing: " ++ String.fromInt space
636 , attr = Element.spacing space
637 , id = Testable.NoId
638 , test =
639 \found ->
640 let
641 findDistance child total =
642 List.concatMap
643 (\otherChild ->
644 let
645 horizontal =
646 round <|
647 child.bbox.left
648 - otherChild.bbox.right
650 vertical =
651 round <|
652 child.bbox.top
653 - otherChild.bbox.bottom
654 in
655 [ if horizontal > 0 then
656 horizontal
658 else
659 space
660 , if vertical > 0 then
661 vertical
663 else
664 space
665 ]
666 )
667 found.children
668 ++ total
670 distances =
671 List.foldl findDistance [] found.children
673 allAreSpaced =
674 List.foldl
675 (\x wrong ->
676 if not (x >= space) then
677 x :: wrong
679 else
680 wrong
681 )
682 []
683 distances
684 in
685 [ Testable.true
686 ("All children are at least "
687 ++ String.fromInt space
688 ++ " pixels apart."
689 ++ Debug.toString allAreSpaced
690 ++ " are not though"
691 )
692 (allAreSpaced == [])
693 ]
694 }
695 ]
698{-| alignLeft needs to account for
700 - parent padding
701 - elements to the left
702 - spacing value
704in order to calculate the expected result.
706Also need parent rendering context if this is to work with wrapped rows in the future.
708All sibling elements
710-}
711alignLeft : Testable.Attr msg
712alignLeft =
713 Testable.LabeledTest
714 { label = "alignLeft"
715 , attr = Element.alignLeft
716 , id = Testable.NoId
717 , test =
718 \found ->
719 [ if List.member found.location [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
720 Testable.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
722 else if
723 List.member found.location
724 [ Testable.IsNearby Testable.InFront
725 , Testable.IsNearby Testable.Behind
726 , Testable.IsNearby Testable.Above
727 , Testable.IsNearby Testable.Below
728 ]
729 then
730 expectRoundedEquality
731 { found = found.self.bbox.left
732 , expected = found.parent.bbox.left
733 }
735 else if List.length found.siblings == 0 then
736 expectRoundedEquality
737 { found = found.self.bbox.left
738 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
739 }
741 else
742 case found.location of
743 Testable.InRow ->
744 let
745 siblingsOnLeft =
746 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
748 spacings =
749 toFloat (List.length siblingsOnLeft * found.parentSpacing)
751 widthsOnLeft =
752 siblingsOnLeft
753 |> List.map (.width << .bbox)
754 |> List.sum
755 in
756 expectRoundedEquality
757 { found = found.self.bbox.left
758 , expected = found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings)
759 }
761 _ ->
762 expectRoundedEquality
763 { found = found.self.bbox.left
764 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
765 }
766 ]
767 }
770{-| -}
771centerX : Testable.Attr msg
772centerX =
773 Testable.LabeledTest
774 { label = "centerX"
775 , attr = Element.centerX
776 , id = Testable.NoId
777 , test =
778 \found ->
779 let
780 selfCenter : Float
781 selfCenter =
782 found.self.bbox.left + (found.self.bbox.width / 2)
784 parentCenter : Float
785 parentCenter =
786 found.parent.bbox.left + (found.parent.bbox.width / 2)
787 in
788 if List.member found.location [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
789 [ Testable.true "centerX doesn't apply to elements that are onLeft or onRight" True ]
791 else if List.length found.siblings == 0 then
792 [ expectRoundedEquality
793 { found = selfCenter
794 , expected = parentCenter
795 }
796 ]
798 else
799 case found.location of
800 Testable.InRow ->
801 let
802 siblingsOnLeft =
803 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
805 siblingsOnRight =
806 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
808 widthsOnLeft : Float
809 widthsOnLeft =
810 siblingsOnLeft
811 |> List.map (.width << .bbox)
812 |> List.sum
813 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
815 widthsOnRight =
816 siblingsOnRight
817 |> List.map (.width << .bbox)
818 |> List.sum
819 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
821 expectedCenter : Float
822 expectedCenter =
823 found.parent.bbox.left
824 + widthsOnLeft
825 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
826 / 2
827 )
828 in
829 [ expectRoundedEquality
830 { found = selfCenter
831 , expected = expectedCenter
832 }
833 ]
835 _ ->
836 [ expectRoundedEquality
837 { found = selfCenter
838 , expected = parentCenter
839 }
840 ]
841 }
844{-| -}
845alignRight : Testable.Attr msg
846alignRight =
847 Testable.LabeledTest
848 { label = "alignRight"
849 , attr = Element.alignRight
850 , id = Testable.NoId
851 , test =
852 \found ->
853 if List.member found.location [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
854 [ Testable.true "alignRight doesn't apply to elements that are onLeft or onRight" True ]
856 else if
857 List.member found.location
858 [ Testable.IsNearby Testable.InFront
859 , Testable.IsNearby Testable.Behind
860 , Testable.IsNearby Testable.Above
861 , Testable.IsNearby Testable.Below
862 ]
863 then
864 [ expectRoundedEquality
865 { found = found.self.bbox.right
866 , expected = found.parent.bbox.right
867 }
868 ]
870 else if List.length found.siblings == 0 then
871 [ expectRoundedEquality
872 { found = found.self.bbox.right
873 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
874 }
875 ]
877 else
878 case found.location of
879 Testable.InRow ->
880 let
881 siblingsOnRight =
882 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
884 spacings =
885 toFloat (List.length siblingsOnRight * found.parentSpacing)
887 widthsOnRight =
888 siblingsOnRight
889 |> List.map (.width << .bbox)
890 |> List.sum
891 in
892 [ expectRoundedEquality
893 { found = found.self.bbox.right
894 , expected = found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings)
895 }
896 ]
898 _ ->
899 [ expectRoundedEquality
900 { found = found.self.bbox.right
901 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
902 }
903 ]
904 }
907{-| -}
908alignTop : Testable.Attr msg
909alignTop =
910 Testable.LabeledTest
911 { label = "alignTop"
912 , attr = Element.alignTop
913 , id = Testable.NoId
914 , test =
915 \found ->
916 if List.member found.location [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
917 [ Testable.true "alignTop doesn't apply to elements that are above or below" True ]
919 else if
920 List.member found.location
921 [ Testable.IsNearby Testable.InFront
922 , Testable.IsNearby Testable.Behind
923 , Testable.IsNearby Testable.OnRight
924 , Testable.IsNearby Testable.OnLeft
925 ]
926 then
927 [ expectRoundedEquality
928 { found = found.self.bbox.top
929 , expected = found.parent.bbox.top
930 }
931 ]
933 else if List.length found.siblings == 0 then
934 [ expectRoundedEquality
935 { found = found.self.bbox.top
936 , expected = found.parent.bbox.top + found.parent.bbox.padding.top
937 }
938 ]
940 else
941 case found.location of
942 Testable.InColumn ->
943 let
944 siblingsAbove =
945 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
947 spacings =
948 toFloat (List.length siblingsAbove * found.parentSpacing)
950 heightsAbove =
951 siblingsAbove
952 |> List.map (.height << .bbox)
953 |> List.sum
954 in
955 [ expectRoundedEquality
956 { found = found.self.bbox.top
957 , expected = found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings)
958 }
959 ]
961 _ ->
962 [ expectRoundedEquality
963 { found = found.self.bbox.top
964 , expected = found.parent.bbox.top
965 }
966 ]
967 }
970{-| -}
971alignBottom : Testable.Attr msg
972alignBottom =
973 Testable.LabeledTest
974 { label = "alignBottom"
975 , attr = Element.alignBottom
976 , id = Testable.NoId
977 , test =
978 \found ->
979 if List.member found.location [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
980 [ Testable.true "alignBottom doesn't apply to elements that are above or below" True ]
982 else if
983 List.member found.location
984 [ Testable.IsNearby Testable.InFront
985 , Testable.IsNearby Testable.Behind
986 , Testable.IsNearby Testable.OnRight
987 , Testable.IsNearby Testable.OnLeft
988 ]
989 then
990 [ expectRoundedEquality
991 { found = found.self.bbox.bottom
992 , expected = found.parent.bbox.bottom
993 }
994 ]
996 else if List.length found.siblings == 0 then
997 [ expectRoundedEquality
998 { found = found.self.bbox.bottom
999 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1003 else
1004 case found.location of
1005 Testable.InColumn ->
1006 let
1007 siblingsBelow =
1008 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1010 spacings =
1011 toFloat (List.length siblingsBelow * found.parentSpacing)
1013 heightsBelow =
1014 siblingsBelow
1015 |> List.map (.height << .bbox)
1016 |> List.sum
1017 in
1018 [ expectRoundedEquality
1019 { found = found.self.bbox.bottom
1020 , expected = found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings)
1024 _ ->
1025 [ expectRoundedEquality
1026 { found = found.self.bbox.bottom
1027 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1033expectRoundedEquality : { expected : Float, found : Float } -> Testable.LayoutExpectation
1034expectRoundedEquality { expected, found } =
1035 Testable.true
1036 ("expected " ++ floatToString expected ++ ", found " ++ floatToString found)
1037 (abs (expected - found) < 1)
1040floatToString : Float -> String
1041floatToString x =
1042 String.fromFloat (toFloat (round (x * 100)) / 100)
1045{-| -}
1046centerY : Testable.Attr msg
1047centerY =
1048 Testable.LabeledTest
1049 { label = "centerY"
1050 , attr = Element.centerY
1051 , id = Testable.NoId
1052 , test =
1053 \found ->
1054 let
1055 selfCenter =
1056 found.self.bbox.top + (found.self.bbox.height / 2)
1058 parentCenter =
1059 found.parent.bbox.top + (found.parent.bbox.height / 2)
1060 in
1061 if List.member found.location [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1062 [ Testable.true "centerY doesn't apply to elements that are above or below" True ]
1064 else if List.length found.siblings == 0 then
1065 [ expectRoundedEquality
1066 { found = selfCenter
1067 , expected = parentCenter
1071 else
1072 case found.location of
1073 Testable.InColumn ->
1074 let
1075 siblingsOnTop =
1076 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1078 siblingsBelow =
1079 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1081 heightsAbove : Float
1082 heightsAbove =
1083 siblingsOnTop
1084 |> List.map (.height << .bbox)
1085 |> List.sum
1086 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1088 heightsBelow =
1089 siblingsBelow
1090 |> List.map (.height << .bbox)
1091 |> List.sum
1092 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1094 expectedCenter : Float
1095 expectedCenter =
1096 found.parent.bbox.top
1097 + heightsAbove
1098 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1099 / 2
1101 in
1102 [ expectRoundedEquality
1103 { found = selfCenter
1104 , expected = expectedCenter
1108 _ ->
1109 [ expectRoundedEquality
1110 { found = selfCenter
1111 , expected = parentCenter
1117{-| -}
1118above : Testable.Element msg -> Testable.Attr msg
1119above element =
1120 Testable.Nearby
1121 { location = Testable.Above
1122 , element = element
1123 , label = "above"
1124 , test =
1125 \found ->
1126 [ expectRoundedEquality
1127 { found = found.self.bbox.bottom
1128 , expected = found.parent.bbox.top
1134{-| -}
1135below : Testable.Element msg -> Testable.Attr msg
1136below element =
1137 Testable.Nearby
1138 { location = Testable.Below
1139 , element = element
1140 , label = "below"
1141 , test =
1142 \found ->
1143 [ expectRoundedEquality
1144 { found = found.self.bbox.top
1145 , expected = found.parent.bbox.bottom
1151{-| -}
1152onRight : Testable.Element msg -> Testable.Attr msg
1153onRight element =
1154 Testable.Nearby
1155 { location = Testable.OnRight
1156 , element = element
1157 , label = "onRight"
1158 , test =
1159 \found ->
1160 [ expectRoundedEquality
1161 { found = found.self.bbox.left
1162 , expected = found.parent.bbox.right
1168{-| -}
1169onLeft : Testable.Element msg -> Testable.Attr msg
1170onLeft element =
1171 Testable.Nearby
1172 { location = Testable.OnLeft
1173 , element = element
1174 , label = "onLeft"
1175 , test =
1176 \found ->
1177 [ expectRoundedEquality
1178 { found = found.self.bbox.right
1179 , expected = found.parent.bbox.left
1185compare x vs y =
1186 vs (round x) (round y) || vs (floor x) (floor y)
1189{-| -}
1190inFront : Testable.Element msg -> Testable.Attr msg
1191inFront element =
1192 Testable.Nearby
1193 { location = Testable.InFront
1194 , element = element
1195 , label = "inFront"
1196 , test =
1197 \found ->
1198 [ withinHelper found ]
1202withinHelper found =
1203 let
1204 horizontalCheck =
1205 if found.self.bbox.width > found.parent.bbox.width then
1206 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1207 || compare found.self.bbox.left (>=) found.parent.bbox.left
1210 else
1211 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1212 , compare found.self.bbox.left (>=) found.parent.bbox.left
1215 verticalCheck =
1216 if found.self.bbox.width > found.parent.bbox.width then
1217 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1218 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1221 else
1222 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1223 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1225 in
1226 Testable.true "within the confines of the parent"
1227 (List.all ((==) True)
1228 (List.concat
1229 [ horizontalCheck
1230 , verticalCheck
1236{-| -}
1237behindContent : Testable.Element msg -> Testable.Attr msg
1238behindContent element =
1239 Testable.Nearby
1240 { location = Testable.Behind
1241 , element = element
1242 , label = "behindContent"
1243 , test =
1244 \found ->
1245 [ withinHelper found ]
1250{- Implicit width/height calcualtions -}
1253implicitWidthHeightShrink attrs =
1254 let
1255 withImplicits =
1256 implicitTest (widthHelper Nothing Nothing Shrink)
1257 :: implicitTest (heightHelper Nothing Nothing Shrink)
1258 :: attrs
1259 in
1260 skipOverridden withImplicits
1263attrId attr =
1264 case attr of
1265 Testable.LabeledTest details ->
1266 details.id
1268 Testable.AttrTest details ->
1269 details.id
1271 _ ->
1272 Testable.NoId
1275skipOverridden ls =
1276 List.foldr
1277 (\attr ( found, caught ) ->
1278 let
1279 ( skip, has ) =
1280 case attrId attr of
1281 Testable.NoId ->
1282 ( False, found )
1284 Testable.IsWidth ->
1285 ( found.hasWidth
1286 , { hasWidth = True
1287 , hasHeight = found.hasHeight
1291 Testable.IsHeight ->
1292 ( found.hasHeight
1293 , { hasWidth = found.hasWidth
1294 , hasHeight = True
1297 in
1298 ( has
1299 , if skip then
1300 caught
1302 else
1303 attr :: caught
1306 ( { hasWidth = False
1307 , hasHeight = False
1309 , []
1311 ls
1312 |> Tuple.second
1313 |> List.reverse
1316{-| This is taking a normal test and rmoving its ability to attach a real `Element` attribute.
1318implicitTest attr =
1319 case attr of
1320 Testable.LabeledTest details ->
1321 Testable.AttrTest
1322 { test = details.test
1323 , label = "Implicit -> " ++ details.label
1324 , id = details.id
1327 otherwise ->
1328 otherwise