{-# LANGUAGE LambdaCase   #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module      : Data.Conduino.Lift
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Working with underlying monad transformers and 'Pipe'.
--
-- There is no "general abstraction" for dealing with each monad
-- transformer, but we can translate the semantics that each monad
-- transformer provides into meaningful 'Pipe' operations.
--
-- For example, a @'Pipe' i o u ('State' s) a@ is a pipe working over
-- stateful effects --- it can pull information and modify an underlying
-- state to do its job.  It takes in @i@ and outputs @o@, using an
-- underlying state @s@.
--
-- However, such a pipe is similar to @s -> 'Pipe'
-- i o u 'Data.Functor.Identity.Identity' (a, s)@.  Giving some starting
-- state, it takes in @i@ and outputs @o@, and when it completes, it
-- returns an @a@ and an @s@, the final state after all its processing is
-- done.
--
-- The /general/ idea is that:
--
-- *  A pipe over a monad transformer /shares that monadic context/ over
--    /every pipe/ in a composition.
--
--    For example, if @p@, @q@, and @r@ are all pipes over 'StateT', the @p
--    .| q .| r@ will all share a common global state.
--
--    If @p@, @q@, and @r@ are all pipes over 'ExceptT', then @p .| q .| r@
--    will all short-circult fail each other: if @q@ fails, then they all
--    fail, etc.
--
--    If @p@, @q@, and @r@ are all pipes over 'WriterT' then @p .| q .| r@
--    will all accumulate to a shared global log.
--
--    If @p@, @q@, and @r@ are all pipes over 'ReaderT' then @p .| q .| r@
--    will use the same identical environment.
--
-- *  Using the @runX@ family of functions ('runStateP', 'runExceptP',
--    etc.) lets you /isolate/ out the common context within a composition
--    of pipes.
--
--    For example, if @p@ is a pipe over 'StateT', then @a .| 'void' ('runStateP'
--    s0 p) .| b@, @a@ and @b@ will not be able to use the state of @p@.
--
--    If @p@ is a pipe over 'ExceptT', then in @a .| void ('runExceptP' p) .|
--    b@, a failure in @p@ will not cause all the others to fail.
--
-- Both of these representations have different advantages and
-- disadvantages, that are separate and unique for each individual monad
-- transformer on a case-by-case basis.  This module provides functions on
-- such a case-by-case basis as you need them.
--
-- @since 0.2.1.0
module Data.Conduino.Lift (
  -- * State
  -- ** Lazy
    stateP, runStateP, evalStateP, execStateP
  -- ** Strict
  , statePS, runStatePS, evalStatePS, execStatePS
  -- * Except
  , exceptP, runExceptP, runExceptP_
  -- * Reader
  , readerP, runReaderP
  -- * Writer
  -- ** Lazy
  , writerP, runWriterP, execWriterP
  -- ** Strict
  , writerPS, runWriterPS, execWriterPS
  -- * RWS
  -- ** Lazy
  , rwsP, runRWSP, evalRWSP, execRWSP
  -- ** Strict
  , rwsPS, runRWSPS, evalRWSPS, execRWSPS
  -- * Catch
  , catchP, runCatchP
  ) where

import           Control.Monad.Catch.Pure
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Except
import           Control.Monad.Trans.Free
import           Control.Monad.Trans.RWS           (RWST(..))
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.State
import           Control.Monad.Trans.Writer
import           Data.Conduino
import           Data.Conduino.Internal
import           Data.Functor
import qualified Control.Monad.Trans.RWS           as RWS
import qualified Control.Monad.Trans.RWS.Strict    as RWSS
import qualified Control.Monad.Trans.State.Strict  as SS
import qualified Control.Monad.Trans.Writer.Strict as WS

-- | Turn a "state-modifying 'Pipe'" into a 'Pipe' that runs over 'StateT',
-- so you can chain it with other 'StateT' pipes.
--
-- Note that this will /overwrite/ whatever state exists with
-- the @s@ that it gets when it terminates.  If any other pipe in this
-- chain modifies or uses state, all modifications will be overwritten when
-- the @(a, s)@-producing pipe terminates.
--
-- @since 0.2.1.0
stateP
    :: Monad m
    => (s -> Pipe i o u m (a, s))
    -> Pipe i o u (StateT s m) a
stateP :: (s -> Pipe i o u m (a, s)) -> Pipe i o u (StateT s m) a
stateP f :: s -> Pipe i o u m (a, s)
f = do
    s
s       <- StateT s m s -> Pipe i o u (StateT s m) s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT s m s
forall (m :: * -> *) s. Monad m => StateT s m s
get
    (x :: a
x, s' :: s
s') <- (forall x. m x -> StateT s m x)
-> Pipe i o u m (a, s) -> Pipe i o u (StateT s m) (a, s)
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> StateT s m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> Pipe i o u m (a, s)
f s
s)
    a
x a -> Pipe i o u (StateT s m) () -> Pipe i o u (StateT s m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT s m () -> Pipe i o u (StateT s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> StateT s m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put s
s')

-- | Like 'runStateP', but ignoring the final result.  It returns the final
-- state after the pipe succesfuly terminates.
--
-- @since 0.2.1.0
execStateP
    :: Monad m
    => s
    -> Pipe i o u (StateT s m) a
    -> Pipe i o u m s
execStateP :: s -> Pipe i o u (StateT s m) a -> Pipe i o u m s
execStateP s :: s
s = ((a, s) -> s) -> Pipe i o u m (a, s) -> Pipe i o u m s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> s
forall a b. (a, b) -> b
snd (Pipe i o u m (a, s) -> Pipe i o u m s)
-> (Pipe i o u (StateT s m) a -> Pipe i o u m (a, s))
-> Pipe i o u (StateT s m) a
-> Pipe i o u m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
forall (m :: * -> *) s i o u a.
Monad m =>
s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
runStateP s
s

-- | Takes a 'Pipe' over 'StateT' and "hides" the state from the outside
-- world.  Give an initial state --- the pipe behaves the same way, but to
-- the external user it is abstracted away.  See 'runStateP' for more
-- information.
--
-- This can be cleaner than 'runStateP' because if @a@ is @()@, you
-- don't have to sprinkle in 'void' everywhere.  However, it's only really
-- useful if you don't need to get the final state upon termination.
--
-- @since 0.2.1.0
evalStateP
    :: Monad m
    => s
    -> Pipe i o u (StateT s m) a
    -> Pipe i o u m a
evalStateP :: s -> Pipe i o u (StateT s m) a -> Pipe i o u m a
evalStateP s :: s
s = ((a, s) -> a) -> Pipe i o u m (a, s) -> Pipe i o u m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> a
forall a b. (a, b) -> a
fst (Pipe i o u m (a, s) -> Pipe i o u m a)
-> (Pipe i o u (StateT s m) a -> Pipe i o u m (a, s))
-> Pipe i o u (StateT s m) a
-> Pipe i o u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
forall (m :: * -> *) s i o u a.
Monad m =>
s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
runStateP s
s

-- | 'stateP', but for "Control.Monad.Trans.State.Strict".
--
-- @since 0.2.1.0
statePS
    :: Monad m
    => (s -> Pipe i o u m (a, s))
    -> Pipe i o u (SS.StateT s m) a
statePS :: (s -> Pipe i o u m (a, s)) -> Pipe i o u (StateT s m) a
statePS f :: s -> Pipe i o u m (a, s)
f = do
    s
s       <- StateT s m s -> Pipe i o u (StateT s m) s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT s m s
forall (m :: * -> *) s. Monad m => StateT s m s
SS.get
    (x :: a
x, s' :: s
s') <- (forall x. m x -> StateT s m x)
-> Pipe i o u m (a, s) -> Pipe i o u (StateT s m) (a, s)
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> StateT s m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> Pipe i o u m (a, s)
f s
s)
    a
x a -> Pipe i o u (StateT s m) () -> Pipe i o u (StateT s m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ StateT s m () -> Pipe i o u (StateT s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> StateT s m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
SS.put s
s')

-- | 'runStateP', but for "Control.Monad.Trans.State.Strict".
--
-- @since 0.2.1.0
runStatePS
    :: Monad m
    => s
    -> Pipe i o u (SS.StateT s m) a
    -> Pipe i o u m (a, s)
runStatePS :: s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
runStatePS = (RecPipe i o u (StateT s m) a -> RecPipe i o u m (a, s))
-> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe ((RecPipe i o u (StateT s m) a -> RecPipe i o u m (a, s))
 -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s))
-> (s -> RecPipe i o u (StateT s m) a -> RecPipe i o u m (a, s))
-> s
-> Pipe i o u (StateT s m) a
-> Pipe i o u m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> RecPipe i o u (StateT s m) a -> RecPipe i o u m (a, s)
forall (m :: * -> *) (f :: * -> *) t a.
(Functor m, Functor f) =>
t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go
  where
    go :: t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go s :: t
s (FreeT p :: StateT t m (FreeF f a (FreeT f (StateT t m) a))
p) = m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t))
-> m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t)
forall a b. (a -> b) -> a -> b
$ StateT t m (FreeF f a (FreeT f (StateT t m) a))
-> t -> m (FreeF f a (FreeT f (StateT t m) a), t)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
SS.runStateT StateT t m (FreeF f a (FreeT f (StateT t m) a))
p t
s m (FreeF f a (FreeT f (StateT t m) a), t)
-> ((FreeF f a (FreeT f (StateT t m) a), t)
    -> FreeF f (a, t) (FreeT f m (a, t)))
-> m (FreeF f (a, t) (FreeT f m (a, t)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(q :: FreeF f a (FreeT f (StateT t m) a)
q, s' :: t
s') ->
      case FreeF f a (FreeT f (StateT t m) a)
q of
        Pure x :: a
x -> (a, t) -> FreeF f (a, t) (FreeT f m (a, t))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a
x, t
s')
        Free l :: f (FreeT f (StateT t m) a)
l -> f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t))
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t)))
-> f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t))
forall a b. (a -> b) -> a -> b
$ t -> FreeT f (StateT t m) a -> FreeT f m (a, t)
go t
s' (FreeT f (StateT t m) a -> FreeT f m (a, t))
-> f (FreeT f (StateT t m) a) -> f (FreeT f m (a, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (StateT t m) a)
l

-- | 'execStateP', but for "Control.Monad.Trans.State.Strict".
--
-- @since 0.2.1.0
execStatePS
    :: Monad m
    => s
    -> Pipe i o u (SS.StateT s m) a
    -> Pipe i o u m s
execStatePS :: s -> Pipe i o u (StateT s m) a -> Pipe i o u m s
execStatePS s :: s
s = ((a, s) -> s) -> Pipe i o u m (a, s) -> Pipe i o u m s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> s
forall a b. (a, b) -> b
snd (Pipe i o u m (a, s) -> Pipe i o u m s)
-> (Pipe i o u (StateT s m) a -> Pipe i o u m (a, s))
-> Pipe i o u (StateT s m) a
-> Pipe i o u m s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
forall (m :: * -> *) s i o u a.
Monad m =>
s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
runStatePS s
s

-- | 'evalStateP', but for "Control.Monad.Trans.State.Strict".
--
-- @since 0.2.1.0
evalStatePS
    :: Monad m
    => s
    -> Pipe i o u (SS.StateT s m) a
    -> Pipe i o u m a
evalStatePS :: s -> Pipe i o u (StateT s m) a -> Pipe i o u m a
evalStatePS s :: s
s = ((a, s) -> a) -> Pipe i o u m (a, s) -> Pipe i o u m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s) -> a
forall a b. (a, b) -> a
fst (Pipe i o u m (a, s) -> Pipe i o u m a)
-> (Pipe i o u (StateT s m) a -> Pipe i o u m (a, s))
-> Pipe i o u (StateT s m) a
-> Pipe i o u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
forall (m :: * -> *) s i o u a.
Monad m =>
s -> Pipe i o u (StateT s m) a -> Pipe i o u m (a, s)
runStatePS s
s

