git.iko.soy/typeable/elm-ui
on 2c582df help sign in
typeable/elm-ui/tests-rendering/src/Testable/Element.elm
1602 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 , 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 List.concat
406 [ case context.parentLayout of
407 Testable.IsNearby _ ->
408 [ Testable.true "Nearby Element has fill width"
409 ((floor context.parent.bbox.width == floor context.self.bbox.width)
410 || minMaxTest (floor context.self.bbox.width)
411 )
412 ]
414 Testable.InColumn ->
415 [ Testable.true "Element within column has fill width"
416 ((floor parentAvailableWidth == floor context.self.bbox.width)
417 || minMaxTest (floor context.self.bbox.width)
418 )
419 ]
421 Testable.InEl ->
422 [ Testable.true "Element within element has fill width" <|
423 (floor parentAvailableWidth == floor context.self.bbox.width)
424 || minMaxTest (floor context.self.bbox.width)
425 ]
427 _ ->
428 let
429 spacePerPortion =
430 parentAvailableWidth / toFloat (List.length context.siblings + 1)
431 in
432 [ Testable.true "element has fill width" <|
433 (floor spacePerPortion == floor context.self.bbox.width)
434 || minMaxTest (floor context.self.bbox.width)
435 ]
436 , [ Testable.lessThanOrEqual "not larger than parent"
437 context.self.bbox.width
438 context.parent.bbox.width
439 ]
440 , case context.selfElement of
441 Testable.Paragraph _ _ ->
442 -- A paragraph with width fill
443 -- we want to test for correct text wrapping here.
444 --
445 let
446 childWidth child =
447 child.bbox.width
449 totalChildren =
450 context.children
451 |> List.map childWidth
452 |> List.append (List.map .width context.self.textMetrics)
453 |> List.sum
455 horizontalPadding =
456 context.self.bbox.padding.left + context.self.bbox.padding.right
458 totalCalculatedWidth =
459 totalChildren + horizontalPadding
461 expectedLines =
462 ceiling (totalCalculatedWidth / context.self.bbox.width)
463 in
464 [ Testable.rounded "text wrapping, checking height"
465 { expected = toFloat (expectedLines * 22)
466 , found = context.self.bbox.height
467 }
468 ]
470 _ ->
471 []
472 ]
473 }
475 Shrink ->
476 Testable.LabeledTest
477 { label = "width shrink" ++ minLabel ++ maxLabel
478 , attr =
479 Element.width
480 (Element.shrink
481 |> addMin
482 |> addMax
483 )
484 , id = Testable.IsWidth
485 , test =
486 \context ->
487 case context.selfElement of
488 Testable.El _ _ ->
489 let
490 childWidth child =
491 child.bbox.width
493 totalChildren =
494 context.children
495 |> List.map childWidth
496 |> List.append (List.map .width context.self.textMetrics)
497 |> List.sum
499 horizontalPadding =
500 context.self.bbox.padding.left + context.self.bbox.padding.right
502 _ =
503 Debug.log "widths"
504 { children =
505 context.children
506 |> List.map childWidth
507 , text = List.map .width context.self.textMetrics
508 }
509 in
510 [ Testable.rounded "equals children"
511 { expected = totalChildren + horizontalPadding
512 , found = context.self.bbox.width
513 }
514 , Testable.lessThanOrEqual "not larger than parent"
515 context.self.bbox.width
516 context.parent.bbox.width
517 ]
519 Testable.Row rowAttrs _ ->
520 -- width of row is the sum of all children widths
521 -- both text elements and others.
522 let
523 childWidth child =
524 child.bbox.width
526 totalChildren =
527 context.children
528 |> List.map childWidth
529 |> List.append (List.map .width context.self.textMetrics)
530 |> List.sum
532 horizontalPadding =
533 context.self.bbox.padding.left + context.self.bbox.padding.right
535 spacingAmount =
536 Testable.getSpacingFromAttributes rowAttrs
538 totalSpacing =
539 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
540 in
541 [ expectRoundedEquality
542 { expected = totalChildren + horizontalPadding + totalSpacing
543 , found = context.self.bbox.width
544 }
545 , Testable.lessThanOrEqual "not larger than parent"
546 context.self.bbox.width
547 context.parent.bbox.width
548 ]
550 Testable.Column _ _ ->
551 -- The width of the column is the width of the widest child.
552 let
553 childWidth child =
554 child.bbox.width
555 + context.self.bbox.padding.left
556 + context.self.bbox.padding.right
558 textChildren =
559 List.map
560 (\txt ->
561 txt.width
562 + context.self.bbox.padding.left
563 + context.self.bbox.padding.right
564 )
565 context.self.textMetrics
567 allChildren =
568 context.children
569 |> List.map childWidth
570 |> List.append textChildren
571 in
572 [ expectRoundedEquality
573 { expected = Maybe.withDefault 0 (List.maximum allChildren)
574 , found = context.self.bbox.width
575 }
576 , Testable.lessThanOrEqual "not larger than parent"
577 context.self.bbox.width
578 context.parent.bbox.width
579 ]
581 Testable.TextColumn _ _ ->
582 -- The width of the column is the width of the widest child.
583 let
584 childWidth child =
585 child.bbox.width
586 + context.self.bbox.padding.left
587 + context.self.bbox.padding.right
589 textChildren =
590 List.map
591 (\txt ->
592 txt.width
593 + context.self.bbox.padding.left
594 + context.self.bbox.padding.right
595 )
596 context.self.textMetrics
598 allChildren =
599 context.children
600 |> List.map childWidth
601 |> List.append textChildren
602 in
603 [ expectRoundedEquality
604 { expected = Maybe.withDefault 0 (List.maximum allChildren)
605 , found = context.self.bbox.width
606 }
607 , Testable.lessThanOrEqual "not larger than parent"
608 context.self.bbox.width
609 context.parent.bbox.width
610 ]
612 Testable.Paragraph _ _ ->
613 -- This should be the size it's text,
614 -- unless it takes up all available space, in which case it should wrap.
615 let
616 childWidth child =
617 child.bbox.width
619 totalChildren =
620 context.children
621 |> List.map childWidth
622 |> List.append (List.map .width context.self.textMetrics)
623 |> List.sum
625 horizontalPadding =
626 context.self.bbox.padding.left + context.self.bbox.padding.right
627 in
628 [ expectRoundedEquality
629 { expected = totalChildren + horizontalPadding
630 , found = context.self.bbox.width
631 }
632 , Testable.lessThanOrEqual "not larger than parent"
633 context.self.bbox.width
634 context.parent.bbox.width
635 ]
637 Testable.Text _ ->
638 []
640 Testable.Empty ->
641 []
642 }
645heightHelper maybeMin maybeMax len =
646 let
647 addMin l =
648 case maybeMin of
649 Nothing ->
650 l
652 Just minPx ->
653 l |> Element.minimum minPx
655 addMax l =
656 case maybeMax of
657 Nothing ->
658 l
660 Just maxPx ->
661 l |> Element.maximum maxPx
663 minLabel =
664 case maybeMin of
665 Nothing ->
666 ""
668 Just i ->
669 " min:" ++ String.fromInt i
671 maxLabel =
672 case maybeMax of
673 Nothing ->
674 ""
676 Just i ->
677 " max:" ++ String.fromInt i
679 minMaxTest actualheight =
680 case ( maybeMin, maybeMax ) of
681 ( Nothing, Nothing ) ->
682 True
684 ( Just lower, Nothing ) ->
685 lower <= actualheight
687 ( Just lower, Just higher ) ->
688 lower <= actualheight && actualheight <= higher
690 ( Nothing, Just higher ) ->
691 actualheight <= higher
692 in
693 case len of
694 Minimum m newLen ->
695 heightHelper (Just m) maybeMax newLen
697 Maximum m newLen ->
698 heightHelper maybeMin (Just m) newLen
700 Px val ->
701 -- Pixel values should ignore min and max?
702 Testable.LabeledTest
703 { label = "height " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
704 , attr =
705 Element.height
706 (Element.px val
707 |> addMin
708 |> addMax
709 )
710 , id = Testable.IsHeight
711 , test =
712 \found ->
713 [ expectRoundedEquality
714 { expected = toFloat val
715 , found = found.self.bbox.height
716 }
717 , Testable.true "min/max holds true"
718 (minMaxTest (floor found.self.bbox.height))
719 ]
720 }
722 Fill portion ->
723 Testable.LabeledTest
724 { label = "height fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
725 , attr =
726 Element.height
727 (Element.fillPortion portion
728 |> addMin
729 |> addMax
730 )
731 , id = Testable.IsHeight
732 , test =
733 \context ->
734 [ if List.member context.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
735 Testable.true "height fill doesn't apply to above/below elements" True
737 else
738 let
739 parentAvailableHeight =
740 context.parent.bbox.height - (context.self.bbox.padding.top + context.self.bbox.padding.bottom)
741 in
742 case context.parentLayout of
743 Testable.IsNearby _ ->
744 Testable.true "Nearby Element has fill height"
745 ((floor context.parent.bbox.height == floor context.self.bbox.height)
746 || minMaxTest (floor context.self.bbox.height)
747 )
749 Testable.InColumn ->
750 Testable.true "Element within column has fill height"
751 ((floor parentAvailableHeight == floor context.self.bbox.height)
752 || minMaxTest (floor context.self.bbox.height)
753 )
755 Testable.InEl ->
756 Testable.true "Element within el has fill height" <|
757 (floor parentAvailableHeight == floor context.self.bbox.height)
758 || minMaxTest (floor context.self.bbox.height)
760 _ ->
761 let
762 spacePerPortion =
763 parentAvailableHeight / toFloat (List.length context.siblings + 1)
764 in
765 Testable.true "el has fill height" <|
766 (floor spacePerPortion == floor context.self.bbox.height)
767 || minMaxTest (floor context.self.bbox.height)
768 ]
769 }
771 Shrink ->
772 Testable.LabeledTest
773 { label = "height shrink" ++ minLabel ++ maxLabel
774 , attr =
775 Element.height
776 (Element.shrink
777 |> addMin
778 |> addMax
779 )
780 , id = Testable.IsHeight
781 , test =
782 \context ->
783 case context.selfElement of
784 Testable.El _ _ ->
785 let
786 childHeight child =
787 child.bbox.height
788 in
789 [ if List.isEmpty context.children then
790 -- context.self.textMetrics
791 -- |> List.map Testable.textHeight
792 -- |> List.sum
793 -- TODO: apparently the font metrics we have are for the literal characters rendered
794 -- not for the font itself.
795 -- so for now, we are stubbing this in as 20, which is the default font size + line height.
796 Testable.rounded "expected multiple of 20"
797 { expected = context.self.bbox.height
798 , found = toFloat (List.length context.self.textMetrics * 20)
799 }
801 else
802 expectRoundedEquality
803 { expected =
804 context.children
805 |> List.map childHeight
806 |> List.sum
807 |> (\h -> h + context.self.bbox.padding.top + context.self.bbox.padding.bottom)
808 , found = context.self.bbox.height
809 }
810 , Testable.lessThanOrEqual "not larger than parent"
811 context.self.bbox.height
812 context.parent.bbox.height
813 ]
815 Testable.Row _ _ ->
816 let
817 childHeight child =
818 child.bbox.height
819 in
820 [ if List.isEmpty context.children then
821 -- context.self.textMetrics
822 -- |> List.map Testable.textHeight
823 -- |> List.sum
824 -- TODO: apparently the font metrics we have are for the literal characters rendered
825 -- not for the font itself.
826 -- so for now, we are stubbing this in as 20, which is the default font size.
827 Testable.true "expected multiple of 20"
828 ((round context.self.bbox.height |> modBy 20) == 0)
830 else
831 expectRoundedEquality
832 { expected =
833 context.children
834 |> List.map childHeight
835 |> List.maximum
836 |> Maybe.withDefault 0
837 |> (\h -> h + context.self.bbox.padding.top + context.self.bbox.padding.bottom)
838 , found = context.self.bbox.height
839 }
840 , Testable.lessThanOrEqual "not larger than parent"
841 context.self.bbox.height
842 context.parent.bbox.height
843 ]
845 Testable.Column colAttrs _ ->
846 let
847 childHeight child =
848 child.bbox.height
850 totalChildren =
851 context.children
852 |> List.map childHeight
853 |> List.append (List.map Testable.textHeight context.self.textMetrics)
854 |> List.sum
856 verticalPadding =
857 context.self.bbox.padding.top + context.self.bbox.padding.bottom
859 spacingAmount =
860 Testable.getSpacingFromAttributes colAttrs
862 totalSpacing =
863 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
864 in
865 [ expectRoundedEquality
866 { expected = totalChildren + verticalPadding + totalSpacing
867 , found = context.self.bbox.height
868 }
869 , Testable.lessThanOrEqual "not larger than parent"
870 context.self.bbox.height
871 context.parent.bbox.height
872 ]
874 Testable.TextColumn _ _ ->
875 [ Testable.lessThanOrEqual "not larger than parent"
876 context.self.bbox.height
877 context.parent.bbox.height
878 ]
880 Testable.Paragraph _ _ ->
881 [ Testable.lessThanOrEqual "not larger than parent"
882 context.self.bbox.height
883 context.parent.bbox.height
884 ]
886 Testable.Text _ ->
887 []
889 Testable.Empty ->
890 []
891 }
894width : Length -> Testable.Attr msg
895width len =
896 widthHelper Nothing Nothing len
899height : Length -> Testable.Attr msg
900height len =
901 heightHelper Nothing Nothing len
904spacing : Int -> Testable.Attr msg
905spacing space =
906 Testable.Batch
907 [ Testable.Spacing space
908 , Testable.LabeledTest
909 { label = "spacing: " ++ String.fromInt space
910 , attr = Element.spacing space
911 , id = Testable.NoId
912 , test =
913 \found ->
914 let
915 findDistance child total =
916 List.concatMap
917 (\otherChild ->
918 let
919 horizontal =
920 round <|
921 child.bbox.left
922 - otherChild.bbox.right
924 vertical =
925 round <|
926 child.bbox.top
927 - otherChild.bbox.bottom
928 in
929 [ if horizontal > 0 then
930 horizontal
932 else
933 space
934 , if vertical > 0 then
935 vertical
937 else
938 space
939 ]
940 )
941 found.children
942 ++ total
944 distances =
945 List.foldl findDistance [] found.children
947 allAreSpaced =
948 List.foldl
949 (\x wrong ->
950 if not (x >= space) then
951 x :: wrong
953 else
954 wrong
955 )
956 []
957 distances
958 in
959 [ Testable.true
960 ("All children are at least "
961 ++ String.fromInt space
962 ++ " pixels apart."
963 ++ Debug.toString allAreSpaced
964 ++ " are not though"
965 )
966 (allAreSpaced == [])
967 ]
968 }
969 ]
972{-| alignLeft needs to account for
974 - parent padding
975 - elements to the left
976 - spacing value
978in order to calculate the expected result.
980Also need parent rendering context if this is to work with wrapped rows in the future.
982All sibling elements
984-}
985alignLeft : Testable.Attr msg
986alignLeft =
987 Testable.LabeledTest
988 { label = "alignLeft"
989 , attr = Element.alignLeft
990 , id = Testable.NoId
991 , test =
992 \found ->
993 [ if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
994 Testable.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
996 else if
997 List.member found.parentLayout
998 [ Testable.IsNearby Testable.InFront
999 , Testable.IsNearby Testable.Behind
1000 , Testable.IsNearby Testable.Above
1001 , Testable.IsNearby Testable.Below
1003 then
1004 expectRoundedEquality
1005 { found = found.self.bbox.left
1006 , expected = found.parent.bbox.left
1009 else if List.length found.siblings == 0 then
1010 expectRoundedEquality
1011 { found = found.self.bbox.left
1012 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
1015 else
1016 case found.parentLayout of
1017 Testable.InRow ->
1018 let
1019 siblingsOnLeft =
1020 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
1022 spacings =
1023 toFloat (List.length siblingsOnLeft * found.parentSpacing)
1025 widthsOnLeft =
1026 siblingsOnLeft
1027 |> List.map (.width << .bbox)
1028 |> List.sum
1029 in
1030 expectRoundedEquality
1031 { found = found.self.bbox.left
1032 , expected = found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings)
1035 _ ->
1036 expectRoundedEquality
1037 { found = found.self.bbox.left
1038 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
1044{-| -}
1045centerX : Testable.Attr msg
1046centerX =
1047 Testable.LabeledTest
1048 { label = "centerX"
1049 , attr = Element.centerX
1050 , id = Testable.NoId
1051 , test =
1052 \found ->
1053 let
1054 selfCenter : Float
1055 selfCenter =
1056 found.self.bbox.left + (found.self.bbox.width / 2)
1058 parentCenter : Float
1059 parentCenter =
1060 found.parent.bbox.left + (found.parent.bbox.width / 2)
1061 in
1062 if List.member found.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
1063 [ Testable.true "centerX doesn't apply to elements that are onLeft or onRight" True ]
1065 else if List.length found.siblings == 0 then
1066 [ expectRoundedEquality
1067 { found = selfCenter
1068 , expected = parentCenter
1072 else
1073 case found.parentLayout of
1074 Testable.InRow ->
1075 let
1076 siblingsOnLeft =
1077 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
1079 siblingsOnRight =
1080 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1082 widthsOnLeft : Float
1083 widthsOnLeft =
1084 siblingsOnLeft
1085 |> List.map (.width << .bbox)
1086 |> List.sum
1087 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
1089 widthsOnRight =
1090 siblingsOnRight
1091 |> List.map (.width << .bbox)
1092 |> List.sum
1093 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
1095 expectedCenter : Float
1096 expectedCenter =
1097 found.parent.bbox.left
1098 + widthsOnLeft
1099 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
1100 / 2
1102 in
1103 [ expectRoundedEquality
1104 { found = selfCenter
1105 , expected = expectedCenter
1109 _ ->
1110 [ expectRoundedEquality
1111 { found = selfCenter
1112 , expected = parentCenter
1118{-| -}
1119alignRight : Testable.Attr msg
1120alignRight =
1121 Testable.LabeledTest
1122 { label = "alignRight"
1123 , attr = Element.alignRight
1124 , id = Testable.NoId
1125 , test =
1126 \found ->
1127 if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
1128 [ Testable.true "alignRight doesn't apply to elements that are onLeft or onRight" True ]
1130 else if
1131 List.member found.parentLayout
1132 [ Testable.IsNearby Testable.InFront
1133 , Testable.IsNearby Testable.Behind
1134 , Testable.IsNearby Testable.Above
1135 , Testable.IsNearby Testable.Below
1137 then
1138 [ expectRoundedEquality
1139 { found = found.self.bbox.right
1140 , expected = found.parent.bbox.right
1144 else if List.length found.siblings == 0 then
1145 [ expectRoundedEquality
1146 { found = found.self.bbox.right
1147 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1151 else
1152 case found.parentLayout of
1153 Testable.InRow ->
1154 let
1155 siblingsOnRight =
1156 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1158 spacings =
1159 toFloat (List.length siblingsOnRight * found.parentSpacing)
1161 widthsOnRight =
1162 siblingsOnRight
1163 |> List.map (.width << .bbox)
1164 |> List.sum
1165 in
1166 [ expectRoundedEquality
1167 { found = found.self.bbox.right
1168 , expected = found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings)
1172 _ ->
1173 [ expectRoundedEquality
1174 { found = found.self.bbox.right
1175 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1181{-| -}
1182alignTop : Testable.Attr msg
1183alignTop =
1184 Testable.LabeledTest
1185 { label = "alignTop"
1186 , attr = Element.alignTop
1187 , id = Testable.NoId
1188 , test =
1189 \found ->
1190 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1191 [ Testable.true "alignTop doesn't apply to elements that are above or below" True ]
1193 else if
1194 List.member found.parentLayout
1195 [ Testable.IsNearby Testable.InFront
1196 , Testable.IsNearby Testable.Behind
1197 , Testable.IsNearby Testable.OnRight
1198 , Testable.IsNearby Testable.OnLeft
1200 then
1201 [ expectRoundedEquality
1202 { found = found.self.bbox.top
1203 , expected = found.parent.bbox.top
1207 else if List.length found.siblings == 0 then
1208 [ expectRoundedEquality
1209 { found = found.self.bbox.top
1210 , expected = found.parent.bbox.top + found.parent.bbox.padding.top
1214 else
1215 case found.parentLayout of
1216 Testable.InColumn ->
1217 let
1218 siblingsAbove =
1219 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1221 spacings =
1222 toFloat (List.length siblingsAbove * found.parentSpacing)
1224 heightsAbove =
1225 siblingsAbove
1226 |> List.map (.height << .bbox)
1227 |> List.sum
1228 in
1229 [ expectRoundedEquality
1230 { found = found.self.bbox.top
1231 , expected = found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings)
1235 _ ->
1236 [ expectRoundedEquality
1237 { found = found.self.bbox.top
1238 , expected = found.parent.bbox.top
1244{-| -}
1245alignBottom : Testable.Attr msg
1246alignBottom =
1247 Testable.LabeledTest
1248 { label = "alignBottom"
1249 , attr = Element.alignBottom
1250 , id = Testable.NoId
1251 , test =
1252 \found ->
1253 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1254 [ Testable.true "alignBottom doesn't apply to elements that are above or below" True ]
1256 else if
1257 List.member found.parentLayout
1258 [ Testable.IsNearby Testable.InFront
1259 , Testable.IsNearby Testable.Behind
1260 , Testable.IsNearby Testable.OnRight
1261 , Testable.IsNearby Testable.OnLeft
1263 then
1264 [ expectRoundedEquality
1265 { found = found.self.bbox.bottom
1266 , expected = found.parent.bbox.bottom
1270 else if List.length found.siblings == 0 then
1271 [ expectRoundedEquality
1272 { found = found.self.bbox.bottom
1273 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1277 else
1278 case found.parentLayout of
1279 Testable.InColumn ->
1280 let
1281 siblingsBelow =
1282 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1284 spacings =
1285 toFloat (List.length siblingsBelow * found.parentSpacing)
1287 heightsBelow =
1288 siblingsBelow
1289 |> List.map (.height << .bbox)
1290 |> List.sum
1291 in
1292 [ expectRoundedEquality
1293 { found = found.self.bbox.bottom
1294 , expected = found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings)
1298 _ ->
1299 [ expectRoundedEquality
1300 { found = found.self.bbox.bottom
1301 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1307expectRoundedEquality : { expected : Float, found : Float } -> Testable.LayoutExpectation
1308expectRoundedEquality { expected, found } =
1309 Testable.true
1310 ("expected " ++ floatToString expected ++ ", found " ++ floatToString found)
1311 (abs (expected - found) < 1)
1314floatToString : Float -> String
1315floatToString x =
1316 String.fromFloat (toFloat (round (x * 100)) / 100)
1319{-| -}
1320centerY : Testable.Attr msg
1321centerY =
1322 Testable.LabeledTest
1323 { label = "centerY"
1324 , attr = Element.centerY
1325 , id = Testable.NoId
1326 , test =
1327 \found ->
1328 let
1329 selfCenter =
1330 found.self.bbox.top + (found.self.bbox.height / 2)
1332 parentCenter =
1333 found.parent.bbox.top + (found.parent.bbox.height / 2)
1334 in
1335 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1336 [ Testable.true "centerY doesn't apply to elements that are above or below" True ]
1338 else if List.length found.siblings == 0 then
1339 [ expectRoundedEquality
1340 { found = selfCenter
1341 , expected = parentCenter
1345 else
1346 case found.parentLayout of
1347 Testable.InColumn ->
1348 let
1349 siblingsOnTop =
1350 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1352 siblingsBelow =
1353 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1355 heightsAbove : Float
1356 heightsAbove =
1357 siblingsOnTop
1358 |> List.map (.height << .bbox)
1359 |> List.sum
1360 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1362 heightsBelow =
1363 siblingsBelow
1364 |> List.map (.height << .bbox)
1365 |> List.sum
1366 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1368 expectedCenter : Float
1369 expectedCenter =
1370 found.parent.bbox.top
1371 + heightsAbove
1372 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1373 / 2
1375 in
1376 [ expectRoundedEquality
1377 { found = selfCenter
1378 , expected = expectedCenter
1382 _ ->
1383 [ expectRoundedEquality
1384 { found = selfCenter
1385 , expected = parentCenter
1391{-| -}
1392above : Testable.Element msg -> Testable.Attr msg
1393above element =
1394 Testable.Nearby
1395 { location = Testable.Above
1396 , element = element
1397 , label = "above"
1398 , test =
1399 \found ->
1400 [ expectRoundedEquality
1401 { found = found.self.bbox.bottom
1402 , expected = found.parent.bbox.top
1408{-| -}
1409below : Testable.Element msg -> Testable.Attr msg
1410below element =
1411 Testable.Nearby
1412 { location = Testable.Below
1413 , element = element
1414 , label = "below"
1415 , test =
1416 \found ->
1417 [ expectRoundedEquality
1418 { found = found.self.bbox.top
1419 , expected = found.parent.bbox.bottom
1425{-| -}
1426onRight : Testable.Element msg -> Testable.Attr msg
1427onRight element =
1428 Testable.Nearby
1429 { location = Testable.OnRight
1430 , element = element
1431 , label = "onRight"
1432 , test =
1433 \found ->
1434 [ expectRoundedEquality
1435 { found = found.self.bbox.left
1436 , expected = found.parent.bbox.right
1442{-| -}
1443onLeft : Testable.Element msg -> Testable.Attr msg
1444onLeft element =
1445 Testable.Nearby
1446 { location = Testable.OnLeft
1447 , element = element
1448 , label = "onLeft"
1449 , test =
1450 \found ->
1451 [ expectRoundedEquality
1452 { found = found.self.bbox.right
1453 , expected = found.parent.bbox.left
1459compare x vs y =
1460 vs (round x) (round y) || vs (floor x) (floor y)
1463{-| -}
1464inFront : Testable.Element msg -> Testable.Attr msg
1465inFront element =
1466 Testable.Nearby
1467 { location = Testable.InFront
1468 , element = element
1469 , label = "inFront"
1470 , test =
1471 \found ->
1472 [ withinHelper found ]
1476withinHelper found =
1477 let
1478 horizontalCheck =
1479 if found.self.bbox.width > found.parent.bbox.width then
1480 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1481 || compare found.self.bbox.left (>=) found.parent.bbox.left
1484 else
1485 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1486 , compare found.self.bbox.left (>=) found.parent.bbox.left
1489 verticalCheck =
1490 if found.self.bbox.width > found.parent.bbox.width then
1491 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1492 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1495 else
1496 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1497 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1499 in
1500 Testable.true "within the confines of the parent"
1501 (List.all ((==) True)
1502 (List.concat
1503 [ horizontalCheck
1504 , verticalCheck
1510{-| -}
1511behindContent : Testable.Element msg -> Testable.Attr msg
1512behindContent element =
1513 Testable.Nearby
1514 { location = Testable.Behind
1515 , element = element
1516 , label = "behindContent"
1517 , test =
1518 \found ->
1519 [ withinHelper found ]
1524{- Implicit width/height calcualtions -}
1527implicitWidthHeightShrink attrs =
1528 let
1529 withImplicits =
1530 implicitTest (widthHelper Nothing Nothing Shrink)
1531 :: implicitTest (heightHelper Nothing Nothing Shrink)
1532 :: attrs
1533 in
1534 skipOverridden withImplicits
1537attrId attr =
1538 case attr of
1539 Testable.LabeledTest details ->
1540 details.id
1542 Testable.AttrTest details ->
1543 details.id
1545 _ ->
1546 Testable.NoId
1549skipOverridden ls =
1550 List.foldr
1551 (\attr ( found, caught ) ->
1552 let
1553 ( skip, has ) =
1554 case attrId attr of
1555 Testable.NoId ->
1556 ( False, found )
1558 Testable.IsWidth ->
1559 ( found.hasWidth
1560 , { hasWidth = True
1561 , hasHeight = found.hasHeight
1565 Testable.IsHeight ->
1566 ( found.hasHeight
1567 , { hasWidth = found.hasWidth
1568 , hasHeight = True
1571 in
1572 ( has
1573 , if skip then
1574 caught
1576 else
1577 attr :: caught
1580 ( { hasWidth = False
1581 , hasHeight = False
1583 , []
1585 ls
1586 |> Tuple.second
1587 |> List.reverse
1590{-| This is taking a normal test and rmoving its ability to attach a real `Element` attribute.
1592implicitTest attr =
1593 case attr of
1594 Testable.LabeledTest details ->
1595 Testable.AttrTest
1596 { test = details.test
1597 , label = "Implicit -> " ++ details.label
1598 , id = details.id
1601 otherwise ->
1602 otherwise