{-# LANGUAGE CPP #-}

{- |
Module                  : Colog.Core.IO
Copyright               : (c) 2018-2020 Kowainik, 2021-2022 Co-Log
SPDX-License-Identifier : MPL-2.0
Maintainer              : Co-Log <xrom.xkov@gmail.com>
Stability               : Stable
Portability             : Portable

Introduces logging actions working in 'MonadIO'. These actions are very basic
and inefficient because they use the 'String' data type. If you don't want to
have extra dependencies and performance of logging is not the bottleneck of your
application, then these functions should be enough. Otherwise use functions from
the "Colog.Actions" module from the @co-log@ package.
-}

module Colog.Core.IO
       ( -- * 'String' actions
         logStringStdout
       , logStringStderr
       , logStringHandle
       , withLogStringFile

         -- * 'Show' actions
       , logPrint
       , logPrintStderr
       , logPrintHandle
       , withLogPrintFile

         -- * Various combinators
       , liftLogIO
       , logFlush
       ) where

import Colog.Core.Action (LogAction (..))
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Semigroup ((<>))
import System.IO (Handle, IOMode (AppendMode), hFlush, hPrint, hPutStrLn, stderr, withFile)


{- $setup
>>> import Colog.Core.Action
-}

----------------------------------------------------------------------------
-- String
----------------------------------------------------------------------------

{- | Action that prints 'String' to stdout.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.

>>> logStringStdout <& "foo"
foo
-}
logStringStdout :: MonadIO m => LogAction m String
logStringStdout :: forall (m :: * -> *). MonadIO m => LogAction m String
logStringStdout = (String -> m ()) -> LogAction m String
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn)
{-# INLINE logStringStdout #-}
{-# SPECIALIZE logStringStdout :: LogAction IO String #-}

{- | Action that prints 'String' to stderr.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.

>>> logStringStderr <& "foo"
foo
-}
logStringStderr :: MonadIO m => LogAction m String
logStringStderr :: forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr = Handle -> LogAction m String
forall (m :: * -> *). MonadIO m => Handle -> LogAction m String
logStringHandle Handle
stderr
{-# INLINE logStringStderr #-}
{-# SPECIALIZE logStringStderr :: LogAction IO String #-}

{- | Action that prints 'String' to 'Handle'.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.

>>> logStringHandle stderr <& "foo"
foo
-}
logStringHandle :: MonadIO m => Handle -> LogAction m String
logStringHandle :: forall (m :: * -> *). MonadIO m => Handle -> LogAction m String
logStringHandle Handle
handle = (String -> m ()) -> LogAction m String
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((String -> m ()) -> LogAction m String)
-> (String -> m ()) -> LogAction m String
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
handle
{-# INLINE logStringHandle #-}
{-# SPECIALIZE logStringHandle :: Handle -> LogAction IO String #-}

{- | Action that prints 'String' to file. Instead of returning 'LogAction' it's
implemented in continuation-passing style because it's more efficient to open
file only once at the start of the application and write to 'Handle' instead of
opening file each time we need to write to it.

Opens file in 'AppendMode'. Automatically flushes the output buffer.

#ifndef mingw32_HOST_OS

>>> logger action = action <& "foo"
>>> withLogStringFile "/dev/stdout" logger
foo

#endif
-}
withLogStringFile :: MonadIO m => FilePath -> (LogAction m String -> IO r) -> IO r
withLogStringFile :: forall (m :: * -> *) r.
MonadIO m =>
String -> (LogAction m String -> IO r) -> IO r
withLogStringFile String
path LogAction m String -> IO r
action = String -> IOMode -> (Handle -> IO r) -> IO r
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
AppendMode ((Handle -> IO r) -> IO r) -> (Handle -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
  LogAction m String -> IO r
action (Handle -> LogAction m String
forall (m :: * -> *). MonadIO m => Handle -> LogAction m String
logStringHandle Handle
handle LogAction m String -> LogAction m String -> LogAction m String
forall a. Semigroup a => a -> a -> a
<> Handle -> LogAction m String
forall (m :: * -> *) a. MonadIO m => Handle -> LogAction m a
logFlush Handle
handle)
{-# INLINE withLogStringFile #-}
{-# SPECIALIZE withLogStringFile :: FilePath -> (LogAction IO String -> IO r) -> IO r #-}

----------------------------------------------------------------------------
-- Show
----------------------------------------------------------------------------

{- | Action that prints to stdout using 'Show'.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.

>>> logPrint <& 5
5
-}
logPrint :: forall a m . (Show a, MonadIO m) => LogAction m a
logPrint :: forall a (m :: * -> *). (Show a, MonadIO m) => LogAction m a
logPrint = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
forall a. Show a => a -> IO ()
print
{-# INLINE logPrint #-}
{-# SPECIALIZE logPrint :: Show a => LogAction IO a #-}

{- | Action that prints to stderr using 'Show'.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.

>>> logPrintStderr <& 5
5
-}
logPrintStderr :: forall a m . (Show a, MonadIO m) => LogAction m a
logPrintStderr :: forall a (m :: * -> *). (Show a, MonadIO m) => LogAction m a
logPrintStderr = Handle -> LogAction m a
forall a (m :: * -> *).
(Show a, MonadIO m) =>
Handle -> LogAction m a
logPrintHandle Handle
stderr
{-# INLINE logPrintStderr #-}
{-# SPECIALIZE logPrintStderr :: Show a => LogAction IO a #-}

{- | Action that prints to a 'Handle' using 'Show'.
This action does not flush the output buffer.
If buffering mode is block buffering, the effect of this action can be delayed.

>>> logPrintHandle stderr <& 5
5
-}
logPrintHandle :: forall a m . (Show a, MonadIO m) => Handle -> LogAction m a
logPrintHandle :: forall a (m :: * -> *).
(Show a, MonadIO m) =>
Handle -> LogAction m a
logPrintHandle Handle
handle = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> a -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
handle
{-# INLINE logPrintHandle #-}
{-# SPECIALIZE logPrintHandle :: Show a => Handle -> LogAction IO a #-}

{- | Action that prints to a file using 'Show'. See 'withLogStringFile' for details.
-}
withLogPrintFile
    :: forall a m r . (Show a, MonadIO m)
    => FilePath
    -> (LogAction m a -> IO r)
    -> IO r
withLogPrintFile :: forall a (m :: * -> *) r.
(Show a, MonadIO m) =>
String -> (LogAction m a -> IO r) -> IO r
withLogPrintFile String
path LogAction m a -> IO r
action = String -> IOMode -> (Handle -> IO r) -> IO r
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
AppendMode ((Handle -> IO r) -> IO r) -> (Handle -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
  LogAction m a -> IO r
action (Handle -> LogAction m a
forall a (m :: * -> *).
(Show a, MonadIO m) =>
Handle -> LogAction m a
logPrintHandle Handle
handle LogAction m a -> LogAction m a -> LogAction m a
forall a. Semigroup a => a -> a -> a
<> Handle -> LogAction m a
forall (m :: * -> *) a. MonadIO m => Handle -> LogAction m a
logFlush Handle
handle)
{-# INLINE withLogPrintFile #-}
{-# SPECIALIZE withLogPrintFile :: Show a => FilePath -> (LogAction IO a -> IO r) -> IO r #-}

----------------------------------------------------------------------------
-- Misc
----------------------------------------------------------------------------

{- | Lifts a LogAction over IO into a more general Monad.

>>> logToStdout = LogAction putStrLn
>>> liftLogIO logToStdout <& "foo"
foo
-}
liftLogIO :: MonadIO m => LogAction IO msg -> LogAction m msg
liftLogIO :: forall (m :: * -> *) msg.
MonadIO m =>
LogAction IO msg -> LogAction m msg
liftLogIO (LogAction msg -> IO ()
action) = (msg -> m ()) -> LogAction m msg
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (msg -> IO ()) -> msg -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. msg -> IO ()
action)
{-# INLINE liftLogIO #-}

{- | This action can be used in combination with other actions to flush
a handle every time you log anything.

@since 0.3.0.0
-}
logFlush :: MonadIO m => Handle -> LogAction m a
logFlush :: forall (m :: * -> *) a. MonadIO m => Handle -> LogAction m a
logFlush Handle
handle = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((a -> m ()) -> LogAction m a) -> (a -> m ()) -> LogAction m a
forall a b. (a -> b) -> a -> b
$ m () -> a -> m ()
forall a b. a -> b -> a
const (m () -> a -> m ()) -> m () -> a -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
handle
{-# INLINE logFlush #-}
{-# SPECIALIZE logFlush :: Handle -> LogAction IO a #-}