{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Terminal.Game.Layer.Object.Narrate where

-- Narrate Monad, replay on screen from a GRec

import Terminal.Game.Layer.Object.Interface
import Terminal.Game.Layer.Object.Primitive
import Terminal.Game.Layer.Object.IO () -- MonadIo

import qualified Control.Monad.Catch as MC
import qualified Control.Monad.State as S
import qualified Control.Monad.Trans as T


newtype Narrate a = Narrate (S.StateT GRec IO a)
                deriving ((forall a b. (a -> b) -> Narrate a -> Narrate b)
-> (forall a b. a -> Narrate b -> Narrate a) -> Functor Narrate
forall a b. a -> Narrate b -> Narrate a
forall a b. (a -> b) -> Narrate a -> Narrate b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Narrate a -> Narrate b
fmap :: forall a b. (a -> b) -> Narrate a -> Narrate b
$c<$ :: forall a b. a -> Narrate b -> Narrate a
<$ :: forall a b. a -> Narrate b -> Narrate a
Functor, Functor Narrate
Functor Narrate =>
(forall a. a -> Narrate a)
-> (forall a b. Narrate (a -> b) -> Narrate a -> Narrate b)
-> (forall a b c.
    (a -> b -> c) -> Narrate a -> Narrate b -> Narrate c)
-> (forall a b. Narrate a -> Narrate b -> Narrate b)
-> (forall a b. Narrate a -> Narrate b -> Narrate a)
-> Applicative Narrate
forall a. a -> Narrate a
forall a b. Narrate a -> Narrate b -> Narrate a
forall a b. Narrate a -> Narrate b -> Narrate b
forall a b. Narrate (a -> b) -> Narrate a -> Narrate b
forall a b c. (a -> b -> c) -> Narrate a -> Narrate b -> Narrate c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Narrate a
pure :: forall a. a -> Narrate a
$c<*> :: forall a b. Narrate (a -> b) -> Narrate a -> Narrate b
<*> :: forall a b. Narrate (a -> b) -> Narrate a -> Narrate b
$cliftA2 :: forall a b c. (a -> b -> c) -> Narrate a -> Narrate b -> Narrate c
liftA2 :: forall a b c. (a -> b -> c) -> Narrate a -> Narrate b -> Narrate c
$c*> :: forall a b. Narrate a -> Narrate b -> Narrate b
*> :: forall a b. Narrate a -> Narrate b -> Narrate b
$c<* :: forall a b. Narrate a -> Narrate b -> Narrate a
<* :: forall a b. Narrate a -> Narrate b -> Narrate a
Applicative, Applicative Narrate
Applicative Narrate =>
(forall a b. Narrate a -> (a -> Narrate b) -> Narrate b)
-> (forall a b. Narrate a -> Narrate b -> Narrate b)
-> (forall a. a -> Narrate a)
-> Monad Narrate
forall a. a -> Narrate a
forall a b. Narrate a -> Narrate b -> Narrate b
forall a b. Narrate a -> (a -> Narrate b) -> Narrate b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Narrate a -> (a -> Narrate b) -> Narrate b
>>= :: forall a b. Narrate a -> (a -> Narrate b) -> Narrate b
$c>> :: forall a b. Narrate a -> Narrate b -> Narrate b
>> :: forall a b. Narrate a -> Narrate b -> Narrate b
$creturn :: forall a. a -> Narrate a
return :: forall a. a -> Narrate a
Monad,
                          Monad Narrate
Monad Narrate => (forall a. IO a -> Narrate a) -> MonadIO Narrate
forall a. IO a -> Narrate a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Narrate a
liftIO :: forall a. IO a -> Narrate a
T.MonadIO, S.MonadState GRec,
                          Monad Narrate
Monad Narrate =>
(forall e a. (HasCallStack, Exception e) => e -> Narrate a)
-> MonadThrow Narrate
forall e a. (HasCallStack, Exception e) => e -> Narrate a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> Narrate a
throwM :: forall e a. (HasCallStack, Exception e) => e -> Narrate a
MC.MonadThrow, MonadThrow Narrate
MonadThrow Narrate =>
(forall e a.
 (HasCallStack, Exception e) =>
 Narrate a -> (e -> Narrate a) -> Narrate a)
-> MonadCatch Narrate
forall e a.
(HasCallStack, Exception e) =>
Narrate a -> (e -> Narrate a) -> Narrate a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
Narrate a -> (e -> Narrate a) -> Narrate a
catch :: forall e a.
(HasCallStack, Exception e) =>
Narrate a -> (e -> Narrate a) -> Narrate a
MC.MonadCatch, MonadCatch Narrate
MonadCatch Narrate =>
(forall b.
 HasCallStack =>
 ((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b)
-> (forall b.
    HasCallStack =>
    ((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b)
-> (forall a b c.
    HasCallStack =>
    Narrate a
    -> (a -> ExitCase b -> Narrate c)
    -> (a -> Narrate b)
    -> Narrate (b, c))
-> MonadMask Narrate
forall b.
HasCallStack =>
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
forall a b c.
HasCallStack =>
Narrate a
-> (a -> ExitCase b -> Narrate c)
-> (a -> Narrate b)
-> Narrate (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
mask :: forall b.
HasCallStack =>
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
$cgeneralBracket :: forall a b c.
HasCallStack =>
Narrate a
-> (a -> ExitCase b -> Narrate c)
-> (a -> Narrate b)
-> Narrate (b, c)
generalBracket :: forall a b c.
HasCallStack =>
Narrate a
-> (a -> ExitCase b -> Narrate c)
-> (a -> Narrate b)
-> Narrate (b, c)
MC.MonadMask)

instance MonadInput Narrate where
    startEvents :: TPS -> Narrate InputHandle
startEvents TPS
fps = IO InputHandle -> Narrate InputHandle
forall a. IO a -> Narrate a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO InputHandle -> Narrate InputHandle)
-> IO InputHandle -> Narrate InputHandle
forall a b. (a -> b) -> a -> b
$ TPS -> IO InputHandle
forall (m :: * -> *). MonadInput m => TPS -> m InputHandle
startEvents TPS
fps
    pollEvents :: MVar [Event] -> Narrate [Event]
pollEvents MVar [Event]
_ = (GRec -> ([Event], GRec)) -> Narrate [Event]
forall a. (GRec -> (a, GRec)) -> Narrate a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
S.state GRec -> ([Event], GRec)
getPolled
    stopEvents :: [ThreadId] -> Narrate ()
stopEvents [ThreadId]
ts = IO () -> Narrate ()
forall a. IO a -> Narrate a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO () -> Narrate ()) -> IO () -> Narrate ()
forall a b. (a -> b) -> a -> b
$ [ThreadId] -> IO ()
forall (m :: * -> *). MonadInput m => [ThreadId] -> m ()
stopEvents [ThreadId]
ts
    areEventsOver :: Narrate Bool
areEventsOver = (GRec -> Bool) -> Narrate Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
S.gets GRec -> Bool
isOver

runReplay :: Narrate a -> GRec -> IO a
runReplay :: forall a. Narrate a -> GRec -> IO a
runReplay (Narrate StateT GRec IO a
s) GRec
k = StateT GRec IO a -> GRec -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
S.evalStateT StateT GRec IO a
s GRec
k