{- |
Copyright:  (c) 2018-2022 Kowainik, 2023 Co-Log
SPDX-License-Identifier: MPL-2.0

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, 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

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

{- | Action that prints 'BS.ByteString' to stdout.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.
-}
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 #-}

{- | Action that prints 'BS.ByteString' to stderr.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.
-}
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 #-}

{- | Action that prints 'BS.ByteString' to 'Handle'.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.
-}
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 #-}

{- | 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 :: 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 #-}

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

{- | Action that prints 'T.Text' to stdout.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.
-}
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 #-}

{- | Action that prints 'T.Text' to stderr.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.
-}
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 #-}

{- | Action that prints 'T.Text' to 'Handle'.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.
-}
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 #-}

{- | 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 :: 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 #-}

----------------------------------------------------------------------------
-- 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 :: 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 #-}

{- | Action that constructs 'Colog.Message.RichMessage' and prints formatted
'Message' for it to 'stdout'.
-}
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 #-}