{-# LANGUAGE
    OverloadedStrings
  , GeneralizedNewtypeDeriving
  #-}
module Clay.Animation
(

-- * The animation propery.

  animation
, animations

-- * Animation-delay.

, animationDelay
, animationDelays

-- * Animation-direction.

, AnimationDirection
, animationDirection
, animationDirections
, alternate
, reverse
, alternateReverse

-- * Animation-duration.

, animationDuration
, animationDurations

, IterationCount
, animationIterationCount
, animationIterationCounts
, infinite
, iterationCount

-- * Animation-action-name.

, AnimationName
, animationName

-- * Animation-play-state.

, PlayState
, animationPlayState
, running
, paused

-- * Animation-fill-mode.

, FillMode
, animationFillMode
, forwards
, backwards

-- * Animation-timing-function.

, animationTimingFunction

)
where

import Data.Monoid
import Data.String (IsString)
import Prelude hiding (reverse)

import Clay.Common
import Clay.Property
import Clay.Stylesheet
import Clay.Time
import Clay.Transition


animation
  :: AnimationName
  -> Time
  -> TimingFunction
  -> Time
  -> IterationCount
  -> AnimationDirection
  -> FillMode
  -> Css
animation :: AnimationName
-> Time
-> TimingFunction
-> Time
-> IterationCount
-> AnimationDirection
-> FillMode
-> Css
animation AnimationName
p Time
de TimingFunction
f Time
du IterationCount
i AnimationDirection
di FillMode
fm = Prefixed
-> (AnimationName,
    (Time,
     (TimingFunction,
      (Time, (IterationCount, (AnimationDirection, FillMode))))))
-> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation") (AnimationName
p AnimationName
-> (Time,
    (TimingFunction,
     (Time, (IterationCount, (AnimationDirection, FillMode)))))
-> (AnimationName,
    (Time,
     (TimingFunction,
      (Time, (IterationCount, (AnimationDirection, FillMode))))))
forall a b. a -> b -> (a, b)
! Time
de Time
-> (TimingFunction,
    (Time, (IterationCount, (AnimationDirection, FillMode))))
-> (Time,
    (TimingFunction,
     (Time, (IterationCount, (AnimationDirection, FillMode)))))
forall a b. a -> b -> (a, b)
! TimingFunction
f TimingFunction
-> (Time, (IterationCount, (AnimationDirection, FillMode)))
-> (TimingFunction,
    (Time, (IterationCount, (AnimationDirection, FillMode))))
forall a b. a -> b -> (a, b)
! Time
du Time
-> (IterationCount, (AnimationDirection, FillMode))
-> (Time, (IterationCount, (AnimationDirection, FillMode)))
forall a b. a -> b -> (a, b)
! IterationCount
i IterationCount
-> (AnimationDirection, FillMode)
-> (IterationCount, (AnimationDirection, FillMode))
forall a b. a -> b -> (a, b)
! AnimationDirection
di AnimationDirection -> FillMode -> (AnimationDirection, FillMode)
forall a b. a -> b -> (a, b)
! FillMode
fm)

animations
  :: [ ( AnimationName
       , Time
       , TimingFunction
       , Time
       , IterationCount
       , AnimationDirection
       , FillMode
       )
     ] -> Css
animations :: [(AnimationName, Time, TimingFunction, Time, IterationCount,
  AnimationDirection, FillMode)]
-> Css
animations = Prefixed -> [Value] -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation")
            ([Value] -> Css)
-> ([(AnimationName, Time, TimingFunction, Time, IterationCount,
      AnimationDirection, FillMode)]
    -> [Value])
-> [(AnimationName, Time, TimingFunction, Time, IterationCount,
     AnimationDirection, FillMode)]
-> Css
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AnimationName, Time, TimingFunction, Time, IterationCount,
  AnimationDirection, FillMode)
 -> Value)
-> [(AnimationName, Time, TimingFunction, Time, IterationCount,
     AnimationDirection, FillMode)]
-> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (\(AnimationName
p, Time
de, TimingFunction
f, Time
du, IterationCount
i, AnimationDirection
di, FillMode
fm) -> (AnimationName,
 (Time,
  (TimingFunction,
   (Time, (IterationCount, (AnimationDirection, FillMode))))))
-> Value
forall a. Val a => a -> Value
value (AnimationName
p AnimationName
-> (Time,
    (TimingFunction,
     (Time, (IterationCount, (AnimationDirection, FillMode)))))
-> (AnimationName,
    (Time,
     (TimingFunction,
      (Time, (IterationCount, (AnimationDirection, FillMode))))))
forall a b. a -> b -> (a, b)
! Time
de Time
-> (TimingFunction,
    (Time, (IterationCount, (AnimationDirection, FillMode))))
-> (Time,
    (TimingFunction,
     (Time, (IterationCount, (AnimationDirection, FillMode)))))
forall a b. a -> b -> (a, b)
! TimingFunction
f TimingFunction
-> (Time, (IterationCount, (AnimationDirection, FillMode)))
-> (TimingFunction,
    (Time, (IterationCount, (AnimationDirection, FillMode))))
forall a b. a -> b -> (a, b)
! Time
du Time
-> (IterationCount, (AnimationDirection, FillMode))
-> (Time, (IterationCount, (AnimationDirection, FillMode)))
forall a b. a -> b -> (a, b)
! IterationCount
i IterationCount
-> (AnimationDirection, FillMode)
-> (IterationCount, (AnimationDirection, FillMode))
forall a b. a -> b -> (a, b)
! AnimationDirection
di AnimationDirection -> FillMode -> (AnimationDirection, FillMode)
forall a b. a -> b -> (a, b)
! FillMode
fm))

-------------------------------------------------------------------------------

animationDelay :: Time -> Css
animationDelay :: Time -> Css
animationDelay = Prefixed -> Time -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-delay")

animationDelays :: [Time] -> Css
animationDelays :: [Time] -> Css
animationDelays = Prefixed -> [Time] -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-delay")

-------------------------------------------------------------------------------

newtype AnimationDirection = AnimationDirection Value
  deriving (AnimationDirection -> Value
(AnimationDirection -> Value) -> Val AnimationDirection
forall a. (a -> Value) -> Val a
value :: AnimationDirection -> Value
$cvalue :: AnimationDirection -> Value
Val, Value -> AnimationDirection
(Value -> AnimationDirection) -> Other AnimationDirection
forall a. (Value -> a) -> Other a
other :: Value -> AnimationDirection
$cother :: Value -> AnimationDirection
Other, AnimationDirection
AnimationDirection -> Normal AnimationDirection
forall a. a -> Normal a
normal :: AnimationDirection
$cnormal :: AnimationDirection
Normal)

animationDirection :: AnimationDirection -> Css
animationDirection :: AnimationDirection -> Css
animationDirection = Prefixed -> AnimationDirection -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-direction")

animationDirections :: [AnimationDirection] -> Css
animationDirections :: [AnimationDirection] -> Css
animationDirections = Prefixed -> [AnimationDirection] -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-direction")

alternate, reverse, alternateReverse :: AnimationDirection
alternate :: AnimationDirection
alternate        = Value -> AnimationDirection
AnimationDirection Value
"alternate"
reverse :: AnimationDirection
reverse          = Value -> AnimationDirection
AnimationDirection Value
"reverse"
alternateReverse :: AnimationDirection
alternateReverse = Value -> AnimationDirection
AnimationDirection Value
"alternate-reverse"

-------------------------------------------------------------------------------

animationDuration :: Time -> Css
animationDuration :: Time -> Css
animationDuration = Prefixed -> Time -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-duration")

animationDurations :: [Time] -> Css
animationDurations :: [Time] -> Css
animationDurations = Prefixed -> [Time] -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-duration")

-------------------------------------------------------------------------------

newtype IterationCount = IterationCount Value
  deriving (IterationCount -> Value
(IterationCount -> Value) -> Val IterationCount
forall a. (a -> Value) -> Val a
value :: IterationCount -> Value
$cvalue :: IterationCount -> Value
Val, Value -> IterationCount
(Value -> IterationCount) -> Other IterationCount
forall a. (Value -> a) -> Other a
other :: Value -> IterationCount
$cother :: Value -> IterationCount
Other, IterationCount
IterationCount -> Normal IterationCount
forall a. a -> Normal a
normal :: IterationCount
$cnormal :: IterationCount
Normal)