-- | Turn a "failable-result" 'Pipe' into a pipe over 'ExceptT'.
--
-- Note that a 'throwE' failure will only ever happen when the input pipe
-- "succesfully" terminates with 'Left'.  It would never happen before the
-- pipe terminates, since you don't get the @'Either' e a@ until the pipe
-- succesfully terminates.
--
-- @since 0.2.1.0
exceptP
    :: Monad m
    => Pipe i o u m (Either e a)
    -> Pipe i o u (ExceptT e m) a
exceptP :: Pipe i o u m (Either e a) -> Pipe i o u (ExceptT e m) a
exceptP p :: Pipe i o u m (Either e a)
p = (forall x. m x -> ExceptT e m x)
-> Pipe i o u m (Either e a)
-> Pipe i o u (ExceptT e m) (Either e a)
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> ExceptT e m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Pipe i o u m (Either e a)
p Pipe i o u (ExceptT e m) (Either e a)
-> (Either e a -> Pipe i o u (ExceptT e m) a)
-> Pipe i o u (ExceptT e m) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left  e :: e
e -> ExceptT e m a -> Pipe i o u (ExceptT e m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT e m a -> Pipe i o u (ExceptT e m) a)
-> ExceptT e m a -> Pipe i o u (ExceptT e m) a
forall a b. (a -> b) -> a -> b
$ e -> ExceptT e m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
e
    Right x :: a
