{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, OverloadedStrings, PatternSynonyms #-}

{-|
Module      : Css.Easing
Description : Css easing strings in Haskell.
Maintainer  : hapytexeu+gh@gmail.com
Stability   : experimental
Portability : POSIX

A module to define css easing strings. These can be used in Julius, JSON, etc. templates to limit the easings to valid ones.
-}

module Css.Easing (
    -- * Easing patterns
      Easing(Steps, CubicBezier)
    , steps, steps'
    , cubicBezier, cubicBezier'
    -- * Convert to css
    , easingToCss, easingToCssWithCssAliasses, jumpTermToCss
    -- * Jump terms
    , JumpTerm(JumpStart, JumpEnd, JumpNone, JumpBoth)
    , pattern Start, pattern End
    -- * Standard easing aliasses
    , pattern StepsStart, pattern StepsEnd
    , pattern Ease, pattern Linear, pattern EaseIn, pattern EaseOut, pattern EaseInOut
    -- * PostCSS easing aliasses
    , pattern EaseInSine, pattern EaseOutSine, pattern EaseInOutSine
    , pattern EaseInQuad, pattern EaseOutQuad, pattern EaseInOutQuad
    , pattern EaseInCubic, pattern EaseOutCubic, pattern EaseInOutCubic
    , pattern EaseInQuart, pattern EaseOutQuart, pattern EaseInOutQuart
    , pattern EaseInQuint, pattern EaseOutQuint, pattern EaseInOutQuint
    , pattern EaseInExpo, pattern EaseOutExpo, pattern EaseInOutExpo
    , pattern EaseInCirc, pattern EaseOutCirc, pattern EaseInOutCirc
    , pattern EaseInBack, pattern EaseOutBack, pattern EaseInOutBack
  ) where

import Control.DeepSeq(NFData)

import Data.Aeson(Value(String), ToJSON(toJSON))
import Data.Data(Data)
import Data.Default.Class(Default(def))
import Data.Scientific(Scientific, scientific)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.Text(Text, intercalate, pack)

import GHC.Generics(Generic)

import Text.Blaze(ToMarkup(toMarkup), text)
import Text.Julius(ToJavascript(toJavascript))

import Test.QuickCheck(Gen, choose, oneof)
import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary), arbitraryBoundedEnum)

-- references:
--   https://developer.mozilla.org/en-US/docs/Web/CSS/transition-timing-function
--   https://easings.net/en

