{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Terminal.Game.Layer.Object.Record where

-- Record Monad, for when I need to play the game and record Events
-- (keypresses, ticks, screen size, FPS) to a file.

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

import qualified Control.Concurrent   as CC
import qualified Control.Monad.Catch  as MC
import qualified Control.Monad.Reader as R
import qualified Control.Monad.Trans  as T -- MonadIO
import qualified Data.ByteString      as BS
import qualified Data.Serialize       as S

-- record the key pressed in a game session

newtype Record a = Record (R.ReaderT (CC.MVar GRec) IO a)
                deriving ((forall a b. (a -> b) -> Record a -> Record b)
-> (forall a b. a -> Record b -> Record a) -> Functor Record
forall a b. a -> Record b -> Record a
forall a b. (a -> b) -> Record a -> Record 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) -> Record a -> Record b
fmap :: forall a b. (a -> b) -> Record a -> Record b
$c<$ :: forall a b. a -> Record b -> Record a
<$ :: forall a b. a -> Record b -> Record a
Functor, Functor Record
Functor Record =>
(forall a. a -> Record a)
-> (forall a b. Record (a -> b) -> Record a -> Record b)
-> (forall a b c.
    (a -> b -> c) -> Record a -> Record b -> Record c)
-> (forall a b. Record a -> Record b -> Record b)
-> (forall a b. Record a -> Record b -> Record a)
-> Applicative Record
forall a. a -> Record a
forall a b. Record a -> Record b -> Record a
forall a b. Record a -> Record b -> Record b
forall a b. Record (a -> b) -> Record a -> Record b
forall a b c. (a -> b -> c) -> Record a -> Record b -> Record 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 -> Record a
pure :: forall a. a -> Record a
$c<*> :: forall a b. Record (a -> b) -> Record a -> Record b
<*> :: forall a b. Record (a -> b) -> Record a -> Record b
$cliftA2 :: forall a b c. (a -> b -> c) -> Record a -> Record b -> Record c
liftA2 :: forall a b c. (a -> b -> c) -> Record a -> Record b -> Record c
$c*> :: forall a b. Record a -> Record b -> Record b
*> :: forall a b. Record a -> Record b -> Record b
$c<* :: forall a b. Record a -> Record b -> Record a
<* :: forall a b. Record a -> Record b -> Record a
Applicative, Applicative Record
Applicative Record =>
(forall a b. Record a -> (a -> Record b) -> Record b)
-> (forall a b. Record a -> Record b -> Record b)
-> (forall a. a -> Record a)
-> Monad Record
forall a. a -> Record a
forall a b. Record a -> Record b -> Record b
forall a b. Record a -> (a -> Record b) -> Record 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. Record a -> (a -> Record b) -> Record b
>>= :: forall a b. Record a -> (a -> Record b) -> Record b
$c>> :: forall a b. Record a -> Record b -> Record b
>> :: forall a b. Record a -> Record b -> Record b
$creturn :: forall a. a -> Record a
return :: forall a. a -> Record a
Monad,
                          Monad Record
Monad Record => (forall a. IO a -> Record a) -> MonadIO Record
forall a. IO a -> Record a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> Record a
liftIO :: forall a. IO a -> Record a
T.MonadIO, R.MonadReader (CC.MVar GRec),
                          Monad Record
Monad Record =>
(forall e a. (HasCallStack, Exception e) => e -> Record a)
-> MonadThrow Record
forall e a. (HasCallStack, Exception e) => e -> Record a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> Record a
throwM :: forall e a. (HasCallStack, Exception e) => e -> Record a
MC.MonadThrow, MonadThrow Record
MonadThrow Record =>
(forall e a.
 (HasCallStack, Exception e) =>
 Record a -> (e -> Record a) -> Record a)
-> MonadCatch Record
forall e a.
(HasCallStack, Exception e) =>
Record a -> (e -> Record a) -> Record 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) =>
Record a -> (e -> Record a) -> Record a
catch :: forall e a.
(HasCallStack, Exception e) =>
Record a -> (e -> Record a) -> Record a
MC.MonadCatch, MonadCatch Record
MonadCatch Record =>
(forall b.
 HasCallStack =>
 ((forall a. Record a -> Record a) -> Record b) -> Record b)
-> (forall b.
    HasCallStack =>
    ((forall a. Record a -> Record a) -> Record b) -> Record b)
-> (forall a b c.
    HasCallStack =>
    Record a
    -> (a -> ExitCase b -> Record c)
    -> (a -> Record b)
    -> Record (b, c))
-> MonadMask Record
forall b.
HasCallStack =>
((forall a. Record a -> Record a) -> Record b) -> Record b
forall a b c.
HasCallStack =>
Record a
-> (a -> ExitCase b -> Record c)
-> (a -> Record b)
-> Record (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. Record a -> Record a) -> Record b) -> Record b
mask :: forall b.
HasCallStack =>
((forall a. Record a -> Record a) -> Record b) -> Record b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Record a -> Record a) -> Record b) -> Record b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. Record a -> Record a) -> Record b) -> Record b
$cgeneralBracket :: forall a b c.
HasCallStack =>
Record a
-> (a -> ExitCase b -> Record c)
-> (a -> Record b)
-> Record (b, c)
generalBracket :: forall a b c.
HasCallStack =>
Record a
-> (a -> ExitCase b -> Record c)
-> (a -> Record b)
-> Record (b, c)
MC.MonadMask)

