{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Patat.Transition
( Duration (..)
, threadDelayDuration
, TransitionGen
, TransitionId
, TransitionInstance (..)
, parseTransitionSettings
, newTransition
, stepTransition
) where
import qualified Data.Aeson.Extended as A
import qualified Data.Aeson.TH.Extended as A
import Data.Bifunctor (first)
import qualified Data.HashMap.Strict as HMS
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text)
import qualified Data.Text as T
import Data.Traversable (for)
import Patat.Presentation.Settings (TransitionSettings (..))
import qualified Patat.Transition.Dissolve as Dissolve
import Patat.Transition.Internal
import qualified Patat.Transition.SlideLeft as SlideLeft
import System.Random (uniformR)
data RandomTransitionSettings = RandomTransitionSettings
{ RandomTransitionSettings -> Maybe (NonEmpty TransitionSettings)
rtsItems :: Maybe (NonEmpty TransitionSettings)
}
$(A.deriveFromJSON A.dropPrefixOptions ''RandomTransitionSettings)
random :: NonEmpty TransitionGen -> TransitionGen
random :: NonEmpty TransitionGen -> TransitionGen
random NonEmpty TransitionGen
items Size
size Matrix
matrix0 Matrix
matrix1 StdGen
rg0 =
let (Int
idx, StdGen
rg1) = forall g a. (RandomGen g, UniformRange a) => (a, a) -> g -> (a, g)
uniformR (Int
0, forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty TransitionGen
items forall a. Num a => a -> a -> a
- Int
1) StdGen
rg0 in
(NonEmpty TransitionGen
items forall a. NonEmpty a -> Int -> a
NonEmpty.!! Int
idx) Size
size Matrix
matrix0 Matrix
matrix1 StdGen
rg1
transitions :: NonEmpty (Text, Transition)
transitions :: NonEmpty (Text, Transition)
transitions =
(Text
"dissolve", forall conf. FromJSON conf => (conf -> TransitionGen) -> Transition
Transition Config -> TransitionGen
Dissolve.transition) forall a. a -> [a] -> NonEmpty a
:|
(Text
"slideLeft", forall conf. FromJSON conf => (conf -> TransitionGen) -> Transition
Transition Config -> TransitionGen
SlideLeft.transition) forall a. a -> [a] -> [a]
: []
transitionTable :: HMS.HashMap Text Transition
transitionTable :: HashMap Text Transition
transitionTable = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall k v. Hashable k => k -> v -> HashMap k v
HMS.singleton) NonEmpty (Text, Transition)
transitions
parseTransitionSettings
:: TransitionSettings -> Either String TransitionGen
parseTransitionSettings :: TransitionSettings -> Either String TransitionGen
parseTransitionSettings TransitionSettings
ts
| Text
ty forall a. Eq a => a -> a -> Bool
== Text
"random" = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty TransitionGen -> TransitionGen
random forall a b. (a -> b) -> a -> b
$ do
RandomTransitionSettings
settings <- forall a. Result a -> Either String a
A.resultToEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Result a
A.fromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
A.Object forall a b. (a -> b) -> a -> b
$ TransitionSettings -> Object
tsParams TransitionSettings
ts
case RandomTransitionSettings -> Maybe (NonEmpty TransitionSettings)
rtsItems RandomTransitionSettings
settings of
Just NonEmpty TransitionSettings
items -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TransitionSettings -> Either String TransitionGen
parseTransitionSettings NonEmpty TransitionSettings
items
Maybe (NonEmpty TransitionSettings)
Nothing -> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NonEmpty (Text, Transition)
transitions forall a b. (a -> b) -> a -> b
$ \(Text
typ, Transition
_) -> TransitionSettings -> Either String TransitionGen
parseTransitionSettings
TransitionSettings {tsType :: Text
tsType = Text
typ, tsParams :: Object
tsParams = forall a. Monoid a => a
mempty}
| Just (Transition conf -> TransitionGen
f) <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HMS.lookup Text
ty HashMap Text Transition
transitionTable =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (conf -> TransitionGen
f forall a b. (a -> b) -> a -> b
$) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
err ->
String
"could not parse " forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
ty forall a. [a] -> [a] -> [a]
++ String
" transition: " forall a. [a] -> [a] -> [a]
++ String
err) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. Result a -> Either String a
A.resultToEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Result a
A.fromJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Value
A.Object forall a b. (a -> b) -> a -> b
$ TransitionSettings -> Object
tsParams TransitionSettings
ts
| Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"unknown transition type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
ty
where
ty :: Text
ty = TransitionSettings -> Text
tsType TransitionSettings
ts