{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DerivingStrategies #-}

{- |
Module:      Web.Atomic.CSS.Layout
Copyright:   (c) 2023 Sean Hess
License:     BSD3
Maintainer:  Sean Hess <seanhess@gmail.com>
Stability:   experimental
Portability: portable

We can intuitively create layouts by combining of 'flexRow', 'flexCol', 'grow', and 'stack'


@
holygrail = do
  el ~ flexCol . grow $ do
    el ~ flexRow $ "Top Bar"
    el ~ flexRow . grow $ do
      el ~ flexCol $ "Left Sidebar"
      el ~ flexCol . grow $ "Main Content"
      el ~ flexCol $ "Right Sidebar"
    el ~ flexRow $ "Bottom Bar"
@

Also see 'Web.Atomic.Html.Tag.col',  'Web.Atomic.Html.Tag.row', and  'Web.Atomic.Html.Tag.space'
-}
module Web.Atomic.CSS.Layout where

import Web.Atomic.CSS.Box (sides')
import Web.Atomic.Types


{- | Lay out children in a column. See 'Web.Atomic.Html.Tag.col'

> el ~ flexCol $ do
>    el "Top"
>    el " - " ~ grow
>    el "Bottom"
-}


flexCol :: (Styleable h) => CSS h -> CSS h
flexCol :: forall h. Styleable h => CSS h -> CSS h
flexCol =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility
    ClassName
"col"
    [ Property
"display" Property -> Style -> Declaration
:. Style
"flex"
    , Property
"flex-direction" Property -> Style -> Declaration
:. FlexDirection -> Style
forall a. ToStyle a => a -> Style
style FlexDirection
Column
    ]

{- | Lay out children in a row. See 'Web.Atomic.Html.Tag.row'

> el ~ flexRow $ do
>    el "Left"
>    el " - " ~ grow
>    el "Right"
-}
flexRow :: (Styleable h) => CSS h -> CSS h
flexRow :: forall h. Styleable h => CSS h -> CSS h
flexRow =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility
    ClassName
"row"
    [ Property
"display" Property -> Style -> Declaration
:. Style
"flex"
    , Property
"flex-direction" Property -> Style -> Declaration
:. FlexDirection -> Style
forall a. ToStyle a => a -> Style
style FlexDirection
Row
    ]




-- | Grow to fill the available space in the parent 'flexRow' or 'flexCol'
grow :: (Styleable h) => CSS h -> CSS h
grow :: forall h. Styleable h => CSS h -> CSS h
grow = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility ClassName
"grow" [Property
"flex-grow" Property -> Style -> Declaration
:. Style
"1"]


-- space :: (IsHtml h, AppliedParent h ~ h, Styleable h) => h
-- space = el ~ grow $ none

{- | Stack children on top of each other as layers. Each layer has the full width. See 'popup'

> el ~ stack $ do
>   el "Background"
>   el ~ bg Black . opacity 0.5 $ "Overlay"
-}
stack :: (Styleable h) => CSS h -> CSS h
stack :: forall h. Styleable h => CSS h -> CSS h
stack =
  CSS h -> CSS h
container (CSS h -> CSS h) -> (CSS h -> CSS h) -> CSS h -> CSS h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSS h -> CSS h
absChildren
 where
  container :: CSS h -> CSS h
container =
    ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility
      ClassName
"stack"
      [ Property
"position" Property -> Style -> Declaration
:. Style
"relative"
      , Property
"display" Property -> Style -> Declaration
:. Style
"grid"
      , Property
"overflow" Property -> Style -> Declaration
:. Style
"visible"
      ]

  absChildren :: CSS h -> CSS h
absChildren =
    ClassName -> Selector -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> Selector -> [Declaration] -> CSS h -> CSS h
css
      ClassName
"stack-child"
      Selector
".stack-child > *"
      [ Property
"grid-area" Property -> Style -> Declaration
:. Style
"1 / 1"
      , Property
"min-height" Property -> Style -> Declaration
:. Style
"fit-content"
      ]


{- | Place an element above others, out of the flow of the page

> el ~ stack $ do
>   input @ value "Autocomplete Box"
>   el ~ popup (TL 10 10) $ do
>     el "Item 1"
>     el "Item 2"
>     el "Item 3"
> el "This would be covered by the menu"
-}
popup :: (Styleable h) => Sides Length -> CSS h -> CSS h
popup :: forall h. Styleable h => Sides Length -> CSS h -> CSS h
popup Sides Length
sides =
  Position -> CSS h -> CSS h
forall h. Styleable h => Position -> CSS h -> CSS h
position Position
Absolute (CSS h -> CSS h) -> (CSS h -> CSS h) -> CSS h -> CSS h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sides Length -> CSS h -> CSS h
forall h. Styleable h => Sides Length -> CSS h -> CSS h
inset Sides Length
sides


-- | Set 'top', 'bottom', 'right', and 'left' all at once
inset :: (Styleable h) => Sides Length -> CSS h -> CSS h
inset :: forall h. Styleable h => Sides Length -> CSS h -> CSS h
inset = (Length -> CSS h -> CSS h)
-> (Length -> CSS h -> CSS h)
-> (Length -> CSS h -> CSS h)
-> (Length -> CSS h -> CSS h)
-> (Length -> CSS h -> CSS h)
-> Sides Length
-> CSS h
-> CSS h
forall h a.
(Styleable h, ToStyle a, ToClassName a, Num a) =>
(a -> CSS h -> CSS h)
-> (a -> CSS h -> CSS h)
-> (a -> CSS h -> CSS h)
-> (a -> CSS h -> CSS h)
-> (a -> CSS h -> CSS h)
-> Sides a
-> CSS h
-> CSS h
sides' (\Length
n -> Length -> CSS h -> CSS h
forall h. Styleable h => Length -> CSS h -> CSS h
top Length
n (CSS h -> CSS h) -> (CSS h -> CSS h) -> CSS h -> CSS h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Length -> CSS h -> CSS h
forall h. Styleable h => Length -> CSS h -> CSS h
right Length
n (CSS h -> CSS h) -> (CSS h -> CSS h) -> CSS h -> CSS h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Length -> CSS h -> CSS h
forall h. Styleable h => Length -> CSS h -> CSS h
bottom Length
n (CSS h -> CSS h) -> (CSS h -> CSS h) -> CSS h -> CSS h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Length -> CSS h -> CSS h
forall h. Styleable h => Length -> CSS h -> CSS h
left Length
n) Length -> CSS h -> CSS h
forall h. Styleable h => Length -> CSS h -> CSS h
top Length -> CSS h -> CSS h
forall h. Styleable h => Length -> CSS h -> CSS h
right Length -> CSS h -> CSS h
forall h. Styleable h => Length -> CSS h -> CSS h
bottom Length -> CSS h -> CSS h
forall h. Styleable h => Length -> CSS h -> CSS h
left


top :: (Styleable h) => Length -> CSS h -> CSS h
top :: forall h. Styleable h => Length -> CSS h -> CSS h
top Length
l = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"top" ClassName -> Length -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Length
l) [Property
"top" Property -> Style -> Declaration
:. Length -> Style
forall a. ToStyle a => a -> Style
style Length
l]


