{-# LANGUAGE OverloadedStrings #-}
module Patat.Transition
( Duration (..)
, threadDelayDuration
, TransitionGen
, TransitionId
, TransitionInstance (..)
, parseTransitionSettings
, newTransition
, stepTransition
) where
import qualified Data.Aeson as A
import qualified Data.HashMap.Strict as HMS
import Data.Text (Text)
import qualified Data.Text as T
import Patat.Presentation.Settings (TransitionSettings (..))
import Patat.Transition.Internal
import qualified Patat.Transition.SlideLeft as SlideLeft
transitions :: HMS.HashMap Text Transition
transitions :: HashMap Text Transition
transitions = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HMS.fromList
[ (Text
"slideLeft", forall conf. FromJSON conf => (conf -> TransitionGen) -> Transition
Transition Config -> TransitionGen
SlideLeft.slideLeft)
]
parseTransitionSettings
:: TransitionSettings -> Either String TransitionGen
parseTransitionSettings :: TransitionSettings -> Either [Char] TransitionGen
parseTransitionSettings TransitionSettings
ts = case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup Text
ty HashMap Text Transition
transitions of
Maybe Transition
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"unknown transition type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
ty
Just (Transition conf -> TransitionGen
f) -> case forall a. FromJSON a => Value -> Result a
A.fromJSON (Object -> Value
A.Object forall a b. (a -> b) -> a -> b
$ TransitionSettings -> Object
tsParams TransitionSettings
ts) of
A.Success conf
conf -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ conf -> TransitionGen
f conf
conf
A.Error [Char]
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
[Char]
"could not parse " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
ty forall a. [a] -> [a] -> [a]
++ [Char]
" transition: " forall a. [a] -> [a] -> [a]
++ [Char]
err
where
ty :: Text
ty = TransitionSettings -> Text
tsType TransitionSettings
ts