x -> a -> Pipe i o u (ExceptT e m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Turn a 'Pipe' that runs over 'ExceptT' into an "early-terminating
-- 'Pipe'" that "succesfully" returns 'Left' or 'Right'.
--
-- The main usage of this is to "isolate" the short-circuiting failure of
-- 'ExceptT' to only happen within one component of a chain.  For example,
-- of @p@, @q@, and @r@ are all pipes under 'ExceptT', then:
--
-- @
--     p
--  .| q
--  .| r
-- @
--
-- will short-circuit fail if /any/ of @p@, @q@, or @r@ fail.  We have
-- global failure only.
--
-- However, if you use 'runExceptP', we isolate the short-circuiting
-- failure to only a single type.
--
-- @
--     void (runExceptP p)
--  .| void (runExceptP q)
--  .| runExceptP r
-- @
--
-- In this case, if (for example) @q@ fails, it won't cause the whole thing
-- to fail: it will just be the same as if @q@ succesfully terminates
-- normally.
--
-- This is also useful if you want to chain a pipe over 'ExceptT' with
-- pipes that don't have 'ExceptT' at all: for example if @a@ and @b@ are
-- "non-erroring" pipes (/not/ over 'ExceptT'), you can do:
--
-- @
--     a
--  .| void (runExceptP q)
--  .| b
-- @
--
-- And @a@ and @b@ will be none the wiser to the fact that @q@ uses
-- 'ExceptT' internally.
--
-- Note to avoid the usage of 'void', 'runExceptP_' might be more useful.
--
-- @since 0.2.1.0
runExceptP
    :: Monad m
    => Pipe i o u (ExceptT e m) a
    -> Pipe i o u m (Either e a)
runExceptP :: Pipe i o u (ExceptT e m) a -> Pipe i o u m (Either e a)
runExceptP = (RecPipe i o u (ExceptT e m) a -> RecPipe i o u m (Either e a))
-> Pipe i o u (ExceptT e m) a -> Pipe i o u m (Either e a)
forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe RecPipe i o u (ExceptT e m) a -> RecPipe i o u m (Either e a)
forall (m :: * -> *) (f :: * -> *) a b.
(Functor m, Functor f) =>
FreeT f (ExceptT a m) b -> FreeT f m (Either a b)
go
  where
    go :: FreeT f (ExceptT a m) b -> FreeT f m (Either a b)
go (FreeT p :: ExceptT a m (FreeF f b (FreeT f (ExceptT a m) b))
p) = m (FreeF f (Either a b) (FreeT f m (Either a b)))
-> FreeT f m (Either a b)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f (Either a b) (FreeT f m (Either a b)))
 -> FreeT f m (Either a b))
-> m (FreeF f (Either a b) (FreeT f m (Either a b)))
-> FreeT f m (Either a b)
forall a b. (a -> b) -> a -> b
$ ExceptT a m (FreeF f b (FreeT f (ExceptT a m) b))
-> m (Either a (FreeF f b (FreeT f (ExceptT a m) b)))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT a m (FreeF f b (FreeT f (ExceptT a m) b))
p m (Either a (FreeF f b (FreeT f (ExceptT a m) b)))
-> (Either a (FreeF f b (FreeT f (ExceptT a m) b))
    -> FreeF f (Either a b) (FreeT f m (Either a b)))
-> m (FreeF f (Either a b) (FreeT f m (Either a b)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Left  e :: a
e        -> Either a b -> FreeF f (Either a b) (FreeT f m (Either a b))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (Either a b -> FreeF f (Either a b) (FreeT f m (Either a b)))
-> Either a b -> FreeF f (Either a b) (FreeT f m (Either a b))
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
e
      Right (Pure x :: b
x) -> Either a b -> FreeF f (Either a b) (FreeT f m (Either a b))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (Either a b -> FreeF f (Either a b) (FreeT f m (Either a b)))
-> Either a b -> FreeF f (Either a b) (FreeT f m (Either a b))
forall a b. (a -> b) -> a -> b
$ b -> Either a b
forall a b. b -> Either a b
Right b
x
      Right (Free l :: f (FreeT f (ExceptT a m) b)
l) -> f (FreeT f m (Either a b))
-> FreeF f (Either a b) (FreeT f m (Either a b))
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m (Either a b))
 -> FreeF f (Either a b) (FreeT f m (Either a b)))
-> f (FreeT f m (Either a b))
-> FreeF f (Either a b) (FreeT f m (Either a b))
forall a b. (a -> b) -> a -> b
$ FreeT f (ExceptT a m) b -> FreeT f m (Either a b)
go (FreeT f (ExceptT a m) b -> FreeT f m (Either a b))
-> f (FreeT f (ExceptT a m) b) -> f (FreeT f m (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (ExceptT a m) b)
l

-- | A handy version of 'runExceptP' that discards its output, so it can be
-- easier to chain using '.|'.  It's useful if you are using 'runExceptP'
-- to "isolate" failures from the rest of a chain.
--
-- @since 0.2.1.0
runExceptP_
    :: Monad m
    => Pipe i o u (ExceptT e m) a
    -> Pipe i o u m ()
runExceptP_ :: Pipe i o u (ExceptT e m) a -> Pipe i o u m ()
runExceptP_ = Pipe i o u m (Either e a) -> Pipe i o u m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Pipe i o u m (Either e a) -> Pipe i o u m ())
-> (Pipe i o u (ExceptT e m) a -> Pipe i o u m (Either e a))
-> Pipe i o u (ExceptT e m) a
-> Pipe i o u m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pipe i o u (ExceptT e m) a -> Pipe i o u m (Either e a)
forall (m :: * -> *) i o u e a.
Monad m =>
Pipe i o u (ExceptT e m) a -> Pipe i o u m (Either e a)
runExceptP

