git.iko.soy/typeable/elm-ui
on d5c8a94 help sign in
typeable/elm-ui/tests-rendering/src/Testable/Element.elm
1639 lines 62 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 }
310listIf ls =
311 List.filter Tuple.first ls
312 |> List.map Tuple.second
315widthHelper maybeMin maybeMax len =
316 let
317 addMin l =
318 case maybeMin of
319 Nothing ->
320 l
322 Just minPx ->
323 l |> Element.minimum minPx
325 addMax l =
326 case maybeMax of
327 Nothing ->
328 l
330 Just maxPx ->
331 l |> Element.maximum maxPx
333 minLabel =
334 case maybeMin of
335 Nothing ->
336 ""
338 Just i ->
339 " min:" ++ String.fromInt i
341 maxLabel =
342 case maybeMax of
343 Nothing ->
344 ""
346 Just i ->
347 " max:" ++ String.fromInt i
349 minMaxTest actualWidth =
350 case ( maybeMin, maybeMax ) of
351 ( Nothing, Nothing ) ->
352 True
354 ( Just lower, Nothing ) ->
355 lower <= actualWidth
357 ( Just lower, Just higher ) ->
358 lower <= actualWidth && actualWidth <= higher
360 ( Nothing, Just higher ) ->
361 actualWidth <= higher
362 in
363 case len of
364 Minimum m newLen ->
365 widthHelper (Just m) maybeMax newLen
367 Maximum m newLen ->
368 widthHelper maybeMin (Just m) newLen
370 Px val ->
371 -- Pixel values should ignore min and max?
372 Testable.LabeledTest
373 { label = "width " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
374 , id = Testable.IsWidth
375 , attr =
376 Element.width
377 (Element.px val
378 |> addMin
379 |> addMax
380 )
381 , test =
382 \found ->
383 [ expectRoundedEquality
384 { expected = toFloat val
385 , found = found.self.bbox.width
386 }
387 , Testable.true "min/max is upheld" (minMaxTest (floor found.self.bbox.width))
388 ]
389 }
391 Fill portion ->
392 Testable.LabeledTest
393 { label =
394 if portion == 1 then
395 "width fill" ++ minLabel ++ maxLabel
397 else
398 "width fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
399 , id = Testable.IsWidth
400 , attr =
401 Element.width
402 (Element.fillPortion portion
403 |> addMin
404 |> addMax
405 )
406 , test =
407 \context ->
408 if List.member context.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
409 [ Testable.true "width fill doesn't apply to onright/onleft elements" True ]
411 else
412 let
413 parentAvailableWidth =
414 context.parent.bbox.width - (context.self.bbox.padding.left + context.self.bbox.padding.right)
415 in
416 List.concat
417 [ case context.parentLayout of
418 Testable.IsNearby _ ->
419 [ Testable.true "Nearby Element has fill width"
420 ((floor context.parent.bbox.width == floor context.self.bbox.width)
421 || minMaxTest (floor context.self.bbox.width)
422 )
423 ]
425 Testable.InColumn ->
426 [ Testable.true "Element within column has fill width"
427 ((floor parentAvailableWidth == floor context.self.bbox.width)
428 || minMaxTest (floor context.self.bbox.width)
429 )
430 ]
432 Testable.InEl ->
433 [ Testable.true "Element within element has fill width" <|
434 (floor parentAvailableWidth == floor context.self.bbox.width)
435 || minMaxTest (floor context.self.bbox.width)
436 ]
438 _ ->
439 let
440 spacePerPortion =
441 parentAvailableWidth / toFloat (List.length context.siblings + 1)
442 in
443 [ Testable.true "element has fill width" <|
444 (floor spacePerPortion == floor context.self.bbox.width)
445 || minMaxTest (floor context.self.bbox.width)
446 ]
447 , [ Testable.lessThanOrEqual "not larger than parent"
448 context.self.bbox.width
449 context.parent.bbox.width
450 ]
451 , case context.selfElement of
452 Testable.Paragraph _ _ ->
453 -- A paragraph with width fill
454 -- we want to test for correct text wrapping here.
455 --
456 let
457 childWidth child =
458 child.bbox.width
460 totalChildren =
461 context.children
462 |> List.map childWidth
463 |> List.append (List.map .width context.self.textMetrics)
464 |> List.sum
466 horizontalPadding =
467 context.self.bbox.padding.left + context.self.bbox.padding.right
469 totalCalculatedWidth =
470 totalChildren + horizontalPadding
472 expectedLines =
473 if boxChildrenHeight > 20 then
474 ceiling (boxChildrenHeight / 20)
476 else
477 ceiling (totalCalculatedWidth / context.self.bbox.width)
479 boxChildrenHeight =
480 context.children
481 |> List.map
482 (\c ->
483 c.bbox.height
484 )
485 |> List.sum
486 in
487 [ Testable.true "text wrapping, checking height"
488 -- all we're doing here is testing if wrapping is occurring
489 -- not the exact height, which is a little tricky to calculate perfectly without more information.
490 (if expectedLines > 1 then
491 context.self.bbox.height >= (20 * 2)
493 else
494 -- then it's less than 2 ~ line heights
495 -- there's some weird variance here which makes it hard to be exact.
496 context.self.bbox.height < (20 * 2)
497 )
498 ]
500 _ ->
501 []
502 ]
503 }
505 Shrink ->
506 Testable.LabeledTest
507 { label = "width shrink" ++ minLabel ++ maxLabel
508 , attr =
509 Element.width
510 (Element.shrink
511 |> addMin
512 |> addMax
513 )
514 , id = Testable.IsWidth
515 , test =
516 \context ->
517 case context.selfElement of
518 Testable.El _ _ ->
519 let
520 childWidth child =
521 child.bbox.width
523 totalChildren =
524 context.children
525 |> List.map childWidth
526 |> List.append (List.map .width context.self.textMetrics)
527 |> List.sum
529 horizontalPadding =
530 context.self.bbox.padding.left + context.self.bbox.padding.right
531 in
532 listIf
533 [ ( (context.parentLayout /= Testable.InParagraph)
534 && (context.parentLayout /= Testable.InTextCol)
535 , Testable.rounded "equals children"
536 { expected = totalChildren + horizontalPadding
537 , found = context.self.bbox.width
538 }
539 )
540 , ( context.parentLayout /= Testable.AtRoot
541 , Testable.lessThanOrEqual "not larger than parent"
542 context.self.bbox.width
543 context.parent.bbox.width
544 )
545 ]
547 Testable.Row rowAttrs _ ->
548 -- width of row is the sum of all children widths
549 -- both text elements and others.
550 let
551 childWidth child =
552 child.bbox.width
554 totalChildren =
555 context.children
556 |> List.map childWidth
557 |> List.append (List.map .width context.self.textMetrics)
558 |> List.sum
560 horizontalPadding =
561 context.self.bbox.padding.left + context.self.bbox.padding.right
563 spacingAmount =
564 Testable.getSpacingFromAttributes rowAttrs
566 totalSpacing =
567 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
568 in
569 listIf
570 [ ( True
571 , expectRoundedEquality
572 { expected = totalChildren + horizontalPadding + totalSpacing
573 , found = context.self.bbox.width
574 }
575 )
576 , ( context.parentLayout /= Testable.AtRoot
577 , Testable.lessThanOrEqual "not larger than parent"
578 context.self.bbox.width
579 context.parent.bbox.width
580 )
581 ]
583 Testable.Column _ _ ->
584 -- The width of the column is the width of the widest child.
585 let
586 childWidth child =
587 child.bbox.width
588 + context.self.bbox.padding.left
589 + context.self.bbox.padding.right
591 textChildren =
592 List.map
593 (\txt ->
594 txt.width
595 + context.self.bbox.padding.left
596 + context.self.bbox.padding.right
597 )
598 context.self.textMetrics
600 allChildren =
601 context.children
602 |> List.map childWidth
603 |> List.append textChildren
604 in
605 listIf
606 [ ( True
607 , expectRoundedEquality
608 { expected = Maybe.withDefault 0 (List.maximum allChildren)
609 , found = context.self.bbox.width
610 }
611 )
612 , ( context.parentLayout /= Testable.AtRoot
613 , Testable.lessThanOrEqual "not larger than parent"
614 context.self.bbox.width
615 context.parent.bbox.width
616 )
617 ]
619 Testable.TextColumn _ _ ->
620 -- The width of the column is the width of the widest child.
621 let
622 childWidth child =
623 child.bbox.width
624 + context.self.bbox.padding.left
625 + context.self.bbox.padding.right
627 textChildren =
628 List.map
629 (\txt ->
630 txt.width
631 + context.self.bbox.padding.left
632 + context.self.bbox.padding.right
633 )
634 context.self.textMetrics
636 allChildren =
637 context.children
638 |> List.map childWidth
639 |> List.append textChildren
640 in
641 listIf
642 [ ( True
643 , expectRoundedEquality
644 { expected = Maybe.withDefault 0 (List.maximum allChildren)
645 , found = context.self.bbox.width
646 }
647 )
648 , ( context.parentLayout /= Testable.AtRoot
649 , Testable.lessThanOrEqual "not larger than parent"
650 context.self.bbox.width
651 context.parent.bbox.width
652 )
653 ]
655 Testable.Paragraph _ _ ->
656 -- This should be the size it's text,
657 -- unless it takes up all available space, in which case it should wrap.
658 let
659 childWidth child =
660 child.bbox.width
662 totalChildren =
663 context.children
664 |> List.map childWidth
665 |> List.append (List.map .width context.self.textMetrics)
666 |> List.sum
668 horizontalPadding =
669 context.self.bbox.padding.left + context.self.bbox.padding.right
670 in
671 listIf
672 [ ( True
673 , expectRoundedEquality
674 { expected = totalChildren + horizontalPadding
675 , found = context.self.bbox.width
676 }
677 )
678 , ( context.parentLayout /= Testable.AtRoot
679 , Testable.lessThanOrEqual "not larger than parent"
680 context.self.bbox.width
681 context.parent.bbox.width
682 )
683 ]
685 Testable.Text _ ->
686 []
688 Testable.Empty ->
689 []
690 }
693heightHelper maybeMin maybeMax len =
694 let
695 addMin l =
696 case maybeMin of
697 Nothing ->
698 l
700 Just minPx ->
701 l |> Element.minimum minPx
703 addMax l =
704 case maybeMax of
705 Nothing ->
706 l
708 Just maxPx ->
709 l |> Element.maximum maxPx
711 minLabel =
712 case maybeMin of
713 Nothing ->
714 ""
716 Just i ->
717 " min:" ++ String.fromInt i
719 maxLabel =
720 case maybeMax of
721 Nothing ->
722 ""
724 Just i ->
725 " max:" ++ String.fromInt i
727 minMaxTest actualheight =
728 case ( maybeMin, maybeMax ) of
729 ( Nothing, Nothing ) ->
730 True
732 ( Just lower, Nothing ) ->
733 lower <= actualheight
735 ( Just lower, Just higher ) ->
736 lower <= actualheight && actualheight <= higher
738 ( Nothing, Just higher ) ->
739 actualheight <= higher
740 in
741 case len of
742 Minimum m newLen ->
743 heightHelper (Just m) maybeMax newLen
745 Maximum m newLen ->
746 heightHelper maybeMin (Just m) newLen
748 Px val ->
749 -- Pixel values should ignore min and max?
750 Testable.LabeledTest
751 { label = "height " ++ String.fromInt val ++ "px" ++ minLabel ++ maxLabel
752 , attr =
753 Element.height
754 (Element.px val
755 |> addMin
756 |> addMax
757 )
758 , id = Testable.IsHeight
759 , test =
760 \found ->
761 [ expectRoundedEquality
762 { expected = toFloat val
763 , found = found.self.bbox.height
764 }
765 , Testable.true "min/max holds true"
766 (minMaxTest (floor found.self.bbox.height))
767 ]
768 }
770 Fill portion ->
771 Testable.LabeledTest
772 { label = "height fill-" ++ String.fromInt portion ++ minLabel ++ maxLabel
773 , attr =
774 Element.height
775 (Element.fillPortion portion
776 |> addMin
777 |> addMax
778 )
779 , id = Testable.IsHeight
780 , test =
781 \context ->
782 [ if List.member context.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
783 Testable.true "height fill doesn't apply to above/below elements" True
785 else
786 let
787 parentAvailableHeight =
788 context.parent.bbox.height - (context.self.bbox.padding.top + context.self.bbox.padding.bottom)
789 in
790 case context.parentLayout of
791 Testable.IsNearby _ ->
792 Testable.true "Nearby Element has fill height"
793 ((floor context.parent.bbox.height == floor context.self.bbox.height)
794 || minMaxTest (floor context.self.bbox.height)
795 )
797 Testable.InColumn ->
798 Testable.true "Element within column has fill height"
799 ((floor parentAvailableHeight == floor context.self.bbox.height)
800 || minMaxTest (floor context.self.bbox.height)
801 )
803 Testable.InEl ->
804 Testable.true "Element within el has fill height" <|
805 (floor parentAvailableHeight == floor context.self.bbox.height)
806 || minMaxTest (floor context.self.bbox.height)
808 _ ->
809 let
810 spacePerPortion =
811 parentAvailableHeight / toFloat (List.length context.siblings + 1)
812 in
813 Testable.true "el has fill height" <|
814 (floor spacePerPortion == floor context.self.bbox.height)
815 || minMaxTest (floor context.self.bbox.height)
816 ]
817 }
819 Shrink ->
820 Testable.LabeledTest
821 { label = "height shrink" ++ minLabel ++ maxLabel
822 , attr =
823 Element.height
824 (Element.shrink
825 |> addMin
826 |> addMax
827 )
828 , id = Testable.IsHeight
829 , test =
830 \context ->
831 case context.selfElement of
832 Testable.El _ _ ->
833 let
834 childHeight child =
835 child.bbox.height
836 in
837 if List.isEmpty context.children then
838 -- context.self.textMetrics
839 -- |> List.map Testable.textHeight
840 -- |> List.sum
841 -- TODO: apparently the font metrics we have are for the literal characters rendered
842 -- not for the font itself.
843 [ Testable.todo "calculate height from actual text metrics"
844 ]
846 else
847 [ expectRoundedEquality
848 { expected =
849 context.children
850 |> List.map childHeight
851 |> List.sum
852 |> (\h -> h + context.self.bbox.padding.top + context.self.bbox.padding.bottom)
853 , found = context.self.bbox.height
854 }
855 , Testable.lessThanOrEqual "not larger than parent"
856 context.self.bbox.height
857 context.parent.bbox.height
858 ]
860 Testable.Row _ _ ->
861 let
862 childHeight child =
863 child.bbox.height
864 in
865 if List.isEmpty context.children then
866 -- context.self.textMetrics
867 -- |> List.map Testable.textHeight
868 -- |> List.sum
869 -- TODO: apparently the font metrics we have are for the literal characters rendered
870 -- not for the font itself.
871 [ Testable.todo "calculate height from actual text metrics" ]
873 else
874 [ expectRoundedEquality
875 { expected =
876 context.children
877 |> List.map childHeight
878 |> List.maximum
879 |> Maybe.withDefault 0
880 |> (\h -> h + context.self.bbox.padding.top + context.self.bbox.padding.bottom)
881 , found = context.self.bbox.height
882 }
883 , Testable.lessThanOrEqual "not larger than parent"
884 context.self.bbox.height
885 context.parent.bbox.height
886 ]
888 Testable.Column colAttrs _ ->
889 let
890 childHeight child =
891 child.bbox.height
893 totalChildren =
894 context.children
895 |> List.map childHeight
896 |> List.append (List.map Testable.textHeight context.self.textMetrics)
897 |> List.sum
899 verticalPadding =
900 context.self.bbox.padding.top + context.self.bbox.padding.bottom
902 spacingAmount =
903 Testable.getSpacingFromAttributes colAttrs
905 totalSpacing =
906 toFloat spacingAmount * (toFloat (List.length context.children) - 1)
907 in
908 [ expectRoundedEquality
909 { expected = totalChildren + verticalPadding + totalSpacing
910 , found = context.self.bbox.height
911 }
912 , Testable.lessThanOrEqual "not larger than parent"
913 context.self.bbox.height
914 context.parent.bbox.height
915 ]
917 Testable.TextColumn _ _ ->
918 []
920 Testable.Paragraph _ _ ->
921 []
923 Testable.Text _ ->
924 []
926 Testable.Empty ->
927 []
928 }
931width : Length -> Testable.Attr msg
932width len =
933 widthHelper Nothing Nothing len
936height : Length -> Testable.Attr msg
937height len =
938 heightHelper Nothing Nothing len
941spacing : Int -> Testable.Attr msg
942spacing space =
943 Testable.Batch
944 [ Testable.Spacing space
945 , Testable.LabeledTest
946 { label = "spacing: " ++ String.fromInt space
947 , attr = Element.spacing space
948 , id = Testable.NoId
949 , test =
950 \found ->
951 let
952 findDistance child total =
953 List.concatMap
954 (\otherChild ->
955 let
956 horizontal =
957 round <|
958 child.bbox.left
959 - otherChild.bbox.right
961 vertical =
962 round <|
963 child.bbox.top
964 - otherChild.bbox.bottom
965 in
966 [ if horizontal > 0 then
967 horizontal
969 else
970 space
971 , if vertical > 0 then
972 vertical
974 else
975 space
976 ]
977 )
978 found.children
979 ++ total
981 distances =
982 List.foldl findDistance [] found.children
984 allAreSpaced =
985 List.foldl
986 (\x wrong ->
987 if not (x >= space) then
988 x :: wrong
990 else
991 wrong
992 )
993 []
994 distances
995 in
996 [ Testable.true
997 ("All children are at least "
998 ++ String.fromInt space
999 ++ " pixels apart."
1000 ++ Debug.toString allAreSpaced
1001 ++ " are not though"
1003 (allAreSpaced == [])
1009{-| alignLeft needs to account for
1011 - parent padding
1012 - elements to the left
1013 - spacing value
1015in order to calculate the expected result.
1017Also need parent rendering context if this is to work with wrapped rows in the future.
1019All sibling elements
1022alignLeft : Testable.Attr msg
1023alignLeft =
1024 Testable.LabeledTest
1025 { label = "alignLeft"
1026 , attr = Element.alignLeft
1027 , id = Testable.NoId
1028 , test =
1029 \found ->
1030 [ if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
1031 Testable.true "alignLeft doesn't apply to elements that are onLeft or onRight" True
1033 else if
1034 List.member found.parentLayout
1035 [ Testable.IsNearby Testable.InFront
1036 , Testable.IsNearby Testable.Behind
1037 , Testable.IsNearby Testable.Above
1038 , Testable.IsNearby Testable.Below
1040 then
1041 expectRoundedEquality
1042 { found = found.self.bbox.left
1043 , expected = found.parent.bbox.left
1046 else if List.length found.siblings == 0 then
1047 expectRoundedEquality
1048 { found = found.self.bbox.left
1049 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
1052 else
1053 case found.parentLayout of
1054 Testable.InRow ->
1055 let
1056 siblingsOnLeft =
1057 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
1059 spacings =
1060 toFloat (List.length siblingsOnLeft * found.parentSpacing)
1062 widthsOnLeft =
1063 siblingsOnLeft
1064 |> List.map (.width << .bbox)
1065 |> List.sum
1066 in
1067 expectRoundedEquality
1068 { found = found.self.bbox.left
1069 , expected = found.parent.bbox.left + (found.parent.bbox.padding.left + widthsOnLeft + spacings)
1072 _ ->
1073 expectRoundedEquality
1074 { found = found.self.bbox.left
1075 , expected = found.parent.bbox.left + found.parent.bbox.padding.left
1081{-| -}
1082centerX : Testable.Attr msg
1083centerX =
1084 Testable.LabeledTest
1085 { label = "centerX"
1086 , attr = Element.centerX
1087 , id = Testable.NoId
1088 , test =
1089 \found ->
1090 let
1091 selfCenter : Float
1092 selfCenter =
1093 found.self.bbox.left + (found.self.bbox.width / 2)
1095 parentCenter : Float
1096 parentCenter =
1097 found.parent.bbox.left + (found.parent.bbox.width / 2)
1098 in
1099 if List.member found.parentLayout [ Testable.IsNearby Testable.OnRight, Testable.IsNearby Testable.OnLeft ] then
1100 [ Testable.true "centerX doesn't apply to elements that are onLeft or onRight" True ]
1102 else if List.length found.siblings == 0 then
1103 [ expectRoundedEquality
1104 { found = selfCenter
1105 , expected = parentCenter
1109 else
1110 case found.parentLayout of
1111 Testable.InRow ->
1112 let
1113 siblingsOnLeft =
1114 List.filter (\x -> x.bbox.right < found.self.bbox.left) found.siblings
1116 siblingsOnRight =
1117 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1119 widthsOnLeft : Float
1120 widthsOnLeft =
1121 siblingsOnLeft
1122 |> List.map (.width << .bbox)
1123 |> List.sum
1124 |> (\x -> x + (toFloat (List.length siblingsOnLeft) * toFloat found.parentSpacing))
1126 widthsOnRight =
1127 siblingsOnRight
1128 |> List.map (.width << .bbox)
1129 |> List.sum
1130 |> (\x -> x + (toFloat (List.length siblingsOnRight) * toFloat found.parentSpacing))
1132 expectedCenter : Float
1133 expectedCenter =
1134 found.parent.bbox.left
1135 + widthsOnLeft
1136 + ((found.parent.bbox.width - (widthsOnRight + widthsOnLeft))
1137 / 2
1139 in
1140 [ expectRoundedEquality
1141 { found = selfCenter
1142 , expected = expectedCenter
1146 _ ->
1147 [ expectRoundedEquality
1148 { found = selfCenter
1149 , expected = parentCenter
1155{-| -}
1156alignRight : Testable.Attr msg
1157alignRight =
1158 Testable.LabeledTest
1159 { label = "alignRight"
1160 , attr = Element.alignRight
1161 , id = Testable.NoId
1162 , test =
1163 \found ->
1164 if List.member found.parentLayout [ Testable.IsNearby Testable.OnLeft, Testable.IsNearby Testable.OnRight ] then
1165 [ Testable.true "alignRight doesn't apply to elements that are onLeft or onRight" True ]
1167 else if
1168 List.member found.parentLayout
1169 [ Testable.IsNearby Testable.InFront
1170 , Testable.IsNearby Testable.Behind
1171 , Testable.IsNearby Testable.Above
1172 , Testable.IsNearby Testable.Below
1174 then
1175 [ expectRoundedEquality
1176 { found = found.self.bbox.right
1177 , expected = found.parent.bbox.right
1181 else if List.length found.siblings == 0 then
1182 [ expectRoundedEquality
1183 { found = found.self.bbox.right
1184 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1188 else
1189 case found.parentLayout of
1190 Testable.InRow ->
1191 let
1192 siblingsOnRight =
1193 List.filter (\x -> x.bbox.left > found.self.bbox.right) found.siblings
1195 spacings =
1196 toFloat (List.length siblingsOnRight * found.parentSpacing)
1198 widthsOnRight =
1199 siblingsOnRight
1200 |> List.map (.width << .bbox)
1201 |> List.sum
1202 in
1203 [ expectRoundedEquality
1204 { found = found.self.bbox.right
1205 , expected = found.parent.bbox.right - (found.parent.bbox.padding.right + widthsOnRight + spacings)
1209 _ ->
1210 [ expectRoundedEquality
1211 { found = found.self.bbox.right
1212 , expected = found.parent.bbox.right + found.parent.bbox.padding.right
1218{-| -}
1219alignTop : Testable.Attr msg
1220alignTop =
1221 Testable.LabeledTest
1222 { label = "alignTop"
1223 , attr = Element.alignTop
1224 , id = Testable.NoId
1225 , test =
1226 \found ->
1227 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1228 [ Testable.true "alignTop doesn't apply to elements that are above or below" True ]
1230 else if
1231 List.member found.parentLayout
1232 [ Testable.IsNearby Testable.InFront
1233 , Testable.IsNearby Testable.Behind
1234 , Testable.IsNearby Testable.OnRight
1235 , Testable.IsNearby Testable.OnLeft
1237 then
1238 [ expectRoundedEquality
1239 { found = found.self.bbox.top
1240 , expected = found.parent.bbox.top
1244 else if List.length found.siblings == 0 then
1245 [ expectRoundedEquality
1246 { found = found.self.bbox.top
1247 , expected = found.parent.bbox.top + found.parent.bbox.padding.top
1251 else
1252 case found.parentLayout of
1253 Testable.InColumn ->
1254 let
1255 siblingsAbove =
1256 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1258 spacings =
1259 toFloat (List.length siblingsAbove * found.parentSpacing)
1261 heightsAbove =
1262 siblingsAbove
1263 |> List.map (.height << .bbox)
1264 |> List.sum
1265 in
1266 [ expectRoundedEquality
1267 { found = found.self.bbox.top
1268 , expected = found.parent.bbox.top + (found.parent.bbox.padding.top + heightsAbove + spacings)
1272 _ ->
1273 [ expectRoundedEquality
1274 { found = found.self.bbox.top
1275 , expected = found.parent.bbox.top
1281{-| -}
1282alignBottom : Testable.Attr msg
1283alignBottom =
1284 Testable.LabeledTest
1285 { label = "alignBottom"
1286 , attr = Element.alignBottom
1287 , id = Testable.NoId
1288 , test =
1289 \found ->
1290 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1291 [ Testable.true "alignBottom doesn't apply to elements that are above or below" True ]
1293 else if
1294 List.member found.parentLayout
1295 [ Testable.IsNearby Testable.InFront
1296 , Testable.IsNearby Testable.Behind
1297 , Testable.IsNearby Testable.OnRight
1298 , Testable.IsNearby Testable.OnLeft
1300 then
1301 [ expectRoundedEquality
1302 { found = found.self.bbox.bottom
1303 , expected = found.parent.bbox.bottom
1307 else if List.length found.siblings == 0 then
1308 [ expectRoundedEquality
1309 { found = found.self.bbox.bottom
1310 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1314 else
1315 case found.parentLayout of
1316 Testable.InColumn ->
1317 let
1318 siblingsBelow =
1319 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1321 spacings =
1322 toFloat (List.length siblingsBelow * found.parentSpacing)
1324 heightsBelow =
1325 siblingsBelow
1326 |> List.map (.height << .bbox)
1327 |> List.sum
1328 in
1329 [ expectRoundedEquality
1330 { found = found.self.bbox.bottom
1331 , expected = found.parent.bbox.bottom - (found.parent.bbox.padding.bottom + heightsBelow + spacings)
1335 _ ->
1336 [ expectRoundedEquality
1337 { found = found.self.bbox.bottom
1338 , expected = found.parent.bbox.bottom + found.parent.bbox.padding.bottom
1344expectRoundedEquality : { expected : Float, found : Float } -> Testable.LayoutExpectation
1345expectRoundedEquality { expected, found } =
1346 Testable.true
1347 ("expected " ++ floatToString expected ++ ", found " ++ floatToString found)
1348 (abs (expected - found) < 1)
1351floatToString : Float -> String
1352floatToString x =
1353 String.fromFloat (toFloat (round (x * 100)) / 100)
1356{-| -}
1357centerY : Testable.Attr msg
1358centerY =
1359 Testable.LabeledTest
1360 { label = "centerY"
1361 , attr = Element.centerY
1362 , id = Testable.NoId
1363 , test =
1364 \found ->
1365 let
1366 selfCenter =
1367 found.self.bbox.top + (found.self.bbox.height / 2)
1369 parentCenter =
1370 found.parent.bbox.top + (found.parent.bbox.height / 2)
1371 in
1372 if List.member found.parentLayout [ Testable.IsNearby Testable.Above, Testable.IsNearby Testable.Below ] then
1373 [ Testable.true "centerY doesn't apply to elements that are above or below" True ]
1375 else if List.length found.siblings == 0 then
1376 [ expectRoundedEquality
1377 { found = selfCenter
1378 , expected = parentCenter
1382 else
1383 case found.parentLayout of
1384 Testable.InColumn ->
1385 let
1386 siblingsOnTop =
1387 List.filter (\x -> x.bbox.bottom < found.self.bbox.top) found.siblings
1389 siblingsBelow =
1390 List.filter (\x -> x.bbox.top > found.self.bbox.bottom) found.siblings
1392 heightsAbove : Float
1393 heightsAbove =
1394 siblingsOnTop
1395 |> List.map (.height << .bbox)
1396 |> List.sum
1397 |> (\x -> x + (toFloat (List.length siblingsOnTop) * toFloat found.parentSpacing))
1399 heightsBelow =
1400 siblingsBelow
1401 |> List.map (.height << .bbox)
1402 |> List.sum
1403 |> (\x -> x + (toFloat (List.length siblingsBelow) * toFloat found.parentSpacing))
1405 expectedCenter : Float
1406 expectedCenter =
1407 found.parent.bbox.top
1408 + heightsAbove
1409 + ((found.parent.bbox.height - (heightsBelow + heightsAbove))
1410 / 2
1412 in
1413 [ expectRoundedEquality
1414 { found = selfCenter
1415 , expected = expectedCenter
1419 _ ->
1420 [ expectRoundedEquality
1421 { found = selfCenter
1422 , expected = parentCenter
1428{-| -}
1429above : Testable.Element msg -> Testable.Attr msg
1430above element =
1431 Testable.Nearby
1432 { location = Testable.Above
1433 , element = element
1434 , label = "above"
1435 , test =
1436 \found ->
1437 [ expectRoundedEquality
1438 { found = found.self.bbox.bottom
1439 , expected = found.parent.bbox.top
1445{-| -}
1446below : Testable.Element msg -> Testable.Attr msg
1447below element =
1448 Testable.Nearby
1449 { location = Testable.Below
1450 , element = element
1451 , label = "below"
1452 , test =
1453 \found ->
1454 [ expectRoundedEquality
1455 { found = found.self.bbox.top
1456 , expected = found.parent.bbox.bottom
1462{-| -}
1463onRight : Testable.Element msg -> Testable.Attr msg
1464onRight element =
1465 Testable.Nearby
1466 { location = Testable.OnRight
1467 , element = element
1468 , label = "onRight"
1469 , test =
1470 \found ->
1471 [ expectRoundedEquality
1472 { found = found.self.bbox.left
1473 , expected = found.parent.bbox.right
1479{-| -}
1480onLeft : Testable.Element msg -> Testable.Attr msg
1481onLeft element =
1482 Testable.Nearby
1483 { location = Testable.OnLeft
1484 , element = element
1485 , label = "onLeft"
1486 , test =
1487 \found ->
1488 [ expectRoundedEquality
1489 { found = found.self.bbox.right
1490 , expected = found.parent.bbox.left
1496compare x vs y =
1497 vs (round x) (round y) || vs (floor x) (floor y)
1500{-| -}
1501inFront : Testable.Element msg -> Testable.Attr msg
1502inFront element =
1503 Testable.Nearby
1504 { location = Testable.InFront
1505 , element = element
1506 , label = "inFront"
1507 , test =
1508 \found ->
1509 [ withinHelper found ]
1513withinHelper found =
1514 let
1515 horizontalCheck =
1516 if found.self.bbox.width > found.parent.bbox.width then
1517 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1518 || compare found.self.bbox.left (>=) found.parent.bbox.left
1521 else
1522 [ compare found.self.bbox.right (<=) found.parent.bbox.right
1523 , compare found.self.bbox.left (>=) found.parent.bbox.left
1526 verticalCheck =
1527 if found.self.bbox.width > found.parent.bbox.width then
1528 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1529 || compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1532 else
1533 [ compare found.self.bbox.top (>=) found.parent.bbox.top
1534 , compare found.self.bbox.bottom (<=) found.parent.bbox.bottom
1536 in
1537 Testable.true "within the confines of the parent"
1538 (List.all ((==) True)
1539 (List.concat
1540 [ horizontalCheck
1541 , verticalCheck
1547{-| -}
1548behindContent : Testable.Element msg -> Testable.Attr msg
1549behindContent element =
1550 Testable.Nearby
1551 { location = Testable.Behind
1552 , element = element
1553 , label = "behindContent"
1554 , test =
1555 \found ->
1556 [ withinHelper found ]
1561{- Implicit width/height calcualtions -}
1564implicitWidthHeightShrink attrs =
1565 let
1566 withImplicits =
1567 implicitTest (widthHelper Nothing Nothing Shrink)
1568 :: implicitTest (heightHelper Nothing Nothing Shrink)
1569 :: attrs
1570 in
1571 skipOverridden withImplicits
1574attrId attr =
1575 case attr of
1576 Testable.LabeledTest details ->
1577 details.id
1579 Testable.AttrTest details ->
1580 details.id
1582 _ ->
1583 Testable.NoId
1586skipOverridden ls =
1587 List.foldr
1588 (\attr ( found, caught ) ->
1589 let
1590 ( skip, has ) =
1591 case attrId attr of
1592 Testable.NoId ->
1593 ( False, found )
1595 Testable.IsWidth ->
1596 ( found.hasWidth
1597 , { hasWidth = True
1598 , hasHeight = found.hasHeight
1602 Testable.IsHeight ->
1603 ( found.hasHeight
1604 , { hasWidth = found.hasWidth
1605 , hasHeight = True
1608 in
1609 ( has
1610 , if skip then
1611 caught
1613 else
1614 attr :: caught
1617 ( { hasWidth = False
1618 , hasHeight = False
1620 , []
1622 ls
1623 |> Tuple.second
1624 |> List.reverse
1627{-| This is taking a normal test and rmoving its ability to attach a real `Element` attribute.
1629implicitTest attr =
1630 case attr of
1631 Testable.LabeledTest details ->
1632 Testable.AttrTest
1633 { test = details.test
1634 , label = "Implicit -> " ++ details.label
1635 , id = details.id
1638 otherwise ->
1639 otherwise