{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Colog.Core.Action
(
LogAction (..)
, (<&)
, (&>)
, foldActions
, cfilter
, cfilterM
, cmap
, (>$<)
, cmapMaybe
, cmapMaybeM
, (Colog.Core.Action.>$)
, cmapM
, divide
, divideM
, conquer
, (>*<)
, (>*)
, (*<)
, lose
, choose
, chooseM
, (>|<)
, extract
, extend
, (=>>)
, (<<=)
, duplicate
, multiplicate
, separate
, hoistLogAction
) where
import Control.Monad (when, (<=<), (>=>))
import Data.Coerce (coerce)
import Data.Foldable (fold, for_, traverse_)
import Data.Kind (Constraint)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..), stimesMonoid)
import Data.Void (Void, absurd)
import GHC.TypeLits (ErrorMessage (..), TypeError)
#if MIN_VERSION_base(4,12,0)
import qualified Data.Functor.Contravariant as Contravariant
#endif
newtype LogAction m msg = LogAction
{ forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
unLogAction :: msg -> m ()
}
instance Applicative m => Semigroup (LogAction m a) where
(<>) :: LogAction m a -> LogAction m a -> LogAction m a
LogAction a -> m ()
action1 <> :: LogAction m a -> LogAction m a -> LogAction m a
<> LogAction a -> m ()
action2 = (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
$ \a
a -> a -> m ()
action1 a
a m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> m ()
action2 a
a
{-# INLINE (<>) #-}
sconcat :: NonEmpty (LogAction m a) -> LogAction m a
sconcat :: NonEmpty (LogAction m a) -> LogAction m a
sconcat = NonEmpty (LogAction m a) -> LogAction m a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Applicative m) =>
t (LogAction m a) -> LogAction m a
foldActions
{-# INLINE sconcat #-}
stimes :: Integral b => b -> LogAction m a -> LogAction m a
stimes :: forall b. Integral b => b -> LogAction m a -> LogAction m a
stimes = b -> LogAction m a -> LogAction m a
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid
{-# INLINE stimes #-}
instance Applicative m => Monoid (LogAction m a) where
mappend :: LogAction m a -> LogAction m a -> LogAction m a
mappend :: LogAction m a -> LogAction m a -> LogAction m a
mappend = LogAction m a -> LogAction m a -> LogAction m a
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mappend #-}
mempty :: LogAction m a
mempty :: LogAction m a
mempty = (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
$ \a
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE mempty #-}
mconcat :: [LogAction m a] -> LogAction m a
mconcat :: [LogAction m a] -> LogAction m a
mconcat = [LogAction m a] -> LogAction m a
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Applicative m) =>
t (LogAction m a) -> LogAction m a
foldActions
{-# INLINE mconcat #-}
#if MIN_VERSION_base(4,12,0)
instance Contravariant.Contravariant (LogAction m) where
contramap :: (a -> b) -> LogAction m b -> LogAction m a
contramap :: forall a' a. (a' -> a) -> LogAction m a -> LogAction m a'
contramap = (a -> b) -> LogAction m b -> LogAction m a
forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
cmap
{-# INLINE contramap #-}
(>$) :: b -> LogAction m b -> LogAction m a
>$ :: forall b a. b -> LogAction m b -> LogAction m a
(>$) = b -> LogAction m b -> LogAction m a
forall b (m :: * -> *) a. b -> LogAction m b -> LogAction m a
(Colog.Core.Action.>$)
{-# INLINE (>$) #-}
#endif
type family UnrepresentableClass :: Constraint
where
UnrepresentableClass = TypeError
( 'Text "'LogAction' cannot have a 'Functor' instance by design."
' :$$: 'Text "However, you've attempted to use this instance."
#if MIN_VERSION_base(4,12,0)
' :$$: 'Text ""
' :$$: 'Text "Probably you meant 'Contravariant' class instance with the following methods:"
' :$$: 'Text " * contramap :: (a -> b) -> LogAction m b -> LogAction m a"
' :$$: 'Text " * (>$) :: b -> LogAction m b -> LogAction m a"
#endif
)
instance UnrepresentableClass => Functor (LogAction m) where
fmap :: (a -> b) -> LogAction m a -> LogAction m b
fmap :: forall a b. (a -> b) -> LogAction m a -> LogAction m b
fmap a -> b
_ LogAction m a
_ = [Char] -> LogAction m b
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable Functor instance of LogAction"
(<$) :: a -> LogAction m b -> LogAction m a
a
_ <$ :: forall a b. a -> LogAction m b -> LogAction m a
<$ LogAction m b
_ = [Char] -> LogAction m a
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable Functor instance of LogAction"
infix 5 <&
(<&) :: LogAction m msg -> msg -> m ()
<& :: forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
(<&) = LogAction m msg -> msg -> m ()
forall a b. Coercible a b => a -> b
coerce
{-# INLINE (<&) #-}
infix 5 &>
(&>) :: msg -> LogAction m msg -> m ()
&> :: forall msg (m :: * -> *). msg -> LogAction m msg -> m ()
(&>) = (LogAction m msg -> msg -> m ()) -> msg -> LogAction m msg -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip LogAction m msg -> msg -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
(<&)
{-# INLINE (&>) #-}
foldActions :: (Foldable t, Applicative m) => t (LogAction m a) -> LogAction m a
foldActions :: forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Applicative m) =>
t (LogAction m a) -> LogAction m a
foldActions t (LogAction m a)
actions = (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
$ \a
a -> t (LogAction m a) -> (LogAction m a -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ t (LogAction m a)
actions ((LogAction m a -> m ()) -> m ())
-> (LogAction m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(LogAction a -> m ()
action) -> a -> m ()
action a
a
{-# INLINE foldActions #-}
{-# SPECIALIZE foldActions :: Applicative m => [LogAction m a] -> LogAction m a #-}
{-# SPECIALIZE foldActions :: Applicative m => NonEmpty (LogAction m a) -> LogAction m a #-}
cfilter :: Applicative m => (msg -> Bool) -> LogAction m msg -> LogAction m msg
cfilter :: forall (m :: * -> *) msg.
Applicative m =>
(msg -> Bool) -> LogAction m msg -> LogAction m msg
cfilter msg -> Bool
predicate (LogAction msg -> m ()
action) = (msg -> m ()) -> LogAction m msg
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((msg -> m ()) -> LogAction m msg)
-> (msg -> m ()) -> LogAction m msg
forall a b. (a -> b) -> a -> b
$ \msg
a -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (msg -> Bool
predicate msg
a) (msg -> m ()
action msg
a)
{-# INLINE cfilter #-}
cfilterM :: Monad m => (msg -> m Bool) -> LogAction m msg -> LogAction m msg
cfilterM :: forall (m :: * -> *) msg.
Monad m =>
(msg -> m Bool) -> LogAction m msg -> LogAction m msg
cfilterM msg -> m Bool
predicateM (LogAction msg -> m ()
action) =
(msg -> m ()) -> LogAction m msg
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((msg -> m ()) -> LogAction m msg)
-> (msg -> m ()) -> LogAction m msg
forall a b. (a -> b) -> a -> b
$ \msg
a -> msg -> m Bool
predicateM msg
a m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (msg -> m ()
action msg
a)
{-# INLINE cfilterM #-}
cmap :: (a -> b) -> LogAction m b -> LogAction m a
cmap :: forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
cmap a -> b
f (LogAction b -> m ()
action) = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (b -> m ()
action (b -> m ()) -> (a -> b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
{-# INLINE cmap #-}
infixr 3 >$<
(>$<) :: (a -> b) -> LogAction m b -> LogAction m a
>$< :: forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
(>$<) = (a -> b) -> LogAction m b -> LogAction m a
forall a b (m :: * -> *).
(a -> b) -> LogAction m b -> LogAction m a
cmap
{-# INLINE (>$<) #-}
cmapMaybe :: Applicative m => (a -> Maybe b) -> LogAction m b -> LogAction m a
cmapMaybe :: forall (m :: * -> *) a b.
Applicative m =>
(a -> Maybe b) -> LogAction m b -> LogAction m a
cmapMaybe a -> Maybe b
f (LogAction b -> m ()
action) = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (m () -> (b -> m ()) -> Maybe b -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) b -> m ()
action (Maybe b -> m ()) -> (a -> Maybe b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f)
{-# INLINE cmapMaybe #-}
cmapMaybeM :: Monad m => (a -> m (Maybe b)) -> LogAction m b -> LogAction m a
cmapMaybeM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> LogAction m b -> LogAction m a
cmapMaybeM a -> m (Maybe b)
f (LogAction b -> m ()
action) = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (m () -> (b -> m ()) -> Maybe b -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) b -> m ()
action (Maybe b -> m ()) -> (a -> m (Maybe b)) -> a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (Maybe b)
f)
{-# INLINE cmapMaybeM #-}
infixl 4 >$
(>$) :: b -> LogAction m b -> LogAction m a
>$ :: forall b (m :: * -> *) a. b -> LogAction m b -> LogAction m a
(>$) b
b (LogAction b -> m ()
action) = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (\a
_ -> b -> m ()
action b
b)
cmapM :: Monad m => (a -> m b) -> LogAction m b -> LogAction m a
cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LogAction m b -> LogAction m a
cmapM a -> m b
f (LogAction b -> m ()
action) = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (a -> m b
f (a -> m b) -> (b -> m ()) -> a -> m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m ()
action)
{-# INLINE cmapM #-}
divide :: (Applicative m) => (a -> (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a
divide :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a
divide a -> (b, c)
f (LogAction b -> m ()
actionB) (LogAction c -> m ()
actionC) = (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
$ \(a -> (b, c)
f -> (b
b, c
c)) ->
b -> m ()
actionB b
b m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> c -> m ()
actionC c
c
{-# INLINE divide #-}
divideM :: (Monad m) => (a -> m (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a
divideM :: forall (m :: * -> *) a b c.
Monad m =>
(a -> m (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a
divideM a -> m (b, c)
f (LogAction b -> m ()
actionB) (LogAction c -> m ()
actionC) =
(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
$ \(a -> m (b, c)
f -> m (b, c)
mbc) -> m (b, c)
mbc m (b, c) -> ((b, c) -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(b
b, c
c) -> b -> m ()
actionB b
b m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> c -> m ()
actionC c
c)
{-# INLINE divideM #-}
conquer :: Applicative m => LogAction m a
conquer :: forall (m :: * -> *) a. Applicative m => LogAction m a
conquer = LogAction m a
forall a. Monoid a => a
mempty
{-# INLINE conquer #-}
infixr 4 >*<
(>*<) :: (Applicative m) => LogAction m a -> LogAction m b -> LogAction m (a, b)
(LogAction a -> m ()
actionA) >*< :: forall (m :: * -> *) a b.
Applicative m =>
LogAction m a -> LogAction m b -> LogAction m (a, b)
>*< (LogAction b -> m ()
actionB) = ((a, b) -> m ()) -> LogAction m (a, b)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (((a, b) -> m ()) -> LogAction m (a, b))
-> ((a, b) -> m ()) -> LogAction m (a, b)
forall a b. (a -> b) -> a -> b
$ \(a
a, b
b) ->
a -> m ()
actionA a
a m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> b -> m ()
actionB b
b
{-# INLINE (>*<) #-}
infixr 4 >*
(>*) :: Applicative m => LogAction m a -> LogAction m () -> LogAction m a
(LogAction a -> m ()
actionA) >* :: forall (m :: * -> *) a.
Applicative m =>
LogAction m a -> LogAction m () -> LogAction m a
>* (LogAction () -> m ()
actionB) = (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
$ \a
a ->
a -> m ()
actionA a
a m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> m ()
actionB ()
{-# INLINE (>*) #-}
infixr 4 *<
(*<) :: Applicative m => LogAction m () -> LogAction m a -> LogAction m a
(LogAction () -> m ()
actionA) *< :: forall (m :: * -> *) a.
Applicative m =>
LogAction m () -> LogAction m a -> LogAction m a
*< (LogAction a -> m ()
actionB) = (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
$ \a
a ->
() -> m ()
actionA () m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> a -> m ()
actionB a
a
{-# INLINE (*<) #-}
lose :: (a -> Void) -> LogAction m a
lose :: forall a (m :: * -> *). (a -> Void) -> LogAction m a
lose a -> Void
f = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (Void -> m ()
forall a. Void -> a
absurd (Void -> m ()) -> (a -> Void) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Void
f)
{-# INLINE lose #-}
choose :: (a -> Either b c) -> LogAction m b -> LogAction m c -> LogAction m a
choose :: forall a b c (m :: * -> *).
(a -> Either b c)
-> LogAction m b -> LogAction m c -> LogAction m a
choose a -> Either b c
f (LogAction b -> m ()
actionB) (LogAction c -> m ()
actionC) = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((b -> m ()) -> (c -> m ()) -> Either b c -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> m ()
actionB c -> m ()
actionC (Either b c -> m ()) -> (a -> Either b c) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f)
{-# INLINE choose #-}
chooseM :: Monad m => (a -> m (Either b c)) -> LogAction m b -> LogAction m c -> LogAction m a
chooseM :: forall (m :: * -> *) a b c.
Monad m =>
(a -> m (Either b c))
-> LogAction m b -> LogAction m c -> LogAction m a
chooseM a -> m (Either b c)
f (LogAction b -> m ()
actionB) (LogAction c -> m ()
actionC) = (a -> m ()) -> LogAction m a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((b -> m ()) -> (c -> m ()) -> Either b c -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either b -> m ()
actionB c -> m ()
actionC (Either b c -> m ()) -> (a -> m (Either b c)) -> a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (Either b c)
f)
{-# INLINE chooseM #-}
infixr 3 >|<
(>|<) :: LogAction m a -> LogAction m b -> LogAction m (Either a b)
(LogAction a -> m ()
actionA) >|< :: forall (m :: * -> *) a b.
LogAction m a -> LogAction m b -> LogAction m (Either a b)
>|< (LogAction b -> m ()
actionB) = (Either a b -> m ()) -> LogAction m (Either a b)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((a -> m ()) -> (b -> m ()) -> Either a b -> m ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m ()
actionA b -> m ()
actionB)
{-# INLINE (>|<) #-}
extract :: Monoid msg => LogAction m msg -> m ()
LogAction m msg
action = LogAction m msg -> msg -> m ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
unLogAction LogAction m msg
action msg
forall a. Monoid a => a
mempty
{-# INLINE extract #-}
extend :: Semigroup msg => (LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg
extend :: forall msg (m :: * -> *).
Semigroup msg =>
(LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg
extend LogAction m msg -> m ()
f (LogAction msg -> m ()
action) = (msg -> m ()) -> LogAction m msg
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((msg -> m ()) -> LogAction m msg)
-> (msg -> m ()) -> LogAction m msg
forall a b. (a -> b) -> a -> b
$ \msg
m -> LogAction m msg -> m ()
f (LogAction m msg -> m ()) -> LogAction m msg -> m ()
forall a b. (a -> b) -> a -> b
$ (msg -> m ()) -> LogAction m msg
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((msg -> m ()) -> LogAction m msg)
-> (msg -> m ()) -> LogAction m msg
forall a b. (a -> b) -> a -> b
$ \msg
m' -> msg -> m ()
action (msg
m msg -> msg -> msg
forall a. Semigroup a => a -> a -> a
<> msg
m')
{-# INLINE extend #-}
infixl 1 =>>
(=>>) :: Semigroup msg => LogAction m msg -> (LogAction m msg -> m ()) -> LogAction m msg
=>> :: forall msg (m :: * -> *).
Semigroup msg =>
LogAction m msg -> (LogAction m msg -> m ()) -> LogAction m msg
(=>>) = ((LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg)
-> LogAction m msg -> (LogAction m msg -> m ()) -> LogAction m msg
forall a b c. (a -> b -> c) -> b -> a -> c
flip (LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg
forall msg (m :: * -> *).
Semigroup msg =>
(LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg
extend
{-# INLINE (=>>) #-}
infixr 1 <<=
(<<=) :: Semigroup msg => (LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg
<<= :: forall msg (m :: * -> *).
Semigroup msg =>
(LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg
(<<=) = (LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg
forall msg (m :: * -> *).
Semigroup msg =>
(LogAction m msg -> m ()) -> LogAction m msg -> LogAction m msg
extend
{-# INLINE (<<=) #-}
duplicate :: forall msg m . Semigroup msg => LogAction m msg -> LogAction m (msg, msg)
duplicate :: forall msg (m :: * -> *).
Semigroup msg =>
LogAction m msg -> LogAction m (msg, msg)
duplicate (LogAction msg -> m ()
l) = ((msg, msg) -> m ()) -> LogAction m (msg, msg)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (((msg, msg) -> m ()) -> LogAction m (msg, msg))
-> ((msg, msg) -> m ()) -> LogAction m (msg, msg)
forall a b. (a -> b) -> a -> b
$ \(msg
msg1, msg
msg2) -> msg -> m ()
l (msg
msg1 msg -> msg -> msg
forall a. Semigroup a => a -> a -> a
<> msg
msg2)
{-# INLINE duplicate #-}
multiplicate
:: forall f msg m .
(Foldable f, Monoid msg)
=> LogAction m msg
-> LogAction m (f msg)
multiplicate :: forall (f :: * -> *) msg (m :: * -> *).
(Foldable f, Monoid msg) =>
LogAction m msg -> LogAction m (f msg)
multiplicate (LogAction msg -> m ()
l) = (f msg -> m ()) -> LogAction m (f msg)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((f msg -> m ()) -> LogAction m (f msg))
-> (f msg -> m ()) -> LogAction m (f msg)
forall a b. (a -> b) -> a -> b
$ \f msg
msgs -> msg -> m ()
l (f msg -> msg
forall m. Monoid m => f m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold f msg
msgs)
{-# INLINE multiplicate #-}
{-# SPECIALIZE multiplicate :: Monoid msg => LogAction m msg -> LogAction m [msg] #-}
{-# SPECIALIZE multiplicate :: Monoid msg => LogAction m msg -> LogAction m (NonEmpty msg) #-}
separate
:: forall f msg m .
(Traversable f, Applicative m)
=> LogAction m msg
-> LogAction m (f msg)
separate :: forall (f :: * -> *) msg (m :: * -> *).
(Traversable f, Applicative m) =>
LogAction m msg -> LogAction m (f msg)
separate (LogAction msg -> m ()
action) = (f msg -> m ()) -> LogAction m (f msg)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((msg -> m ()) -> f msg -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ msg -> m ()
action)
{-# INLINE separate #-}
{-# SPECIALIZE separate :: Applicative m => LogAction m msg -> LogAction m [msg] #-}
{-# SPECIALIZE separate :: Applicative m => LogAction m msg -> LogAction m (NonEmpty msg) #-}
{-# SPECIALIZE separate :: LogAction IO msg -> LogAction IO [msg] #-}
{-# SPECIALIZE separate :: LogAction IO msg -> LogAction IO (NonEmpty msg) #-}
hoistLogAction
:: (forall x. m x -> n x)
-> LogAction m a
-> LogAction n a
hoistLogAction :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> LogAction m a -> LogAction n a
hoistLogAction forall x. m x -> n x
f (LogAction a -> m ()
l) = (a -> n ()) -> LogAction n a
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction (m () -> n ()
forall x. m x -> n x
f (m () -> n ()) -> (a -> m ()) -> a -> n ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m ()
l)
{-# INLINE hoistLogAction #-}