-- | Like 'exceptP', but for 'CatchT'.  See 'exceptP' for usage details and
-- caveats.  In general, can be useful for chaining with other 'CatchT'
-- pipes.
--
-- Note that a 'throwM' failure will only ever happen when the input pipe
-- "succesfully" terminates with 'Left'.  It would never happen before the
-- pipe terminates, since you don't get the @'Either' 'SomeException' a@
-- until the pipe succesfully terminates.
--
-- @since 0.2.1.0
catchP
    :: Monad m
    => Pipe i o u m (Either SomeException a)
    -> Pipe i o u (CatchT m) a
catchP :: Pipe i o u m (Either SomeException a) -> Pipe i o u (CatchT m) a
catchP p :: Pipe i o u m (Either SomeException a)
p = (forall x. m x -> CatchT m x)
-> Pipe i o u m (Either SomeException a)
-> Pipe i o u (CatchT m) (Either SomeException a)
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> CatchT m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Pipe i o u m (Either SomeException a)
p Pipe i o u (CatchT m) (Either SomeException a)
-> (Either SomeException a -> Pipe i o u (CatchT m) a)
-> Pipe i o u (CatchT m) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left  e :: SomeException
e -> CatchT m a -> Pipe i o u (CatchT m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (CatchT m a -> Pipe i o u (CatchT m) a)
-> CatchT m a -> Pipe i o u (CatchT m) a
forall a b. (a -> b) -> a -> b
$ SomeException -> CatchT m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SomeException
e
    Right x :: a
x -> a -> Pipe i o u (CatchT m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Like 'runExceptP', but for 'CatchT'.  See 'runExceptP' for usage
-- details.  In general, can be useful for "isolating" a 'CatchT' pipe from
-- the rest of its chain.
--
-- @since 0.2.1.0
runCatchP
    :: Monad m
    => Pipe i o u (CatchT m) a
    -> Pipe i o u m (Either SomeException a)
runCatchP :: Pipe i o u (CatchT m) a -> Pipe i o u m (Either SomeException a)
runCatchP = (RecPipe i o u (CatchT m) a
 -> RecPipe i o u m (Either SomeException a))
-> Pipe i o u (CatchT m) a -> Pipe i o u m (Either SomeException a)
forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe RecPipe i o u (CatchT m) a
-> RecPipe i o u m (Either SomeException a)
forall (m :: * -> *) (f :: * -> *) b.
(Functor m, Functor f) =>
FreeT f (CatchT m) b -> FreeT f m (Either SomeException b)
go
  where
    go :: FreeT f (CatchT m) b -> FreeT f m (Either SomeException b)
go (FreeT p :: CatchT m (FreeF f b (FreeT f (CatchT m) b))
p) = m (FreeF
     f (Either SomeException b) (FreeT f m (Either SomeException b)))
-> FreeT f m (Either SomeException b)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF
      f (Either SomeException b) (FreeT f m (Either SomeException b)))
 -> FreeT f m (Either SomeException b))
-> m (FreeF
        f (Either SomeException b) (FreeT f m (Either SomeException b)))
-> FreeT f m (Either SomeException b)
forall a b. (a -> b) -> a -> b
$ CatchT m (FreeF f b (FreeT f (CatchT m) b))
-> m (Either SomeException (FreeF f b (FreeT f (CatchT m) b)))
forall (m :: * -> *) a. CatchT m a -> m (Either SomeException a)
runCatchT CatchT m (FreeF f b (FreeT f (CatchT m) b))
p m (Either SomeException (FreeF f b (FreeT f (CatchT m) b)))
-> (Either SomeException (FreeF f b (FreeT f (CatchT m) b))
    -> FreeF
         f (Either SomeException b) (FreeT f m (Either SomeException b)))
-> m (FreeF
        f (Either SomeException b) (FreeT f m (Either SomeException b)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Left  e :: SomeException
e        -> Either SomeException b
-> FreeF
     f (Either SomeException b) (FreeT f m (Either SomeException b))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (Either SomeException b
 -> FreeF
      f (Either SomeException b) (FreeT f m (Either SomeException b)))
-> Either SomeException b
-> FreeF
     f (Either SomeException b) (FreeT f m (Either SomeException b))
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException b
forall a b. a -> Either a b
Left SomeException
e
      Right (Pure x :: b
x) -> Either SomeException b
-> FreeF
     f (Either SomeException b) (FreeT f m (Either SomeException b))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (Either SomeException b
 -> FreeF
      f (Either SomeException b) (FreeT f m (Either SomeException b)))
-> Either SomeException b
-> FreeF
     f (Either SomeException b) (FreeT f m (Either SomeException b))
forall a b. (a -> b) -> a -> b
$ b -> Either SomeException b
forall a b. b -> Either a b
Right b
x
      Right (Free l :: f (FreeT f (CatchT m) b)
l) -> f (FreeT f m (Either SomeException b))
-> FreeF
     f (Either SomeException b) (FreeT f m (Either SomeException b))
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m (Either SomeException b))
 -> FreeF
      f (Either SomeException b) (FreeT f m (Either SomeException b)))
-> f (FreeT f m (Either SomeException b))
-> FreeF
     f (Either SomeException b) (FreeT f m (Either SomeException b))