bottom :: (Styleable h) => Length -> CSS h -> CSS h
bottom :: forall h. Styleable h => Length -> CSS h -> CSS h
bottom Length
l = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"bottom" ClassName -> Length -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Length
l) [Property
"bottom" Property -> Style -> Declaration
:. Length -> Style
forall a. ToStyle a => a -> Style
style Length
l]


right :: (Styleable h) => Length -> CSS h -> CSS h
right :: forall h. Styleable h => Length -> CSS h -> CSS h
right Length
l = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"right" ClassName -> Length -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Length
l) [Property
"right" Property -> Style -> Declaration
:. Length -> Style
forall a. ToStyle a => a -> Style
style Length
l]


left :: (Styleable h) => Length -> CSS h -> CSS h
left :: forall h. Styleable h => Length -> CSS h -> CSS h
left Length
l = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"left" ClassName -> Length -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Length
l) [Property
"left" Property -> Style -> Declaration
:. Length -> Style
forall a. ToStyle a => a -> Style
style Length
l]


data FlexDirection
  = Row
  | Column
  deriving (Int -> FlexDirection -> ShowS
[FlexDirection] -> ShowS
FlexDirection -> String
(Int -> FlexDirection -> ShowS)
-> (FlexDirection -> String)
-> ([FlexDirection] -> ShowS)
-> Show FlexDirection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlexDirection -> ShowS
showsPrec :: Int -> FlexDirection -> ShowS
$cshow :: FlexDirection -> String
show :: FlexDirection -> String
$cshowList :: [FlexDirection] -> ShowS
showList :: [FlexDirection] -> ShowS
Show, FlexDirection -> Style
(FlexDirection -> Style) -> ToStyle FlexDirection
forall a. (a -> Style) -> ToStyle a
$cstyle :: FlexDirection -> Style
style :: FlexDirection -> Style
ToStyle)
instance ToClassName FlexDirection where
  toClassName :: FlexDirection -> ClassName
