--------------------------------------------------------------------------------
{-# 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
    -- Random is treated specially here.
    | 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
            -- Items specified: parse those
            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
            -- No items specified: parse default transition settings.
            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}
    -- Found the transition type.
    | 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
    -- Not found, error.
    | 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