{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}

module Terminal.Game.Layer.Object.Narrate 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        as CM
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
import qualified System.IO            as SI


newtype Narrate a = Narrate (R.ReaderT [Event] IO a)
                deriving (Functor, Applicative, Monad,
                          T.MonadIO,
                          MC.MonadThrow, MC.MonadCatch, MC.MonadMask)

runReplay :: Narrate a -> [Event] -> IO a
runReplay (Narrate r) e = R.runReaderT r e

-- | Reads a file containing a recorded session.
readRecord :: FilePath -> IO [Event]
readRecord fp = S.decode <$> BS.readFile fp >>= \case
                  Left e  -> error $ "readRecord could not decode: " ++
                                    show e
                  Right r -> return r

-- class Monad m => MonadInput m where
--     startEvents :: FPS -> m (CC.MVar [Event], [CC.ThreadId])
--     pollEvents  :: CC.MVar [Event] ->
--                    m [Event]
--     stopEvents :: [CC.ThreadId] -> m ()

instance MonadInput Narrate where
    startEvents fps = Narrate $
                        R.ask >>= \e ->
                        T.liftIO $ startNarrate e fps
    pollEvents ve = T.liftIO $ CC.swapMVar ve []
    stopEvents ts = T.liftIO $ stopEventsIO ts
        -- xxx questi puoi fare dispatch tramite TC?

-- xxx ma narrate deve finire?
instance MonadLogic Narrate where
    checkQuit fs s = Narrate $ R.ask >>= \case
                         [] -> return True
                         _  -> return $ fs s




-- xxx astrai da qui?
-- filepath = logging
startNarrate :: [Event] -> FPS -> IO InputHandle
startNarrate env fps =

                   -- non buffered input
                   SI.hSetBuffering SI.stdin SI.NoBuffering  >>
                   SI.hSetBuffering SI.stdout SI.NoBuffering >>
                   SI.hSetEcho SI.stdin False                >>
                   -- xxx astrai this

                   CC.newMVar []                 >>= \ve ->
                   CC.forkIO (addEnv ve env fps) >>= \te ->
                   return (InputHandle ve [te])

addEnv :: CC.MVar [Event] -> [Event] -> FPS -> IO ()
addEnv _  []     _   = error "fine"
                        -- xxx occhio qui
addEnv ve (e:es) fps = addEvent Nothing ve e >>
                       CM.when (e == Tick)
                            (CC.threadDelay delayAmount) >>
                       addEnv ve es fps
    where
          delayAmount :: Int
          delayAmount = fromIntegral $ quot oneTickSec fps