forall a b. (a -> b) -> a -> b
$ FreeT f (CatchT m) b -> FreeT f m (Either SomeException b)
go (FreeT f (CatchT m) b -> FreeT f m (Either SomeException b))
-> f (FreeT f (CatchT m) b)
-> f (FreeT f m (Either SomeException b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (CatchT m) b)
l

-- | Turn a "parameterized 'Pipe'" into a 'Pipe' that runs over 'ReaderT',
-- so you can chain it with other 'ReaderT' pipes.
--
-- Essentially, instead of directly providing the @r@ in an @r -> 'Pipe'
-- i o u m a@, the @r@ instead comes from the globally shared environment.
--
-- @since 0.2.1.0
readerP
    :: Monad m
    => (r -> Pipe i o u m a)
    -> Pipe i o u (ReaderT r m) a
readerP :: (r -> Pipe i o u m a) -> Pipe i o u (ReaderT r m) a
readerP f :: r -> Pipe i o u m a
f = (forall x. m x -> ReaderT r m x)
-> Pipe i o u m a -> Pipe i o u (ReaderT r m) a
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> ReaderT r m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Pipe i o u m a -> Pipe i o u (ReaderT r m) a)
-> (r -> Pipe i o u m a) -> r -> Pipe i o u (ReaderT r m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> Pipe i o u m a
f (r -> Pipe i o u (ReaderT r m) a)
-> Pipe i o u (ReaderT r m) r -> Pipe i o u (ReaderT r m) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT r m r -> Pipe i o u (ReaderT r m) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT r m r
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

-- | Turn a pipe over 'ReaderT' into a directly parameterized pipe.
-- Instead of getting the parameter from the globally shared 'ReaderT'
-- environment, give it directly instead.
--
-- It can be useful to "ignore" a globally shared environment and just give
-- the @r@ directly and immediately.
--
-- @since 0.2.1.0
runReaderP
    :: Monad m
    => r
    -> Pipe i o u (ReaderT r m) a
    -> Pipe i o u m a
runReaderP :: r -> Pipe i o u (ReaderT r m) a -> Pipe i o u m a
runReaderP r :: r
r = (forall x. ReaderT r m x -> m x)
-> Pipe i o u (ReaderT r m) a -> Pipe i o u m a
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe (ReaderT r m x -> r -> m x
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r)

-- | Turn a pipe returning an @(a, w)@ tuple upon termination into a pipe
-- returning @a@, logging the @w@ in an underlying 'WriterT' context.
--
-- This can be useful for composing your pipe with other 'WriterT' pipes,
-- aggregating all to a common global log.
--
-- However, be aware that this only ever 'tell's when the pipe succesfuly
-- terminates.  It doesn't do "streaming logging" -- it only makes one
-- log payload at the point of succesful termination.  To do streaming
-- logging (logging things as you get them), you should probably just
-- directly use 'WriterT' instead, with 'Data.Conduino.Combinators.repeatM'
-- or 'Data.Conduino.Combinators.iterM' or something similar.
--
-- @since 0.2.1.0
writerP
    :: (Monad m, Monoid w)
    => Pipe i o u m (a, w)
    -> Pipe i o u (WriterT w m) a
writerP :: Pipe i o u m (a, w) -> Pipe i o u (WriterT w m) a
writerP p :: Pipe i o u m (a, w)
p = do
    (x :: a
x, w :: w
w) <- (forall x. m x -> WriterT w m x)
-> Pipe i o u m (a, w) -> Pipe i o u (WriterT w m) (a, w)
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> WriterT w m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Pipe i o u m (a, w)
p
    a
x a -> Pipe i o u (WriterT w m) () -> Pipe i o u (WriterT w m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ WriterT w m () -> Pipe i o u (WriterT w m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (w -> WriterT w m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell w
w)

-- | Turn a 'Pipe' that runs over 'WriterT' into a 'Pipe' that returns the
-- final log when it terminates.
--
-- The main usage of this is to "isolate" the log from other pipes in the
-- same chain.  For example, of @p@, @q@, and @r@ are all pipes under
-- 'WriterT', then:
--
-- @
--     p
--  .| q
--  .| r
-- @
--
-- will all share underlying log, and all logging from any of them will
-- accumulate together in an interleaved way.  It is essentially a global
-- log.
--
-- However, if you use 'runWriterP', you can all have them use different
-- encapsulated logs.
--
-- @
--     void (runWriterP p)
--  .| void (runWriterP q)
--  .| runWriterP r
-- @
--
-- In this case, each of those three chained pipes will use their own
-- internal logs, without sharing.
--
-- This is also useful if you want to chain a pipe over 'WriterT' with
-- pipes that don't use state at all: for example if @a@ and @b@ are
-- "non-logging" pipes (/not/ over 'WriterT'), you can do:
--
-- @
--     a
--  .| void (runWriterP q)
--  .| b
-- @
--
-- And @a@ and @b@ will be none the wiser to the fact that @q@ uses
-- 'WriterT' internally.
--
-- @since 0.2.1.0
runWriterP
    :: (Monad m, Monoid w)
    => Pipe i o u (WriterT w m) a
    -> Pipe i o u m (a, w)
runWriterP :: Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w)
runWriterP = (RecPipe i o u (WriterT w m) a -> RecPipe i o u m (a, w))
-> Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w)
forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe (w -> RecPipe i o u (WriterT w m) a -> RecPipe i o u m (a, w)
forall t (m :: * -> *) (f :: * -> *) a.
(Semigroup t, Functor m, Functor f) =>
t -> FreeT f (WriterT t m) a -> FreeT f m (a, t)
go w
forall a. Monoid a => a
mempty)
  where
    go :: t -> FreeT f (WriterT t m) a -> FreeT f m (a, t)
go w :: t
w (FreeT p :: WriterT t m (FreeF f a (FreeT f (WriterT t m) a))
p) = m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t))
-> m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t)
forall a b. (a -> b) -> a -> b
$ WriterT t m (FreeF f a (FreeT f (WriterT t m) a))
-> m (FreeF f a (FreeT f (WriterT t m) a), t)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT t m (FreeF f a (FreeT f (WriterT t m) a))
p m (FreeF f a (FreeT f (WriterT t m) a), t)
-> ((FreeF f a (FreeT f (WriterT t m) a), t)
    -> FreeF f (a, t) (FreeT f m (a, t)))
-> m (FreeF f (a, t) (FreeT f m (a, t)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(r :: FreeF f a (FreeT f (WriterT t m) a)
r, (t
w t -> t -> t
forall a. Semigroup a => a -> a -> a
<>)->t
w') ->
      case FreeF f a (FreeT f (WriterT t m) a)
r of
        Pure x :: a
x -> (a, t) -> FreeF f (a, t) (FreeT f m (a, t))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a
x, t
w')
        Free l :: f (FreeT f (WriterT t m) a)
l -> f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t))
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t)))
-> f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t))
forall a b. (a -> b) -> a -> b
$ t -> FreeT f (WriterT t m) a -> FreeT f m (a, t)
go t
w' (FreeT f (WriterT t m) a -> FreeT f m (a, t))
-> f (FreeT f (WriterT t m) a) -> f (FreeT f m (a, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (WriterT t m) a)
l

-- | 'runWriterP', but only returning the final log after succesful
-- termination.
--
-- @since 0.2.1.0
execWriterP
    :: (Monad m, Monoid w)
    => Pipe i o u (WriterT w m) a
    -> Pipe i o u m w
execWriterP :: Pipe i o u (WriterT w m) a -> Pipe i o u m w
execWriterP = ((a, w) -> w) -> Pipe i o u m (a, w) -> Pipe i o u m w
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> w
forall a b. (a, b) -> b
snd (Pipe i o u m (a, w) -> Pipe i o u m w)
-> (Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w))
-> Pipe i o u (WriterT w m) a
-> Pipe i o u m w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w)
forall (m :: * -> *) w i o u a.
(Monad m, Monoid w) =>
Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w)
runWriterP

