{-| A simple logger class for LightT monad -}
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