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

Pure implementation of logging action.
-}

module Colog.Pure
       ( PureLoggerT (..)
       , runPureLogT

       , PureLogger
       , runPureLog

       , logMessagePure
       ) where

import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.State (MonadState, StateT (..), modify')
import Control.Monad.Trans.Class (MonadTrans)
import Data.Bifunctor (second)
import Data.Foldable (toList)
import Data.Functor.Identity (Identity (..))
import Data.Sequence (Seq, (|>))

import Colog.Core.Action (LogAction (..))


{- | Pure monad transformer for logging. Can log any @msg@ messages. Allows to
log messages by storing them in the internal state.
-}
newtype PureLoggerT msg m a = PureLoggerT
    { forall msg (m :: * -> *) a.
PureLoggerT msg m a -> StateT (Seq msg) m a
runPureLoggerT :: StateT (Seq msg) m a
    } deriving newtype ( (forall a b.
 (a -> b) -> PureLoggerT msg m a -> PureLoggerT msg m b)
-> (forall a b. a -> PureLoggerT msg m b -> PureLoggerT msg m a)
-> Functor (PureLoggerT msg m)
forall a b. a -> PureLoggerT msg m b -> PureLoggerT msg m a
forall a b. (a -> b) -> PureLoggerT msg m a -> PureLoggerT msg m b
forall msg (m :: * -> *) a b.
Functor m =>
a -> PureLoggerT msg m b -> PureLoggerT msg m a
forall msg (m :: * -> *) a b.
Functor m =>
(a -> b) -> PureLoggerT msg m a -> PureLoggerT msg m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall msg (m :: * -> *) a b.
Functor m =>
(a -> b) -> PureLoggerT msg m a -> PureLoggerT msg m b
fmap :: forall a b. (a -> b) -> PureLoggerT msg m a -> PureLoggerT msg m b
$c<$ :: forall msg (m :: * -> *) a b.
Functor m =>
a -> PureLoggerT msg m b -> PureLoggerT msg m a
<$ :: forall a b. a -> PureLoggerT msg m b -> PureLoggerT msg m a
Functor, Functor (PureLoggerT msg m)
Functor (PureLoggerT msg m) =>
(forall a. a -> PureLoggerT msg m a)
-> (forall a b.
    PureLoggerT msg m (a -> b)
    -> PureLoggerT msg m a -> PureLoggerT msg m b)
-> (forall a b c.
    (a -> b -> c)
    -> PureLoggerT msg m a
    -> PureLoggerT msg m b
    -> PureLoggerT msg m c)
-> (forall a b.
    PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b)
-> (forall a b.
    PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m a)
-> Applicative (PureLoggerT msg m)
forall a. a -> PureLoggerT msg m a
forall a b.
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m a
forall a b.
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b
forall a b.
PureLoggerT msg m (a -> b)
-> PureLoggerT msg m a -> PureLoggerT msg m b
forall a b c.
(a -> b -> c)
-> PureLoggerT msg m a
-> PureLoggerT msg m b
-> PureLoggerT msg m c
forall msg (m :: * -> *). Monad m => Functor (PureLoggerT msg m)
forall msg (m :: * -> *) a. Monad m => a -> PureLoggerT msg m a
forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m a
forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b
forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m (a -> b)
-> PureLoggerT msg m a -> PureLoggerT msg m b
forall msg (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> PureLoggerT msg m a
-> PureLoggerT msg m b
-> PureLoggerT msg m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall msg (m :: * -> *) a. Monad m => a -> PureLoggerT msg m a
pure :: forall a. a -> PureLoggerT msg m a
$c<*> :: forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m (a -> b)
-> PureLoggerT msg m a -> PureLoggerT msg m b
<*> :: forall a b.
PureLoggerT msg m (a -> b)
-> PureLoggerT msg m a -> PureLoggerT msg m b
$cliftA2 :: forall msg (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> PureLoggerT msg m a
-> PureLoggerT msg m b
-> PureLoggerT msg m c
liftA2 :: forall a b c.
(a -> b -> c)
-> PureLoggerT msg m a
-> PureLoggerT msg m b
-> PureLoggerT msg m c
$c*> :: forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b
*> :: forall a b.
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b
$c<* :: forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m a
<* :: forall a b.
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m a
Applicative, Applicative (PureLoggerT msg m)
Applicative (PureLoggerT msg m) =>
(forall a b.
 PureLoggerT msg m a
 -> (a -> PureLoggerT msg m b) -> PureLoggerT msg m b)
-> (forall a b.
    PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b)
-> (forall a. a -> PureLoggerT msg m a)
-> Monad (PureLoggerT msg m)
forall a. a -> PureLoggerT msg m a
forall a b.
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b
forall a b.
PureLoggerT msg m a
-> (a -> PureLoggerT msg m b) -> PureLoggerT msg m b
forall msg (m :: * -> *).
Monad m =>
Applicative (PureLoggerT msg m)
forall msg (m :: * -> *) a. Monad m => a -> PureLoggerT msg m a
forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b
forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m a
-> (a -> PureLoggerT msg m b) -> PureLoggerT msg m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m a
-> (a -> PureLoggerT msg m b) -> PureLoggerT msg m b
>>= :: forall a b.
PureLoggerT msg m a
-> (a -> PureLoggerT msg m b) -> PureLoggerT msg m b
$c>> :: forall msg (m :: * -> *) a b.
Monad m =>
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b
>> :: forall a b.
PureLoggerT msg m a -> PureLoggerT msg m b -> PureLoggerT msg m b
$creturn :: forall msg (m :: * -> *) a. Monad m => a -> PureLoggerT msg m a
return :: forall a. a -> PureLoggerT msg m a
Monad, (forall (m :: * -> *). Monad m => Monad (PureLoggerT msg m)) =>
(forall (m :: * -> *) a. Monad m => m a -> PureLoggerT msg m a)
-> MonadTrans (PureLoggerT msg)
forall msg (m :: * -> *). Monad m => Monad (PureLoggerT msg m)
forall msg (m :: * -> *) a. Monad m => m a -> PureLoggerT msg m a
forall (m :: * -> *). Monad m => Monad (PureLoggerT msg m)
forall (m :: * -> *) a. Monad m => m a -> PureLoggerT msg m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall msg (m :: * -> *) a. Monad m => m a -> PureLoggerT msg m a
lift :: forall (m :: * -> *) a. Monad m => m a -> PureLoggerT msg m a
MonadTrans
                       , MonadState (Seq msg), Monad (PureLoggerT msg m)
Monad (PureLoggerT msg m) =>
(forall a. String -> PureLoggerT msg m a)
-> MonadFail (PureLoggerT msg m)
forall a. String -> PureLoggerT msg m a
forall msg (m :: * -> *). MonadFail m => Monad (PureLoggerT msg m)
forall msg (m :: * -> *) a.
MonadFail m =>
String -> PureLoggerT msg m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall msg (m :: * -> *) a.
MonadFail m =>
String -> PureLoggerT msg m a
fail :: forall a. String -> PureLoggerT msg m a
MonadFail, Monad (PureLoggerT msg m)
Monad (PureLoggerT msg m) =>
(forall a. IO a -> PureLoggerT msg m a)
-> MonadIO (PureLoggerT msg m)
forall a. IO a -> PureLoggerT msg m a
forall msg (m :: * -> *). MonadIO m => Monad (PureLoggerT msg m)
forall msg (m :: * -> *) a.
MonadIO m =>
IO a -> PureLoggerT msg m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall msg (m :: * -> *) a.
MonadIO m =>
IO a -> PureLoggerT msg m a
liftIO :: forall a. IO a -> PureLoggerT msg m a
MonadIO, Monad (PureLoggerT msg m)
Monad (PureLoggerT msg m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 e -> PureLoggerT msg m a)
-> MonadThrow (PureLoggerT msg m)
forall e a. (HasCallStack, Exception e) => e -> PureLoggerT msg m a
forall msg (m :: * -> *). MonadThrow m => Monad (PureLoggerT msg m)
forall msg (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> PureLoggerT msg m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall msg (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> PureLoggerT msg m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> PureLoggerT msg m a
MonadThrow
                       )

-- | Returns result value of 'PureLoggerT' and list of logged messages.
runPureLogT :: Functor m => PureLoggerT msg m a -> m (a, [msg])
runPureLogT :: forall (m :: * -> *) msg a.
Functor m =>
PureLoggerT msg m a -> m (a, [msg])
runPureLogT = ((a, Seq msg) -> (a, [msg])) -> m (a, Seq msg) -> m (a, [msg])
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Seq msg -> [msg]) -> (a, Seq msg) -> (a, [msg])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Seq msg -> [msg]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) (m (a, Seq msg) -> m (a, [msg]))
-> (PureLoggerT msg m a -> m (a, Seq msg))
-> PureLoggerT msg m a
-> m (a, [msg])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (Seq msg) m a -> Seq msg -> m (a, Seq msg))
-> Seq msg -> StateT (Seq msg) m a -> m (a, Seq msg)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Seq msg) m a -> Seq msg -> m (a, Seq msg)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Seq msg
forall a. Monoid a => a
mempty (StateT (Seq msg) m a -> m (a, Seq msg))
-> (PureLoggerT msg m a -> StateT (Seq msg) m a)
-> PureLoggerT msg m a
-> m (a, Seq msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureLoggerT msg m a -> StateT (Seq msg) m a
forall msg (m :: * -> *) a.
PureLoggerT msg m a -> StateT (Seq msg) m a
runPureLoggerT

-- | 'PureLoggerT' specialized to 'Identity'
type PureLogger msg = PureLoggerT msg Identity

-- | Returns result value of 'PureLogger' and list of logged messages.
runPureLog :: PureLogger msg a -> (a, [msg])
runPureLog :: forall msg a. PureLogger msg a -> (a, [msg])
runPureLog = Identity (a, [msg]) -> (a, [msg])
forall a. Identity a -> a
runIdentity (Identity (a, [msg]) -> (a, [msg]))
-> (PureLogger msg a -> Identity (a, [msg]))
-> PureLogger msg a
-> (a, [msg])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureLogger msg a -> Identity (a, [msg])
forall (m :: * -> *) msg a.
Functor m =>
PureLoggerT msg m a -> m (a, [msg])
runPureLogT
{-# INLINE runPureLog #-}

-- | 'LogAction' that prints @msg@ by appending it to the end of the sequence.
logMessagePure :: Monad m => LogAction (PureLoggerT msg m) msg
logMessagePure :: forall (m :: * -> *) msg.
Monad m =>
LogAction (PureLoggerT msg m) msg
logMessagePure = (msg -> PureLoggerT msg m ()) -> LogAction (PureLoggerT msg m) msg
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((msg -> PureLoggerT msg m ())
 -> LogAction (PureLoggerT msg m) msg)
-> (msg -> PureLoggerT msg m ())
-> LogAction (PureLoggerT msg m) msg
forall a b. (a -> b) -> a -> b
$ \msg
msg -> (Seq msg -> Seq msg) -> PureLoggerT msg m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Seq msg -> msg -> Seq msg
forall a. Seq a -> a -> Seq a
|> msg
msg)
{-# INLINE logMessagePure #-}