-- | A type that describes the different types of css-easings (also known as
-- "transition timing functions"). There are basically two modes: 'Steps' and
-- 'CubicBezier's.
data Easing
    = Steps Int JumpTerm
    -- ^ Displays the transition along n stops along the transition, displaying each stop for
    -- equal lengths of time. For example, if n is 5,  there are 5 steps. Whether the transition
    -- holds temporarily at 0%, 20%, 40%, 60% and 80%, on the 20%, 40%, 60%, 80% and 100%, or
    -- makes 5 stops between the 0% and 100% along the transition, or makes 5 stops including
    -- the 0% and 100% marks (on the 0%, 25%, 50%, 75%, and 100%) depends on which of the
    -- 'JumpTerm' is used.
    | CubicBezier Scientific Scientific Scientific Scientific
    -- ^ An author defined cubic-Bezier curve, where the p1 and p3 values must
    -- be in the range of 0 to 1.
    deriving (Typeable Easing
DataType
Constr
Typeable Easing
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Easing -> c Easing)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Easing)
-> (Easing -> Constr)
-> (Easing -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Easing))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Easing))
-> ((forall b. Data b => b -> b) -> Easing -> Easing)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Easing -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Easing -> r)
-> (forall u. (forall d. Data d => d -> u) -> Easing -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Easing -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Easing -> m Easing)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Easing -> m Easing)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Easing -> m Easing)
-> Data Easing
Easing -> DataType
Easing -> Constr
(forall b. Data b => b -> b) -> Easing -> Easing
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Easing -> c Easing
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Easing
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Easing -> u
forall u. (forall d. Data d => d -> u) -> Easing -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Easing -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Easing -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Easing -> m Easing
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Easing -> m Easing
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Easing
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Easing -> c Easing
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Easing)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Easing)
$cCubicBezier :: Constr
$cSteps :: Constr
$tEasing :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Easing -> m Easing
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Easing -> m Easing
gmapMp :: (forall d. Data d => d -> m d) -> Easing -> m Easing
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Easing -> m Easing
gmapM :: (forall d. Data d => d -> m d) -> Easing -> m Easing
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Easing -> m Easing
gmapQi :: Int -> (forall d. Data d => d -> u) -> Easing -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Easing -> u
gmapQ :: (forall d. Data d => d -> u) -> Easing -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Easing -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Easing -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Easing -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Easing -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Easing -> r
gmapT :: (forall b. Data b => b -> b) -> Easing -> Easing
$cgmapT :: (forall b. Data b => b -> b) -> Easing -> Easing
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Easing)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Easing)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Easing)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Easing)
dataTypeOf :: Easing -> DataType
$cdataTypeOf :: Easing -> DataType
toConstr :: Easing -> Constr
$ctoConstr :: Easing -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Easing
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Easing
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Easing -> c Easing
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Easing -> c Easing
$cp1Data :: Typeable Easing
Data, Easing -> Easing -> Bool
(Easing -> Easing -> Bool)
-> (Easing -> Easing -> Bool) -> Eq Easing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Easing -> Easing -> Bool
$c/= :: Easing -> Easing -> Bool
== :: Easing -> Easing -> Bool
$c== :: Easing -> Easing -> Bool
Eq, (forall x. Easing -> Rep Easing x)
-> (forall x. Rep Easing x -> Easing) -> Generic Easing
forall x. Rep Easing x -> Easing
forall x. Easing -> Rep Easing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Easing x -> Easing
$cfrom :: forall x. Easing -> Rep Easing x
Generic, Eq Easing
Eq Easing
-> (Easing -> Easing -> Ordering)
-> (Easing -> Easing -> Bool)
-> (Easing -> Easing -> Bool)
-> (Easing -> Easing -> Bool)
-> (Easing -> Easing -> Bool)
-> (Easing -> Easing -> Easing)
-> (Easing -> Easing -> Easing)
-> Ord Easing
Easing -> Easing -> Bool
Easing -> Easing -> Ordering
Easing -> Easing -> Easing
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Easing -> Easing -> Easing
$cmin :: Easing -> Easing -> Easing
max :: Easing -> Easing -> Easing
$cmax :: Easing -> Easing -> Easing
>= :: Easing -> Easing -> Bool
$c>= :: Easing -> Easing -> Bool
> :: Easing -> Easing -> Bool
$c> :: Easing -> Easing -> Bool
<= :: Easing -> Easing -> Bool
$c<= :: Easing -> Easing -> Bool
< :: Easing -> Easing -> Bool
$c< :: Easing -> Easing -> Bool
compare :: Easing -> Easing -> Ordering
$ccompare :: Easing -> Easing -> Ordering
$cp1Ord :: Eq Easing
Ord, Int -> Easing -> ShowS
[Easing] -> ShowS
Easing -> String
(Int -> Easing -> ShowS)
-> (Easing -> String) -> ([Easing] -> ShowS) -> Show Easing
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Easing] -> ShowS
$cshowList :: [Easing] -> ShowS
show :: Easing -> String
$cshow :: Easing -> String
showsPrec :: Int -> Easing -> ShowS
$cshowsPrec :: Int -> Easing -> ShowS
Show)

instance NFData Easing

-- | Convert an 'Easing' to its css counterpart. The css aliases like
-- @"steps-start"@ are /not/ checked. Therefore, only strings like "@steps(..)"
-- and @cubic-bezier(..)@ are returned.
easingToCss :: Easing -- ^ The given 'Easing' to convert.
    -> Text -- ^ The css counterpart of the given 'Easing'.
easingToCss :: Easing -> Text
easingToCss (Steps Int
n JumpTerm
j) = Text
"steps(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> JumpTerm -> Text
jumpTermToCss JumpTerm
j Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
easingToCss (CubicBezier Scientific
p1 Scientific
p2 Scientific
p3 Scientific
p4) = Text
"cubic-bezier(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ((Scientific -> Text) -> [Scientific] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
pack (String -> Text) -> (Scientific -> String) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> String
forall a. Show a => a -> String
show) [Scientific
p1, Scientific
p2, Scientific
p3, Scientific
p4]) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

-- | Convert an 'Easing' to its css counterpart. The css aliases like
-- @"steps-start"@ are checked, and if they match, the alias is returned.
easingToCssWithCssAliasses :: Easing -- ^ The given 'Easing' to convert.
    -> Text  -- ^ The css counterpart of the given 'Easing'.
