git.iko.soy/typeable/elm-ui
on master help sign in
typeable/elm-ui/src/Internal/Model.elm
3550 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 , paddingNameFloat
83 , pageClass
84 , paragraphClass
85 , reduceRecursive
86 , reduceStyles
87 , reduceStylesRecursive
88 , removeNever
89 , renderFontClassName
90 , renderHeight
91 , renderRoot
92 , renderVariant
93 , renderWidth
94 , rootStyle
95 , rowClass
96 , singleClass
97 , spacingName
98 , tag
99 , textShadowClass
100 , toHtml
101 , toStyleSheet
102 , transformClass
103 , unstyled
104 , unwrapDecorations
105 , variantName
106 )
108{-| -}
110import Html
111import Html.Attributes
112import Html.Keyed
113import Internal.Flag as Flag exposing (Flag)
114import Internal.Style exposing (classes, dot)
115import Json.Encode as Encode
116import Set exposing (Set)
117import VirtualDom
120type Element msg
121 = Unstyled (LayoutContext -> VirtualDom.Node msg)
122 | Styled
123 { styles : List Style
124 , html : EmbedStyle -> LayoutContext -> VirtualDom.Node msg
125 }
126 | Text String
127 | Empty
130type EmbedStyle
131 = NoStyleSheet
132 | StaticRootAndDynamic OptionRecord (List Style)
133 | OnlyDynamic OptionRecord (List Style)
136noStyleSheet : EmbedStyle
137noStyleSheet =
138 NoStyleSheet
141type LayoutContext
142 = AsRow
143 | AsColumn
144 | AsEl
145 | AsGrid
146 | AsParagraph
147 | AsTextColumn
150type Aligned
151 = Unaligned
152 | Aligned (Maybe HAlign) (Maybe VAlign)
155type HAlign
156 = Left
157 | CenterX
158 | Right
161type VAlign
162 = Top
163 | CenterY
164 | Bottom
167type Style
168 = Style String (List Property)
169 -- class prop val
170 | FontFamily String (List Font)
171 | FontSize Int
172 -- classname, prop, value
173 | Single String String String
174 | Colored String String Color
175 | SpacingStyle String Int Int
176 | BorderWidth String Int Int Int Int
177 | PaddingStyle String Float Float Float Float
178 | GridTemplateStyle
179 { spacing : ( Length, Length )
180 , columns : List Length
181 , rows : List Length
182 }
183 | GridPosition
184 { row : Int
185 , col : Int
186 , width : Int
187 , height : Int
188 }
189 | Transform Transformation
190 | PseudoSelector PseudoClass (List Style)
191 | Transparency String Float
192 | Shadows String String
195type Transformation
196 = Untransformed
197 | Moved XYZ
198 -- translate, scale, rotate
199 | FullTransform XYZ XYZ XYZ Angle
202type PseudoClass
203 = Focus
204 | Hover
205 | Active
208{-| -}
209type alias Adjustment =
210 { capital : Float
211 , lowercase : Float
212 , baseline : Float
213 , descender : Float
214 }
217type Font
218 = Serif
219 | SansSerif
220 | Monospace
221 | Typeface String
222 | ImportFont String String
223 | FontWith
224 { name : String
225 , adjustment : Maybe Adjustment
226 , variants : List Variant
227 }
230type Variant
231 = VariantActive String
232 | VariantOff String
233 | VariantIndexed String Int
236renderVariant var =
237 case var of
238 VariantActive name ->
239 "\"" ++ name ++ "\""
241 VariantOff name ->
242 "\"" ++ name ++ "\" 0"
244 VariantIndexed name index ->
245 "\"" ++ name ++ "\" " ++ String.fromInt index
248variantName var =
249 case var of
250 VariantActive name ->
251 name
253 VariantOff name ->
254 name ++ "-0"
256 VariantIndexed name index ->
257 name ++ "-" ++ String.fromInt index
260renderVariants typeface =
261 case typeface of
262 FontWith font ->
263 Just (String.join ", " (List.map renderVariant font.variants))
265 _ ->
266 Nothing
269isSmallCaps var =
270 case var of
271 VariantActive name ->
272 name == "smcp"
274 VariantOff name ->
275 False
277 VariantIndexed name index ->
278 name == "smcp" && index == 1
281hasSmallCaps typeface =
282 case typeface of
283 FontWith font ->
284 List.any isSmallCaps font.variants
286 _ ->
287 False
290type Property
291 = Property String String
294type alias XYZ =
295 ( Float, Float, Float )
298type alias Angle =
299 Float
302type Attribute aligned msg
303 = NoAttribute
304 | Attr (VirtualDom.Attribute msg)
305 | Describe Description
306 -- invalidation key and literal class
307 | Class Flag String
308 -- invalidation key "border-color" as opposed to "border-color-10-10-10" that will be the key for the class
309 | StyleClass Flag Style
310 | AlignY VAlign
311 | AlignX HAlign
312 | Width Length
313 | Height Length
314 | Nearby Location (Element msg)
315 | TransformComponent Flag TransformComponent
318type TransformComponent
319 = MoveX Float
320 | MoveY Float
321 | MoveZ Float
322 | MoveXYZ XYZ
323 | Rotate XYZ Float
324 | Scale XYZ
327type Description
328 = Main
329 | Navigation
330 -- | Search
331 | ContentInfo
332 | Complementary
333 | Heading Int
334 | Label String
335 | LivePolite
336 | LiveAssertive
337 | Button
338 | Paragraph
341type Length
342 = Px Int
343 | Content
344 | Fill Int
345 | Min Int Length
346 | Max Int Length
349type Axis
350 = XAxis
351 | YAxis
352 | AllAxis
355type Location
356 = Above
357 | Below
358 | OnRight
359 | OnLeft
360 | InFront
361 | Behind
364{-| -}
365type Color
366 = Rgba Float Float Float Float
369type NodeName
370 = Generic
371 | NodeName String
372 | Embedded String String
375type NearbyChildren msg
376 = NoNearbyChildren
377 | ChildrenBehind (List (Html.Html msg))
378 | ChildrenInFront (List (Html.Html msg))
379 | ChildrenBehindAndInFront (List (Html.Html msg)) (List (Html.Html msg))
382div =
383 Generic
386type alias Gathered msg =
387 { node : NodeName
388 , attributes : List (VirtualDom.Attribute msg)
389 , styles : List Style
390 , children : NearbyChildren msg
391 , has : Flag.Field
392 }
395htmlClass : String -> Attribute aligned msg
396htmlClass cls =
397 Attr <| Html.Attributes.class cls
400{-| -}
401unstyled : VirtualDom.Node msg -> Element msg
402unstyled =
403 Unstyled << always
406finalizeNode has node attributes children embedMode parentContext =
407 let
408 createNode nodeName attrs =
409 case children of
410 Keyed keyed ->
411 VirtualDom.keyedNode nodeName
412 attrs
413 (case embedMode of
414 NoStyleSheet ->
415 keyed
417 OnlyDynamic opts styles ->
418 embedKeyed False opts styles keyed
420 StaticRootAndDynamic opts styles ->
421 embedKeyed True opts styles keyed
422 )
424 Unkeyed unkeyed ->
425 (case nodeName of
426 "div" ->
427 Html.div
429 "p" ->
430 Html.p
432 _ ->
433 VirtualDom.node nodeName
434 )
435 attrs
436 (case embedMode of
437 NoStyleSheet ->
438 unkeyed
440 OnlyDynamic opts styles ->
441 embedWith False opts styles unkeyed
443 StaticRootAndDynamic opts styles ->
444 embedWith True opts styles unkeyed
445 )
447 html =
448 case node of
449 Generic ->
450 createNode "div" attributes
452 NodeName nodeName ->
453 createNode nodeName attributes
455 Embedded nodeName internal ->
456 VirtualDom.node nodeName
457 attributes
458 [ createNode internal
459 [ Html.Attributes.class
460 (classes.any ++ " " ++ classes.single)
461 ]
462 ]
463 in
464 case parentContext of
465 AsRow ->
466 if Flag.present Flag.widthFill has && not (Flag.present Flag.widthBetween has) then
467 html
469 else if Flag.present Flag.alignRight has then
470 Html.u
471 [ Html.Attributes.class
472 (String.join " "
473 [ classes.any
474 , classes.single
475 , classes.container
476 , classes.contentCenterY
477 , classes.alignContainerRight
478 ]
479 )
480 ]
481 [ html ]
483 else if Flag.present Flag.centerX has then
484 Html.s
485 [ Html.Attributes.class
486 (String.join " "
487 [ classes.any
488 , classes.single
489 , classes.container
490 , classes.contentCenterY
491 , classes.alignContainerCenterX
492 ]
493 )
494 ]
495 [ html ]
497 else
498 html
500 AsColumn ->
501 if Flag.present Flag.heightFill has && not (Flag.present Flag.heightBetween has) then
502 html
504 else if Flag.present Flag.centerY has then
505 Html.s
506 [ Html.Attributes.class
507 (String.join " "
508 [ classes.any
509 , classes.single
510 , classes.container
511 , classes.alignContainerCenterY
512 ]
513 )
514 ]
515 [ html ]
517 else if Flag.present Flag.alignBottom has then
518 Html.u
519 [ Html.Attributes.class
520 (String.join " "
521 [ classes.any
522 , classes.single
523 , classes.container
524 , classes.alignContainerBottom
525 ]
526 )
527 ]
528 [ html ]
530 else
531 html
533 _ ->
534 html
537embedWith static opts styles children =
538 let
539 dynamicStyleSheet =
540 styles
541 |> List.foldl reduceStyles ( Set.empty, renderFocusStyle opts.focus )
542 |> Tuple.second
543 -- |> reduceStylesRecursive Set.empty [ ]) --renderFocusStyle opts.focus ]
544 -- |> sortedReduce
545 |> toStyleSheet opts
546 in
547 if static then
548 staticRoot opts
549 :: dynamicStyleSheet
550 :: children
552 else
553 dynamicStyleSheet
554 :: children
557embedKeyed static opts styles children =
558 let
559 dynamicStyleSheet =
560 styles
561 |> List.foldl reduceStyles ( Set.empty, renderFocusStyle opts.focus )
562 |> Tuple.second
563 -- |> reduceStylesRecursive Set.empty [ ]) --renderFocusStyle opts.focus ]
564 -- |> sortedReduce
565 |> toStyleSheet opts
566 in
567 if static then
568 ( "static-stylesheet", staticRoot opts )
569 :: ( "dynamic-stylesheet"
570 , dynamicStyleSheet
571 )
572 :: children
574 else
575 ( "dynamic-stylesheet"
576 , dynamicStyleSheet
577 )
578 :: children
581reduceStylesRecursive : Set String -> List Style -> List Style -> List Style
582reduceStylesRecursive cache found styles =
583 case styles of
584 [] ->
585 found
587 head :: remaining ->
588 let
589 styleName =
590 getStyleName head
591 in
592 if Set.member styleName cache then
593 reduceStylesRecursive cache found remaining
595 else
596 reduceStylesRecursive (Set.insert styleName cache) (head :: found) remaining
599reduceStyles : Style -> ( Set String, List Style ) -> ( Set String, List Style )
600reduceStyles style (( cache, existing ) as nevermind) =
601 let
602 styleName =
603 getStyleName style
604 in
605 if Set.member styleName cache then
606 nevermind
608 else
609 ( Set.insert styleName cache
610 , style :: existing
611 )
614sortedReduce styles =
615 styles
616 -- |> List.map (\x -> ( getStyleName x, x ))
617 |> List.sortBy getStyleName
618 |> reduceRecursiveCalcName []
621reduceRecursiveCalcName : List Style -> List Style -> List Style
622reduceRecursiveCalcName found styles =
623 case styles of
624 [] ->
625 found
627 headOfList :: [] ->
628 headOfList :: found
630 headOfList :: other :: remaining ->
631 if headOfList /= other then
632 reduceRecursiveCalcName (headOfList :: found) (other :: remaining)
634 else
635 reduceRecursiveCalcName found (other :: remaining)
638reduceRecursive : List Style -> List ( String, Style ) -> List Style
639reduceRecursive found styles =
640 case styles of
641 [] ->
642 found
644 ( _, headOfList ) :: [] ->
645 headOfList :: found
647 ( headOfListName, headOfList ) :: ( otherName, other ) :: remaining ->
648 if headOfListName /= otherName then
649 reduceRecursive (headOfList :: found) (( otherName, other ) :: remaining)
651 else
652 reduceRecursive found (( otherName, other ) :: remaining)
655addNodeName : String -> NodeName -> NodeName
656addNodeName newNode old =
657 case old of
658 Generic ->
659 NodeName newNode
661 NodeName name ->
662 Embedded name newNode
664 Embedded x y ->
665 Embedded x y
668alignXName : HAlign -> String
669alignXName align =
670 case align of
671 Left ->
672 classes.alignedHorizontally ++ " " ++ classes.alignLeft
674 Right ->
675 classes.alignedHorizontally ++ " " ++ classes.alignRight
677 CenterX ->
678 classes.alignedHorizontally ++ " " ++ classes.alignCenterX
681alignYName : VAlign -> String
682alignYName align =
683 case align of
684 Top ->
685 classes.alignedVertically ++ " " ++ classes.alignTop
687 Bottom ->
688 classes.alignedVertically ++ " " ++ classes.alignBottom
690 CenterY ->
691 classes.alignedVertically ++ " " ++ classes.alignCenterY
694transformClass transform =
695 case transform of
696 Untransformed ->
697 Nothing
699 Moved ( x, y, z ) ->
700 Just <|
701 "mv-"
702 ++ floatClass x
703 ++ "-"
704 ++ floatClass y
705 ++ "-"
706 ++ floatClass z
708 FullTransform ( tx, ty, tz ) ( sx, sy, sz ) ( ox, oy, oz ) angle ->
709 Just <|
710 "tfrm-"
711 ++ floatClass tx
712 ++ "-"
713 ++ floatClass ty
714 ++ "-"
715 ++ floatClass tz
716 ++ "-"
717 ++ floatClass sx
718 ++ "-"
719 ++ floatClass sy
720 ++ "-"
721 ++ floatClass sz
722 ++ "-"
723 ++ floatClass ox
724 ++ "-"
725 ++ floatClass oy
726 ++ "-"
727 ++ floatClass oz
728 ++ "-"
729 ++ floatClass angle
732transformValue transform =
733 case transform of
734 Untransformed ->
735 Nothing
737 Moved ( x, y, z ) ->
738 Just <|
739 "translate3d("
740 ++ String.fromFloat x
741 ++ "px, "
742 ++ String.fromFloat y
743 ++ "px, "
744 ++ String.fromFloat z
745 ++ "px)"
747 FullTransform ( tx, ty, tz ) ( sx, sy, sz ) ( ox, oy, oz ) angle ->
748 let
749 translate =
750 "translate3d("
751 ++ String.fromFloat tx
752 ++ "px, "
753 ++ String.fromFloat ty
754 ++ "px, "
755 ++ String.fromFloat tz
756 ++ "px)"
758 scale =
759 "scale3d("
760 ++ String.fromFloat sx
761 ++ ", "
762 ++ String.fromFloat sy
763 ++ ", "
764 ++ String.fromFloat sz
765 ++ ")"
767 rotate =
768 "rotate3d("
769 ++ String.fromFloat ox
770 ++ ", "
771 ++ String.fromFloat oy
772 ++ ", "
773 ++ String.fromFloat oz
774 ++ ", "
775 ++ String.fromFloat angle
776 ++ "rad)"
777 in
778 Just <| translate ++ " " ++ scale ++ " " ++ rotate
781composeTransformation transform component =
782 case transform of
783 Untransformed ->
784 case component of
785 MoveX x ->
786 Moved ( x, 0, 0 )
788 MoveY y ->
789 Moved ( 0, y, 0 )
791 MoveZ z ->
792 Moved ( 0, 0, z )
794 MoveXYZ xyz ->
795 Moved xyz
797 Rotate xyz angle ->
798 FullTransform ( 0, 0, 0 ) ( 1, 1, 1 ) xyz angle
800 Scale xyz ->
801 FullTransform ( 0, 0, 0 ) xyz ( 0, 0, 1 ) 0
803 Moved (( x, y, z ) as moved) ->
804 case component of
805 MoveX newX ->
806 Moved ( newX, y, z )
808 MoveY newY ->
809 Moved ( x, newY, z )
811 MoveZ newZ ->
812 Moved ( x, y, newZ )
814 MoveXYZ xyz ->
815 Moved xyz
817 Rotate xyz angle ->
818 FullTransform moved ( 1, 1, 1 ) xyz angle
820 Scale scale ->
821 FullTransform moved scale ( 0, 0, 1 ) 0
823 FullTransform (( x, y, z ) as moved) scaled origin angle ->
824 case component of
825 MoveX newX ->
826 FullTransform ( newX, y, z ) scaled origin angle
828 MoveY newY ->
829 FullTransform ( x, newY, z ) scaled origin angle
831 MoveZ newZ ->
832 FullTransform ( x, y, newZ ) scaled origin angle
834 MoveXYZ newMove ->
835 FullTransform newMove scaled origin angle
837 Rotate newOrigin newAngle ->
838 FullTransform moved scaled newOrigin newAngle
840 Scale newScale ->
841 FullTransform moved newScale origin angle
844skippable flag style =
845 if flag == Flag.borderWidth then
846 case style of
847 Single _ _ val ->
848 case val of
849 "0px" ->
850 True
852 "1px" ->
853 True
855 "2px" ->
856 True
858 "3px" ->
859 True
861 "4px" ->
862 True
864 "5px" ->
865 True
867 "6px" ->
868 True
870 _ ->
871 False
873 _ ->
874 False
876 else
877 case style of
878 FontSize i ->
879 i >= 8 && i <= 32
881 PaddingStyle name t r b l ->
882 t == b && t == r && t == l && t >= 0 && t <= 24
884 -- SpacingStyle _ _ _ ->
885 -- True
886 -- FontFamily _ _ ->
887 -- True
888 _ ->
889 False
892gatherAttrRecursive :
893 String
894 -> NodeName
895 -> Flag.Field
896 -> Transformation
897 -> List Style
898 -> List (VirtualDom.Attribute msg)
899 -> NearbyChildren msg
900 -> List (Attribute aligned msg)
901 -> Gathered msg
902gatherAttrRecursive classes node has transform styles attrs children elementAttrs =
903 case elementAttrs of
904 [] ->
905 case transformClass transform of
906 Nothing ->
907 { attributes = Html.Attributes.class classes :: attrs
908 , styles = styles
909 , node = node
910 , children = children
911 , has = has
912 }
914 Just class ->
915 { attributes = Html.Attributes.class (classes ++ " " ++ class) :: attrs
916 , styles = Transform transform :: styles
917 , node = node
918 , children = children
919 , has = has
920 }
922 attribute :: remaining ->
923 case attribute of
924 NoAttribute ->
925 gatherAttrRecursive classes node has transform styles attrs children remaining
927 Class flag exactClassName ->
928 if Flag.present flag has then
929 gatherAttrRecursive classes node has transform styles attrs children remaining
931 else
932 gatherAttrRecursive (exactClassName ++ " " ++ classes) node (Flag.add flag has) transform styles attrs children remaining
934 Attr actualAttribute ->
935 gatherAttrRecursive classes node has transform styles (actualAttribute :: attrs) children remaining
937 StyleClass flag style ->
938 if Flag.present flag has then
939 gatherAttrRecursive classes node has transform styles attrs children remaining
941 else if skippable flag style then
942 gatherAttrRecursive (getStyleName style ++ " " ++ classes)
943 node
944 (Flag.add flag has)
945 transform
946 styles
947 attrs
948 children
949 remaining
951 else
952 gatherAttrRecursive (getStyleName style ++ " " ++ classes)
953 node
954 (Flag.add flag has)
955 transform
956 (style :: styles)
957 attrs
958 children
959 remaining
961 TransformComponent flag component ->
962 gatherAttrRecursive classes
963 node
964 (Flag.add flag has)
965 (composeTransformation transform component)
966 styles
967 attrs
968 children
969 remaining
971 Width width ->
972 if Flag.present Flag.width has then
973 gatherAttrRecursive classes node has transform styles attrs children remaining
975 else
976 case width of
977 Px px ->
978 gatherAttrRecursive ((Internal.Style.classes.widthExact ++ " width-px-" ++ String.fromInt px) ++ " " ++ classes)
979 node
980 (Flag.add Flag.width has)
981 transform
982 (Single ("width-px-" ++ String.fromInt px) "width" (String.fromInt px ++ "px") :: styles)
983 attrs
984 children
985 remaining
987 Content ->
988 gatherAttrRecursive (classes ++ " " ++ Internal.Style.classes.widthContent)
989 node
990 (Flag.add Flag.widthContent (Flag.add Flag.width has))
991 transform
992 styles
993 attrs
994 children
995 remaining
997 Fill portion ->
998 if portion == 1 then
999 gatherAttrRecursive (classes ++ " " ++ Internal.Style.classes.widthFill)
1000 node
1001 (Flag.add Flag.widthFill (Flag.add Flag.width has))
1002 transform
1003 styles
1004 attrs
1005 children
1006 remaining
1008 else
1009 gatherAttrRecursive (classes ++ " " ++ Internal.Style.classes.widthFillPortion ++ " width-fill-" ++ String.fromInt portion)
1010 node
1011 (Flag.add Flag.widthFill (Flag.add Flag.width has))
1012 transform
1013 (Single
1014 (Internal.Style.classes.any
1015 ++ "."
1016 ++ Internal.Style.classes.row
1017 ++ " > "
1018 ++ (Internal.Style.dot <| "width-fill-" ++ String.fromInt portion)
1020 "flex-grow"
1021 (String.fromInt (portion * 100000))
1022 :: styles
1024 attrs
1025 children
1026 remaining
1028 _ ->
1029 let
1030 ( addToFlags, newClass, newStyles ) =
1031 renderWidth width
1032 in
1033 gatherAttrRecursive (classes ++ " " ++ newClass)
1034 node
1035 (Flag.merge addToFlags (Flag.add Flag.width has))
1036 transform
1037 (newStyles ++ styles)
1038 attrs
1039 children
1040 remaining
1042 Height height ->
1043 if Flag.present Flag.height has then
1044 gatherAttrRecursive classes node has transform styles attrs children remaining
1046 else
1047 case height of
1048 Px px ->
1049 let
1050 val =
1051 String.fromInt px ++ "px"
1053 name =
1054 "height-px-" ++ val
1055 in
1056 gatherAttrRecursive (Internal.Style.classes.heightExact ++ " " ++ name ++ " " ++ classes)
1057 node
1058 (Flag.add Flag.height has)
1059 transform
1060 (Single name "height " val :: styles)
1061 attrs
1062 children
1063 remaining
1065 Content ->
1066 gatherAttrRecursive (Internal.Style.classes.heightContent ++ " " ++ classes)
1067 node
1068 (Flag.add Flag.heightContent (Flag.add Flag.height has))
1069 transform
1070 styles
1071 attrs
1072 children
1073 remaining
1075 Fill portion ->
1076 if portion == 1 then
1077 gatherAttrRecursive (Internal.Style.classes.heightFill ++ " " ++ classes)
1078 node
1079 (Flag.add Flag.heightFill (Flag.add Flag.height has))
1080 transform
1081 styles
1082 attrs
1083 children
1084 remaining
1086 else
1087 gatherAttrRecursive (classes ++ " " ++ (Internal.Style.classes.heightFillPortion ++ " height-fill-" ++ String.fromInt portion))
1088 node
1089 (Flag.add Flag.heightFill (Flag.add Flag.height has))
1090 transform
1091 (Single
1092 (Internal.Style.classes.any
1093 ++ "."
1094 ++ Internal.Style.classes.column
1095 ++ " > "
1096 ++ (Internal.Style.dot <| "height-fill-" ++ String.fromInt portion)
1098 "flex-grow"
1099 (String.fromInt (portion * 100000))
1100 :: styles
1102 attrs
1103 children
1104 remaining
1106 _ ->
1107 let
1108 ( addToFlags, newClass, newStyles ) =
1109 renderHeight height
1110 in
1111 gatherAttrRecursive (classes ++ " " ++ newClass)
1112 node
1113 (Flag.merge addToFlags (Flag.add Flag.height has))
1114 transform
1115 (newStyles ++ styles)
1116 attrs
1117 children
1118 remaining
1120 Describe description ->
1121 case description of
1122 Main ->
1123 gatherAttrRecursive classes (addNodeName "main" node) has transform styles attrs children remaining
1125 Navigation ->
1126 gatherAttrRecursive classes (addNodeName "nav" node) has transform styles attrs children remaining
1128 ContentInfo ->
1129 gatherAttrRecursive classes (addNodeName "footer" node) has transform styles attrs children remaining
1131 Complementary ->
1132 gatherAttrRecursive classes (addNodeName "aside" node) has transform styles attrs children remaining
1134 Heading i ->
1135 if i <= 1 then
1136 gatherAttrRecursive classes (addNodeName "h1" node) has transform styles attrs children remaining
1138 else if i < 7 then
1139 gatherAttrRecursive classes (addNodeName ("h" ++ String.fromInt i) node) has transform styles attrs children remaining
1141 else
1142 gatherAttrRecursive classes (addNodeName "h6" node) has transform styles attrs children remaining
1144 Paragraph ->
1145 -- previously we rendered a <p> tag, though apparently this invalidates the html if it has <div>s inside.
1146 -- Since we can't guaranteee that there are no divs, we need another strategy.
1147 -- While it's not documented in many places, there apparently is a paragraph aria role
1148 -- https://github.com/w3c/aria/blob/11f85f41a5b621fdbe85fc9bcdcd270e653a48ba/common/script/roleInfo.js
1149 -- Though we'll need to wait till it gets released in an official wai-aria spec to use it.
1150 -- If it's used at the moment, then Lighthouse complains (likely rightfully) that role paragraph is not recognized.
1151 gatherAttrRecursive
1152 classes
1153 node
1154 has
1155 transform
1156 styles
1157 attrs
1158 children
1159 remaining
1161 Button ->
1162 gatherAttrRecursive classes node has transform styles (VirtualDom.attribute "role" "button" :: attrs) children remaining
1164 Label label ->
1165 gatherAttrRecursive classes node has transform styles (VirtualDom.attribute "aria-label" label :: attrs) children remaining
1167 LivePolite ->
1168 gatherAttrRecursive classes node has transform styles (VirtualDom.attribute "aria-live" "polite" :: attrs) children remaining
1170 LiveAssertive ->
1171 gatherAttrRecursive classes node has transform styles (VirtualDom.attribute "aria-live" "assertive" :: attrs) children remaining
1173 Nearby location elem ->
1174 let
1175 newStyles =
1176 case elem of
1177 Empty ->
1178 styles
1180 Text str ->
1181 styles
1183 Unstyled html ->
1184 styles
1186 Styled styled ->
1187 styles ++ styled.styles
1188 in
1189 gatherAttrRecursive
1190 classes
1191 node
1192 has
1193 transform
1194 newStyles
1195 attrs
1196 (addNearbyElement location elem children)
1197 remaining
1199 AlignX x ->
1200 if Flag.present Flag.xAlign has then
1201 gatherAttrRecursive classes node has transform styles attrs children remaining
1203 else
1204 gatherAttrRecursive (alignXName x ++ " " ++ classes)
1205 node
1206 (has
1207 |> Flag.add Flag.xAlign
1208 |> (\flags ->
1209 case x of
1210 CenterX ->
1211 Flag.add Flag.centerX flags
1213 Right ->
1214 Flag.add Flag.alignRight flags
1216 _ ->
1217 flags
1220 transform
1221 styles
1222 attrs
1223 children
1224 remaining
1226 AlignY y ->
1227 if Flag.present Flag.yAlign has then
1228 gatherAttrRecursive classes node has transform styles attrs children remaining
1230 else
1231 gatherAttrRecursive (alignYName y ++ " " ++ classes)
1232 node
1233 (Flag.add Flag.yAlign has
1234 |> (\flags ->
1235 case y of
1236 CenterY ->
1237 Flag.add Flag.centerY flags
1239 Bottom ->
1240 Flag.add Flag.alignBottom flags
1242 _ ->
1243 flags
1246 transform
1247 styles
1248 attrs
1249 children
1250 remaining
1253addNearbyElement location elem existing =
1254 let
1255 nearby =
1256 nearbyElement location elem
1257 in
1258 case existing of
1259 NoNearbyChildren ->
1260 case location of
1261 Behind ->
1262 ChildrenBehind [ nearby ]
1264 _ ->
1265 ChildrenInFront [ nearby ]
1267 ChildrenBehind existingBehind ->
1268 case location of
1269 Behind ->
1270 ChildrenBehind (nearby :: existingBehind)
1272 _ ->
1273 ChildrenBehindAndInFront existingBehind [ nearby ]
1275 ChildrenInFront existingInFront ->
1276 case location of
1277 Behind ->
1278 ChildrenBehindAndInFront [ nearby ] existingInFront
1280 _ ->
1281 ChildrenInFront (nearby :: existingInFront)
1283 ChildrenBehindAndInFront existingBehind existingInFront ->
1284 case location of
1285 Behind ->
1286 ChildrenBehindAndInFront (nearby :: existingBehind) existingInFront
1288 _ ->
1289 ChildrenBehindAndInFront existingBehind (nearby :: existingInFront)
1292nearbyElement location elem =
1293 Html.div
1294 [ Html.Attributes.class <|
1295 case location of
1296 Above ->
1297 String.join " "
1298 [ Internal.Style.classes.nearby
1299 , Internal.Style.classes.single
1300 , Internal.Style.classes.above
1303 Below ->
1304 String.join " "
1305 [ Internal.Style.classes.nearby
1306 , Internal.Style.classes.single
1307 , Internal.Style.classes.below
1310 OnRight ->
1311 String.join " "
1312 [ Internal.Style.classes.nearby
1313 , Internal.Style.classes.single
1314 , Internal.Style.classes.onRight
1317 OnLeft ->
1318 String.join " "
1319 [ Internal.Style.classes.nearby
1320 , Internal.Style.classes.single
1321 , Internal.Style.classes.onLeft
1324 InFront ->
1325 String.join " "
1326 [ Internal.Style.classes.nearby
1327 , Internal.Style.classes.single
1328 , Internal.Style.classes.inFront
1331 Behind ->
1332 String.join " "
1333 [ Internal.Style.classes.nearby
1334 , Internal.Style.classes.single
1335 , Internal.Style.classes.behind
1338 [ case elem of
1339 Empty ->
1340 VirtualDom.text ""
1342 Text str ->
1343 textElement str
1345 Unstyled html ->
1346 html asEl
1348 Styled styled ->
1349 styled.html NoStyleSheet asEl
1353renderWidth w =
1354 case w of
1355 Px px ->
1356 ( Flag.none
1357 , Internal.Style.classes.widthExact ++ " width-px-" ++ String.fromInt px
1358 , [ Single ("width-px-" ++ String.fromInt px) "width" (String.fromInt px ++ "px") ]
1361 Content ->
1362 ( Flag.add Flag.widthContent Flag.none
1363 , Internal.Style.classes.widthContent
1364 , []
1367 Fill portion ->
1368 if portion == 1 then
1369 ( Flag.add Flag.widthFill Flag.none
1370 , Internal.Style.classes.widthFill
1371 , []
1374 else
1375 ( Flag.add Flag.widthFill Flag.none
1376 , Internal.Style.classes.widthFillPortion ++ " width-fill-" ++ String.fromInt portion
1377 , [ Single
1378 (Internal.Style.classes.any
1379 ++ "."
1380 ++ Internal.Style.classes.row
1381 ++ " > "
1382 ++ (Internal.Style.dot <| "width-fill-" ++ String.fromInt portion)
1384 "flex-grow"
1385 (String.fromInt (portion * 100000))
1389 Min minSize len ->
1390 let
1391 cls =
1392 "min-width-"
1393 ++ String.fromInt minSize
1395 style =
1396 Single
1397 cls
1398 "min-width"
1399 (String.fromInt minSize ++ "px")
1401 ( newFlag, newAttrs, newStyle ) =
1402 renderWidth len
1403 in
1404 ( Flag.add Flag.widthBetween newFlag
1405 , cls ++ " " ++ newAttrs
1406 , style :: newStyle
1409 Max maxSize len ->
1410 let
1411 cls =
1412 "max-width-" ++ String.fromInt maxSize
1414 style =
1415 Single cls
1416 "max-width"
1417 (String.fromInt maxSize ++ "px")
1419 ( newFlag, newAttrs, newStyle ) =
1420 renderWidth len
1421 in
1422 ( Flag.add Flag.widthBetween newFlag
1423 , cls ++ " " ++ newAttrs
1424 , style :: newStyle
1428renderHeight h =
1429 case h of
1430 Px px ->
1431 let
1432 val =
1433 String.fromInt px
1435 name =
1436 "height-px-" ++ val
1437 in
1438 ( Flag.none
1439 , Internal.Style.classes.heightExact ++ " " ++ name
1440 , [ Single name "height" (val ++ "px") ]
1443 Content ->
1444 ( Flag.add Flag.heightContent Flag.none
1445 , Internal.Style.classes.heightContent
1446 , []
1449 Fill portion ->
1450 if portion == 1 then
1451 ( Flag.add Flag.heightFill Flag.none
1452 , Internal.Style.classes.heightFill
1453 , []
1456 else
1457 ( Flag.add Flag.heightFill Flag.none
1458 , Internal.Style.classes.heightFillPortion ++ " height-fill-" ++ String.fromInt portion
1459 , [ Single
1460 (Internal.Style.classes.any
1461 ++ "."
1462 ++ Internal.Style.classes.column
1463 ++ " > "
1464 ++ (Internal.Style.dot <| "height-fill-" ++ String.fromInt portion)
1466 "flex-grow"
1467 (String.fromInt (portion * 100000))
1471 Min minSize len ->
1472 let
1473 cls =
1474 "min-height-"
1475 ++ String.fromInt minSize
1477 style =
1478 Single
1479 cls
1480 "min-height"
1481 -- This needs to be !important because we're using `min-height: min-content`
1482 -- to correct for safari's incorrect implementation of flexbox.
1483 (String.fromInt minSize ++ "px !important")
1485 ( newFlag, newAttrs, newStyle ) =
1486 renderHeight len
1487 in
1488 ( Flag.add Flag.heightBetween newFlag
1489 , cls ++ " " ++ newAttrs
1490 , style :: newStyle
1493 Max maxSize len ->
1494 let
1495 cls =
1496 "max-height-" ++ String.fromInt maxSize
1498 style =
1499 Single cls
1500 "max-height"
1501 (String.fromInt maxSize ++ "px")
1503 ( newFlag, newAttrs, newStyle ) =
1504 renderHeight len
1505 in
1506 ( Flag.add Flag.heightBetween newFlag
1507 , cls ++ " " ++ newAttrs
1508 , style :: newStyle
1512rowClass =
1513 classes.any ++ " " ++ classes.row
1516columnClass =
1517 classes.any ++ " " ++ classes.column
1520singleClass =
1521 classes.any ++ " " ++ classes.single
1524gridClass =
1525 classes.any ++ " " ++ classes.grid
1528paragraphClass =
1529 classes.any ++ " " ++ classes.paragraph
1532pageClass =
1533 classes.any ++ " " ++ classes.page
1536contextClasses context =
1537 case context of
1538 AsRow ->
1539 rowClass
1541 AsColumn ->
1542 columnClass
1544 AsEl ->
1545 singleClass
1547 AsGrid ->
1548 gridClass
1550 AsParagraph ->
1551 paragraphClass
1553 AsTextColumn ->
1554 pageClass
1557element : LayoutContext -> NodeName -> List (Attribute aligned msg) -> Children (Element msg) -> Element msg
1558element context node attributes children =
1559 attributes
1560 |> List.reverse
1561 |> gatherAttrRecursive (contextClasses context) node Flag.none untransformed [] [] NoNearbyChildren
1562 |> createElement context children
1565untransformed =
1566 Untransformed
1569createElement : LayoutContext -> Children (Element msg) -> Gathered msg -> Element msg
1570createElement context children rendered =
1571 let
1572 gather child ( htmls, existingStyles ) =
1573 case child of
1574 Unstyled html ->
1575 if context == asParagraph then
1576 ( html context :: htmls
1577 , existingStyles
1580 else
1581 ( html context :: htmls
1582 , existingStyles
1585 Styled styled ->
1586 if context == asParagraph then
1587 ( styled.html NoStyleSheet context :: htmls
1588 , if List.isEmpty existingStyles then
1589 styled.styles
1591 else
1592 styled.styles ++ existingStyles
1595 else
1596 ( styled.html NoStyleSheet context :: htmls
1597 , if List.isEmpty existingStyles then
1598 styled.styles
1600 else
1601 styled.styles ++ existingStyles
1604 Text str ->
1605 -- TEXT OPTIMIZATION
1606 -- You can have raw text if the element is an el, and has `width-content` and `height-content`
1607 -- Same if it's a column or row with one child and width-content, height-content
1608 -- interferes with css grid
1609 -- Maybe we could unpack text elements in a paragraph as well,
1610 -- however, embedded elements that are larger than the line height will overlap with exisitng text.
1611 -- I don't think that's what we want.
1612 -- if
1613 -- context
1614 -- == asEl
1615 -- || context
1616 -- == asParagraph
1617 -- then
1618 -- ( VirtualDom.text
1619 -- (if context == asParagraph then
1620 -- str
1621 -- else
1622 -- str
1623 -- )
1624 -- :: htmls
1625 -- , existingStyles
1626 -- )
1627 -- else
1628 ( (if context == asEl then
1629 textElementFill str
1631 else
1632 textElement str
1634 :: htmls
1635 , existingStyles
1638 Empty ->
1639 ( htmls, existingStyles )
1641 gatherKeyed ( key, child ) ( htmls, existingStyles ) =
1642 case child of
1643 Unstyled html ->
1644 if context == asParagraph then
1645 ( ( key, html context ) :: htmls
1646 , existingStyles
1649 else
1650 ( ( key, html context ) :: htmls
1651 , existingStyles
1654 Styled styled ->
1655 if context == asParagraph then
1656 ( ( key, styled.html NoStyleSheet context )
1657 :: htmls
1658 , if List.isEmpty existingStyles then
1659 styled.styles
1661 else
1662 styled.styles ++ existingStyles
1665 else
1666 ( ( key, styled.html NoStyleSheet context ) :: htmls
1667 , if List.isEmpty existingStyles then
1668 styled.styles
1670 else
1671 styled.styles ++ existingStyles
1674 Text str ->
1675 -- TEXT OPTIMIZATION
1676 -- You can have raw text if the element is an el, and has `width-content` and `height-content`
1677 -- Same if it's a column or row with one child and width-content, height-content
1678 -- if
1679 -- context
1680 -- == asEl
1681 -- || context
1682 -- == asParagraph
1683 -- then
1684 -- ( ( key
1685 -- , VirtualDom.text
1686 -- str
1687 -- )
1688 -- :: htmls
1689 -- , existingStyles
1690 -- )
1691 -- else
1692 ( ( key
1693 , if context == asEl then
1694 textElementFill str
1696 else
1697 textElement str
1699 :: htmls
1700 , existingStyles
1703 Empty ->
1704 ( htmls, existingStyles )
1705 in
1706 case children of
1707 Keyed keyedChildren ->
1708 case List.foldr gatherKeyed ( [], [] ) keyedChildren of
1709 ( keyed, styles ) ->
1710 let
1711 newStyles =
1712 if List.isEmpty styles then
1713 rendered.styles
1715 else
1716 rendered.styles ++ styles
1717 in
1718 case newStyles of
1719 [] ->
1720 Unstyled
1721 (finalizeNode rendered.has
1722 rendered.node
1723 rendered.attributes
1724 (Keyed
1725 (addKeyedChildren "nearby-element-pls" keyed rendered.children)
1727 NoStyleSheet
1730 allStyles ->
1731 Styled
1732 { styles = allStyles
1733 , html =
1734 finalizeNode
1735 rendered.has
1736 rendered.node
1737 rendered.attributes
1738 (Keyed
1739 (addKeyedChildren "nearby-element-pls" keyed rendered.children)
1743 Unkeyed unkeyedChildren ->
1744 case List.foldr gather ( [], [] ) unkeyedChildren of
1745 ( unkeyed, styles ) ->
1746 let
1747 newStyles =
1748 if List.isEmpty styles then
1749 rendered.styles
1751 else
1752 rendered.styles ++ styles
1753 in
1754 case newStyles of
1755 [] ->
1756 Unstyled
1757 (finalizeNode
1758 rendered.has
1759 rendered.node
1760 rendered.attributes
1761 (Unkeyed (addChildren unkeyed rendered.children))
1762 NoStyleSheet
1765 allStyles ->
1766 Styled
1767 { styles = allStyles
1768 , html =
1769 finalizeNode
1770 rendered.has
1771 rendered.node
1772 rendered.attributes
1773 (Unkeyed (addChildren unkeyed rendered.children))
1777addChildren existing nearbyChildren =
1778 case nearbyChildren of
1779 NoNearbyChildren ->
1780 existing
1782 ChildrenBehind behind ->
1783 behind ++ existing
1785 ChildrenInFront inFront ->
1786 existing ++ inFront
1788 ChildrenBehindAndInFront behind inFront ->
1789 behind ++ existing ++ inFront
1792addKeyedChildren key existing nearbyChildren =
1793 case nearbyChildren of
1794 NoNearbyChildren ->
1795 existing
1797 ChildrenBehind behind ->
1798 List.map (\x -> ( key, x )) behind ++ existing
1800 ChildrenInFront inFront ->
1801 existing ++ List.map (\x -> ( key, x )) inFront
1803 ChildrenBehindAndInFront behind inFront ->
1804 List.map (\x -> ( key, x )) behind
1805 ++ existing
1806 ++ List.map (\x -> ( key, x )) inFront
1809unit =
1813defaultOptions =
1814 { hover = AllowHover
1815 , focus = focusDefaultStyle
1816 , mode = Layout
1820staticRoot : OptionRecord -> VirtualDom.Node msg
1821staticRoot opts =
1822 case opts.mode of
1823 Layout ->
1824 -- wrap the style node in a div to prevent `Dark Reader` from blowin up the dom.
1825 VirtualDom.node "div"
1826 []
1827 [ VirtualDom.node "style" [] [ VirtualDom.text Internal.Style.rules ] ]
1829 NoStaticStyleSheet ->
1830 VirtualDom.text ""
1832 WithVirtualCss ->
1833 VirtualDom.node "elm-ui-static-rules" [ VirtualDom.property "rules" (Encode.string Internal.Style.rules) ] []
1836addWhen ifThis x to =
1837 if ifThis then
1838 x :: to
1840 else
1841 to
1844{-| TODO:
1846This doesn't reduce equivalent attributes completely.
1849filter : List (Attribute aligned msg) -> List (Attribute aligned msg)
1850filter attrs =
1851 Tuple.first <|
1852 List.foldr
1853 (\x ( found, has ) ->
1854 case x of
1855 NoAttribute ->
1856 ( found, has )
1858 Class key _ ->
1859 ( x :: found, has )
1861 Attr attr ->
1862 ( x :: found, has )
1864 StyleClass _ style ->
1865 ( x :: found, has )
1867 Width width ->
1868 if Set.member "width" has then
1869 ( found, has )
1871 else
1872 ( x :: found, Set.insert "width" has )
1874 Height height ->
1875 if Set.member "height" has then
1876 ( found, has )
1878 else
1879 ( x :: found, Set.insert "height" has )
1881 Describe description ->
1882 if Set.member "described" has then
1883 ( found, has )
1885 else
1886 ( x :: found, Set.insert "described" has )
1888 Nearby location elem ->
1889 ( x :: found, has )
1891 AlignX _ ->
1892 if Set.member "align-x" has then
1893 ( found, has )
1895 else
1896 ( x :: found, Set.insert "align-x" has )
1898 AlignY _ ->
1899 if Set.member "align-y" has then
1900 ( found, has )
1902 else
1903 ( x :: found, Set.insert "align-y" has )
1905 TransformComponent _ _ ->
1906 if Set.member "transform" has then
1907 ( found, has )
1909 else
1910 ( x :: found, Set.insert "transform" has )
1912 ( [], Set.empty )
1913 attrs
1916isContent len =
1917 case len of
1918 Content ->
1919 True
1921 Max _ l ->
1922 isContent l
1924 Min _ l ->
1925 isContent l
1927 _ ->
1928 False
1931get : List (Attribute aligned msg) -> (Attribute aligned msg -> Bool) -> List (Attribute aligned msg)
1932get attrs isAttr =
1933 attrs
1934 |> filter
1935 |> List.foldr
1936 (\x found ->
1937 if isAttr x then
1938 x :: found
1940 else
1941 found
1943 []
1946type Spacing
1947 = Spaced String Int Int
1950type Padding
1951 = Padding String Float Float Float Float
1954extractSpacingAndPadding : List (Attribute aligned msg) -> ( Maybe Padding, Maybe Spacing )
1955extractSpacingAndPadding attrs =
1956 List.foldr
1957 (\attr ( pad, spacing ) ->
1958 ( case pad of
1959 Just x ->
1960 pad
1962 Nothing ->
1963 case attr of
1964 StyleClass _ (PaddingStyle name t r b l) ->
1965 Just (Padding name t r b l)
1967 _ ->
1968 Nothing
1969 , case spacing of
1970 Just x ->
1971 spacing
1973 Nothing ->
1974 case attr of
1975 StyleClass _ (SpacingStyle name x y) ->
1976 Just (Spaced name x y)
1978 _ ->
1979 Nothing
1982 ( Nothing, Nothing )
1983 attrs
1986getSpacing : List (Attribute aligned msg) -> ( Int, Int ) -> ( Int, Int )
1987getSpacing attrs default =
1988 attrs
1989 |> List.foldr
1990 (\attr acc ->
1991 case acc of
1992 Just x ->
1993 Just x
1995 Nothing ->
1996 case attr of
1997 StyleClass _ (SpacingStyle _ x y) ->
1998 Just ( x, y )
2000 _ ->
2001 Nothing
2003 Nothing
2004 |> Maybe.withDefault default
2007getWidth : List (Attribute aligned msg) -> Maybe Length
2008getWidth attrs =
2009 attrs
2010 |> List.foldr
2011 (\attr acc ->
2012 case acc of
2013 Just x ->
2014 Just x
2016 Nothing ->
2017 case attr of
2018 Width len ->
2019 Just len
2021 _ ->
2022 Nothing
2024 Nothing
2027getHeight : List (Attribute aligned msg) -> Maybe Length
2028getHeight attrs =
2029 attrs
2030 |> List.foldr
2031 (\attr acc ->
2032 case acc of
2033 Just x ->
2034 Just x
2036 Nothing ->
2037 case attr of
2038 Height len ->
2039 Just len
2041 _ ->
2042 Nothing
2044 Nothing
2047textElementClasses : String
2048textElementClasses =
2049 classes.any
2050 ++ " "
2051 ++ classes.text
2052 ++ " "
2053 ++ classes.widthContent
2054 ++ " "
2055 ++ classes.heightContent
2058textElement : String -> VirtualDom.Node msg
2059textElement str =
2060 Html.div
2061 [ Html.Attributes.class
2062 textElementClasses
2064 [ Html.text str ]
2067textElementFillClasses : String
2068textElementFillClasses =
2069 classes.any
2070 ++ " "
2071 ++ classes.text
2072 ++ " "
2073 ++ classes.widthFill
2074 ++ " "
2075 ++ classes.heightFill
2078textElementFill : String -> VirtualDom.Node msg
2079textElementFill str =
2080 Html.div
2081 [ Html.Attributes.class
2082 textElementFillClasses
2084 [ Html.text str ]
2087type Children x
2088 = Unkeyed (List x)
2089 | Keyed (List ( String, x ))
2092toHtml mode el =
2093 case el of
2094 Unstyled html ->
2095 html asEl
2097 Styled { styles, html } ->
2098 html (mode styles) asEl
2100 Text text ->
2101 textElement text
2103 Empty ->
2104 textElement ""
2107{-| -}
2108renderRoot : List Option -> List (Attribute aligned msg) -> Element msg -> VirtualDom.Node msg
2109renderRoot optionList attributes child =
2110 let
2111 options =
2112 optionsToRecord optionList
2114 embedStyle =
2115 case options.mode of
2116 NoStaticStyleSheet ->
2117 OnlyDynamic options
2119 _ ->
2120 StaticRootAndDynamic options
2121 in
2122 element asEl div attributes (Unkeyed [ child ])
2123 |> toHtml embedStyle
2126type RenderMode
2127 = Layout
2128 | NoStaticStyleSheet
2129 | WithVirtualCss
2132type alias OptionRecord =
2133 { hover : HoverSetting
2134 , focus : FocusStyle
2135 , mode : RenderMode
2139type HoverSetting
2140 = NoHover
2141 | AllowHover
2142 | ForceHover
2145type Option
2146 = HoverOption HoverSetting
2147 | FocusStyleOption FocusStyle
2148 | RenderModeOption RenderMode
2151type alias FocusStyle =
2152 { borderColor : Maybe Color
2153 , shadow : Maybe Shadow
2154 , backgroundColor : Maybe Color
2158type alias Shadow =
2159 { color : Color
2160 , offset : ( Int, Int )
2161 , blur : Int
2162 , size : Int
2166rootStyle : List (Attribute aligned msg)
2167rootStyle =
2168 let
2169 families =
2170 [ Typeface "Open Sans"
2171 , Typeface "Helvetica"
2172 , Typeface "Verdana"
2173 , SansSerif
2175 in
2176 [ StyleClass Flag.bgColor (Colored ("bg-" ++ formatColorClass (Rgba 1 1 1 0)) "background-color" (Rgba 1 1 1 0))
2177 , StyleClass Flag.fontColor (Colored ("fc-" ++ formatColorClass (Rgba 0 0 0 1)) "color" (Rgba 0 0 0 1))
2178 , StyleClass Flag.fontSize (FontSize 20)
2179 , StyleClass Flag.fontFamily <|
2180 FontFamily (List.foldl renderFontClassName "font-" families)
2181 families
2185renderFontClassName : Font -> String -> String
2186renderFontClassName font current =
2187 current
2188 ++ (case font of
2189 Serif ->
2190 "serif"
2192 SansSerif ->
2193 "sans-serif"
2195 Monospace ->
2196 "monospace"
2198 Typeface name ->
2199 name
2200 |> String.toLower
2201 |> String.words
2202 |> String.join "-"
2204 ImportFont name url ->
2205 name
2206 |> String.toLower
2207 |> String.words
2208 |> String.join "-"
2210 FontWith { name } ->
2211 name
2212 |> String.toLower
2213 |> String.words
2214 |> String.join "-"
2218renderFocusStyle :
2219 FocusStyle
2220 -> List Style
2221renderFocusStyle focus =
2222 [ Style (Internal.Style.dot classes.focusedWithin ++ ":focus-within")
2223 (List.filterMap identity
2224 [ Maybe.map (\color -> Property "border-color" (formatColor color)) focus.borderColor
2225 , Maybe.map (\color -> Property "background-color" (formatColor color)) focus.backgroundColor
2226 , Maybe.map
2227 (\shadow ->
2228 Property "box-shadow"
2229 (formatBoxShadow
2230 { color = shadow.color
2231 , offset =
2232 shadow.offset
2233 |> Tuple.mapFirst toFloat
2234 |> Tuple.mapSecond toFloat
2235 , inset = False
2236 , blur =
2237 toFloat shadow.blur
2238 , size =
2239 toFloat shadow.size
2243 focus.shadow
2244 , Just <| Property "outline" "none"
2247 , Style
2248 ((Internal.Style.dot classes.any ++ ":focus .focusable, ")
2249 ++ (Internal.Style.dot classes.any ++ ".focusable:focus, ")
2250 ++ (".ui-slide-bar:focus + " ++ Internal.Style.dot classes.any ++ " .focusable-thumb")
2252 (List.filterMap identity
2253 [ Maybe.map (\color -> Property "border-color" (formatColor color)) focus.borderColor
2254 , Maybe.map (\color -> Property "background-color" (formatColor color)) focus.backgroundColor
2255 , Maybe.map
2256 (\shadow ->
2257 Property "box-shadow"
2258 (formatBoxShadow
2259 { color = shadow.color
2260 , offset =
2261 shadow.offset
2262 |> Tuple.mapFirst toFloat
2263 |> Tuple.mapSecond toFloat
2264 , inset = False
2265 , blur = toFloat shadow.blur
2266 , size = toFloat shadow.size
2270 focus.shadow
2271 , Just <| Property "outline" "none"
2277focusDefaultStyle : { backgroundColor : Maybe Color, borderColor : Maybe Color, shadow : Maybe Shadow }
2278focusDefaultStyle =
2279 { backgroundColor = Nothing
2280 , borderColor = Nothing
2281 , shadow =
2282 Just
2283 { color =
2284 Rgba (155 / 255) (203 / 255) 1 1
2285 , offset = ( 0, 0 )
2286 , blur = 0
2287 , size = 3
2292optionsToRecord : List Option -> OptionRecord
2293optionsToRecord options =
2294 let
2295 combine opt record =
2296 case opt of
2297 HoverOption hoverable ->
2298 case record.hover of
2299 Nothing ->
2300 { record | hover = Just hoverable }
2302 _ ->
2303 record
2305 FocusStyleOption focusStyle ->
2306 case record.focus of
2307 Nothing ->
2308 { record | focus = Just focusStyle }
2310 _ ->
2311 record
2313 RenderModeOption renderMode ->
2314 case record.mode of
2315 Nothing ->
2316 { record | mode = Just renderMode }
2318 _ ->
2319 record
2321 andFinally record =
2322 { hover =
2323 case record.hover of
2324 Nothing ->
2325 AllowHover
2327 Just hoverable ->
2328 hoverable
2329 , focus =
2330 case record.focus of
2331 Nothing ->
2332 focusDefaultStyle
2334 Just focusable ->
2335 focusable
2336 , mode =
2337 case record.mode of
2338 Nothing ->
2339 Layout
2341 Just actualMode ->
2342 actualMode
2344 in
2345 andFinally <|
2346 List.foldr combine
2347 { hover = Nothing
2348 , focus = Nothing
2349 , mode = Nothing
2351 options
2354toStyleSheet : OptionRecord -> List Style -> VirtualDom.Node msg
2355toStyleSheet options styleSheet =
2356 case options.mode of
2357 Layout ->
2358 -- wrap the style node in a div to prevent `Dark Reader` from blowin up the dom.
2359 VirtualDom.node "div"
2360 []
2361 [ VirtualDom.node "style"
2362 []
2363 [ VirtualDom.text (toStyleSheetString options styleSheet) ]
2366 NoStaticStyleSheet ->
2367 -- wrap the style node in a div to prevent `Dark Reader` from blowin up the dom.
2368 VirtualDom.node "div"
2369 []
2370 [ VirtualDom.node "style"
2371 []
2372 [ VirtualDom.text (toStyleSheetString options styleSheet) ]
2375 WithVirtualCss ->
2376 VirtualDom.node "elm-ui-rules"
2377 [ VirtualDom.property "rules"
2378 (encodeStyles options styleSheet)
2380 []
2383renderTopLevelValues rules =
2384 let
2385 withImport font =
2386 case font of
2387 ImportFont _ url ->
2388 Just ("@import url('" ++ url ++ "');")
2390 -- FontWith with ->
2391 -- case with.url of
2392 -- Just x ->
2393 -- Just ("@import url('" ++ x ++ "');")
2394 -- Nothing ->
2395 -- Nothing
2396 _ ->
2397 Nothing
2399 allNames =
2400 List.map Tuple.first rules
2402 fontImports ( name, typefaces ) =
2403 let
2404 imports =
2405 String.join "\n" (List.filterMap withImport typefaces)
2406 in
2407 imports
2409 fontAdjustments ( name, typefaces ) =
2410 case typefaceAdjustment typefaces of
2411 Nothing ->
2412 String.join ""
2413 (List.map (renderNullAdjustmentRule name) allNames)
2415 Just adjustment ->
2416 String.join ""
2417 (List.map (renderFontAdjustmentRule name adjustment) allNames)
2418 in
2419 String.join "\n" (List.map fontImports rules)
2420 ++ String.join "\n" (List.map fontAdjustments rules)
2423renderNullAdjustmentRule fontToAdjust otherFontName =
2424 let
2425 name =
2426 if fontToAdjust == otherFontName then
2427 fontToAdjust
2429 else
2430 otherFontName ++ " ." ++ fontToAdjust
2431 in
2432 String.join " "
2433 [ bracket
2434 ("."
2435 ++ name
2436 ++ "."
2437 ++ classes.sizeByCapital
2438 ++ ", "
2439 ++ "."
2440 ++ name
2441 ++ " ."
2442 ++ classes.sizeByCapital
2444 [ ( "line-height", "1" )
2446 , bracket
2447 ("."
2448 ++ name
2449 ++ "."
2450 ++ classes.sizeByCapital
2451 ++ "> ."
2452 ++ Internal.Style.classes.text
2453 ++ ", ."
2454 ++ name
2455 ++ " ."
2456 ++ classes.sizeByCapital
2457 ++ " > ."
2458 ++ Internal.Style.classes.text
2460 [ ( "vertical-align", "0" )
2461 , ( "line-height", "1" )
2466fontRule name modifier ( parentAdj, textAdjustment ) =
2467 [ bracket
2468 ("."
2469 ++ name
2470 ++ "."
2471 ++ modifier
2472 ++ ", "
2473 ++ "."
2474 ++ name
2475 ++ " ."
2476 ++ modifier
2478 parentAdj
2479 , bracket
2480 ("."
2481 ++ name
2482 ++ "."
2483 ++ modifier
2484 ++ "> ."
2485 ++ Internal.Style.classes.text
2486 ++ ", ."
2487 ++ name
2488 ++ " ."
2489 ++ modifier
2490 ++ " > ."
2491 ++ Internal.Style.classes.text
2493 textAdjustment
2497renderFontAdjustmentRule fontToAdjust ( full, capital ) otherFontName =
2498 let
2499 name =
2500 if fontToAdjust == otherFontName then
2501 fontToAdjust
2503 else
2504 otherFontName ++ " ." ++ fontToAdjust
2505 in
2506 String.join " "
2507 (fontRule name classes.sizeByCapital capital ++ fontRule name classes.fullSize full)
2510bracket selector rules =
2511 let
2512 renderPair ( name, val ) =
2513 name ++ ": " ++ val ++ ";"
2514 in
2515 selector ++ " {" ++ String.join "" (List.map renderPair rules) ++ "}"
2518fontAdjustmentRules converted =
2519 ( [ ( "display", "block" )
2521 , [ ( "display", "inline-block" )
2522 , ( "line-height", String.fromFloat converted.height )
2523 , ( "vertical-align", String.fromFloat converted.vertical ++ "em" )
2524 , ( "font-size", String.fromFloat converted.size ++ "em" )
2529typefaceAdjustment typefaces =
2530 List.foldl
2531 (\face found ->
2532 case found of
2533 Nothing ->
2534 case face of
2535 FontWith with ->
2536 case with.adjustment of
2537 Nothing ->
2538 found
2540 Just adjustment ->
2541 Just
2542 ( fontAdjustmentRules
2543 (.full (convertAdjustment adjustment))
2544 , fontAdjustmentRules
2545 (.capital (convertAdjustment adjustment))
2548 _ ->
2549 found
2551 Just _ ->
2552 found
2554 Nothing
2555 typefaces
2558fontName font =
2559 case font of
2560 Serif ->
2561 "serif"
2563 SansSerif ->
2564 "sans-serif"
2566 Monospace ->
2567 "monospace"
2569 Typeface name ->
2570 "\"" ++ name ++ "\""
2572 ImportFont name url ->
2573 "\"" ++ name ++ "\""
2575 FontWith { name } ->
2576 "\"" ++ name ++ "\""
2579topLevelValue rule =
2580 case rule of
2581 FontFamily name typefaces ->
2582 Just ( name, typefaces )
2584 _ ->
2585 Nothing
2588renderProps force (Property key val) existing =
2589 if force then
2590 existing ++ "\n " ++ key ++ ": " ++ val ++ " !important;"
2592 else
2593 existing ++ "\n " ++ key ++ ": " ++ val ++ ";"
2596encodeStyles options stylesheet =
2597 stylesheet
2598 |> List.map
2599 (\style ->
2600 let
2601 styled =
2602 renderStyleRule options style Nothing
2603 in
2604 ( getStyleName style, Encode.list Encode.string styled )
2606 |> Encode.object
2609toStyleSheetString : OptionRecord -> List Style -> String
2610toStyleSheetString options stylesheet =
2611 let
2612 combine style rendered =
2613 { rules = rendered.rules ++ renderStyleRule options style Nothing
2614 , topLevel =
2615 case topLevelValue style of
2616 Nothing ->
2617 rendered.topLevel
2619 Just topLevel ->
2620 topLevel :: rendered.topLevel
2622 in
2623 case List.foldl combine { topLevel = [], rules = [] } stylesheet of
2624 { topLevel, rules } ->
2625 renderTopLevelValues topLevel ++ String.concat rules
2628renderStyle : OptionRecord -> Maybe PseudoClass -> String -> List Property -> List String
2629renderStyle options maybePseudo selector props =
2630 case maybePseudo of
2631 Nothing ->
2632 [ selector ++ "{" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2634 Just pseudo ->
2635 case pseudo of
2636 Hover ->
2637 case options.hover of
2638 NoHover ->
2639 []
2641 ForceHover ->
2642 [ selector ++ "-hv {" ++ List.foldl (renderProps True) "" props ++ "\n}" ]
2644 AllowHover ->
2645 [ selector ++ "-hv:hover {" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2647 Focus ->
2648 let
2649 renderedProps =
2650 List.foldl (renderProps False) "" props
2651 in
2652 [ selector ++ "-fs:focus {" ++ renderedProps ++ "\n}"
2653 , ("." ++ classes.any ++ ":focus " ++ selector ++ "-fs {")
2654 ++ renderedProps
2655 ++ "\n}"
2656 , (selector ++ "-fs:focus-within {")
2657 ++ renderedProps
2658 ++ "\n}"
2659 , (".ui-slide-bar:focus + " ++ Internal.Style.dot classes.any ++ " .focusable-thumb" ++ selector ++ "-fs {")
2660 ++ renderedProps
2661 ++ "\n}"
2664 Active ->
2665 [ selector ++ "-act:active {" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2668renderStyleRule : OptionRecord -> Style -> Maybe PseudoClass -> List String
2669renderStyleRule options rule maybePseudo =
2670 case rule of
2671 Style selector props ->
2672 renderStyle options maybePseudo selector props
2674 Shadows name prop ->
2675 renderStyle options
2676 maybePseudo
2677 ("." ++ name)
2678 [ Property "box-shadow" prop
2681 Transparency name transparency ->
2682 let
2683 opacity =
2684 (1 - transparency)
2685 |> min 1
2686 |> max 0
2687 in
2688 renderStyle options
2689 maybePseudo
2690 ("." ++ name)
2691 [ Property "opacity" (String.fromFloat opacity)
2694 FontSize i ->
2695 renderStyle options
2696 maybePseudo
2697 (".font-size-" ++ String.fromInt i)
2698 [ Property "font-size" (String.fromInt i ++ "px")
2701 FontFamily name typefaces ->
2702 let
2703 features =
2704 typefaces
2705 |> List.filterMap renderVariants
2706 |> String.join ", "
2708 families =
2709 [ Property "font-family"
2710 (typefaces
2711 |> List.map fontName
2712 |> String.join ", "
2714 , Property "font-feature-settings" features
2715 , Property "font-variant"
2716 (if List.any hasSmallCaps typefaces then
2717 "small-caps"
2719 else
2720 "normal"
2723 in
2724 renderStyle options
2725 maybePseudo
2726 ("." ++ name)
2727 families
2729 Single class prop val ->
2730 renderStyle options
2731 maybePseudo
2732 ("." ++ class)
2733 [ Property prop val
2736 Colored class prop color ->
2737 renderStyle options
2738 maybePseudo
2739 ("." ++ class)
2740 [ Property prop (formatColor color)
2743 SpacingStyle cls x y ->
2744 let
2745 class =
2746 "." ++ cls
2748 halfX =
2749 String.fromFloat (toFloat x / 2) ++ "px"
2751 halfY =
2752 String.fromFloat (toFloat y / 2) ++ "px"
2754 xPx =
2755 String.fromInt x ++ "px"
2757 yPx =
2758 String.fromInt y ++ "px"
2760 row =
2761 "." ++ Internal.Style.classes.row
2763 wrappedRow =
2764 "." ++ Internal.Style.classes.wrapped ++ row
2766 column =
2767 "." ++ Internal.Style.classes.column
2769 page =
2770 "." ++ Internal.Style.classes.page
2772 paragraph =
2773 "." ++ Internal.Style.classes.paragraph
2775 left =
2776 "." ++ Internal.Style.classes.alignLeft
2778 right =
2779 "." ++ Internal.Style.classes.alignRight
2781 any =
2782 "." ++ Internal.Style.classes.any
2784 single =
2785 "." ++ Internal.Style.classes.single
2786 in
2787 List.concat
2788 [ renderStyle options maybePseudo (class ++ row ++ " > " ++ any ++ " + " ++ any) [ Property "margin-left" xPx ]
2790 -- margins don't apply to last element of normal, unwrapped rows
2791 -- , renderStyle options maybePseudo (class ++ row ++ " > " ++ any ++ ":first-child") [ Property "margin" "0" ]
2792 -- For wrapped rows, margins always apply because we handle "canceling out" the other margins manually in the element.
2793 , renderStyle options
2794 maybePseudo
2795 (class ++ wrappedRow ++ " > " ++ any)
2796 [ Property "margin" (halfY ++ " " ++ halfX)
2799 -- , renderStyle options maybePseudo
2800 -- (class ++ wrappedRow ++ " > " ++ any ++ ":last-child")
2801 -- [ Property "margin-right" "0"
2802 -- ]
2803 -- columns
2804 , renderStyle options maybePseudo (class ++ column ++ " > " ++ any ++ " + " ++ any) [ Property "margin-top" yPx ]
2805 , renderStyle options maybePseudo (class ++ page ++ " > " ++ any ++ " + " ++ any) [ Property "margin-top" yPx ]
2806 , renderStyle options maybePseudo (class ++ page ++ " > " ++ left) [ Property "margin-right" xPx ]
2807 , renderStyle options maybePseudo (class ++ page ++ " > " ++ right) [ Property "margin-left" xPx ]
2808 , renderStyle options
2809 maybePseudo
2810 (class ++ paragraph)
2811 [ Property "line-height" ("calc(1em + " ++ String.fromInt y ++ "px)")
2813 , renderStyle options
2814 maybePseudo
2815 ("textarea" ++ any ++ class)
2816 [ Property "line-height" ("calc(1em + " ++ String.fromInt y ++ "px)")
2817 , Property "height" ("calc(100% + " ++ String.fromInt y ++ "px)")
2820 -- , renderStyle options
2821 -- maybePseudo
2822 -- (class ++ paragraph ++ " > " ++ any)
2823 -- [ Property "margin-right" xPx
2824 -- , Property "margin-bottom" yPx
2825 -- ]
2826 , renderStyle options
2827 maybePseudo
2828 (class ++ paragraph ++ " > " ++ left)
2829 [ Property "margin-right" xPx
2831 , renderStyle options
2832 maybePseudo
2833 (class ++ paragraph ++ " > " ++ right)
2834 [ Property "margin-left" xPx
2836 , renderStyle options
2837 maybePseudo
2838 (class ++ paragraph ++ "::after")
2839 [ Property "content" "''"
2840 , Property "display" "block"
2841 , Property "height" "0"
2842 , Property "width" "0"
2843 , Property "margin-top" (String.fromInt (-1 * (y // 2)) ++ "px")
2845 , renderStyle options
2846 maybePseudo
2847 (class ++ paragraph ++ "::before")
2848 [ Property "content" "''"
2849 , Property "display" "block"
2850 , Property "height" "0"
2851 , Property "width" "0"
2852 , Property "margin-bottom" (String.fromInt (-1 * (y // 2)) ++ "px")
2856 PaddingStyle cls top right bottom left ->
2857 let
2858 class =
2859 "."
2860 ++ cls
2861 in
2862 renderStyle options
2863 maybePseudo
2864 class
2865 [ Property "padding"
2866 (String.fromFloat top
2867 ++ "px "
2868 ++ String.fromFloat right
2869 ++ "px "
2870 ++ String.fromFloat bottom
2871 ++ "px "
2872 ++ String.fromFloat left
2873 ++ "px"
2877 BorderWidth cls top right bottom left ->
2878 let
2879 class =
2880 "."
2881 ++ cls
2882 in
2883 renderStyle options
2884 maybePseudo
2885 class
2886 [ Property "border-width"
2887 (String.fromInt top
2888 ++ "px "
2889 ++ String.fromInt right
2890 ++ "px "
2891 ++ String.fromInt bottom
2892 ++ "px "
2893 ++ String.fromInt left
2894 ++ "px"
2898 GridTemplateStyle template ->
2899 let
2900 class =
2901 ".grid-rows-"
2902 ++ String.join "-" (List.map lengthClassName template.rows)
2903 ++ "-cols-"
2904 ++ String.join "-" (List.map lengthClassName template.columns)
2905 ++ "-space-x-"
2906 ++ lengthClassName (Tuple.first template.spacing)
2907 ++ "-space-y-"
2908 ++ lengthClassName (Tuple.second template.spacing)
2910 ySpacing =
2911 toGridLength (Tuple.second template.spacing)
2913 xSpacing =
2914 toGridLength (Tuple.first template.spacing)
2916 toGridLength x =
2917 toGridLengthHelper Nothing Nothing x
2919 toGridLengthHelper minimum maximum x =
2920 case x of
2921 Px px ->
2922 String.fromInt px ++ "px"
2924 Content ->
2925 case ( minimum, maximum ) of
2926 ( Nothing, Nothing ) ->
2927 "max-content"
2929 ( Just minSize, Nothing ) ->
2930 "minmax(" ++ String.fromInt minSize ++ "px, " ++ "max-content)"
2932 ( Nothing, Just maxSize ) ->
2933 "minmax(max-content, " ++ String.fromInt maxSize ++ "px)"
2935 ( Just minSize, Just maxSize ) ->
2936 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt maxSize ++ "px)"
2938 Fill i ->
2939 case ( minimum, maximum ) of
2940 ( Nothing, Nothing ) ->
2941 String.fromInt i ++ "fr"
2943 ( Just minSize, Nothing ) ->
2944 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt i ++ "fr" ++ "fr)"
2946 ( Nothing, Just maxSize ) ->
2947 "minmax(max-content, " ++ String.fromInt maxSize ++ "px)"
2949 ( Just minSize, Just maxSize ) ->
2950 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt maxSize ++ "px)"
2952 Min m len ->
2953 toGridLengthHelper (Just m) maximum len
2955 Max m len ->
2956 toGridLengthHelper minimum (Just m) len
2958 msColumns =
2959 template.columns
2960 |> List.map toGridLength
2961 |> String.join ySpacing
2962 |> (\x -> "-ms-grid-columns: " ++ x ++ ";")
2964 msRows =
2965 template.columns
2966 |> List.map toGridLength
2967 |> String.join ySpacing
2968 |> (\x -> "-ms-grid-rows: " ++ x ++ ";")
2970 base =
2971 class ++ "{" ++ msColumns ++ msRows ++ "}"
2973 columns =
2974 template.columns
2975 |> List.map toGridLength
2976 |> String.join " "
2977 |> (\x -> "grid-template-columns: " ++ x ++ ";")
2979 rows =
2980 template.rows
2981 |> List.map toGridLength
2982 |> String.join " "
2983 |> (\x -> "grid-template-rows: " ++ x ++ ";")
2985 gapX =
2986 "grid-column-gap:" ++ toGridLength (Tuple.first template.spacing) ++ ";"
2988 gapY =
2989 "grid-row-gap:" ++ toGridLength (Tuple.second template.spacing) ++ ";"
2991 modernGrid =
2992 class ++ "{" ++ columns ++ rows ++ gapX ++ gapY ++ "}"
2994 supports =
2995 "@supports (display:grid) {" ++ modernGrid ++ "}"
2996 in
2997 [ base
2998 , supports
3001 GridPosition position ->
3002 let
3003 class =
3004 ".grid-pos-"
3005 ++ String.fromInt position.row
3006 ++ "-"
3007 ++ String.fromInt position.col
3008 ++ "-"
3009 ++ String.fromInt position.width
3010 ++ "-"
3011 ++ String.fromInt position.height
3013 msPosition =
3014 String.join " "
3015 [ "-ms-grid-row: "
3016 ++ String.fromInt position.row
3017 ++ ";"
3018 , "-ms-grid-row-span: "
3019 ++ String.fromInt position.height
3020 ++ ";"
3021 , "-ms-grid-column: "
3022 ++ String.fromInt position.col
3023 ++ ";"
3024 , "-ms-grid-column-span: "
3025 ++ String.fromInt position.width
3026 ++ ";"
3029 base =
3030 class ++ "{" ++ msPosition ++ "}"
3032 modernPosition =
3033 String.join " "
3034 [ "grid-row: "
3035 ++ String.fromInt position.row
3036 ++ " / "
3037 ++ String.fromInt (position.row + position.height)
3038 ++ ";"
3039 , "grid-column: "
3040 ++ String.fromInt position.col
3041 ++ " / "
3042 ++ String.fromInt (position.col + position.width)
3043 ++ ";"
3046 modernGrid =
3047 class ++ "{" ++ modernPosition ++ "}"
3049 supports =
3050 "@supports (display:grid) {" ++ modernGrid ++ "}"
3051 in
3052 [ base
3053 , supports
3056 PseudoSelector class styles ->
3057 let
3058 renderPseudoRule style =
3059 renderStyleRule options style (Just class)
3060 in
3061 List.concatMap renderPseudoRule styles
3063 Transform transform ->
3064 let
3065 val =
3066 transformValue transform
3068 class =
3069 transformClass transform
3070 in
3071 case ( class, val ) of
3072 ( Just cls, Just v ) ->
3073 renderStyle options
3074 maybePseudo
3075 ("." ++ cls)
3076 [ Property "transform"
3080 _ ->
3081 []
3084lengthClassName : Length -> String
3085lengthClassName x =
3086 case x of
3087 Px px ->
3088 String.fromInt px ++ "px"
3090 Content ->
3091 "auto"
3093 Fill i ->
3094 String.fromInt i ++ "fr"
3096 Min min len ->
3097 "min" ++ String.fromInt min ++ lengthClassName len
3099 Max max len ->
3100 "max" ++ String.fromInt max ++ lengthClassName len
3103formatDropShadow shadow =
3104 String.join " "
3105 [ String.fromFloat (Tuple.first shadow.offset) ++ "px"
3106 , String.fromFloat (Tuple.second shadow.offset) ++ "px"
3107 , String.fromFloat shadow.blur ++ "px"
3108 , formatColor shadow.color
3112formatTextShadow shadow =
3113 String.join " "
3114 [ String.fromFloat (Tuple.first shadow.offset) ++ "px"
3115 , String.fromFloat (Tuple.second shadow.offset) ++ "px"
3116 , String.fromFloat shadow.blur ++ "px"
3117 , formatColor shadow.color
3121textShadowClass shadow =
3122 String.concat
3123 [ "txt"
3124 , floatClass (Tuple.first shadow.offset) ++ "px"
3125 , floatClass (Tuple.second shadow.offset) ++ "px"
3126 , floatClass shadow.blur ++ "px"
3127 , formatColorClass shadow.color
3131formatBoxShadow shadow =
3132 String.join " " <|
3133 List.filterMap identity
3134 [ if shadow.inset then
3135 Just "inset"
3137 else
3138 Nothing
3139 , Just <| String.fromFloat (Tuple.first shadow.offset) ++ "px"
3140 , Just <| String.fromFloat (Tuple.second shadow.offset) ++ "px"
3141 , Just <| String.fromFloat shadow.blur ++ "px"
3142 , Just <| String.fromFloat shadow.size ++ "px"
3143 , Just <| formatColor shadow.color
3147boxShadowClass shadow =
3148 String.concat <|
3149 [ if shadow.inset then
3150 "box-inset"
3152 else
3153 "box-"
3154 , floatClass (Tuple.first shadow.offset) ++ "px"
3155 , floatClass (Tuple.second shadow.offset) ++ "px"
3156 , floatClass shadow.blur ++ "px"
3157 , floatClass shadow.size ++ "px"
3158 , formatColorClass shadow.color
3162floatClass : Float -> String
3163floatClass x =
3164 String.fromInt (round (x * 255))
3167formatColor : Color -> String
3168formatColor (Rgba red green blue alpha) =
3169 "rgba("
3170 ++ String.fromInt (round (red * 255))
3171 ++ ("," ++ String.fromInt (round (green * 255)))
3172 ++ ("," ++ String.fromInt (round (blue * 255)))
3173 ++ ("," ++ String.fromFloat alpha ++ ")")
3176formatColorClass : Color -> String
3177formatColorClass (Rgba red green blue alpha) =
3178 floatClass red
3179 ++ "-"
3180 ++ floatClass green
3181 ++ "-"
3182 ++ floatClass blue
3183 ++ "-"
3184 ++ floatClass alpha
3187spacingName x y =
3188 "spacing-" ++ String.fromInt x ++ "-" ++ String.fromInt y
3191paddingName top right bottom left =
3192 "pad-"
3193 ++ String.fromInt top
3194 ++ "-"
3195 ++ String.fromInt right
3196 ++ "-"
3197 ++ String.fromInt bottom
3198 ++ "-"
3199 ++ String.fromInt left
3202paddingNameFloat top right bottom left =
3203 "pad-"
3204 ++ floatClass top
3205 ++ "-"
3206 ++ floatClass right
3207 ++ "-"
3208 ++ floatClass bottom
3209 ++ "-"
3210 ++ floatClass left
3213getStyleName : Style -> String
3214getStyleName style =
3215 case style of
3216 Shadows name _ ->
3217 name
3219 Transparency name o ->
3220 name
3222 Style class _ ->
3223 class
3225 FontFamily name _ ->
3226 name
3228 FontSize i ->
3229 "font-size-" ++ String.fromInt i
3231 Single class _ _ ->
3232 class
3234 Colored class _ _ ->
3235 class
3237 SpacingStyle cls x y ->
3238 cls
3240 PaddingStyle cls top right bottom left ->
3241 cls
3243 BorderWidth cls top right bottom left ->
3244 cls
3246 GridTemplateStyle template ->
3247 "grid-rows-"
3248 ++ String.join "-" (List.map lengthClassName template.rows)
3249 ++ "-cols-"
3250 ++ String.join "-" (List.map lengthClassName template.columns)
3251 ++ "-space-x-"
3252 ++ lengthClassName (Tuple.first template.spacing)
3253 ++ "-space-y-"
3254 ++ lengthClassName (Tuple.second template.spacing)
3256 GridPosition pos ->
3257 "gp grid-pos-"
3258 ++ String.fromInt pos.row
3259 ++ "-"
3260 ++ String.fromInt pos.col
3261 ++ "-"
3262 ++ String.fromInt pos.width
3263 ++ "-"
3264 ++ String.fromInt pos.height
3266 PseudoSelector selector subStyle ->
3267 let
3268 name =
3269 case selector of
3270 Focus ->
3271 "fs"
3273 Hover ->
3274 "hv"
3276 Active ->
3277 "act"
3278 in
3279 List.map
3280 (\sty ->
3281 case getStyleName sty of
3282 "" ->
3283 ""
3285 styleName ->
3286 styleName ++ "-" ++ name
3288 subStyle
3289 |> String.join " "
3291 Transform x ->
3292 Maybe.withDefault "" (transformClass x)
3296{- Constants -}
3299asGrid : LayoutContext
3300asGrid =
3301 AsGrid
3304asRow : LayoutContext
3305asRow =
3306 AsRow
3309asColumn : LayoutContext
3310asColumn =
3311 AsColumn
3314asEl : LayoutContext
3315asEl =
3316 AsEl
3319asParagraph : LayoutContext
3320asParagraph =
3321 AsParagraph
3324asTextColumn : LayoutContext
3325asTextColumn =
3326 AsTextColumn
3330{- Mapping -}
3333map : (msg -> msg1) -> Element msg -> Element msg1
3334map fn el =
3335 case el of
3336 Styled styled ->
3337 Styled
3338 { styles = styled.styles
3339 , html = \add context -> VirtualDom.map fn <| styled.html add context
3342 Unstyled html ->
3343 Unstyled (VirtualDom.map fn << html)
3345 Text str ->
3346 Text str
3348 Empty ->
3349 Empty
3352mapAttr : (msg -> msg1) -> Attribute aligned msg -> Attribute aligned msg1
3353mapAttr fn attr =
3354 case attr of
3355 NoAttribute ->
3356 NoAttribute
3358 Describe description ->
3359 Describe description
3361 AlignX x ->
3362 AlignX x
3364 AlignY y ->
3365 AlignY y
3367 Width x ->
3368 Width x
3370 Height x ->
3371 Height x
3373 Class x y ->
3374 Class x y
3376 StyleClass flag style ->
3377 StyleClass flag style
3379 Nearby location elem ->
3380 Nearby location (map fn elem)
3382 Attr htmlAttr ->
3383 Attr (VirtualDom.mapAttribute fn htmlAttr)
3385 TransformComponent fl trans ->
3386 TransformComponent fl trans
3389mapAttrFromStyle : (msg -> msg1) -> Attribute Never msg -> Attribute () msg1
3390mapAttrFromStyle fn attr =
3391 case attr of
3392 NoAttribute ->
3393 NoAttribute
3395 Describe description ->
3396 Describe description
3398 AlignX x ->
3399 AlignX x
3401 AlignY y ->
3402 AlignY y
3404 Width x ->
3405 Width x
3407 Height x ->
3408 Height x
3410 -- invalidation key "border-color" as opposed to "border-color-10-10-10" that will be the key for the class
3411 Class x y ->
3412 Class x y
3414 StyleClass flag style ->
3415 StyleClass flag style
3417 Nearby location elem ->
3418 Nearby location (map fn elem)
3420 Attr htmlAttr ->
3421 Attr (VirtualDom.mapAttribute fn htmlAttr)
3423 TransformComponent fl trans ->
3424 TransformComponent fl trans
3427unwrapDecorations : List (Attribute Never Never) -> List Style
3428unwrapDecorations attrs =
3429 case List.foldl unwrapDecsHelper ( [], Untransformed ) attrs of
3430 ( styles, transform ) ->
3431 Transform transform :: styles
3434unwrapDecsHelper attr ( styles, trans ) =
3435 case removeNever attr of
3436 StyleClass _ style ->
3437 ( style :: styles, trans )
3439 TransformComponent flag component ->
3440 ( styles, composeTransformation trans component )
3442 _ ->
3443 ( styles, trans )
3446removeNever : Attribute Never Never -> Attribute () msg
3447removeNever style =
3448 mapAttrFromStyle Basics.never style
3451tag : String -> Style -> Style
3452tag label style =
3453 case style of
3454 Single class prop val ->
3455 Single (label ++ "-" ++ class) prop val
3457 Colored class prop val ->
3458 Colored (label ++ "-" ++ class) prop val
3460 Style class props ->
3461 Style (label ++ "-" ++ class) props
3463 Transparency class o ->
3464 Transparency (label ++ "-" ++ class) o
3466 x ->
3470onlyStyles : Attribute aligned msg -> Maybe Style
3471onlyStyles attr =
3472 case attr of
3473 StyleClass _ style ->
3474 Just style
3476 _ ->
3477 Nothing
3481{- Font Adjustments -}
3484convertAdjustment adjustment =
3485 let
3486 lineHeight =
3487 1.5
3489 base =
3490 lineHeight
3492 normalDescender =
3493 (lineHeight - 1)
3494 / 2
3496 oldMiddle =
3497 lineHeight / 2
3499 newCapitalMiddle =
3500 ((ascender - newBaseline) / 2) + newBaseline
3502 newFullMiddle =
3503 ((ascender - descender) / 2) + descender
3505 lines =
3506 [ adjustment.capital
3507 , adjustment.baseline
3508 , adjustment.descender
3509 , adjustment.lowercase
3512 ascender =
3513 Maybe.withDefault adjustment.capital (List.maximum lines)
3515 descender =
3516 Maybe.withDefault adjustment.descender (List.minimum lines)
3518 newBaseline =
3519 lines
3520 |> List.filter (\x -> x /= descender)
3521 |> List.minimum
3522 |> Maybe.withDefault adjustment.baseline
3524 capitalVertical =
3525 1 - ascender
3527 capitalSize =
3528 1 / (ascender - newBaseline)
3530 fullSize =
3531 1 / (ascender - descender)
3533 fullVertical =
3534 1 - ascender
3536 -- (oldMiddle - newFullMiddle) * 2
3537 in
3538 { full =
3539 adjust fullSize (ascender - descender) fullVertical
3540 , capital =
3541 adjust capitalSize (ascender - newBaseline) capitalVertical
3545adjust size height vertical =
3546 { vertical = vertical
3547 , height =
3548 height / size
3549 , size = size