toClassName FlexDirection
Row = ClassName
"row"
  toClassName FlexDirection
Column = ClassName
"col"


flexDirection :: (Styleable h) => FlexDirection -> CSS h -> CSS h
flexDirection :: forall h. Styleable h => FlexDirection -> CSS h -> CSS h
flexDirection FlexDirection
dir = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (FlexDirection -> ClassName
forall a. ToClassName a => a -> ClassName
toClassName FlexDirection
dir) [Property
"flex-direction" Property -> Style -> Declaration
:. FlexDirection -> Style
forall a. ToStyle a => a -> Style
style FlexDirection
dir]


data FlexWrap
  = WrapReverse
  deriving (Int -> FlexWrap -> ShowS
[FlexWrap] -> ShowS
FlexWrap -> String
(Int -> FlexWrap -> ShowS)
-> (FlexWrap -> String) -> ([FlexWrap] -> ShowS) -> Show FlexWrap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FlexWrap -> ShowS
showsPrec :: Int -> FlexWrap -> ShowS
$cshow :: FlexWrap -> String
show :: FlexWrap -> String
$cshowList :: [FlexWrap] -> ShowS
showList :: [FlexWrap] -> ShowS
Show, FlexWrap -> Style
(FlexWrap -> Style) -> ToStyle FlexWrap
forall a. (a -> Style) -> ToStyle a
$cstyle :: FlexWrap -> Style
style :: FlexWrap -> Style
ToStyle)
instance PropertyStyle FlexWrap FlexWrap
instance PropertyStyle FlexWrap Wrap
instance ToClassName FlexWrap where
  toClassName :: FlexWrap -> ClassName
toClassName FlexWrap
WrapReverse = ClassName
"rev"


{- | Set the flex-wrap

@
el ~ flexWrap 'WrapReverse' $ do
  el "one"
  el "two"
  el "three"
el ~ flexWrap 'Wrap' $ do
  el "one"
  el "two"
  el "three"
@
-}
flexWrap :: (PropertyStyle FlexWrap w, ToClassName w, Styleable h) => w -> CSS h -> CSS h
flexWrap :: forall w h.
(PropertyStyle FlexWrap w, ToClassName w, Styleable h) =>
w -> CSS h -> CSS h
flexWrap w
w =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"fwrap" ClassName -> w -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. w
w) [Property
"flex-wrap" Property -> Style -> Declaration
:. forall {k} (property :: k) value.
PropertyStyle property value =>
value -> Style
forall property value.
PropertyStyle property value =>
value -> Style
propertyStyle @FlexWrap w
w]