-- Lifts IO interface, records where necessary
instance MonadInput Record where
    startEvents :: TPS -> Record InputHandle
startEvents TPS
tps = IO InputHandle -> Record InputHandle
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (TPS -> IO InputHandle
forall (m :: * -> *). MonadInput m => TPS -> m InputHandle
startEvents TPS
tps)
    pollEvents :: MVar [Event] -> Record [Event]
pollEvents MVar [Event]
ve = IO [Event] -> Record [Event]
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (MVar [Event] -> IO [Event]
forall (m :: * -> *). MonadInput m => MVar [Event] -> m [Event]
pollEvents MVar [Event]
ve) Record [Event] -> ([Event] -> Record [Event]) -> Record [Event]
forall a b. Record a -> (a -> Record b) -> Record b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Event]
es ->
                    ([Event] -> GRec -> GRec) -> [Event] -> Record [Event]
forall a. (a -> GRec -> GRec) -> a -> Record a
modMRec [Event] -> GRec -> GRec
addPolled [Event]
es
    stopEvents :: [ThreadId] -> Record ()
stopEvents [ThreadId]
ts = IO () -> Record ()
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO ([ThreadId] -> IO ()
forall (m :: * -> *). MonadInput m => [ThreadId] -> m ()
stopEvents [ThreadId]
ts)
    areEventsOver :: Record Bool
areEventsOver = IO Bool -> Record Bool
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO Bool
forall (m :: * -> *). MonadInput m => m Bool
areEventsOver

instance MonadDisplay Record where
    setupDisplay :: Record ()
setupDisplay = IO () -> Record ()
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
forall (m :: * -> *). MonadDisplay m => m ()
setupDisplay
    clearDisplay :: Record ()
clearDisplay = IO () -> Record ()
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
forall (m :: * -> *). MonadDisplay m => m ()
clearDisplay
    displaySize :: Record (Maybe Dimensions)
displaySize = IO (Maybe Dimensions) -> Record (Maybe Dimensions)
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO (Maybe Dimensions)
forall (m :: * -> *). MonadDisplay m => m (Maybe Dimensions)
displaySize Record (Maybe Dimensions)
-> (Maybe Dimensions -> Record (Maybe Dimensions))
-> Record (Maybe Dimensions)
forall a b. Record a -> (a -> Record b) -> Record b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe Dimensions
ds ->
                  (Maybe Dimensions -> GRec -> GRec)
-> Maybe Dimensions -> Record (Maybe Dimensions)
forall a. (a -> GRec -> GRec) -> a -> Record a
modMRec Maybe Dimensions -> GRec -> GRec
addDims Maybe Dimensions
ds
    blitPlane :: Maybe Plane -> Plane -> Record ()
blitPlane Maybe Plane
mp Plane
p = IO () -> Record ()
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (Maybe Plane -> Plane -> IO ()
forall (m :: * -> *).
MonadDisplay m =>
Maybe Plane -> Plane -> m ()
blitPlane Maybe Plane
mp Plane
p)
    shutdownDisplay :: Record ()
shutdownDisplay = IO () -> Record ()
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
forall (m :: * -> *). MonadDisplay m => m ()
shutdownDisplay

-- logs and passes the value on
modMRec :: (a -> GRec -> GRec) -> a -> Record a
modMRec :: forall a. (a -> GRec -> GRec) -> a -> Record a
modMRec a -> GRec -> GRec
f a
a = Record (MVar GRec)
forall r (m :: * -> *). MonadReader r m => m r
R.ask Record (MVar GRec) -> (MVar GRec -> Record a) -> Record a
forall a b. Record a -> (a -> Record b) -> Record b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar GRec
mv ->
              let fmv :: IO ()
fmv = MVar GRec -> (GRec -> IO GRec) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
CC.modifyMVar_ MVar GRec
mv (GRec -> IO GRec
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GRec -> IO GRec) -> (GRec -> GRec) -> GRec -> IO GRec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GRec -> GRec
f a
a) in
              IO () -> Record ()
forall a. IO a -> Record a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
fmv Record () -> Record a -> Record a
forall a b. Record a -> Record b -> Record b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              a -> Record a
forall a. a -> Record a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

runRecord :: Record a -> CC.MVar GRec -> IO a
runRecord :: forall a. Record a -> MVar GRec -> IO a
runRecord (Record ReaderT (MVar GRec) IO a
r) MVar GRec
me = ReaderT (MVar GRec) IO a -> MVar GRec -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT ReaderT (MVar GRec) IO a
r MVar GRec
me

writeRec :: FilePath -> CC.MVar GRec -> IO ()
writeRec :: FilePath -> MVar GRec -> IO ()
writeRec FilePath
fp MVar GRec
vr = MVar GRec -> IO GRec
forall a. MVar a -> IO a
CC.readMVar MVar GRec
vr                IO GRec -> (GRec -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \GRec
k ->
                 FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fp (GRec -> ByteString
forall a. Serialize a => a -> ByteString
S.encode GRec
k)