easingToCssWithCssAliasses :: Easing -> Text
easingToCssWithCssAliasses Easing
StepsStart = Text
"steps-start"
easingToCssWithCssAliasses Easing
StepsEnd = Text
"steps-end"
easingToCssWithCssAliasses Easing
Linear = Text
"linear"
easingToCssWithCssAliasses Easing
Ease = Text
"ease"
easingToCssWithCssAliasses Easing
EaseIn = Text
"ease-in"
easingToCssWithCssAliasses Easing
EaseInOut = Text
"ease-in-out"
easingToCssWithCssAliasses Easing
EaseOut = Text
"ease-out"
easingToCssWithCssAliasses Easing
e = Easing -> Text
easingToCss Easing
e

-- | A type that is used to describe how the jumps are done in a 'Steps'
-- construction.
data JumpTerm
    = JumpStart -- ^ In css this is denoted as @jump-start@. This denotes a left-continuous function, so that the first jump happens when the transition begins.
    | JumpEnd -- ^ In css this is denoted as @jump-end@. Denotes a right-continuous function, so that the last jump happens when the animation ends.
    | JumpNone -- ^ In css this is denoted as @jump-none@. There is no jump on either end. Instead, holding at both the 0% mark and the 100% mark, each for 1/n of the duration.
    | JumpBoth -- ^ In css this is denoted as @jump-both@. Includes pauses at both the 0% and 100% marks, effectively adding a step during the transition time.
    deriving (JumpTerm
JumpTerm -> JumpTerm -> Bounded JumpTerm
forall a. a -> a -> Bounded a
maxBound :: JumpTerm
$cmaxBound :: JumpTerm
minBound :: JumpTerm
$cminBound :: JumpTerm
Bounded, Typeable JumpTerm
DataType
Constr
Typeable JumpTerm
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> JumpTerm -> c JumpTerm)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c JumpTerm)
-> (JumpTerm -> Constr)
-> (JumpTerm -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c JumpTerm))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JumpTerm))
-> ((forall b. Data b => b -> b) -> JumpTerm -> JumpTerm)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> JumpTerm -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> JumpTerm -> r)
-> (forall u. (forall d. Data d => d -> u) -> JumpTerm -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> JumpTerm -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm)
-> Data JumpTerm
JumpTerm -> DataType
JumpTerm -> Constr
(forall b. Data b => b -> b) -> JumpTerm -> JumpTerm
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JumpTerm -> c JumpTerm
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JumpTerm
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> JumpTerm -> u
forall u. (forall d. Data d => d -> u) -> JumpTerm -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JumpTerm -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JumpTerm -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JumpTerm
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JumpTerm -> c JumpTerm
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JumpTerm)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JumpTerm)
$cJumpBoth :: Constr
$cJumpNone :: Constr
$cJumpEnd :: Constr
$cJumpStart :: Constr
$tJumpTerm :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm
gmapMp :: (forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm
gmapM :: (forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> JumpTerm -> m JumpTerm
gmapQi :: Int -> (forall d. Data d => d -> u) -> JumpTerm -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> JumpTerm -> u
gmapQ :: (forall d. Data d => d -> u) -> JumpTerm -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> JumpTerm -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JumpTerm -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> JumpTerm -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JumpTerm -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> JumpTerm -> r
gmapT :: (forall b. Data b => b -> b) -> JumpTerm -> JumpTerm
$cgmapT :: (forall b. Data b => b -> b) -> JumpTerm -> JumpTerm
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JumpTerm)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c JumpTerm)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c JumpTerm)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c JumpTerm)
dataTypeOf :: JumpTerm -> DataType
$cdataTypeOf :: JumpTerm -> DataType
toConstr :: JumpTerm -> Constr
$ctoConstr :: JumpTerm -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JumpTerm
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c JumpTerm
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JumpTerm -> c JumpTerm
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> JumpTerm -> c JumpTerm
$cp1Data :: Typeable JumpTerm
Data, Int -> JumpTerm
JumpTerm -> Int
JumpTerm -> [JumpTerm]
JumpTerm -> JumpTerm
JumpTerm -> JumpTerm -> [JumpTerm]
JumpTerm -> JumpTerm -> JumpTerm -> [JumpTerm]
(JumpTerm -> JumpTerm)
-> (JumpTerm -> JumpTerm)
-> (Int -> JumpTerm)
-> (JumpTerm -> Int)
-> (JumpTerm -> [JumpTerm])
-> (JumpTerm -> JumpTerm -> [JumpTerm])
-> (JumpTerm -> JumpTerm -> [JumpTerm])
-> (JumpTerm -> JumpTerm -> JumpTerm -> [JumpTerm])
-> Enum JumpTerm
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: JumpTerm -> JumpTerm -> JumpTerm -> [JumpTerm]
$cenumFromThenTo :: JumpTerm -> JumpTerm -> JumpTerm -> [JumpTerm]
enumFromTo :: JumpTerm -> JumpTerm -> [JumpTerm]
$cenumFromTo :: JumpTerm -> JumpTerm -> [JumpTerm]
enumFromThen :: JumpTerm -> JumpTerm -> [JumpTerm]
$cenumFromThen :: JumpTerm -> JumpTerm -> [JumpTerm]
enumFrom :: JumpTerm -> [JumpTerm]
$cenumFrom :: JumpTerm -> [JumpTerm]
fromEnum :: JumpTerm -> Int
$cfromEnum :: JumpTerm -> Int
toEnum :: Int -> JumpTerm
$ctoEnum :: Int -> JumpTerm
pred :: JumpTerm -> JumpTerm
$cpred :: JumpTerm -> JumpTerm
succ :: JumpTerm -> JumpTerm
$csucc :: JumpTerm -> JumpTerm
Enum, JumpTerm -> JumpTerm -> Bool
(JumpTerm -> JumpTerm -> Bool)
-> (JumpTerm -> JumpTerm -> Bool) -> Eq JumpTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JumpTerm -> JumpTerm -> Bool
$c/= :: JumpTerm -> JumpTerm -> Bool
== :: JumpTerm -> JumpTerm -> Bool
$c== :: JumpTerm -> JumpTerm -> Bool
Eq, (forall x. JumpTerm -> Rep JumpTerm x)
-> (forall x. Rep JumpTerm x -> JumpTerm) -> Generic JumpTerm
forall x. Rep JumpTerm x -> JumpTerm
forall x. JumpTerm -> Rep JumpTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JumpTerm x -> JumpTerm
$cfrom :: forall x. JumpTerm -> Rep JumpTerm x
Generic, Eq JumpTerm
Eq JumpTerm
-> (JumpTerm -> JumpTerm -> Ordering)
-> (JumpTerm -> JumpTerm -> Bool)
-> (JumpTerm -> JumpTerm -> Bool)
-> (JumpTerm -> JumpTerm -> Bool)
-> (JumpTerm -> JumpTerm -> Bool)
-> (JumpTerm -> JumpTerm -> JumpTerm)
-> (JumpTerm -> JumpTerm -> JumpTerm)
-> Ord JumpTerm
JumpTerm -> JumpTerm -> Bool
JumpTerm -> JumpTerm -> Ordering
JumpTerm -> JumpTerm -> JumpTerm
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JumpTerm -> JumpTerm -> JumpTerm
$cmin :: JumpTerm -> JumpTerm -> JumpTerm
max :: JumpTerm -> JumpTerm -> JumpTerm
$cmax :: JumpTerm -> JumpTerm -> JumpTerm
>= :: JumpTerm -> JumpTerm -> Bool
$c>= :: JumpTerm -> JumpTerm -> Bool
> :: JumpTerm -> JumpTerm -> Bool
$c> :: JumpTerm -> JumpTerm -> Bool
<= :: JumpTerm -> JumpTerm -> Bool
$c<= :: JumpTerm -> JumpTerm -> Bool
< :: JumpTerm -> JumpTerm -> Bool
$c< :: JumpTerm -> JumpTerm -> Bool
compare :: JumpTerm -> JumpTerm -> Ordering
$ccompare :: JumpTerm -> JumpTerm -> Ordering
$cp1Ord :: Eq JumpTerm
Ord, ReadPrec [JumpTerm]
ReadPrec JumpTerm
Int -> ReadS JumpTerm
ReadS [JumpTerm]
(Int -> ReadS JumpTerm)
-> ReadS [JumpTerm]
-> ReadPrec JumpTerm
-> ReadPrec [JumpTerm]
-> Read JumpTerm
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JumpTerm]
$creadListPrec :: ReadPrec [JumpTerm]
readPrec :: ReadPrec JumpTerm
$creadPrec :: ReadPrec JumpTerm
readList :: ReadS [JumpTerm]
$creadList :: ReadS [JumpTerm]
readsPrec :: Int -> ReadS JumpTerm
$creadsPrec :: Int -> ReadS JumpTerm
Read, Int -> JumpTerm -> ShowS
[JumpTerm] -> ShowS
JumpTerm -> String
(Int -> JumpTerm -> ShowS)
-> (JumpTerm -> String) -> ([JumpTerm] -> ShowS) -> Show JumpTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JumpTerm] -> ShowS
$cshowList :: [JumpTerm] -> ShowS
show :: JumpTerm -> String
$cshow :: JumpTerm -> String
showsPrec :: Int -> JumpTerm -> ShowS
$cshowsPrec :: Int -> JumpTerm -> ShowS
Show)

