{-# 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 = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 = 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 = 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 -> 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 = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
AppendMode forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
  LogAction m String -> IO r
action (forall (m :: * -> *). MonadIO m => Handle -> LogAction m String
logStringHandle Handle
handle forall a. Semigroup a => a -> a -> a
<> 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 = 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
. 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 = 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 = 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
. 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 = forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
AppendMode forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
  LogAction m a -> IO r
action (forall a (m :: * -> *).
(Show a, MonadIO m) =>
Handle -> LogAction m a
logPrintHandle Handle
handle forall a. Semigroup a => a -> a -> 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) = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
handle
{-# INLINE logFlush #-}
{-# SPECIALIZE logFlush :: Handle -> LogAction IO a #-}