{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Terminal.Game.Layer.Object.Record where

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

import Terminal.Game.Layer.Object.Interface
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 [Event]) 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,
                          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)

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

instance MonadInput Record where
    startEvents :: FPS -> Record InputHandle
startEvents FPS
fps = ReaderT (MVar [Event]) IO InputHandle -> Record InputHandle
forall a. ReaderT (MVar [Event]) IO a -> Record a
Record (ReaderT (MVar [Event]) IO InputHandle -> Record InputHandle)
-> ReaderT (MVar [Event]) IO InputHandle -> Record InputHandle
forall a b. (a -> b) -> a -> b
$
                        ReaderT (MVar [Event]) IO (MVar [Event])
forall r (m :: * -> *). MonadReader r m => m r
R.ask ReaderT (MVar [Event]) IO (MVar [Event])
-> (MVar [Event] -> ReaderT (MVar [Event]) IO InputHandle)
-> ReaderT (MVar [Event]) IO InputHandle
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MVar [Event]
ve ->
                        IO InputHandle -> ReaderT (MVar [Event]) IO InputHandle
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO InputHandle -> ReaderT (MVar [Event]) IO InputHandle)
-> IO InputHandle -> ReaderT (MVar [Event]) IO InputHandle
forall a b. (a -> b) -> a -> b
$ Maybe (MVar [Event]) -> FPS -> IO InputHandle
startIOInput (MVar [Event] -> Maybe (MVar [Event])
forall a. a -> Maybe a
Just MVar [Event]
ve) FPS
fps
    pollEvents :: MVar [Event] -> Record [Event]
pollEvents MVar [Event]
ve = IO [Event] -> Record [Event]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO [Event] -> Record [Event]) -> IO [Event] -> Record [Event]
forall a b. (a -> b) -> a -> b
$ MVar [Event] -> [Event] -> IO [Event]
forall a. MVar a -> a -> IO a
CC.swapMVar MVar [Event]
ve []
    stopEvents :: [ThreadId] -> Record ()
stopEvents [ThreadId]
ts = IO () -> Record ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
T.liftIO (IO () -> Record ()) -> IO () -> Record ()
forall a b. (a -> b) -> a -> b
$ [ThreadId] -> IO ()
stopEventsIO [ThreadId]
ts
        -- xxx questi puoi fare dispatch tramite TC?

writeMoves :: FilePath -> CC.MVar [Event] -> IO ()
writeMoves :: FilePath -> MVar [Event] -> IO ()
writeMoves FilePath
fp MVar [Event]
ve = MVar [Event] -> IO [Event]
forall a. MVar a -> IO a
CC.readMVar MVar [Event]
ve                IO [Event] -> ([Event] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[Event]
es ->
                   FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fp ([Event] -> ByteString
forall a. Serialize a => a -> ByteString
S.encode [Event]
es)