module Web.Atomic.CSS.Text where

import Data.Char (toLower)
import Web.Atomic.Types


bold :: (Styleable h) => CSS h -> CSS h
bold :: forall h. Styleable h => CSS h -> CSS h
bold = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility ClassName
"bold" [Property
"font-weight" Property -> Style -> Declaration
:. Style
"bold"]


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


color :: (Styleable h) => (ToColor clr) => clr -> CSS h -> CSS h
color :: forall h clr. (Styleable h, ToColor clr) => clr -> CSS h -> CSS h
color clr
c = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"clr" ClassName -> Text -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. clr -> Text
forall a. ToColor a => a -> Text
colorName clr
c) [Property
"color" Property -> Style -> Declaration
:. HexColor -> Style
forall a. ToStyle a => a -> Style
style (clr -> HexColor
forall a. ToColor a => a -> HexColor
colorValue clr
c)]


italic :: (Styleable h) => CSS h -> CSS h
italic :: forall h. Styleable h => CSS h -> CSS h
italic = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility ClassName
"italic" [Property
"font-style" Property -> Style -> Declaration
:. Style
"italic"]


underline :: (Styleable h) => CSS h -> CSS h
underline :: forall h. Styleable h => CSS h -> CSS h
underline = ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility ClassName
"underline" [Property
"text-decoration" Property -> Style -> Declaration
:. Style
"underline"]


data Align
  = AlignCenter
  | AlignLeft
  | AlignRight
  | AlignJustify
  deriving (Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Align -> ShowS
showsPrec :: Int -> Align -> ShowS
$cshow :: Align -> String
show :: Align -> String
$cshowList :: [Align] -> ShowS
showList :: [Align] -> ShowS
Show, Align -> ClassName
(Align -> ClassName) -> ToClassName Align
forall a. (a -> ClassName) -> ToClassName a
$ctoClassName :: Align -> ClassName
toClassName :: Align -> ClassName
ToClassName)
instance ToStyle Align where
  style :: Align -> Style
style Align
a = String -> Style
Style (String -> Style) -> ShowS -> String -> Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower (String -> Style) -> String -> Style
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
5 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Align -> String
forall a. Show a => a -> String
show Align
a


textAlign :: (Styleable h) => Align -> CSS h -> CSS h
textAlign :: forall h. Styleable h => Align -> CSS h -> CSS h
textAlign Align
a =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"ta" ClassName -> Align -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Align
a) [Property
"text-align" Property -> Style -> Declaration
:. Align -> Style
forall a. ToStyle a => a -> Style
style Align
a]


data WhiteSpace
  = Pre
  | PreWrap
  | PreLine
  | BreakSpaces
  deriving (Int -> WhiteSpace -> ShowS
[WhiteSpace] -> ShowS
WhiteSpace -> String
(Int -> WhiteSpace -> ShowS)
-> (WhiteSpace -> String)
-> ([WhiteSpace] -> ShowS)
-> Show WhiteSpace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhiteSpace -> ShowS
showsPrec :: Int -> WhiteSpace -> ShowS
$cshow :: WhiteSpace -> String
show :: WhiteSpace -> String
$cshowList :: [WhiteSpace] -> ShowS
showList :: [WhiteSpace] -> ShowS
Show, WhiteSpace -> ClassName
(WhiteSpace -> ClassName) -> ToClassName WhiteSpace
forall a. (a -> ClassName) -> ToClassName a
$ctoClassName :: WhiteSpace -> ClassName
toClassName :: WhiteSpace -> ClassName
ToClassName, WhiteSpace -> Style
(WhiteSpace -> Style) -> ToStyle WhiteSpace
forall a. (a -> Style) -> ToStyle a
$cstyle :: WhiteSpace -> Style
style :: WhiteSpace -> Style
ToStyle)
instance PropertyStyle WhiteSpace Wrap
instance PropertyStyle WhiteSpace Normal
instance PropertyStyle WhiteSpace WhiteSpace


whiteSpace :: (PropertyStyle WhiteSpace w, ToClassName w, Styleable h) => w -> CSS h -> CSS h
whiteSpace :: forall w h.
(PropertyStyle WhiteSpace w, ToClassName w, Styleable h) =>
w -> CSS h -> CSS h
whiteSpace w
w =
  ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility (ClassName
"wspace" ClassName -> w -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. w
w) [Property
"white-space" Property -> Style -> Declaration
:. forall {k} (property :: k) value.
PropertyStyle property value =>
value -> Style
forall property value.
PropertyStyle property value =>
value -> Style
propertyStyle @WhiteSpace w
w]