{- | position:absolute, relative, etc. See 'stack' and 'popup' for a higher-level interface

@
tag "nav" ~ position Fixed . height 100 $ "Navigation bar"
tag "div" ~ flexCol . margin (T 100) $ "Main Content"
@
-}
position :: (Styleable h) => Position -> CSS h -> CSS h
position :: forall h. Styleable h => Position -> CSS h -> CSS h
position Position
p = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"pos" ClassName -> Position -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Position
p) [Property
"position" Property -> Style -> Declaration
:. Position -> Style
forall a. ToStyle a => a -> Style
style Position
p]


data Position
  = Absolute
  | Fixed
  | Sticky
  | Relative
  deriving (Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> String
show :: Position -> String
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
Show, Position -> ClassName
(Position -> ClassName) -> ToClassName Position
forall a. (a -> ClassName) -> ToClassName a
$ctoClassName :: Position -> ClassName
toClassName :: Position -> ClassName
ToClassName, Position -> Style
(Position -> Style) -> ToStyle Position
forall a. (a -> Style) -> ToStyle a
$cstyle :: Position -> Style
style :: Position -> Style
ToStyle)


zIndex :: (Styleable h) => Int -> CSS h -> CSS h
zIndex :: forall h. Styleable h => Int -> CSS h -> CSS h
zIndex Int
n = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"z" ClassName -> Int -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Int
n) [Property
"z-index" Property -> Style -> Declaration
:. Int -> Style
forall a. ToStyle a => a -> Style
style Int
n]


{- | Set container display

@
el ~ (display 'None') $ "none"
el ~ (display 'Block') $ "block"
@
-}
display :: (PropertyStyle Display d, ToClassName d, Styleable h) => d -> CSS h -> CSS h
display :: forall d h.
(PropertyStyle Display d, ToClassName d, Styleable h) =>
d -> CSS h -> CSS h
display d
disp =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"disp" ClassName -> d -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. d
disp) [Property
"display" Property -> Style -> Declaration
:. forall {k} (property :: k) value.
PropertyStyle property value =>
value -> Style
forall property value.
PropertyStyle property value =>
value -> Style
propertyStyle @Display d
disp]


data Display
  = Block
  | Flex
  deriving (Int -> Display -> ShowS
[Display] -> ShowS
Display -> String
(Int -> Display -> ShowS)
-> (Display -> String) -> ([Display] -> ShowS) -> Show Display
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Display -> ShowS
showsPrec :: Int -> Display -> ShowS
$cshow :: Display -> String
show :: Display -> String
$cshowList :: [Display] -> ShowS
showList :: [Display] -> ShowS
Show, Display -> ClassName
(Display -> ClassName) -> ToClassName Display
forall a. (a -> ClassName) -> ToClassName a
$ctoClassName :: Display -> ClassName
toClassName :: Display -> ClassName
ToClassName, Display -> Style
(Display -> Style) -> ToStyle Display
forall a. (a -> Style) -> ToStyle a
$cstyle :: Display -> Style
style :: Display -> Style
ToStyle)
instance PropertyStyle Display Display
instance PropertyStyle Display None


data Visibility
  = Visible
  | Hidden
  deriving (Int -> Visibility -> ShowS
[Visibility] -> ShowS
Visibility -> String
(Int -> Visibility -> ShowS)
-> (Visibility -> String)
-> ([Visibility] -> ShowS)
-> Show Visibility
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Visibility -> ShowS
showsPrec :: Int -> Visibility -> ShowS
$cshow :: Visibility -> String
show :: Visibility -> String
$cshowList :: [Visibility] -> ShowS
showList :: [Visibility] -> ShowS
Show, Visibility -> ClassName
(Visibility -> ClassName) -> ToClassName Visibility
forall a. (a -> ClassName) -> ToClassName a
$ctoClassName :: Visibility -> ClassName
toClassName :: Visibility -> ClassName
ToClassName, Visibility -> Style
(Visibility -> Style) -> ToStyle Visibility
forall a. (a -> Style) -> ToStyle a
$cstyle :: Visibility -> Style
style :: Visibility -> Style
ToStyle)


