git.iko.soy/typeable/elm-ui
on fe73cbd help sign in
typeable/elm-ui/tests-rendering/src/Testable/Element.elm
1554 lines 57 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 , link
24 , maximum
25 , minimum
26 , moveDown
27 , moveLeft
28 , moveRight
29 , moveUp
30 , none
31 , onLeft
32 , onRight
33 , padding
34 , paddingXY
35 , paragraph
36 , px
37 , rgb
38 , rgba
39 , row
40 , shrink
41 , spacing
42 , text
43 , textColumn
44 , transparent
45 , width
46 )
48{-| This module should mirror the top level `Element` api, with one important distinction.
50The resulting `Element msg` structure can either be rendered to Html or transformed into a test suite that can be run.
52In order to run the test:
54 - render html
55 - gather information from the browser
56 - generate tests
58-}
60import Dict
61import Element
62import Html.Attributes
63import Testable
64import Testable.Runner
67layout : List (Testable.Attr msg) -> Testable.Element Testable.Runner.Msg -> Testable.Runner.TestableProgram
68layout attrs elem =
69 Testable.Runner.program
70 [ ( "Tests Run", elem )
71 ]
74text : String -> Testable.Element msg
75text =
76 Testable.Text
79el : List (Testable.Attr msg) -> Testable.Element msg -> Testable.Element msg
80el attrs =
81 Testable.El (implicitWidthHeightShrink attrs)
84row : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
85row attrs =
86 Testable.Row (implicitWidthHeightShrink attrs)
89column : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
90column attrs =
91 Testable.Column (implicitWidthHeightShrink attrs)
94none : Testable.Element msg
95none =
96 Testable.Empty
99paragraph : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
100paragraph attrs =
101 let
102 withImplicits =
103 implicitTest (widthHelper Nothing Nothing (Fill 1))
104 :: implicitTest (heightHelper Nothing Nothing Shrink)
105 :: attrs
106 in
107 Testable.Paragraph (skipOverridden withImplicits)
110textColumn : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
111textColumn attrs =
112 let
113 withImplicits =
114 implicitTest (widthHelper (Just 500) (Just 750) (Fill 1))
115 :: implicitTest (heightHelper Nothing Nothing Shrink)
116 :: attrs
117 in
118 Testable.TextColumn (skipOverridden withImplicits)
121link :
122 List (Testable.Attr msg)
123 ->
124 { url : String
125 , label : Testable.Element msg
126 }
127 -> Testable.Element msg
128link attrs details =
129 -- TODO: this is not actually a link element!!
130 Testable.El (implicitWidthHeightShrink attrs) details.label
133{-| Old labeling mechanism that i removed to hastily
134-}
135label str =
136 Testable.Batch []
139moveUp x =
140 Testable.Attr (Element.moveUp x)
143moveDown x =
144 Testable.Attr (Element.moveDown x)
147moveRight x =
148 Testable.Attr (Element.moveRight x)
151moveLeft x =
152 Testable.Attr (Element.moveLeft x)
155type Length
156 = Px Int
157 | Fill Int
158 | Shrink
159 | Minimum Int Length
160 | Maximum Int Length
163minimum =
164 Minimum
167maximum =
168 Maximum
171rgb =
172 Element.rgb
175rgba =
176 Element.rgba
179px : Int -> Length
180px =
181 Px
184fill : Length
185fill =
186 Fill 1
189shrink : Length
190shrink =
191 Shrink
194fillPortion : Int -> Length
195fillPortion =
196 Fill
199transparent : Bool -> Testable.Attr msg
200transparent on =
201 Testable.LabeledTest
202 { label =
203 if on then
204 "transparent"
206 else
207 "opaque"
208 , attr = Element.transparent on
209 , id = Testable.NoId
210 , test =
211 \context ->
212 let
213 selfTransparency =
214 context.self.style
215 |> Dict.get "opacity"
216 |> Maybe.withDefault "notfound"
218 value =
219 if on then
220 "0"
222 else
223 "1"
224 in
225 [ Testable.equal value selfTransparency ]
226 }
229{-| -}
230isVisible : Testable.Attr msg
231isVisible =
232 Testable.AttrTest
233 { label = "is-visible"
234 , id = Testable.NoId
235 , test =
236 \context ->
237 [ Testable.equal context.self.isVisible True ]
238 }
241{-| -}
242alpha : Float -> Testable.Attr msg
243alpha a =
244 Testable.LabeledTest
245 { label = "alpha-" ++ String.fromFloat a
246 , attr = Element.alpha a
247 , id = Testable.NoId
248 , test =
249 \context ->
250 let
251 selfTransparency =
252 context.self.style
253 |> Dict.get "opacity"
254 |> Maybe.withDefault "notfound"
255 in
256 [ Testable.equal (String.fromFloat a) selfTransparency ]
257 }
260{-| -}
261padding : Int -> Testable.Attr msg
262padding pad =
263 Testable.LabeledTest
264 { label = "padding " ++ String.fromInt pad
265 , attr = Element.padding pad
266 , id = Testable.NoId
267 , test =
268 \found ->
269 [ Testable.true ("Padding " ++ String.fromInt pad ++ " is present")
270 (List.all ((==) pad)
271 [ floor found.self.bbox.padding.left
272 , floor found.self.bbox.padding.right
273 , floor found.self.bbox.padding.top
274 , floor found.self.bbox.padding.bottom
275 ]
276 )
277 ]
278 }
281{-| -}
282paddingXY : Int -> Int -> Testable.Attr msg
283paddingXY x y =
284 Testable.LabeledTest
285 { label = "paddingXY " ++ String.fromInt x ++ ", " ++ String.fromInt y
286 , attr = Element.paddingXY x y
287 , id = Testable.NoId
288 , test =
289 \found ->
290 [ Testable.true ("PaddingXY (" ++ String.fromInt x ++ ", " ++ String.fromInt y ++ ") is present")
291 (List.all ((==) x)
292 [ floor found.self.bbox.padding.left
293 , floor found.self.bbox.padding.right
294 ]
295 && List.all ((==) y)
296 [ floor found.self.bbox.padding.top
297 , floor found.self.bbox.padding.bottom
298 ]
299 )
300 ]
301 }
304widthHelper maybeMin maybeMax len =
305 let
306 addMin l =
307 case maybeMin of
308 Nothing ->
309 l
311 Just minPx ->
312 l |> Element.minimum minPx
314 addMax l =
315 case maybeMax of
316 Nothing ->
317 l
319 Just maxPx ->
320 l |> Element.maximum maxPx
322 minLabel =
323 case maybeMin of
324 Nothing ->
325 ""
327 Just i ->
328 " min:" ++ String.fromInt i
330 maxLabel =
331 case maybeMax of
332 Nothing ->
333 ""
335 Just i ->
336 " max:" ++ String.fromInt i
338 minMaxTest actualWidth =
339 case ( maybeMin, maybeMax ) of
340 ( Nothing, Nothing ) ->
341 True
343 ( Just lower, Nothing ) ->
344 lower <= actualWidth
346 ( Just lower, Just higher ) ->
347 lower <= actualWidth && actualWidth <= higher
349 ( Nothing, Just higher ) ->
350 actualWidth <= higher
351 in
352 case len of
353 Minimum m newLen ->
354 widthHelper (Just m) maybeMax newLen
356 Maximum m newLen ->
357 widthHelper maybeMin (Just m) newLen
359 Px val ->
360 -- Pixel values should ignore min and max?
361 Testable.LabeledTest
362 { label = "width " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
363 , id = Testable.IsWidth
364 , attr =
365 Element.width
366 (Element.px val
367 |> addMin
368 |> addMax
369 )
370 , test =
371 \found ->
372 [ expectRoundedEquality
373 { expected = toFloat val
374 , found = found.self.bbox.width
375 }
376 , Testable.true "min/max is upheld" (minMaxTest (floor found.self.bbox.width))
377 ]
378 }
380 Fill portion ->
381 Testable.LabeledTest
382 { label =
383 if portion == 1 then
384 "width fill" ++ minLabel ++ maxLabel
386 else
387 "width fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
388 , id = Testable.IsWidth
389 , attr =
390 Element.width
391 (Element.fillPortion portion
392 |> addMin
393 |> addMax
394 )
395 , test =
396 \context ->
397 if List.member context.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
398 [ Testable.true "width fill doesn't apply to onright/onleft elements" True ]
400 else
401 let
402 parentAvailableWidth =
403 context.parent.bbox.width - (context.self.bbox.padding.left + context.self.bbox.padding.right)
404 in
405 [ case context.parentLayout of
406 Testable.IsNearby _ ->
407 Testable.true "Nearby Element has fill width"
408 ((floor context.parent.bbox.width == floor context.self.bbox.width)
409 || minMaxTest (floor context.self.bbox.width)
410 )
412 Testable.InColumn ->
413 Testable.true "Element within column has fill width"
414 ((floor parentAvailableWidth == floor context.self.bbox.width)
415 || minMaxTest (floor context.self.bbox.width)
416 )
418 Testable.InEl ->
419 Testable.true "Element within element has fill width" <|
420 (floor parentAvailableWidth == floor context.self.bbox.width)
421 || minMaxTest (floor context.self.bbox.width)
423 _ ->
424 let
425 spacePerPortion =
426 parentAvailableWidth / toFloat (List.length context.siblings + 1)
427 in
428 Testable.true "element has fill width" <|
429 (floor spacePerPortion == floor context.self.bbox.width)
430 || minMaxTest (floor context.self.bbox.width)
431 , Testable.lessThanOrEqual "not larger than parent"
432 context.self.bbox.width
433 context.parent.bbox.width
434 ]
435 }
437 Shrink ->
438 Testable.LabeledTest
439 { label = "width shrink" ++ minLabel ++ maxLabel
440 , attr =
441 Element.width
442 (Element.shrink
443 |> addMin
444 |> addMax
445 )
446 , id = Testable.IsWidth
447 , test =
448 \context ->
449 case context.selfElement of
450 Testable.El _ _ ->
451 let
452 childWidth child =
453 child.bbox.width
455 totalChildren =
456 context.children
457 |> List.map childWidth
458 |> List.append (List.map .width context.self.textMetrics)
459 |> List.sum
461 horizontalPadding =
462 context.self.bbox.padding.left + context.self.bbox.padding.right
463 in
464 [ expectRoundedEquality
465 { expected = totalChildren + horizontalPadding
466 , found = context.self.bbox.width
467 }
468 , Testable.lessThanOrEqual "not larger than parent"
469 context.self.bbox.width
470 context.parent.bbox.width
471 ]
473 Testable.Row rowAttrs _ ->
474 -- width of row is the sum of all children widths
475 -- both text elements and others.
476 let
477 childWidth child =
478 child.bbox.width
480 totalChildren =
481 context.children
482 |> List.map childWidth
483 |> List.append (List.map .width context.self.textMetrics)
484 |> List.sum
486 horizontalPadding =
487 context.self.bbox.padding.left + context.self.bbox.padding.right
489 spacingAmount =
490 Testable.getSpacingFromAttributes rowAttrs
492 totalSpacing =
493 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
494 in
495 [ expectRoundedEquality
496 { expected = totalChildren + horizontalPadding + totalSpacing
497 , found = context.self.bbox.width
498 }
499 , Testable.lessThanOrEqual "not larger than parent"
500 context.self.bbox.width
501 context.parent.bbox.width
502 ]
504 Testable.Column _ _ ->
505 -- The width of the column is the width of the widest child.
506 let
507 childWidth child =
508 child.bbox.width
509 + context.self.bbox.padding.left
510 + context.self.bbox.padding.right
512 textChildren =
513 List.map
514 (\txt ->
515 txt.width
516 + context.self.bbox.padding.left
517 + context.self.bbox.padding.right
518 )
519 context.self.textMetrics
521 allChildren =
522 context.children
523 |> List.map childWidth
524 |> List.append textChildren
525 in
526 [ expectRoundedEquality
527 { expected = Maybe.withDefault 0 (List.maximum allChildren)
528 , found = context.self.bbox.width
529 }
530 , Testable.lessThanOrEqual "not larger than parent"
531 context.self.bbox.width
532 context.parent.bbox.width
533 ]
535 Testable.TextColumn _ _ ->
536 -- The width of the column is the width of the widest child.
537 let
538 childWidth child =
539 child.bbox.width
540 + context.self.bbox.padding.left
541 + context.self.bbox.padding.right
543 textChildren =
544 List.map
545 (\txt ->
546 txt.width
547 + context.self.bbox.padding.left
548 + context.self.bbox.padding.right
549 )
550 context.self.textMetrics
552 allChildren =
553 context.children
554 |> List.map childWidth
555 |> List.append textChildren
556 in
557 [ expectRoundedEquality
558 { expected = Maybe.withDefault 0 (List.maximum allChildren)
559 , found = context.self.bbox.width
560 }
561 , Testable.lessThanOrEqual "not larger than parent"
562 context.self.bbox.width
563 context.parent.bbox.width
564 ]
566 Testable.Paragraph _ _ ->
567 -- This should be the size it's text,
568 -- unless it takes up all available space, in which case it should wrap.
569 let
570 childWidth child =
571 child.bbox.width
573 totalChildren =
574 context.children
575 |> List.map childWidth
576 |> List.append (List.map .width context.self.textMetrics)
577 |> List.sum
579 horizontalPadding =
580 context.self.bbox.padding.left + context.self.bbox.padding.right
581 in
582 [ expectRoundedEquality
583 { expected = totalChildren + horizontalPadding
584 , found = context.self.bbox.width
585 }
586 , Testable.lessThanOrEqual "not larger than parent"
587 context.self.bbox.width
588 context.parent.bbox.width
589 ]
591 Testable.Text _ ->
592 []
594 Testable.Empty ->
595 []
596 }
599heightHelper maybeMin maybeMax len =
600 let
601 addMin l =
602 case maybeMin of
603 Nothing ->
604 l
606 Just minPx ->
607 l |> Element.minimum minPx
609 addMax l =
610 case maybeMax of
611 Nothing ->
612 l
614 Just maxPx ->
615 l |> Element.maximum maxPx
617 minLabel =
618 case maybeMin of
619 Nothing ->
620 ""
622 Just i ->
623 " min:" ++ String.fromInt i
625 maxLabel =
626 case maybeMax of
627 Nothing ->
628 ""
630 Just i ->
631 " max:" ++ String.fromInt i
633 minMaxTest actualheight =
634 case ( maybeMin, maybeMax ) of
635 ( Nothing, Nothing ) ->
636 True
638 ( Just lower, Nothing ) ->
639 lower <= actualheight
641 ( Just lower, Just higher ) ->
642 lower <= actualheight && actualheight <= higher
644 ( Nothing, Just higher ) ->
645 actualheight <= higher
646 in
647 case len of
648 Minimum m newLen ->
649 heightHelper (Just m) maybeMax newLen
651 Maximum m newLen ->
652 heightHelper maybeMin (Just m) newLen
654 Px val ->
655 -- Pixel values should ignore min and max?
656 Testable.LabeledTest
657 { label = "height " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
658 , attr =
659 Element.height
660 (Element.px val
661 |> addMin
662 |> addMax
663 )
664 , id = Testable.IsHeight
665 , test =
666 \found ->
667 [ expectRoundedEquality
668 { expected = toFloat val
669 , found = found.self.bbox.height
670 }
671 , Testable.true "min/max holds true"
672 (minMaxTest (floor found.self.bbox.height))
673 ]
674 }
676 Fill portion ->
677 Testable.LabeledTest
678 { label = "height fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
679 , attr =
680 Element.height
681 (Element.fillPortion portion
682 |> addMin
683 |> addMax
684 )
685 , id = Testable.IsHeight
686 , test =
687 \context ->
688 [ if List.member context.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
689 Testable.true "height fill doesn't apply to above/below elements" True
691 else
692 let
693 parentAvailableHeight =
694 context.parent.bbox.height - (context.self.bbox.padding.top + context.self.bbox.padding.bottom)
695 in
696 case context.parentLayout of
697 Testable.IsNearby _ ->
698 Testable.true "Nearby Element has fill height"
699 ((floor context.parent.bbox.height == floor context.self.bbox.height)
700 || minMaxTest (floor context.self.bbox.height)
701 )
703 Testable.InColumn ->
704 Testable.true "Element within column has fill height"
705 ((floor parentAvailableHeight == floor context.self.bbox.height)
706 || minMaxTest (floor context.self.bbox.height)
707 )
709 Testable.InEl ->
710 Testable.true "Element within el has fill height" <|
711 (floor parentAvailableHeight == floor context.self.bbox.height)
712 || minMaxTest (floor context.self.bbox.height)
714 _ ->
715 let
716 spacePerPortion =
717 parentAvailableHeight / toFloat (List.length context.siblings + 1)
718 in
719 Testable.true "el has fill height" <|
720 (floor spacePerPortion == floor context.self.bbox.height)
721 || minMaxTest (floor context.self.bbox.height)
722 ]
723 }
725 Shrink ->
726 Testable.LabeledTest
727 { label = "height shrink" ++ minLabel ++ maxLabel
728 , attr =
729 Element.height
730 (Element.shrink
731 |> addMin
732 |> addMax
733 )
734 , id = Testable.IsHeight
735 , test =
736 \context ->
737 case context.selfElement of
738 Testable.El _ _ ->
739 let
740 childHeight child =
741 child.bbox.height
742 in
743 [ if List.isEmpty context.children then
744 -- context.self.textMetrics
745 -- |> List.map Testable.textHeight
746 -- |> List.sum
747 -- TODO: apparently the font metrics we have are for the literal characters rendered
748 -- not for the font itself.
749 -- so for now, we are stubbing this in as 20, which is the default font size.
750 Testable.true "expected multiple of 20"
751 ((round context.self.bbox.height |> modBy 20) == 0)
753 else
754 expectRoundedEquality
755 { expected =
756 context.children
757 |> List.map childHeight
758 |> List.sum
759 |> (\h -> h + context.self.bbox.padding.top + context.self.bbox.padding.bottom)
760 , found = context.self.bbox.height
761 }
762 , Testable.lessThanOrEqual "not larger than parent"
763 context.self.bbox.height
764 context.parent.bbox.height
765 ]
767 Testable.Row _ _ ->
768 let
769 childHeight child =
770 child.bbox.height
771 in
772 [ if List.isEmpty context.children then
773 -- context.self.textMetrics
774 -- |> List.map Testable.textHeight
775 -- |> List.sum
776 -- TODO: apparently the font metrics we have are for the literal characters rendered
777 -- not for the font itself.
778 -- so for now, we are stubbing this in as 20, which is the default font size.
779 Testable.true "expected multiple of 20"
780 ((round context.self.bbox.height |> modBy 20) == 0)
782 else
783 expectRoundedEquality
784 { expected =
785 context.children
786 |> List.map childHeight
787 |> List.maximum
788 |> Maybe.withDefault 0
789 |> (\h -> h + context.self.bbox.padding.top + context.self.bbox.padding.bottom)
790 , found = context.self.bbox.height
791 }
792 , Testable.lessThanOrEqual "not larger than parent"
793 context.self.bbox.height
794 context.parent.bbox.height
795 ]
797 Testable.Column colAttrs _ ->
798 let
799 childHeight child =
800 child.bbox.height
802 totalChildren =
803 context.children
804 |> List.map childHeight
805 |> List.append (List.map Testable.textHeight context.self.textMetrics)
806 |> List.sum
808 verticalPadding =
809 context.self.bbox.padding.top + context.self.bbox.padding.bottom
811 spacingAmount =
812 Testable.getSpacingFromAttributes colAttrs
814 totalSpacing =
815 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
816 in
817 [ expectRoundedEquality
818 { expected = totalChildren + verticalPadding + totalSpacing
819 , found = context.self.bbox.height
820 }
821 , Testable.lessThanOrEqual "not larger than parent"
822 context.self.bbox.height
823 context.parent.bbox.height
824 ]
826 Testable.TextColumn _ _ ->
827 [ Testable.lessThanOrEqual "not larger than parent"
828 context.self.bbox.height
829 context.parent.bbox.height
830 ]
832 Testable.Paragraph _ _ ->
833 [ Testable.lessThanOrEqual "not larger than parent"
834 context.self.bbox.height
835 context.parent.bbox.height
836 ]
838 Testable.Text _ ->
839 []
841 Testable.Empty ->
842 []
843 }
846width : Length -> Testable.Attr msg
847width len =
848 widthHelper Nothing Nothing len
851height : Length -> Testable.Attr msg
852height len =
853 heightHelper Nothing Nothing len
856spacing : Int -> Testable.Attr msg
857spacing space =
858 Testable.Batch
859 [ Testable.Spacing space
860 , Testable.LabeledTest
861 { label = "spacing: " ++ String.fromInt space
862 , attr = Element.spacing space
863 , id = Testable.NoId
864 , test =
865 \found ->
866 let
867 findDistance child total =
868 List.concatMap
869 (\otherChild ->
870 let
871 horizontal =
872 round <|
873 child.bbox.left
874 - otherChild.bbox.right
876 vertical =
877 round <|
878 child.bbox.top
879 - otherChild.bbox.bottom
880 in
881 [ if horizontal > 0 then
882 horizontal
884 else
885 space
886 , if vertical > 0 then
887 vertical
889 else
890 space
891 ]
892 )
893 found.children
894 ++ total
896 distances =
897 List.foldl findDistance [] found.children
899 allAreSpaced =
900 List.foldl
901 (\x wrong ->
902 if not (x >= space) then
903 x :: wrong
905 else
906 wrong
907 )
908 []
909 distances
910 in
911 [ Testable.true
912 ("All children are at least "
913 ++ String.fromInt space
914 ++ " pixels apart."
915 ++ Debug.toString allAreSpaced
916 ++ " are not though"
917 )
918 (allAreSpaced == [])
919 ]
920 }
921 ]
924{-| alignLeft needs to account for
926 - parent padding
927 - elements to the left
928 - spacing value
930in order to calculate the expected result.
932Also need parent rendering context if this is to work with wrapped rows in the future.
934All sibling elements
936-}
937alignLeft : Testable.Attr msg
938alignLeft =
939 Testable.LabeledTest
940 { label = "alignLeft"
941 , attr = Element.alignLeft
942 , id = Testable.NoId
943 , test =
944 \found ->
945 [ if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
946 Testable.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
948 else if
949 List.member found.parentLayout
950 [ Testable.IsNearby Testable.InFront
951 , Testable.IsNearby Testable.Behind
952 , Testable.IsNearby Testable.Above
953 , Testable.IsNearby Testable.Below
954 ]
955 then
956 expectRoundedEquality
957 { found = found.self.bbox.left
958 , expected = found.parent.bbox.left
959 }
961 else if List.length found.siblings == 0 then
962 expectRoundedEquality
963 { found = found.self.bbox.left
964 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
965 }
967 else
968 case found.parentLayout of
969 Testable.InRow ->
970 let
971 siblingsOnLeft =
972 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
974 spacings =
975 toFloat (List.length siblingsOnLeft * found.parentSpacing)
977 widthsOnLeft =
978 siblingsOnLeft
979 |> List.map (.width << .bbox)
980 |> List.sum
981 in
982 expectRoundedEquality
983 { found = found.self.bbox.left
984 , expected = found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings)
985 }
987 _ ->
988 expectRoundedEquality
989 { found = found.self.bbox.left
990 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
991 }
992 ]
993 }
996{-| -}
997centerX : Testable.Attr msg
998centerX =
999 Testable.LabeledTest
1000 { label = "centerX"
1001 , attr = Element.centerX
1002 , id = Testable.NoId
1003 , test =
1004 \found ->
1005 let
1006 selfCenter : Float
1007 selfCenter =
1008 found.self.bbox.left + (found.self.bbox.width / 2)
1010 parentCenter : Float
1011 parentCenter =
1012 found.parent.bbox.left + (found.parent.bbox.width / 2)
1013 in
1014 if List.member found.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
1015 [ Testable.true "centerX doesn't apply to elements that are onLeft or onRight" True ]
1017 else if List.length found.siblings == 0 then
1018 [ expectRoundedEquality
1019 { found = selfCenter
1020 , expected = parentCenter
1024 else
1025 case found.parentLayout of
1026 Testable.InRow ->
1027 let
1028 siblingsOnLeft =
1029 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
1031 siblingsOnRight =
1032 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1034 widthsOnLeft : Float
1035 widthsOnLeft =
1036 siblingsOnLeft
1037 |> List.map (.width << .bbox)
1038 |> List.sum
1039 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
1041 widthsOnRight =
1042 siblingsOnRight
1043 |> List.map (.width << .bbox)
1044 |> List.sum
1045 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
1047 expectedCenter : Float
1048 expectedCenter =
1049 found.parent.bbox.left
1050 + widthsOnLeft
1051 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
1052 / 2
1054 in
1055 [ expectRoundedEquality
1056 { found = selfCenter
1057 , expected = expectedCenter
1061 _ ->
1062 [ expectRoundedEquality
1063 { found = selfCenter
1064 , expected = parentCenter
1070{-| -}
1071alignRight : Testable.Attr msg
1072alignRight =
1073 Testable.LabeledTest
1074 { label = "alignRight"
1075 , attr = Element.alignRight
1076 , id = Testable.NoId
1077 , test =
1078 \found ->
1079 if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
1080 [ Testable.true "alignRight doesn't apply to elements that are onLeft or onRight" True ]
1082 else if
1083 List.member found.parentLayout
1084 [ Testable.IsNearby Testable.InFront
1085 , Testable.IsNearby Testable.Behind
1086 , Testable.IsNearby Testable.Above
1087 , Testable.IsNearby Testable.Below
1089 then
1090 [ expectRoundedEquality
1091 { found = found.self.bbox.right
1092 , expected = found.parent.bbox.right
1096 else if List.length found.siblings == 0 then
1097 [ expectRoundedEquality
1098 { found = found.self.bbox.right
1099 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1103 else
1104 case found.parentLayout of
1105 Testable.InRow ->
1106 let
1107 siblingsOnRight =
1108 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1110 spacings =
1111 toFloat (List.length siblingsOnRight * found.parentSpacing)
1113 widthsOnRight =
1114 siblingsOnRight
1115 |> List.map (.width << .bbox)
1116 |> List.sum
1117 in
1118 [ expectRoundedEquality
1119 { found = found.self.bbox.right
1120 , expected = found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings)
1124 _ ->
1125 [ expectRoundedEquality
1126 { found = found.self.bbox.right
1127 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1133{-| -}
1134alignTop : Testable.Attr msg
1135alignTop =
1136 Testable.LabeledTest
1137 { label = "alignTop"
1138 , attr = Element.alignTop
1139 , id = Testable.NoId
1140 , test =
1141 \found ->
1142 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1143 [ Testable.true "alignTop doesn't apply to elements that are above or below" True ]
1145 else if
1146 List.member found.parentLayout
1147 [ Testable.IsNearby Testable.InFront
1148 , Testable.IsNearby Testable.Behind
1149 , Testable.IsNearby Testable.OnRight
1150 , Testable.IsNearby Testable.OnLeft
1152 then
1153 [ expectRoundedEquality
1154 { found = found.self.bbox.top
1155 , expected = found.parent.bbox.top
1159 else if List.length found.siblings == 0 then
1160 [ expectRoundedEquality
1161 { found = found.self.bbox.top
1162 , expected = found.parent.bbox.top + found.parent.bbox.padding.top
1166 else
1167 case found.parentLayout of
1168 Testable.InColumn ->
1169 let
1170 siblingsAbove =
1171 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1173 spacings =
1174 toFloat (List.length siblingsAbove * found.parentSpacing)
1176 heightsAbove =
1177 siblingsAbove
1178 |> List.map (.height << .bbox)
1179 |> List.sum
1180 in
1181 [ expectRoundedEquality
1182 { found = found.self.bbox.top
1183 , expected = found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings)
1187 _ ->
1188 [ expectRoundedEquality
1189 { found = found.self.bbox.top
1190 , expected = found.parent.bbox.top
1196{-| -}
1197alignBottom : Testable.Attr msg
1198alignBottom =
1199 Testable.LabeledTest
1200 { label = "alignBottom"
1201 , attr = Element.alignBottom
1202 , id = Testable.NoId
1203 , test =
1204 \found ->
1205 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1206 [ Testable.true "alignBottom doesn't apply to elements that are above or below" True ]
1208 else if
1209 List.member found.parentLayout
1210 [ Testable.IsNearby Testable.InFront
1211 , Testable.IsNearby Testable.Behind
1212 , Testable.IsNearby Testable.OnRight
1213 , Testable.IsNearby Testable.OnLeft
1215 then
1216 [ expectRoundedEquality
1217 { found = found.self.bbox.bottom
1218 , expected = found.parent.bbox.bottom
1222 else if List.length found.siblings == 0 then
1223 [ expectRoundedEquality
1224 { found = found.self.bbox.bottom
1225 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1229 else
1230 case found.parentLayout of
1231 Testable.InColumn ->
1232 let
1233 siblingsBelow =
1234 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1236 spacings =
1237 toFloat (List.length siblingsBelow * found.parentSpacing)
1239 heightsBelow =
1240 siblingsBelow
1241 |> List.map (.height << .bbox)
1242 |> List.sum
1243 in
1244 [ expectRoundedEquality
1245 { found = found.self.bbox.bottom
1246 , expected = found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings)
1250 _ ->
1251 [ expectRoundedEquality
1252 { found = found.self.bbox.bottom
1253 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1259expectRoundedEquality : { expected : Float, found : Float } -> Testable.LayoutExpectation
1260expectRoundedEquality { expected, found } =
1261 Testable.true
1262 ("expected " ++ floatToString expected ++ ", found " ++ floatToString found)
1263 (abs (expected - found) < 1)
1266floatToString : Float -> String
1267floatToString x =
1268 String.fromFloat (toFloat (round (x * 100)) / 100)
1271{-| -}
1272centerY : Testable.Attr msg
1273centerY =
1274 Testable.LabeledTest
1275 { label = "centerY"
1276 , attr = Element.centerY
1277 , id = Testable.NoId
1278 , test =
1279 \found ->
1280 let
1281 selfCenter =
1282 found.self.bbox.top + (found.self.bbox.height / 2)
1284 parentCenter =
1285 found.parent.bbox.top + (found.parent.bbox.height / 2)
1286 in
1287 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1288 [ Testable.true "centerY doesn't apply to elements that are above or below" True ]
1290 else if List.length found.siblings == 0 then
1291 [ expectRoundedEquality
1292 { found = selfCenter
1293 , expected = parentCenter
1297 else
1298 case found.parentLayout of
1299 Testable.InColumn ->
1300 let
1301 siblingsOnTop =
1302 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1304 siblingsBelow =
1305 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1307 heightsAbove : Float
1308 heightsAbove =
1309 siblingsOnTop
1310 |> List.map (.height << .bbox)
1311 |> List.sum
1312 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1314 heightsBelow =
1315 siblingsBelow
1316 |> List.map (.height << .bbox)
1317 |> List.sum
1318 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1320 expectedCenter : Float
1321 expectedCenter =
1322 found.parent.bbox.top
1323 + heightsAbove
1324 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1325 / 2
1327 in
1328 [ expectRoundedEquality
1329 { found = selfCenter
1330 , expected = expectedCenter
1334 _ ->
1335 [ expectRoundedEquality
1336 { found = selfCenter
1337 , expected = parentCenter
1343{-| -}
1344above : Testable.Element msg -> Testable.Attr msg
1345above element =
1346 Testable.Nearby
1347 { location = Testable.Above
1348 , element = element
1349 , label = "above"
1350 , test =
1351 \found ->
1352 [ expectRoundedEquality
1353 { found = found.self.bbox.bottom
1354 , expected = found.parent.bbox.top
1360{-| -}
1361below : Testable.Element msg -> Testable.Attr msg
1362below element =
1363 Testable.Nearby
1364 { location = Testable.Below
1365 , element = element
1366 , label = "below"
1367 , test =
1368 \found ->
1369 [ expectRoundedEquality
1370 { found = found.self.bbox.top
1371 , expected = found.parent.bbox.bottom
1377{-| -}
1378onRight : Testable.Element msg -> Testable.Attr msg
1379onRight element =
1380 Testable.Nearby
1381 { location = Testable.OnRight
1382 , element = element
1383 , label = "onRight"
1384 , test =
1385 \found ->
1386 [ expectRoundedEquality
1387 { found = found.self.bbox.left
1388 , expected = found.parent.bbox.right
1394{-| -}
1395onLeft : Testable.Element msg -> Testable.Attr msg
1396onLeft element =
1397 Testable.Nearby
1398 { location = Testable.OnLeft
1399 , element = element
1400 , label = "onLeft"
1401 , test =
1402 \found ->
1403 [ expectRoundedEquality
1404 { found = found.self.bbox.right
1405 , expected = found.parent.bbox.left
1411compare x vs y =
1412 vs (round x) (round y) || vs (floor x) (floor y)
1415{-| -}
1416inFront : Testable.Element msg -> Testable.Attr msg
1417inFront element =
1418 Testable.Nearby
1419 { location = Testable.InFront
1420 , element = element
1421 , label = "inFront"
1422 , test =
1423 \found ->
1424 [ withinHelper found ]
1428withinHelper found =
1429 let
1430 horizontalCheck =
1431 if found.self.bbox.width > found.parent.bbox.width then
1432 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1433 || compare found.self.bbox.left (>=) found.parent.bbox.left
1436 else
1437 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1438 , compare found.self.bbox.left (>=) found.parent.bbox.left
1441 verticalCheck =
1442 if found.self.bbox.width > found.parent.bbox.width then
1443 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1444 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1447 else
1448 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1449 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1451 in
1452 Testable.true "within the confines of the parent"
1453 (List.all ((==) True)
1454 (List.concat
1455 [ horizontalCheck
1456 , verticalCheck
1462{-| -}
1463behindContent : Testable.Element msg -> Testable.Attr msg
1464behindContent element =
1465 Testable.Nearby
1466 { location = Testable.Behind
1467 , element = element
1468 , label = "behindContent"
1469 , test =
1470 \found ->
1471 [ withinHelper found ]
1476{- Implicit width/height calcualtions -}
1479implicitWidthHeightShrink attrs =
1480 let
1481 withImplicits =
1482 implicitTest (widthHelper Nothing Nothing Shrink)
1483 :: implicitTest (heightHelper Nothing Nothing Shrink)
1484 :: attrs
1485 in
1486 skipOverridden withImplicits
1489attrId attr =
1490 case attr of
1491 Testable.LabeledTest details ->
1492 details.id
1494 Testable.AttrTest details ->
1495 details.id
1497 _ ->
1498 Testable.NoId
1501skipOverridden ls =
1502 List.foldr
1503 (\attr ( found, caught ) ->
1504 let
1505 ( skip, has ) =
1506 case attrId attr of
1507 Testable.NoId ->
1508 ( False, found )
1510 Testable.IsWidth ->
1511 ( found.hasWidth
1512 , { hasWidth = True
1513 , hasHeight = found.hasHeight
1517 Testable.IsHeight ->
1518 ( found.hasHeight
1519 , { hasWidth = found.hasWidth
1520 , hasHeight = True
1523 in
1524 ( has
1525 , if skip then
1526 caught
1528 else
1529 attr :: caught
1532 ( { hasWidth = False
1533 , hasHeight = False
1535 , []
1537 ls
1538 |> Tuple.second
1539 |> List.reverse
1542{-| This is taking a normal test and rmoving its ability to attach a real `Element` attribute.
1544implicitTest attr =
1545 case attr of
1546 Testable.LabeledTest details ->
1547 Testable.AttrTest
1548 { test = details.test
1549 , label = "Implicit -> " ++ details.label
1550 , id = details.id
1553 otherwise ->
1554 otherwise