-- | 'writerP', but for "Control.Monad.Trans.Writer.Strict".
--
-- @since 0.2.1.0
writerPS
    :: (Monad m, Monoid w)
    => Pipe i o u m (a, w)
    -> Pipe i o u (WS.WriterT w m) a
writerPS :: Pipe i o u m (a, w) -> Pipe i o u (WriterT w m) a
writerPS p :: Pipe i o u m (a, w)
p = do
    (x :: a
x, w :: w
w) <- (forall x. m x -> WriterT w m x)
-> Pipe i o u m (a, w) -> Pipe i o u (WriterT w m) (a, w)
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> WriterT w m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Pipe i o u m (a, w)
p
    a
x a -> Pipe i o u (WriterT w m) () -> Pipe i o u (WriterT w m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ WriterT w m () -> Pipe i o u (WriterT w m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (w -> WriterT w m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
WS.tell w
w)

-- | 'runWriterP', but for "Control.Monad.Trans.Writer.Strict".
--
-- @since 0.2.1.0
runWriterPS
    :: (Monad m, Monoid w)
    => Pipe i o u (WS.WriterT w m) a
    -> Pipe i o u m (a, w)
runWriterPS :: Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w)
runWriterPS = (RecPipe i o u (WriterT w m) a -> RecPipe i o u m (a, w))
-> Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w)
forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe (w -> RecPipe i o u (WriterT w m) a -> RecPipe i o u m (a, w)
forall t (m :: * -> *) (f :: * -> *) a.
(Semigroup t, Functor m, Functor f) =>
t -> FreeT f (WriterT t m) a -> FreeT f m (a, t)
go w
forall a. Monoid a => a
mempty)
  where
    go :: t -> FreeT f (WriterT t m) a -> FreeT f m (a, t)
go w :: t
w (FreeT p :: WriterT t m (FreeF f a (FreeT f (WriterT t m) a))
p) = m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t))
-> m (FreeF f (a, t) (FreeT f m (a, t))) -> FreeT f m (a, t)
forall a b. (a -> b) -> a -> b
$ WriterT t m (FreeF f a (FreeT f (WriterT t m) a))
-> m (FreeF f a (FreeT f (WriterT t m) a), t)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
WS.runWriterT WriterT t m (FreeF f a (FreeT f (WriterT t m) a))
p m (FreeF f a (FreeT f (WriterT t m) a), t)
-> ((FreeF f a (FreeT f (WriterT t m) a), t)
    -> FreeF f (a, t) (FreeT f m (a, t)))
-> m (FreeF f (a, t) (FreeT f m (a, t)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(r :: FreeF f a (FreeT f (WriterT t m) a)
r, (t
w t -> t -> t
forall a. Semigroup a => a -> a -> a
<>)->t
w') ->
      case FreeF f a (FreeT f (WriterT t m) a)
r of
        Pure x :: a
x -> (a, t) -> FreeF f (a, t) (FreeT f m (a, t))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a
x, t
w')
        Free l :: f (FreeT f (WriterT t m) a)
l -> f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t))
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t)))
-> f (FreeT f m (a, t)) -> FreeF f (a, t) (FreeT f m (a, t))
forall a b. (a -> b) -> a -> b
$ t -> FreeT f (WriterT t m) a -> FreeT f m (a, t)
go t
w' (FreeT f (WriterT t m) a -> FreeT f m (a, t))
-> f (FreeT f (WriterT t m) a) -> f (FreeT f m (a, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (WriterT t m) a)
l

-- | 'execWriterP', but for "Control.Monad.Trans.Writer.Strict".
--
-- @since 0.2.1.0
execWriterPS
    :: (Monad m, Monoid w)
    => Pipe i o u (WriterT w m) a
    -> Pipe i o u m w
execWriterPS :: Pipe i o u (WriterT w m) a -> Pipe i o u m w
execWriterPS = ((a, w) -> w) -> Pipe i o u m (a, w) -> Pipe i o u m w
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> w
forall a b. (a, b) -> b
snd (Pipe i o u m (a, w) -> Pipe i o u m w)
-> (Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w))
-> Pipe i o u (WriterT w m) a
-> Pipe i o u m w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w)
forall (m :: * -> *) w i o u a.
(Monad m, Monoid w) =>
Pipe i o u (WriterT w m) a -> Pipe i o u m (a, w)
runWriterP

-- | Turn a parameterized, state-transforming, log-producing 'Pipe' into
-- a 'Pipe' over 'RWST', which can be useful for chaining it with other
-- 'RWST' pipes.
--
-- See 'stateP' and 'writerP' for more details on caveats, including:
--
-- *  Logging only happens when the @(a,s,w)@-returning pipe terminates.
--    There is no "streaming logging" --- the resulting @w@ is logged all
--    at once.
-- *  When the @(a,s,w)@-returning pipe terminates, whatever state in the
--    'RWST' is overwritten with the @s@ returned.  If other pipes in the
--    chain modify the @s@, their modifications will be overwritten.
--
-- @since 0.2.1.0
rwsP
    :: (Monad m, Monoid w)
    => (r -> s -> Pipe i o u m (a, s, w))
    -> Pipe i o u (RWST r w s m) a
rwsP :: (r -> s -> Pipe i o u m (a, s, w)) -> Pipe i o u (RWST r w s m) a
rwsP f :: r -> s -> Pipe i o u m (a, s, w)
f = do
    r
r <- RWST r w s m r -> Pipe i o u (RWST r w s m) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift RWST r w s m r
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
RWS.ask
    s
