M.hs

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GADTs #-}

module M where

import Control.Monad.IO.Class
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.Class as Trans

class (MonadIO m) => MonadLoggerIO m where
    -- | Request the logging function itself.
    --
    -- Since 0.3.10
    askLoggerIO :: m (IO ())
    default askLoggerIO :: (Trans.MonadTrans t, MonadLoggerIO n, m ~ t n)
                        => t n (IO ())
    askLoggerIO = Trans.lift askLoggerIO
    
instance MonadLoggerIO m => MonadLoggerIO (ReaderT r m)

MonadLogger.hs

{-# LANGUAGE DefaultSignatures, GADTs #-}
module MonadLogger where

import           Control.Monad.IO.Class
import qualified Control.Monad.Trans.Class as Trans
import           Control.Monad.Trans.Identity

data Loc
data LogSource
data LogLevel
data LogStr

class ToLogStr msg

class Monad m => MonadLogger m where
    monadLoggerLog :: ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> m ()
    default monadLoggerLog :: (Trans.MonadTrans t, MonadLogger (t m), ToLogStr msg)
                           => Loc -> LogSource -> LogLevel -> msg -> t m ()
    monadLoggerLog loc src lvl msg = Trans.lift $ monadLoggerLog loc src lvl msg

class (MonadLogger m, MonadIO m) => MonadLoggerIO m where
    askLoggerIO :: m (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
    -- default askLoggerIO :: (Trans.MonadTrans t, MonadLogger (t m), MonadIO (t m))
    default askLoggerIO :: (Trans.MonadTrans t, MonadLoggerIO n, t n ~ m)
                        => t n (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
    askLoggerIO = Trans.lift askLoggerIO

instance MonadLogger m => MonadLogger (IdentityT m) where
    monadLoggerLog a b c d = Trans.lift $ monadLoggerLog a b c d

instance MonadLoggerIO m => MonadLoggerIO (IdentityT m)