git.iko.soy/typeable/elm-ui
on be0eaaa help sign in
typeable/elm-ui/src/Internal/Model.elm
3552 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 -- wrap the style node in a div to prevent `Dark Reader` from blowin up the dom.
1822 VirtualDom.node "div"
1823 []
1824 [ VirtualDom.node "style" [] [ VirtualDom.text Internal.Style.rules ] ]
1826 NoStaticStyleSheet ->
1827 VirtualDom.text ""
1829 WithVirtualCss ->
1830 VirtualDom.node "elm-ui-static-rules" [ VirtualDom.property "rules" (Encode.string Internal.Style.rules) ] []
1833addWhen ifThis x to =
1834 if ifThis then
1835 x :: to
1837 else
1838 to
1841{-| TODO:
1843This doesn't reduce equivalent attributes completely.
1846filter : List (Attribute aligned msg) -> List (Attribute aligned msg)
1847filter attrs =
1848 Tuple.first <|
1849 List.foldr
1850 (\x ( found, has ) ->
1851 case x of
1852 NoAttribute ->
1853 ( found, has )
1855 Class key _ ->
1856 ( x :: found, has )
1858 Attr attr ->
1859 ( x :: found, has )
1861 StyleClass _ style ->
1862 ( x :: found, has )
1864 Width width ->
1865 if Set.member "width" has then
1866 ( found, has )
1868 else
1869 ( x :: found, Set.insert "width" has )
1871 Height height ->
1872 if Set.member "height" has then
1873 ( found, has )
1875 else
1876 ( x :: found, Set.insert "height" has )
1878 Describe description ->
1879 if Set.member "described" has then
1880 ( found, has )
1882 else
1883 ( x :: found, Set.insert "described" has )
1885 Nearby location elem ->
1886 ( x :: found, has )
1888 AlignX _ ->
1889 if Set.member "align-x" has then
1890 ( found, has )
1892 else
1893 ( x :: found, Set.insert "align-x" has )
1895 AlignY _ ->
1896 if Set.member "align-y" has then
1897 ( found, has )
1899 else
1900 ( x :: found, Set.insert "align-y" has )
1902 TransformComponent _ _ ->
1903 if Set.member "transform" has then
1904 ( found, has )
1906 else
1907 ( x :: found, Set.insert "transform" has )
1909 ( [], Set.empty )
1910 attrs
1913isContent len =
1914 case len of
1915 Content ->
1916 True
1918 Max _ l ->
1919 isContent l
1921 Min _ l ->
1922 isContent l
1924 _ ->
1925 False
1928get : List (Attribute aligned msg) -> (Attribute aligned msg -> Bool) -> List (Attribute aligned msg)
1929get attrs isAttr =
1930 attrs
1931 |> filter
1932 |> List.foldr
1933 (\x found ->
1934 if isAttr x then
1935 x :: found
1937 else
1938 found
1940 []
1943type Spacing
1944 = Spaced String Int Int
1947type Padding
1948 = Padding String Int Int Int Int
1951extractSpacingAndPadding : List (Attribute aligned msg) -> ( Maybe Padding, Maybe Spacing )
1952extractSpacingAndPadding attrs =
1953 List.foldr
1954 (\attr ( pad, spacing ) ->
1955 ( case pad of
1956 Just x ->
1957 pad
1959 Nothing ->
1960 case attr of
1961 StyleClass _ (PaddingStyle name t r b l) ->
1962 Just (Padding name t r b l)
1964 _ ->
1965 Nothing
1966 , case spacing of
1967 Just x ->
1968 spacing
1970 Nothing ->
1971 case attr of
1972 StyleClass _ (SpacingStyle name x y) ->
1973 Just (Spaced name x y)
1975 _ ->
1976 Nothing
1979 ( Nothing, Nothing )
1980 attrs
1983getSpacing : List (Attribute aligned msg) -> ( Int, Int ) -> ( Int, Int )
1984getSpacing attrs default =
1985 attrs
1986 |> List.foldr
1987 (\attr acc ->
1988 case acc of
1989 Just x ->
1990 Just x
1992 Nothing ->
1993 case attr of
1994 StyleClass _ (SpacingStyle _ x y) ->
1995 Just ( x, y )
1997 _ ->
1998 Nothing
2000 Nothing
2001 |> Maybe.withDefault default
2004getWidth : List (Attribute aligned msg) -> Maybe Length
2005getWidth attrs =
2006 attrs
2007 |> List.foldr
2008 (\attr acc ->
2009 case acc of
2010 Just x ->
2011 Just x
2013 Nothing ->
2014 case attr of
2015 Width len ->
2016 Just len
2018 _ ->
2019 Nothing
2021 Nothing
2024getHeight : List (Attribute aligned msg) -> Maybe Length
2025getHeight attrs =
2026 attrs
2027 |> List.foldr
2028 (\attr acc ->
2029 case acc of
2030 Just x ->
2031 Just x
2033 Nothing ->
2034 case attr of
2035 Height len ->
2036 Just len
2038 _ ->
2039 Nothing
2041 Nothing
2044textElementClasses : String
2045textElementClasses =
2046 classes.any
2047 ++ " "
2048 ++ classes.text
2049 ++ " "
2050 ++ classes.widthContent
2051 ++ " "
2052 ++ classes.heightContent
2055textElement : String -> VirtualDom.Node msg
2056textElement str =
2057 Html.div
2058 [ Html.Attributes.class
2059 textElementClasses
2061 [ Html.text str ]
2064textElementFillClasses : String
2065textElementFillClasses =
2066 classes.any
2067 ++ " "
2068 ++ classes.text
2069 ++ " "
2070 ++ classes.widthFill
2071 ++ " "
2072 ++ classes.heightFill
2075textElementFill : String -> VirtualDom.Node msg
2076textElementFill str =
2077 Html.div
2078 [ Html.Attributes.class
2079 textElementFillClasses
2081 [ Html.text str ]
2084type Children x
2085 = Unkeyed (List x)
2086 | Keyed (List ( String, x ))
2089toHtml mode el =
2090 case el of
2091 Unstyled html ->
2092 html asEl
2094 Styled { styles, html } ->
2095 html (mode styles) asEl
2097 Text text ->
2098 textElement text
2100 Empty ->
2101 textElement ""
2104{-| -}
2105renderRoot : List Option -> List (Attribute aligned msg) -> Element msg -> VirtualDom.Node msg
2106renderRoot optionList attributes child =
2107 let
2108 options =
2109 optionsToRecord optionList
2111 embedStyle =
2112 case options.mode of
2113 NoStaticStyleSheet ->
2114 OnlyDynamic options
2116 _ ->
2117 StaticRootAndDynamic options
2118 in
2119 element asEl div attributes (Unkeyed [ child ])
2120 |> toHtml embedStyle
2123type RenderMode
2124 = Layout
2125 | NoStaticStyleSheet
2126 | WithVirtualCss
2129type alias OptionRecord =
2130 { hover : HoverSetting
2131 , focus : FocusStyle
2132 , mode : RenderMode
2136type HoverSetting
2137 = NoHover
2138 | AllowHover
2139 | ForceHover
2142type Option
2143 = HoverOption HoverSetting
2144 | FocusStyleOption FocusStyle
2145 | RenderModeOption RenderMode
2148type alias FocusStyle =
2149 { borderColor : Maybe Color
2150 , shadow : Maybe Shadow
2151 , backgroundColor : Maybe Color
2155type alias Shadow =
2156 { color : Color
2157 , offset : ( Int, Int )
2158 , blur : Int
2159 , size : Int
2163rootStyle : List (Attribute aligned msg)
2164rootStyle =
2165 let
2166 families =
2167 [ Typeface "Open Sans"
2168 , Typeface "Helvetica"
2169 , Typeface "Verdana"
2170 , SansSerif
2172 in
2173 [ StyleClass Flag.bgColor (Colored ("bg-" ++ formatColorClass (Rgba 1 1 1 0)) "background-color" (Rgba 1 1 1 0))
2174 , StyleClass Flag.fontColor (Colored ("fc-" ++ formatColorClass (Rgba 0 0 0 1)) "color" (Rgba 0 0 0 1))
2175 , StyleClass Flag.fontSize (FontSize 20)
2176 , StyleClass Flag.fontFamily <|
2177 FontFamily (List.foldl renderFontClassName "font-" families)
2178 families
2182renderFontClassName : Font -> String -> String
2183renderFontClassName font current =
2184 current
2185 ++ (case font of
2186 Serif ->
2187 "serif"
2189 SansSerif ->
2190 "sans-serif"
2192 Monospace ->
2193 "monospace"
2195 Typeface name ->
2196 name
2197 |> String.toLower
2198 |> String.words
2199 |> String.join "-"
2201 ImportFont name url ->
2202 name
2203 |> String.toLower
2204 |> String.words
2205 |> String.join "-"
2207 FontWith { name } ->
2208 name
2209 |> String.toLower
2210 |> String.words
2211 |> String.join "-"
2215renderFocusStyle :
2216 FocusStyle
2217 -> List Style
2218renderFocusStyle focus =
2219 [ Style (Internal.Style.dot classes.focusedWithin ++ ":focus-within")
2220 (List.filterMap identity
2221 [ Maybe.map (\color -> Property "border-color" (formatColor color)) focus.borderColor
2222 , Maybe.map (\color -> Property "background-color" (formatColor color)) focus.backgroundColor
2223 , Maybe.map
2224 (\shadow ->
2225 Property "box-shadow"
2226 (formatBoxShadow
2227 { color = shadow.color
2228 , offset =
2229 shadow.offset
2230 |> Tuple.mapFirst toFloat
2231 |> Tuple.mapSecond toFloat
2232 , inset = False
2233 , blur =
2234 toFloat shadow.blur
2235 , size =
2236 toFloat shadow.size
2240 focus.shadow
2241 , Just <| Property "outline" "none"
2244 , Style (Internal.Style.dot classes.any ++ ":focus .focusable, " ++ Internal.Style.dot classes.any ++ ".focusable:focus")
2245 (List.filterMap identity
2246 [ Maybe.map (\color -> Property "border-color" (formatColor color)) focus.borderColor
2247 , Maybe.map (\color -> Property "background-color" (formatColor color)) focus.backgroundColor
2248 , Maybe.map
2249 (\shadow ->
2250 Property "box-shadow"
2251 (formatBoxShadow
2252 { color = shadow.color
2253 , offset =
2254 shadow.offset
2255 |> Tuple.mapFirst toFloat
2256 |> Tuple.mapSecond toFloat
2257 , inset = False
2258 , blur = toFloat shadow.blur
2259 , size = toFloat shadow.size
2263 focus.shadow
2264 , Just <| Property "outline" "none"
2270focusDefaultStyle : { backgroundColor : Maybe Color, borderColor : Maybe Color, shadow : Maybe Shadow }
2271focusDefaultStyle =
2272 { backgroundColor = Nothing
2273 , borderColor = Nothing
2274 , shadow =
2275 Just
2276 { color =
2277 Rgba (155 / 255) (203 / 255) 1 1
2278 , offset = ( 0, 0 )
2279 , blur = 0
2280 , size = 3
2285optionsToRecord : List Option -> OptionRecord
2286optionsToRecord options =
2287 let
2288 combine opt record =
2289 case opt of
2290 HoverOption hoverable ->
2291 case record.hover of
2292 Nothing ->
2293 { record | hover = Just hoverable }
2295 _ ->
2296 record
2298 FocusStyleOption focusStyle ->
2299 case record.focus of
2300 Nothing ->
2301 { record | focus = Just focusStyle }
2303 _ ->
2304 record
2306 RenderModeOption renderMode ->
2307 case record.mode of
2308 Nothing ->
2309 { record | mode = Just renderMode }
2311 _ ->
2312 record
2314 andFinally record =
2315 { hover =
2316 case record.hover of
2317 Nothing ->
2318 AllowHover
2320 Just hoverable ->
2321 hoverable
2322 , focus =
2323 case record.focus of
2324 Nothing ->
2325 focusDefaultStyle
2327 Just focusable ->
2328 focusable
2329 , mode =
2330 case record.mode of
2331 Nothing ->
2332 Layout
2334 Just actualMode ->
2335 actualMode
2337 in
2338 andFinally <|
2339 List.foldr combine
2340 { hover = Nothing
2341 , focus = Nothing
2342 , mode = Nothing
2344 options
2347toStyleSheet : OptionRecord -> List Style -> VirtualDom.Node msg
2348toStyleSheet options styleSheet =
2349 case options.mode of
2350 Layout ->
2351 -- wrap the style node in a div to prevent `Dark Reader` from blowin up the dom.
2352 VirtualDom.node "div"
2353 []
2354 [ VirtualDom.node "style"
2355 []
2356 [ VirtualDom.text (toStyleSheetString options styleSheet) ]
2359 NoStaticStyleSheet ->
2360 -- wrap the style node in a div to prevent `Dark Reader` from blowin up the dom.
2361 VirtualDom.node "div"
2362 []
2363 [ VirtualDom.node "style"
2364 []
2365 [ VirtualDom.text (toStyleSheetString options styleSheet) ]
2368 WithVirtualCss ->
2369 VirtualDom.node "elm-ui-rules"
2370 [ VirtualDom.property "rules"
2371 (encodeStyles options styleSheet)
2373 []
2376renderTopLevelValues rules =
2377 let
2378 withImport font =
2379 case font of
2380 ImportFont _ url ->
2381 Just ("@import url('" ++ url ++ "');")
2383 -- FontWith with ->
2384 -- case with.url of
2385 -- Just x ->
2386 -- Just ("@import url('" ++ x ++ "');")
2387 -- Nothing ->
2388 -- Nothing
2389 _ ->
2390 Nothing
2392 allNames =
2393 List.map Tuple.first rules
2395 fontImports ( name, typefaces ) =
2396 let
2397 imports =
2398 String.join "\n" (List.filterMap withImport typefaces)
2399 in
2400 imports
2402 fontAdjustments ( name, typefaces ) =
2403 case typefaceAdjustment typefaces of
2404 Nothing ->
2405 String.join ""
2406 (List.map (renderNullAdjustmentRule name) allNames)
2408 Just adjustment ->
2409 String.join ""
2410 (List.map (renderFontAdjustmentRule name adjustment) allNames)
2411 in
2412 String.join "\n" (List.map fontImports rules)
2413 ++ String.join "\n" (List.map fontAdjustments rules)
2416renderNullAdjustmentRule fontToAdjust otherFontName =
2417 let
2418 name =
2419 if fontToAdjust == otherFontName then
2420 fontToAdjust
2422 else
2423 otherFontName ++ " ." ++ fontToAdjust
2424 in
2425 String.join " "
2426 [ bracket
2427 ("."
2428 ++ name
2429 ++ "."
2430 ++ classes.sizeByCapital
2431 ++ ", "
2432 ++ "."
2433 ++ name
2434 ++ " ."
2435 ++ classes.sizeByCapital
2437 [ ( "line-height", "1" )
2439 , bracket
2440 ("."
2441 ++ name
2442 ++ "."
2443 ++ classes.sizeByCapital
2444 ++ "> ."
2445 ++ Internal.Style.classes.text
2446 ++ ", ."
2447 ++ name
2448 ++ " ."
2449 ++ classes.sizeByCapital
2450 ++ " > ."
2451 ++ Internal.Style.classes.text
2453 [ ( "vertical-align", "0" )
2454 , ( "line-height", "1" )
2459fontRule name modifier ( parentAdj, textAdjustment ) =
2460 [ bracket
2461 ("."
2462 ++ name
2463 ++ "."
2464 ++ modifier
2465 ++ ", "
2466 ++ "."
2467 ++ name
2468 ++ " ."
2469 ++ modifier
2471 parentAdj
2472 , bracket
2473 ("."
2474 ++ name
2475 ++ "."
2476 ++ modifier
2477 ++ "> ."
2478 ++ Internal.Style.classes.text
2479 ++ ", ."
2480 ++ name
2481 ++ " ."
2482 ++ modifier
2483 ++ " > ."
2484 ++ Internal.Style.classes.text
2486 textAdjustment
2490renderFontAdjustmentRule fontToAdjust ( full, capital ) otherFontName =
2491 let
2492 name =
2493 if fontToAdjust == otherFontName then
2494 fontToAdjust
2496 else
2497 otherFontName ++ " ." ++ fontToAdjust
2498 in
2499 String.join " "
2500 (fontRule name classes.sizeByCapital capital ++ fontRule name classes.fullSize full)
2503bracket selector rules =
2504 let
2505 renderPair ( name, val ) =
2506 name ++ ": " ++ val ++ ";"
2507 in
2508 selector ++ " {" ++ String.join "" (List.map renderPair rules) ++ "}"
2511fontAdjustmentRules converted =
2512 ( [ ( "display", "block" )
2514 , [ ( "display", "inline-block" )
2515 , ( "line-height", String.fromFloat converted.height )
2516 , ( "vertical-align", String.fromFloat converted.vertical ++ "em" )
2517 , ( "font-size", String.fromFloat converted.size ++ "em" )
2522typefaceAdjustment typefaces =
2523 List.foldl
2524 (\face found ->
2525 case found of
2526 Nothing ->
2527 case face of
2528 FontWith with ->
2529 case with.adjustment of
2530 Nothing ->
2531 found
2533 Just adjustment ->
2534 Just
2535 ( fontAdjustmentRules
2536 (.full (convertAdjustment adjustment))
2537 , fontAdjustmentRules
2538 (.capital (convertAdjustment adjustment))
2541 _ ->
2542 found
2544 Just _ ->
2545 found
2547 Nothing
2548 typefaces
2551fontName font =
2552 case font of
2553 Serif ->
2554 "serif"
2556 SansSerif ->
2557 "sans-serif"
2559 Monospace ->
2560 "monospace"
2562 Typeface name ->
2563 "\"" ++ name ++ "\""
2565 ImportFont name url ->
2566 "\"" ++ name ++ "\""
2568 FontWith { name } ->
2569 "\"" ++ name ++ "\""
2572topLevelValue rule =
2573 case rule of
2574 FontFamily name typefaces ->
2575 Just ( name, typefaces )
2577 _ ->
2578 Nothing
2581renderProps force (Property key val) existing =
2582 if force then
2583 existing ++ "\n " ++ key ++ ": " ++ val ++ " !important;"
2585 else
2586 existing ++ "\n " ++ key ++ ": " ++ val ++ ";"
2589encodeStyles options stylesheet =
2590 stylesheet
2591 |> List.map
2592 (\style ->
2593 let
2594 styled =
2595 renderStyleRule options style Nothing
2596 in
2597 ( getStyleName style, Encode.list Encode.string styled )
2599 |> Encode.object
2602toStyleSheetString : OptionRecord -> List Style -> String
2603toStyleSheetString options stylesheet =
2604 let
2605 combine style rendered =
2606 { rules = rendered.rules ++ renderStyleRule options style Nothing
2607 , topLevel =
2608 case topLevelValue style of
2609 Nothing ->
2610 rendered.topLevel
2612 Just topLevel ->
2613 topLevel :: rendered.topLevel
2615 in
2616 case List.foldl combine { topLevel = [], rules = [] } stylesheet of
2617 { topLevel, rules } ->
2618 renderTopLevelValues topLevel ++ String.concat rules
2621renderStyle : OptionRecord -> Maybe PseudoClass -> String -> List Property -> List String
2622renderStyle options maybePseudo selector props =
2623 case maybePseudo of
2624 Nothing ->
2625 [ selector ++ "{" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2627 Just pseudo ->
2628 case pseudo of
2629 Hover ->
2630 case options.hover of
2631 NoHover ->
2632 []
2634 ForceHover ->
2635 [ selector ++ "-hv {" ++ List.foldl (renderProps True) "" props ++ "\n}" ]
2637 AllowHover ->
2638 [ selector ++ "-hv:hover {" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2640 Focus ->
2641 let
2642 renderedProps =
2643 List.foldl (renderProps False) "" props
2644 in
2645 [ selector
2646 ++ "-fs:focus {"
2647 ++ renderedProps
2648 ++ "\n}"
2649 , "."
2650 ++ classes.any
2651 ++ ":focus ~ "
2652 ++ selector
2653 ++ "-fs:not(.focus) {"
2654 ++ renderedProps
2655 ++ "\n}"
2656 , "."
2657 ++ classes.any
2658 ++ ":focus "
2659 ++ selector
2660 ++ "-fs {"
2661 ++ renderedProps
2662 ++ "\n}"
2663 , selector
2664 ++ "-fs:focus-within {"
2665 ++ renderedProps
2666 ++ "\n}"
2667 , ".focusable-parent:focus ~ "
2668 ++ "."
2669 ++ classes.any
2670 ++ " "
2671 ++ selector
2672 ++ "-fs {"
2673 ++ renderedProps
2674 ++ "\n}"
2677 Active ->
2678 [ selector ++ "-act:active {" ++ List.foldl (renderProps False) "" props ++ "\n}" ]
2681renderStyleRule : OptionRecord -> Style -> Maybe PseudoClass -> List String
2682renderStyleRule options rule maybePseudo =
2683 case rule of
2684 Style selector props ->
2685 renderStyle options maybePseudo selector props
2687 Shadows name prop ->
2688 renderStyle options
2689 maybePseudo
2690 ("." ++ name)
2691 [ Property "box-shadow" prop
2694 Transparency name transparency ->
2695 let
2696 opacity =
2697 (1 - transparency)
2698 |> min 1
2699 |> max 0
2700 in
2701 renderStyle options
2702 maybePseudo
2703 ("." ++ name)
2704 [ Property "opacity" (String.fromFloat opacity)
2707 FontSize i ->
2708 renderStyle options
2709 maybePseudo
2710 (".font-size-" ++ String.fromInt i)
2711 [ Property "font-size" (String.fromInt i ++ "px")
2714 FontFamily name typefaces ->
2715 let
2716 features =
2717 typefaces
2718 |> List.filterMap renderVariants
2719 |> String.join ", "
2721 families =
2722 [ Property "font-family"
2723 (typefaces
2724 |> List.map fontName
2725 |> String.join ", "
2727 , Property "font-feature-settings" features
2728 , Property "font-variant"
2729 (if List.any hasSmallCaps typefaces then
2730 "small-caps"
2732 else
2733 "normal"
2736 in
2737 renderStyle options
2738 maybePseudo
2739 ("." ++ name)
2740 families
2742 Single class prop val ->
2743 renderStyle options
2744 maybePseudo
2745 ("." ++ class)
2746 [ Property prop val
2749 Colored class prop color ->
2750 renderStyle options
2751 maybePseudo
2752 ("." ++ class)
2753 [ Property prop (formatColor color)
2756 SpacingStyle cls x y ->
2757 let
2758 class =
2759 "." ++ cls
2761 halfX =
2762 String.fromFloat (toFloat x / 2) ++ "px"
2764 halfY =
2765 String.fromFloat (toFloat y / 2) ++ "px"
2767 xPx =
2768 String.fromInt x ++ "px"
2770 yPx =
2771 String.fromInt y ++ "px"
2773 row =
2774 "." ++ Internal.Style.classes.row
2776 wrappedRow =
2777 "." ++ Internal.Style.classes.wrapped ++ row
2779 column =
2780 "." ++ Internal.Style.classes.column
2782 page =
2783 "." ++ Internal.Style.classes.page
2785 paragraph =
2786 "." ++ Internal.Style.classes.paragraph
2788 left =
2789 "." ++ Internal.Style.classes.alignLeft
2791 right =
2792 "." ++ Internal.Style.classes.alignRight
2794 any =
2795 "." ++ Internal.Style.classes.any
2797 single =
2798 "." ++ Internal.Style.classes.single
2799 in
2800 List.concat
2801 [ renderStyle options maybePseudo (class ++ row ++ " > " ++ any ++ " + " ++ any) [ Property "margin-left" xPx ]
2803 -- margins don't apply to last element of normal, unwrapped rows
2804 -- , renderStyle options maybePseudo (class ++ row ++ " > " ++ any ++ ":first-child") [ Property "margin" "0" ]
2805 -- For wrapped rows, margins always apply because we handle "canceling out" the other margins manually in the element.
2806 , renderStyle options
2807 maybePseudo
2808 (class ++ wrappedRow ++ " > " ++ any)
2809 [ Property "margin" (halfY ++ " " ++ halfX)
2812 -- , renderStyle options maybePseudo
2813 -- (class ++ wrappedRow ++ " > " ++ any ++ ":last-child")
2814 -- [ Property "margin-right" "0"
2815 -- ]
2816 -- columns
2817 , renderStyle options maybePseudo (class ++ column ++ " > " ++ any ++ " + " ++ any) [ Property "margin-top" yPx ]
2818 , renderStyle options maybePseudo (class ++ page ++ " > " ++ any ++ " + " ++ any) [ Property "margin-top" yPx ]
2819 , renderStyle options maybePseudo (class ++ page ++ " > " ++ left) [ Property "margin-right" xPx ]
2820 , renderStyle options maybePseudo (class ++ page ++ " > " ++ right) [ Property "margin-left" xPx ]
2821 , renderStyle options
2822 maybePseudo
2823 (class ++ paragraph)
2824 [ Property "line-height" ("calc(1em + " ++ String.fromInt y ++ "px)")
2826 , renderStyle options
2827 maybePseudo
2828 ("textarea" ++ any ++ class)
2829 [ Property "line-height" ("calc(1em + " ++ String.fromInt y ++ "px)")
2830 , Property "height" ("calc(100% + " ++ String.fromInt y ++ "px)")
2833 -- , renderStyle options
2834 -- maybePseudo
2835 -- (class ++ paragraph ++ " > " ++ any)
2836 -- [ Property "margin-right" xPx
2837 -- , Property "margin-bottom" yPx
2838 -- ]
2839 , renderStyle options
2840 maybePseudo
2841 (class ++ paragraph ++ " > " ++ left)
2842 [ Property "margin-right" xPx
2844 , renderStyle options
2845 maybePseudo
2846 (class ++ paragraph ++ " > " ++ right)
2847 [ Property "margin-left" xPx
2849 , renderStyle options
2850 maybePseudo
2851 (class ++ paragraph ++ "::after")
2852 [ Property "content" "''"
2853 , Property "display" "block"
2854 , Property "height" "0"
2855 , Property "width" "0"
2856 , Property "margin-top" (String.fromInt (-1 * (y // 2)) ++ "px")
2858 , renderStyle options
2859 maybePseudo
2860 (class ++ paragraph ++ "::before")
2861 [ Property "content" "''"
2862 , Property "display" "block"
2863 , Property "height" "0"
2864 , Property "width" "0"
2865 , Property "margin-bottom" (String.fromInt (-1 * (y // 2)) ++ "px")
2869 PaddingStyle cls top right bottom left ->
2870 let
2871 class =
2872 "."
2873 ++ cls
2874 in
2875 renderStyle options
2876 maybePseudo
2877 class
2878 [ Property "padding"
2879 (String.fromInt top
2880 ++ "px "
2881 ++ String.fromInt right
2882 ++ "px "
2883 ++ String.fromInt bottom
2884 ++ "px "
2885 ++ String.fromInt left
2886 ++ "px"
2890 BorderWidth cls top right bottom left ->
2891 let
2892 class =
2893 "."
2894 ++ cls
2895 in
2896 renderStyle options
2897 maybePseudo
2898 class
2899 [ Property "border-width"
2900 (String.fromInt top
2901 ++ "px "
2902 ++ String.fromInt right
2903 ++ "px "
2904 ++ String.fromInt bottom
2905 ++ "px "
2906 ++ String.fromInt left
2907 ++ "px"
2911 GridTemplateStyle template ->
2912 let
2913 class =
2914 ".grid-rows-"
2915 ++ String.join "-" (List.map lengthClassName template.rows)
2916 ++ "-cols-"
2917 ++ String.join "-" (List.map lengthClassName template.columns)
2918 ++ "-space-x-"
2919 ++ lengthClassName (Tuple.first template.spacing)
2920 ++ "-space-y-"
2921 ++ lengthClassName (Tuple.second template.spacing)
2923 ySpacing =
2924 toGridLength (Tuple.second template.spacing)
2926 xSpacing =
2927 toGridLength (Tuple.first template.spacing)
2929 toGridLength x =
2930 toGridLengthHelper Nothing Nothing x
2932 toGridLengthHelper minimum maximum x =
2933 case x of
2934 Px px ->
2935 String.fromInt px ++ "px"
2937 Content ->
2938 case ( minimum, maximum ) of
2939 ( Nothing, Nothing ) ->
2940 "max-content"
2942 ( Just minSize, Nothing ) ->
2943 "minmax(" ++ String.fromInt minSize ++ "px, " ++ "max-content)"
2945 ( Nothing, Just maxSize ) ->
2946 "minmax(max-content, " ++ String.fromInt maxSize ++ "px)"
2948 ( Just minSize, Just maxSize ) ->
2949 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt maxSize ++ "px)"
2951 Fill i ->
2952 case ( minimum, maximum ) of
2953 ( Nothing, Nothing ) ->
2954 String.fromInt i ++ "fr"
2956 ( Just minSize, Nothing ) ->
2957 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt i ++ "fr" ++ "fr)"
2959 ( Nothing, Just maxSize ) ->
2960 "minmax(max-content, " ++ String.fromInt maxSize ++ "px)"
2962 ( Just minSize, Just maxSize ) ->
2963 "minmax(" ++ String.fromInt minSize ++ "px, " ++ String.fromInt maxSize ++ "px)"
2965 Min m len ->
2966 toGridLengthHelper (Just m) maximum len
2968 Max m len ->
2969 toGridLengthHelper minimum (Just m) len
2971 msColumns =
2972 template.columns
2973 |> List.map toGridLength
2974 |> String.join ySpacing
2975 |> (\x -> "-ms-grid-columns: " ++ x ++ ";")
2977 msRows =
2978 template.columns
2979 |> List.map toGridLength
2980 |> String.join ySpacing
2981 |> (\x -> "-ms-grid-rows: " ++ x ++ ";")
2983 base =
2984 class ++ "{" ++ msColumns ++ msRows ++ "}"
2986 columns =
2987 template.columns
2988 |> List.map toGridLength
2989 |> String.join " "
2990 |> (\x -> "grid-template-columns: " ++ x ++ ";")
2992 rows =
2993 template.rows
2994 |> List.map toGridLength
2995 |> String.join " "
2996 |> (\x -> "grid-template-rows: " ++ x ++ ";")
2998 gapX =
2999 "grid-column-gap:" ++ toGridLength (Tuple.first template.spacing) ++ ";"
3001 gapY =
3002 "grid-row-gap:" ++ toGridLength (Tuple.second template.spacing) ++ ";"
3004 modernGrid =
3005 class ++ "{" ++ columns ++ rows ++ gapX ++ gapY ++ "}"
3007 supports =
3008 "@supports (display:grid) {" ++ modernGrid ++ "}"
3009 in
3010 [ base
3011 , supports
3014 GridPosition position ->
3015 let
3016 class =
3017 ".grid-pos-"
3018 ++ String.fromInt position.row
3019 ++ "-"
3020 ++ String.fromInt position.col
3021 ++ "-"
3022 ++ String.fromInt position.width
3023 ++ "-"
3024 ++ String.fromInt position.height
3026 msPosition =
3027 String.join " "
3028 [ "-ms-grid-row: "
3029 ++ String.fromInt position.row
3030 ++ ";"
3031 , "-ms-grid-row-span: "
3032 ++ String.fromInt position.height
3033 ++ ";"
3034 , "-ms-grid-column: "
3035 ++ String.fromInt position.col
3036 ++ ";"
3037 , "-ms-grid-column-span: "
3038 ++ String.fromInt position.width
3039 ++ ";"
3042 base =
3043 class ++ "{" ++ msPosition ++ "}"
3045 modernPosition =
3046 String.join " "
3047 [ "grid-row: "
3048 ++ String.fromInt position.row
3049 ++ " / "
3050 ++ String.fromInt (position.row + position.height)
3051 ++ ";"
3052 , "grid-column: "
3053 ++ String.fromInt position.col
3054 ++ " / "
3055 ++ String.fromInt (position.col + position.width)
3056 ++ ";"
3059 modernGrid =
3060 class ++ "{" ++ modernPosition ++ "}"
3062 supports =
3063 "@supports (display:grid) {" ++ modernGrid ++ "}"
3064 in
3065 [ base
3066 , supports
3069 PseudoSelector class styles ->
3070 let
3071 renderPseudoRule style =
3072 renderStyleRule options style (Just class)
3073 in
3074 List.concatMap renderPseudoRule styles
3076 Transform transform ->
3077 let
3078 val =
3079 transformValue transform
3081 class =
3082 transformClass transform
3083 in
3084 case ( class, val ) of
3085 ( Just cls, Just v ) ->
3086 renderStyle options
3087 maybePseudo
3088 ("." ++ cls)
3089 [ Property "transform"
3093 _ ->
3094 []
3097lengthClassName : Length -> String
3098lengthClassName x =
3099 case x of
3100 Px px ->
3101 String.fromInt px ++ "px"
3103 Content ->
3104 "auto"
3106 Fill i ->
3107 String.fromInt i ++ "fr"
3109 Min min len ->
3110 "min" ++ String.fromInt min ++ lengthClassName len
3112 Max max len ->
3113 "max" ++ String.fromInt max ++ lengthClassName len
3116formatDropShadow shadow =
3117 String.join " "
3118 [ String.fromFloat (Tuple.first shadow.offset) ++ "px"
3119 , String.fromFloat (Tuple.second shadow.offset) ++ "px"
3120 , String.fromFloat shadow.blur ++ "px"
3121 , formatColor shadow.color
3125formatTextShadow shadow =
3126 String.join " "
3127 [ String.fromFloat (Tuple.first shadow.offset) ++ "px"
3128 , String.fromFloat (Tuple.second shadow.offset) ++ "px"
3129 , String.fromFloat shadow.blur ++ "px"
3130 , formatColor shadow.color
3134textShadowClass shadow =
3135 String.concat
3136 [ "txt"
3137 , floatClass (Tuple.first shadow.offset) ++ "px"
3138 , floatClass (Tuple.second shadow.offset) ++ "px"
3139 , floatClass shadow.blur ++ "px"
3140 , formatColorClass shadow.color
3144formatBoxShadow shadow =
3145 String.join " " <|
3146 List.filterMap identity
3147 [ if shadow.inset then
3148 Just "inset"
3150 else
3151 Nothing
3152 , Just <| String.fromFloat (Tuple.first shadow.offset) ++ "px"
3153 , Just <| String.fromFloat (Tuple.second shadow.offset) ++ "px"
3154 , Just <| String.fromFloat shadow.blur ++ "px"
3155 , Just <| String.fromFloat shadow.size ++ "px"
3156 , Just <| formatColor shadow.color
3160boxShadowClass shadow =
3161 String.concat <|
3162 [ if shadow.inset then
3163 "box-inset"
3165 else
3166 "box-"
3167 , floatClass (Tuple.first shadow.offset) ++ "px"
3168 , floatClass (Tuple.second shadow.offset) ++ "px"
3169 , floatClass shadow.blur ++ "px"
3170 , floatClass shadow.size ++ "px"
3171 , formatColorClass shadow.color
3175floatClass : Float -> String
3176floatClass x =
3177 String.fromInt (round (x * 255))
3180formatColor : Color -> String
3181formatColor (Rgba red green blue alpha) =
3182 "rgba("
3183 ++ String.fromInt (round (red * 255))
3184 ++ ("," ++ String.fromInt (round (green * 255)))
3185 ++ ("," ++ String.fromInt (round (blue * 255)))
3186 ++ ("," ++ String.fromFloat alpha ++ ")")
3189formatColorClass : Color -> String
3190formatColorClass (Rgba red green blue alpha) =
3191 floatClass red
3192 ++ "-"
3193 ++ floatClass green
3194 ++ "-"
3195 ++ floatClass blue
3196 ++ "-"
3197 ++ floatClass alpha
3200spacingName x y =
3201 "spacing-" ++ String.fromInt x ++ "-" ++ String.fromInt y
3204paddingName top right bottom left =
3205 "pad-"
3206 ++ String.fromInt top
3207 ++ "-"
3208 ++ String.fromInt right
3209 ++ "-"
3210 ++ String.fromInt bottom
3211 ++ "-"
3212 ++ String.fromInt left
3215getStyleName : Style -> String
3216getStyleName style =
3217 case style of
3218 Shadows name _ ->
3219 name
3221 Transparency name o ->
3222 name
3224 Style class _ ->
3225 class
3227 FontFamily name _ ->
3228 name
3230 FontSize i ->
3231 "font-size-" ++ String.fromInt i
3233 Single class _ _ ->
3234 class
3236 Colored class _ _ ->
3237 class
3239 SpacingStyle cls x y ->
3240 cls
3242 PaddingStyle cls top right bottom left ->
3243 cls
3245 BorderWidth cls top right bottom left ->
3246 cls
3248 GridTemplateStyle template ->
3249 "grid-rows-"
3250 ++ String.join "-" (List.map lengthClassName template.rows)
3251 ++ "-cols-"
3252 ++ String.join "-" (List.map lengthClassName template.columns)
3253 ++ "-space-x-"
3254 ++ lengthClassName (Tuple.first template.spacing)
3255 ++ "-space-y-"
3256 ++ lengthClassName (Tuple.second template.spacing)
3258 GridPosition pos ->
3259 "gp grid-pos-"
3260 ++ String.fromInt pos.row
3261 ++ "-"
3262 ++ String.fromInt pos.col
3263 ++ "-"
3264 ++ String.fromInt pos.width
3265 ++ "-"
3266 ++ String.fromInt pos.height
3268 PseudoSelector selector subStyle ->
3269 let
3270 name =
3271 case selector of
3272 Focus ->
3273 "fs"
3275 Hover ->
3276 "hv"
3278 Active ->
3279 "act"
3280 in
3281 List.map
3282 (\sty ->
3283 case getStyleName sty of
3284 "" ->
3285 ""
3287 styleName ->
3288 styleName ++ "-" ++ name
3290 subStyle
3291 |> String.join " "
3293 Transform x ->
3294 Maybe.withDefault "" (transformClass x)
3298{- Constants -}
3301asGrid : LayoutContext
3302asGrid =
3303 AsGrid
3306asRow : LayoutContext
3307asRow =
3308 AsRow
3311asColumn : LayoutContext
3312asColumn =
3313 AsColumn
3316asEl : LayoutContext
3317asEl =
3318 AsEl
3321asParagraph : LayoutContext
3322asParagraph =
3323 AsParagraph
3326asTextColumn : LayoutContext
3327asTextColumn =
3328 AsTextColumn
3332{- Mapping -}
3335map : (msg -> msg1) -> Element msg -> Element msg1
3336map fn el =
3337 case el of
3338 Styled styled ->
3339 Styled
3340 { styles = styled.styles
3341 , html = \add context -> VirtualDom.map fn <| styled.html add context
3344 Unstyled html ->
3345 Unstyled (VirtualDom.map fn << html)
3347 Text str ->
3348 Text str
3350 Empty ->
3351 Empty
3354mapAttr : (msg -> msg1) -> Attribute aligned msg -> Attribute aligned msg1
3355mapAttr fn attr =
3356 case attr of
3357 NoAttribute ->
3358 NoAttribute
3360 Describe description ->
3361 Describe description
3363 AlignX x ->
3364 AlignX x
3366 AlignY y ->
3367 AlignY y
3369 Width x ->
3370 Width x
3372 Height x ->
3373 Height x
3375 Class x y ->
3376 Class x y
3378 StyleClass flag style ->
3379 StyleClass flag style
3381 Nearby location elem ->
3382 Nearby location (map fn elem)
3384 Attr htmlAttr ->
3385 Attr (VirtualDom.mapAttribute fn htmlAttr)
3387 TransformComponent fl trans ->
3388 TransformComponent fl trans
3391mapAttrFromStyle : (msg -> msg1) -> Attribute Never msg -> Attribute () msg1
3392mapAttrFromStyle fn attr =
3393 case attr of
3394 NoAttribute ->
3395 NoAttribute
3397 Describe description ->
3398 Describe description
3400 AlignX x ->
3401 AlignX x
3403 AlignY y ->
3404 AlignY y
3406 Width x ->
3407 Width x
3409 Height x ->
3410 Height x
3412 -- invalidation key "border-color" as opposed to "border-color-10-10-10" that will be the key for the class
3413 Class x y ->
3414 Class x y
3416 StyleClass flag style ->
3417 StyleClass flag style
3419 Nearby location elem ->
3420 Nearby location (map fn elem)
3422 Attr htmlAttr ->
3423 Attr (VirtualDom.mapAttribute fn htmlAttr)
3425 TransformComponent fl trans ->
3426 TransformComponent fl trans
3429unwrapDecorations : List (Attribute Never Never) -> List Style
3430unwrapDecorations attrs =
3431 case List.foldl unwrapDecsHelper ( [], Untransformed ) attrs of
3432 ( styles, transform ) ->
3433 Transform transform :: styles
3436unwrapDecsHelper attr ( styles, trans ) =
3437 case removeNever attr of
3438 StyleClass _ style ->
3439 ( style :: styles, trans )
3441 TransformComponent flag component ->
3442 ( styles, composeTransformation trans component )
3444 _ ->
3445 ( styles, trans )
3448removeNever : Attribute Never Never -> Attribute () msg
3449removeNever style =
3450 mapAttrFromStyle Basics.never style
3453tag : String -> Style -> Style
3454tag label style =
3455 case style of
3456 Single class prop val ->
3457 Single (label ++ "-" ++ class) prop val
3459 Colored class prop val ->
3460 Colored (label ++ "-" ++ class) prop val
3462 Style class props ->
3463 Style (label ++ "-" ++ class) props
3465 Transparency class o ->
3466 Transparency (label ++ "-" ++ class) o
3468 x ->
3472onlyStyles : Attribute aligned msg -> Maybe Style
3473onlyStyles attr =
3474 case attr of
3475 StyleClass _ style ->
3476 Just style
3478 _ ->
3479 Nothing
3483{- Font Adjustments -}
3486convertAdjustment adjustment =
3487 let
3488 lineHeight =
3489 1.5
3491 base =
3492 lineHeight
3494 normalDescender =
3495 (lineHeight - 1)
3496 / 2
3498 oldMiddle =
3499 lineHeight / 2
3501 newCapitalMiddle =
3502 ((ascender - newBaseline) / 2) + newBaseline
3504 newFullMiddle =
3505 ((ascender - descender) / 2) + descender
3507 lines =
3508 [ adjustment.capital
3509 , adjustment.baseline
3510 , adjustment.descender
3511 , adjustment.lowercase
3514 ascender =
3515 Maybe.withDefault adjustment.capital (List.maximum lines)
3517 descender =
3518 Maybe.withDefault adjustment.descender (List.minimum lines)
3520 newBaseline =
3521 lines
3522 |> List.filter (\x -> x /= descender)
3523 |> List.minimum
3524 |> Maybe.withDefault adjustment.baseline
3526 capitalVertical =
3527 1 - ascender
3529 capitalSize =
3530 1 / (ascender - newBaseline)
3532 fullSize =
3533 1 / (ascender - descender)
3535 fullVertical =
3536 1 - ascender
3538 -- (oldMiddle - newFullMiddle) * 2
3539 in
3540 { full =
3541 adjust fullSize (ascender - descender) fullVertical
3542 , capital =
3543 adjust capitalSize (ascender - newBaseline) capitalVertical
3547adjust size height vertical =
3548 { vertical = vertical
3549 , height =
3550 height / size
3551 , size = size