{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE ViewPatterns               #-}

-- |
-- Module      : Data.Conduino
-- Copyright   : (c) Justin Le 2019
-- License     : BSD3
--
-- Maintainer  : justin@jle.im
-- Stability   : experimental
-- Portability : non-portable
--
-- Base API for 'Pipe'.  See documentation for 'Pipe', '.|', and 'runPipe'
-- for information on usage.
--
-- A "prelude" of useful pipes can be found in "Data.Conduino.Combinators".
--
-- == Why a stream processing library?
--
-- A stream processing library is a way to stream processors in a /composable/ way:
-- instead of defining your entire stream processing function as a single
-- recursive loop with some global state, instead think about each "stage" of the process,
-- and isolate each state to its own segment.  Each component can contain its own
-- isolated state:
--
-- >>> runPipePure $ sourceList [1..10]
--       .| scan (+) 0
--       .| sinkList
-- [1,3,6,10,15,21,28,36,45,55]
--
-- All of these components have internal "state":
--
-- *   @sourceList@ keeps track of "which" item in the list to yield next
-- *   @scan@ keeps track of the current running sum
-- *   @sinkList@ keeps track of all items that have been seen so far, as a list
--
-- They all work together without knowing any other component's internal state, so
-- you can write your total streaming function without concerning yourself, at
-- each stage, with the entire part.
--
-- In addition, there are useful functions to "combine" stream processors:
--
-- *   'zipSink' combines sinks in an "and" sort of way: combine two sinks in
--     parallel and finish when all finish.
-- *   'altSink' combines sinks in an "or" sort of way: combine two sinks in
--     parallel and finish when any of them finish
-- *   'zipSource' combines sources in parallel and collate their outputs.
--
-- Stream processing libraries are also useful for streaming composition of
-- monadic effects (like IO or State), as well.
--
module Data.Conduino (
    Pipe
  , (.|)
  , runPipe, runPipePure
  -- * Primitives
  , awaitEither, await, awaitWith, awaitSurely, awaitForever, yield
  -- * Special chaining
  , (&|), (|.)
  , fuseBoth, fuseUpstream, fuseBothMaybe
  -- * Incremental running
  , squeezePipe, squeezePipeEither
  , feedPipe, feedPipeEither
  -- * Pipe transformers
  , mapInput, mapOutput, mapUpRes, trimapPipe
  , hoistPipe
  , feedbackPipe, feedbackPipeEither
  -- * Wrappers
  , ZipSource(..)
  , unconsZipSource
  , zipSource
  , ZipSink(..)
  , zipSink, altSink
  -- * Generators
  , toListT, fromListT
  , pattern PipeList
  , withSource, genSource
  ) where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Free        (FreeT(..), FreeF(..))
import           Control.Monad.Trans.Free.Church
import           Control.Monad.Trans.State
import           Data.Bifunctor
import           Data.Conduino.Internal
import           Data.Functor
import           Data.Functor.Identity
import           Data.Sequence                   (Seq(..))
import           Data.Void
import           List.Transformer                (ListT(..), Step(..))
import qualified Data.Sequence                   as Seq
import qualified List.Transformer                as LT

-- | Await input from upstream.  Will block until upstream 'yield's.
--
-- Will return 'Nothing' if the upstream pipe finishes and terminates.
--
-- If the upstream pipe never terminates, then you can use 'awaitSurely' to
-- guarantee a result.
--
-- Will always return 'Just' if @u@ is 'Void'.
await :: Pipe i o u m (Maybe i)
await :: Pipe i o u m (Maybe i)
await = (u -> Maybe i) -> (i -> Maybe i) -> Either u i -> Maybe i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe i -> u -> Maybe i
forall a b. a -> b -> a
const Maybe i
forall a. Maybe a
Nothing) i -> Maybe i
forall a. a -> Maybe a
Just (Either u i -> Maybe i)
-> Pipe i o u m (Either u i) -> Pipe i o u m (Maybe i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipe i o u m (Either u i)
forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither

-- | 'await', but directly chaining a continuation if the 'await' was
-- succesful.
--
-- The await will always be succesful if @u@ is 'Void'.
--
-- This is a way of writing code in a way that is agnostic to how the
-- upstream pipe terminates.
awaitWith :: (i -> Pipe i o u m u) -> Pipe i o u m u
awaitWith :: (i -> Pipe i o u m u) -> Pipe i o u m u
awaitWith f :: i -> Pipe i o u m u
f = Pipe i o u m (Either u i)
forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither Pipe i o u m (Either u i)
-> (Either u i -> Pipe i o u m u) -> Pipe i o u m u
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left  r :: u
r -> u -> Pipe i o u m u
forall (f :: * -> *) a. Applicative f => a -> f a
pure u
r
    Right x :: i
x -> i -> Pipe i o u m u
f i
x

-- | Await input from upstream where the upstream pipe is guaranteed to
-- never terminate.
--
-- A common type error will occur if @u@ (upstream pipe result type) is not
-- 'Void' -- it might be @()@ or some non-'Void' type.  This means that the
-- upstream pipe terminates, so awaiting cannot be assured.
--
-- In that case, either change your upstream pipe to be one that never
-- terminates (which is most likely not possible), or use 'await' instead
-- of 'awaitSurely'.
awaitSurely :: Pipe i o Void m i
awaitSurely :: Pipe i o Void m i
awaitSurely = (Void -> i) -> (i -> i) -> Either Void i -> i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> i
forall a. Void -> a
absurd i -> i
forall a. a -> a
id (Either Void i -> i)
-> Pipe i o Void m (Either Void i) -> Pipe i o Void m i
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipe i o Void m (Either Void i)
forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither

-- | A useful utility function over repeated 'await's.  Will repeatedly
-- 'await' and then continue with the given pipe whenever the upstream pipe
-- yields.
--
-- Can be used to implement many pipe combinators:
--
-- @
-- 'Data.Conduino.Combinators.map' f = 'awaitForever' $ \x -> 'yield' (f x)
-- @
awaitForever :: (i -> Pipe i o u m a) -> Pipe i o u m u
awaitForever :: (i -> Pipe i o u m a) -> Pipe i o u m u
awaitForever = (u -> Pipe () o u m u) -> (i -> Pipe i o u m a) -> Pipe i o u m u
forall u o (m :: * -> *) b i a.
(u -> Pipe () o u m b) -> (i -> Pipe i o u m a) -> Pipe i o u m b
awaitForeverWith u -> Pipe () o u m u
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | 'awaitForever', but with a way to handle the result of the
-- upstream pipe, which will be called when the upstream pipe stops
-- producing.
awaitForeverWith
    :: (u -> Pipe () o u m b)       -- ^ how to handle upstream ending, transitioning to a source
    -> (i -> Pipe i o u m a)        -- ^ how to handle upstream output
    -> Pipe i o u m b
awaitForeverWith :: (u -> Pipe () o u m b) -> (i -> Pipe i o u m a) -> Pipe i o u m b
awaitForeverWith f :: u -> Pipe () o u m b
f g :: i -> Pipe i o u m a
g = Pipe i o u m b
go
  where
    go :: Pipe i o u m b
go = Pipe i o u m (Either u i)
forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither Pipe i o u m (Either u i)
-> (Either u i -> Pipe i o u m b) -> Pipe i o u m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Left x :: u
x  -> (i -> ()) -> Pipe () o u m b -> Pipe i o u m b
forall i j o u (m :: * -> *) a.
(i -> j) -> Pipe j o u m a -> Pipe i o u m a
mapInput (() -> i -> ()
forall a b. a -> b -> a
const ()) (Pipe () o u m b -> Pipe i o u m b)
-> Pipe () o u m b -> Pipe i o u m b
forall a b. (a -> b) -> a -> b
$ u -> Pipe () o u m b
f u
x
      Right x :: i
x -> i -> Pipe i o u m a
g i
x Pipe i o u m a -> Pipe i o u m b -> Pipe i o u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pipe i o u m b
go

-- | Run a pipe that is both a source and a sink (an "effect") into the
-- effect that it represents.
--
-- Usually you wouild construct this using something like:
--
-- @
-- 'runPipe' $ someSource
--        '.|' somePipe
--        .| someOtherPipe
--        .| someSink
-- @
--
-- 'runPipe' will produce the result of that final sink.
--
-- Some common errors you might receive:
--
-- *  @i@ is not @()@: If you give a pipe where the first parameter
--    ("input") is not @()@, it means that your pipe is not a producer.
--    Pre-compose it (using '.|') with a producer of the type you need.
--
--    For example, if you have a @myPipe :: 'Pipe' 'Int' o u m a@, this is
--    a pipe that is awaiting 'Int's from upstream.  Pre-compose with
--    a producer of 'Int's, like @'Data.Conduino.Combinators.sourceList'
--    [1,2,3] '.|' myPipe@, in order to be able to run it.
--
-- *  @o@ is not 'Void': If you give a pipe where the second parameter
--    ("output") is not 'Void', it means that your pipe is not a consumer.
--    Post-compose it (using '.|') with a consumer of the type you need.
--
--    For example, if you have @myPipe :: 'Pipe' i 'Int' u m a@, this is
--    a pipe that is yielding 'Int's downstream that are going unhandled.
--    Post-compose it a consumer of 'Int's, like @myPipe '.|'
--    'Data.Conduino.foldl' (+) 0@, in order to be able to run it.
--
--    If you just want to ignore all downstream yields, post-compose with
--    'Data.Conduino.Combinators.sinkNull'.
--
runPipe :: Monad m => Pipe () Void u m a -> m a
runPipe :: Pipe () Void u m a -> m a
runPipe = (PipeF () Void u (m a) -> m a) -> FT (PipeF () Void u) m a -> m a
forall (f :: * -> *) (m :: * -> *) a.
(Functor f, Monad m) =>
(f (m a) -> m a) -> FT f m a -> m a
iterT PipeF () Void u (m a) -> m a
forall u p. PipeF () Void u p -> p
go (FT (PipeF () Void u) m a -> m a)
-> (Pipe () Void u m a -> FT (PipeF () Void u) m a)
-> Pipe () Void u m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pipe () Void u m a -> FT (PipeF () Void u) m a
forall i o u (m :: * -> *) a.
Pipe i o u m a -> FT (PipeF i o u) m a
pipeFree
  where
    go :: PipeF () Void u p -> p
go = \case
      PAwaitF _ f :: () -> p
f -> () -> p
f ()
      PYieldF o :: Void
o _ -> Void -> p
forall a. Void -> a
absurd Void
o

-- | 'runPipe' when the underlying monad is 'Identity', and so has no
-- effects.
runPipePure :: Pipe () Void Void Identity a -> a
runPipePure :: Pipe () Void Void Identity a -> a
runPipePure = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (Pipe () Void Void Identity a -> Identity a)
-> Pipe () Void Void Identity a
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pipe () Void Void Identity a -> Identity a
forall (m :: * -> *) u a. Monad m => Pipe () Void u m a -> m a
runPipe

-- | Repeatedly run 'squeezePipe' by giving it items from an input list.
-- Returns the outputs observed, and 'Left' if the input list was exhausted
-- with more input expected, or 'Right' if the pipe terminated, with the
-- leftover inputs and output result.
--
-- @since 0.2.1.0
feedPipe
    :: Monad m
    => [i]                      -- ^ input to feed in
    -> Pipe i o u m a
    -> m ([o], Either (i -> Pipe i o u m a) ([i], a))
feedPipe :: [i]
-> Pipe i o u m a -> m ([o], Either (i -> Pipe i o u m a) ([i], a))
feedPipe xs :: [i]
xs = ((([o], Either (Either u i -> Pipe i o u m a) ([i], a))
 -> ([o], Either (i -> Pipe i o u m a) ([i], a)))
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
-> m ([o], Either (i -> Pipe i o u m a) ([i], a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([o], Either (Either u i -> Pipe i o u m a) ([i], a))
  -> ([o], Either (i -> Pipe i o u m a) ([i], a)))
 -> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
 -> m ([o], Either (i -> Pipe i o u m a) ([i], a)))
-> (((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
    -> ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
    -> ([o], Either (i -> Pipe i o u m a) ([i], a)))
-> ((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
-> m ([o], Either (i -> Pipe i o u m a) ([i], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Either u i -> Pipe i o u m a) ([i], a)
 -> Either (i -> Pipe i o u m a) ([i], a))
-> ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
-> ([o], Either (i -> Pipe i o u m a) ([i], a))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Either (Either u i -> Pipe i o u m a) ([i], a)
  -> Either (i -> Pipe i o u m a) ([i], a))
 -> ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
 -> ([o], Either (i -> Pipe i o u m a) ([i], a)))
-> (((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
    -> Either (Either u i -> Pipe i o u m a) ([i], a)
    -> Either (i -> Pipe i o u m a) ([i], a))
-> ((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
-> ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
-> ([o], Either (i -> Pipe i o u m a) ([i], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
-> Either (Either u i -> Pipe i o u m a) ([i], a)
-> Either (i -> Pipe i o u m a) ([i], a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) ((Either u i -> Pipe i o u m a)
-> (i -> Either u i) -> i -> Pipe i o u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either u i
forall a b. b -> Either a b
Right)
            (m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
 -> m ([o], Either (i -> Pipe i o u m a) ([i], a)))
-> (Pipe i o u m a
    -> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a)))
-> Pipe i o u m a
-> m ([o], Either (i -> Pipe i o u m a) ([i], a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [i]
-> Pipe i o u m a
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
forall (m :: * -> *) i o u a.
Monad m =>
[i]
-> Pipe i o u m a
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
feedPipeEither [i]
xs

-- | Repeatedly run 'squeezePipeEither' by giving it items from an input
-- list.  Returns the outputs observed, and 'Left' if the input list was
-- exhausted with more input expected (or a @u@ terminating upstream
-- value), or 'Right' if the pipe terminated, with the leftover inputs and
-- output result.
--
-- @since 0.2.1.0
feedPipeEither
    :: Monad m
    => [i]                      -- ^ input to feed in
    -> Pipe i o u m a
    -> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
feedPipeEither :: [i]
-> Pipe i o u m a
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
feedPipeEither xs :: [i]
xs p :: Pipe i o u m a
p = do
    (zs :: [o]
zs, r :: Either (Either u i -> Pipe i o u m a) a
r) <- Pipe i o u m a -> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall (m :: * -> *) i o u a.
Monad m =>
Pipe i o u m a -> m ([o], Either (Either u i -> Pipe i o u m a) a)
squeezePipeEither Pipe i o u m a
p
    case Either (Either u i -> Pipe i o u m a) a
r of
      Left n :: Either u i -> Pipe i o u m a
n -> case [i]
xs of
        []   -> ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([o]
zs, (Either u i -> Pipe i o u m a)
-> Either (Either u i -> Pipe i o u m a) ([i], a)
forall a b. a -> Either a b
Left Either u i -> Pipe i o u m a
n)
        y :: i
y:ys :: [i]
ys -> ([o] -> [o])
-> ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
-> ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([o]
zs [o] -> [o] -> [o]
forall a. [a] -> [a] -> [a]
++) (([o], Either (Either u i -> Pipe i o u m a) ([i], a))
 -> ([o], Either (Either u i -> Pipe i o u m a) ([i], a)))
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [i]
-> Pipe i o u m a
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
forall (m :: * -> *) i o u a.
Monad m =>
[i]
-> Pipe i o u m a
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
feedPipeEither [i]
ys (Either u i -> Pipe i o u m a
n (i -> Either u i
forall a b. b -> Either a b
Right i
y))
      Right z :: a
z -> ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
-> m ([o], Either (Either u i -> Pipe i o u m a) ([i], a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([o]
zs, ([i], a) -> Either (Either u i -> Pipe i o u m a) ([i], a)
forall a b. b -> Either a b
Right ([i]
xs, a
z))

-- | "Squeeze" a pipe by extracting all output that can be extracted
-- before any input is requested.  Returns a 'Left' if the pipe eventually
-- does request input (as a continuation on the new input), or a 'Right' if
-- the pipe terminates with a value before ever asking for input.
--
-- @since 0.2.1.0
squeezePipe
    :: Monad m
    => Pipe i o u m a
    -> m ([o], Either (i -> Pipe i o u m a) a)
squeezePipe :: Pipe i o u m a -> m ([o], Either (i -> Pipe i o u m a) a)
squeezePipe = ((([o], Either (Either u i -> Pipe i o u m a) a)
 -> ([o], Either (i -> Pipe i o u m a) a))
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
-> m ([o], Either (i -> Pipe i o u m a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((([o], Either (Either u i -> Pipe i o u m a) a)
  -> ([o], Either (i -> Pipe i o u m a) a))
 -> m ([o], Either (Either u i -> Pipe i o u m a) a)
 -> m ([o], Either (i -> Pipe i o u m a) a))
-> (((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
    -> ([o], Either (Either u i -> Pipe i o u m a) a)
    -> ([o], Either (i -> Pipe i o u m a) a))
-> ((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
-> m ([o], Either (i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either (Either u i -> Pipe i o u m a) a
 -> Either (i -> Pipe i o u m a) a)
-> ([o], Either (Either u i -> Pipe i o u m a) a)
-> ([o], Either (i -> Pipe i o u m a) a)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Either (Either u i -> Pipe i o u m a) a
  -> Either (i -> Pipe i o u m a) a)
 -> ([o], Either (Either u i -> Pipe i o u m a) a)
 -> ([o], Either (i -> Pipe i o u m a) a))
-> (((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
    -> Either (Either u i -> Pipe i o u m a) a
    -> Either (i -> Pipe i o u m a) a)
-> ((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
-> ([o], Either (Either u i -> Pipe i o u m a) a)
-> ([o], Either (i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either u i -> Pipe i o u m a) -> i -> Pipe i o u m a)
-> Either (Either u i -> Pipe i o u m a) a
-> Either (i -> Pipe i o u m a) a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first) ((Either u i -> Pipe i o u m a)
-> (i -> Either u i) -> i -> Pipe i o u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either u i
forall a b. b -> Either a b
Right)
            (m ([o], Either (Either u i -> Pipe i o u m a) a)
 -> m ([o], Either (i -> Pipe i o u m a) a))
-> (Pipe i o u m a
    -> m ([o], Either (Either u i -> Pipe i o u m a) a))
-> Pipe i o u m a
-> m ([o], Either (i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pipe i o u m a -> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall (m :: * -> *) i o u a.
Monad m =>
Pipe i o u m a -> m ([o], Either (Either u i -> Pipe i o u m a) a)
squeezePipeEither

-- | "Squeeze" a pipe by extracting all output that can be extracted before
-- any input is requested.  Returns a 'Left' if the pipe eventually does
-- request input (as a continuation on the new input, or a terminating @u@
-- value), or a 'Right' if the pipe terminates with a value before ever
-- asking for input.
--
-- @since 0.2.1.0
squeezePipeEither
    :: Monad m
    => Pipe i o u m a
    -> m ([o], Either (Either u i -> Pipe i o u m a) a)
squeezePipeEither :: Pipe i o u m a -> m ([o], Either (Either u i -> Pipe i o u m a) a)
squeezePipeEither p :: Pipe i o u m a
p = FT (PipeF i o u) m a
-> (a -> m ([o], Either (Either u i -> Pipe i o u m a) a))
-> (forall x.
    (x -> m ([o], Either (Either u i -> Pipe i o u m a) a))
    -> PipeF i o u x
    -> m ([o], Either (Either u i -> Pipe i o u m a) a))
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
   (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT (Pipe i o u m a -> FT (PipeF i o u) m a
forall i o u (m :: * -> *) a.
Pipe i o u m a -> FT (PipeF i o u) m a
pipeFree Pipe i o u m a
p)
    (([o], Either (Either u i -> Pipe i o u m a) a)
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([o], Either (Either u i -> Pipe i o u m a) a)
 -> m ([o], Either (Either u i -> Pipe i o u m a) a))
-> (a -> ([o], Either (Either u i -> Pipe i o u m a) a))
-> a
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],) (Either (Either u i -> Pipe i o u m a) a
 -> ([o], Either (Either u i -> Pipe i o u m a) a))
-> (a -> Either (Either u i -> Pipe i o u m a) a)
-> a
-> ([o], Either (Either u i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Either u i -> Pipe i o u m a) a
forall a b. b -> Either a b
Right)
    (\pNext :: x -> m ([o], Either (Either u i -> Pipe i o u m a) a)
pNext -> \case
        PAwaitF f :: u -> x
f g :: i -> x
g -> ([o], Either (Either u i -> Pipe i o u m a) a)
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([o], Either (Either u i -> Pipe i o u m a) a)
 -> m ([o], Either (Either u i -> Pipe i o u m a) a))
-> ((Either u i -> Pipe i o u m a)
    -> ([o], Either (Either u i -> Pipe i o u m a) a))
-> (Either u i -> Pipe i o u m a)
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],) (Either (Either u i -> Pipe i o u m a) a
 -> ([o], Either (Either u i -> Pipe i o u m a) a))
-> ((Either u i -> Pipe i o u m a)
    -> Either (Either u i -> Pipe i o u m a) a)
-> (Either u i -> Pipe i o u m a)
-> ([o], Either (Either u i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either u i -> Pipe i o u m a)
-> Either (Either u i -> Pipe i o u m a) a
forall a b. a -> Either a b
Left ((Either u i -> Pipe i o u m a)
 -> m ([o], Either (Either u i -> Pipe i o u m a) a))
-> (Either u i -> Pipe i o u m a)
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall a b. (a -> b) -> a -> b
$ (([o], Either (Either u i -> Pipe i o u m a) a) -> Pipe i o u m a
forall (t :: * -> *) o u i (m :: * -> *) b.
Foldable t =>
(t o, Either (Either u i -> Pipe i o u m b) b) -> Pipe i o u m b
unSqueeze (([o], Either (Either u i -> Pipe i o u m a) a) -> Pipe i o u m a)
-> Pipe i o u m ([o], Either (Either u i -> Pipe i o u m a) a)
-> Pipe i o u m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Pipe i o u m ([o], Either (Either u i -> Pipe i o u m a) a)
 -> Pipe i o u m a)
-> (Either u i
    -> Pipe i o u m ([o], Either (Either u i -> Pipe i o u m a) a))
-> Either u i
-> Pipe i o u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m ([o], Either (Either u i -> Pipe i o u m a) a)
-> Pipe i o u m ([o], Either (Either u i -> Pipe i o u m a) a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ([o], Either (Either u i -> Pipe i o u m a) a)
 -> Pipe i o u m ([o], Either (Either u i -> Pipe i o u m a) a))
-> (Either u i -> m ([o], Either (Either u i -> Pipe i o u m a) a))
-> Either u i
-> Pipe i o u m ([o], Either (Either u i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m ([o], Either (Either u i -> Pipe i o u m a) a)
pNext (x -> m ([o], Either (Either u i -> Pipe i o u m a) a))
-> (Either u i -> x)
-> Either u i
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (u -> x) -> (i -> x) -> Either u i -> x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either u -> x
f i -> x
g
        PYieldF o :: o
o x :: x
x -> ([o] -> [o])
-> ([o], Either (Either u i -> Pipe i o u m a) a)
-> ([o], Either (Either u i -> Pipe i o u m a) a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (o
oo -> [o] -> [o]
forall a. a -> [a] -> [a]
:) (([o], Either (Either u i -> Pipe i o u m a) a)
 -> ([o], Either (Either u i -> Pipe i o u m a) a))
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
-> m ([o], Either (Either u i -> Pipe i o u m a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> x -> m ([o], Either (Either u i -> Pipe i o u m a) a)
pNext x
x
    )
  where
    unSqueeze :: (t o, Either (Either u i -> Pipe i o u m b) b) -> Pipe i o u m b
unSqueeze (os :: t o
os, nxt :: Either (Either u i -> Pipe i o u m b) b
nxt) = do
      (o -> Pipe i o u m ()) -> t o -> Pipe i o u m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ o -> Pipe i o u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
yield t o
os
      case Either (Either u i -> Pipe i o u m b) b
nxt of
        Left f :: Either u i -> Pipe i o u m b
f  -> Either u i -> Pipe i o u m b
f (Either u i -> Pipe i o u m b)
-> Pipe i o u m (Either u i) -> Pipe i o u m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Pipe i o u m (Either u i)
forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither
        Right a :: b
a -> b -> Pipe i o u m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
a

-- | The main operator for chaining pipes together.  @pipe1 .| pipe2@ will
-- connect the output of @pipe1@ to the input of @pipe2@.
--
-- "Running" a pipe will draw from @pipe2@, and if @pipe2@ ever asks for
-- input (with 'await' or something similar), it will block until @pipe1@
-- outputs something (or signals termination).
--
-- The structure of a full pipeline usually looks like:
--
-- @
-- 'runPipe' $ someSource
--        '.|' somePipe
--        .| someOtherPipe
--        .| someSink
-- @
--
-- Where you route a source into a series of pipes, which eventually ends
-- up at a sink.  'runPipe' will then produce the result of that sink.
(.|)
    :: Monad m
    => Pipe a b u m v
    -> Pipe b c v m r
    -> Pipe a c u m r
Pipe p :: FT (PipeF a b u) m v
p .| :: Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
.| Pipe q :: FT (PipeF b c v) m r
q = FT (PipeF a c u) m r -> Pipe a c u m r
forall i o u (m :: * -> *) a.
FT (PipeF i o u) m a -> Pipe i o u m a
Pipe (FT (PipeF a c u) m r -> Pipe a c u m r)
-> FT (PipeF a c u) m r -> Pipe a c u m r
forall a b. (a -> b) -> a -> b
$ FreeT (PipeF a c u) m r -> FT (PipeF a c u) m r
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT (FreeT (PipeF a c u) m r -> FT (PipeF a c u) m r)
-> FreeT (PipeF a c u) m r -> FT (PipeF a c u) m r
forall a b. (a -> b) -> a -> b
$ RecPipe a b u m v -> RecPipe b c v m r -> FreeT (PipeF a c u) m r
forall a b c u v (m :: * -> *) r.
Monad m =>
RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
compPipe_ (FT (PipeF a b u) m v -> RecPipe a b u m v
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT (PipeF a b u) m v
p) (FT (PipeF b c v) m r -> RecPipe b c v m r
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT (PipeF b c v) m r
q)
infixr 2 .|

compPipe_
    :: forall a b c u v m r. (Monad m)
    => RecPipe a b u m v
    -> RecPipe b c v m r
    -> RecPipe a c u m r
compPipe_ :: RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
compPipe_ p :: RecPipe a b u m v
p q :: RecPipe b c v m r
q = m (FreeF (PipeF a c u) r (RecPipe a c u m r)) -> RecPipe a c u m r
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF (PipeF a c u) r (RecPipe a c u m r))
 -> RecPipe a c u m r)
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
-> RecPipe a c u m r
forall a b. (a -> b) -> a -> b
$ RecPipe b c v m r -> m (FreeF (PipeF b c v) r (RecPipe b c v m r))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT RecPipe b c v m r
q m (FreeF (PipeF b c v) r (RecPipe b c v m r))
-> (FreeF (PipeF b c v) r (RecPipe b c v m r)
    -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \qq :: FreeF (PipeF b c v) r (RecPipe b c v m r)
qq -> case FreeF (PipeF b c v) r (RecPipe b c v m r)
qq of
    Pure x :: r
x             -> FreeF (PipeF a c u) r (RecPipe a c u m r)
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeF (PipeF a c u) r (RecPipe a c u m r)
 -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> (r -> FreeF (PipeF a c u) r (RecPipe a c u m r))
-> r
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> FreeF (PipeF a c u) r (RecPipe a c u m r)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (r -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> r -> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall a b. (a -> b) -> a -> b
$ r
x
    Free (PAwaitF f :: v -> RecPipe b c v m r
f g :: b -> RecPipe b c v m r
g) -> RecPipe a b u m v -> m (FreeF (PipeF a b u) v (RecPipe a b u m v))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT RecPipe a b u m v
p m (FreeF (PipeF a b u) v (RecPipe a b u m v))
-> (FreeF (PipeF a b u) v (RecPipe a b u m v)
    -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \pp :: FreeF (PipeF a b u) v (RecPipe a b u m v)
pp -> case FreeF (PipeF a b u) v (RecPipe a b u m v)
pp of
      Pure x' :: v
x'              -> RecPipe a c u m r -> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (RecPipe a c u m r
 -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> RecPipe a c u m r
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall a b. (a -> b) -> a -> b
$ RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
forall a b c u v (m :: * -> *) r.
Monad m =>
RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
compPipe_ (m (FreeF (PipeF a b u) v (RecPipe a b u m v)) -> RecPipe a b u m v
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (FreeF (PipeF a b u) v (RecPipe a b u m v)
-> m (FreeF (PipeF a b u) v (RecPipe a b u m v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeF (PipeF a b u) v (RecPipe a b u m v)
pp)) (v -> RecPipe b c v m r
f v
x')
      Free (PAwaitF f' :: u -> RecPipe a b u m v
f' g' :: a -> RecPipe a b u m v
g') -> FreeF (PipeF a c u) r (RecPipe a c u m r)
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeF (PipeF a c u) r (RecPipe a c u m r)
 -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> (PipeF a c u (RecPipe a c u m r)
    -> FreeF (PipeF a c u) r (RecPipe a c u m r))
-> PipeF a c u (RecPipe a c u m r)
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipeF a c u (RecPipe a c u m r)
-> FreeF (PipeF a c u) r (RecPipe a c u m r)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (PipeF a c u (RecPipe a c u m r)
 -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> PipeF a c u (RecPipe a c u m r)
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall a b. (a -> b) -> a -> b
$ (u -> RecPipe a c u m r)
-> (a -> RecPipe a c u m r) -> PipeF a c u (RecPipe a c u m r)
forall i o u a. (u -> a) -> (i -> a) -> PipeF i o u a
PAwaitF ((RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
forall a b c u v (m :: * -> *) r.
Monad m =>
RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
`compPipe_` m (FreeF (PipeF b c v) r (RecPipe b c v m r)) -> RecPipe b c v m r
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (FreeF (PipeF b c v) r (RecPipe b c v m r)
-> m (FreeF (PipeF b c v) r (RecPipe b c v m r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeF (PipeF b c v) r (RecPipe b c v m r)
qq)) (RecPipe a b u m v -> RecPipe a c u m r)
-> (u -> RecPipe a b u m v) -> u -> RecPipe a c u m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> RecPipe a b u m v
f')
                                                    ((RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
forall a b c u v (m :: * -> *) r.
Monad m =>
RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
`compPipe_` m (FreeF (PipeF b c v) r (RecPipe b c v m r)) -> RecPipe b c v m r
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (FreeF (PipeF b c v) r (RecPipe b c v m r)
-> m (FreeF (PipeF b c v) r (RecPipe b c v m r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeF (PipeF b c v) r (RecPipe b c v m r)
qq)) (RecPipe a b u m v -> RecPipe a c u m r)
-> (a -> RecPipe a b u m v) -> a -> RecPipe a c u m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RecPipe a b u m v
g')
      Free (PYieldF x' :: b
x' y' :: RecPipe a b u m v
y') -> RecPipe a c u m r -> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT (RecPipe a c u m r
 -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> RecPipe a c u m r
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall a b. (a -> b) -> a -> b
$ RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
forall a b c u v (m :: * -> *) r.
Monad m =>
RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
compPipe_ RecPipe a b u m v
y' (b -> RecPipe b c v m r
g b
x')
    Free (PYieldF x :: c
x y :: RecPipe b c v m r
y) -> FreeF (PipeF a c u) r (RecPipe a c u m r)
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeF (PipeF a c u) r (RecPipe a c u m r)
 -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> (PipeF a c u (RecPipe a c u m r)
    -> FreeF (PipeF a c u) r (RecPipe a c u m r))
-> PipeF a c u (RecPipe a c u m r)
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipeF a c u (RecPipe a c u m r)
-> FreeF (PipeF a c u) r (RecPipe a c u m r)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (PipeF a c u (RecPipe a c u m r)
 -> m (FreeF (PipeF a c u) r (RecPipe a c u m r)))
-> PipeF a c u (RecPipe a c u m r)
-> m (FreeF (PipeF a c u) r (RecPipe a c u m r))
forall a b. (a -> b) -> a -> b
$ c -> RecPipe a c u m r -> PipeF a c u (RecPipe a c u m r)
forall i o u a. o -> a -> PipeF i o u a
PYieldF c
x (RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
forall a b c u v (m :: * -> *) r.
Monad m =>
RecPipe a b u m v -> RecPipe b c v m r -> RecPipe a c u m r
compPipe_ RecPipe a b u m v
p RecPipe b c v m r
y)

-- | Useful prefix version of '&|'.
--
-- @since 0.2.1.0
fuseBoth
    :: Monad m
    => Pipe a b u m v
    -> Pipe b c v m r
    -> Pipe a c u m (v, r)
fuseBoth :: Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (v, r)
fuseBoth p :: Pipe a b u m v
p q :: Pipe b c v m r
q = Pipe a b u m v
p
            Pipe a b u m v -> Pipe b c v m (v, r) -> Pipe a c u m (v, r)
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
.| (Pipe b c v m r
q Pipe b c v m r -> (r -> Pipe b c v m (v, r)) -> Pipe b c v m (v, r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> Pipe b c v m (v, r)
forall b i o a (m :: * -> *). b -> Pipe i o a m (a, b)
exhaust)
  where
    exhaust :: b -> Pipe i o a m (a, b)
exhaust x :: b
x = Pipe i o a m (a, b)
forall i o a (m :: * -> *). Pipe i o a m (a, b)
go
      where
        go :: Pipe i o a m (a, b)
go = Pipe i o a m (Either a i)
forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither Pipe i o a m (Either a i)
-> (Either a i -> Pipe i o a m (a, b)) -> Pipe i o a m (a, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Left  y :: a
y -> (a, b) -> Pipe i o a m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
y, b
x)
          Right _ -> Pipe i o a m (a, b)
go

-- | Like 'fuseBoth' and '&|', except does not wait for the upstream pipe
-- to terminate.  Return 'Nothing' in the first field if the upstream pipe hasn't terminated,
-- and 'Just' if it has, with the terminating value.
--
-- @since 0.2.1.0
fuseBothMaybe :: Monad m => Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (Maybe v, r)
fuseBothMaybe :: Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (Maybe v, r)
fuseBothMaybe p :: Pipe a b u m v
p q :: Pipe b c v m r
q = Pipe a b u m v
p
                 Pipe a b u m v
-> Pipe b c v m (Maybe v, r) -> Pipe a c u m (Maybe v, r)
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
.| (Pipe b c v m r
q Pipe b c v m r
-> (r -> Pipe b c v m (Maybe v, r)) -> Pipe b c v m (Maybe v, r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= r -> Pipe b c v m (Maybe v, r)
forall t b o a (m :: * -> *). t -> Pipe b o a m (Maybe a, t)
check)
  where
    check :: t -> Pipe b o a m (Maybe a, t)
check x :: t
x = (,t
x) (Maybe a -> (Maybe a, t))
-> (Either a b -> Maybe a) -> Either a b -> (Maybe a, t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> (b -> Maybe a) -> Either a b -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) (Either a b -> (Maybe a, t))
-> Pipe b o a m (Either a b) -> Pipe b o a m (Maybe a, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipe b o a m (Either a b)
forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither

-- | Useful prefix version of '|.'.
--
-- @since 0.2.1.0
fuseUpstream
    :: Monad m
    => Pipe a b u m v
    -> Pipe b c v m r
    -> Pipe a c u m v
fuseUpstream :: Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m v
fuseUpstream p :: Pipe a b u m v
p q :: Pipe b c v m r
q = (v, r) -> v
forall a b. (a, b) -> a
fst ((v, r) -> v) -> Pipe a c u m (v, r) -> Pipe a c u m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (v, r)
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (v, r)
fuseBoth Pipe a b u m v
p Pipe b c v m r
q

-- | Like @.|@, but get the result of /both/ pipes on termination, instead
-- of just the second.  This means that @p &| q@ will only terminate with a result when
-- /both/ @p@ and @q@ terminate.  (Typically, @p .| q@ would terminate as soon as
-- @q@ terminates.)
--
-- @since 0.2.1.0
(&|) :: Monad m => Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (v, r)
&| :: Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (v, r)
(&|) = Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (v, r)
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m (v, r)
fuseBoth

-- | Like @.|@, but keep the result of the /first/ pipe, instead of the
-- second.  This means that @p |. q@ will only terminate with a result when
-- /both/ @p@ and @q@ terminate.  (Typically, @p .| q@ would terminate as soon as
-- @q@ terminates.)
--
-- @since 0.2.1.0
(|.) :: Monad m => Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m v
|. :: Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m v
(|.) = Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m v
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m v
fuseUpstream

infixr 2 &|
infixr 2 |.

-- | Loop a pipe into itself.
--
-- *  Will feed all output back to the input
-- *  Will only ask for input upstream if output is stalled.
-- *  Yields all outputted values downstream, effectively duplicating them.
--
-- @since 0.2.1.0
feedbackPipe
    :: Monad m
    => Pipe x x u m a
    -> Pipe x x u m a
feedbackPipe :: Pipe x x u m a -> Pipe x x u m a
feedbackPipe = Pipe (Either x x) x u m a -> Pipe x x u m a
forall (m :: * -> *) i o u a.
Monad m =>
Pipe (Either i o) o u m a -> Pipe i o u m a
feedbackPipeEither (Pipe (Either x x) x u m a -> Pipe x x u m a)
-> (Pipe x x u m a -> Pipe (Either x x) x u m a)
-> Pipe x x u m a
-> Pipe x x u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either x x -> x) -> Pipe x x u m a -> Pipe (Either x x) x u m a
forall i j o u (m :: * -> *) a.
(i -> j) -> Pipe j o u m a -> Pipe i o u m a
mapInput ((x -> x) -> (x -> x) -> Either x x -> x
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either x -> x
forall a. a -> a
id x -> x
forall a. a -> a
id)

-- | A version of 'feedbackPipe' that distinguishes upstream input from
-- downstream output fed back.  Gets 'Left' from upstream, and 'Right' from
-- its own output.
--
-- *  Will feed all output back to the input
-- *  Will only ask for input upstream if output is stalled.
-- *  Yields all outputted values downstream, effectively duplicating them.
--
-- @since 0.2.2.0
feedbackPipeEither
    :: Monad m
    => Pipe (Either i o) o u m a
    -> Pipe i o u m a
feedbackPipeEither :: Pipe (Either i o) o u m a -> Pipe i o u m a
feedbackPipeEither p :: Pipe (Either i o) o u m a
p = ((a, Seq o) -> a) -> Pipe i o u m (a, Seq o) -> Pipe i o u m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Seq o) -> a
forall a b. (a, b) -> a
fst (Pipe i o u m (a, Seq o) -> Pipe i o u m a)
-> (Pipe i o u (StateT (Seq o) m) a -> Pipe i o u m (a, Seq o))
-> Pipe i o u (StateT (Seq o) m) a
-> Pipe i o u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq o -> Pipe i o u (StateT (Seq o) m) a -> Pipe i o u m (a, Seq o)
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 Seq o
forall a. Seq a
Seq.empty (Pipe i o u (StateT (Seq o) m) a -> Pipe i o u m a)
-> Pipe i o u (StateT (Seq o) m) a -> Pipe i o u m a
forall a b. (a -> b) -> a -> b
$
       Pipe i (Either i o) u (StateT (Seq o) m) u
forall a b b. Pipe a (Either a b) b (StateT (Seq b) m) b
popper
    Pipe i (Either i o) u (StateT (Seq o) m) u
-> Pipe (Either i o) o u (StateT (Seq o) m) a
-> Pipe i o u (StateT (Seq o) m) a
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
.| (forall x. m x -> StateT (Seq o) m x)
-> Pipe (Either i o) o u m a
-> Pipe (Either i o) o u (StateT (Seq o) 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 -> StateT (Seq o) m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Pipe (Either i o) o u m a
p
    Pipe (Either i o) o u (StateT (Seq o) m) a
-> Pipe o o a (StateT (Seq o) m) a
-> Pipe (Either i o) o u (StateT (Seq o) m) a
forall (m :: * -> *) a b u v c r.
Monad m =>
Pipe a b u m v -> Pipe b c v m r -> Pipe a c u m r
.| (o -> Pipe o o a (StateT (Seq o) m) ())
-> Pipe o o a (StateT (Seq o) m) a
forall i o u (m :: * -> *) a.
(i -> Pipe i o u m a) -> Pipe i o u m u
awaitForever (\x :: o
x -> StateT (Seq o) m () -> Pipe o o a (StateT (Seq o) m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Seq o -> Seq o) -> StateT (Seq o) m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Seq o -> o -> Seq o
forall a. Seq a -> a -> Seq a
:|> o
x)) Pipe o o a (StateT (Seq o) m) ()
-> Pipe o o a (StateT (Seq o) m) ()
-> Pipe o o a (StateT (Seq o) m) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> o -> Pipe o o a (StateT (Seq o) m) ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
yield o
x)
  where
    popper :: Pipe a (Either a b) b (StateT (Seq b) m) b
popper = StateT (Seq b) m (Seq b)
-> Pipe a (Either a b) b (StateT (Seq b) m) (Seq b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Seq b) m (Seq b)
forall (m :: * -> *) s. Monad m => StateT s m s
get Pipe a (Either a b) b (StateT (Seq b) m) (Seq b)
-> (Seq b -> Pipe a (Either a b) b (StateT (Seq b) m) b)
-> Pipe a (Either a b) b (StateT (Seq b) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Empty -> Pipe a (Either a b) b (StateT (Seq b) m) (Either b a)
forall i o u (m :: * -> *). Pipe i o u m (Either u i)
awaitEither Pipe a (Either a b) b (StateT (Seq b) m) (Either b a)
-> (Either b a -> Pipe a (Either a b) b (StateT (Seq b) m) b)
-> Pipe a (Either a b) b (StateT (Seq b) m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left r :: b
r  -> b -> Pipe a (Either a b) b (StateT (Seq b) m) b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
r
        Right x :: a
x -> Either a b -> Pipe a (Either a b) b (StateT (Seq b) m) ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
yield (a -> Either a b
forall a b. a -> Either a b
Left a
x) Pipe a (Either a b) b (StateT (Seq b) m) ()
-> Pipe a (Either a b) b (StateT (Seq b) m) b
-> Pipe a (Either a b) b (StateT (Seq b) m) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pipe a (Either a b) b (StateT (Seq b) m) b
popper
      x :: b
x :<| xs :: Seq b
xs -> do
        StateT (Seq b) m () -> Pipe a (Either a b) b (StateT (Seq b) m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Seq b) m ()
 -> Pipe a (Either a b) b (StateT (Seq b) m) ())
-> StateT (Seq b) m ()
-> Pipe a (Either a b) b (StateT (Seq b) m) ()
forall a b. (a -> b) -> a -> b
$ Seq b -> StateT (Seq b) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put Seq b
xs
        Either a b -> Pipe a (Either a b) b (StateT (Seq b) m) ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
yield (b -> Either a b
forall a b. b -> Either a b
Right b
x)
        Pipe a (Either a b) b (StateT (Seq b) m) b
popper

-- | A newtype wrapper over a source (@'Pipe' () o 'Void'@) that gives it an
-- alternative 'Applicative' and 'Alternative' instance, matching "ListT
-- done right".
--
-- '<*>' will pair up each output that the sources produce: if you 'await'
-- a value from downstream, it will wait until both paired sources yield
-- before passing them on together.
--
-- '<|>' will completely exhaust the first source before moving on to the
-- next source.
--
-- 'ZipSource' is effectively equivalent to "ListT done right", the true
-- List Monad transformer.  '<|>' is concatentation.  You can use this type
-- with 'lift' to lift a yielding action and '<|>' to sequence yields to
-- implement the pattern described in
-- <http://www.haskellforall.com/2014/11/how-to-build-library-agnostic-streaming.html>,
-- where you can write streaming producers in a polymorphic way, and have
-- it run with pipes, conduit, etc.
--
-- The main difference is that its 'Applicative' instance ("zipping") is
-- different from the traditional 'Applicative' instance for 'ListT'
-- ("all combinations").  Effectively this becomes like a "zipping"
-- 'Applicative' instance for 'ListT'.
--
-- If you want a 'Monad' (or 'Control.Monad.IO.Class.MonadIO') instance,
-- use 'ListT' instead, and convert using 'toListT'/'fromListT' or the
-- 'PipeList' pattern/constructor.
newtype ZipSource m a = ZipSource { ZipSource m a -> Pipe () a Void m ()
getZipSource :: Pipe () a Void m () }

-- | A source is equivalent to a 'ListT' producing a 'Maybe'; this pattern
-- synonym lets you treat it as such.  It essentialyl wraps over 'toListT'
-- and 'fromListT'.
pattern PipeList :: Monad m => ListT m (Maybe a) -> Pipe () a u m ()
pattern $bPipeList :: ListT m (Maybe a) -> Pipe () a u m ()
$mPipeList :: forall r (m :: * -> *) a u.
Monad m =>
Pipe () a u m () -> (ListT m (Maybe a) -> r) -> (Void# -> r) -> r
PipeList xs <- (toListT->xs)
  where
    PipeList xs :: ListT m (Maybe a)
xs = ListT m (Maybe a) -> Pipe () a u m ()
forall (m :: * -> *) o i u.
Monad m =>
ListT m (Maybe o) -> Pipe i o u m ()
fromListT ListT m (Maybe a)
xs
{-# COMPLETE PipeList #-}

instance Functor (ZipSource m) where
    fmap :: (a -> b) -> ZipSource m a -> ZipSource m b
fmap f :: a -> b
f = Pipe () b Void m () -> ZipSource m b
forall (m :: * -> *) a. Pipe () a Void m () -> ZipSource m a
ZipSource (Pipe () b Void m () -> ZipSource m b)
-> (ZipSource m a -> Pipe () b Void m ())
-> ZipSource m a
-> ZipSource m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Pipe () a Void m () -> Pipe () b Void m ()
forall p o i u (m :: * -> *) a.
(p -> o) -> Pipe i p u m a -> Pipe i o u m a
mapOutput a -> b
f (Pipe () a Void m () -> Pipe () b Void m ())
-> (ZipSource m a -> Pipe () a Void m ())
-> ZipSource m a
-> Pipe () b Void m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipSource m a -> Pipe () a Void m ()
forall (m :: * -> *) a. ZipSource m a -> Pipe () a Void m ()
getZipSource

instance Monad m => Applicative (ZipSource m) where
    pure :: a -> ZipSource m a
pure = Pipe () a Void m () -> ZipSource m a
forall (m :: * -> *) a. Pipe () a Void m () -> ZipSource m a
ZipSource (Pipe () a Void m () -> ZipSource m a)
-> (a -> Pipe () a Void m ()) -> a -> ZipSource m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Pipe () a Void m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
yield
    ZipSource p :: Pipe () (a -> b) Void m ()
p <*> :: ZipSource m (a -> b) -> ZipSource m a -> ZipSource m b
<*> ZipSource q :: Pipe () a Void m ()
q = Pipe () b Void m () -> ZipSource m b
forall (m :: * -> *) a. Pipe () a Void m () -> ZipSource m a
ZipSource (Pipe () b Void m () -> ZipSource m b)
-> Pipe () b Void m () -> ZipSource m b
forall a b. (a -> b) -> a -> b
$ Pipe () (a -> b) Void m ()
-> Pipe () a Void m () -> Pipe () b Void m ()
forall (m :: * -> *) a b u v w.
Monad m =>
Pipe () (a -> b) u m () -> Pipe () a v m () -> Pipe () b w m ()
zipSource Pipe () (a -> b) Void m ()
p Pipe () a Void m ()
q

-- | Takes two sources and runs them in parallel, collating their outputs.
--
-- @since 0.2.1.0
zipSource :: Monad m => Pipe () (a -> b) u m () -> Pipe () a v m () -> Pipe () b w m ()
zipSource :: Pipe () (a -> b) u m () -> Pipe () a v m () -> Pipe () b w m ()
zipSource (PipeList fs :: ListT m (Maybe (a -> b))
fs) (PipeList xs :: ListT m (Maybe a)
xs) = ListT m (Maybe b) -> Pipe () b w m ()
forall (m :: * -> *) a u.
Monad m =>
ListT m (Maybe a) -> Pipe () a u m ()
PipeList (ListT m (Maybe b) -> Pipe () b w m ())
-> (ListT m b -> ListT m (Maybe b))
-> ListT m b
-> Pipe () b w m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Maybe b) -> ListT m b -> ListT m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Maybe b
forall a. a -> Maybe a
Just (ListT m b -> Pipe () b w m ()) -> ListT m b -> Pipe () b w m ()
forall a b. (a -> b) -> a -> b
$
    ((a -> b) -> a -> b) -> (a -> b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) ((a -> b, a) -> b) -> ListT m (a -> b, a) -> ListT m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListT m (a -> b) -> ListT m a -> ListT m (a -> b, a)
forall (m :: * -> *) a b.
Monad m =>
ListT m a -> ListT m b -> ListT m (a, b)
LT.zip (ListT m (Maybe (a -> b)) -> ListT m (a -> b)
forall (m :: * -> *) a. Monad m => ListT m (Maybe a) -> ListT m a
concatListT ListT m (Maybe (a -> b))
fs) (ListT m (Maybe a) -> ListT m a
forall (m :: * -> *) a. Monad m => ListT m (Maybe a) -> ListT m a
concatListT ListT m (Maybe a)
xs)

concatListT :: Monad m => ListT m (Maybe a) -> ListT m a
concatListT :: ListT m (Maybe a) -> ListT m a
concatListT xs :: ListT m (Maybe a)
xs = m (Step m a) -> ListT m a
forall (m :: * -> *) a. m (Step m a) -> ListT m a
ListT (m (Step m a) -> ListT m a) -> m (Step m a) -> ListT m a
forall a b. (a -> b) -> a -> b
$ ListT m (Maybe a) -> m (Step m (Maybe a))
forall (m :: * -> *) a. ListT m a -> m (Step m a)
next ListT m (Maybe a)
xs m (Step m (Maybe a))
-> (Step m (Maybe a) -> m (Step m a)) -> m (Step m a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Nil              -> Step m a -> m (Step m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step m a
forall (m :: * -> *) a. Step m a
Nil
    Cons Nothing  ys :: ListT m (Maybe a)
ys -> ListT m a -> m (Step m a)
forall (m :: * -> *) a. ListT m a -> m (Step m a)
next (ListT m (Maybe a) -> ListT m a
forall (m :: * -> *) a. Monad m => ListT m (Maybe a) -> ListT m a
concatListT ListT m (Maybe a)
ys)
    Cons (Just y :: a
y) ys :: ListT m (Maybe a)
ys -> Step m a -> m (Step m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step m a -> m (Step m a)) -> Step m a -> m (Step m a)
forall a b. (a -> b) -> a -> b
$ a -> ListT m a -> Step m a
forall (m :: * -> *) a. a -> ListT m a -> Step m a
Cons a
y (ListT m (Maybe a) -> ListT m a
forall (m :: * -> *) a. Monad m => ListT m (Maybe a) -> ListT m a
concatListT ListT m (Maybe a)
ys)

instance Monad m => Alternative (ZipSource m) where
    empty :: ZipSource m a
empty = Pipe () a Void m () -> ZipSource m a
forall (m :: * -> *) a. Pipe () a Void m () -> ZipSource m a
ZipSource (Pipe () a Void m () -> ZipSource m a)
-> Pipe () a Void m () -> ZipSource m a
forall a b. (a -> b) -> a -> b
$ () -> Pipe () a Void m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ZipSource p :: Pipe () a Void m ()
p <|> :: ZipSource m a -> ZipSource m a -> ZipSource m a
<|> ZipSource q :: Pipe () a Void m ()
q = Pipe () a Void m () -> ZipSource m a
forall (m :: * -> *) a. Pipe () a Void m () -> ZipSource m a
ZipSource (Pipe () a Void m ()
p Pipe () a Void m () -> Pipe () a Void m () -> Pipe () a Void m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Pipe () a Void m ()
q)

instance MonadTrans ZipSource where
    lift :: m a -> ZipSource m a
lift = Pipe () a Void m () -> ZipSource m a
forall (m :: * -> *) a. Pipe () a Void m () -> ZipSource m a
ZipSource (Pipe () a Void m () -> ZipSource m a)
-> (m a -> Pipe () a Void m ()) -> m a -> ZipSource m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Pipe () a Void m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
yield (a -> Pipe () a Void m ())
-> Pipe () a Void m a -> Pipe () a Void m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Pipe () a Void m a -> Pipe () a Void m ())
-> (m a -> Pipe () a Void m a) -> m a -> Pipe () a Void m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Pipe () a Void m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | A source is essentially equivalent to 'ListT' producing a 'Maybe'
-- result.  This converts it to the 'ListT' it encodes.
--
-- See 'ZipSource' for a wrapper over 'Pipe' that gives the right 'Functor'
-- and 'Alternative' instances.
toListT
    :: Applicative m
    => Pipe () o u m ()
    -> ListT m (Maybe o)
toListT :: Pipe () o u m () -> ListT m (Maybe o)
toListT p :: Pipe () o u m ()
p = m (Step m (Maybe o)) -> ListT m (Maybe o)
forall (m :: * -> *) a. m (Step m a) -> ListT m a
ListT (m (Step m (Maybe o)) -> ListT m (Maybe o))
-> m (Step m (Maybe o)) -> ListT m (Maybe o)
forall a b. (a -> b) -> a -> b
$ FT (PipeF () o u) m ()
-> (() -> m (Step m (Maybe o)))
-> (forall x.
    (x -> m (Step m (Maybe o)))
    -> PipeF () o u x -> m (Step m (Maybe o)))
-> m (Step m (Maybe o))
forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
   (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT (Pipe () o u m () -> FT (PipeF () o u) m ()
forall i o u (m :: * -> *) a.
Pipe i o u m a -> FT (PipeF i o u) m a
pipeFree Pipe () o u m ()
p)
    (\_ -> Step m (Maybe o) -> m (Step m (Maybe o))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step m (Maybe o)
forall (m :: * -> *) a. Step m a
Nil)
    (\pNext :: x -> m (Step m (Maybe o))
pNext -> \case
        PAwaitF _ g :: () -> x
g -> Step m (Maybe o) -> m (Step m (Maybe o))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step m (Maybe o) -> m (Step m (Maybe o)))
-> Step m (Maybe o) -> m (Step m (Maybe o))
forall a b. (a -> b) -> a -> b
$ Maybe o -> ListT m (Maybe o) -> Step m (Maybe o)
forall (m :: * -> *) a. a -> ListT m a -> Step m a
Cons Maybe o
forall a. Maybe a
Nothing  (m (Step m (Maybe o)) -> ListT m (Maybe o)
forall (m :: * -> *) a. m (Step m a) -> ListT m a
ListT (m (Step m (Maybe o)) -> ListT m (Maybe o))
-> (x -> m (Step m (Maybe o))) -> x -> ListT m (Maybe o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (Step m (Maybe o))
pNext (x -> ListT m (Maybe o)) -> x -> ListT m (Maybe o)
forall a b. (a -> b) -> a -> b
$ () -> x
g ())
        PYieldF x :: o
x y :: x
y -> Step m (Maybe o) -> m (Step m (Maybe o))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step m (Maybe o) -> m (Step m (Maybe o)))
-> Step m (Maybe o) -> m (Step m (Maybe o))
forall a b. (a -> b) -> a -> b
$ Maybe o -> ListT m (Maybe o) -> Step m (Maybe o)
forall (m :: * -> *) a. a -> ListT m a -> Step m a
Cons (o -> Maybe o
forall a. a -> Maybe a
Just o
x) (m (Step m (Maybe o)) -> ListT m (Maybe o)
forall (m :: * -> *) a. m (Step m a) -> ListT m a
ListT (m (Step m (Maybe o)) -> ListT m (Maybe o))
-> (x -> m (Step m (Maybe o))) -> x -> ListT m (Maybe o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (Step m (Maybe o))
pNext (x -> ListT m (Maybe o)) -> x -> ListT m (Maybe o)
forall a b. (a -> b) -> a -> b
$ x
y   )
    )

-- | A source is essentially 'ListT' producing a 'Maybe' result.  This
-- converts a 'ListT' to the source it encodes.
--
-- See 'ZipSource' for a wrapper over 'Pipe' that gives the right 'Functor'
-- and 'Alternative' instances.
fromListT
    :: Monad m
    => ListT m (Maybe o)
    -> Pipe i o u m ()
fromListT :: ListT m (Maybe o) -> Pipe i o u m ()
fromListT xs :: ListT m (Maybe o)
xs = m (Step m (Maybe o)) -> Pipe i o u m (Step m (Maybe o))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ListT m (Maybe o) -> m (Step m (Maybe o))
forall (m :: * -> *) a. ListT m a -> m (Step m a)
next ListT m (Maybe o)
xs) Pipe i o u m (Step m (Maybe o))
-> (Step m (Maybe o) -> Pipe i o u m ()) -> Pipe i o u m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Nil              -> () -> Pipe i o u m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Cons Nothing  ys :: ListT m (Maybe o)
ys -> ListT m (Maybe o) -> Pipe i o u m ()
forall (m :: * -> *) o i u.
Monad m =>
ListT m (Maybe o) -> Pipe i o u m ()
fromListT ListT m (Maybe o)
ys
      Cons (Just y :: o
y) ys :: ListT m (Maybe o)
ys -> o -> Pipe i o u m ()
forall o i u (m :: * -> *). o -> Pipe i o u m ()
yield o
y Pipe i o u m () -> Pipe i o u m () -> Pipe i o u m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ListT m (Maybe o) -> Pipe i o u m ()
forall (m :: * -> *) o i u.
Monad m =>
ListT m (Maybe o) -> Pipe i o u m ()
fromListT ListT m (Maybe o)
ys

-- | Given a "generator" of @o@ in @m@, return a /source/ that that
-- generator encodes.  Is the inverse of 'withSource'.
--
-- The generator is essentially a church-encoded 'ListT'.
genSource
    :: (forall r. (Maybe (o, m r) -> m r) -> m r)
    -> Pipe i o u m ()
genSource :: (forall r. (Maybe (o, m r) -> m r) -> m r) -> Pipe i o u m ()
genSource f :: forall r. (Maybe (o, m r) -> m r) -> m r
f = FT (PipeF i o u) m () -> Pipe i o u m ()
forall i o u (m :: * -> *) a.
FT (PipeF i o u) m a -> Pipe i o u m a
Pipe (FT (PipeF i o u) m () -> Pipe i o u m ())
-> FT (PipeF i o u) m () -> Pipe i o u m ()
forall a b. (a -> b) -> a -> b
$ (forall r.
 (() -> m r)
 -> (forall x. (x -> m r) -> PipeF i o u x -> m r) -> m r)
-> FT (PipeF i o u) m ()
forall (f :: * -> *) (m :: * -> *) a.
(forall r.
 (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r)
-> FT f m a
FT ((forall r.
  (() -> m r)
  -> (forall x. (x -> m r) -> PipeF i o u x -> m r) -> m r)
 -> FT (PipeF i o u) m ())
-> (forall r.
    (() -> m r)
    -> (forall x. (x -> m r) -> PipeF i o u x -> m r) -> m r)
-> FT (PipeF i o u) m ()
forall a b. (a -> b) -> a -> b
$ \pDone :: () -> m r
pDone pFree :: forall x. (x -> m r) -> PipeF i o u x -> m r
pFree -> (Maybe (o, m r) -> m r) -> m r
forall r. (Maybe (o, m r) -> m r) -> m r
f ((Maybe (o, m r) -> m r) -> m r) -> (Maybe (o, m r) -> m r) -> m r
forall a b. (a -> b) -> a -> b
$ \case
    Nothing      -> () -> m r
pDone ()
    Just (x :: o
x, xs :: m r
xs) -> (m r -> m r) -> PipeF i o u (m r) -> m r
forall x. (x -> m r) -> PipeF i o u x -> m r
pFree m r -> m r
forall a. a -> a
id (o -> m r -> PipeF i o u (m r)
forall i o u a. o -> a -> PipeF i o u a
PYieldF o
x m r
xs)

-- | A source can be "run" by providing a continuation to handle and
-- sequence each of its outputs.  Is ths inverse of 'genSource'.
--
-- This essentially turns a pipe into a church-encoded 'ListT'.
withSource
    :: Pipe () o u m ()
    -> (Maybe (o, m r) -> m r)    -- ^ handler ('Nothing' = done, @'Just' (x, next)@ = yielded value and next action
    -> m r
withSource :: Pipe () o u m () -> (Maybe (o, m r) -> m r) -> m r
withSource p :: Pipe () o u m ()
p f :: Maybe (o, m r) -> m r
f = FT (PipeF () o u) m ()
-> (() -> m r)
-> (forall x. (x -> m r) -> PipeF () o u x -> m r)
-> m r
forall (f :: * -> *) (m :: * -> *) a.
FT f m a
-> forall r.
   (a -> m r) -> (forall x. (x -> m r) -> f x -> m r) -> m r
runFT (Pipe () o u m () -> FT (PipeF () o u) m ()
forall i o u (m :: * -> *) a.
Pipe i o u m a -> FT (PipeF i o u) m a
pipeFree Pipe () o u m ()
p)
    (\_ -> Maybe (o, m r) -> m r
f Maybe (o, m r)
forall a. Maybe a
Nothing)
    (\pNext :: x -> m r
pNext -> \case
        PAwaitF _ g :: () -> x
g -> x -> m r
pNext (x -> m r) -> x -> m r
forall a b. (a -> b) -> a -> b
$ () -> x
g ()
        PYieldF x :: o
x y :: x
y -> Maybe (o, m r) -> m r
f ((o, m r) -> Maybe (o, m r)
forall a. a -> Maybe a
Just (o
x, x -> m r
pNext x
y))
    )

-- | 'ZipSource' is effectively 'ListT' returning a 'Maybe'.  As such, you
-- can use 'unconsZipSource' to "peel off" the first yielded item, if it
-- exists, and return the "rest of the list".
unconsZipSource
    :: Monad m
    => ZipSource m a
    -> m (Maybe (Maybe a, ZipSource m a))
unconsZipSource :: ZipSource m a -> m (Maybe (Maybe a, ZipSource m a))
unconsZipSource (ZipSource (PipeList p :: ListT m (Maybe a)
p)) = ListT m (Maybe a) -> m (Step m (Maybe a))
forall (m :: * -> *) a. ListT m a -> m (Step m a)
next ListT m (Maybe a)
p m (Step m (Maybe a))
-> (Step m (Maybe a) -> Maybe (Maybe a, ZipSource m a))
-> m (Maybe (Maybe a, ZipSource m a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Cons x :: Maybe a
x xs :: ListT m (Maybe a)
xs -> (Maybe a, ZipSource m a) -> Maybe (Maybe a, ZipSource m a)
forall a. a -> Maybe a
Just (Maybe a
x, Pipe () a Void m () -> ZipSource m a
forall (m :: * -> *) a. Pipe () a Void m () -> ZipSource m a
ZipSource (ListT m (Maybe a) -> Pipe () a Void m ()
forall (m :: * -> *) a u.
Monad m =>
ListT m (Maybe a) -> Pipe () a u m ()
PipeList ListT m (Maybe a)
xs))
    Nil       -> Maybe (Maybe a, ZipSource m a)
forall a. Maybe a
Nothing

-- | A newtype wrapper over a sink (@'Pipe' i 'Void'@) that gives it an
-- alternative 'Applicative' and 'Alternative' instance.
--
-- '<*>' will distribute input over both sinks, and output a final result
-- once both sinks finish.
--
-- '<|>' will distribute input over both sinks, and output a final result
-- as soon as one or the other finishes.
newtype ZipSink i u m a = ZipSink { ZipSink i u m a -> Pipe i Void u m a
getZipSink :: Pipe i Void u m a }
  deriving a -> ZipSink i u m b -> ZipSink i u m a
(a -> b) -> ZipSink i u m a -> ZipSink i u m b
(forall a b. (a -> b) -> ZipSink i u m a -> ZipSink i u m b)
-> (forall a b. a -> ZipSink i u m b -> ZipSink i u m a)
-> Functor (ZipSink i u m)
forall a b. a -> ZipSink i u m b -> ZipSink i u m a
forall a b. (a -> b) -> ZipSink i u m a -> ZipSink i u m b
forall i u (m :: * -> *) a b.
a -> ZipSink i u m b -> ZipSink i u m a
forall i u (m :: * -> *) a b.
(a -> b) -> ZipSink i u m a -> ZipSink i u m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ZipSink i u m b -> ZipSink i u m a
$c<$ :: forall i u (m :: * -> *) a b.
a -> ZipSink i u m b -> ZipSink i u m a
fmap :: (a -> b) -> ZipSink i u m a -> ZipSink i u m b
$cfmap :: forall i u (m :: * -> *) a b.
(a -> b) -> ZipSink i u m a -> ZipSink i u m b
Functor

zipSink_
    :: Monad m
    => RecPipe i Void u m (a -> b)
    -> RecPipe i Void u m a
    -> RecPipe i Void u m b
zipSink_ :: RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
zipSink_ p :: RecPipe i Void u m (a -> b)
p q :: RecPipe i Void u m a
q = m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
-> RecPipe i Void u m b
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
 -> RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
-> RecPipe i Void u m b
forall a b. (a -> b) -> a -> b
$ RecPipe i Void u m (a -> b)
-> m (FreeF
        (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b)))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT RecPipe i Void u m (a -> b)
p m (FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b)))
-> (FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b))
    -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \pp :: FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b))
pp -> case FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b))
pp of
    Pure x :: a -> b
x             -> RecPipe i Void u m a
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT RecPipe i Void u m a
q m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> (FreeF (PipeF i Void u) a (RecPipe i Void u m a)
    -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Pure x' :: a
x'              -> FreeF (PipeF i Void u) b (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeF (PipeF i Void u) b (RecPipe i Void u m b)
 -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> (b -> FreeF (PipeF i Void u) b (RecPipe i Void u m b))
-> b
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> FreeF (PipeF i Void u) b (RecPipe i Void u m b)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (b -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> b -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall a b. (a -> b) -> a -> b
$ a -> b
x a
x'
      Free (PAwaitF f' :: u -> RecPipe i Void u m a
f' g' :: i -> RecPipe i Void u m a
g') -> FreeF (PipeF i Void u) b (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeF (PipeF i Void u) b (RecPipe i Void u m b)
 -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> (PipeF i Void u (RecPipe i Void u m b)
    -> FreeF (PipeF i Void u) b (RecPipe i Void u m b))
-> PipeF i Void u (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipeF i Void u (RecPipe i Void u m b)
-> FreeF (PipeF i Void u) b (RecPipe i Void u m b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (PipeF i Void u (RecPipe i Void u m b)
 -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> PipeF i Void u (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall a b. (a -> b) -> a -> b
$
        (u -> RecPipe i Void u m b)
-> (i -> RecPipe i Void u m b)
-> PipeF i Void u (RecPipe i Void u m b)
forall i o u a. (u -> a) -> (i -> a) -> PipeF i o u a
PAwaitF (RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
forall (m :: * -> *) i u a b.
Monad m =>
RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
zipSink_ (m (FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b)))
-> RecPipe i Void u m (a -> b)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b))
-> m (FreeF
        (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b))
pp)) (RecPipe i Void u m a -> RecPipe i Void u m b)
-> (u -> RecPipe i Void u m a) -> u -> RecPipe i Void u m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> RecPipe i Void u m a
f')
                (RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
forall (m :: * -> *) i u a b.
Monad m =>
RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
zipSink_ (m (FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b)))
-> RecPipe i Void u m (a -> b)
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b))
-> m (FreeF
        (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeF (PipeF i Void u) (a -> b) (RecPipe i Void u m (a -> b))
pp)) (RecPipe i Void u m a -> RecPipe i Void u m b)
-> (i -> RecPipe i Void u m a) -> i -> RecPipe i Void u m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> RecPipe i Void u m a
g')
      Free (PYieldF x' :: Void
x' _ ) -> Void -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall a. Void -> a
absurd Void
x'
    Free (PAwaitF f :: u -> RecPipe i Void u m (a -> b)
f g :: i -> RecPipe i Void u m (a -> b)
g) -> RecPipe i Void u m a
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT RecPipe i Void u m a
q m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> (FreeF (PipeF i Void u) a (RecPipe i Void u m a)
    -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \qq :: FreeF (PipeF i Void u) a (RecPipe i Void u m a)
qq -> case FreeF (PipeF i Void u) a (RecPipe i Void u m a)
qq of
      Pure _               -> FreeF (PipeF i Void u) b (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeF (PipeF i Void u) b (RecPipe i Void u m b)
 -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> (PipeF i Void u (RecPipe i Void u m b)
    -> FreeF (PipeF i Void u) b (RecPipe i Void u m b))
-> PipeF i Void u (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipeF i Void u (RecPipe i Void u m b)
-> FreeF (PipeF i Void u) b (RecPipe i Void u m b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (PipeF i Void u (RecPipe i Void u m b)
 -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> PipeF i Void u (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall a b. (a -> b) -> a -> b
$
        (u -> RecPipe i Void u m b)
-> (i -> RecPipe i Void u m b)
-> PipeF i Void u (RecPipe i Void u m b)
forall i o u a. (u -> a) -> (i -> a) -> PipeF i o u a
PAwaitF ((RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
forall (m :: * -> *) i u a b.
Monad m =>
RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
`zipSink_` m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> RecPipe i Void u m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (FreeF (PipeF i Void u) a (RecPipe i Void u m a)
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeF (PipeF i Void u) a (RecPipe i Void u m a)
qq)) (RecPipe i Void u m (a -> b) -> RecPipe i Void u m b)
-> (u -> RecPipe i Void u m (a -> b)) -> u -> RecPipe i Void u m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. u -> RecPipe i Void u m (a -> b)
f)
                ((RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
forall (m :: * -> *) i u a b.
Monad m =>
RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
`zipSink_` m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> RecPipe i Void u m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (FreeF (PipeF i Void u) a (RecPipe i Void u m a)
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure FreeF (PipeF i Void u) a (RecPipe i Void u m a)
qq)) (RecPipe i Void u m (a -> b) -> RecPipe i Void u m b)
-> (i -> RecPipe i Void u m (a -> b)) -> i -> RecPipe i Void u m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> RecPipe i Void u m (a -> b)
g)
      Free (PAwaitF f' :: u -> RecPipe i Void u m a
f' g' :: i -> RecPipe i Void u m a
g') -> FreeF (PipeF i Void u) b (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeF (PipeF i Void u) b (RecPipe i Void u m b)
 -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> (PipeF i Void u (RecPipe i Void u m b)
    -> FreeF (PipeF i Void u) b (RecPipe i Void u m b))
-> PipeF i Void u (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PipeF i Void u (RecPipe i Void u m b)
-> FreeF (PipeF i Void u) b (RecPipe i Void u m b)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (PipeF i Void u (RecPipe i Void u m b)
 -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b)))
-> PipeF i Void u (RecPipe i Void u m b)
-> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall a b. (a -> b) -> a -> b
$
        (u -> RecPipe i Void u m b)
-> (i -> RecPipe i Void u m b)
-> PipeF i Void u (RecPipe i Void u m b)
forall i o u a. (u -> a) -> (i -> a) -> PipeF i o u a
PAwaitF (RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
forall (m :: * -> *) i u a b.
Monad m =>
RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
zipSink_ (RecPipe i Void u m (a -> b)
 -> RecPipe i Void u m a -> RecPipe i Void u m b)
-> (u -> RecPipe i Void u m (a -> b))
-> u
-> RecPipe i Void u m a
-> RecPipe i Void u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> RecPipe i Void u m (a -> b)
f (u -> RecPipe i Void u m a -> RecPipe i Void u m b)
-> (u -> RecPipe i Void u m a) -> u -> RecPipe i Void u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u -> RecPipe i Void u m a
f') (RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
forall (m :: * -> *) i u a b.
Monad m =>
RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
zipSink_ (RecPipe i Void u m (a -> b)
 -> RecPipe i Void u m a -> RecPipe i Void u m b)
-> (i -> RecPipe i Void u m (a -> b))
-> i
-> RecPipe i Void u m a
-> RecPipe i Void u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> RecPipe i Void u m (a -> b)
g (i -> RecPipe i Void u m a -> RecPipe i Void u m b)
-> (i -> RecPipe i Void u m a) -> i -> RecPipe i Void u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> i -> RecPipe i Void u m a
g')
      Free (PYieldF x' :: Void
x' _ ) -> Void -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall a. Void -> a
absurd Void
x'
    Free (PYieldF x :: Void
x _) -> Void -> m (FreeF (PipeF i Void u) b (RecPipe i Void u m b))
forall a. Void -> a
absurd Void
x

altSink_
    :: Monad m
    => RecPipe i Void u m a
    -> RecPipe i Void u m a
    -> RecPipe i Void u m a
altSink_ :: RecPipe i Void u m a
-> RecPipe i Void u m a -> RecPipe i Void u m a
altSink_ p :: RecPipe i Void u m a
p q :: RecPipe i Void u m a
q = m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> RecPipe i Void u m a
forall (f :: * -> *) (m :: * -> *) a.
m (FreeF f a (FreeT f m a)) -> FreeT f m a
FreeT (m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
 -> RecPipe i Void u m a)
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> RecPipe i Void u m a
forall a b. (a -> b) -> a -> b
$ RecPipe i Void u m a
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT RecPipe i Void u m a
p m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> (FreeF (PipeF i Void u) a (RecPipe i Void u m a)
    -> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a)))
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Pure x :: a
x             -> FreeF (PipeF i Void u) a (RecPipe i Void u m a)
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FreeF (PipeF i Void u) a (RecPipe i Void u m a)
 -> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a)))
-> (a -> FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> a
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FreeF (PipeF i Void u) a (RecPipe i Void u m a)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a -> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a)))
-> a -> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall a b. (a -> b) -> a -> b
$ a
x
    Free (PAwaitF f :: u -> RecPipe i Void u m a
f g :: i -> RecPipe i Void u m a
g) -> RecPipe i Void u m a
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (f :: * -> *) (m :: * -> *) a.
FreeT f m a -> m (FreeF f a (FreeT f m a))
runFreeT RecPipe i Void u m a
q m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> (FreeF (PipeF i Void u) a (RecPipe i Void u m a)
    -> FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Pure x' :: a
x'              -> a -> FreeF (PipeF i Void u) a (RecPipe i Void u m a)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure a
x'
      Free (PAwaitF f' :: u -> RecPipe i Void u m a
f' g' :: i -> RecPipe i Void u m a
g') -> PipeF i Void u (RecPipe i Void u m a)
-> FreeF (PipeF i Void u) a (RecPipe i Void u m a)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (PipeF i Void u (RecPipe i Void u m a)
 -> FreeF (PipeF i Void u) a (RecPipe i Void u m a))
-> PipeF i Void u (RecPipe i Void u m a)
-> FreeF (PipeF i Void u) a (RecPipe i Void u m a)
forall a b. (a -> b) -> a -> b
$ (u -> RecPipe i Void u m a)
-> (i -> RecPipe i Void u m a)
-> PipeF i Void u (RecPipe i Void u m a)
forall i o u a. (u -> a) -> (i -> a) -> PipeF i o u a
PAwaitF (RecPipe i Void u m a
-> RecPipe i Void u m a -> RecPipe i Void u m a
forall (m :: * -> *) i u a.
Monad m =>
RecPipe i Void u m a
-> RecPipe i Void u m a -> RecPipe i Void u m a
altSink_ (RecPipe i Void u m a
 -> RecPipe i Void u m a -> RecPipe i Void u m a)
-> (u -> RecPipe i Void u m a)
-> u
-> RecPipe i Void u m a
-> RecPipe i Void u m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> u -> RecPipe i Void u m a
f (u -> RecPipe i Void u m a -> RecPipe i Void u m a)
-> (u -> RecPipe i Void u m a) -> u -> RecPipe i Void u m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> u -> RecPipe i Void u m a
f') (RecPipe i Void u m a
-> RecPipe i Void u m a -> RecPipe i Void u m a
forall (m :: * -> *) i u a.
Monad m =>
RecPipe i Void u m a
-> RecPipe i Void u m a -> RecPipe i Void u m a
altSink_ (RecPipe i Void u m a
 -> RecPipe i Void u m a -> RecPipe i Void u m a)
-> (i -> RecPipe i Void u m a)
-> i
-> RecPipe i Void u m a
-> RecPipe i Void u m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> i -> RecPipe i Void u m a
g (i -> RecPipe i Void u m a -> RecPipe i Void u m a)
-> (i -> RecPipe i Void u m a) -> i -> RecPipe i Void u m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> i -> RecPipe i Void u m a
g')
      Free (PYieldF x' :: Void
x' _ ) -> Void -> FreeF (PipeF i Void u) a (RecPipe i Void u m a)
forall a. Void -> a
absurd Void
x'
    Free (PYieldF x :: Void
x _) -> Void -> m (FreeF (PipeF i Void u) a (RecPipe i Void u m a))
forall a. Void -> a
absurd Void
x

-- | Distribute input to both sinks, and finishes with the final result
-- once both finish.
--
-- Forms an identity with 'pure'.
zipSink
    :: Monad m
    => Pipe i Void u m (a -> b)
    -> Pipe i Void u m a
    -> Pipe i Void u m b
zipSink :: Pipe i Void u m (a -> b) -> Pipe i Void u m a -> Pipe i Void u m b
zipSink (Pipe p :: FT (PipeF i Void u) m (a -> b)
p) (Pipe q :: FT (PipeF i Void u) m a
q) = FT (PipeF i Void u) m b -> Pipe i Void u m b
forall i o u (m :: * -> *) a.
FT (PipeF i o u) m a -> Pipe i o u m a
Pipe (FT (PipeF i Void u) m b -> Pipe i Void u m b)
-> FT (PipeF i Void u) m b -> Pipe i Void u m b
forall a b. (a -> b) -> a -> b
$ FreeT (PipeF i Void u) m b -> FT (PipeF i Void u) m b
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT (FreeT (PipeF i Void u) m b -> FT (PipeF i Void u) m b)
-> FreeT (PipeF i Void u) m b -> FT (PipeF i Void u) m b
forall a b. (a -> b) -> a -> b
$ RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> FreeT (PipeF i Void u) m b
forall (m :: * -> *) i u a b.
Monad m =>
RecPipe i Void u m (a -> b)
-> RecPipe i Void u m a -> RecPipe i Void u m b
zipSink_ (FT (PipeF i Void u) m (a -> b) -> RecPipe i Void u m (a -> b)
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT (PipeF i Void u) m (a -> b)
p) (FT (PipeF i Void u) m a -> RecPipe i Void u m a
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT (PipeF i Void u) m a
q)

-- | Distribute input to both sinks, and finishes with the result of
-- the one that finishes first.
altSink
    :: Monad m
    => Pipe i Void u m a
    -> Pipe i Void u m a
    -> Pipe i Void u m a
altSink :: Pipe i Void u m a -> Pipe i Void u m a -> Pipe i Void u m a
altSink (Pipe p :: FT (PipeF i Void u) m a
p) (Pipe q :: FT (PipeF i Void u) m a
q) = FT (PipeF i Void u) m a -> Pipe i Void u m a
forall i o u (m :: * -> *) a.
FT (PipeF i o u) m a -> Pipe i o u m a
Pipe (FT (PipeF i Void u) m a -> Pipe i Void u m a)
-> FT (PipeF i Void u) m a -> Pipe i Void u m a
forall a b. (a -> b) -> a -> b
$ FreeT (PipeF i Void u) m a -> FT (PipeF i Void u) m a
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
FreeT f m a -> FT f m a
toFT (FreeT (PipeF i Void u) m a -> FT (PipeF i Void u) m a)
-> FreeT (PipeF i Void u) m a -> FT (PipeF i Void u) m a
forall a b. (a -> b) -> a -> b
$ FreeT (PipeF i Void u) m a
-> FreeT (PipeF i Void u) m a -> FreeT (PipeF i Void u) m a
forall (m :: * -> *) i u a.
Monad m =>
RecPipe i Void u m a
-> RecPipe i Void u m a -> RecPipe i Void u m a
altSink_ (FT (PipeF i Void u) m a -> FreeT (PipeF i Void u) m a
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT (PipeF i Void u) m a
p) (FT (PipeF i Void u) m a -> FreeT (PipeF i Void u) m a
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
FT f m a -> FreeT f m a
fromFT FT (PipeF i Void u) m a
q)

-- | '<*>' = distribute input to all, and return result when they finish
--
-- 'pure' = immediately finish
instance Monad m => Applicative (ZipSink i u m) where
    pure :: a -> ZipSink i u m a
pure = Pipe i Void u m a -> ZipSink i u m a
forall i u (m :: * -> *) a. Pipe i Void u m a -> ZipSink i u m a
ZipSink (Pipe i Void u m a -> ZipSink i u m a)
-> (a -> Pipe i Void u m a) -> a -> ZipSink i u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Pipe i Void u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ZipSink p :: Pipe i Void u m (a -> b)
p <*> :: ZipSink i u m (a -> b) -> ZipSink i u m a -> ZipSink i u m b
<*> ZipSink q :: Pipe i Void u m a
q = Pipe i Void u m b -> ZipSink i u m b
forall i u (m :: * -> *) a. Pipe i Void u m a -> ZipSink i u m a
ZipSink (Pipe i Void u m b -> ZipSink i u m b)
-> Pipe i Void u m b -> ZipSink i u m b
forall a b. (a -> b) -> a -> b
$ Pipe i Void u m (a -> b) -> Pipe i Void u m a -> Pipe i Void u m b
forall (m :: * -> *) i u a b.
Monad m =>
Pipe i Void u m (a -> b) -> Pipe i Void u m a -> Pipe i Void u m b
zipSink Pipe i Void u m (a -> b)
p Pipe i Void u m a
q

-- | '<|>' = distribute input to all, and return the first result that
-- finishes
--
-- 'empty' = never finish
instance Monad m => Alternative (ZipSink i u m) where
    empty :: ZipSink i u m a
empty = Pipe i Void u m a -> ZipSink i u m a
forall i u (m :: * -> *) a. Pipe i Void u m a -> ZipSink i u m a
ZipSink Pipe i Void u m a
forall i o u (m :: * -> *) b. Pipe i o u m b
go
      where
        go :: Pipe i o u m b
go = Pipe i o u m (Maybe i) -> Pipe i o u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever Pipe i o u m (Maybe i)
forall i o u (m :: * -> *). Pipe i o u m (Maybe i)
await
    ZipSink p :: Pipe i Void u m a
p <|> :: ZipSink i u m a -> ZipSink i u m a -> ZipSink i u m a
<|> ZipSink q :: Pipe i Void u m a
q = Pipe i Void u m a -> ZipSink i u m a
forall i u (m :: * -> *) a. Pipe i Void u m a -> ZipSink i u m a
ZipSink (Pipe i Void u m a -> ZipSink i u m a)
-> Pipe i Void u m a -> ZipSink i u m a
forall a b. (a -> b) -> a -> b
$ Pipe i Void u m a -> Pipe i Void u m a -> Pipe i Void u m a
forall (m :: * -> *) i u a.
Monad m =>
Pipe i Void u m a -> Pipe i Void u m a -> Pipe i Void u m a
altSink Pipe i Void u m a
p Pipe i Void u m a
q

instance MonadTrans (ZipSink i u) where
    lift :: m a -> ZipSink i u m a
lift = Pipe i Void u m a -> ZipSink i u m a
forall i u (m :: * -> *) a. Pipe i Void u m a -> ZipSink i u m a
ZipSink (Pipe i Void u m a -> ZipSink i u m a)
-> (m a -> Pipe i Void u m a) -> m a -> ZipSink i u m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Pipe i Void u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift