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

Type-safe Atomic CSS with composable css utility classes and intuitive layouts. Inspired by Tailwindcss and Elm-UI

@
import Web.Atomic

example = do
  'el' ~ 'flexCol' . 'gap' 10 $ do
    'el' ~ 'bold' . 'fontSize' 32 $ "My page"
    'el' "Hello!"
@

See [Web.Atomic](Web-Atomic.html) for a complete introduction
-}
module Web.Atomic.CSS
  ( -- * Atomic CSS
    Styleable ((~))
  , utility
  , css
  , cls

    -- * CSS Utilities

    -- ** Layout
  , display
  , Display (..)
  , visibility
  , Visibility (..)
  , width
  , height
  , minWidth
  , minHeight
  , position
  , Position (..)
  , inset
  , top
  , bottom
  , right
  , left
  , overflow

    -- ** Flexbox
    -- $flexbox
  , flexRow
  , flexCol
  , grow
  , flexDirection
  , FlexDirection (..)
  , flexWrap
  , FlexWrap (..)

    -- ** Window
  , zIndex

    -- ** Stack
  , stack
  , popup

    -- ** Box Model
  , pad
  , gap
  , margin
  , bg
  , border
  , borderWidth
  , borderColor
  , borderStyle
  , BorderStyle (..)
  , rounded
  , opacity
  , shadow
  , Shadow
  , Inner (..)

    -- ** Text
  , bold
  , fontSize
  , color
  , italic
  , underline
  , textAlign
  , Align (..)
  , whiteSpace
  , WhiteSpace (..)

    -- ** CSS Transitions
  , transition
  , TransitionProperty (..)

    -- ** Elements
  , list
  , ListType (..)
  , pointer

    -- ** Selector Modifiers
  , hover
  , active
  , even
  , odd
  , descendentOf
  , media
  , Media (..)

    -- ** Colors
  , ToColor (..)
  , HexColor (..)

    -- * CSS Reset
  , cssResetEmbed

    -- * Types
  , Property
  , Declaration (..)
  , Style
  , ToStyle (..)
  , PropertyStyle (..)
  , None (..)
  , Auto (..)
  , Normal (..)
  , Length (..)
  , PxRem (..)
  , Ms (..)
  , Wrap (..)
  , Sides (..)
  , CSS

    -- * Other
  , declarations
  , rules
  ) where

import Web.Atomic.CSS.Box hiding (sides, sides')
import Web.Atomic.CSS.Layout
import Web.Atomic.CSS.Reset
import Web.Atomic.CSS.Select hiding (addAncestor, addMedia, addPseudo)
import Web.Atomic.CSS.Text
import Web.Atomic.CSS.Transition
import Web.Atomic.Types
import Prelude hiding (even, odd, truncate)


{- | Set the list style of an item

> tag "ol" $ do
>   tag "li" ~ list Decimal $ "one"
>   tag "li" ~ list Decimal $ "two"
>   tag "li" ~ list Decimal $ "three"
-}
list :: (ToClassName l, PropertyStyle ListType l, Styleable h) => l -> CSS h -> CSS h
list :: forall l h.
(ToClassName l, PropertyStyle ListType l, Styleable h) =>
l -> CSS h -> CSS h
list l
a =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"list" ClassName -> l -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. l
a) [Property
"list-style-type" Property -> Style -> Declaration
:. forall {k} (property :: k) value.
PropertyStyle property value =>
value -> Style
forall property value.
PropertyStyle property value =>
value -> Style
propertyStyle @ListType l
a]


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


{- | Use a button-like cursor when hovering over the element

Button-like elements:

> btn = pointer . bg Primary . hover (bg PrimaryLight)
>
> options = do
>   el ~ btn $ "Login"
>   el ~ btn $ "Sign Up"
-}
pointer :: (Styleable h) => CSS h -> CSS h
pointer :: forall h. Styleable h => CSS h -> CSS h
pointer = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility ClassName
"pointer" [Property
"cursor" Property -> Style -> Declaration
:. Style
"pointer"]


{- $use

See
-}


{- $flexbox

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"
@
-}