s <- RWST r w s m s -> Pipe i o u (RWST r w s m) s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift RWST r w s m s
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
RWS.get
    (x :: a
x, s' :: s
s', w :: w
w) <- (forall x. m x -> RWST r w s m x)
-> Pipe i o u m (a, s, w) -> Pipe i o u (RWST r w s m) (a, s, w)
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> RWST r w s m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (r -> s -> Pipe i o u m (a, s, w)
f r
r s
s)
    RWST r w s m () -> Pipe i o u (RWST r w s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (w -> RWST r w s m ()
forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
RWS.tell w
w)
    a
x a -> Pipe i o u (RWST r w s m) () -> Pipe i o u (RWST r w s m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RWST r w s m () -> Pipe i o u (RWST r w s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> RWST r w s m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
RWS.put s
s')

-- | Turn a 'Pipe' that runs over 'RWST' into a state-modifying,
-- environment-using, log-accumulating 'Pipe'.  See 'runStateP',
-- 'runWriterP', and 'runReaderP' for the uses and semantics.
--
-- @since 0.2.1.0
runRWSP
    :: (Monad m, Monoid w)
    => r
    -> s
    -> Pipe i o u (RWST r w s m) a
    -> Pipe i o u m (a, s, w)
runRWSP :: r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
runRWSP r :: r
r = (RecPipe i o u (RWST r w s m) a -> RecPipe i o u m (a, s, w))
-> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe ((RecPipe i o u (RWST r w s m) a -> RecPipe i o u m (a, s, w))
 -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w))
-> (s
    -> RecPipe i o u (RWST r w s m) a -> RecPipe i o u m (a, s, w))
-> s
-> Pipe i o u (RWST r w s m) a
-> Pipe i o u m (a, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w
-> s -> RecPipe i o u (RWST r w s m) a -> RecPipe i o u m (a, s, w)
forall t (m :: * -> *) (f :: * -> *) t a.
(Semigroup t, Functor m, Functor f) =>
t -> t -> FreeT f (RWST r t t m) a -> FreeT f m (a, t, t)
go w
forall a. Monoid a => a
mempty
  where
    go :: t -> t -> FreeT f (RWST r t t m) a -> FreeT f m (a, t, t)
go w :: t
w s :: t
s (FreeT p :: RWST r t t m (FreeF f a (FreeT f (RWST r t t m) a))
p) = m (FreeF f (a, t, t) (FreeT f m (a, t, t))) -> FreeT f m (a, t, t)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f (a, t, t) (FreeT f m (a, t, t)))
 -> FreeT f m (a, t, t))
-> m (FreeF f (a, t, t) (FreeT f m (a, t, t)))
-> FreeT f m (a, t, t)
forall a b. (a -> b) -> a -> b
$ RWST r t t m (FreeF f a (FreeT f (RWST r t t m) a))
-> r -> t -> m (FreeF f a (FreeT f (RWST r t t m) a), t, t)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST r t t m (FreeF f a (FreeT f (RWST r t t m) a))
p r
r t
s m (FreeF f a (FreeT f (RWST r t t m) a), t, t)
-> ((FreeF f a (FreeT f (RWST r t t m) a), t, t)
    -> FreeF f (a, t, t) (FreeT f m (a, t, t)))
-> m (FreeF f (a, t, t) (FreeT f m (a, t, t)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(q :: FreeF f a (FreeT f (RWST r t t m) a)
q, s' :: t
s', (t
w t -> t -> t
forall a. Semigroup a => a -> a -> a
<>)->t
w') ->
      case FreeF f a (FreeT f (RWST r t t m) a)
q of
        Pure x :: a
x -> (a, t, t) -> FreeF f (a, t, t) (FreeT f m (a, t, t))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a
x, t
s', t
w')
        Free l :: f (FreeT f (RWST r t t m) a)
l -> f (FreeT f m (a, t, t)) -> FreeF f (a, t, t) (FreeT f m (a, t, t))
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m (a, t, t))
 -> FreeF f (a, t, t) (FreeT f m (a, t, t)))
-> f (FreeT f m (a, t, t))
-> FreeF f (a, t, t) (FreeT f m (a, t, t))
forall a b. (a -> b) -> a -> b
$ t -> t -> FreeT f (RWST r t t m) a -> FreeT f m (a, t, t)
go t
w' t
s' (FreeT f (RWST r t t m) a -> FreeT f m (a, t, t))
-> f (FreeT f (RWST r t t m) a) -> f (FreeT f m (a, t, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (RWST r t t m) a)
l

-- | 'runRWSP', but ignoring the final state.
--
-- @since 0.2.1.0
evalRWSP
    :: (Monad m, Monoid w)
    => r
    -> s
    -> Pipe i o u (RWST r w s m) a
    -> Pipe i o u m (a, w)
evalRWSP :: r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, w)
evalRWSP r :: r
r s :: s
s = ((a, s, w) -> (a, w))
-> Pipe i o u m (a, s, w) -> Pipe i o u m (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(x :: a
x,_,w :: w
w) -> (a
x,w
w)) (Pipe i o u m (a, s, w) -> Pipe i o u m (a, w))
-> (Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w))
-> Pipe i o u (RWST r w s m) a
-> Pipe i o u m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
forall (m :: * -> *) w r s i o u a.
(Monad m, Monoid w) =>
r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
runRWSP r
r s
s

-- | 'runRWSP', but ignoring the result value.
--
-- @since 0.2.1.0
execRWSP
    :: (Monad m, Monoid w)
    => r
    -> s
    -> Pipe i o u (RWST r w s m) a
    -> Pipe i o u m (s, w)
