{-# LANGUAGE LambdaCase #-}

module Web.Atomic.CSS.Transition where

import Data.Text (Text)
import Web.Atomic.Types


{- | Animate changes to the given property

> el ~ transition 100 (Height 400) $ "Tall"
> el ~ transition 100 (Height 100) $ "Small"
-}
transition :: (Styleable h) => Ms -> TransitionProperty -> CSS h -> CSS h
transition :: forall h. Styleable h => Ms -> TransitionProperty -> CSS h -> CSS h
transition Ms
ms = \case
  (Height PxRem
n) -> Text -> PxRem -> CSS h -> CSS h
forall val h.
(ToClassName val, ToStyle val, Styleable h) =>
Text -> val -> CSS h -> CSS h
trans Text
"height" PxRem
n
  (Width PxRem
n) -> Text -> PxRem -> CSS h -> CSS h
forall val h.
(ToClassName val, ToStyle val, Styleable h) =>
Text -> val -> CSS h -> CSS h
trans Text
"width" PxRem
n
  (BgColor HexColor
c) -> Text -> HexColor -> CSS h -> CSS h
forall val h.
(ToClassName val, ToStyle val, Styleable h) =>
Text -> val -> CSS h -> CSS h
trans Text
"background-color" HexColor
c
  (Color HexColor
c) -> Text -> HexColor -> CSS h -> CSS h
forall val h.
(ToClassName val, ToStyle val, Styleable h) =>
Text -> val -> CSS h -> CSS h
trans Text
"color" HexColor
c
 where
  trans :: (ToClassName val, ToStyle val, Styleable h) => Text -> val -> CSS h -> CSS h
  trans :: forall val h.
(ToClassName val, ToStyle val, Styleable h) =>
Text -> val -> CSS h -> CSS h
trans Text
p val
val =
    ClassName -> [Declaration] -> CSS h -> CSS h
forall h.
Styleable h =>
ClassName -> [Declaration] -> CSS h -> CSS h
utility
      (ClassName
"t" ClassName -> val -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. val
val ClassName -> Text -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Text
p ClassName -> Ms -> ClassName
forall a. ToClassName a => ClassName -> a -> ClassName
-. Ms
ms)
      [ Property
"transition-duration" Property -> Style -> Declaration
:. Ms -> Style
forall a. ToStyle a => a -> Style
style Ms
ms
      , Property
"transition-property" Property -> Style -> Declaration
:. Text -> Style
forall a. ToStyle a => a -> Style
style Text
p
      , Text -> Property
Property Text
p Property -> Style -> Declaration
:. val -> Style
forall a. ToStyle a => a -> Style
style val
val
      ]


-- You MUST set the height/width manually when you attempt to transition it
data TransitionProperty
  = Width PxRem
  | Height PxRem
  | BgColor HexColor
  | Color HexColor
  deriving (Int -> TransitionProperty -> ShowS
[TransitionProperty] -> ShowS
TransitionProperty -> String
(Int -> TransitionProperty -> ShowS)
-> (TransitionProperty -> String)
-> ([TransitionProperty] -> ShowS)
-> Show TransitionProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransitionProperty -> ShowS
showsPrec :: Int -> TransitionProperty -> ShowS
$cshow :: TransitionProperty -> String
show :: TransitionProperty -> String
$cshowList :: [TransitionProperty] -> ShowS
showList :: [TransitionProperty] -> ShowS
Show)