Record.hs

{-# 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 (Functor, Applicative, Monad,
                          T.MonadIO,
                          MC.MonadThrow, MC.MonadCatch, MC.MonadMask)

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

instance MonadInput Record where
    startEvents tps = Record $
                        R.ask >>= \ve ->
                        T.liftIO $ startIOInput (Just ve) tps
    pollEvents ve = T.liftIO $ CC.swapMVar ve []
    stopEvents ts = T.liftIO $ stopEventsIO ts
        -- xxx questi puoi fare dispatch tramite TC?

writeMoves :: FilePath -> CC.MVar [Event] -> IO ()
writeMoves fp ve = CC.readMVar ve                >>= \es ->
                   BS.writeFile fp (S.encode es)