module Game.GoreAndAsh.Logging.API(
LoggingMonad(..)
, logA
, logALn
, logE
, logELn
, logInfoA
, logWarnA
, logErrorA
, logInfoE
, logWarnE
, logErrorE
, traceEvent
, traceEventShow
) where
import Control.Monad.State.Strict
import Control.Wire
import Data.Text
import Prelude hiding (id, (.))
import qualified Data.Sequence as S
import TextShow
import Game.GoreAndAsh
import Game.GoreAndAsh.Logging.State
import Game.GoreAndAsh.Logging.Module
class Monad m => LoggingMonad m where
putMsgM :: Text -> m ()
putMsgLnM :: Text -> m ()
instance Monad m => LoggingMonad (LoggingT s m) where
putMsgM t = do
cntx <- get
let newMsgs = case S.viewr $ loggingMsgs cntx of
S.EmptyR -> loggingMsgs cntx S.|> t
(s' S.:> t') -> s' S.|> (t' <> t)
put $ cntx { loggingMsgs = newMsgs }
putMsgLnM t = do
cntx <- get
put $ cntx { loggingMsgs = loggingMsgs cntx S.|> t }
instance (Monad (mt m), LoggingMonad m, MonadTrans mt) => LoggingMonad (mt m) where
putMsgM = lift . putMsgM
putMsgLnM = lift . putMsgLnM
logA :: LoggingMonad m => GameWire m Text ()
logA = liftGameMonad1 putMsgM
logALn :: LoggingMonad m => GameWire m Text ()
logALn = liftGameMonad1 putMsgLnM
logE :: LoggingMonad m => GameWire m (Event Text) (Event ())
logE = liftGameMonadEvent1 putMsgM
logELn :: LoggingMonad m => GameWire m (Event Text) (Event ())
logELn = liftGameMonadEvent1 putMsgLnM
logInfoA :: LoggingMonad m => GameWire m Text ()
logInfoA = logALn . arr ("Info: " <>)
logWarnA :: LoggingMonad m => GameWire m Text ()
logWarnA = logALn . arr ("Info: " <>)
logErrorA :: LoggingMonad m => GameWire m Text ()
logErrorA = logALn . arr ("Info: " <>)
logInfoE :: LoggingMonad m => GameWire m (Event Text) (Event ())
logInfoE = logELn . mapE ("Info: " <>)
logWarnE :: LoggingMonad m => GameWire m (Event Text) (Event ())
logWarnE = logELn . mapE ("Info: " <>)
logErrorE :: LoggingMonad m => GameWire m (Event Text) (Event ())
logErrorE = logELn . mapE ("Info: " <>)
traceEvent :: LoggingMonad m => (a -> Text) -> GameWire m (Event a) (Event ())
traceEvent f = logELn . mapE f
traceEventShow :: (TextShow a, LoggingMonad m) => GameWire m (Event a) (Event ())
traceEventShow = traceEvent showt