instance NFData JumpTerm

-- | Convert a 'JumpTerm' to its css counterpart. So 'JumpStart' is for example
-- converted to @"jump-start"@.
jumpTermToCss :: JumpTerm -- ^ The 'JumpTerm' to convert.
    -> Text -- ^ The css counterpart of the given 'JumpTerm'.
jumpTermToCss :: JumpTerm -> Text
jumpTermToCss JumpTerm
JumpStart = Text
"jump-start"
jumpTermToCss JumpTerm
JumpEnd = Text
"jump-end"
jumpTermToCss JumpTerm
JumpNone = Text
"jump-none"
jumpTermToCss JumpTerm
JumpBoth = Text
"jump-both"

_validPoint :: Scientific -> Bool
_validPoint :: Scientific -> Bool
_validPoint Scientific
x = Scientific
0.0 Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
x Bool -> Bool -> Bool
&& Scientific
x Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
1.0

-- | Constructs a 'CubicBezier' given that the first and third value are between @0.0@
-- and @1.0@. If that is the case, it returns a 'Just' that wraps the 'Easing'.
-- Otherwise 'Nothing' is returned.
cubicBezier :: Scientific -> Scientific -> Scientific -> Scientific -> Maybe Easing
cubicBezier :: Scientific
-> Scientific -> Scientific -> Scientific -> Maybe Easing
cubicBezier Scientific
p1 Scientific
p2 Scientific
p3
    | Scientific -> Bool