visibility :: Styleable h => Visibility -> CSS h -> CSS h
visibility :: forall h. Styleable h => Visibility -> CSS h -> CSS h
visibility Visibility
v = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"vis" ClassName -> Visibility -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Visibility
v) [Property
"visibility" Property -> Style -> Declaration
:. Visibility -> Style
forall a. ToStyle a => a -> Style
style Visibility
v]

{- | Set to specific width

> el ~ width 100 $ "100px"
> el ~ width (PxRem 100) $ "100px"
> el ~ width (Pct 50) $ "50pct"
-}
width :: (Styleable h) => Length -> CSS h -> CSS h
width :: forall h. Styleable h => Length -> CSS h -> CSS h
width Length
n = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"w" ClassName -> Length -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Length
n) [ Property
"width" Property -> Style -> Declaration
:. Length -> Style
forall a. ToStyle a => a -> Style
style Length
n ]


height :: (Styleable h) => Length -> CSS h -> CSS h
height :: forall h. Styleable h => Length -> CSS h -> CSS h
height Length
n = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"h" ClassName -> Length -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Length
n) [ Property
"height" Property -> Style -> Declaration
:. Length -> Style
forall a. ToStyle a => a -> Style
style Length
n ]


-- | Allow width to grow to contents but not shrink any smaller than value
minWidth :: (Styleable h) => Length -> CSS h -> CSS h
minWidth :: forall h. Styleable h => Length -> CSS h -> CSS h
minWidth Length
n =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"mw" ClassName -> Length -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Length
n) [Property
"min-width" Property -> Style -> Declaration
:. Length -> Style
forall a. ToStyle a => a -> Style
style Length
n]


-- | Allow height to grow to contents but not shrink any smaller than value
minHeight :: (Styleable h) => Length -> CSS h -> CSS h
minHeight :: forall h. Styleable h => Length -> CSS h -> CSS h
minHeight Length
n =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"mh" ClassName -> Length -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Length
n) [Property
"min-height" Property -> Style -> Declaration
:. Length -> Style
forall a. ToStyle a => a -> Style
style Length
n]


data Overflow
  = Scroll
  | Clip
  deriving (Int -> Overflow -> ShowS
[Overflow] -> ShowS
Overflow -> String
(Int -> Overflow -> ShowS)
-> (Overflow -> String) -> ([Overflow] -> ShowS) -> Show Overflow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Overflow -> ShowS
showsPrec :: Int -> Overflow -> ShowS
$cshow :: Overflow -> String
show :: Overflow -> String
$cshowList :: [Overflow] -> ShowS
showList :: [Overflow] -> ShowS
Show, Overflow -> Style
(Overflow -> Style) -> ToStyle Overflow
forall a. (a -> Style) -> ToStyle a
$cstyle :: Overflow -> Style
style :: Overflow -> Style
ToStyle, Overflow -> ClassName
(Overflow -> ClassName) -> ToClassName Overflow
forall a. (a -> ClassName) -> ToClassName a
$ctoClassName :: Overflow -> ClassName
toClassName :: Overflow -> ClassName
ToClassName)
instance PropertyStyle Overflow Overflow
instance PropertyStyle Overflow Auto
instance PropertyStyle Overflow Visibility


-- | Control how an element clips content that exceeds its bounds 
overflow :: (PropertyStyle Overflow o, ToClassName o, Styleable h) => o -> CSS h -> CSS h
overflow :: forall o h.
(PropertyStyle Overflow o, ToClassName o, Styleable h) =>
o -> CSS h -> CSS h
overflow o
o = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"over" ClassName -> o -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. o
o) [Property
"overflow" Property -> Style -> Declaration
:. forall {k} (property :: k) value.
PropertyStyle property value =>
value -> Style
forall property value.
PropertyStyle property value =>
value -> Style
propertyStyle @Overflow o
o]