git.iko.soy/typeable/elm-ui
on cd088cb help sign in
typeable/elm-ui/src/Internal/Model.elm
3533 lines 105 kB history raw
1module Internal.Model exposing
2 ( Aligned(..)
3 , Angle
4 , Attribute(..)
5 , Axis(..)
6 , Children(..)
7 , Color(..)
8 , Description(..)
9 , Element(..)
10 , EmbedStyle(..)
11 , FocusStyle
12 , Font(..)
13 , Gathered
14 , HAlign(..)
15 , HoverSetting(..)
16 , LayoutContext(..)
17 , Length(..)
18 , Location(..)
19 , NearbyChildren(..)
20 , NodeName(..)
21 , Option(..)
22 , OptionRecord
23 , Padding(..)
24 , Property(..)
25 , PseudoClass(..)
26 , RenderMode(..)
27 , Shadow
28 , Spacing(..)
29 , Style(..)
30 , TransformComponent(..)
31 , Transformation(..)
32 , VAlign(..)
33 , Variant(..)
34 , XYZ
35 , addNodeName
36 , addWhen
37 , alignXName
38 , alignYName
39 , asColumn
40 , asEl
41 , asGrid
42 , asParagraph
43 , asRow
44 , asTextColumn
45 , boxShadowClass
46 , columnClass
47 , composeTransformation
48 , contextClasses
49 , createElement
50 , defaultOptions
51 , div
52 , element
53 , embedKeyed
54 , embedWith
55 , extractSpacingAndPadding
56 , filter
57 , finalizeNode
58 , floatClass
59 , focusDefaultStyle
60 , formatBoxShadow
61 , formatColor
62 , formatColorClass
63 , formatDropShadow
64 , formatTextShadow
65 , gatherAttrRecursive
66 , get
67 , getHeight
68 , getSpacing
69 , getStyleName
70 , getWidth
71 , gridClass
72 , htmlClass
73 , isContent
74 , lengthClassName
75 , map
76 , mapAttr
77 , mapAttrFromStyle
78 , noStyleSheet
79 , onlyStyles
80 , optionsToRecord
81 , paddingName
82 , pageClass
83 , paragraphClass
84 , reduceRecursive
85 , reduceStyles
86 , reduceStylesRecursive
87 , removeNever
88 , renderFontClassName
89 , renderHeight
90 , renderRoot
91 , renderVariant
92 , renderWidth
93 , rootStyle
94 , rowClass
95 , singleClass
96 , spacingName
97 , tag
98 , textShadowClass
99 , toHtml
100 , toStyleSheet
101 , transformClass
102 , unstyled
103 , unwrapDecorations
104 , variantName
105 )
107{-| -}
109import Html
110import Html.Attributes
111import Html.Keyed
112import Internal.Flag as Flag exposing (Flag)
113import Internal.Style exposing (classes, dot)
114import Json.Encode as Encode
115import Set exposing (Set)
116import VirtualDom
119type Element msg
120 = Unstyled (LayoutContext -> VirtualDom.Node msg)
121 | Styled
122 { styles : List Style
123 , html : EmbedStyle -> LayoutContext -> VirtualDom.Node msg
124 }
125 | Text String
126 | Empty
129type EmbedStyle
130 = NoStyleSheet
131 | StaticRootAndDynamic OptionRecord (List Style)
132 | OnlyDynamic OptionRecord (List Style)
135noStyleSheet : EmbedStyle
136noStyleSheet =
137 NoStyleSheet
140type LayoutContext
141 = AsRow
142 | AsColumn
143 | AsEl
144 | AsGrid
145 | AsParagraph
146 | AsTextColumn
149type Aligned
150 = Unaligned
151 | Aligned (Maybe HAlign) (Maybe VAlign)
154type HAlign
155 = Left
156 | CenterX
157 | Right
160type VAlign
161 = Top
162 | CenterY
163 | Bottom
166type Style
167 = Style String (List Property)
168 -- class prop val
169 | FontFamily String (List Font)
170 | FontSize Int
171 -- classname, prop, value
172 | Single String String String
173 | Colored String String Color
174 | SpacingStyle String Int Int
175 | BorderWidth String Int Int Int Int
176 | PaddingStyle String Int Int Int Int
177 | GridTemplateStyle
178 { spacing : ( Length, Length )
179 , columns : List Length
180 , rows : List Length
181 }
182 | GridPosition
183 { row : Int
184 , col : Int
185 , width : Int
186 , height : Int
187 }
188 | Transform Transformation
189 | PseudoSelector PseudoClass (List Style)
190 | Transparency String Float
191 | Shadows String String
194type Transformation
195 = Untransformed
196 | Moved XYZ
197 -- translate, scale, rotate
198 | FullTransform XYZ XYZ XYZ Angle
201type PseudoClass
202 = Focus
203 | Hover
204 | Active
207{-| -}
208type alias Adjustment =
209 { capital : Float
210 , lowercase : Float
211 , baseline : Float
212 , descender : Float
213 }
216type Font
217 = Serif
218 | SansSerif
219 | Monospace
220 | Typeface String
221 | ImportFont String String
222 | FontWith
223 { name : String
224 , adjustment : Maybe Adjustment
225 , variants : List Variant
226 }
229type Variant
230 = VariantActive String
231 | VariantOff String
232 | VariantIndexed String Int
235renderVariant var =
236 case var of
237 VariantActive name ->
238 "\"" ++ name ++ "\""
240 VariantOff name ->
241 "\"" ++ name ++ "\" 0"
243 VariantIndexed name index ->
244 "\"" ++ name ++ "\" " ++ String.fromInt index
247variantName var =
248 case var of
249 VariantActive name ->
250 name
252 VariantOff name ->
253 name ++ "-0"
255 VariantIndexed name index ->
256 name ++ "-" ++ String.fromInt index
259renderVariants typeface =
260 case typeface of
261 FontWith font ->
262 Just (String.join ", " (List.map renderVariant font.variants))
264 _ ->
265 Nothing
268isSmallCaps var =
269 case var of
270 VariantActive name ->
271 name == "smcp"
273 VariantOff name ->
274 False
276 VariantIndexed name index ->
277 name == "smcp" && index == 1
280hasSmallCaps typeface =
281 case typeface of
282 FontWith font ->
283 List.any isSmallCaps font.variants
285 _ ->
286 False
289type Property
290 = Property String String
293type alias XYZ =
294 ( Float, Float, Float )
297type alias Angle =
298 Float
301type Attribute aligned msg
302 = NoAttribute
303 | Attr (VirtualDom.Attribute msg)
304 | Describe Description
305 -- invalidation key and literal class
306 | Class Flag String
307 -- invalidation key "border-color" as opposed to "border-color-10-10-10" that will be the key for the class
308 | StyleClass Flag Style
309 | AlignY VAlign
310 | AlignX HAlign
311 | Width Length
312 | Height Length
313 | Nearby Location (Element msg)
314 | TransformComponent Flag TransformComponent
317type TransformComponent
318 = MoveX Float
319 | MoveY Float
320 | MoveZ Float
321 | MoveXYZ XYZ
322 | Rotate XYZ Float
323 | Scale XYZ
326type Description
327 = Main
328 | Navigation
329 -- | Search
330 | ContentInfo
331 | Complementary
332 | Heading Int
333 | Label String
334 | LivePolite
335 | LiveAssertive
336 | Button
337 | Paragraph
340type Length
341 = Px Int
342 | Content
343 | Fill Int
344 | Min Int Length
345 | Max Int Length
348type Axis
349 = XAxis
350 | YAxis
351 | AllAxis
354type Location
355 = Above
356 | Below
357 | OnRight
358 | OnLeft
359 | InFront
360 | Behind
363{-| -}
364type Color
365 = Rgba Float Float Float Float
368type NodeName
369 = Generic
370 | NodeName String
371 | Embedded String String
374type NearbyChildren msg
375 = NoNearbyChildren
376 | ChildrenBehind (List (Html.Html msg))
377 | ChildrenInFront (List (Html.Html msg))
378 | ChildrenBehindAndInFront (List (Html.Html msg)) (List (Html.Html msg))
381div =
382 Generic
385type alias Gathered msg =
386 { node : NodeName
387 , attributes : List (VirtualDom.Attribute msg)
388 , styles : List Style
389 , children : NearbyChildren msg
390 , has : Flag.Field
391 }
394htmlClass : String -> Attribute aligned msg
395htmlClass cls =
396 Attr <| Html.Attributes.class cls
399{-| -}
400unstyled : VirtualDom.Node msg -> Element msg
401unstyled =
402 Unstyled << always
405finalizeNode has node attributes children embedMode parentContext =
406 let
407 createNode nodeName attrs =
408 case children of
409 Keyed keyed ->
410 VirtualDom.keyedNode nodeName
411 attrs
412 (case embedMode of
413 NoStyleSheet ->
414 keyed
416 OnlyDynamic opts styles ->
417 embedKeyed False opts styles keyed
419 StaticRootAndDynamic opts styles ->
420 embedKeyed True opts styles keyed
421 )
423 Unkeyed unkeyed ->
424 (case nodeName of
425 "div" ->
426 Html.div
428 "p" ->
429 Html.p
431 _ ->
432 VirtualDom.node nodeName
433 )
434 attrs
435 (case embedMode of
436 NoStyleSheet ->
437 unkeyed
439 OnlyDynamic opts styles ->
440 embedWith False opts styles unkeyed
442 StaticRootAndDynamic opts styles ->
443 embedWith True opts styles unkeyed
444 )
446 html =
447 case node of
448 Generic ->
449 createNode "div" attributes
451 NodeName nodeName ->
452 createNode nodeName attributes
454 Embedded nodeName internal ->
455 VirtualDom.node nodeName
456 attributes
457 [ createNode internal
458 [ Html.Attributes.class
459 (classes.any ++ " " ++ classes.single)
460 ]
461 ]
462 in
463 case parentContext of
464 AsRow ->
465 if Flag.present Flag.widthFill has && not (Flag.present Flag.widthBetween has) then
466 html
468 else if Flag.present Flag.alignRight has then
469 Html.u
470 [ Html.Attributes.class
471 (String.join " "
472 [ classes.any
473 , classes.single
474 , classes.container
475 , classes.contentCenterY
476 , classes.alignContainerRight
477 ]
478 )
479 ]
480 [ html ]
482 else if Flag.present Flag.centerX has then
483 Html.s
484 [ Html.Attributes.class
485 (String.join " "
486 [ classes.any
487 , classes.single
488 , classes.container
489 , classes.contentCenterY
490 , classes.alignContainerCenterX
491 ]
492 )
493 ]
494 [ html ]
496 else
497 html
499 AsColumn ->
500 if Flag.present Flag.heightFill has && not (Flag.present Flag.heightBetween has) then
501 html
503 else if Flag.present Flag.centerY has then
504 Html.s
505 [ Html.Attributes.class
506 (String.join " "
507 [ classes.any
508 , classes.single
509 , classes.container
510 , classes.alignContainerCenterY
511 ]
512 )
513 ]
514 [ html ]
516 else if Flag.present Flag.alignBottom has then
517 Html.u
518 [ Html.Attributes.class
519 (String.join " "
520 [ classes.any
521 , classes.single
522 , classes.container
523 , classes.alignContainerBottom
524 ]
525 )
526 ]
527 [ html ]
529 else
530 html
532 _ ->
533 html
536embedWith static opts styles children =
537 let
538 dynamicStyleSheet =
539 styles
540 |> List.foldl reduceStyles ( Set.empty, renderFocusStyle opts.focus )
541 |> Tuple.second
542 -- |> reduceStylesRecursive Set.empty [ ]) --renderFocusStyle opts.focus ]
543 -- |> sortedReduce
544 |> toStyleSheet opts
545 in
546 if static then
547 staticRoot opts
548 :: dynamicStyleSheet
549 :: children
551 else
552 dynamicStyleSheet
553 :: children
556embedKeyed static opts styles children =
557 let
558 dynamicStyleSheet =
559 styles
560 |> List.foldl reduceStyles ( Set.empty, renderFocusStyle opts.focus )
561 |> Tuple.second
562 -- |> reduceStylesRecursive Set.empty [ ]) --renderFocusStyle opts.focus ]
563 -- |> sortedReduce
564 |> toStyleSheet opts
565 in
566 if static then
567 ( "static-stylesheet", staticRoot opts )
568 :: ( "dynamic-stylesheet"
569 , dynamicStyleSheet
570 )
571 :: children
573 else
574 ( "dynamic-stylesheet"
575 , dynamicStyleSheet
576 )
577 :: children
580reduceStylesRecursive : Set String -> List Style -> List Style -> List Style
581reduceStylesRecursive cache found styles =
582 case styles of
583 [] ->
584 found
586 head :: remaining ->
587 let
588 styleName =
589 getStyleName head
590 in
591 if Set.member styleName cache then
592 reduceStylesRecursive cache found remaining
594 else
595 reduceStylesRecursive (Set.insert styleName cache) (head :: found) remaining
598reduceStyles : Style -> ( Set String, List Style ) -> ( Set String, List Style )
599reduceStyles style (( cache, existing ) as nevermind) =
600 let
601 styleName =
602 getStyleName style
603 in
604 if Set.member styleName cache then
605 nevermind
607 else
608 ( Set.insert styleName cache
609 , style :: existing
610 )
613sortedReduce styles =
614 styles
615 -- |> List.map (\x -> ( getStyleName x, x ))
616 |> List.sortBy getStyleName
617 |> reduceRecursiveCalcName []
620reduceRecursiveCalcName : List Style -> List Style -> List Style
621reduceRecursiveCalcName found styles =
622 case styles of
623 [] ->
624 found
626 headOfList :: [] ->
627 headOfList :: found
629 headOfList :: other :: remaining ->
630 if headOfList /= other then
631 reduceRecursiveCalcName (headOfList :: found) (other :: remaining)
633 else
634 reduceRecursiveCalcName found (other :: remaining)
637reduceRecursive : List Style -> List ( String, Style ) -> List Style
638reduceRecursive found styles =
639 case styles of
640 [] ->
641 found
643 ( _, headOfList ) :: [] ->
644 headOfList :: found
646 ( headOfListName, headOfList ) :: ( otherName, other ) :: remaining ->
647 if headOfListName /= otherName then
648 reduceRecursive (headOfList :: found) (( otherName, other ) :: remaining)
650 else
651 reduceRecursive found (( otherName, other ) :: remaining)
654addNodeName : String -> NodeName -> NodeName
655addNodeName newNode old =
656 case old of
657 Generic ->
658 NodeName newNode
660 NodeName name ->
661 Embedded name newNode
663 Embedded x y ->
664 Embedded x y
667alignXName : HAlign -> String
668alignXName align =
669 case align of
670 Left ->
671 classes.alignedHorizontally ++ " " ++ classes.alignLeft
673 Right ->
674 classes.alignedHorizontally ++ " " ++ classes.alignRight
676 CenterX ->
677 classes.alignedHorizontally ++ " " ++ classes.alignCenterX
680alignYName : VAlign -> String
681alignYName align =
682 case align of
683 Top ->
684 classes.alignedVertically ++ " " ++ classes.alignTop
686 Bottom ->
687 classes.alignedVertically ++ " " ++ classes.alignBottom
689 CenterY ->
690 classes.alignedVertically ++ " " ++ classes.alignCenterY
693transformClass transform =
694 case transform of
695 Untransformed ->
696 Nothing
698 Moved ( x, y, z ) ->
699 Just <|
700 "mv-"
701 ++ floatClass x
702 ++ "-"
703 ++ floatClass y
704 ++ "-"
705 ++ floatClass z
707 FullTransform ( tx, ty, tz ) ( sx, sy, sz ) ( ox, oy, oz ) angle ->
708 Just <|
709 "tfrm-"
710 ++ floatClass tx
711 ++ "-"
712 ++ floatClass ty
713 ++ "-"
714 ++ floatClass tz
715 ++ "-"
716 ++ floatClass sx
717 ++ "-"
718 ++ floatClass sy
719 ++ "-"
720 ++ floatClass sz
721 ++ "-"
722 ++ floatClass ox
723 ++ "-"
724 ++ floatClass oy
725 ++ "-"
726 ++ floatClass oz
727 ++ "-"
728 ++ floatClass angle
731transformValue transform =
732 case transform of
733 Untransformed ->
734 Nothing
736 Moved ( x, y, z ) ->
737 Just <|
738 "translate3d("
739 ++ String.fromFloat x
740 ++ "px, "
741 ++ String.fromFloat y
742 ++ "px, "
743 ++ String.fromFloat z
744 ++ "px)"
746 FullTransform ( tx, ty, tz ) ( sx, sy, sz ) ( ox, oy, oz ) angle ->
747 let
748 translate =
749 "translate3d("
750 ++ String.fromFloat tx
751 ++ "px, "
752 ++ String.fromFloat ty
753 ++ "px, "
754 ++ String.fromFloat tz
755 ++ "px)"
757 scale =
758 "scale3d("
759 ++ String.fromFloat sx
760 ++ ", "
761 ++ String.fromFloat sy
762 ++ ", "
763 ++ String.fromFloat sz
764 ++ ")"
766 rotate =
767 "rotate3d("
768 ++ String.fromFloat ox
769 ++ ", "
770 ++ String.fromFloat oy
771 ++ ", "
772 ++ String.fromFloat oz
773 ++ ", "
774 ++ String.fromFloat angle
775 ++ "rad)"
776 in
777 Just <| translate ++ " " ++ scale ++ " " ++ rotate
780composeTransformation transform component =
781 case transform of
782 Untransformed ->
783 case component of
784 MoveX x ->
785 Moved ( x, 0, 0 )
787 MoveY y ->
788 Moved ( 0, y, 0 )
790 MoveZ z ->
791 Moved ( 0, 0, z )
793 MoveXYZ xyz ->
794 Moved xyz
796 Rotate xyz angle ->
797 FullTransform ( 0, 0, 0 ) ( 1, 1, 1 ) xyz angle
799 Scale xyz ->
800 FullTransform ( 0, 0, 0 ) xyz ( 0, 0, 1 ) 0
802 Moved (( x, y, z ) as moved) ->
803 case component of
804 MoveX newX ->
805 Moved ( newX, y, z )
807 MoveY newY ->
808 Moved ( x, newY, z )
810 MoveZ newZ ->
811 Moved ( x, y, newZ )
813 MoveXYZ xyz ->
814 Moved xyz
816 Rotate xyz angle ->
817 FullTransform moved ( 1, 1, 1 ) xyz angle
819 Scale scale ->
820 FullTransform moved scale ( 0, 0, 1 ) 0
822 FullTransform (( x, y, z ) as moved) scaled origin angle ->
823 case component of
824 MoveX newX ->
825 FullTransform ( newX, y, z ) scaled origin angle
827 MoveY newY ->
828 FullTransform ( x, newY, z ) scaled origin angle
830 MoveZ newZ ->
831 FullTransform ( x, y, newZ ) scaled origin angle
833 MoveXYZ newMove ->
834 FullTransform newMove scaled origin angle
836 Rotate newOrigin newAngle ->
837 FullTransform moved scaled newOrigin newAngle
839 Scale newScale ->
840 FullTransform moved newScale origin angle
843skippable flag style =
844 if flag == Flag.borderWidth then
845 case style of
846 Single _ _ val ->
847 case val of
848 "0px" ->
849 True
851 "1px" ->
852 True
854 "2px" ->
855 True
857 "3px" ->
858 True
860 "4px" ->
861 True
863 "5px" ->
864 True
866 "6px" ->
867 True
869 _ ->
870 False
872 _ ->
873 False
875 else
876 case style of
877 FontSize i ->
878 i >= 8 && i <= 32
880 PaddingStyle name t r b l ->
881 t == b && t == r && t == l && t >= 0 && t <= 24
883 -- SpacingStyle _ _ _ ->
884 -- True
885 -- FontFamily _ _ ->
886 -- True
887 _ ->
888 False
891gatherAttrRecursive :
892 String
893 -> NodeName
894 -> Flag.Field
895 -> Transformation
896 -> List Style
897 -> List (VirtualDom.Attribute msg)
898 -> NearbyChildren msg
899 -> List (Attribute aligned msg)
900 -> Gathered msg
901gatherAttrRecursive classes node has transform styles attrs children elementAttrs =
902 case elementAttrs of
903 [] ->
904 case transformClass transform of
905 Nothing ->
906 { attributes = Html.Attributes.class classes :: attrs
907 , styles = styles
908 , node = node
909 , children = children
910 , has = has
911 }
913 Just class ->
914 { attributes = Html.Attributes.class (classes ++ " " ++ class) :: attrs
915 , styles = Transform transform :: styles
916 , node = node
917 , children = children
918 , has = has
919 }
921 attribute :: remaining ->
922 case attribute of
923 NoAttribute ->
924 gatherAttrRecursive classes node has transform styles attrs children remaining
926 Class flag exactClassName ->
927 if Flag.present flag has then
928 gatherAttrRecursive classes node has transform styles attrs children remaining
930 else
931 gatherAttrRecursive (exactClassName ++ " " ++ classes) node (Flag.add flag has) transform styles attrs children remaining
933 Attr actualAttribute ->
934 gatherAttrRecursive classes node has transform styles (actualAttribute :: attrs) children remaining
936 StyleClass flag style ->
937 if Flag.present flag has then
938 gatherAttrRecursive classes node has transform styles attrs children remaining
940 else if skippable flag style then
941 gatherAttrRecursive (getStyleName style ++ " " ++ classes)
942 node
943 (Flag.add flag has)
944 transform
945 styles
946 attrs
947 children
948 remaining
950 else
951 gatherAttrRecursive (getStyleName style ++ " " ++ classes)
952 node
953 (Flag.add flag has)
954 transform
955 (style :: styles)
956 attrs
957 children
958 remaining
960 TransformComponent flag component ->
961 gatherAttrRecursive classes
962 node
963 (Flag.add flag has)
964 (composeTransformation transform component)
965 styles
966 attrs
967 children
968 remaining
970 Width width ->
971 if Flag.present Flag.width has then
972 gatherAttrRecursive classes node has transform styles attrs children remaining
974 else
975 case width of
976 Px px ->
977 gatherAttrRecursive ((Internal.Style.classes.widthExact ++ " width-px-" ++ String.fromInt px) ++ " " ++ classes)
978 node
979 (Flag.add Flag.width has)
980 transform
981 (Single ("width-px-" ++ String.fromInt px) "width" (String.fromInt px ++ "px") :: styles)
982 attrs
983 children
984 remaining
986 Content ->
987 gatherAttrRecursive (classes ++ " " ++ Internal.Style.classes.widthContent)
988 node
989 (Flag.add Flag.widthContent (Flag.add Flag.width has))
990 transform
991 styles
992 attrs
993 children
994 remaining
996 Fill portion ->
997 if portion == 1 then
998 gatherAttrRecursive (classes ++ " " ++ Internal.Style.classes.widthFill)
999 node
1000 (Flag.add Flag.widthFill (Flag.add Flag.width has))
1001 transform
1002 styles
1003 attrs
1004 children
1005 remaining
1007 else
1008 gatherAttrRecursive (classes ++ " " ++ Internal.Style.classes.widthFillPortion ++ " width-fill-" ++ String.fromInt portion)
1009 node
1010 (Flag.add Flag.widthFill (Flag.add Flag.width has))
1011 transform
1012 (Single
1013 (Internal.Style.classes.any
1014 ++ "."
1015 ++ Internal.Style.classes.row
1016 ++ " > "
1017 ++ (Internal.Style.dot <| "width-fill-" ++ String.fromInt portion)
1019 "flex-grow"
1020 (String.fromInt (portion * 100000))
1021 :: styles
1023 attrs
1024 children
1025 remaining
1027 _ ->
1028 let
1029 ( addToFlags, newClass, newStyles ) =
1030 renderWidth width
1031 in
1032 gatherAttrRecursive (classes ++ " " ++ newClass)
1033 node
1034 (Flag.merge addToFlags (Flag.add Flag.width has))
1035 transform
1036 (newStyles ++ styles)
1037 attrs
1038 children
1039 remaining
1041 Height height ->
1042 if Flag.present Flag.height has then
1043 gatherAttrRecursive classes node has transform styles attrs children remaining
1045 else
1046 case height of
1047 Px px ->
1048 let
1049 val =
1050 String.fromInt px ++ "px"
1052 name =
1053 "height-px-" ++ val
1054 in
1055 gatherAttrRecursive (Internal.Style.classes.heightExact ++ " " ++ name ++ " " ++ classes)
1056 node
1057 (Flag.add Flag.height has)
1058 transform
1059 (Single name "height " val :: styles)
1060 attrs
1061 children
1062 remaining
1064 Content ->
1065 gatherAttrRecursive (Internal.Style.classes.heightContent ++ " " ++ classes)
1066 node
1067 (Flag.add Flag.heightContent (Flag.add Flag.height has))
1068 transform
1069 styles
1070 attrs
1071 children
1072 remaining
1074 Fill portion ->
1075 if portion == 1 then
1076 gatherAttrRecursive (Internal.Style.classes.heightFill ++ " " ++ classes)
1077 node
1078 (Flag.add Flag.heightFill (Flag.add Flag.height has))
1079 transform
1080 styles
1081 attrs
1082 children
1083 remaining
1085 else
1086 gatherAttrRecursive (classes ++ " " ++ (Internal.Style.classes.heightFillPortion ++ " height-fill-" ++ String.fromInt portion))
1087 node
1088 (Flag.add Flag.heightFill (Flag.add Flag.height has))
1089 transform
1090 (Single
1091 (Internal.Style.classes.any
1092 ++ "."
1093 ++ Internal.Style.classes.column
1094 ++ " > "
1095 ++ (Internal.Style.dot <| "height-fill-" ++ String.fromInt portion)
1097 "flex-grow"
1098 (String.fromInt (portion * 100000))
1099 :: styles
1101 attrs
1102 children
1103 remaining
1105 _ ->
1106 let
1107 ( addToFlags, newClass, newStyles ) =
1108 renderHeight height
1109 in
1110 gatherAttrRecursive (classes ++ " " ++ newClass)
1111 node
1112 (Flag.merge addToFlags (Flag.add Flag.height has))
1113 transform
1114 (newStyles ++ styles)
1115 attrs
1116 children
1117 remaining
1119 Describe description ->
1120 case description of
1121 Main ->
1122 gatherAttrRecursive classes (addNodeName "main" node) has transform styles attrs children remaining
1124 Navigation ->
1125 gatherAttrRecursive classes (addNodeName "nav" node) has transform styles attrs children remaining
1127 ContentInfo ->
1128 gatherAttrRecursive classes (addNodeName "footer" node) has transform styles attrs children remaining
1130 Complementary ->
1131 gatherAttrRecursive classes (addNodeName "aside" node) has transform styles attrs children remaining
1133 Heading i ->
1134 if i <= 1 then
1135 gatherAttrRecursive classes (addNodeName "h1" node) has transform styles attrs children remaining
1137 else if i < 7 then
1138 gatherAttrRecursive classes (addNodeName ("h" ++ String.fromInt i) node) has transform styles attrs children remaining
1140 else
1141 gatherAttrRecursive classes (addNodeName "h6" node) has transform styles attrs children remaining
1143 Paragraph ->
1144 -- previously we rendered a <p> tag, though apparently this invalidates the html if it has <div>s inside.
1145 -- Since we can't guaranteee that there are no divs, we need another strategy.
1146 -- While it's not documented in many places, there apparently is a paragraph aria role
1147 -- https://github.com/w3c/aria/blob/11f85f41a5b621fdbe85fc9bcdcd270e653a48ba/common/script/roleInfo.js
1148 -- Though we'll need to wait till it gets released in an official wai-aria spec to use it.
1149 -- If it's used at the moment, then Lighthouse complains (likely rightfully) that role paragraph is not recognized.
1150 gatherAttrRecursive
1151 classes
1152 node
1153 has
1154 transform
1155 styles
1156 attrs
1157 children
1158 remaining
1160 Button ->
1161 gatherAttrRecursive classes node has transform styles (VirtualDom.attribute "role" "button" :: attrs) children remaining
1163 Label label ->
1164 gatherAttrRecursive classes node has transform styles (VirtualDom.attribute "aria-label" label :: attrs) children remaining
1166 LivePolite ->
1167 gatherAttrRecursive classes node has transform styles (VirtualDom.attribute "aria-live" "polite" :: attrs) children remaining
1169 LiveAssertive ->
1170 gatherAttrRecursive classes node has transform styles (VirtualDom.attribute "aria-live" "assertive" :: attrs) children remaining
1172 Nearby location elem ->
1173 let
1174 newStyles =
1175 case elem of
1176 Empty ->
1177 styles
1179 Text str ->
1180 styles
1182 Unstyled html ->
1183 styles
1185 Styled styled ->
1186 styles ++ styled.styles
1187 in
1188 gatherAttrRecursive
1189 classes
1190 node
1191 has
1192 transform
1193 newStyles
1194 attrs
1195 (addNearbyElement location elem children)
1196 remaining
1198 AlignX x ->
1199 if Flag.present Flag.xAlign has then
1200 gatherAttrRecursive classes node has transform styles attrs children remaining
1202 else
1203 gatherAttrRecursive (alignXName x ++ " " ++ classes)
1204 node
1205 (has
1206 |> Flag.add Flag.xAlign
1207 |> (\flags ->
1208 case x of
1209 CenterX ->
1210 Flag.add Flag.centerX flags
1212 Right ->
1213 Flag.add Flag.alignRight flags
1215 _ ->
1216 flags
1219 transform
1220 styles
1221 attrs
1222 children
1223 remaining
1225 AlignY y ->
1226 if Flag.present Flag.yAlign has then
1227 gatherAttrRecursive classes node has transform styles attrs children remaining
1229 else
1230 gatherAttrRecursive (alignYName y ++ " " ++ classes)
1231 node
1232 (Flag.add Flag.yAlign has
1233 |> (\flags ->
1234 case y of
1235 CenterY ->
1236 Flag.add Flag.centerY flags
1238 Bottom ->
1239 Flag.add Flag.alignBottom flags
1241 _ ->
1242 flags
1245 transform
1246 styles
1247 attrs
1248 children
1249 remaining
1252addNearbyElement location elem existing =
1253 let
1254 nearby =
1255 nearbyElement location elem
1256 in
1257 case existing of
1258 NoNearbyChildren ->
1259 case location of
1260 Behind ->
1261 ChildrenBehind [ nearby ]
1263 _ ->
1264 ChildrenInFront [ nearby ]
1266 ChildrenBehind existingBehind ->
1267 case location of
1268 Behind ->
1269 ChildrenBehind (nearby :: existingBehind)
1271 _ ->
1272 ChildrenBehindAndInFront existingBehind [ nearby ]
1274 ChildrenInFront existingInFront ->
1275 case location of
1276 Behind ->
1277 ChildrenBehindAndInFront [ nearby ] existingInFront
1279 _ ->
1280 ChildrenInFront (nearby :: existingInFront)
1282 ChildrenBehindAndInFront existingBehind existingInFront ->
1283 case location of
1284 Behind ->
1285 ChildrenBehindAndInFront (nearby :: existingBehind) existingInFront
1287 _ ->
1288 ChildrenBehindAndInFront existingBehind (nearby :: existingInFront)
1291nearbyElement location elem =
1292 Html.div
1293 [ Html.Attributes.class <|
1294 case location of
1295 Above ->
1296 String.join " "
1297 [ Internal.Style.classes.nearby
1298 , Internal.Style.classes.single
1299 , Internal.Style.classes.above
1302 Below ->
1303 String.join " "
1304 [ Internal.Style.classes.nearby
1305 , Internal.Style.classes.single
1306 , Internal.Style.classes.below
1309 OnRight ->
1310 String.join " "
1311 [ Internal.Style.classes.nearby
1312 , Internal.Style.classes.single
1313 , Internal.Style.classes.onRight
1316 OnLeft ->
1317 String.join " "
1318 [ Internal.Style.classes.nearby
1319 , Internal.Style.classes.single
1320 , Internal.Style.classes.onLeft
1323 InFront ->
1324 String.join " "
1325 [ Internal.Style.classes.nearby
1326 , Internal.Style.classes.single
1327 , Internal.Style.classes.inFront
1330 Behind ->
1331 String.join " "
1332 [ Internal.Style.classes.nearby
1333 , Internal.Style.classes.single
1334 , Internal.Style.classes.behind
1337 [ case elem of
1338 Empty ->
1339 VirtualDom.text ""
1341 Text str ->
1342 textElement str
1344 Unstyled html ->
1345 html asEl
1347 Styled styled ->
1348 styled.html NoStyleSheet asEl
1352renderWidth w =
1353 case w of
1354 Px px ->
1355 ( Flag.none
1356 , Internal.Style.classes.widthExact ++ " width-px-" ++ String.fromInt px
1357 , [ Single ("width-px-" ++ String.fromInt px) "width" (String.fromInt px ++ "px") ]
1360 Content ->
1361 ( Flag.add Flag.widthContent Flag.none
1362 , Internal.Style.classes.widthContent
1363 , []
1366 Fill portion ->
1367 if portion == 1 then
1368 ( Flag.add Flag.widthFill Flag.none
1369 , Internal.Style.classes.widthFill
1370 , []
1373 else
1374 ( Flag.add Flag.widthFill Flag.none
1375 , Internal.Style.classes.widthFillPortion ++ " width-fill-" ++ String.fromInt portion
1376 , [ Single
1377 (Internal.Style.classes.any
1378 ++ "."
1379 ++ Internal.Style.classes.row
1380 ++ " > "
1381 ++ (Internal.Style.dot <| "width-fill-" ++ String.fromInt portion)
1383 "flex-grow"
1384 (String.fromInt (portion * 100000))
1388 Min minSize len ->
1389 let
1390 cls =
1391 "min-width-"
1392 ++ String.fromInt minSize
1394 style =
1395 Single
1396 cls
1397 "min-width"
1398 (String.fromInt minSize ++ "px")
1400 ( newFlag, newAttrs, newStyle ) =
1401 renderWidth len
1402 in
1403 ( Flag.add Flag.widthBetween newFlag
1404 , cls ++ " " ++ newAttrs
1405 , style :: newStyle
1408 Max maxSize len ->
1409 let
1410 cls =
1411 "max-width-" ++ String.fromInt maxSize
1413 style =
1414 Single cls
1415 "max-width"
1416 (String.fromInt maxSize ++ "px")
1418 ( newFlag, newAttrs, newStyle ) =
1419 renderWidth len
1420 in
1421 ( Flag.add Flag.widthBetween newFlag
1422 , cls ++ " " ++ newAttrs
1423 , style :: newStyle
1427renderHeight h =
1428 case h of
1429 Px px ->
1430 let
1431 val =
1432 String.fromInt px
1434 name =
1435 "height-px-" ++ val
1436 in
1437 ( Flag.none
1438 , Internal.Style.classes.heightExact ++ " " ++ name
1439 , [ Single name "height" (val ++ "px") ]
1442 Content ->
1443 ( Flag.add Flag.heightContent Flag.none
1444 , Internal.Style.classes.heightContent
1445 , []
1448 Fill portion ->
1449 if portion == 1 then
1450 ( Flag.add Flag.heightFill Flag.none
1451 , Internal.Style.classes.heightFill
1452 , []
1455 else
1456 ( Flag.add Flag.heightFill Flag.none
1457 , Internal.Style.classes.heightFillPortion ++ " height-fill-" ++ String.fromInt portion
1458 , [ Single
1459 (Internal.Style.classes.any
1460 ++ "."
1461 ++ Internal.Style.classes.column
1462 ++ " > "
1463 ++ (Internal.Style.dot <| "height-fill-" ++ String.fromInt portion)
1465 "flex-grow"
1466 (String.fromInt (portion * 100000))
1470 Min minSize len ->
1471 let
1472 cls =
1473 "min-height-"
1474 ++ String.fromInt minSize
1476 style =
1477 Single
1478 cls
1479 "min-height"
1480 (String.fromInt minSize ++ "px")
1482 ( newFlag, newAttrs, newStyle ) =
1483 renderHeight len
1484 in
1485 ( Flag.add Flag.heightBetween newFlag
1486 , cls ++ " " ++ newAttrs
1487 , style :: newStyle
1490 Max maxSize len ->
1491 let
1492 cls =
1493 "max-height-" ++ String.fromInt maxSize
1495 style =
1496 Single cls
1497 "max-height"
1498 (String.fromInt maxSize ++ "px")
1500 ( newFlag, newAttrs, newStyle ) =
1501 renderHeight len
1502 in
1503 ( Flag.add Flag.heightBetween newFlag
1504 , cls ++ " " ++ newAttrs
1505 , style :: newStyle
1509rowClass =
1510 classes.any ++ " " ++ classes.row
1513columnClass =
1514 classes.any ++ " " ++ classes.column
1517singleClass =
1518 classes.any ++ " " ++ classes.single
1521gridClass =
1522 classes.any ++ " " ++ classes.grid
1525paragraphClass =
1526 classes.any ++ " " ++ classes.paragraph
1529pageClass =
1530 classes.any ++ " " ++ classes.page
1533contextClasses context =
1534 case context of
1535 AsRow ->
1536 rowClass
1538 AsColumn ->
1539 columnClass
1541 AsEl ->
1542 singleClass
1544 AsGrid ->
1545 gridClass
1547 AsParagraph ->
1548 paragraphClass
1550 AsTextColumn ->
1551 pageClass
1554element : LayoutContext -> NodeName -> List (Attribute aligned msg) -> Children (Element msg) -> Element msg
1555element context node attributes children =
1556 attributes
1557 |> List.reverse
1558 |> gatherAttrRecursive (contextClasses context) node Flag.none untransformed [] [] NoNearbyChildren
1559 |> createElement context children
1562untransformed =
1563 Untransformed
1566createElement : LayoutContext -> Children (Element msg) -> Gathered msg -> Element msg
1567createElement context children rendered =
1568 let
1569 gather child ( htmls, existingStyles ) =
1570 case child of
1571 Unstyled html ->
1572 if context == asParagraph then
1573 ( html context :: htmls
1574 , existingStyles
1577 else
1578 ( html context :: htmls
1579 , existingStyles
1582 Styled styled ->
1583 if context == asParagraph then
1584 ( styled.html NoStyleSheet context :: htmls
1585 , if List.isEmpty existingStyles then
1586 styled.styles
1588 else
1589 styled.styles ++ existingStyles
1592 else
1593 ( styled.html NoStyleSheet context :: htmls
1594 , if List.isEmpty existingStyles then
1595 styled.styles
1597 else
1598 styled.styles ++ existingStyles
1601 Text str ->
1602 -- TEXT OPTIMIZATION
1603 -- You can have raw text if the element is an el, and has `width-content` and `height-content`
1604 -- Same if it's a column or row with one child and width-content, height-content
1605 -- interferes with css grid
1606 -- Maybe we could unpack text elements in a paragraph as well,
1607 -- however, embedded elements that are larger than the line height will overlap with exisitng text.
1608 -- I don't think that's what we want.
1609 -- if
1610 -- context
1611 -- == asEl
1612 -- || context
1613 -- == asParagraph
1614 -- then
1615 -- ( VirtualDom.text
1616 -- (if context == asParagraph then
1617 -- str
1618 -- else
1619 -- str
1620 -- )
1621 -- :: htmls
1622 -- , existingStyles
1623 -- )
1624 -- else
1625 ( (if context == asEl then
1626 textElementFill str
1628 else
1629 textElement str
1631 :: htmls
1632 , existingStyles
1635 Empty ->
1636 ( htmls, existingStyles )
1638 gatherKeyed ( key, child ) ( htmls, existingStyles ) =
1639 case child of
1640 Unstyled html ->
1641 if context == asParagraph then
1642 ( ( key, html context ) :: htmls
1643 , existingStyles
1646 else
1647 ( ( key, html context ) :: htmls
1648 , existingStyles
1651 Styled styled ->
1652 if context == asParagraph then
1653 ( ( key, styled.html NoStyleSheet context )
1654 :: htmls
1655 , if List.isEmpty existingStyles then
1656 styled.styles
1658 else
1659 styled.styles ++ existingStyles
1662 else
1663 ( ( key, styled.html NoStyleSheet context ) :: htmls
1664 , if List.isEmpty existingStyles then
1665 styled.styles
1667 else
1668 styled.styles ++ existingStyles
1671 Text str ->
1672 -- TEXT OPTIMIZATION
1673 -- You can have raw text if the element is an el, and has `width-content` and `height-content`
1674 -- Same if it's a column or row with one child and width-content, height-content
1675 -- if
1676 -- context
1677 -- == asEl
1678 -- || context
1679 -- == asParagraph
1680 -- then
1681 -- ( ( key
1682 -- , VirtualDom.text
1683 -- str
1684 -- )
1685 -- :: htmls
1686 -- , existingStyles
1687 -- )
1688 -- else
1689 ( ( key
1690 , if context == asEl then
1691 textElementFill str
1693 else
1694 textElement str
1696 :: htmls
1697 , existingStyles
1700 Empty ->
1701 ( htmls, existingStyles )
1702 in
1703 case children of
1704 Keyed keyedChildren ->
1705 case List.foldr gatherKeyed ( [], [] ) keyedChildren of
1706 ( keyed, styles ) ->
1707 let
1708 newStyles =
1709 if List.isEmpty styles then
1710 rendered.styles
1712 else
1713 rendered.styles ++ styles
1714 in
1715 case newStyles of
1716 [] ->
1717 Unstyled
1718 (finalizeNode rendered.has
1719 rendered.node
1720 rendered.attributes
1721 (Keyed
1722 (addKeyedChildren "nearby-element-pls" keyed rendered.children)
1724 NoStyleSheet
1727 allStyles ->
1728 Styled
1729 { styles = allStyles
1730 , html =
1731 finalizeNode
1732 rendered.has
1733 rendered.node
1734 rendered.attributes
1735 (Keyed
1736 (addKeyedChildren "nearby-element-pls" keyed rendered.children)
1740 Unkeyed unkeyedChildren ->
1741 case List.foldr gather ( [], [] ) unkeyedChildren of
1742 ( unkeyed, styles ) ->
1743 let
1744 newStyles =
1745 if List.isEmpty styles then
1746 rendered.styles
1748 else
1749 rendered.styles ++ styles
1750 in
1751 case newStyles of
1752 [] ->
1753 Unstyled
1754 (finalizeNode
1755 rendered.has
1756 rendered.node
1757 rendered.attributes
1758 (Unkeyed (addChildren unkeyed rendered.children))
1759 NoStyleSheet
1762 allStyles ->
1763 Styled
1764 { styles = allStyles
1765 , html =
1766 finalizeNode
1767 rendered.has
1768 rendered.node
1769 rendered.attributes
1770 (Unkeyed (addChildren unkeyed rendered.children))
1774addChildren existing nearbyChildren =
1775 case nearbyChildren of
1776 NoNearbyChildren ->
1777 existing
1779 ChildrenBehind behind ->
1780 behind ++ existing
1782 ChildrenInFront inFront ->
1783 existing ++ inFront
1785 ChildrenBehindAndInFront behind inFront ->
1786 behind ++ existing ++ inFront
1789addKeyedChildren key existing nearbyChildren =
1790 case nearbyChildren of
1791 NoNearbyChildren ->
1792 existing
1794 ChildrenBehind behind ->
1795 List.map (\x -> ( key, x )) behind ++ existing
1797 ChildrenInFront inFront ->
1798 existing ++ List.map (\x -> ( key, x )) inFront
1800 ChildrenBehindAndInFront behind inFront ->
1801 List.map (\x -> ( key, x )) behind
1802 ++ existing
1803 ++ List.map (\x -> ( key, x )) inFront
1806unit =
1810defaultOptions =
1811 { hover = AllowHover
1812 , focus = focusDefaultStyle
1813 , mode = Layout
1817staticRoot : OptionRecord -> VirtualDom.Node msg
1818staticRoot opts =
1819 case opts.mode of
1820 Layout ->
1821 VirtualDom.node "style" [] [ VirtualDom.text Internal.Style.rules ]
1823 NoStaticStyleSheet ->
1824 VirtualDom.text ""
1826 WithVirtualCss ->
1827 VirtualDom.node "elm-ui-static-rules" [ VirtualDom.property "rules" (Encode.string Internal.Style.rules) ] []
1830addWhen ifThis x to =
1831 if ifThis then
1832 x :: to
1834 else
1835 to
1838{-| TODO:
1840This doesn't reduce equivalent attributes completely.
1843filter : List (Attribute aligned msg) -> List (Attribute aligned msg)
1844filter attrs =
1845 Tuple.first <|
1846 List.foldr
1847 (\x ( found, has ) ->
1848 case x of
1849 NoAttribute ->
1850 ( found, has )
1852 Class key _ ->
1853 ( x :: found, has )
1855 Attr attr ->
1856 ( x :: found, has )
1858 StyleClass _ style ->
1859 ( x :: found, has )
1861 Width width ->
1862 if Set.member "width" has then
1863 ( found, has )
1865 else
1866 ( x :: found, Set.insert "width" has )
1868 Height height ->
1869 if Set.member "height" has then
1870 ( found, has )
1872 else
1873 ( x :: found, Set.insert "height" has )
1875 Describe description ->
1876 if Set.member "described" has then
1877 ( found, has )
1879 else
1880 ( x :: found, Set.insert "described" has )
1882 Nearby location elem ->
1883 ( x :: found, has )
1885 AlignX _ ->
1886 if Set.member "align-x" has then
1887 ( found, has )
1889 else
1890 ( x :: found, Set.insert "align-x" has )
1892 AlignY _ ->
1893 if Set.member "align-y" has then
1894 ( found, has )
1896 else
1897 ( x :: found, Set.insert "align-y" has )
1899 TransformComponent _ _ ->
1900 if Set.member "transform" has then
1901 ( found, has )
1903 else
1904 ( x :: found, Set.insert "transform" has )
1906 ( [], Set.empty )
1907 attrs
1910isContent len =
1911 case len of
1912 Content ->
1913 True
1915 Max _ l ->
1916 isContent l
1918 Min _ l ->
1919 isContent l
1921 _ ->
1922 False
1925get : List (Attribute aligned msg) -> (Attribute aligned msg -> Bool) -> List (Attribute aligned msg)
1926get attrs isAttr =
1927 attrs
1928 |> filter
1929 |> List.foldr
1930 (\x found ->
1931 if isAttr x then
1932 x :: found
1934 else
1935 found
1937 []
1940type Spacing
1941 = Spaced String Int Int
1944type Padding
1945 = Padding String Int Int Int Int
1948extractSpacingAndPadding : List (Attribute aligned msg) -> ( Maybe Padding, Maybe Spacing )
1949extractSpacingAndPadding attrs =
1950 List.foldr
1951 (\attr ( pad, spacing ) ->
1952 ( case pad of
1953 Just x ->
1954 pad
1956 Nothing ->
1957 case attr of
1958 StyleClass _ (PaddingStyle name t r b l) ->
1959 Just (Padding name t r b l)
1961 _ ->
1962 Nothing
1963 , case spacing of
1964 Just x ->
1965 spacing
1967 Nothing ->
1968 case attr of
1969 StyleClass _ (SpacingStyle name x y) ->
1970 Just (Spaced name x y)
1972 _ ->
1973 Nothing
1976 ( Nothing, Nothing )
1977 attrs
1980getSpacing : List (Attribute aligned msg) -> ( Int, Int ) -> ( Int, Int )
1981getSpacing attrs default =
1982 attrs
1983 |> List.foldr
1984 (\attr acc ->
1985 case acc of
1986 Just x ->
1987 Just x
1989 Nothing ->
1990 case attr of
1991 StyleClass _ (SpacingStyle _ x y) ->
1992 Just ( x, y )
1994 _ ->
1995 Nothing
1997 Nothing
1998 |> Maybe.withDefault default
2001getWidth : List (Attribute aligned msg) -> Maybe Length
2002getWidth attrs =
2003 attrs
2004 |> List.foldr
2005 (\attr acc ->
2006 case acc of
2007 Just x ->
2008 Just x
2010 Nothing ->
2011 case attr of
2012 Width len ->
2013 Just len
2015 _ ->
2016 Nothing
2018 Nothing
2021getHeight : List (Attribute aligned msg) -> Maybe Length
2022getHeight attrs =
2023 attrs
2024 |> List.foldr
2025 (\attr acc ->
2026 case acc of
2027 Just x ->
2028 Just x
2030 Nothing ->
2031 case attr of
2032 Height len ->
2033 Just len
2035 _ ->
2036 Nothing
2038 Nothing
2041textElementClasses : String
2042textElementClasses =
2043 classes.any
2044 ++ " "
2045 ++ classes.text
2046 ++ " "
2047 ++ classes.widthContent
2048 ++ " "
2049 ++ classes.heightContent
2052textElement : String -> VirtualDom.Node msg
2053textElement str =
2054 Html.div
2055 [ Html.Attributes.class
2056 textElementClasses
2058 [ Html.text str ]
2061textElementFillClasses : String
2062textElementFillClasses =
2063 classes.any
2064 ++ " "
2065 ++ classes.text
2066 ++ " "
2067 ++ classes.widthFill
2068 ++ " "
2069 ++ classes.heightFill
2072textElementFill : String -> VirtualDom.Node msg
2073textElementFill str =
2074 Html.div
2075 [ Html.Attributes.class
2076 textElementFillClasses
2078 [ Html.text str ]
2081type Children x
2082 = Unkeyed (List x)
2083 | Keyed (List ( String, x ))
2086toHtml mode el =
2087 case el of
2088 Unstyled html ->
2089 html asEl
2091 Styled { styles, html } ->
2092 html (mode styles) asEl
2094 Text text ->
2095 textElement text
2097 Empty ->
2098 textElement ""
2101{-| -}
2102renderRoot : List Option -> List (Attribute aligned msg) -> Element msg -> VirtualDom.Node msg
2103renderRoot optionList attributes child =
2104 let
2105 options =
2106 optionsToRecord optionList
2108 embedStyle =
2109 case options.mode of
2110 NoStaticStyleSheet ->
2111 OnlyDynamic options
2113 _ ->
2114 StaticRootAndDynamic options
2115 in
2116 element asEl div attributes (Unkeyed [ child ])
2117 |> toHtml embedStyle
2120type RenderMode
2121 = Layout
2122 | NoStaticStyleSheet
2123 | WithVirtualCss
2126type alias OptionRecord =
2127 { hover : HoverSetting
2128 , focus : FocusStyle
2129 , mode : RenderMode
2133type HoverSetting
2134 = NoHover
2135 | AllowHover
2136 | ForceHover
2139type Option
2140 = HoverOption HoverSetting
2141 | FocusStyleOption FocusStyle
2142 | RenderModeOption RenderMode
2145type alias FocusStyle =
2146 { borderColor : Maybe Color
2147 , shadow : Maybe Shadow
2148 , backgroundColor : Maybe Color
2152type alias Shadow =
2153 { color : Color
2154 , offset : ( Int, Int )
2155 , blur : Int
2156 , size : Int
2160rootStyle : List (Attribute aligned msg)
2161rootStyle =
2162 let
2163 families =
2164 [ Typeface "Open Sans"
2165 , Typeface "Helvetica"
2166 , Typeface "Verdana"
2167 , SansSerif
2169 in
2170 [ StyleClass Flag.bgColor (Colored ("bg-" ++ formatColorClass (Rgba 1 1 1 0)) "background-color" (Rgba 1 1 1 0))
2171 , StyleClass Flag.fontColor (Colored ("fc-" ++ formatColorClass (Rgba 0 0 0 1)) "color" (Rgba 0 0 0 1))
2172 , StyleClass Flag.fontSize (FontSize 20)
2173 , StyleClass Flag.fontFamily <|
2174 FontFamily (List.foldl renderFontClassName "font-" families)
2175 families
2179renderFontClassName : Font -> String -> String
2180renderFontClassName font current =
2181 current
2182 ++ (case font of
2183 Serif ->
2184 "serif"
2186 SansSerif ->
2187 "sans-serif"
2189 Monospace ->
2190 "monospace"
2192 Typeface name ->
2193 name
2194 |> String.toLower
2195 |> String.words
2196 |> String.join "-"
2198 ImportFont name url ->
2199 name
2200 |> String.toLower
2201 |> String.words
2202 |> String.join "-"
2204 FontWith { name } ->
2205 name
2206 |> String.toLower
2207 |> String.words
2208 |> String.join "-"
2212renderFocusStyle :
2213 FocusStyle
2214 -> List Style
2215renderFocusStyle focus =
2216 [ Style (Internal.Style.dot classes.focusedWithin ++ ":focus-within")
2217 (List.filterMap identity
2218 [ Maybe.map (\color -> Property "border-color" (formatColor color)) focus.borderColor
2219 , Maybe.map (\color -> Property "background-color" (formatColor color)) focus.backgroundColor
2220 , Maybe.map
2221 (\shadow ->
2222 Property "box-shadow"
2223 (formatBoxShadow
2224 { color = shadow.color
2225 , offset =
2226 shadow.offset
2227 |> Tuple.mapFirst toFloat
2228 |> Tuple.mapSecond toFloat
2229 , inset = False
2230 , blur =
2231 toFloat shadow.blur
2232 , size =
2233 toFloat shadow.size
2237 focus.shadow
2238 , Just <| Property "outline" "none"
2241 , Style (Internal.Style.dot classes.any ++ ":focus .focusable, " ++ Internal.Style.dot classes.any ++ ".focusable:focus")
2242 (List.filterMap identity
2243 [ Maybe.map (\color -> Property "border-color" (formatColor color)) focus.borderColor
2244 , Maybe.map (\color -> Property "background-color" (formatColor color)) focus.backgroundColor
2245 , Maybe.map
2246 (\shadow ->
2247 Property "box-shadow"
2248 (formatBoxShadow
2249 { color = shadow.color
2250 , offset =
2251 shadow.offset
2252 |> Tuple.mapFirst toFloat
2253 |> Tuple.mapSecond toFloat
2254 , inset = False
2255 , blur = toFloat shadow.blur
2256 , size = toFloat shadow.size
2260 focus.shadow
2261 , Just <| Property "outline" "none"
2267focusDefaultStyle : { backgroundColor : Maybe Color, borderColor : Maybe Color, shadow : Maybe Shadow }
2268focusDefaultStyle =
2269 { backgroundColor = Nothing
2270 , borderColor = Nothing
2271 , shadow =
2272 Just
2273 { color =
2274 Rgba (155 / 255) (203 / 255) 1 1
2275 , offset = ( 0, 0 )
2276 , blur = 0
2277 , size = 3
2282optionsToRecord : List Option -> OptionRecord
2283optionsToRecord options =
2284 let
2285 combine opt record =
2286 case opt of
2287 HoverOption hoverable ->
2288 case record.hover of
2289 Nothing ->
2290 { record | hover = Just hoverable }
2292 _ ->
2293 record
2295 FocusStyleOption focusStyle ->
2296 case record.focus of
2297 Nothing ->
2298 { record | focus = Just focusStyle }
2300 _ ->
2301 record
2303 RenderModeOption renderMode ->
2304 case record.mode of
2305 Nothing ->
2306 { record | mode = Just renderMode }
2308 _ ->
2309 record
2311 andFinally record =
2312 { hover =
2313 case record.hover of
2314 Nothing ->
2315 AllowHover
2317 Just hoverable ->
2318 hoverable
2319 , focus =
2320 case record.focus of
2321 Nothing ->
2322 focusDefaultStyle
2324 Just focusable ->
2325 focusable
2326 , mode =
2327 case record.mode of
2328 Nothing ->
2329 Layout
2331 Just actualMode ->
2332 actualMode
2334 in
2335 andFinally <|
2336 List.foldr combine
2337 { hover = Nothing
2338 , focus = Nothing
2339 , mode = Nothing
2341 options
2344toStyleSheet : OptionRecord -> List Style -> VirtualDom.Node msg
2345toStyleSheet options styleSheet =
2346 case options.mode of
2347 Layout ->
2348 VirtualDom.node "style" [] [ VirtualDom.text (toStyleSheetString options styleSheet) ]
2350 NoStaticStyleSheet ->
2351 VirtualDom.node "style" [] [ VirtualDom.text (toStyleSheetString options styleSheet) ]
2353 WithVirtualCss ->
2354 VirtualDom.node "elm-ui-rules"
2355 [ VirtualDom.property "rules"
2356 (encodeStyles options styleSheet)
2358 []
2361renderTopLevelValues rules =
2362 let
2363 withImport font =
2364 case font of
2365 ImportFont _ url ->
2366 Just ("@import url('" ++ url ++ "');")
2368 -- FontWith with ->
2369 -- case with.url of
2370 -- Just x ->
2371 -- Just ("@import url('" ++ x ++ "');")
2372 -- Nothing ->
2373 -- Nothing
2374 _ ->
2375 Nothing
2377 allNames =
2378 List.map Tuple.first rules
2380 fontImports ( name, typefaces ) =
2381 let
2382 imports =
2383 String.join "\n" (List.filterMap withImport typefaces)
2384 in
2385 imports
2387 fontAdjustments ( name, typefaces ) =
2388 case typefaceAdjustment typefaces of
2389 Nothing ->
2390 String.join ""
2391 (List.map (renderNullAdjustmentRule name) allNames)
2393 Just adjustment ->
2394 String.join ""
2395 (List.map (renderFontAdjustmentRule name adjustment) allNames)
2396 in
2397 String.join "\n" (List.map fontImports rules)
2398 ++ String.join "\n" (List.map fontAdjustments rules)
2401renderNullAdjustmentRule fontToAdjust otherFontName =
2402 let
2403 name =
2404 if fontToAdjust == otherFontName then
2405 fontToAdjust
2407 else
2408 otherFontName ++ " ." ++ fontToAdjust
2409 in
2410 String.join " "
2411 [ bracket
2412 ("."
2413 ++ name
2414 ++ "."
2415 ++ classes.sizeByCapital
2416 ++ ", "
2417 ++ "."
2418 ++ name
2419 ++ " ."
2420 ++ classes.sizeByCapital
2422 [ ( "line-height", "1" )
2424 , bracket
2425 ("."
2426 ++ name
2427 ++ "."
2428 ++ classes.sizeByCapital
2429 ++ "> ."
2430 ++ Internal.Style.classes.text
2431 ++ ", ."
2432 ++ name
2433 ++ " ."
2434 ++ classes.sizeByCapital
2435 ++ " > ."
2436 ++ Internal.Style.classes.text
2438 [ ( "vertical-align", "0" )
2439 , ( "line-height", "1" )
2444fontRule name modifier ( parentAdj, textAdjustment ) =
2445 [ bracket
2446 ("."
2447 ++ name
2448 ++ "."
2449 ++ modifier
2450 ++ ", "
2451 ++ "."
2452 ++ name
2453 ++ " ."
2454 ++ modifier
2456 parentAdj
2457 , bracket
2458 ("."
2459 ++ name
2460 ++ "."
2461 ++ modifier
2462 ++ "> ."
2463 ++ Internal.Style.classes.text
2464 ++ ", ."
2465 ++ name
2466 ++ " ."
2467 ++ modifier
2468 ++ " > ."
2469 ++ Internal.Style.classes.text
2471 textAdjustment
2475renderFontAdjustmentRule fontToAdjust ( full, capital ) otherFontName =
2476 let
2477 name =
2478 if fontToAdjust == otherFontName then
2479 fontToAdjust
2481 else
2482 otherFontName ++ " ." ++ fontToAdjust
2483 in
2484 String.join " "
2485 (fontRule name classes.sizeByCapital capital ++ fontRule name classes.fullSize full)
2488bracket selector rules =
2489 let
2490 renderPair ( name, val ) =
2491 name ++ ": " ++ val ++ ";"
2492 in
2493 selector ++ " {" ++ String.join "" (List.map renderPair rules) ++ "}"
2496fontAdjustmentRules converted =
2497 ( [ ( "display", "block" )
2499 , [ ( "display", "inline-block" )
2500 , ( "line-height", String.fromFloat converted.height )
2501 , ( "vertical-align", String.fromFloat converted.vertical ++ "em" )
2502 , ( "font-size", String.fromFloat converted.size ++ "em" )
2507typefaceAdjustment typefaces =
2508 List.foldl
2509 (\face found ->
2510 case found of
2511 Nothing ->
2512 case face of
2513 FontWith with ->
2514 case with.adjustment of
2515 Nothing ->
2516 found
2518 Just adjustment ->
2519 Just
2520 ( fontAdjustmentRules
2521 (.full (convertAdjustment adjustment))
2522 , fontAdjustmentRules
2523 (.capital (convertAdjustment adjustment))
2526 _ ->
2527 found
2529 Just _ ->
2530 found
2532 Nothing
2533 typefaces
2536fontName font =
2537 case font of
2538 Serif ->
2539 "serif"
2541 SansSerif ->
2542 "sans-serif"
2544 Monospace ->
2545 "monospace"
2547 Typeface name ->
2548 "\"" ++ name ++ "\""
2550 ImportFont name url ->
2551 "\"" ++ name ++ "\""
2553 FontWith { name } ->
2554 "\"" ++ name ++ "\""
2557topLevelValue rule =
2558 case rule of
2559 FontFamily name typefaces ->
2560 Just ( name, typefaces )
2562 _ ->
2563 Nothing
2566renderProps force (Property key val) existing =
2567 if force then
2568 existing ++ "\n " ++ key ++ ": " ++ val ++ " !important;"
2570 else
2571 existing ++ "\n " ++ key ++ ": " ++ val ++ ";"
2574encodeStyles options stylesheet =
2575 stylesheet
2576 |> List.map
2577 (\style ->
2578 let
2579 styled =
2580 renderStyleRule options style Nothing
2581 in
2582 ( getStyleName style, Encode.list Encode.string styled )
2584 |> Encode.object
2587toStyleSheetString : OptionRecord -> List Style -> String
2588toStyleSheetString options stylesheet =
2589 let
2590 combine style rendered =
2591 { rules = rendered.rules ++ renderStyleRule options style Nothing
2592 , topLevel =
2593 case topLevelValue style of
2594 Nothing ->
2595 rendered.topLevel
2597 Just topLevel ->
2598 topLevel :: rendered.topLevel
2600 in
2601 case List.foldl combine { topLevel = [], rules = [] } stylesheet of
2602 { topLevel, rules } ->
2603 renderTopLevelValues topLevel ++ String.concat rules
2606renderStyle : OptionRecord -> Maybe PseudoClass -> String -> List Property -> List String
2607renderStyle options maybePseudo selector props =
2608 case maybePseudo of
2609 Nothing ->
2610 [ selector ++ "{" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2612 Just pseudo ->
2613 case pseudo of
2614 Hover ->
2615 case options.hover of
2616 NoHover ->
2617 []
2619 ForceHover ->
2620 [ selector ++ "-hv {" ++ List.foldl (renderProps True) "" props ++ "\n}" ]
2622 AllowHover ->
2623 [ selector ++ "-hv:hover {" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2625 Focus ->
2626 let
2627 renderedProps =
2628 List.foldl (renderProps False) "" props
2629 in
2630 [ selector
2631 ++ "-fs:focus {"
2632 ++ renderedProps
2633 ++ "\n}"
2634 , "."
2635 ++ classes.any
2636 ++ ":focus ~ "
2637 ++ selector
2638 ++ "-fs:not(.focus) {"
2639 ++ renderedProps
2640 ++ "\n}"
2641 , "."
2642 ++ classes.any
2643 ++ ":focus "
2644 ++ selector
2645 ++ "-fs {"
2646 ++ renderedProps
2647 ++ "\n}"
2648 , ".focusable-parent:focus ~ "
2649 ++ "."
2650 ++ classes.any
2651 ++ " "
2652 ++ selector
2653 ++ "-fs {"
2654 ++ renderedProps
2655 ++ "\n}"
2658 Active ->
2659 [ selector ++ "-act:active {" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2662renderStyleRule : OptionRecord -> Style -> Maybe PseudoClass -> List String
2663renderStyleRule options rule maybePseudo =
2664 case rule of
2665 Style selector props ->
2666 renderStyle options maybePseudo selector props
2668 Shadows name prop ->
2669 renderStyle options
2670 maybePseudo
2671 ("." ++ name)
2672 [ Property "box-shadow" prop
2675 Transparency name transparency ->
2676 let
2677 opacity =
2678 (1 - transparency)
2679 |> min 1
2680 |> max 0
2681 in
2682 renderStyle options
2683 maybePseudo
2684 ("." ++ name)
2685 [ Property "opacity" (String.fromFloat opacity)
2688 FontSize i ->
2689 renderStyle options
2690 maybePseudo
2691 (".font-size-" ++ String.fromInt i)
2692 [ Property "font-size" (String.fromInt i ++ "px")
2695 FontFamily name typefaces ->
2696 let
2697 features =
2698 typefaces
2699 |> List.filterMap renderVariants
2700 |> String.join ", "
2702 families =
2703 [ Property "font-family"
2704 (typefaces
2705 |> List.map fontName
2706 |> String.join ", "
2708 , Property "font-feature-settings" features
2709 , Property "font-variant"
2710 (if List.any hasSmallCaps typefaces then
2711 "small-caps"
2713 else
2714 "normal"
2717 in
2718 renderStyle options
2719 maybePseudo
2720 ("." ++ name)
2721 families
2723 Single class prop val ->
2724 renderStyle options
2725 maybePseudo
2726 ("." ++ class)
2727 [ Property prop val
2730 Colored class prop color ->
2731 renderStyle options
2732 maybePseudo
2733 ("." ++ class)
2734 [ Property prop (formatColor color)
2737 SpacingStyle cls x y ->
2738 let
2739 class =
2740 "." ++ cls
2742 halfX =
2743 String.fromFloat (toFloat x / 2) ++ "px"
2745 halfY =
2746 String.fromFloat (toFloat y / 2) ++ "px"
2748 xPx =
2749 String.fromInt x ++ "px"
2751 yPx =
2752 String.fromInt y ++ "px"
2754 row =
2755 "." ++ Internal.Style.classes.row
2757 wrappedRow =
2758 "." ++ Internal.Style.classes.wrapped ++ row
2760 column =
2761 "." ++ Internal.Style.classes.column
2763 page =
2764 "." ++ Internal.Style.classes.page
2766 paragraph =
2767 "." ++ Internal.Style.classes.paragraph
2769 left =
2770 "." ++ Internal.Style.classes.alignLeft
2772 right =
2773 "." ++ Internal.Style.classes.alignRight
2775 any =
2776 "." ++ Internal.Style.classes.any
2778 single =
2779 "." ++ Internal.Style.classes.single
2780 in
2781 List.concat
2782 [ renderStyle options maybePseudo (class ++ row ++ " > " ++ any ++ " + " ++ any) [ Property "margin-left" xPx ]
2784 -- margins don't apply to last element of normal, unwrapped rows
2785 -- , renderStyle options maybePseudo (class ++ row ++ " > " ++ any ++ ":first-child") [ Property "margin" "0" ]
2786 -- For wrapped rows, margins always apply because we handle "canceling out" the other margins manually in the element.
2787 , renderStyle options
2788 maybePseudo
2789 (class ++ wrappedRow ++ " > " ++ any)
2790 [ Property "margin" (halfY ++ " " ++ halfX)
2793 -- , renderStyle options maybePseudo
2794 -- (class ++ wrappedRow ++ " > " ++ any ++ ":last-child")
2795 -- [ Property "margin-right" "0"
2796 -- ]
2797 -- columns
2798 , renderStyle options maybePseudo (class ++ column ++ " > " ++ any ++ " + " ++ any) [ Property "margin-top" yPx ]
2799 , renderStyle options maybePseudo (class ++ page ++ " > " ++ any ++ " + " ++ any) [ Property "margin-top" yPx ]
2800 , renderStyle options maybePseudo (class ++ page ++ " > " ++ left) [ Property "margin-right" xPx ]
2801 , renderStyle options maybePseudo (class ++ page ++ " > " ++ right) [ Property "margin-left" xPx ]
2802 , renderStyle options
2803 maybePseudo
2804 (class ++ paragraph)
2805 [ Property "line-height" ("calc(1em + " ++ String.fromInt y ++ "px)")
2807 , renderStyle options
2808 maybePseudo
2809 ("textarea" ++ any ++ class)
2810 [ Property "line-height" ("calc(1em + " ++ String.fromInt y ++ "px)")
2811 , Property "height" ("calc(100% + " ++ String.fromInt y ++ "px)")
2814 -- , renderStyle options
2815 -- maybePseudo
2816 -- (class ++ paragraph ++ " > " ++ any)
2817 -- [ Property "margin-right" xPx
2818 -- , Property "margin-bottom" yPx
2819 -- ]
2820 , renderStyle options
2821 maybePseudo
2822 (class ++ paragraph ++ " > " ++ left)
2823 [ Property "margin-right" xPx
2825 , renderStyle options
2826 maybePseudo
2827 (class ++ paragraph ++ " > " ++ right)
2828 [ Property "margin-left" xPx
2830 , renderStyle options
2831 maybePseudo
2832 (class ++ paragraph ++ "::after")
2833 [ Property "content" "''"
2834 , Property "display" "block"
2835 , Property "height" "0"
2836 , Property "width" "0"
2837 , Property "margin-top" (String.fromInt (-1 * (y // 2)) ++ "px")
2839 , renderStyle options
2840 maybePseudo
2841 (class ++ paragraph ++ "::before")
2842 [ Property "content" "''"
2843 , Property "display" "block"
2844 , Property "height" "0"
2845 , Property "width" "0"
2846 , Property "margin-bottom" (String.fromInt (-1 * (y // 2)) ++ "px")
2850 PaddingStyle cls top right bottom left ->
2851 let
2852 class =
2853 "."
2854 ++ cls
2855 in
2856 renderStyle options
2857 maybePseudo
2858 class
2859 [ Property "padding"
2860 (String.fromInt top
2861 ++ "px "
2862 ++ String.fromInt right
2863 ++ "px "
2864 ++ String.fromInt bottom
2865 ++ "px "
2866 ++ String.fromInt left
2867 ++ "px"
2871 BorderWidth cls top right bottom left ->
2872 let
2873 class =
2874 "."
2875 ++ cls
2876 in
2877 renderStyle options
2878 maybePseudo
2879 class
2880 [ Property "border-width"
2881 (String.fromInt top
2882 ++ "px "
2883 ++ String.fromInt right
2884 ++ "px "
2885 ++ String.fromInt bottom
2886 ++ "px "
2887 ++ String.fromInt left
2888 ++ "px"
2892 GridTemplateStyle template ->
2893 let
2894 class =
2895 ".grid-rows-"
2896 ++ String.join "-" (List.map lengthClassName template.rows)
2897 ++ "-cols-"
2898 ++ String.join "-" (List.map lengthClassName template.columns)
2899 ++ "-space-x-"
2900 ++ lengthClassName (Tuple.first template.spacing)
2901 ++ "-space-y-"
2902 ++ lengthClassName (Tuple.second template.spacing)
2904 ySpacing =
2905 toGridLength (Tuple.second template.spacing)
2907 xSpacing =
2908 toGridLength (Tuple.first template.spacing)
2910 toGridLength x =
2911 toGridLengthHelper Nothing Nothing x
2913 toGridLengthHelper minimum maximum x =
2914 case x of
2915 Px px ->
2916 String.fromInt px ++ "px"
2918 Content ->
2919 case ( minimum, maximum ) of
2920 ( Nothing, Nothing ) ->
2921 "max-content"
2923 ( Just minSize, Nothing ) ->
2924 "minmax(" ++ String.fromInt minSize ++ "px, " ++ "max-content)"
2926 ( Nothing, Just maxSize ) ->
2927 "minmax(max-content, " ++ String.fromInt maxSize ++ "px)"
2929 ( Just minSize, Just maxSize ) ->
2930 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt maxSize ++ "px)"
2932 Fill i ->
2933 case ( minimum, maximum ) of
2934 ( Nothing, Nothing ) ->
2935 String.fromInt i ++ "fr"
2937 ( Just minSize, Nothing ) ->
2938 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt i ++ "fr" ++ "fr)"
2940 ( Nothing, Just maxSize ) ->
2941 "minmax(max-content, " ++ String.fromInt maxSize ++ "px)"
2943 ( Just minSize, Just maxSize ) ->
2944 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt maxSize ++ "px)"
2946 Min m len ->
2947 toGridLengthHelper (Just m) maximum len
2949 Max m len ->
2950 toGridLengthHelper minimum (Just m) len
2952 msColumns =
2953 template.columns
2954 |> List.map toGridLength
2955 |> String.join ySpacing
2956 |> (\x -> "-ms-grid-columns: " ++ x ++ ";")
2958 msRows =
2959 template.columns
2960 |> List.map toGridLength
2961 |> String.join ySpacing
2962 |> (\x -> "-ms-grid-rows: " ++ x ++ ";")
2964 base =
2965 class ++ "{" ++ msColumns ++ msRows ++ "}"
2967 columns =
2968 template.columns
2969 |> List.map toGridLength
2970 |> String.join " "
2971 |> (\x -> "grid-template-columns: " ++ x ++ ";")
2973 rows =
2974 template.rows
2975 |> List.map toGridLength
2976 |> String.join " "
2977 |> (\x -> "grid-template-rows: " ++ x ++ ";")
2979 gapX =
2980 "grid-column-gap:" ++ toGridLength (Tuple.first template.spacing) ++ ";"
2982 gapY =
2983 "grid-row-gap:" ++ toGridLength (Tuple.second template.spacing) ++ ";"
2985 modernGrid =
2986 class ++ "{" ++ columns ++ rows ++ gapX ++ gapY ++ "}"
2988 supports =
2989 "@supports (display:grid) {" ++ modernGrid ++ "}"
2990 in
2991 [ base
2992 , supports
2995 GridPosition position ->
2996 let
2997 class =
2998 ".grid-pos-"
2999 ++ String.fromInt position.row
3000 ++ "-"
3001 ++ String.fromInt position.col
3002 ++ "-"
3003 ++ String.fromInt position.width
3004 ++ "-"
3005 ++ String.fromInt position.height
3007 msPosition =
3008 String.join " "
3009 [ "-ms-grid-row: "
3010 ++ String.fromInt position.row
3011 ++ ";"
3012 , "-ms-grid-row-span: "
3013 ++ String.fromInt position.height
3014 ++ ";"
3015 , "-ms-grid-column: "
3016 ++ String.fromInt position.col
3017 ++ ";"
3018 , "-ms-grid-column-span: "
3019 ++ String.fromInt position.width
3020 ++ ";"
3023 base =
3024 class ++ "{" ++ msPosition ++ "}"
3026 modernPosition =
3027 String.join " "
3028 [ "grid-row: "
3029 ++ String.fromInt position.row
3030 ++ " / "
3031 ++ String.fromInt (position.row + position.height)
3032 ++ ";"
3033 , "grid-column: "
3034 ++ String.fromInt position.col
3035 ++ " / "
3036 ++ String.fromInt (position.col + position.width)
3037 ++ ";"
3040 modernGrid =
3041 class ++ "{" ++ modernPosition ++ "}"
3043 supports =
3044 "@supports (display:grid) {" ++ modernGrid ++ "}"
3045 in
3046 [ base
3047 , supports
3050 PseudoSelector class styles ->
3051 let
3052 renderPseudoRule style =
3053 renderStyleRule options style (Just class)
3054 in
3055 List.concatMap renderPseudoRule styles
3057 Transform transform ->
3058 let
3059 val =
3060 transformValue transform
3062 class =
3063 transformClass transform
3064 in
3065 case ( class, val ) of
3066 ( Just cls, Just v ) ->
3067 renderStyle options
3068 maybePseudo
3069 ("." ++ cls)
3070 [ Property "transform"
3074 _ ->
3075 []
3078lengthClassName : Length -> String
3079lengthClassName x =
3080 case x of
3081 Px px ->
3082 String.fromInt px ++ "px"
3084 Content ->
3085 "auto"
3087 Fill i ->
3088 String.fromInt i ++ "fr"
3090 Min min len ->
3091 "min" ++ String.fromInt min ++ lengthClassName len
3093 Max max len ->
3094 "max" ++ String.fromInt max ++ lengthClassName len
3097formatDropShadow shadow =
3098 String.join " "
3099 [ String.fromFloat (Tuple.first shadow.offset) ++ "px"
3100 , String.fromFloat (Tuple.second shadow.offset) ++ "px"
3101 , String.fromFloat shadow.blur ++ "px"
3102 , formatColor shadow.color
3106formatTextShadow shadow =
3107 String.join " "
3108 [ String.fromFloat (Tuple.first shadow.offset) ++ "px"
3109 , String.fromFloat (Tuple.second shadow.offset) ++ "px"
3110 , String.fromFloat shadow.blur ++ "px"
3111 , formatColor shadow.color
3115textShadowClass shadow =
3116 String.concat
3117 [ "txt"
3118 , floatClass (Tuple.first shadow.offset) ++ "px"
3119 , floatClass (Tuple.second shadow.offset) ++ "px"
3120 , floatClass shadow.blur ++ "px"
3121 , formatColorClass shadow.color
3125formatBoxShadow shadow =
3126 String.join " " <|
3127 List.filterMap identity
3128 [ if shadow.inset then
3129 Just "inset"
3131 else
3132 Nothing
3133 , Just <| String.fromFloat (Tuple.first shadow.offset) ++ "px"
3134 , Just <| String.fromFloat (Tuple.second shadow.offset) ++ "px"
3135 , Just <| String.fromFloat shadow.blur ++ "px"
3136 , Just <| String.fromFloat shadow.size ++ "px"
3137 , Just <| formatColor shadow.color
3141boxShadowClass shadow =
3142 String.concat <|
3143 [ if shadow.inset then
3144 "box-inset"
3146 else
3147 "box-"
3148 , floatClass (Tuple.first shadow.offset) ++ "px"
3149 , floatClass (Tuple.second shadow.offset) ++ "px"
3150 , floatClass shadow.blur ++ "px"
3151 , floatClass shadow.size ++ "px"
3152 , formatColorClass shadow.color
3156floatClass : Float -> String
3157floatClass x =
3158 String.fromInt (round (x * 255))
3161formatColor : Color -> String
3162formatColor (Rgba red green blue alpha) =
3163 "rgba("
3164 ++ String.fromInt (round (red * 255))
3165 ++ ("," ++ String.fromInt (round (green * 255)))
3166 ++ ("," ++ String.fromInt (round (blue * 255)))
3167 ++ ("," ++ String.fromFloat alpha ++ ")")
3170formatColorClass : Color -> String
3171formatColorClass (Rgba red green blue alpha) =
3172 floatClass red
3173 ++ "-"
3174 ++ floatClass green
3175 ++ "-"
3176 ++ floatClass blue
3177 ++ "-"
3178 ++ floatClass alpha
3181spacingName x y =
3182 "spacing-" ++ String.fromInt x ++ "-" ++ String.fromInt y
3185paddingName top right bottom left =
3186 "pad-"
3187 ++ String.fromInt top
3188 ++ "-"
3189 ++ String.fromInt right
3190 ++ "-"
3191 ++ String.fromInt bottom
3192 ++ "-"
3193 ++ String.fromInt left
3196getStyleName : Style -> String
3197getStyleName style =
3198 case style of
3199 Shadows name _ ->
3200 name
3202 Transparency name o ->
3203 name
3205 Style class _ ->
3206 class
3208 FontFamily name _ ->
3209 name
3211 FontSize i ->
3212 "font-size-" ++ String.fromInt i
3214 Single class _ _ ->
3215 class
3217 Colored class _ _ ->
3218 class
3220 SpacingStyle cls x y ->
3221 cls
3223 PaddingStyle cls top right bottom left ->
3224 cls
3226 BorderWidth cls top right bottom left ->
3227 cls
3229 GridTemplateStyle template ->
3230 "grid-rows-"
3231 ++ String.join "-" (List.map lengthClassName template.rows)
3232 ++ "-cols-"
3233 ++ String.join "-" (List.map lengthClassName template.columns)
3234 ++ "-space-x-"
3235 ++ lengthClassName (Tuple.first template.spacing)
3236 ++ "-space-y-"
3237 ++ lengthClassName (Tuple.second template.spacing)
3239 GridPosition pos ->
3240 "gp grid-pos-"
3241 ++ String.fromInt pos.row
3242 ++ "-"
3243 ++ String.fromInt pos.col
3244 ++ "-"
3245 ++ String.fromInt pos.width
3246 ++ "-"
3247 ++ String.fromInt pos.height
3249 PseudoSelector selector subStyle ->
3250 let
3251 name =
3252 case selector of
3253 Focus ->
3254 "fs"
3256 Hover ->
3257 "hv"
3259 Active ->
3260 "act"
3261 in
3262 List.map
3263 (\sty ->
3264 case getStyleName sty of
3265 "" ->
3266 ""
3268 styleName ->
3269 styleName ++ "-" ++ name
3271 subStyle
3272 |> String.join " "
3274 Transform x ->
3275 Maybe.withDefault "" (transformClass x)
3279{- Constants -}
3282asGrid : LayoutContext
3283asGrid =
3284 AsGrid
3287asRow : LayoutContext
3288asRow =
3289 AsRow
3292asColumn : LayoutContext
3293asColumn =
3294 AsColumn
3297asEl : LayoutContext
3298asEl =
3299 AsEl
3302asParagraph : LayoutContext
3303asParagraph =
3304 AsParagraph
3307asTextColumn : LayoutContext
3308asTextColumn =
3309 AsTextColumn
3313{- Mapping -}
3316map : (msg -> msg1) -> Element msg -> Element msg1
3317map fn el =
3318 case el of
3319 Styled styled ->
3320 Styled
3321 { styles = styled.styles
3322 , html = \add context -> VirtualDom.map fn <| styled.html add context
3325 Unstyled html ->
3326 Unstyled (VirtualDom.map fn << html)
3328 Text str ->
3329 Text str
3331 Empty ->
3332 Empty
3335mapAttr : (msg -> msg1) -> Attribute aligned msg -> Attribute aligned msg1
3336mapAttr fn attr =
3337 case attr of
3338 NoAttribute ->
3339 NoAttribute
3341 Describe description ->
3342 Describe description
3344 AlignX x ->
3345 AlignX x
3347 AlignY y ->
3348 AlignY y
3350 Width x ->
3351 Width x
3353 Height x ->
3354 Height x
3356 Class x y ->
3357 Class x y
3359 StyleClass flag style ->
3360 StyleClass flag style
3362 Nearby location elem ->
3363 Nearby location (map fn elem)
3365 Attr htmlAttr ->
3366 Attr (VirtualDom.mapAttribute fn htmlAttr)
3368 TransformComponent fl trans ->
3369 TransformComponent fl trans
3372mapAttrFromStyle : (msg -> msg1) -> Attribute Never msg -> Attribute () msg1
3373mapAttrFromStyle fn attr =
3374 case attr of
3375 NoAttribute ->
3376 NoAttribute
3378 Describe description ->
3379 Describe description
3381 AlignX x ->
3382 AlignX x
3384 AlignY y ->
3385 AlignY y
3387 Width x ->
3388 Width x
3390 Height x ->
3391 Height x
3393 -- invalidation key "border-color" as opposed to "border-color-10-10-10" that will be the key for the class
3394 Class x y ->
3395 Class x y
3397 StyleClass flag style ->
3398 StyleClass flag style
3400 Nearby location elem ->
3401 Nearby location (map fn elem)
3403 Attr htmlAttr ->
3404 Attr (VirtualDom.mapAttribute fn htmlAttr)
3406 TransformComponent fl trans ->
3407 TransformComponent fl trans
3410unwrapDecorations : List (Attribute Never Never) -> List Style
3411unwrapDecorations attrs =
3412 case List.foldl unwrapDecsHelper ( [], Untransformed ) attrs of
3413 ( styles, transform ) ->
3414 Transform transform :: styles
3417unwrapDecsHelper attr ( styles, trans ) =
3418 case removeNever attr of
3419 StyleClass _ style ->
3420 ( style :: styles, trans )
3422 TransformComponent flag component ->
3423 ( styles, composeTransformation trans component )
3425 _ ->
3426 ( styles, trans )
3429removeNever : Attribute Never Never -> Attribute () msg
3430removeNever style =
3431 mapAttrFromStyle Basics.never style
3434tag : String -> Style -> Style
3435tag label style =
3436 case style of
3437 Single class prop val ->
3438 Single (label ++ "-" ++ class) prop val
3440 Colored class prop val ->
3441 Colored (label ++ "-" ++ class) prop val
3443 Style class props ->
3444 Style (label ++ "-" ++ class) props
3446 Transparency class o ->
3447 Transparency (label ++ "-" ++ class) o
3449 x ->
3453onlyStyles : Attribute aligned msg -> Maybe Style
3454onlyStyles attr =
3455 case attr of
3456 StyleClass _ style ->
3457 Just style
3459 _ ->
3460 Nothing
3464{- Font Adjustments -}
3467convertAdjustment adjustment =
3468 let
3469 lineHeight =
3470 1.5
3472 base =
3473 lineHeight
3475 normalDescender =
3476 (lineHeight - 1)
3477 / 2
3479 oldMiddle =
3480 lineHeight / 2
3482 newCapitalMiddle =
3483 ((ascender - newBaseline) / 2) + newBaseline
3485 newFullMiddle =
3486 ((ascender - descender) / 2) + descender
3488 lines =
3489 [ adjustment.capital
3490 , adjustment.baseline
3491 , adjustment.descender
3492 , adjustment.lowercase
3495 ascender =
3496 Maybe.withDefault adjustment.capital (List.maximum lines)
3498 descender =
3499 Maybe.withDefault adjustment.descender (List.minimum lines)
3501 newBaseline =
3502 lines
3503 |> List.filter (\x -> x /= descender)
3504 |> List.minimum
3505 |> Maybe.withDefault adjustment.baseline
3507 capitalVertical =
3508 1 - ascender
3510 capitalSize =
3511 1 / (ascender - newBaseline)
3513 fullSize =
3514 1 / (ascender - descender)
3516 fullVertical =
3517 1 - ascender
3519 -- (oldMiddle - newFullMiddle) * 2
3520 in
3521 { full =
3522 adjust fullSize (ascender - descender) fullVertical
3523 , capital =
3524 adjust capitalSize (ascender - newBaseline) capitalVertical
3528adjust size height vertical =
3529 { vertical = vertical
3530 , height =
3531 height / size
3532 , size = size