module Colog.Actions
(
logByteStringStdout
, logByteStringStderr
, logByteStringHandle
, withLogByteStringFile
, logTextStdout
, logTextStderr
, logTextHandle
, withLogTextFile
, simpleMessageAction
, richMessageAction
) where
import Control.Monad.IO.Class (MonadIO (..))
import Data.Text.Encoding (encodeUtf8)
import System.IO (Handle, IOMode (AppendMode), stderr, stdout, withFile)
import Colog.Core.Action (LogAction (..), cmapM, (>$<))
import Colog.Core.IO (logFlush)
import Colog.Message (Message, defaultFieldMap, fmtMessage, fmtRichMessageDefault,
upgradeMessageAction)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
logByteStringStdout :: MonadIO m => LogAction m BS.ByteString
logByteStringStdout :: forall (m :: * -> *). MonadIO m => LogAction m ByteString
logByteStringStdout = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
BS8.putStrLn
{-# INLINE logByteStringStdout #-}
{-# SPECIALIZE logByteStringStdout :: LogAction IO BS.ByteString #-}
logByteStringStderr :: MonadIO m => LogAction m BS.ByteString
logByteStringStderr :: forall (m :: * -> *). MonadIO m => LogAction m ByteString
logByteStringStderr = forall (m :: * -> *). MonadIO m => Handle -> LogAction m ByteString
logByteStringHandle Handle
stderr
{-# INLINE logByteStringStderr #-}
{-# SPECIALIZE logByteStringStderr :: LogAction IO BS.ByteString #-}
logByteStringHandle :: MonadIO m => Handle -> LogAction m BS.ByteString
logByteStringHandle :: forall (m :: * -> *). MonadIO m => Handle -> LogAction m ByteString
logByteStringHandle Handle
handle = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> ByteString -> IO ()
BS8.hPutStrLn Handle
handle
{-# INLINE logByteStringHandle #-}
{-# SPECIALIZE logByteStringHandle :: Handle -> LogAction IO BS.ByteString #-}
withLogByteStringFile :: MonadIO m => FilePath -> (LogAction m BS.ByteString -> IO r) -> IO r
withLogByteStringFile :: forall (m :: * -> *) r.
MonadIO m =>
FilePath -> (LogAction m ByteString -> IO r) -> IO r
withLogByteStringFile FilePath
path LogAction m ByteString -> IO r
action = forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
path IOMode
AppendMode forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
LogAction m ByteString -> IO r
action (forall (m :: * -> *). MonadIO m => Handle -> LogAction m ByteString
logByteStringHandle Handle
handle forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *) a. MonadIO m => Handle -> LogAction m a
logFlush Handle
handle)
{-# INLINE withLogByteStringFile #-}
{-# SPECIALIZE withLogByteStringFile :: FilePath -> (LogAction IO BS.ByteString -> IO r) -> IO r #-}
logTextStdout :: MonadIO m => LogAction m T.Text
logTextStdout :: forall (m :: * -> *). MonadIO m => LogAction m Text
logTextStdout = forall (m :: * -> *). MonadIO m => Handle -> LogAction m Text
logTextHandle Handle
stdout
{-# INLINE logTextStdout #-}
{-# SPECIALIZE logTextStdout :: LogAction IO T.Text #-}
logTextStderr :: MonadIO m => LogAction m T.Text
logTextStderr :: forall (m :: * -> *). MonadIO m => LogAction m Text
logTextStderr = forall (m :: * -> *). MonadIO m => Handle -> LogAction m Text
logTextHandle Handle
stderr
{-# INLINE logTextStderr #-}
{-# SPECIALIZE logTextStderr :: LogAction IO T.Text #-}
logTextHandle :: MonadIO m => Handle -> LogAction m T.Text
logTextHandle :: forall (m :: * -> *). MonadIO m => Handle -> LogAction m Text
logTextHandle Handle
handle = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction forall a b. (a -> b) -> a -> b
$ \Text
m -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
TIO.hPutStr Handle
handle forall a b. (a -> b) -> a -> b
$ Text
m forall a. Semigroup a => a -> a -> a
<> Text
"\n"
{-# INLINE logTextHandle #-}
{-# SPECIALIZE logTextHandle :: Handle -> LogAction IO T.Text #-}
withLogTextFile :: MonadIO m => FilePath -> (LogAction m T.Text -> IO r) -> IO r
withLogTextFile :: forall (m :: * -> *) r.
MonadIO m =>
FilePath -> (LogAction m Text -> IO r) -> IO r
withLogTextFile FilePath
path LogAction m Text -> IO r
action = forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
path IOMode
AppendMode forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
LogAction m Text -> IO r
action (forall (m :: * -> *). MonadIO m => Handle -> LogAction m Text
logTextHandle Handle
handle forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *) a. MonadIO m => Handle -> LogAction m a
logFlush Handle
handle)
{-# INLINE withLogTextFile #-}
{-# SPECIALIZE withLogTextFile :: FilePath -> (LogAction IO T.Text -> IO r) -> IO r #-}
simpleMessageAction :: MonadIO m => LogAction m Message
simpleMessageAction :: forall (m :: * -> *). MonadIO m => LogAction m Message
simpleMessageAction = Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Text
fmtMessage forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
>$< forall (m :: * -> *). MonadIO m => LogAction m ByteString
logByteStringStdout
{-# INLINE simpleMessageAction #-}
{-# SPECIALIZE simpleMessageAction :: LogAction IO Message #-}
richMessageAction :: MonadIO m => LogAction m Message
richMessageAction :: forall (m :: * -> *). MonadIO m => LogAction m Message
richMessageAction = forall (m :: * -> *) msg.
FieldMap m -> LogAction m (RichMsg m msg) -> LogAction m msg
upgradeMessageAction forall (m :: * -> *). MonadIO m => FieldMap m
defaultFieldMap forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LogAction m b -> LogAction m a
cmapM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => RichMessage m -> m Text
fmtRichMessageDefault) forall (m :: * -> *). MonadIO m => LogAction m ByteString
logByteStringStdout
{-# INLINE richMessageAction #-}
{-# SPECIALIZE richMessageAction :: LogAction IO Message #-}