_validPoint Scientific
p1 Bool -> Bool -> Bool
&& Scientific -> Bool
_validPoint Scientific
p2 = Easing -> Maybe Easing
forall a. a -> Maybe a
Just (Easing -> Maybe Easing)
-> (Scientific -> Easing) -> Scientific -> Maybe Easing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Scientific -> Scientific -> Scientific -> Easing
CubicBezier Scientific
p1 Scientific
p2 Scientific
p3
    | Bool
otherwise = Maybe Easing -> Scientific -> Maybe Easing
forall a b. a -> b -> a
const Maybe Easing
forall a. Maybe a
Nothing

-- | Constructs a 'CubicBezier' given the first and third value are between @0.0@
-- and @1.0@. If this is the case, it returns that 'Easing', otherwise it will
-- raise an error.
cubicBezier' :: Scientific -> Scientific -> Scientific -> Scientific -> Easing
cubicBezier' :: Scientific -> Scientific -> Scientific -> Scientific -> Easing
cubicBezier' Scientific
p1 Scientific
p2 Scientific
p3
    | Scientific -> Bool
_validPoint Scientific
p1 Bool -> Bool -> Bool
&& Scientific -> Bool
_validPoint Scientific
p3 = Scientific -> Scientific -> Scientific -> Scientific -> Easing
CubicBezier Scientific
p1 Scientific
p2 Scientific
p3
    | Bool
otherwise = String -> Scientific -> Easing
forall a. HasCallStack => String -> a
error String
"The first and third value needs to be between 0 and 1."

-- | Constructs a 'Steps' given the first item is strictly greater than zero. If
-- that is the case, it returns the 'Easing' wrapped in a 'Just', otherwise a
-- 'Nothing' is returned.
steps :: Int -> JumpTerm -> Maybe Easing
steps :: Int -> JumpTerm -> Maybe Easing
steps Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Easing -> Maybe Easing
forall a. a -> Maybe a
Just (Easing -> Maybe Easing)
-> (JumpTerm -> Easing) -> JumpTerm -> Maybe Easing
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> JumpTerm -> Easing
Steps Int
n
        | Bool
otherwise = Maybe Easing -> JumpTerm -> Maybe Easing
forall a b. a -> b -> a
const Maybe Easing
forall a. Maybe a
Nothing

-- | Construct a 'Steps' given the first item is strictly greater than ero. If
-- that is the case, it returns the 'Easing' object, otherwise it will raise an
-- error.
steps' :: Int -> JumpTerm -> Easing
steps' :: Int -> JumpTerm -> Easing
steps' Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> JumpTerm -> Easing
Steps Int
n
         | Bool
