git.iko.soy/typeable/elm-ui
on 8190467 help sign in
typeable/elm-ui/tests-rendering/src/Testable/Element.elm
1608 lines 60 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 , toProgram
45 , transparent
46 , width
47 )
49{-| This module should mirror the top level `Element` api, with one important distinction.
51The resulting `Element msg` structure can either be rendered to Html or transformed into a test suite that can be run.
53In order to run the test:
55 - render html
56 - gather information from the browser
57 - generate tests
59-}
61import Dict
62import Element
63import Html.Attributes
64import Testable
65import Testable.Runner
68{-| This is used when we want to run all tests in a test suite instead of one at a time.
69-}
70toProgram : Testable.Runner.Testable -> Testable.Runner.TestableProgram
71toProgram testable =
72 Testable.Runner.program [ testable ]
75layout : List (Testable.Attr msg) -> Testable.Element Testable.Runner.Msg -> Testable.Runner.Testable
76layout attrs elem =
77 Testable.Runner.testable "Test" elem
80text : String -> Testable.Element msg
81text =
82 Testable.Text
85el : List (Testable.Attr msg) -> Testable.Element msg -> Testable.Element msg
86el attrs =
87 Testable.El (implicitWidthHeightShrink attrs)
90row : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
91row attrs =
92 Testable.Row (implicitWidthHeightShrink attrs)
95column : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
96column attrs =
97 Testable.Column (implicitWidthHeightShrink attrs)
100none : Testable.Element msg
101none =
102 Testable.Empty
105paragraph : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
106paragraph attrs =
107 let
108 withImplicits =
109 implicitTest (widthHelper Nothing Nothing (Fill 1))
110 :: implicitTest (heightHelper Nothing Nothing Shrink)
111 :: attrs
112 in
113 Testable.Paragraph (skipOverridden withImplicits)
116textColumn : List (Testable.Attr msg) -> List (Testable.Element msg) -> Testable.Element msg
117textColumn attrs =
118 let
119 withImplicits =
120 implicitTest (widthHelper (Just 500) (Just 750) (Fill 1))
121 :: implicitTest (heightHelper Nothing Nothing Shrink)
122 :: attrs
123 in
124 Testable.TextColumn (skipOverridden withImplicits)
127link :
128 List (Testable.Attr msg)
129 ->
130 { url : String
131 , label : Testable.Element msg
132 }
133 -> Testable.Element msg
134link attrs details =
135 -- TODO: this is not actually a link element!!
136 Testable.El (implicitWidthHeightShrink attrs) details.label
139{-| Old labeling mechanism that i removed to hastily
140-}
141label str =
142 Testable.Batch []
145moveUp x =
146 Testable.Attr (Element.moveUp x)
149moveDown x =
150 Testable.Attr (Element.moveDown x)
153moveRight x =
154 Testable.Attr (Element.moveRight x)
157moveLeft x =
158 Testable.Attr (Element.moveLeft x)
161type Length
162 = Px Int
163 | Fill Int
164 | Shrink
165 | Minimum Int Length
166 | Maximum Int Length
169minimum =
170 Minimum
173maximum =
174 Maximum
177rgb =
178 Element.rgb
181rgba =
182 Element.rgba
185px : Int -> Length
186px =
187 Px
190fill : Length
191fill =
192 Fill 1
195shrink : Length
196shrink =
197 Shrink
200fillPortion : Int -> Length
201fillPortion =
202 Fill
205transparent : Bool -> Testable.Attr msg
206transparent on =
207 Testable.LabeledTest
208 { label =
209 if on then
210 "transparent"
212 else
213 "opaque"
214 , attr = Element.transparent on
215 , id = Testable.NoId
216 , test =
217 \context ->
218 let
219 selfTransparency =
220 context.self.style
221 |> Dict.get "opacity"
222 |> Maybe.withDefault "notfound"
224 value =
225 if on then
226 "0"
228 else
229 "1"
230 in
231 [ Testable.equal value selfTransparency ]
232 }
235{-| -}
236isVisible : Testable.Attr msg
237isVisible =
238 Testable.AttrTest
239 { label = "is-visible"
240 , id = Testable.NoId
241 , test =
242 \context ->
243 [ Testable.equal context.self.isVisible True ]
244 }
247{-| -}
248alpha : Float -> Testable.Attr msg
249alpha a =
250 Testable.LabeledTest
251 { label = "alpha-" ++ String.fromFloat a
252 , attr = Element.alpha a
253 , id = Testable.NoId
254 , test =
255 \context ->
256 let
257 selfTransparency =
258 context.self.style
259 |> Dict.get "opacity"
260 |> Maybe.withDefault "notfound"
261 in
262 [ Testable.equal (String.fromFloat a) selfTransparency ]
263 }
266{-| -}
267padding : Int -> Testable.Attr msg
268padding pad =
269 Testable.LabeledTest
270 { label = "padding " ++ String.fromInt pad
271 , attr = Element.padding pad
272 , id = Testable.NoId
273 , test =
274 \found ->
275 [ Testable.true ("Padding " ++ String.fromInt pad ++ " is present")
276 (List.all ((==) pad)
277 [ floor found.self.bbox.padding.left
278 , floor found.self.bbox.padding.right
279 , floor found.self.bbox.padding.top
280 , floor found.self.bbox.padding.bottom
281 ]
282 )
283 ]
284 }
287{-| -}
288paddingXY : Int -> Int -> Testable.Attr msg
289paddingXY x y =
290 Testable.LabeledTest
291 { label = "paddingXY " ++ String.fromInt x ++ ", " ++ String.fromInt y
292 , attr = Element.paddingXY x y
293 , id = Testable.NoId
294 , test =
295 \found ->
296 [ Testable.true ("PaddingXY (" ++ String.fromInt x ++ ", " ++ String.fromInt y ++ ") is present")
297 (List.all ((==) x)
298 [ floor found.self.bbox.padding.left
299 , floor found.self.bbox.padding.right
300 ]
301 && List.all ((==) y)
302 [ floor found.self.bbox.padding.top
303 , floor found.self.bbox.padding.bottom
304 ]
305 )
306 ]
307 }
310widthHelper maybeMin maybeMax len =
311 let
312 addMin l =
313 case maybeMin of
314 Nothing ->
315 l
317 Just minPx ->
318 l |> Element.minimum minPx
320 addMax l =
321 case maybeMax of
322 Nothing ->
323 l
325 Just maxPx ->
326 l |> Element.maximum maxPx
328 minLabel =
329 case maybeMin of
330 Nothing ->
331 ""
333 Just i ->
334 " min:" ++ String.fromInt i
336 maxLabel =
337 case maybeMax of
338 Nothing ->
339 ""
341 Just i ->
342 " max:" ++ String.fromInt i
344 minMaxTest actualWidth =
345 case ( maybeMin, maybeMax ) of
346 ( Nothing, Nothing ) ->
347 True
349 ( Just lower, Nothing ) ->
350 lower <= actualWidth
352 ( Just lower, Just higher ) ->
353 lower <= actualWidth && actualWidth <= higher
355 ( Nothing, Just higher ) ->
356 actualWidth <= higher
357 in
358 case len of
359 Minimum m newLen ->
360 widthHelper (Just m) maybeMax newLen
362 Maximum m newLen ->
363 widthHelper maybeMin (Just m) newLen
365 Px val ->
366 -- Pixel values should ignore min and max?
367 Testable.LabeledTest
368 { label = "width " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
369 , id = Testable.IsWidth
370 , attr =
371 Element.width
372 (Element.px val
373 |> addMin
374 |> addMax
375 )
376 , test =
377 \found ->
378 [ expectRoundedEquality
379 { expected = toFloat val
380 , found = found.self.bbox.width
381 }
382 , Testable.true "min/max is upheld" (minMaxTest (floor found.self.bbox.width))
383 ]
384 }
386 Fill portion ->
387 Testable.LabeledTest
388 { label =
389 if portion == 1 then
390 "width fill" ++ minLabel ++ maxLabel
392 else
393 "width fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
394 , id = Testable.IsWidth
395 , attr =
396 Element.width
397 (Element.fillPortion portion
398 |> addMin
399 |> addMax
400 )
401 , test =
402 \context ->
403 if List.member context.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
404 [ Testable.true "width fill doesn't apply to onright/onleft elements" True ]
406 else
407 let
408 parentAvailableWidth =
409 context.parent.bbox.width - (context.self.bbox.padding.left + context.self.bbox.padding.right)
410 in
411 List.concat
412 [ case context.parentLayout of
413 Testable.IsNearby _ ->
414 [ Testable.true "Nearby Element has fill width"
415 ((floor context.parent.bbox.width == floor context.self.bbox.width)
416 || minMaxTest (floor context.self.bbox.width)
417 )
418 ]
420 Testable.InColumn ->
421 [ Testable.true "Element within column has fill width"
422 ((floor parentAvailableWidth == floor context.self.bbox.width)
423 || minMaxTest (floor context.self.bbox.width)
424 )
425 ]
427 Testable.InEl ->
428 [ Testable.true "Element within element has fill width" <|
429 (floor parentAvailableWidth == floor context.self.bbox.width)
430 || minMaxTest (floor context.self.bbox.width)
431 ]
433 _ ->
434 let
435 spacePerPortion =
436 parentAvailableWidth / toFloat (List.length context.siblings + 1)
437 in
438 [ Testable.true "element has fill width" <|
439 (floor spacePerPortion == floor context.self.bbox.width)
440 || minMaxTest (floor context.self.bbox.width)
441 ]
442 , [ Testable.lessThanOrEqual "not larger than parent"
443 context.self.bbox.width
444 context.parent.bbox.width
445 ]
446 , case context.selfElement of
447 Testable.Paragraph _ _ ->
448 -- A paragraph with width fill
449 -- we want to test for correct text wrapping here.
450 --
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
464 totalCalculatedWidth =
465 totalChildren + horizontalPadding
467 expectedLines =
468 ceiling (totalCalculatedWidth / context.self.bbox.width)
469 in
470 [ Testable.rounded "text wrapping, checking height"
471 { expected = toFloat (expectedLines * 22)
472 , found = context.self.bbox.height
473 }
474 ]
476 _ ->
477 []
478 ]
479 }
481 Shrink ->
482 Testable.LabeledTest
483 { label = "width shrink" ++ minLabel ++ maxLabel
484 , attr =
485 Element.width
486 (Element.shrink
487 |> addMin
488 |> addMax
489 )
490 , id = Testable.IsWidth
491 , test =
492 \context ->
493 case context.selfElement of
494 Testable.El _ _ ->
495 let
496 childWidth child =
497 child.bbox.width
499 totalChildren =
500 context.children
501 |> List.map childWidth
502 |> List.append (List.map .width context.self.textMetrics)
503 |> List.sum
505 horizontalPadding =
506 context.self.bbox.padding.left + context.self.bbox.padding.right
508 _ =
509 Debug.log "widths"
510 { children =
511 context.children
512 |> List.map childWidth
513 , text = List.map .width context.self.textMetrics
514 }
515 in
516 [ Testable.rounded "equals children"
517 { expected = totalChildren + horizontalPadding
518 , found = context.self.bbox.width
519 }
520 , Testable.lessThanOrEqual "not larger than parent"
521 context.self.bbox.width
522 context.parent.bbox.width
523 ]
525 Testable.Row rowAttrs _ ->
526 -- width of row is the sum of all children widths
527 -- both text elements and others.
528 let
529 childWidth child =
530 child.bbox.width
532 totalChildren =
533 context.children
534 |> List.map childWidth
535 |> List.append (List.map .width context.self.textMetrics)
536 |> List.sum
538 horizontalPadding =
539 context.self.bbox.padding.left + context.self.bbox.padding.right
541 spacingAmount =
542 Testable.getSpacingFromAttributes rowAttrs
544 totalSpacing =
545 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
546 in
547 [ expectRoundedEquality
548 { expected = totalChildren + horizontalPadding + totalSpacing
549 , found = context.self.bbox.width
550 }
551 , Testable.lessThanOrEqual "not larger than parent"
552 context.self.bbox.width
553 context.parent.bbox.width
554 ]
556 Testable.Column _ _ ->
557 -- The width of the column is the width of the widest child.
558 let
559 childWidth child =
560 child.bbox.width
561 + context.self.bbox.padding.left
562 + context.self.bbox.padding.right
564 textChildren =
565 List.map
566 (\txt ->
567 txt.width
568 + context.self.bbox.padding.left
569 + context.self.bbox.padding.right
570 )
571 context.self.textMetrics
573 allChildren =
574 context.children
575 |> List.map childWidth
576 |> List.append textChildren
577 in
578 [ expectRoundedEquality
579 { expected = Maybe.withDefault 0 (List.maximum allChildren)
580 , found = context.self.bbox.width
581 }
582 , Testable.lessThanOrEqual "not larger than parent"
583 context.self.bbox.width
584 context.parent.bbox.width
585 ]
587 Testable.TextColumn _ _ ->
588 -- The width of the column is the width of the widest child.
589 let
590 childWidth child =
591 child.bbox.width
592 + context.self.bbox.padding.left
593 + context.self.bbox.padding.right
595 textChildren =
596 List.map
597 (\txt ->
598 txt.width
599 + context.self.bbox.padding.left
600 + context.self.bbox.padding.right
601 )
602 context.self.textMetrics
604 allChildren =
605 context.children
606 |> List.map childWidth
607 |> List.append textChildren
608 in
609 [ expectRoundedEquality
610 { expected = Maybe.withDefault 0 (List.maximum allChildren)
611 , found = context.self.bbox.width
612 }
613 , Testable.lessThanOrEqual "not larger than parent"
614 context.self.bbox.width
615 context.parent.bbox.width
616 ]
618 Testable.Paragraph _ _ ->
619 -- This should be the size it's text,
620 -- unless it takes up all available space, in which case it should wrap.
621 let
622 childWidth child =
623 child.bbox.width
625 totalChildren =
626 context.children
627 |> List.map childWidth
628 |> List.append (List.map .width context.self.textMetrics)
629 |> List.sum
631 horizontalPadding =
632 context.self.bbox.padding.left + context.self.bbox.padding.right
633 in
634 [ expectRoundedEquality
635 { expected = totalChildren + horizontalPadding
636 , found = context.self.bbox.width
637 }
638 , Testable.lessThanOrEqual "not larger than parent"
639 context.self.bbox.width
640 context.parent.bbox.width
641 ]
643 Testable.Text _ ->
644 []
646 Testable.Empty ->
647 []
648 }
651heightHelper maybeMin maybeMax len =
652 let
653 addMin l =
654 case maybeMin of
655 Nothing ->
656 l
658 Just minPx ->
659 l |> Element.minimum minPx
661 addMax l =
662 case maybeMax of
663 Nothing ->
664 l
666 Just maxPx ->
667 l |> Element.maximum maxPx
669 minLabel =
670 case maybeMin of
671 Nothing ->
672 ""
674 Just i ->
675 " min:" ++ String.fromInt i
677 maxLabel =
678 case maybeMax of
679 Nothing ->
680 ""
682 Just i ->
683 " max:" ++ String.fromInt i
685 minMaxTest actualheight =
686 case ( maybeMin, maybeMax ) of
687 ( Nothing, Nothing ) ->
688 True
690 ( Just lower, Nothing ) ->
691 lower <= actualheight
693 ( Just lower, Just higher ) ->
694 lower <= actualheight && actualheight <= higher
696 ( Nothing, Just higher ) ->
697 actualheight <= higher
698 in
699 case len of
700 Minimum m newLen ->
701 heightHelper (Just m) maybeMax newLen
703 Maximum m newLen ->
704 heightHelper maybeMin (Just m) newLen
706 Px val ->
707 -- Pixel values should ignore min and max?
708 Testable.LabeledTest
709 { label = "height " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
710 , attr =
711 Element.height
712 (Element.px val
713 |> addMin
714 |> addMax
715 )
716 , id = Testable.IsHeight
717 , test =
718 \found ->
719 [ expectRoundedEquality
720 { expected = toFloat val
721 , found = found.self.bbox.height
722 }
723 , Testable.true "min/max holds true"
724 (minMaxTest (floor found.self.bbox.height))
725 ]
726 }
728 Fill portion ->
729 Testable.LabeledTest
730 { label = "height fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
731 , attr =
732 Element.height
733 (Element.fillPortion portion
734 |> addMin
735 |> addMax
736 )
737 , id = Testable.IsHeight
738 , test =
739 \context ->
740 [ if List.member context.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
741 Testable.true "height fill doesn't apply to above/below elements" True
743 else
744 let
745 parentAvailableHeight =
746 context.parent.bbox.height - (context.self.bbox.padding.top + context.self.bbox.padding.bottom)
747 in
748 case context.parentLayout of
749 Testable.IsNearby _ ->
750 Testable.true "Nearby Element has fill height"
751 ((floor context.parent.bbox.height == floor context.self.bbox.height)
752 || minMaxTest (floor context.self.bbox.height)
753 )
755 Testable.InColumn ->
756 Testable.true "Element within column has fill height"
757 ((floor parentAvailableHeight == floor context.self.bbox.height)
758 || minMaxTest (floor context.self.bbox.height)
759 )
761 Testable.InEl ->
762 Testable.true "Element within el has fill height" <|
763 (floor parentAvailableHeight == floor context.self.bbox.height)
764 || minMaxTest (floor context.self.bbox.height)
766 _ ->
767 let
768 spacePerPortion =
769 parentAvailableHeight / toFloat (List.length context.siblings + 1)
770 in
771 Testable.true "el has fill height" <|
772 (floor spacePerPortion == floor context.self.bbox.height)
773 || minMaxTest (floor context.self.bbox.height)
774 ]
775 }
777 Shrink ->
778 Testable.LabeledTest
779 { label = "height shrink" ++ minLabel ++ maxLabel
780 , attr =
781 Element.height
782 (Element.shrink
783 |> addMin
784 |> addMax
785 )
786 , id = Testable.IsHeight
787 , test =
788 \context ->
789 case context.selfElement of
790 Testable.El _ _ ->
791 let
792 childHeight child =
793 child.bbox.height
794 in
795 [ if List.isEmpty context.children then
796 -- context.self.textMetrics
797 -- |> List.map Testable.textHeight
798 -- |> List.sum
799 -- TODO: apparently the font metrics we have are for the literal characters rendered
800 -- not for the font itself.
801 -- so for now, we are stubbing this in as 20, which is the default font size + line height.
802 Testable.rounded "expected multiple of 20"
803 { expected = context.self.bbox.height
804 , found = toFloat (List.length context.self.textMetrics * 20)
805 }
807 else
808 expectRoundedEquality
809 { expected =
810 context.children
811 |> List.map childHeight
812 |> List.sum
813 |> (\h -> h + context.self.bbox.padding.top + context.self.bbox.padding.bottom)
814 , found = context.self.bbox.height
815 }
816 , Testable.lessThanOrEqual "not larger than parent"
817 context.self.bbox.height
818 context.parent.bbox.height
819 ]
821 Testable.Row _ _ ->
822 let
823 childHeight child =
824 child.bbox.height
825 in
826 [ if List.isEmpty context.children then
827 -- context.self.textMetrics
828 -- |> List.map Testable.textHeight
829 -- |> List.sum
830 -- TODO: apparently the font metrics we have are for the literal characters rendered
831 -- not for the font itself.
832 -- so for now, we are stubbing this in as 20, which is the default font size.
833 Testable.true "expected multiple of 20"
834 ((round context.self.bbox.height |> modBy 20) == 0)
836 else
837 expectRoundedEquality
838 { expected =
839 context.children
840 |> List.map childHeight
841 |> List.maximum
842 |> Maybe.withDefault 0
843 |> (\h -> h + context.self.bbox.padding.top + context.self.bbox.padding.bottom)
844 , found = context.self.bbox.height
845 }
846 , Testable.lessThanOrEqual "not larger than parent"
847 context.self.bbox.height
848 context.parent.bbox.height
849 ]
851 Testable.Column colAttrs _ ->
852 let
853 childHeight child =
854 child.bbox.height
856 totalChildren =
857 context.children
858 |> List.map childHeight
859 |> List.append (List.map Testable.textHeight context.self.textMetrics)
860 |> List.sum
862 verticalPadding =
863 context.self.bbox.padding.top + context.self.bbox.padding.bottom
865 spacingAmount =
866 Testable.getSpacingFromAttributes colAttrs
868 totalSpacing =
869 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
870 in
871 [ expectRoundedEquality
872 { expected = totalChildren + verticalPadding + totalSpacing
873 , found = context.self.bbox.height
874 }
875 , Testable.lessThanOrEqual "not larger than parent"
876 context.self.bbox.height
877 context.parent.bbox.height
878 ]
880 Testable.TextColumn _ _ ->
881 [ Testable.lessThanOrEqual "not larger than parent"
882 context.self.bbox.height
883 context.parent.bbox.height
884 ]
886 Testable.Paragraph _ _ ->
887 [ Testable.lessThanOrEqual "not larger than parent"
888 context.self.bbox.height
889 context.parent.bbox.height
890 ]
892 Testable.Text _ ->
893 []
895 Testable.Empty ->
896 []
897 }
900width : Length -> Testable.Attr msg
901width len =
902 widthHelper Nothing Nothing len
905height : Length -> Testable.Attr msg
906height len =
907 heightHelper Nothing Nothing len
910spacing : Int -> Testable.Attr msg
911spacing space =
912 Testable.Batch
913 [ Testable.Spacing space
914 , Testable.LabeledTest
915 { label = "spacing: " ++ String.fromInt space
916 , attr = Element.spacing space
917 , id = Testable.NoId
918 , test =
919 \found ->
920 let
921 findDistance child total =
922 List.concatMap
923 (\otherChild ->
924 let
925 horizontal =
926 round <|
927 child.bbox.left
928 - otherChild.bbox.right
930 vertical =
931 round <|
932 child.bbox.top
933 - otherChild.bbox.bottom
934 in
935 [ if horizontal > 0 then
936 horizontal
938 else
939 space
940 , if vertical > 0 then
941 vertical
943 else
944 space
945 ]
946 )
947 found.children
948 ++ total
950 distances =
951 List.foldl findDistance [] found.children
953 allAreSpaced =
954 List.foldl
955 (\x wrong ->
956 if not (x >= space) then
957 x :: wrong
959 else
960 wrong
961 )
962 []
963 distances
964 in
965 [ Testable.true
966 ("All children are at least "
967 ++ String.fromInt space
968 ++ " pixels apart."
969 ++ Debug.toString allAreSpaced
970 ++ " are not though"
971 )
972 (allAreSpaced == [])
973 ]
974 }
975 ]
978{-| alignLeft needs to account for
980 - parent padding
981 - elements to the left
982 - spacing value
984in order to calculate the expected result.
986Also need parent rendering context if this is to work with wrapped rows in the future.
988All sibling elements
990-}
991alignLeft : Testable.Attr msg
992alignLeft =
993 Testable.LabeledTest
994 { label = "alignLeft"
995 , attr = Element.alignLeft
996 , id = Testable.NoId
997 , test =
998 \found ->
999 [ if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
1000 Testable.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
1002 else if
1003 List.member found.parentLayout
1004 [ Testable.IsNearby Testable.InFront
1005 , Testable.IsNearby Testable.Behind
1006 , Testable.IsNearby Testable.Above
1007 , Testable.IsNearby Testable.Below
1009 then
1010 expectRoundedEquality
1011 { found = found.self.bbox.left
1012 , expected = found.parent.bbox.left
1015 else if List.length found.siblings == 0 then
1016 expectRoundedEquality
1017 { found = found.self.bbox.left
1018 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
1021 else
1022 case found.parentLayout of
1023 Testable.InRow ->
1024 let
1025 siblingsOnLeft =
1026 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
1028 spacings =
1029 toFloat (List.length siblingsOnLeft * found.parentSpacing)
1031 widthsOnLeft =
1032 siblingsOnLeft
1033 |> List.map (.width << .bbox)
1034 |> List.sum
1035 in
1036 expectRoundedEquality
1037 { found = found.self.bbox.left
1038 , expected = found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings)
1041 _ ->
1042 expectRoundedEquality
1043 { found = found.self.bbox.left
1044 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
1050{-| -}
1051centerX : Testable.Attr msg
1052centerX =
1053 Testable.LabeledTest
1054 { label = "centerX"
1055 , attr = Element.centerX
1056 , id = Testable.NoId
1057 , test =
1058 \found ->
1059 let
1060 selfCenter : Float
1061 selfCenter =
1062 found.self.bbox.left + (found.self.bbox.width / 2)
1064 parentCenter : Float
1065 parentCenter =
1066 found.parent.bbox.left + (found.parent.bbox.width / 2)
1067 in
1068 if List.member found.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
1069 [ Testable.true "centerX doesn't apply to elements that are onLeft or onRight" True ]
1071 else if List.length found.siblings == 0 then
1072 [ expectRoundedEquality
1073 { found = selfCenter
1074 , expected = parentCenter
1078 else
1079 case found.parentLayout of
1080 Testable.InRow ->
1081 let
1082 siblingsOnLeft =
1083 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
1085 siblingsOnRight =
1086 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1088 widthsOnLeft : Float
1089 widthsOnLeft =
1090 siblingsOnLeft
1091 |> List.map (.width << .bbox)
1092 |> List.sum
1093 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
1095 widthsOnRight =
1096 siblingsOnRight
1097 |> List.map (.width << .bbox)
1098 |> List.sum
1099 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
1101 expectedCenter : Float
1102 expectedCenter =
1103 found.parent.bbox.left
1104 + widthsOnLeft
1105 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
1106 / 2
1108 in
1109 [ expectRoundedEquality
1110 { found = selfCenter
1111 , expected = expectedCenter
1115 _ ->
1116 [ expectRoundedEquality
1117 { found = selfCenter
1118 , expected = parentCenter
1124{-| -}
1125alignRight : Testable.Attr msg
1126alignRight =
1127 Testable.LabeledTest
1128 { label = "alignRight"
1129 , attr = Element.alignRight
1130 , id = Testable.NoId
1131 , test =
1132 \found ->
1133 if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
1134 [ Testable.true "alignRight doesn't apply to elements that are onLeft or onRight" True ]
1136 else if
1137 List.member found.parentLayout
1138 [ Testable.IsNearby Testable.InFront
1139 , Testable.IsNearby Testable.Behind
1140 , Testable.IsNearby Testable.Above
1141 , Testable.IsNearby Testable.Below
1143 then
1144 [ expectRoundedEquality
1145 { found = found.self.bbox.right
1146 , expected = found.parent.bbox.right
1150 else if List.length found.siblings == 0 then
1151 [ expectRoundedEquality
1152 { found = found.self.bbox.right
1153 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1157 else
1158 case found.parentLayout of
1159 Testable.InRow ->
1160 let
1161 siblingsOnRight =
1162 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1164 spacings =
1165 toFloat (List.length siblingsOnRight * found.parentSpacing)
1167 widthsOnRight =
1168 siblingsOnRight
1169 |> List.map (.width << .bbox)
1170 |> List.sum
1171 in
1172 [ expectRoundedEquality
1173 { found = found.self.bbox.right
1174 , expected = found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings)
1178 _ ->
1179 [ expectRoundedEquality
1180 { found = found.self.bbox.right
1181 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1187{-| -}
1188alignTop : Testable.Attr msg
1189alignTop =
1190 Testable.LabeledTest
1191 { label = "alignTop"
1192 , attr = Element.alignTop
1193 , id = Testable.NoId
1194 , test =
1195 \found ->
1196 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1197 [ Testable.true "alignTop doesn't apply to elements that are above or below" True ]
1199 else if
1200 List.member found.parentLayout
1201 [ Testable.IsNearby Testable.InFront
1202 , Testable.IsNearby Testable.Behind
1203 , Testable.IsNearby Testable.OnRight
1204 , Testable.IsNearby Testable.OnLeft
1206 then
1207 [ expectRoundedEquality
1208 { found = found.self.bbox.top
1209 , expected = found.parent.bbox.top
1213 else if List.length found.siblings == 0 then
1214 [ expectRoundedEquality
1215 { found = found.self.bbox.top
1216 , expected = found.parent.bbox.top + found.parent.bbox.padding.top
1220 else
1221 case found.parentLayout of
1222 Testable.InColumn ->
1223 let
1224 siblingsAbove =
1225 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1227 spacings =
1228 toFloat (List.length siblingsAbove * found.parentSpacing)
1230 heightsAbove =
1231 siblingsAbove
1232 |> List.map (.height << .bbox)
1233 |> List.sum
1234 in
1235 [ expectRoundedEquality
1236 { found = found.self.bbox.top
1237 , expected = found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings)
1241 _ ->
1242 [ expectRoundedEquality
1243 { found = found.self.bbox.top
1244 , expected = found.parent.bbox.top
1250{-| -}
1251alignBottom : Testable.Attr msg
1252alignBottom =
1253 Testable.LabeledTest
1254 { label = "alignBottom"
1255 , attr = Element.alignBottom
1256 , id = Testable.NoId
1257 , test =
1258 \found ->
1259 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1260 [ Testable.true "alignBottom doesn't apply to elements that are above or below" True ]
1262 else if
1263 List.member found.parentLayout
1264 [ Testable.IsNearby Testable.InFront
1265 , Testable.IsNearby Testable.Behind
1266 , Testable.IsNearby Testable.OnRight
1267 , Testable.IsNearby Testable.OnLeft
1269 then
1270 [ expectRoundedEquality
1271 { found = found.self.bbox.bottom
1272 , expected = found.parent.bbox.bottom
1276 else if List.length found.siblings == 0 then
1277 [ expectRoundedEquality
1278 { found = found.self.bbox.bottom
1279 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1283 else
1284 case found.parentLayout of
1285 Testable.InColumn ->
1286 let
1287 siblingsBelow =
1288 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1290 spacings =
1291 toFloat (List.length siblingsBelow * found.parentSpacing)
1293 heightsBelow =
1294 siblingsBelow
1295 |> List.map (.height << .bbox)
1296 |> List.sum
1297 in
1298 [ expectRoundedEquality
1299 { found = found.self.bbox.bottom
1300 , expected = found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings)
1304 _ ->
1305 [ expectRoundedEquality
1306 { found = found.self.bbox.bottom
1307 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1313expectRoundedEquality : { expected : Float, found : Float } -> Testable.LayoutExpectation
1314expectRoundedEquality { expected, found } =
1315 Testable.true
1316 ("expected " ++ floatToString expected ++ ", found " ++ floatToString found)
1317 (abs (expected - found) < 1)
1320floatToString : Float -> String
1321floatToString x =
1322 String.fromFloat (toFloat (round (x * 100)) / 100)
1325{-| -}
1326centerY : Testable.Attr msg
1327centerY =
1328 Testable.LabeledTest
1329 { label = "centerY"
1330 , attr = Element.centerY
1331 , id = Testable.NoId
1332 , test =
1333 \found ->
1334 let
1335 selfCenter =
1336 found.self.bbox.top + (found.self.bbox.height / 2)
1338 parentCenter =
1339 found.parent.bbox.top + (found.parent.bbox.height / 2)
1340 in
1341 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1342 [ Testable.true "centerY doesn't apply to elements that are above or below" True ]
1344 else if List.length found.siblings == 0 then
1345 [ expectRoundedEquality
1346 { found = selfCenter
1347 , expected = parentCenter
1351 else
1352 case found.parentLayout of
1353 Testable.InColumn ->
1354 let
1355 siblingsOnTop =
1356 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1358 siblingsBelow =
1359 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1361 heightsAbove : Float
1362 heightsAbove =
1363 siblingsOnTop
1364 |> List.map (.height << .bbox)
1365 |> List.sum
1366 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1368 heightsBelow =
1369 siblingsBelow
1370 |> List.map (.height << .bbox)
1371 |> List.sum
1372 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1374 expectedCenter : Float
1375 expectedCenter =
1376 found.parent.bbox.top
1377 + heightsAbove
1378 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1379 / 2
1381 in
1382 [ expectRoundedEquality
1383 { found = selfCenter
1384 , expected = expectedCenter
1388 _ ->
1389 [ expectRoundedEquality
1390 { found = selfCenter
1391 , expected = parentCenter
1397{-| -}
1398above : Testable.Element msg -> Testable.Attr msg
1399above element =
1400 Testable.Nearby
1401 { location = Testable.Above
1402 , element = element
1403 , label = "above"
1404 , test =
1405 \found ->
1406 [ expectRoundedEquality
1407 { found = found.self.bbox.bottom
1408 , expected = found.parent.bbox.top
1414{-| -}
1415below : Testable.Element msg -> Testable.Attr msg
1416below element =
1417 Testable.Nearby
1418 { location = Testable.Below
1419 , element = element
1420 , label = "below"
1421 , test =
1422 \found ->
1423 [ expectRoundedEquality
1424 { found = found.self.bbox.top
1425 , expected = found.parent.bbox.bottom
1431{-| -}
1432onRight : Testable.Element msg -> Testable.Attr msg
1433onRight element =
1434 Testable.Nearby
1435 { location = Testable.OnRight
1436 , element = element
1437 , label = "onRight"
1438 , test =
1439 \found ->
1440 [ expectRoundedEquality
1441 { found = found.self.bbox.left
1442 , expected = found.parent.bbox.right
1448{-| -}
1449onLeft : Testable.Element msg -> Testable.Attr msg
1450onLeft element =
1451 Testable.Nearby
1452 { location = Testable.OnLeft
1453 , element = element
1454 , label = "onLeft"
1455 , test =
1456 \found ->
1457 [ expectRoundedEquality
1458 { found = found.self.bbox.right
1459 , expected = found.parent.bbox.left
1465compare x vs y =
1466 vs (round x) (round y) || vs (floor x) (floor y)
1469{-| -}
1470inFront : Testable.Element msg -> Testable.Attr msg
1471inFront element =
1472 Testable.Nearby
1473 { location = Testable.InFront
1474 , element = element
1475 , label = "inFront"
1476 , test =
1477 \found ->
1478 [ withinHelper found ]
1482withinHelper found =
1483 let
1484 horizontalCheck =
1485 if found.self.bbox.width > found.parent.bbox.width then
1486 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1487 || compare found.self.bbox.left (>=) found.parent.bbox.left
1490 else
1491 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1492 , compare found.self.bbox.left (>=) found.parent.bbox.left
1495 verticalCheck =
1496 if found.self.bbox.width > found.parent.bbox.width then
1497 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1498 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1501 else
1502 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1503 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1505 in
1506 Testable.true "within the confines of the parent"
1507 (List.all ((==) True)
1508 (List.concat
1509 [ horizontalCheck
1510 , verticalCheck
1516{-| -}
1517behindContent : Testable.Element msg -> Testable.Attr msg
1518behindContent element =
1519 Testable.Nearby
1520 { location = Testable.Behind
1521 , element = element
1522 , label = "behindContent"
1523 , test =
1524 \found ->
1525 [ withinHelper found ]
1530{- Implicit width/height calcualtions -}
1533implicitWidthHeightShrink attrs =
1534 let
1535 withImplicits =
1536 implicitTest (widthHelper Nothing Nothing Shrink)
1537 :: implicitTest (heightHelper Nothing Nothing Shrink)
1538 :: attrs
1539 in
1540 skipOverridden withImplicits
1543attrId attr =
1544 case attr of
1545 Testable.LabeledTest details ->
1546 details.id
1548 Testable.AttrTest details ->
1549 details.id
1551 _ ->
1552 Testable.NoId
1555skipOverridden ls =
1556 List.foldr
1557 (\attr ( found, caught ) ->
1558 let
1559 ( skip, has ) =
1560 case attrId attr of
1561 Testable.NoId ->
1562 ( False, found )
1564 Testable.IsWidth ->
1565 ( found.hasWidth
1566 , { hasWidth = True
1567 , hasHeight = found.hasHeight
1571 Testable.IsHeight ->
1572 ( found.hasHeight
1573 , { hasWidth = found.hasWidth
1574 , hasHeight = True
1577 in
1578 ( has
1579 , if skip then
1580 caught
1582 else
1583 attr :: caught
1586 ( { hasWidth = False
1587 , hasHeight = False
1589 , []
1591 ls
1592 |> Tuple.second
1593 |> List.reverse
1596{-| This is taking a normal test and rmoving its ability to attach a real `Element` attribute.
1598implicitTest attr =
1599 case attr of
1600 Testable.LabeledTest details ->
1601 Testable.AttrTest
1602 { test = details.test
1603 , label = "Implicit -> " ++ details.label
1604 , id = details.id
1607 otherwise ->
1608 otherwise