{- |
Copyright:  (c) 2018-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Logging actions for various text types.
-}

module Colog.Actions
       ( -- * 'ByteString' actions
         logByteStringStdout
       , logByteStringStderr
       , logByteStringHandle
       , withLogByteStringFile

         -- * 'Text' actions
       , logTextStdout
       , logTextStderr
       , logTextHandle
       , withLogTextFile

         -- * 'Message' actions
         -- $msg
       , simpleMessageAction
       , richMessageAction
       ) where

import Control.Monad.IO.Class (MonadIO (..))
import Data.Text.Encoding (encodeUtf8)
import System.IO (Handle, IOMode (AppendMode), stderr, withFile)

import Colog.Core.Action (LogAction (..), cmapM, (>$<))
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

----------------------------------------------------------------------------
-- ByteString
----------------------------------------------------------------------------

{- | Action that prints 'BS.ByteString' to stdout. -}
logByteStringStdout :: MonadIO m => LogAction m BS.ByteString
logByteStringStdout :: LogAction m ByteString
logByteStringStdout = (ByteString -> m ()) -> LogAction m ByteString
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((ByteString -> m ()) -> LogAction m ByteString)
-> (ByteString -> m ()) -> LogAction m ByteString
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (ByteString -> IO ()) -> ByteString -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
BS8.putStrLn
{-# INLINE logByteStringStdout #-}
{-# SPECIALIZE logByteStringStdout :: LogAction IO BS.ByteString #-}

{- | Action that prints 'BS.ByteString' to stderr. -}
logByteStringStderr :: MonadIO m => LogAction m BS.ByteString
logByteStringStderr :: LogAction m ByteString
logByteStringStderr = Handle -> LogAction m ByteString
forall (m :: * -> *). MonadIO m => Handle -> LogAction m ByteString
logByteStringHandle Handle
stderr
{-# INLINE logByteStringStderr #-}
{-# SPECIALIZE logByteStringStderr :: LogAction IO BS.ByteString #-}

{- | Action that prints 'BS.ByteString' to 'Handle'. -}
logByteStringHandle :: MonadIO m => Handle -> LogAction m BS.ByteString
logByteStringHandle :: Handle -> LogAction m ByteString
logByteStringHandle handle :: Handle
handle = (ByteString -> m ()) -> LogAction m ByteString
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((ByteString -> m ()) -> LogAction m ByteString)
-> (ByteString -> m ()) -> LogAction m ByteString
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (ByteString -> IO ()) -> ByteString -> m ()
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 #-}

{- | Action that prints 'BS.ByteString' to file. See
'Colog.Core.Action.withLogStringFile' for details.
-}
withLogByteStringFile :: MonadIO m => FilePath -> (LogAction m BS.ByteString -> IO r) -> IO r
withLogByteStringFile :: FilePath -> (LogAction m ByteString -> IO r) -> IO r
withLogByteStringFile path :: FilePath
path action :: LogAction m ByteString -> IO r
action = FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
path IOMode
AppendMode ((Handle -> IO r) -> IO r) -> (Handle -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ LogAction m ByteString -> IO r
action (LogAction m ByteString -> IO r)
-> (Handle -> LogAction m ByteString) -> Handle -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> LogAction m ByteString
forall (m :: * -> *). MonadIO m => Handle -> LogAction m ByteString
logByteStringHandle
{-# INLINE withLogByteStringFile #-}
{-# SPECIALIZE withLogByteStringFile :: FilePath -> (LogAction IO BS.ByteString -> IO r) -> IO r #-}

----------------------------------------------------------------------------
-- Text
----------------------------------------------------------------------------

{- | Action that prints 'T.Text' to stdout. -}
logTextStdout :: MonadIO m => LogAction m T.Text
logTextStdout :: LogAction m Text
logTextStdout = (Text -> m ()) -> LogAction m Text
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((Text -> m ()) -> LogAction m Text)
-> (Text -> m ()) -> LogAction m Text
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
TIO.putStrLn
{-# INLINE logTextStdout #-}
{-# SPECIALIZE logTextStdout :: LogAction IO T.Text #-}

{- | Action that prints 'T.Text' to stderr. -}
logTextStderr :: MonadIO m => LogAction m T.Text
logTextStderr :: LogAction m Text
logTextStderr = Handle -> LogAction m Text
forall (m :: * -> *). MonadIO m => Handle -> LogAction m Text
logTextHandle Handle
stderr
{-# INLINE logTextStderr #-}
{-# SPECIALIZE logTextStderr :: LogAction IO T.Text #-}

{- | Action that prints 'T.Text' to 'Handle'. -}
logTextHandle :: MonadIO m => Handle -> LogAction m T.Text
logTextHandle :: Handle -> LogAction m Text
logTextHandle handle :: Handle
handle = (Text -> m ()) -> LogAction m Text
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((Text -> m ()) -> LogAction m Text)
-> (Text -> m ()) -> LogAction m Text
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> IO ()
TIO.hPutStrLn Handle
handle
{-# INLINE logTextHandle #-}
{-# SPECIALIZE logTextHandle :: Handle -> LogAction IO T.Text #-}

{- | Action that prints 'T.Text' to file. See
'Colog.Core.Action.withLogStringFile' for details.
-}
withLogTextFile :: MonadIO m => FilePath -> (LogAction m T.Text -> IO r) -> IO r
withLogTextFile :: FilePath -> (LogAction m Text -> IO r) -> IO r
withLogTextFile path :: FilePath
path action :: LogAction m Text -> IO r
action = FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
path IOMode
AppendMode ((Handle -> IO r) -> IO r) -> (Handle -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ LogAction m Text -> IO r
action (LogAction m Text -> IO r)
-> (Handle -> LogAction m Text) -> Handle -> IO r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> LogAction m Text
forall (m :: * -> *). MonadIO m => Handle -> LogAction m Text
logTextHandle
{-# INLINE withLogTextFile #-}
{-# SPECIALIZE withLogTextFile :: FilePath -> (LogAction IO T.Text -> IO r) -> IO r #-}

----------------------------------------------------------------------------
-- Message
----------------------------------------------------------------------------

{- $msg
Default logging actions to make the usage with 'Message's easier.
-}

{- | Action that prints 'Message' to 'stdout'. -}
simpleMessageAction :: MonadIO m => LogAction m Message
simpleMessageAction :: LogAction m Message
simpleMessageAction = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Message -> Text) -> Message -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Message -> Text
fmtMessage (Message -> ByteString)
-> LogAction m ByteString -> LogAction m Message
forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
>$< LogAction m ByteString
forall (m :: * -> *). MonadIO m => LogAction m ByteString
logByteStringStdout
{-# INLINE simpleMessageAction #-}
{-# SPECIALIZE simpleMessageAction :: LogAction IO Message #-}

{- | Action that constructs 'Colog.Message.RichMessage' and prints formatted
'Message' for it to 'stdout'.
-}
richMessageAction :: MonadIO m => LogAction m Message
richMessageAction :: LogAction m Message
richMessageAction = FieldMap m
-> LogAction m (RichMsg m Message) -> LogAction m Message
forall (m :: * -> *) msg.
FieldMap m -> LogAction m (RichMsg m msg) -> LogAction m msg
upgradeMessageAction FieldMap m
forall (m :: * -> *). MonadIO m => FieldMap m
defaultFieldMap (LogAction m (RichMsg m Message) -> LogAction m Message)
-> LogAction m (RichMsg m Message) -> LogAction m Message
forall a b. (a -> b) -> a -> b
$
    (RichMsg m Message -> m ByteString)
-> LogAction m ByteString -> LogAction m (RichMsg m Message)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LogAction m b -> LogAction m a
cmapM ((Text -> ByteString) -> m Text -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
encodeUtf8 (m Text -> m ByteString)
-> (RichMsg m Message -> m Text)
-> RichMsg m Message
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RichMsg m Message -> m Text
forall (m :: * -> *). MonadIO m => RichMessage m -> m Text
fmtRichMessageDefault) LogAction m ByteString
forall (m :: * -> *). MonadIO m => LogAction m ByteString
logByteStringStdout
{-# INLINE richMessageAction #-}
{-# SPECIALIZE richMessageAction :: LogAction IO Message #-}