animationIterationCount :: IterationCount -> Css
animationIterationCount :: IterationCount -> Css
animationIterationCount = Prefixed -> IterationCount -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-iteration-count")

animationIterationCounts :: [IterationCount] -> Css
animationIterationCounts :: [IterationCount] -> Css
animationIterationCounts = Prefixed -> [IterationCount] -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-iteration-count")

infinite :: IterationCount
infinite :: IterationCount
infinite = Value -> IterationCount
IterationCount Value
"infinite"

iterationCount :: Double -> IterationCount
iterationCount :: Double -> IterationCount
iterationCount = Value -> IterationCount
IterationCount (Value -> IterationCount)
-> (Double -> Value) -> Double -> IterationCount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Value
forall a. Val a => a -> Value
value

-------------------------------------------------------------------------------

newtype AnimationName = AnimationName Value
  deriving (AnimationName -> Value
(AnimationName -> Value) -> Val AnimationName
forall a. (a -> Value) -> Val a
value :: AnimationName -> Value
$cvalue :: AnimationName -> Value
Val, Value -> AnimationName
(Value -> AnimationName) -> Other AnimationName
forall a. (Value -> a) -> Other a
other :: Value -> AnimationName
$cother :: Value -> AnimationName
Other, String -> AnimationName
(String -> AnimationName) -> IsString AnimationName
forall a. (String -> a) -> IsString a
fromString :: String -> AnimationName
$cfromString :: String -> AnimationName
IsString, AnimationName
AnimationName -> Initial AnimationName
forall a. a -> Initial a
initial :: AnimationName
$cinitial :: AnimationName
Initial, AnimationName
AnimationName -> Inherit AnimationName
forall a. a -> Inherit a
inherit :: AnimationName
$cinherit :: AnimationName
Inherit, AnimationName
AnimationName -> Unset AnimationName
forall a. a -> Unset a
unset :: AnimationName
$cunset :: AnimationName
Unset)

animationName :: AnimationName -> Css
animationName :: AnimationName -> Css
animationName = Prefixed -> AnimationName -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-name")

-------------------------------------------------------------------------------

newtype PlayState = PlayState Value
  deriving (PlayState -> Value
(PlayState -> Value) -> Val PlayState
forall a. (a -> Value) -> Val a
value :: PlayState -> Value
$cvalue :: PlayState -> Value
Val, Value -> PlayState
(Value -> PlayState) -> Other PlayState
forall a. (Value -> a) -> Other a
other :: Value -> PlayState
$cother :: Value -> PlayState
Other)

animationPlayState :: PlayState -> Css
animationPlayState :: PlayState -> Css
animationPlayState = Prefixed -> PlayState -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-play-state")

running, paused :: PlayState
running :: PlayState
running = Value -> PlayState
PlayState Value
"running"
paused :: PlayState
paused  = Value -> PlayState
PlayState Value
"paused"

-------------------------------------------------------------------------------

newtype FillMode = FillMode Value
  deriving (FillMode -> Value
(FillMode -> Value) -> Val FillMode
forall a. (a -> Value) -> Val a
value :: FillMode -> Value
$cvalue :: FillMode -> Value
Val, Value -> FillMode
(Value -> FillMode) -> Other FillMode
forall a. (Value -> a) -> Other a
other :: Value -> FillMode
$cother :: Value -> FillMode
Other, FillMode
FillMode -> None FillMode
forall a. a -> None a
none :: FillMode
$cnone :: FillMode
None)

animationFillMode :: FillMode -> Css
animationFillMode :: FillMode -> Css
animationFillMode = Prefixed -> FillMode -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-fill-mode")

forwards, backwards :: FillMode
forwards :: FillMode
forwards  = Value -> FillMode
FillMode Value
"forwards"
backwards :: FillMode
backwards = Value -> FillMode
FillMode Value
"backwards"

-------------------------------------------------------------------------------

animationTimingFunction :: TimingFunction -> Css
animationTimingFunction :: TimingFunction -> Css
animationTimingFunction = Prefixed -> TimingFunction -> Css
forall a. Val a => Prefixed -> a -> Css
prefixed (Prefixed
browsers Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Prefixed
"animation-timing-function")