{-# LANGUAGE UndecidableInstances #-}
module Control.Eff.Log.Writer
(
LogWriter(..)
, LogWriterReader
, localLogWriterReader
, askLogWriter
, runLogWriterReader
, liftWriteLogMessage
, noOpLogWriter
, filteringLogWriter
, mappingLogWriter
, mappingLogWriterIO
, ioHandleLogWriter
, stdoutLogWriter
)
where
import Control.Eff
import Control.Eff.Reader.Strict
import Control.Eff.Log.Message
import Control.Eff.Log.MessageRenderer
import Control.Monad ( (>=>)
, when
)
import qualified Data.Text.IO as Text
import Data.Text (Text)
import qualified System.IO as IO
newtype LogWriter = MkLogWriter
{ runLogWriter :: LogMessage -> IO ()
}
instance Semigroup LogWriter where
(MkLogWriter l) <> (MkLogWriter r) = MkLogWriter (l >> r)
instance Monoid LogWriter where
mempty = MkLogWriter (const (pure ()))
type LogWriterReader = Reader LogWriter
runLogWriterReader :: LogWriter -> Eff (Reader LogWriter ': e) a -> Eff e a
runLogWriterReader = runReader
askLogWriter :: Member LogWriterReader e => Eff e LogWriter
askLogWriter = ask
localLogWriterReader
:: forall e a
. Member LogWriterReader e
=> (LogWriter -> LogWriter)
-> Eff e a
-> Eff e a
localLogWriterReader = local
liftWriteLogMessage
:: ( Member LogWriterReader e, Lifted IO e)
=> LogMessage
-> Eff e ()
liftWriteLogMessage m = do
w <- askLogWriter
lift (runLogWriter w m)
noOpLogWriter :: LogWriter
noOpLogWriter = mempty
filteringLogWriter :: LogPredicate -> LogWriter -> LogWriter
filteringLogWriter p lw =
MkLogWriter (\msg -> when (p msg) (runLogWriter lw msg))
mappingLogWriter :: (LogMessage -> LogMessage) -> LogWriter -> LogWriter
mappingLogWriter f lw = MkLogWriter (runLogWriter lw . f)
mappingLogWriterIO
:: (LogMessage -> IO LogMessage) -> LogWriter -> LogWriter
mappingLogWriterIO f lw = MkLogWriter (f >=> runLogWriter lw)
ioHandleLogWriter :: IO.Handle -> LogMessageRenderer Text -> LogWriter
ioHandleLogWriter outH r = MkLogWriter (Text.hPutStrLn outH . r)
stdoutLogWriter :: LogMessageRenderer Text -> IO LogWriter
stdoutLogWriter render = do
IO.hSetBuffering IO.stdout IO.LineBuffering
return (ioHandleLogWriter IO.stdout render)