otherwise = String -> JumpTerm -> Easing
forall a. HasCallStack => String -> a
error String
"The number of steps should be larger than 0."

-- | A pattern that defines the css alias @start@ that is equal to @jump-start@.
pattern Start :: JumpTerm
pattern $bStart :: JumpTerm
$mStart :: forall r. JumpTerm -> (Void# -> r) -> (Void# -> r) -> r
Start = JumpStart

-- | A pattern that defines the css alias @end@ that is equal to @jump-end@.
pattern End :: JumpTerm
pattern $bEnd :: JumpTerm
$mEnd :: forall r. JumpTerm -> (Void# -> r) -> (Void# -> r) -> r
End = JumpEnd

-- | A pattern that defines the css alias @steps-start@ that is equal to @steps(1, jump-start)@.
pattern StepsStart :: Easing
pattern $bStepsStart :: Easing
$mStepsStart :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
StepsStart = Steps 1 JumpStart

-- | A pattern that defines the css alias @steps-end@ that is equal to @steps(1, jump-end)@.
pattern StepsEnd :: Easing
pattern $bStepsEnd :: Easing
$mStepsEnd :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
StepsEnd = Steps 1 JumpEnd

-- | A pattern that defines the css alias @ease@ that is equal to @cubic-bezier(0.25, 0.1, 0.25, 1)@.
pattern Ease :: Easing
pattern $bEase :: Easing
$mEase :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
Ease = CubicBezier 0.25 0.1 0.25 1

-- | A pattern that defines the css alias @linear@ that is equal to @cubic-bezier(0, 0, 1, 1)@.
pattern Linear :: Easing
pattern $bLinear :: Easing
$mLinear :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
Linear = CubicBezier 0 0 1 1

-- | A pattern that defines the css alias @ease-in@ that is equal to @cubic-bezier(0.42, 0, 1, 1)@.
pattern EaseIn :: Easing
pattern $bEaseIn :: Easing
$mEaseIn :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseIn = CubicBezier 0.42 0 1 1

-- | A pattern that defines the css alias @ease-out@ that is equal to @cubic-bezier(0, 0, 0.58, 1)@.
pattern EaseOut :: Easing
pattern $bEaseOut :: Easing
$mEaseOut :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOut = CubicBezier 0 0 0.58 1

-- | A pattern that defines the css alias @ease-in-out@ that is equal to @cubic-bezier(0.42, 0, 0.58, 1)@.
pattern EaseInOut :: Easing
pattern $bEaseInOut :: Easing
$mEaseInOut :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOut = CubicBezier 0.42 0 0.58 1

instance Default Easing where
    def :: Easing
def = Easing
Ease

instance Default JumpTerm where
    def :: JumpTerm
def = JumpTerm
JumpNone

-- PostCSS
-- | A pattern that defines the PostCSS easing pattern @easeInSine@.
pattern EaseInSine :: Easing
pattern $bEaseInSine :: Easing
$mEaseInSine :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInSine = CubicBezier 0.12 0 0.39 0

-- | A pattern that defines the PostCSS easing pattern @easeOutSine@.
pattern EaseOutSine :: Easing
pattern $bEaseOutSine :: Easing
$mEaseOutSine :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOutSine = CubicBezier 0.61 1 0.88 1

-- | A pattern that defines the PostCSS easing pattern @easeInOutSine@.
pattern EaseInOutSine :: Easing
pattern $bEaseInOutSine :: Easing
$mEaseInOutSine :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOutSine = CubicBezier 0.37 0 0.63 1

-- | A pattern that defines the PostCSS easing pattern @easeInQuad@.
pattern EaseInQuad :: Easing
pattern $bEaseInQuad :: Easing
$mEaseInQuad :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInQuad = CubicBezier 0.11 0 0.5 0

-- | A pattern that defines the PostCSS easing pattern @easeOutQuad@.
pattern EaseOutQuad :: Easing
pattern $bEaseOutQuad :: Easing
$mEaseOutQuad :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOutQuad = CubicBezier 0.5 1 0.89 1

-- | A pattern that defines the PostCSS easing pattern @easeInOutQuad@.
pattern EaseInOutQuad :: Easing
pattern $bEaseInOutQuad :: Easing
$mEaseInOutQuad :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOutQuad = CubicBezier 0.45 0 0.55 1

-- | A pattern that defines the PostCSS easing pattern @easeInCubic@.
pattern EaseInCubic :: Easing
pattern $bEaseInCubic :: Easing
$mEaseInCubic :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInCubic = CubicBezier 0.32 0 0.67 0

-- | A pattern that defines the PostCSS easing pattern @easeOutCubic@.
pattern EaseOutCubic :: Easing
pattern $bEaseOutCubic :: Easing
$mEaseOutCubic :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOutCubic = CubicBezier 0.33 1 0.68 1

-- | A pattern that defines the PostCSS easing pattern @easeInOutCubic@.
pattern EaseInOutCubic :: Easing
pattern $bEaseInOutCubic :: Easing
$mEaseInOutCubic :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOutCubic = CubicBezier 0.65 0 0.35 1

-- | A pattern that defines the PostCSS easing pattern @easeInQuart@.
pattern EaseInQuart :: Easing
pattern $bEaseInQuart :: Easing
$mEaseInQuart :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInQuart = CubicBezier 0.5 0 0.75 0

-- | A pattern that defines the PostCSS easing pattern @easeOutQuart@.
pattern EaseOutQuart :: Easing
pattern $bEaseOutQuart :: Easing
$mEaseOutQuart :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOutQuart = CubicBezier 0.25 1 0.5 1

-- | A pattern that defines the PostCSS easing pattern @easeInOutQuart@.
pattern EaseInOutQuart :: Easing
pattern $bEaseInOutQuart :: Easing
$mEaseInOutQuart :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOutQuart = CubicBezier 0.76 0 0.24 1

-- | A pattern that defines the PostCSS easing pattern @easeInQuint@.
pattern EaseInQuint :: Easing
pattern $bEaseInQuint :: Easing
$mEaseInQuint :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInQuint = CubicBezier 0.64 0 0.78 0

-- | A pattern that defines the PostCSS easing pattern @easeOutQuint@.
pattern EaseOutQuint :: Easing
pattern $bEaseOutQuint :: Easing
$mEaseOutQuint :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOutQuint = CubicBezier 0.22 1 0.36 1

-- | A pattern that defines the PostCSS easing pattern @easeInOutQuint@.
pattern EaseInOutQuint :: Easing
pattern $bEaseInOutQuint :: Easing
$mEaseInOutQuint :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOutQuint = CubicBezier 0.83 0 0.17 1

-- | A pattern that defines the PostCSS easing pattern @easeInExpo@.
pattern EaseInExpo :: Easing
pattern $bEaseInExpo :: Easing
$mEaseInExpo :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInExpo = CubicBezier 0.7 0 0.84 0

-- | A pattern that defines the PostCSS easing pattern @easeOutExpo@.
pattern EaseOutExpo :: Easing
pattern $bEaseOutExpo :: Easing
$mEaseOutExpo :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOutExpo = CubicBezier 0.16 1 0.3 1

-- | A pattern that defines the PostCSS easing pattern @easeInOutExpo@.
pattern EaseInOutExpo :: Easing
pattern $bEaseInOutExpo :: Easing
$mEaseInOutExpo :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOutExpo = CubicBezier 0.87 0 0.13 1

-- | A pattern that defines the PostCSS easing pattern @easeInCirc@.
pattern EaseInCirc :: Easing
pattern $bEaseInCirc :: Easing
$mEaseInCirc :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInCirc = CubicBezier 0.55 0 1 0.45

-- | A pattern that defines the PostCSS easing pattern @easeOutCirc@.
pattern EaseOutCirc :: Easing
pattern $bEaseOutCirc :: Easing
$mEaseOutCirc :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOutCirc = CubicBezier 0 0.55 0.45 1

-- | A pattern that defines the PostCSS easing pattern @easeInOutCirc@.
pattern EaseInOutCirc :: Easing
pattern $bEaseInOutCirc :: Easing
$mEaseInOutCirc :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOutCirc = CubicBezier 0.85 0 0.15 1

-- | A pattern that defines the PostCSS easing pattern @easeInBack@.
pattern EaseInBack :: Easing
pattern $bEaseInBack :: Easing
$mEaseInBack :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInBack = CubicBezier 0.36 0 0.66 (-0.56)

-- | A pattern that defines the PostCSS easing pattern @easeOutBack@.
pattern EaseOutBack :: Easing
pattern $bEaseOutBack :: Easing
$mEaseOutBack :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseOutBack = CubicBezier 0.34 1.56 0.64 1

-- | A pattern that defines the PostCSS easing pattern @easeInOutBack@.
pattern EaseInOutBack :: Easing
pattern $bEaseInOutBack :: Easing
$mEaseInOutBack :: forall r. Easing -> (Void# -> r) -> (Void# -> r) -> r
EaseInOutBack = CubicBezier 0.68 (-0.6) 0.32 1.6

_genS :: Gen Scientific
_genS :: Gen Scientific
_genS = Integer -> Int -> Scientific
scientific (Integer -> Int -> Scientific)
-> Gen Integer -> Gen (Int -> Scientific)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary Gen (Int -> Scientific) -> Gen Int -> Gen Scientific
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary

_genBoundedS :: Gen Scientific
_genBoundedS :: Gen Scientific
_genBoundedS = do
    Int
e <- (Int -> Int) -> Gen Int -> Gen Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int
forall a. Num a => a -> a
abs Gen Int
forall a. Arbitrary a => Gen a
arbitrary
    (Integer -> Int -> Scientific
`scientific` (-Int
e)) (Integer -> Scientific) -> Gen Integer -> Gen Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
10Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
e)


-- Arbitrary instances
instance Arbitrary Easing where
    arbitrary :: Gen Easing
arbitrary = [Gen Easing] -> Gen Easing
forall a. [Gen a] -> Gen a
oneof [Int -> JumpTerm -> Easing
Steps (Int -> JumpTerm -> Easing) -> Gen Int -> Gen (JumpTerm -> Easing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
forall a. Bounded a => a
maxBound) Gen (JumpTerm -> Easing) -> Gen JumpTerm -> Gen Easing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen JumpTerm
forall a. Arbitrary a => Gen a
arbitrary, Scientific -> Scientific -> Scientific -> Scientific -> Easing
CubicBezier (Scientific -> Scientific -> Scientific -> Scientific -> Easing)
-> Gen Scientific
-> Gen (Scientific -> Scientific -> Scientific -> Easing)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Scientific
_genBoundedS Gen (Scientific -> Scientific -> Scientific -> Easing)
-> Gen Scientific -> Gen (Scientific -> Scientific -> Easing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Scientific
_genS Gen (Scientific -> Scientific -> Easing)
-> Gen Scientific -> Gen (Scientific -> Easing)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Scientific
_genBoundedS Gen (Scientific -> Easing) -> Gen Scientific -> Gen Easing
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Scientific
_genS]

instance Arbitrary JumpTerm where
    arbitrary :: Gen JumpTerm
arbitrary = Gen JumpTerm
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

-- ToMarkup instances
instance ToMarkup Easing where
    toMarkup :: Easing -> Markup
toMarkup = Text -> Markup
text (Text -> Markup) -> (Easing -> Text) -> Easing -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Easing -> Text
easingToCssWithCssAliasses

instance ToMarkup JumpTerm where
    toMarkup :: JumpTerm -> Markup
toMarkup = Text -> Markup
text (Text -> Markup) -> (JumpTerm -> Text) -> JumpTerm -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JumpTerm -> Text
jumpTermToCss

-- ToJavascript instances
instance ToJavascript Easing where
#if __GLASGOW_HASKELL__ < 803
    toJavascript = toJavascript . toJSON . easingToCssWithCssAliasses
#else
    toJavascript :: Easing -> Javascript
toJavascript = Text -> Javascript
forall a. ToJavascript a => a -> Javascript
toJavascript (Text -> Javascript) -> (Easing -> Text) -> Easing -> Javascript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Easing -> Text
easingToCssWithCssAliasses
#endif

instance ToJavascript JumpTerm where
#if __GLASGOW_HASKELL__ < 803
    toJavascript = toJavascript . toJSON . jumpTermToCss
#else
    toJavascript :: JumpTerm -> Javascript
toJavascript = Text -> Javascript
forall a. ToJavascript a => a -> Javascript
toJavascript (Text -> Javascript)
-> (JumpTerm -> Text) -> JumpTerm -> Javascript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JumpTerm -> Text
jumpTermToCss
#endif

-- ToJSON instances
instance ToJSON Easing where
    toJSON :: Easing -> Value
toJSON = Text -> Value
String (Text -> Value) -> (Easing -> Text) -> Easing -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Easing -> Text
easingToCssWithCssAliasses

instance ToJSON JumpTerm where
    toJSON :: JumpTerm -> Value
toJSON = Text -> Value
String (Text -> Value) -> (JumpTerm -> Text) -> JumpTerm -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JumpTerm -> Text
jumpTermToCss