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

-- Lifts IO interface, records where necessary
instance MonadInput Record where
    startEvents :: TPS -> Record InputHandle
startEvents TPS
tps = IO InputHandle -> Record InputHandle
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 (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 (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 (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO ([ThreadId] -> IO ()
forall (m :: * -> *). MonadInput m => [ThreadId] -> m ()
stopEvents [ThreadId]
ts)

instance MonadDisplay Record where
    setupDisplay :: Record ()
setupDisplay = IO () -> Record ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
forall (m :: * -> *). MonadDisplay m => m ()
setupDisplay
    clearDisplay :: Record ()
clearDisplay = IO () -> Record ()
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 (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 (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 (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 (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 :: (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 (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 (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 (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO IO ()
fmv Record () -> Record a -> Record a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              a -> Record a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

runRecord :: Record a -> CC.MVar GRec -> IO a
runRecord :: 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 (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)