git.iko.soy/typeable/elm-ui
on dfef577 help sign in
1136 lines 40 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 , moveUp
27 , none
28 , onLeft
29 , onRight
30 , padding
31 , paddingXY
32 , paragraph
33 , px
34 , rgb
35 , rgba
36 , row
37 , shrink
38 , spacing
39 , text
40 , textColumn
41 , transparent
42 , width
43 )
45{-| This module should mirror the top level `Element` api, with one important distinction.
47The resulting `Element msg` structure can either be rendered to Html or transformed into a test suite that can be run.
49In order to run the test:
51 - render html
52 - gather information from the browser
53 - generate tests
55-}
57import Dict
58import Element
59import Expect
60import Html.Attributes
61import Testable
62import Testable.Runner
65layout : List (Testable.Attr msg) -> Testable.Element Testable.Runner.Msg -> Testable.Runner.TestableProgram
66layout attrs elem =
67 Testable.Runner.program
68 [ ( "Open Case", elem )
69 ]
72text : String -> Testable.Element msg
73text =
74 Testable.Text
77el : List (Testable.Attr msg) -> Testable.Element msg -> Testable.Element msg
78el =
79 Testable.El
82row : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
83row =
84 Testable.Row
87column : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
88column =
89 Testable.Column
92none : Testable.Element msg
93none =
94 Testable.Empty
97paragraph : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
98paragraph =
99 Testable.Paragraph
102textColumn : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
103textColumn =
104 Testable.TextColumn
107moveUp x =
108 Testable.Attr (Element.moveUp x)
111moveDown x =
112 Testable.Attr (Element.moveDown x)
115type Length
116 = Px Int
117 | Fill Int
118 | Shrink
119 | Minimum Int Length
120 | Maximum Int Length
123minimum =
124 Minimum
127maximum =
128 Maximum
131rgb =
132 Element.rgb
135rgba =
136 Element.rgba
139px : Int -> Length
140px =
141 Px
144fill : Length
145fill =
146 Fill 1
149shrink : Length
150shrink =
151 Shrink
154fillPortion : Int -> Length
155fillPortion =
156 Fill
159label : String -> Testable.Attr msg
160label =
161 Testable.Label
164transparent : Bool -> Testable.Attr msg
165transparent on =
166 Testable.LabeledTest
167 { label =
168 if on then
169 "transparent"
171 else
172 "opaque"
173 , attr = Element.transparent on
174 , test =
175 \context _ ->
176 let
177 selfTransparency =
178 context.self.style
179 |> Dict.get "opacity"
180 |> Maybe.withDefault "notfound"
182 value =
183 if on then
184 "0"
186 else
187 "1"
188 in
189 Expect.equal value selfTransparency
190 }
193{-| -}
194isVisible : Testable.Attr msg
195isVisible =
196 Testable.LabeledTest
197 { label = "is-visible"
198 , attr = Element.htmlAttribute (Html.Attributes.style "not" "applicable")
199 , test =
200 \context _ ->
201 Expect.equal context.self.isVisible True
202 }
205{-| -}
206alpha : Float -> Testable.Attr msg
207alpha a =
208 Testable.LabeledTest
209 { label = "alpha-" ++ String.fromFloat a
210 , attr = Element.alpha a
211 , test =
212 \context _ ->
213 let
214 selfTransparency =
215 context.self.style
216 |> Dict.get "opacity"
217 |> Maybe.withDefault "notfound"
218 in
219 Expect.equal (String.fromFloat a) selfTransparency
220 }
223{-| -}
224padding : Int -> Testable.Attr msg
225padding pad =
226 Testable.LabeledTest
227 { label = "padding " ++ String.fromInt pad
228 , attr = Element.padding pad
229 , test =
230 \found _ ->
231 Expect.true ("Padding " ++ String.fromInt pad ++ " is present")
232 (List.all ((==) pad)
233 [ floor found.self.bbox.padding.left
234 , floor found.self.bbox.padding.right
235 , floor found.self.bbox.padding.top
236 , floor found.self.bbox.padding.bottom
237 ]
238 )
239 }
242{-| -}
243paddingXY : Int -> Int -> Testable.Attr msg
244paddingXY x y =
245 Testable.LabeledTest
246 { label = "paddingXY " ++ String.fromInt x ++ ", " ++ String.fromInt y
247 , attr = Element.paddingXY x y
248 , test =
249 \found _ ->
250 Expect.true ("PaddingXY (" ++ String.fromInt x ++ ", " ++ String.fromInt y ++ ") is present")
251 (List.all ((==) x)
252 [ floor found.self.bbox.padding.left
253 , floor found.self.bbox.padding.right
254 ]
255 && List.all ((==) y)
256 [ floor found.self.bbox.padding.top
257 , floor found.self.bbox.padding.bottom
258 ]
259 )
260 }
263widthHelper maybeMin maybeMax len =
264 let
265 addMin l =
266 case maybeMin of
267 Nothing ->
268 l
270 Just minPx ->
271 l |> Element.minimum minPx
273 addMax l =
274 case maybeMax of
275 Nothing ->
276 l
278 Just maxPx ->
279 l |> Element.maximum maxPx
281 minLabel =
282 case maybeMin of
283 Nothing ->
284 ""
286 Just i ->
287 " min:" ++ String.fromInt i
289 maxLabel =
290 case maybeMax of
291 Nothing ->
292 ""
294 Just i ->
295 " max:" ++ String.fromInt i
297 minMaxTest actualWidth =
298 case ( maybeMin, maybeMax ) of
299 ( Nothing, Nothing ) ->
300 True
302 ( Just lower, Nothing ) ->
303 lower <= actualWidth
305 ( Just lower, Just higher ) ->
306 lower <= actualWidth && actualWidth <= higher
308 ( Nothing, Just higher ) ->
309 actualWidth <= higher
310 in
311 case len of
312 Minimum m newLen ->
313 widthHelper (Just m) maybeMax newLen
315 Maximum m newLen ->
316 widthHelper maybeMin (Just m) newLen
318 Px val ->
319 -- Pixel values should ignore min and max?
320 Testable.LabeledTest
321 { label = "width " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
322 , attr =
323 Element.width
324 (Element.px val
325 |> addMin
326 |> addMax
327 )
328 , test =
329 \found _ ->
330 Expect.all
331 [ \_ ->
332 Expect.true "exact width is exact" (floor found.self.bbox.width == val)
333 , \_ -> Expect.true "min/max is upheld" (minMaxTest (floor found.self.bbox.width))
334 ]
335 ()
336 }
338 Fill portion ->
339 Testable.LabeledTest
340 { label = "width fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
341 , attr =
342 Element.width
343 (Element.fillPortion portion
344 |> addMin
345 |> addMax
346 )
347 , test =
348 \context _ ->
349 if List.member context.location [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
350 Expect.true "width fill doesn't apply to onright/onleft elements" True
352 else
353 let
354 parentAvailableWidth =
355 context.parent.bbox.width - (context.self.bbox.padding.left + context.self.bbox.padding.right)
356 in
357 case context.location of
358 Testable.IsNearby _ ->
359 Expect.true "Nearby Element has fill width"
360 ((floor context.parent.bbox.width == floor context.self.bbox.width)
361 || minMaxTest (floor context.self.bbox.width)
362 )
364 Testable.InColumn ->
365 Expect.true "Element within column has fill width"
366 ((floor parentAvailableWidth == floor context.self.bbox.width)
367 || minMaxTest (floor context.self.bbox.width)
368 )
370 Testable.InEl ->
371 Expect.true "Element within element has fill width" <|
372 (floor parentAvailableWidth == floor context.self.bbox.width)
373 || minMaxTest (floor context.self.bbox.width)
375 _ ->
376 let
377 spacePerPortion =
378 parentAvailableWidth / toFloat (List.length context.siblings + 1)
379 in
380 Expect.true "element has fill width" <|
381 (floor spacePerPortion == floor context.self.bbox.width)
382 || minMaxTest (floor context.self.bbox.width)
383 }
385 Shrink ->
386 Testable.LabeledTest
387 { label = "width shrink" ++ minLabel ++ maxLabel
388 , attr =
389 Element.width
390 (Element.shrink
391 |> addMin
392 |> addMax
393 )
394 , test =
395 \context _ ->
396 let
397 childWidth child =
398 -- TODO: add margin values to widths
399 child.bbox.width
401 totalChildren =
402 context.children
403 |> List.map childWidth
404 |> List.sum
406 horizontalPadding =
407 context.self.bbox.padding.left + context.self.bbox.padding.right
409 spacingValue =
410 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
411 in
412 if totalChildren == 0 then
413 -- TODO: The issue is that we have a hard time measuring `text` elements
414 -- So if a element has a text child, then it's width isn't going to show up in the system.
415 expectRoundedEquality context.self.bbox.width context.self.bbox.width
417 else
418 -- This fails if this element is actually a column
419 -- So we need to capture what this element is in order to do this calculation.
420 expectRoundedEquality (totalChildren + horizontalPadding + spacingValue) context.self.bbox.width
421 }
424heightHelper maybeMin maybeMax len =
425 let
426 addMin l =
427 case maybeMin of
428 Nothing ->
429 l
431 Just minPx ->
432 l |> Element.minimum minPx
434 addMax l =
435 case maybeMax of
436 Nothing ->
437 l
439 Just maxPx ->
440 l |> Element.maximum maxPx
442 minLabel =
443 case maybeMin of
444 Nothing ->
445 ""
447 Just i ->
448 " min:" ++ String.fromInt i
450 maxLabel =
451 case maybeMax of
452 Nothing ->
453 ""
455 Just i ->
456 " max:" ++ String.fromInt i
458 minMaxTest actualheight =
459 case ( maybeMin, maybeMax ) of
460 ( Nothing, Nothing ) ->
461 True
463 ( Just lower, Nothing ) ->
464 lower <= actualheight
466 ( Just lower, Just higher ) ->
467 lower <= actualheight && actualheight <= higher
469 ( Nothing, Just higher ) ->
470 actualheight <= higher
471 in
472 case len of
473 Minimum m newLen ->
474 heightHelper (Just m) maybeMax newLen
476 Maximum m newLen ->
477 heightHelper maybeMin (Just m) newLen
479 Px val ->
480 -- Pixel values should ignore min and max?
481 Testable.LabeledTest
482 { label = "height " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
483 , attr =
484 Element.height
485 (Element.px val
486 |> addMin
487 |> addMax
488 )
489 , test =
490 \found _ ->
491 Expect.all
492 [ \_ ->
493 Expect.true ("exact height is exact: " ++ String.fromInt (floor found.self.bbox.height) ++ "," ++ String.fromInt val)
494 (floor found.self.bbox.height == val)
495 , \_ ->
496 Expect.true "min/max holds true"
497 (minMaxTest (floor found.self.bbox.height))
498 ]
499 ()
500 }
502 Fill portion ->
503 Testable.LabeledTest
504 { label = "height fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
505 , attr =
506 Element.height
507 (Element.fillPortion portion
508 |> addMin
509 |> addMax
510 )
511 , test =
512 \context _ ->
513 if List.member context.location [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
514 Expect.true "height fill doesn't apply to above/below elements" True
516 else
517 let
518 parentAvailableHeight =
519 context.parent.bbox.height - (context.self.bbox.padding.top + context.self.bbox.padding.bottom)
520 in
521 case context.location of
522 Testable.IsNearby _ ->
523 Expect.true "Nearby Element has fill height"
524 ((floor context.parent.bbox.height == floor context.self.bbox.height)
525 || minMaxTest (floor context.self.bbox.height)
526 )
528 Testable.InColumn ->
529 Expect.true "Element within column has fill height"
530 ((floor parentAvailableHeight == floor context.self.bbox.height)
531 || minMaxTest (floor context.self.bbox.height)
532 )
534 Testable.InEl ->
535 Expect.true "Element within el has fill height" <|
536 (floor parentAvailableHeight == floor context.self.bbox.height)
537 || minMaxTest (floor context.self.bbox.height)
539 _ ->
540 let
541 spacePerPortion =
542 parentAvailableHeight / toFloat (List.length context.siblings + 1)
543 in
544 Expect.true "el has fill height" <|
545 (floor spacePerPortion == floor context.self.bbox.height)
546 || minMaxTest (floor context.self.bbox.height)
547 }
549 Shrink ->
550 Testable.LabeledTest
551 { label = "height shrink" ++ minLabel ++ maxLabel
552 , attr =
553 Element.height
554 (Element.shrink
555 |> addMin
556 |> addMax
557 )
558 , test =
559 \context _ ->
560 let
561 childWidth child =
562 -- TODO: add margin values to heights
563 child.bbox.height
565 totalChildren =
566 context.children
567 |> List.map childWidth
568 |> List.sum
570 verticalPadding =
571 context.self.bbox.padding.top + context.self.bbox.padding.bottom
573 spacingValue =
574 toFloat context.parentSpacing * (toFloat (List.length context.children) - 1)
575 in
576 if totalChildren == 0 then
577 -- TODO: The issue is that we have a hard time measuring `text` elements
578 -- So if a element has a text child, then it's height isn't going to show up in the system.
579 expectRoundedEquality context.self.bbox.height context.self.bbox.height
581 else
582 -- This fails if this element is actually a column
583 -- So we need to capture what this element is in order to do this calculation.
584 expectRoundedEquality (totalChildren + verticalPadding + spacingValue) context.self.bbox.height
585 }
588width : Length -> Testable.Attr msg
589width len =
590 widthHelper Nothing Nothing len
593height : Length -> Testable.Attr msg
594height len =
595 heightHelper Nothing Nothing len
598spacing : Int -> Testable.Attr msg
599spacing space =
600 Testable.Batch
601 [ Testable.Spacing space
602 , Testable.LabeledTest
603 { label = "spacing: " ++ String.fromInt space
604 , attr = Element.spacing space
605 , test =
606 \found _ ->
607 let
608 findDistance child total =
609 List.concatMap
610 (\otherChild ->
611 let
612 horizontal =
613 round <|
614 child.bbox.left
615 - otherChild.bbox.right
617 vertical =
618 round <|
619 child.bbox.top
620 - otherChild.bbox.bottom
621 in
622 [ if horizontal > 0 then
623 horizontal
625 else
626 space
627 , if vertical > 0 then
628 vertical
630 else
631 space
632 ]
633 )
634 found.children
635 ++ total
637 distances =
638 List.foldl findDistance [] found.children
640 allAreSpaced =
641 List.foldl
642 (\x wrong ->
643 if not (x >= space) then
644 x :: wrong
646 else
647 wrong
648 )
649 []
650 distances
651 in
652 Expect.true
653 ("All children are at least "
654 ++ String.fromInt space
655 ++ " pixels apart."
656 ++ Debug.toString allAreSpaced
657 ++ " are not though"
658 )
659 (allAreSpaced == [])
660 }
661 ]
664{-| alignLeft needs to account for
666 - parent padding
667 - elements to the left
668 - spacing value
670in order to calculate the expected result.
672Also need parent rendering context if this is to work with wrapped rows in the future.
674All sibling elements
676-}
677alignLeft : Testable.Attr msg
678alignLeft =
679 Testable.LabeledTest
680 { label = "alignLeft"
681 , attr = Element.alignLeft
682 , test =
683 \found _ ->
684 if List.member found.location [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
685 Expect.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
687 else if
688 List.member found.location
689 [ Testable.IsNearby Testable.InFront
690 , Testable.IsNearby Testable.Behind
691 , Testable.IsNearby Testable.Above
692 , Testable.IsNearby Testable.Below
693 ]
694 then
695 expectRoundedEquality
696 found.self.bbox.left
697 found.parent.bbox.left
699 else if List.length found.siblings == 0 then
700 expectRoundedEquality
701 found.self.bbox.left
702 (found.parent.bbox.left + found.parent.bbox.padding.left)
704 else
705 case found.location of
706 Testable.InRow ->
707 let
708 siblingsOnLeft =
709 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
711 spacings =
712 toFloat (List.length siblingsOnLeft * found.parentSpacing)
714 widthsOnLeft =
715 siblingsOnLeft
716 |> List.map (.width << .bbox)
717 |> List.sum
718 in
719 expectRoundedEquality
720 found.self.bbox.left
721 (found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings))
723 _ ->
724 expectRoundedEquality
725 found.self.bbox.left
726 (found.parent.bbox.left + found.parent.bbox.padding.left)
727 }
730{-| -}
731centerX : Testable.Attr msg
732centerX =
733 Testable.LabeledTest
734 { label = "centerX"
735 , attr = Element.centerX
736 , test =
737 \found _ ->
738 let
739 selfCenter : Float
740 selfCenter =
741 found.self.bbox.left + (found.self.bbox.width / 2)
743 parentCenter : Float
744 parentCenter =
745 found.parent.bbox.left + (found.parent.bbox.width / 2)
746 in
747 if List.member found.location [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
748 Expect.true "centerX doesn't apply to elements that are onLeft or onRight" True
750 else if List.length found.siblings == 0 then
751 expectRoundedEquality
752 selfCenter
753 parentCenter
755 else
756 case found.location of
757 Testable.InRow ->
758 let
759 siblingsOnLeft =
760 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
762 siblingsOnRight =
763 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
765 widthsOnLeft : Float
766 widthsOnLeft =
767 siblingsOnLeft
768 |> List.map (.width << .bbox)
769 |> List.sum
770 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
772 widthsOnRight =
773 siblingsOnRight
774 |> List.map (.width << .bbox)
775 |> List.sum
776 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
778 expectedCenter : Float
779 expectedCenter =
780 found.parent.bbox.left
781 + widthsOnLeft
782 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
783 / 2
784 )
785 in
786 expectRoundedEquality
787 selfCenter
788 expectedCenter
790 _ ->
791 expectRoundedEquality selfCenter parentCenter
792 }
795{-| -}
796alignRight : Testable.Attr msg
797alignRight =
798 Testable.LabeledTest
799 { label = "alignRight"
800 , attr = Element.alignRight
801 , test =
802 \found _ ->
803 if List.member found.location [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
804 Expect.true "alignRight doesn't apply to elements that are onLeft or onRight" True
806 else if
807 List.member found.location
808 [ Testable.IsNearby Testable.InFront
809 , Testable.IsNearby Testable.Behind
810 , Testable.IsNearby Testable.Above
811 , Testable.IsNearby Testable.Below
812 ]
813 then
814 expectRoundedEquality
815 found.self.bbox.right
816 found.parent.bbox.right
818 else if List.length found.siblings == 0 then
819 expectRoundedEquality
820 found.self.bbox.right
821 (found.parent.bbox.right + found.parent.bbox.padding.right)
823 else
824 case found.location of
825 Testable.InRow ->
826 let
827 siblingsOnRight =
828 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
830 spacings =
831 toFloat (List.length siblingsOnRight * found.parentSpacing)
833 widthsOnRight =
834 siblingsOnRight
835 |> List.map (.width << .bbox)
836 |> List.sum
837 in
838 expectRoundedEquality
839 found.self.bbox.right
840 (found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings))
842 _ ->
843 expectRoundedEquality
844 found.self.bbox.right
845 (found.parent.bbox.right + found.parent.bbox.padding.right)
846 }
849{-| -}
850alignTop : Testable.Attr msg
851alignTop =
852 Testable.LabeledTest
853 { label = "alignTop"
854 , attr = Element.alignTop
855 , test =
856 \found _ ->
857 if List.member found.location [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
858 Expect.true "alignTop doesn't apply to elements that are above or below" True
860 else if
861 List.member found.location
862 [ Testable.IsNearby Testable.InFront
863 , Testable.IsNearby Testable.Behind
864 , Testable.IsNearby Testable.OnRight
865 , Testable.IsNearby Testable.OnLeft
866 ]
867 then
868 expectRoundedEquality
869 found.self.bbox.top
870 found.parent.bbox.top
872 else if List.length found.siblings == 0 then
873 expectRoundedEquality
874 found.self.bbox.top
875 (found.parent.bbox.top + found.parent.bbox.padding.top)
877 else
878 case found.location of
879 Testable.InColumn ->
880 let
881 siblingsAbove =
882 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
884 spacings =
885 toFloat (List.length siblingsAbove * found.parentSpacing)
887 heightsAbove =
888 siblingsAbove
889 |> List.map (.height << .bbox)
890 |> List.sum
891 in
892 expectRoundedEquality
893 found.self.bbox.top
894 (found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings))
896 _ ->
897 expectRoundedEquality
898 found.self.bbox.top
899 found.parent.bbox.top
900 }
903{-| -}
904alignBottom : Testable.Attr msg
905alignBottom =
906 Testable.LabeledTest
907 { label = "alignBottom"
908 , attr = Element.alignBottom
909 , test =
910 \found _ ->
911 if List.member found.location [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
912 Expect.true "alignBottom doesn't apply to elements that are above or below" True
914 else if
915 List.member found.location
916 [ Testable.IsNearby Testable.InFront
917 , Testable.IsNearby Testable.Behind
918 , Testable.IsNearby Testable.OnRight
919 , Testable.IsNearby Testable.OnLeft
920 ]
921 then
922 expectRoundedEquality
923 found.self.bbox.bottom
924 found.parent.bbox.bottom
926 else if List.length found.siblings == 0 then
927 expectRoundedEquality
928 found.self.bbox.bottom
929 (found.parent.bbox.bottom + found.parent.bbox.padding.bottom)
931 else
932 case found.location of
933 Testable.InColumn ->
934 let
935 siblingsBelow =
936 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
938 spacings =
939 toFloat (List.length siblingsBelow * found.parentSpacing)
941 heightsBelow =
942 siblingsBelow
943 |> List.map (.height << .bbox)
944 |> List.sum
945 in
946 expectRoundedEquality
947 found.self.bbox.bottom
948 (found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings))
950 _ ->
951 expectRoundedEquality
952 found.self.bbox.bottom
953 (found.parent.bbox.bottom + found.parent.bbox.padding.bottom)
954 }
957expectRoundedEquality x y =
958 Expect.true ("within 1 of each other " ++ String.fromFloat x ++ ":" ++ String.fromFloat y)
959 (abs (x - y) < 1)
962{-| -}
963centerY : Testable.Attr msg
964centerY =
965 Testable.LabeledTest
966 { label = "centerY"
967 , attr = Element.centerY
968 , test =
969 \found _ ->
970 let
971 selfCenter =
972 found.self.bbox.top + (found.self.bbox.height / 2)
974 parentCenter =
975 found.parent.bbox.top + (found.parent.bbox.height / 2)
976 in
977 if List.member found.location [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
978 Expect.true "centerY doesn't apply to elements that are above or below" True
980 else if List.length found.siblings == 0 then
981 expectRoundedEquality
982 selfCenter
983 parentCenter
985 else
986 case found.location of
987 Testable.InColumn ->
988 let
989 siblingsOnTop =
990 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
992 siblingsBelow =
993 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
995 heightsAbove : Float
996 heightsAbove =
997 siblingsOnTop
998 |> List.map (.height << .bbox)
999 |> List.sum
1000 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1002 heightsBelow =
1003 siblingsBelow
1004 |> List.map (.height << .bbox)
1005 |> List.sum
1006 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1008 expectedCenter : Float
1009 expectedCenter =
1010 found.parent.bbox.top
1011 + heightsAbove
1012 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1013 / 2
1015 in
1016 expectRoundedEquality
1017 selfCenter
1018 expectedCenter
1020 _ ->
1021 expectRoundedEquality selfCenter parentCenter
1025{-| -}
1026above : Testable.Element msg -> Testable.Attr msg
1027above element =
1028 Testable.Nearby
1029 { location = Testable.Above
1030 , element = element
1031 , label = "above"
1032 , test =
1033 \found _ ->
1034 expectRoundedEquality found.self.bbox.bottom found.parent.bbox.top
1038{-| -}
1039below : Testable.Element msg -> Testable.Attr msg
1040below element =
1041 Testable.Nearby
1042 { location = Testable.Below
1043 , element = element
1044 , label = "below"
1045 , test =
1046 \found _ ->
1047 expectRoundedEquality found.self.bbox.top found.parent.bbox.bottom
1051{-| -}
1052onRight : Testable.Element msg -> Testable.Attr msg
1053onRight element =
1054 Testable.Nearby
1055 { location = Testable.OnRight
1056 , element = element
1057 , label = "onRight"
1058 , test =
1059 \found _ ->
1060 expectRoundedEquality found.self.bbox.left found.parent.bbox.right
1064{-| -}
1065onLeft : Testable.Element msg -> Testable.Attr msg
1066onLeft element =
1067 Testable.Nearby
1068 { location = Testable.OnLeft
1069 , element = element
1070 , label = "onLeft"
1071 , test =
1072 \found _ ->
1073 expectRoundedEquality found.self.bbox.right found.parent.bbox.left
1077compare x vs y =
1078 vs (round x) (round y) || vs (floor x) (floor y)
1081{-| -}
1082inFront : Testable.Element msg -> Testable.Attr msg
1083inFront element =
1084 Testable.Nearby
1085 { location = Testable.InFront
1086 , element = element
1087 , label = "inFront"
1088 , test =
1089 withinHelper
1093withinHelper found _ =
1094 let
1095 horizontalCheck =
1096 if found.self.bbox.width > found.parent.bbox.width then
1097 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1098 || compare found.self.bbox.left (>=) found.parent.bbox.left
1101 else
1102 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1103 , compare found.self.bbox.left (>=) found.parent.bbox.left
1106 verticalCheck =
1107 if found.self.bbox.width > found.parent.bbox.width then
1108 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1109 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1112 else
1113 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1114 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1116 in
1117 Expect.true "within the confines of the parent"
1118 (List.all ((==) True)
1119 (List.concat
1120 [ horizontalCheck
1121 , verticalCheck
1127{-| -}
1128behindContent : Testable.Element msg -> Testable.Attr msg
1129behindContent element =
1130 Testable.Nearby
1131 { location = Testable.Behind
1132 , element = element
1133 , label = "behindContent"
1134 , test =
1135 withinHelper