execRWSP :: r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (s, w)
execRWSP r :: r
r s :: s
s = ((a, s, w) -> (s, w))
-> Pipe i o u m (a, s, w) -> Pipe i o u m (s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(_,s' :: s
s',w :: w
w) -> (s
s',w
w)) (Pipe i o u m (a, s, w) -> Pipe i o u m (s, w))
-> (Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w))
-> Pipe i o u (RWST r w s m) a
-> Pipe i o u m (s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
forall (m :: * -> *) w r s i o u a.
(Monad m, Monoid w) =>
r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
runRWSP r
r s
s

-- | 'rwsP', but for "Control.Monad.Trans.RWS.Strict".
--
-- @since 0.2.1.0
rwsPS
    :: (Monad m, Monoid w)
    => (r -> s -> Pipe i o u m (a, s, w))
    -> Pipe i o u (RWSS.RWST r w s m) a
rwsPS :: (r -> s -> Pipe i o u m (a, s, w)) -> Pipe i o u (RWST r w s m) a
rwsPS f :: r -> s -> Pipe i o u m (a, s, w)
f = do
    r
r <- RWST r w s m r -> Pipe i o u (RWST r w s m) r
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift RWST r w s m r
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m r
RWSS.ask
    s
s <- RWST r w s m s -> Pipe i o u (RWST r w s m) s
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift RWST r w s m s
forall w (m :: * -> *) r s. (Monoid w, Monad m) => RWST r w s m s
RWSS.get
    (x :: a
x, s' :: s
s', w :: w
w) <- (forall x. m x -> RWST r w s m x)
-> Pipe i o u m (a, s, w) -> Pipe i o u (RWST r w s m) (a, s, w)
forall (m :: * -> *) (n :: * -> *) i o u a.
(Monad m, Monad n) =>
(forall x. m x -> n x) -> Pipe i o u m a -> Pipe i o u n a
hoistPipe forall x. m x -> RWST r w s m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (r -> s -> Pipe i o u m (a, s, w)
f r
r s
s)
    RWST r w s m () -> Pipe i o u (RWST r w s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (w -> RWST r w s m ()
forall (m :: * -> *) w r s. Monad m => w -> RWST r w s m ()
RWSS.tell w
w)
    a
x a -> Pipe i o u (RWST r w s m) () -> Pipe i o u (RWST r w s m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ RWST r w s m () -> Pipe i o u (RWST r w s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> RWST r w s m ()
forall w (m :: * -> *) s r.
(Monoid w, Monad m) =>
s -> RWST r w s m ()
RWSS.put s
s')

-- | 'runRWSPS', but for "Control.Monad.Trans.RWS.Strict".
--
-- @since 0.2.1.0
runRWSPS
    :: (Monad m, Monoid w)
    => r
    -> s
    -> Pipe i o u (RWSS.RWST r w s m) a
    -> Pipe i o u m (a, s, w)
runRWSPS :: r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
runRWSPS r :: r
r = (RecPipe i o u (RWST r w s m) a -> RecPipe i o u m (a, s, w))
-> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
forall (m :: * -> *) (n :: * -> *) i o u a j p v b.
(Monad m, Monad n) =>
(RecPipe i o u m a -> RecPipe j p v n b)
-> Pipe i o u m a -> Pipe j p v n b
withRecPipe ((RecPipe i o u (RWST r w s m) a -> RecPipe i o u m (a, s, w))
 -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w))
-> (s
    -> RecPipe i o u (RWST r w s m) a -> RecPipe i o u m (a, s, w))
-> s
-> Pipe i o u (RWST r w s m) a
-> Pipe i o u m (a, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w
-> s -> RecPipe i o u (RWST r w s m) a -> RecPipe i o u m (a, s, w)
forall t (m :: * -> *) (f :: * -> *) t a.
(Semigroup t, Functor m, Functor f) =>
t -> t -> FreeT f (RWST r t t m) a -> FreeT f m (a, t, t)
go w
forall a. Monoid a => a
mempty
  where
    go :: t -> t -> FreeT f (RWST r t t m) a -> FreeT f m (a, t, t)
go w :: t
w s :: t
s (FreeT p :: RWST r t t m (FreeF f a (FreeT f (RWST r t t m) a))
p) = m (FreeF f (a, t, t) (FreeT f m (a, t, t))) -> FreeT f m (a, t, t)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF f (a, t, t) (FreeT f m (a, t, t)))
 -> FreeT f m (a, t, t))
-> m (FreeF f (a, t, t) (FreeT f m (a, t, t)))
-> FreeT f m (a, t, t)
forall a b. (a -> b) -> a -> b
$ RWST r t t m (FreeF f a (FreeT f (RWST r t t m) a))
-> r -> t -> m (FreeF f a (FreeT f (RWST r t t m) a), t, t)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
RWSS.runRWST RWST r t t m (FreeF f a (FreeT f (RWST r t t m) a))
p r
r t
s m (FreeF f a (FreeT f (RWST r t t m) a), t, t)
-> ((FreeF f a (FreeT f (RWST r t t m) a), t, t)
    -> FreeF f (a, t, t) (FreeT f m (a, t, t)))
-> m (FreeF f (a, t, t) (FreeT f m (a, t, t)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(q :: FreeF f a (FreeT f (RWST r t t m) a)
q, s' :: t
s', (t
w t -> t -> t
forall a. Semigroup a => a -> a -> a
<>)->t
w') ->
      case FreeF f a (FreeT f (RWST r t t m) a)
q of
        Pure x :: a
x -> (a, t, t) -> FreeF f (a, t, t) (FreeT f m (a, t, t))
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a
x, t
s', t
w')
        Free l :: f (FreeT f (RWST r t t m) a)
l -> f (FreeT f m (a, t, t)) -> FreeF f (a, t, t) (FreeT f m (a, t, t))
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (f (FreeT f m (a, t, t))
 -> FreeF f (a, t, t) (FreeT f m (a, t, t)))
-> f (FreeT f m (a, t, t))
-> FreeF f (a, t, t) (FreeT f m (a, t, t))
forall a b. (a -> b) -> a -> b
$ t -> t -> FreeT f (RWST r t t m) a -> FreeT f m (a, t, t)
go t
w' t
s' (FreeT f (RWST r t t m) a -> FreeT f m (a, t, t))
-> f (FreeT f (RWST r t t m) a) -> f (FreeT f m (a, t, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (FreeT f (RWST r t t m) a)
l

-- | 'evalRWSPS', but for "Control.Monad.Trans.RWS.Strict".
--
-- @since 0.2.1.0
evalRWSPS
    :: (Monad m, Monoid w)
    => r
    -> s
    -> Pipe i o u (RWSS.RWST r w s m) a
    -> Pipe i o u m (a, w)
evalRWSPS :: r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, w)
evalRWSPS r :: r
r s :: s
s = ((a, s, w) -> (a, w))
-> Pipe i o u m (a, s, w) -> Pipe i o u m (a, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(x :: a
x,_,w :: w
w) -> (a
x,w
w)) (Pipe i o u m (a, s, w) -> Pipe i o u m (a, w))
-> (Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w))
-> Pipe i o u (RWST r w s m) a
-> Pipe i o u m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
forall (m :: * -> *) w r s i o u a.
(Monad m, Monoid w) =>
r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
runRWSPS r
r s
s

-- | 'execRWSPS', but for "Control.Monad.Trans.RWS.Strict".
--
-- @since 0.2.1.0
execRWSPS
    :: (Monad m, Monoid w)
    => r
    -> s
    -> Pipe i o u (RWSS.RWST r w s m) a
    -> Pipe i o u m (s, w)
execRWSPS :: r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (s, w)
execRWSPS r :: r
r s :: s
s = ((a, s, w) -> (s, w))
-> Pipe i o u m (a, s, w) -> Pipe i o u m (s, w)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(_,s' :: s
s',w :: w
w) -> (s
s',w
w)) (Pipe i o u m (a, s, w) -> Pipe i o u m (s, w))
-> (Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w))
-> Pipe i o u (RWST r w s m) a
-> Pipe i o u m (s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
forall (m :: * -> *) w r s i o u a.
(Monad m, Monoid w) =>
r -> s -> Pipe i o u (RWST r w s m) a -> Pipe i o u m (a, s, w)
runRWSPS r
r s
s