module Control.Monad.Caster (
MonadLogger (..),
ToBuilder (..),
LogLevel (..),
LogQueue,
stdoutLogger,
iohandleLogger,
) where
import Control.Monad.IO.Class
import Control.Concurrent
import GHC.IO.Handle (Handle)
import System.Log.Caster as Caster
class MonadLogger m where
getLogger :: MonadIO m => m LogQueue
debug :: (MonadIO m, ToBuilder s) => s -> m ()
debug s :: s
s = m LogQueue
forall (m :: * -> *). (MonadLogger m, MonadIO m) => m LogQueue
getLogger m LogQueue -> (LogQueue -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \g :: LogQueue
g -> LogQueue -> s -> m ()
forall (m :: * -> *) s.
(MonadIO m, ToBuilder s) =>
LogQueue -> s -> m ()
Caster.debug LogQueue
g s
s
info :: (MonadIO m, ToBuilder s) => s -> m ()
info s :: s
s = m LogQueue
forall (m :: * -> *). (MonadLogger m, MonadIO m) => m LogQueue
getLogger m LogQueue -> (LogQueue -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \g :: LogQueue
g -> LogQueue -> s -> m ()
forall (m :: * -> *) s.
(MonadIO m, ToBuilder s) =>
LogQueue -> s -> m ()
Caster.info LogQueue
g s
s
warn :: (MonadIO m, ToBuilder s) => s -> m ()
warn s :: s
s = m LogQueue
forall (m :: * -> *). (MonadLogger m, MonadIO m) => m LogQueue
getLogger m LogQueue -> (LogQueue -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \g :: LogQueue
g -> LogQueue -> s -> m ()
forall (m :: * -> *) s.
(MonadIO m, ToBuilder s) =>
LogQueue -> s -> m ()
Caster.warn LogQueue
g s
s
err :: (MonadIO m, ToBuilder s) => s -> m ()
err s :: s
s = m LogQueue
forall (m :: * -> *). (MonadLogger m, MonadIO m) => m LogQueue
getLogger m LogQueue -> (LogQueue -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \g :: LogQueue
g -> LogQueue -> s -> m ()
forall (m :: * -> *) s.
(MonadIO m, ToBuilder s) =>
LogQueue -> s -> m ()
Caster.err LogQueue
g s
s
stdoutLogger :: LogLevel -> IO LogQueue
stdoutLogger :: LogLevel -> IO LogQueue
stdoutLogger level :: LogLevel
level = do
LogChan
chan <- IO LogChan
newLogChan
LogQueue
q <- IO LogQueue
newLogQueue
ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ LogChan -> LogLevel -> Listener -> IO ()
relayLog LogChan
chan LogLevel
level Listener
terminalListener
ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ LogQueue -> LogChan -> IO ()
broadcastLog LogQueue
q LogChan
chan
LogQueue -> IO LogQueue
forall (m :: * -> *) a. Monad m => a -> m a
return LogQueue
q
iohandleLogger :: Handle -> LogLevel -> IO LogQueue
iohandleLogger :: Handle -> LogLevel -> IO LogQueue
iohandleLogger handle :: Handle
handle level :: LogLevel
level = do
LogChan
chan <- IO LogChan
newLogChan
LogQueue
q <- IO LogQueue
newLogQueue
ThreadId
_ <- IO () -> IO ThreadId
forkIO
(IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ LogChan -> LogLevel -> Listener -> IO ()
relayLog LogChan
chan LogLevel
level (Formatter -> Handle -> Listener
handleListenerFlush Formatter
terminalFormatter Handle
handle)
ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ LogQueue -> LogChan -> IO ()
broadcastLog LogQueue
q LogChan
chan
LogQueue -> IO LogQueue
forall (m :: * -> *) a. Monad m => a -> m a
return LogQueue
q