{-# 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 (a -> Narrate b -> Narrate a
(a -> b) -> Narrate a -> Narrate b
(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
<$ :: a -> Narrate b -> Narrate a
$c<$ :: forall a b. a -> Narrate b -> Narrate a
fmap :: (a -> b) -> Narrate a -> Narrate b
$cfmap :: forall a b. (a -> b) -> Narrate a -> Narrate b
Functor, Functor Narrate
a -> Narrate a
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
Narrate a -> Narrate b -> Narrate b
Narrate a -> Narrate b -> Narrate a
Narrate (a -> b) -> Narrate a -> Narrate b
(a -> b -> c) -> Narrate a -> Narrate b -> Narrate c
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
<* :: Narrate a -> Narrate b -> Narrate a
$c<* :: forall a b. Narrate a -> Narrate b -> Narrate a
*> :: Narrate a -> Narrate b -> Narrate b
$c*> :: forall a b. Narrate a -> Narrate b -> Narrate b
liftA2 :: (a -> b -> c) -> Narrate a -> Narrate b -> Narrate c
$cliftA2 :: forall a b c. (a -> b -> c) -> Narrate a -> Narrate b -> Narrate c
<*> :: Narrate (a -> b) -> Narrate a -> Narrate b
$c<*> :: forall a b. Narrate (a -> b) -> Narrate a -> Narrate b
pure :: a -> Narrate a
$cpure :: forall a. a -> Narrate a
$cp1Applicative :: Functor Narrate
Applicative, Applicative Narrate
a -> Narrate a
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
Narrate a -> (a -> Narrate b) -> Narrate b
Narrate a -> Narrate b -> Narrate b
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
return :: a -> Narrate a
$creturn :: forall a. a -> Narrate a
>> :: Narrate a -> Narrate b -> Narrate b
$c>> :: forall a b. Narrate a -> Narrate b -> Narrate b
>>= :: Narrate a -> (a -> Narrate b) -> Narrate b
$c>>= :: forall a b. Narrate a -> (a -> Narrate b) -> Narrate b
$cp1Monad :: Applicative Narrate
Monad,
                          Monad Narrate
Monad Narrate -> (forall a. IO a -> Narrate a) -> MonadIO Narrate
IO a -> Narrate a
forall a. IO a -> Narrate a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Narrate a
$cliftIO :: forall a. IO a -> Narrate a
$cp1MonadIO :: Monad Narrate
T.MonadIO, S.MonadState GRec,
                          Monad Narrate
e -> Narrate a
Monad Narrate
-> (forall e a. Exception e => e -> Narrate a)
-> MonadThrow Narrate
forall e a. Exception e => e -> Narrate a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> Narrate a
$cthrowM :: forall e a. Exception e => e -> Narrate a
$cp1MonadThrow :: Monad Narrate
MC.MonadThrow, MonadThrow Narrate
MonadThrow Narrate
-> (forall e a.
    Exception e =>
    Narrate a -> (e -> Narrate a) -> Narrate a)
-> MonadCatch Narrate
Narrate a -> (e -> Narrate a) -> Narrate a
forall e a.
Exception e =>
Narrate a -> (e -> Narrate a) -> Narrate a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: Narrate a -> (e -> Narrate a) -> Narrate a
$ccatch :: forall e a.
Exception e =>
Narrate a -> (e -> Narrate a) -> Narrate a
$cp1MonadCatch :: MonadThrow Narrate
MC.MonadCatch, MonadCatch Narrate
MonadCatch Narrate
-> (forall b.
    ((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b)
-> (forall b.
    ((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b)
-> (forall a b c.
    Narrate a
    -> (a -> ExitCase b -> Narrate c)
    -> (a -> Narrate b)
    -> Narrate (b, c))
-> MonadMask Narrate
Narrate a
-> (a -> ExitCase b -> Narrate c)
-> (a -> Narrate b)
-> Narrate (b, c)
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
forall b.
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
forall a b c.
Narrate a
-> (a -> ExitCase b -> Narrate c)
-> (a -> Narrate b)
-> Narrate (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: Narrate a
-> (a -> ExitCase b -> Narrate c)
-> (a -> Narrate b)
-> Narrate (b, c)
$cgeneralBracket :: forall a b c.
Narrate a
-> (a -> ExitCase b -> Narrate c)
-> (a -> Narrate b)
-> Narrate (b, c)
uninterruptibleMask :: ((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
$cuninterruptibleMask :: forall b.
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
mask :: ((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
$cmask :: forall b.
((forall a. Narrate a -> Narrate a) -> Narrate b) -> Narrate b
$cp1MonadMask :: MonadCatch Narrate
MC.MonadMask)

instance MonadInput Narrate where
    startEvents :: TPS -> Narrate InputHandle
startEvents TPS
fps = IO InputHandle -> Narrate InputHandle
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 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 (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

instance MonadLogic Narrate where
    checkQuit :: (s -> Bool) -> s -> Narrate Bool
checkQuit s -> Bool
_ s
_ = (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 :: 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