{-# LANGUAGE NamedFieldPuns #-}
module App (
      T
    , Context(..)
    , debug
    , exec
    , get
    , player
    , session
    , update
  ) where

import Control.Concurrent (MVar, modifyMVar, readMVar)
import Control.Monad.Reader (ReaderT(..), ask, asks, lift)
import Data.Map ((!), (!?))
import qualified Player (T)
import qualified Server (T(..))
import qualified Session (ID, T(..))

data Context = Context {
      mServer :: MVar Server.T
    , sessionID :: Session.ID
  }

type T a = ReaderT Context IO a

get :: (Server.T -> a) -> T a
get projector =
  lift . fmap projector . readMVar =<< asks mServer

session :: T Session.T
session = do
  Context {sessionID} <- ask
  get $ (! sessionID) . Server.sessions

player :: T (Maybe Player.T)
player = do
  Context {sessionID} <- ask
  get $ (Session.player =<<) . (!? sessionID) . Server.sessions

debug :: String -> T ()
debug message =
  show <$> asks sessionID
  >>= lift . putStrLn . (++ ' ':message)

exec :: (Server.T -> IO (Server.T, a)) -> T a
exec f = do
  Context {mServer} <- ask
  lift $ modifyMVar mServer f

update :: (Server.T -> Server.T) -> T ()
update f = exec $ (\x -> return (x, ())) . f