module Control.Eff.Log
( Log(Log, logLine)
, Logger
, logE
, filterLog
, filterLog'
, runLogPure
, runLogStdout
, runLogStderr
, runLogFile
, runLogWithLoggerSet
, runLog
) where
import Control.Applicative ((<$>), (<*))
import Control.Eff ((:>), Eff, Member, SetMember, VE (..), admin,
handleRelay, inj, interpose, send)
import Control.Eff.Lift (Lift, lift)
import Data.Monoid ((<>))
import Data.Typeable (Typeable, Typeable1)
import System.Log.FastLogger (LogStr, LoggerSet, ToLogStr, defaultBufSize,
flushLogStr, fromLogStr, newFileLoggerSet,
newStderrLoggerSet, newStdoutLoggerSet,
pushLogStr, toLogStr)
import qualified Data.ByteString.Char8 as B8
data Log a v = Log
{ logLine :: a
, logNext :: v
} deriving (Typeable, Functor)
type Logger m l = forall v. Log l v -> m ()
logE :: (Typeable l, Member (Log l) r)
=> l -> Eff r ()
logE line = send $ \next -> inj (Log line (next ()))
runLogPure :: (Typeable l)
=> Eff (Log l :> r) a
-> Eff r (a, [l])
runLogPure = go . admin
where go (Val v) = return (v, [])
go (E req) = handleRelay req go performLog
performLog l = fmap (prefixLogWith l) (go (logNext l))
prefixLogWith log' (v, l) = (v, logLine log' : l)
runLog :: (Typeable l, Typeable1 m, SetMember Lift (Lift m) r)
=> Logger m l -> Eff (Log l :> r) a -> Eff r a
runLog logger = go . admin
where go (Val v) = return v
go (E req) = handleRelay req go performLog
performLog l = lift (logger l) >> go (logNext l)
filterLog :: (Typeable l, Member (Log l) r)
=> (l -> Bool) -> Eff r a -> Eff r a
filterLog f = go . admin
where go (Val v) = return v
go (E req) = interpose req go filter'
where filter' (Log l v) = if f l then send (<$> req) >>= go
else go v
filterLog' :: (Typeable l, Member (Log l) r)
=> (l -> Bool) -> proxy l -> Eff r a -> Eff r a
filterLog' predicate _ = filterLog predicate
runLogStdout :: (Typeable l, ToLogStr l, SetMember Lift (Lift IO) r)
=> proxy l -> Eff (Log l :> r) a -> Eff r a
runLogStdout proxy eff = do
s <- lift $ newStdoutLoggerSet defaultBufSize
runLogWithLoggerSet s proxy eff <* lift (flushLogStr s)
runLogStderr :: (Typeable l, ToLogStr l, SetMember Lift (Lift IO) r)
=> proxy l -> Eff (Log l :> r) a -> Eff r a
runLogStderr proxy eff = do
s <- lift $ newStderrLoggerSet defaultBufSize
runLogWithLoggerSet s proxy eff <* lift (flushLogStr s)
runLogFile :: (Typeable l, ToLogStr l, SetMember Lift (Lift IO) r)
=> FilePath -> proxy l -> Eff (Log l :> r) a -> Eff r a
runLogFile f proxy eff = do
s <- lift $ newFileLoggerSet defaultBufSize f
runLogWithLoggerSet s proxy eff <* lift (flushLogStr s)
runLogWithLoggerSet :: (Typeable l, ToLogStr l, SetMember Lift (Lift IO) r)
=> LoggerSet -> proxy l -> Eff (Log l :> r) a -> Eff r a
runLogWithLoggerSet s _ = runLog (loggerSetLogger s)
loggerSetLogger :: ToLogStr l => LoggerSet -> Logger IO l
loggerSetLogger loggerSet = pushLogStr loggerSet . (<> "\n") . toLogStr . logLine