pipes 2.5.0 → 3.0.0

raw patch · 30 files changed

+4656/−3743 lines, 30 filesdep −index-corePVP ok

version bump matches the API change (PVP)

Dependencies removed: index-core

API changes (from Hackage documentation)

Files

• Control/Frame.hs +0/−473
• Control/Frame/Tutorial.hs +0/−487
• Control/IMonad/Trans/Free.hs +0/−56
• Control/MFunctor.hs +45/−3
• Control/PFunctor.hs +32/−0
• Control/Pipe.hs +195/−9
• Control/Pipe/Core.hs +0/−230
• Control/Pipe/Tutorial.hs +0/−539
• Control/Proxy.hs +21/−18
• Control/Proxy/Class.hs +394/−84
• Control/Proxy/Core.hs +31/−203
• Control/Proxy/Core/Correct.hs +186/−0
• Control/Proxy/Core/Fast.hs +238/−0
• Control/Proxy/Pipe.hs +165/−58
• Control/Proxy/Prelude.hs +2/−2
• Control/Proxy/Prelude/Base.hs +598/−198
• Control/Proxy/Prelude/IO.hs +81/−68
• Control/Proxy/Prelude/Kleisli.hs +51/−17
• Control/Proxy/Synonym.hs +66/−0
• Control/Proxy/Trans.hs +52/−19
• Control/Proxy/Trans/Either.hs +102/−49
• Control/Proxy/Trans/Identity.hs +105/−39
• Control/Proxy/Trans/Maybe.hs +95/−38
• Control/Proxy/Trans/Reader.hs +98/−50
• Control/Proxy/Trans/State.hs +99/−51
• Control/Proxy/Trans/Tutorial.hs +0/−415
• Control/Proxy/Trans/Writer.hs +89/−46
• Control/Proxy/Tutorial.hs +1889/−549
• Data/Closed.hs +0/−9
• pipes.cabal +22/−33

@@ -1,473 +0,0 @@-{-|-    'Frame's extend 'Pipe's with:--    * The ability to fold input--    * Prompt and deterministic finalization--    'Frame's differ from 'Pipe's because they form restricted monads rather than-    forming ordinary monads.  This means you must rebind @do@ notation to use-    restricted monads from the @index-core@ package.  See the \"Create Frames\"-    section for details.  For even more details, consult the @index-core@-    package.--}--{-# LANGUAGE GADTs, TypeOperators #-}--module Control.Frame (-    -- * Types-    -- $types-    C,-    O,-    M,-    FrameF(..),-    Frame,-    Stack,-    -- * Create Frames-    -- $create--    -- ** Primitives-    -- $primitives-    yieldF,-    awaitF,-    close,-    -- ** Pipe-like primitives-    -- $pipeprims-    yield,-    await,-    -- * Finalize Frames-    -- $finalization-    catchD,-    catchF,-    finallyD,-    finallyF,-    -- * Compose Frames-    -- $compose-    (<-<),-    (>->),-    idF,-    FrameC(..),-    -- * Run Frames-    -- $run-    runFrame-    ) where--import Control.Category-import Control.IMonad-import Control.IMonad.Trans-import Control.IMonad.Trans.Free-import Control.Monad.Instances ()-import Data.Closed (C)-import Data.Maybe-import Prelude hiding ((.), id)---- For documentation-import Control.Pipe hiding (await, yield, Await, Yield)--{- $types-    The first step to convert 'Pipe' code to 'Frame' code is to translate the-    types.  All types of the form \"@Pipe a b m r@\" become-    \"@Frame b m (M a) C r@\".  For example, given the following type signatures-    from the tutorial:--> printer  :: (Show a) => Pipe b C IO r-> take'    :: Int -> Pipe b b IO ()-> fromList :: (Monad m) => [b] -> Pipe () b m ()--    ... you would replace them with:--> printer  :: (Show a) => Frame C IO (M a) C r-> take'    :: Int -> Frame a IO (M a) C ()-> fromList :: (Monad m) => [a] -> Frame a m (M ()) C ()-> -- To use the finalization example, change fromList's base monad to 'IO'-> fromList :: [a] -> Frame a IO (M ()) C ()--}---- | Index representing an open input end, receiving values of type @a@-data O a = O -- Not exported---- | Index representing an open input end, receiving values of type @Maybe a@-type M a = O (Maybe a)--{-|-    Base functor for a pipe that can close its input end--    * @b@ - Output type--    * @x@ - Next step--    * @i@ - Current step's index--}-data FrameF b x i where-    Yield ::  b -> x    i   -> FrameF b x    i-    Await :: (a -> x (O a)) -> FrameF b x (O a)-    Close ::       x    C   -> FrameF b x (O a)--instance IFunctor (FrameF b) where-    fmapI f p = case p of-        Yield b y -> Yield b (f y)-        Await a   -> Await (f . a)-        Close c   -> Close (f c)--{-|-    A 'Frame' is like a 'Pipe' with an indexed input end:--    * @b@ - The type of the 'Frame's output--    * @m@ - The base monad--    * @i@ - The initial index of the input end ('O'pen or 'C'losed)--    * @j@ - The final index of the input end ('O'pen or 'C'losed)--    * @r@ - The return value--}-type Frame b m i j r = IFreeT (FrameF (m (), b)) (U m) (r := j) i---- | A self-contained 'Frame' that is ready to be run-type Stack m r = Frame C m (M ()) C r---- $create--- The second step to convert 'Pipe' code to 'Frame' code is to change your--- module header to:------ > {-# LANGUAGE RebindableSyntax #-}--- >--- > import Control.IMonad.Do--- > import Control.Frame--- > import Prelude hiding (Monad(..))------ "Control.Frame" replaces all 'Pipe' 'await's and 'yield's with their--- corresponding 'Frame' counterparts.  @Control.IMonad.Do@ rebinds @do@--- notation to work with restricted monads, which also requires using the--- @RebindableSyntax@ extension and hiding the 'Monad' class from the @Prelude@.------ You also must use the restricted monad utility functions, which have the--- same name as their ordinary monad counterparts except with an \'@R@\' suffix,--- such as 'foreverR' instead of 'forever'.  Finally, you must use 'liftU'--- instead of 'lift' to invoke operations in the base monad.------ Finally, every terminating 'Frame' must be 'close'd exactly once before being--- passed to composition.------ > printer = foreverR $ do--- >     a <- await--- >     liftU $ print a--- >--- > take' n = do--- >     replicateMR_ n $ do--- >         a <- await--- >         yield a--- >     close--- >     liftU $ putStrLn "You shall not pass!"--- >--- > fromList xs = do--- >     close--- >     mapMR_ yield xs--{- $primitives-    'yieldF' guards against downstream termination by yielding the most-    up-to-date finalization alongside each value, so that downstream can call-    that finalizer if it terminates before requesting another value.--    'awaitF' intercepts upstream termination by returning a 'Nothing' if-    upstream terminates before providing a value.  Further attempts to request-    input from upstream will terminate the current 'Frame' using the-    return value provided from upstream.--    While 'awaitF' is useful for folds, 'yieldF' is less useful for end-users of-    this library and the higher-order 'catchF' / 'finallyF' finalization-    functions are much more user-friendly.--    Composing two 'Frame's requires that each 'Frame' invokes 'close' exactly-    once.  Anything else will not type-check.  Leave out the 'close' statement-    when writing library components and let the person assembling the components-    for composition specify where the 'close' goes.--    The earlier you 'close' the upstream 'Frame', the earlier it is finalized.-    However, once you 'close' it you may no longer 'await'.--}---- | 'Yield' the most current finalizer for this 'Frame' alongside the value-yieldF :: (Monad m) => m () -> b -> Frame b m i i ()-yieldF m x = liftF $ Yield (m, x) (V ())---- | 'Await' a value from upstream, returning 'Nothing' if upstream terminates-awaitF :: (Monad m) => Frame b m (M a) (M a) (Maybe a)-awaitF = liftF $ Await V---- | 'Close' the input end, calling the finalizers of every upstream 'Frame'-close :: (Monad m) => Frame b m (M a) C ()-close = liftF $ Close (V ())--{- $pipeprims-    The following 'Pipe'-like primitives are built on top of the 'Frame'-    primitives.  They behave identically to their 'Pipe' counterparts and can-    be used as drop-in replacements for them.--}---- | 'yield' a value upstream alongside an empty finalizer-yield :: (Monad m) => b -> Frame b m i i ()-yield = yieldF (return ())---- | 'await' a value from upstream and terminate if upstream terminates-await :: (Monad m) => Frame b m (M a) (M a) a-await = awaitF !>= maybe await returnR--{- $finalization-    The third (and optional) step to convert 'Pipe' code to 'Frame' code is to-    register finalizers for your 'Frame'.  These finalizers may be arbitrarily-    nested:--> printer = foreverR $ catchF (putStrLn "printer interrupted") $ do->     a <- await->     liftU $ print a->-> take' n = finallyF (putStrLn "You shall not pass!") $ do->     replicateMR_ n $ do->         a <- catchF (putStrLn "take' interrupted") await->         yield a->     close->-> fromList xs = catchF (putStrLn "fromList interrupted") $ do->     close->     mapMR_ yield xs--    These convenience functions register block-level finalizers to be called if-    another 'Frame' terminates first.  The naming conventions are:--    * \"catch\" functions (i.e. 'catchD' / 'catchF') call the finalizer only if-      another 'Frame' terminates before the block completes, but will not call-      the finalizer if the block terminates normally.--    * \"finally\" functions (i.e. 'finallyD' / 'finallyF') are like \"catch\"-      functions except that they also call the finalizer if the block terminates-      normally.--    * Functions that end in a \'@D@\' suffix (i.e. 'catchD' / 'finallyD') only-      guard against downstream termination.--    * Functions that end in a \'@F@\' suffix (i.e. 'catchF' / 'finallyF') guard-      against termination in both directions.  You usually want these ones.--    Note that finalization blocks that /begin/ after the 'close' statement may-    only use the \'@D@\'-suffixed version as upstream has been closed off.  This-    is a consequence of a deficiency in Haskell's type system that will take-    time to work around.  However an \'@F@\'-suffixed block that begins before a-    'close' statement may continue through it normally.  So, for code blocks-    after a 'close' statement, use 'catchD' \/ 'finallyD', otherwise use-    'catchF' \/ 'finallyF'.  In future releases, the \'@D@\'-suffixed versions-    will be removed and merged into the \'@F@\'-suffixed versions.--}--{-|-    @catchD m p@ calls the finalizer @m@ if a downstream 'Frame' terminates-    before @p@ finishes.--}-catchD :: (Monad m) => m () -> Frame b m i j r -> Frame b m i j r-catchD m p = IFreeT $ U $ do-    x <- unU $ runIFreeT p-    unU $ runIFreeT $ case x of-        Return r                -> returnI r-        Wrap (Close         p') -> wrap $ Close (catchD m p')-        Wrap (Yield (m', b) p') -> wrap $ Yield (m' >> m, b) (catchD m p')-        Wrap (Await         f ) -> wrap $ Await $ fmap (catchD m) f--{-|-    @catchF m p@ calls the finalizer @m@ if any 'Frame' terminates before @p@-    finishes.--}-catchF :: (Monad m) => m () -> Frame b m (M a) j r -> Frame b m (M a) j r-catchF m p = IFreeT $ U $ do-    x <- unU $ runIFreeT p-    unU $ runIFreeT $ case x of-        Return r                -> returnI r-        Wrap (Close         p') -> wrap $ Close $ catchD m p'-        Wrap (Yield (m', b) p') -> wrap $ Yield (m' >> m, b) (catchF m p')-        Wrap (Await         f ) -> wrap $ Await $ \e -> case e of-            Nothing -> liftU m !> catchF m (f e)-            Just _  ->            catchF m (f e)--{-|-    @finallyD m p@ calls the finalizer @m@ if a downstream 'Frame' terminates-    before @p@ finishes or if @p@ completes normally.--}-finallyD :: (Monad m) => m () -> Frame b m i j r -> Frame b m i j r-finallyD m p = IFreeT $ U $ do-    x <- unU $ runIFreeT p-    unU $ runIFreeT $ case x of-        Return r                -> liftU m !> returnI r-        Wrap (Close         p') -> wrap $ Close (finallyD m p')-        Wrap (Yield (m', b) p') -> wrap $ Yield (m' >> m, b) (finallyD m p')-        Wrap (Await         f ) -> wrap $ Await $ fmap (finallyD m) f--{-|-    @finallyF m p@ calls the finalizer @m@ if any 'Frame' terminates before @p@-    finishes or if @p@ completes normally.--}-finallyF :: (Monad m) => m () -> Frame b m (M a) j r -> Frame b m (M a) j r-finallyF m p = IFreeT $ U $ do-    x <- unU $ runIFreeT p-    unU $ runIFreeT $ case x of-        Return r                -> liftU m !> returnI r-        Wrap (Close         p') -> wrap $ Close $ finallyD m p'-        Wrap (Yield (m', b) p') -> wrap $ Yield (m' >> m, b) (finallyF m p')-        Wrap (Await         f ) -> wrap $ Await $ \e -> case e of-            Nothing -> liftU m !> finallyF m (f e)-            Just _  ->            finallyF m (f e)--(<~<) :: (Monad m)- => IFreeT (FrameF c) (U m) (r := C) (O b)- -> IFreeT (FrameF b) (U m) (r := C) (O a)- -> IFreeT (FrameF c) (U m) (r := C) (O a)-p1 <~< p2 = IFreeT $ U $ do-    x1 <- unU $ runIFreeT p1-    unU $ runIFreeT $ case x1 of-        Wrap (Close   p1') -> wrap $ Close p1'-        Wrap (Yield c p1') -> wrap $ Yield c (p1' <~< p2)-        Wrap (Await   f1 ) -> IFreeT $ U $ do-            x2 <- unU $ runIFreeT p2-            let p1' = IFreeT $ returnI x1-            unU $ runIFreeT $ case x2 of-                Wrap (Close p2')   -> wrap $ Close $ p1' <~| p2'-                Wrap (Yield b p2') -> f1 b <~< p2'-                Wrap (Await f2) -> wrap $ Await $ fmap (\p2'-> p1' <~< p2') f2--(<~|) :: (Monad m)- => IFreeT (FrameF c) (U m) (r := C) (O b)- -> IFreeT (FrameF b) (U m) (r := C)  C- -> IFreeT (FrameF c) (U m) (r := C)  C-p1 <~| p2 = IFreeT $ U $ do-    x1 <- unU $ runIFreeT p1-    unU $ runIFreeT $ case x1 of-        Wrap (Close   p1') -> p1'-        Wrap (Yield c p1') -> wrap $ Yield c (p1' <~| p2)-        Wrap (Await   f1 ) -> IFreeT $ U $ do-            x2 <- unU $ runIFreeT p2-            unU $ runIFreeT $ case x2 of-                Return r           -> returnI r-                Wrap (Yield b p2') -> f1 b <~| p2' --heap :: (Monad m)- => m ()- -> IFreeT (FrameF (m (), c)) (U m) (r := C) (M        b )- -> IFreeT (FrameF (m (), c)) (U m) (r := C) (M (m (), b))-heap m p = IFreeT $ U $ do-    x <- unU $ runIFreeT p-    unU $ runIFreeT $ case x of-        Wrap (Close         p') -> wrap $ Close $ liftU m !> p'-        Wrap (Yield (m', c) p') -> wrap $ Yield (m >> m', c) (heap m p')-        Wrap (Await         f ) -> wrap $ Await $ \e -> case e of-            Nothing      -> heap (return ()) (f  Nothing)-            Just (m', b) -> heap m'          (f $ Just b)--stack :: (Monad m)- => Bool- -> IFreeT (FrameF        b ) (U m) (r := C) (M a)- -> IFreeT (FrameF (Maybe b)) (U m) (r := C) (M a)-stack t p = IFreeT $ U $ do-    x <- unU $ runIFreeT p-    unU $ runIFreeT $ case x of-        Wrap (Close   p') -> wrap $ Close $ warn p'-        Wrap (Yield b p') -> wrap $ Yield (Just b) (stack t p')-        Wrap (Await   f ) ->-            let p' = wrap $ Await $ \e -> stack (isNothing e) (f e)-             in case t of-                    False -> p'-                    True  -> wrap $ Yield Nothing p'--warn :: (Monad m)- => IFreeT (FrameF        b ) (U m) (r := C) C- -> IFreeT (FrameF (Maybe b)) (U m) (r := C) C-warn p = IFreeT $ U $ do-    x <- unU $ runIFreeT p-    unU $ runIFreeT $ case x of-        Return r -> wrap $ Yield Nothing (returnI r)-        Wrap (Yield b p') -> wrap $ Yield (Just b) (warn p')--{- $compose-    The fourth step to convert 'Pipe' code to 'Frame' code is to replace ('<+<')-    with ('<-<'):--> printer <-< take' 3 <-< fromList [1..]--    Like 'Pipe's, Frames form a 'Category' where composition pipes the output-    from the upstream 'Frame' to the input of the downstream 'Frame'.-    Additionally, composition guarantees the following behaviors:--    * 'Frame's receive exactly one 'Nothing' if an upstream 'Frame' terminates.--    * Registered finalizers get called exactly once if a downstream 'Frame'-      terminates.--    * Finalizers are always ordered from upstream to downstream.--    The 'Category' laws cannot be broken, so you don't have to be careful when-    using 'Frame's.--    Note that you may only compose 'Frame's that begin open and end closed.--}---- | Corresponds to ('<<<')/('.') from @Control.Category@-(<-<) :: Monad m- => Frame c m (M b) C r -> Frame b m (M a) C r -> Frame c m (M a) C r-p1 <-< p2 = heap (return ()) p1 <~< stack False p2---- | Corresponds to ('>>>') from @Control.Category@-(>->) :: Monad m- => Frame b m (M a) C r -> Frame c m (M b) C r -> Frame c m (M a) C r-(>->) = flip (<-<)--infixr 9 <-<-infixr 9 >->---- | Corresponds to 'id' from @Control.Category@-idF :: (Monad m) => Frame a m (M a) C r-idF = foreverR $ await !>= yield---- | 'Frame's form a 'Category' instance when you rearrange the type variables-newtype FrameC m r a b = FrameC { unFrameC :: Frame b m (M a) C r }--instance (Monad m) => Category (FrameC m r) where-    id = FrameC idF-    (FrameC p1) . (FrameC p2) = FrameC (p1 <-< p2)--{- $run-    The fifth step to convert 'Pipe' code to 'Frame' code is to use 'runFrame'-    instead of 'runPipe':-->>> runFrame $ printer <-< take' 3 <-< fromList [1..]-1-2-3-fromList interrupted-You shall not pass!-printer interrupted->>> runFrame $ printer <-< take' 3 <-< fromList [1]-1-You shall not pass!-take' interrupted-printer interrupted---}--{-|-    Run the 'Frame' monad transformer, converting it back to the base monad.--    'runFrame' is the 'Frame' equivalent to 'runPipe' and requires a-    self-contained 'Stack'.--}-runFrame :: (Monad m) => Stack m r -> m r-runFrame p = do-    x <- unU $ runIFreeT p-    case x of-        Wrap (Close   p') -> runFrame' p'-        Wrap (Yield _ p') -> runFrame  p'-        Wrap (Await   f ) -> runFrame (f $ Just ())--runFrame' :: (Monad m) => Frame C m C C r -> m r-runFrame' p = do-    x <- unU $ runIFreeT p-    case x of-        Return (V r)      -> return r-        Wrap (Yield _ p') -> runFrame'  p'

@@ -1,487 +0,0 @@-{-|-    This module provides the tutorial for "Control.Frame".--}--module Control.Frame.Tutorial (-    -- * Restricted Monads-    -- $restrict1--    -- $extension--    -- $restrict2--    -- * Type Signatures-    -- $types--    -- * Prompt Finalization-    -- $prompt--    -- * Composition-    -- $compose--    -- * Finalization-    -- $ensure--    -- * Folds-    -- $fold--    -- * Strictness-    -- $strict--    -- * Robustness-    -- $robust-    ) where---- For documentation-import Control.Category-import Control.Frame-import Control.IMonad-import Control.IMonad.Trans-import Control.Monad.Trans.Class-import Control.Pipe hiding (await, yield, Await, Yield)--{- $restrict1-    'Frame's extend 'Pipe's with two new features:--    * Folding input and intercepting upstream termination--    * Guaranteeing prompt and deterministic finalization--    However, these extra features comes with some added complexity: restricted-    monads, also known as indexed monads.  Restricted monads sound scarier than-    they are, so I'll demonstrate that if you are comfortable using monads, then-    you'll be comfortable using restricted monads.--    Let's translate the @take'@ function from the 'Pipe's tutorial into a-    'Frame' to see what changes when we use restricted monads:---}--- $extension--- > {-# LANGUAGE RebindableSyntax #-}--- >--- > import Control.Frame--- > import Control.IMonad.Do--- > import Control.IMonad.Trans--- > import Prelude hiding (Monad(..))--- >--- > take' :: Int -> Frame a IO (M a) C ()--- > take' n = do--- >     replicateMR_ n $ do--- >         x <- await--- >         yield x--- >     close--- >     liftU $ putStrLn "You shall not pass!"-{- $restrict2-    This time I included all imports and highlighted the new @RebindableSyntax@-    extension.  The new imports belong to the @Control.IMonad@ hierarchy from-    the @index-core@ package, which provides the core restricted monad-    functionality.--    Yet, you almost wouldn't even know you were using an restricted monad just-    by looking at the code.  This is because @index-core@ can rebind @do@-    notation to use restricted monads instead of ordinary extensions.  Three-    things make this possible:--    * The @RebindableSyntax@ extension, which allows libraries to override-      @do@ syntax (among other things)--    * The @Control.IMonad.Do@ module which exports the new bindings for @do@-      notation--    * Hiding 'Monad' from the Prelude so that it does not conflict with the-      bindings from @index-core@--    However, you are not obligated to rebind @do@ notation to use 'Frame's.  You-    can choose to keep ordinary @do@ notation and desugar the restricted monad-    by hand.  Just import @Control.IMonad@ instead, drop the @RebindableSyntax@-    extension, and don't hide 'Monad'.  Then you can desugar @take'@ manually-    using the restricted monad operators:--> import Control.Frame-> import Control.IMonad-> import Control.IMonad.Trans->-> take' :: Int -> Frame a IO (M a) C ()-> take' n =->     (replicateMR_ n $->         await !>= \x -> ->         yield x) !>= \_ ->->     close        !>= \_ ->->     liftU $ putStrLn "You shall not pass!"--    However, for this tutorial I will use the @do@ notation, since it's prettier-    and easier to use.--    You'll also notice functions that resemble the ones in @Control.Monad@,-    except with an \'@R@\' suffix on the end of them, like 'replicateMR_'.-    Most functions in @Control.Monad@ have a restricted counterpart provided by-    @Control.IMonad.Restrict@ (which is in turn re-exported by-    @Control.IMonad@), such as 'whenR', 'foreverR', and 'mapMR'.--    Also, every time you lift an operation from the base monad, you must use-    'liftU' instead of 'lift'.  'Frame's are \"restricted monad transformers\",-    and they would normally lift a base restricted monad using 'liftI', but-    they can also lift ordinary monads, too, using 'liftU' (mnemonic: \"lift\"-    an ordinary monad and \'U\'pgrade it to a restricted monad).--}--{- $types-    The 'Frame' type constructor also looks a bit different, too:--> Frame a IO (M a) C ()--    Let's dissect that to understand how 'Frame's work:-->       | Output | Base monad | Initial Input | Final Input | Return Value-> Frame   a        IO           (M a)           C             ()--    'Frame's differ from 'Pipe's in that their input end indexes the beginning-    and end of the operation.  Our @take'@ function starts off with an open-    input end (@M a@), and ends with a closed input end (@C@).--    @take'@ finishes with a closed input end because it called the 'close'-    function, which seals off and finalizes upstream.  You can see that the-    'close' primitive changes the index just by looking at its type:--> close :: Monad m => Frame b m (M a) C ()--    The 'close' instruction begins with an open input end (@M a@) and finishes-    with a closed input end (@C@).  If you tried to call 'close' twice, you'd-    get a type error:--> -- wrong!-> do close->    close--    This prevents you from accidentally finalizing upstream twice.--    'close' is the only primitive that changes the index, and there is no way to-    reopen the input once you have closed it.  'close' also forbids you from-    'await'ing input from upstream after you have already closed it.  If you-    try, you will get a type error--> -- wrong!-> do close->    await--    This prevents you from requesting input from a finalized pipe.  In fact,-    once you 'close' your input end, every upstream 'Frame' disappears-    completely.  You couldn't get input from upstream anyway, even if you-    somehow allowed 'await' statements after 'close'.--    You can check out 'await''s type signature to see why it won't type-check-    after 'close':--> await :: Monad m => Frame b m (M a) (M a) a--    'await' must begin with the input end open (@M a@) and it leaves the input-    end open when done (@M a@).  However, you can still use a 'yield' anywhere:--> yield :: Monad m => b -> Frame b m i i ()--    'yield' will work whether or not the input end is open, and it leaves the-    input end in the same state once 'yield' is done.--}--{- $prompt-    Every 'Frame' must close its input end /exactly/ one time before you can-    compose it with other 'Frame's.  The only exception is if a 'Frame' never-    terminates:--> -- This type-checks because foreverR is polymorphic in the final index-> printer :: (Show b) => Frame C IO (M b) C r-> printer = foreverR $ do->     a <- await->     liftU $ print a--    However, when a 'Frame' no longer needs input then you should 'close' it as-    early as possible.  The earlier you 'close' upstream, the more promptly-    upstream gets finalized.--    If you write a stand-alone producer from start to finish, you can be sure it-    will never need upstream, so you can close it immediately:--> -- I'm keeping fromList's input end polymorphic for a later example-> fromList :: (M.Monad m) => [b] -> Frame b m (M a) C ()-> fromList xs = do->     close->     mapMR_ yield xs--    However, if @fromList@ were a library function, you would remove the 'close'-    statement as you cannot guarantee that your user won't want to 'await' after-    @fromList@.  Or, the user might want to call @fromList@ twice within the-    same 'Frame', and having two close statements would lead to a type error.-    Therefore, a good rule of thumb when writing library code for 'Frame's is to-    always let the user decide when to 'close' the 'Frame' unless you are-    writing a stand-alone 'Frame'.--    So for right now, I will leave the 'close' in @fromList@ for simplicity and-    treat it as a stand-alone 'Frame'.  Also, it will come in handy for a later-    example.--}--{- $compose-    Composition works just like 'Pipe's, except you use the ('<-<') composition-    operator instead of ('<+<'):--> stack :: Stack IO ()-> stack = printer <-< take' 3 <-< fromList [1..]--    The 'Frame' equivalent to 'Pipeline' is a 'Stack' (mnemonic: call stack;-    also the name 'Frame' refers to a call stack frame):--> type Stack m r = Frame C m (M ()) C r--    Similarly, you use 'runFrame' instead of 'runPipe' to convert the 'Frame'-    back to the base monad:-->>> runFrame stack-1-2-3-You shall not pass!--    However, let's carefully inspect the type of composition:--> (<-<) :: Monad m->  => Frame c m (M b) C r->  -> Frame b m (M a) C r->  -> Frame c m (M a) C r--    Each argument 'Frame' must begin in an open state and end in a closed state.-    This means that each 'Frame' in a 'Stack' must call 'close' exactly once-    before it may be used.  'runFrame' has the exact same restriction:--> runFrame :: Monad m => Stack m r -> m r-> runFrame ~  Monad m => Frame C m (M ()) C r -> m r--    Composition specifically requires the user to define when to finalize-    upstream and does not assume this occurs at the end of the 'Frame'.  This-    doesn't pose a problem for stand-alone 'Frame's, since they will know when-    they no longer need input, but smaller library components designed to be-    assembled into larger 'Frame's should let the user decide at the very last-    moment where to 'close' the 'Pipe'.  There is no way to know ahead of time-    where the 'close' should be until the complete 'Frame' has been assembled.--}--{- $ensure-    With 'Frame's in hand, we can now write a safe @read'@ function:--> readFile' :: Handle -> Frame Text IO C C ()-> readFile' h = do->     eof <- liftU $ hIsEOF h->     whenR (not eof) $ do->         s <- liftU $ hGetLine h->         yield s->         readFile' h-> -> read' :: FilePath -> Frame Text IO C C ()-> read' file = do->     liftU $ putStrLn "Opening file..."->     h <- liftU $ openFile file ReadMode->     -- The following requires "import qualified Control.Monad as M"->     finallyD (putStrLn "Closing file ..." M.>> hClose h) $ readFile' h--    The 'finallyD' function registers a block-level finalizer that executes if a-    downstream 'Pipe' terminates or if the block completes normally.  The more-    general 'finallyF' function will call the finalizer if /any/ 'Frame'-    terminates.--    Usually you would always want to use 'finallyF', but because of some type-    limitations you can only use 'finallyD' after a 'Frame' is closed.  A future-    release of this library will fix this and merge 'finallyD' into 'finallyF'.-    So that means that for everything beginning before a 'close' statement, use-    'finallyF', otherwise use 'finallyD'.--    Similarly, you can use the 'catchF' / 'catchD' counterparts to the-    \"finally\" functions.  The \"catch\" functions run the finalizer only if-    another 'Frame' terminates before the block is done, but not if the block-    terminates normally.--    We don't 'close' the @read'@ function because it's not a stand-alone-    'Frame'.  We want to be able to concatenate multiple @read'@s together-    within the same 'Frame', like so:--> files = do->     close->     read' "file1.txt"->     read' "file2.txt"--    So let's assume those two files have the following contents:--    \"@file1.txt@\"--> Line 1-> Line 2-> Line 3--    \"@file2.txt@\"--> A-> B-> C--    We can now check to see if our @files@ producer works:-->>> runFrame $ printer <-< files-Opening file...-"Line1"-"Line2"-"Line3"-Closing file ...-Opening file...-"A"-"B"-"C"-Closing file ...--    More importantly, files are never opened if they aren't demanded and they-    are always properly finalized if the consumer terminates early:-->>> runFrame $ printer <-< take' 2 <-< files-Opening file...-"Line1"-"Line2"-Closing file ...-You shall not pass!--    So we get lazy, deterministic, and prompt resource management.  Nice!---}--{- $fold-    'Frame's can actually do more than just manage finalization!  Using-    'Frame's, we can now correctly implement folds like @toList@ in a way that-    is truly compositional:--> toList :: (M.Monad m) => Frame b m (M a) (M a) [a]-> toList = do->     a' <- awaitF->     case a' of->         Nothing -> return []->         Just a  -> do->             as <- toList->             return (a:as)--    We used one new function this time: 'awaitF'.  This is like 'await' except-    that it returns a 'Nothing' if upstream terminates before 'yield'ing back a-    value.  This allows you to intercept upstream termination and do some-    cleanup, and in our case we use it to end the fold.--    You only receive a 'Nothing' once when you use 'awaitF'.  Any attempt to-    request more input after you receive the first 'Nothing' will terminate the-    current 'Frame' using the upstream return value.  In fact, 'await' is built-    on top of 'awaitF':--> await = do->     a' <- awaitF->     case a' of->         Nothing -> await->         Just a  -> return a--    If it gets a 'Nothing', it just ignores it and 'await's again, choosing to-    not do any cleanup.--    Now let's make sure our @toList@ function works.  I didn't make @toList@ a-    stand-alone 'Frame', so we will have to include a 'close' statement to-    complete it before composing it:--> p1 = do->     xs <- toList->     close->     return (Just xs)->-> p2 xs = do->     fromList xs->     return Nothing -- Remember: they need the same return type-->>> runFrame $ p1 <-< p2 [1..10]-Just [1,2,3,4,5,6,7,8,9,10]--}--{- $strict-    Lazy resource management has one important disadvantage: we can't free the-    resource until downstream no longer needs input.  Many libraries duplicate-    their code to provide Lazy and Strict versions, allowing the user to decide-    if they want:--    * Lazy input, which conserves memory, but holds onto the resource until-      downstream is done processing it--    * Strict input, which loads everything into memory, but can then immediately-      dispose of the resource before the input is processed--    What if there were a way to seamlessly switch between those semantics or-    even choose something in between?  Well, it turns out we can!--    First, we can combine @fromList@ and @toList@ into something even cooler:--> strict :: (M.Monad m) => Frame a m (M a) C ()-> strict = do->     xs <- toList->     fromList xs--    As the name suggests, the @strict@ function is strict in its input.-    @strict@ loads the entire input into memory, finalizes upstream, then-    proceeds to hand the input off to downstream.  We can prove this just by-    using it:-->>> runFrame $ printer <-< strict <-< files-> Opening file...-> Closing file ...-> Opening file...-> Closing file ...-> "Line1"-> "Line2"-> "Line3"-> "A"-> "B"-> "C"--    Both files were disposed of immediately, at the expense of using more-    memory.--    But what if we want something in between strictness and laziness?  Maybe -    something like this:-->>> runFrame $ printer <-< strict <-< take' 2 <-< files-Opening file...-Closing file ...-You shall not pass!-"Line1"-"Line2"--    Now we have the best of both worlds.  We can pick and choose how much of-    our source to strictly load into memory.  In the above example, we specified-    that we wanted to be strict only in the first two lines of our input, and as-    a result the third line of \"@file1.txt@\" is never read and \"@file2.txt@\"-    is never even opened!--    Now we have a way to seamlessly slide anywhere on the spectrum between-    laziness and strictness, and it's all implemented entirely within Haskell-    in a way that is elegant and intuitive without the use of artificial and-    clumsy 'seq' annotations.--}--{- $robust-    The 'Frame' implementation exposes all internals, yet this does not-    compromise safety or invariants in any way.  The library's implementation is-    \"correct-by-construction\", meaning that you can extend it with your own-    features if you so choose, and you never have to worry about accidentally-    breaking any laws, such as the associativity of composition.--    This has the following important practical benefits for finalization and-    folds:--    * Finalizers never get duplicated or dropped--    * Folds can be performed anywhere within the 'Stack', not just at the most-      downstream 'Frame', as the @strict@ example illustrates.--    * You can reason about each 'Frame's finalization behavior completely-      independently of other 'Frame's.--    Composition elegantly handles every single corner case.  This directly-    follows from strictly enforcing the 'Category' laws, because categories have-    no corners!--}

@@ -1,56 +0,0 @@--- | This module is the indexed version of "Control.Monad.Trans.Free"--{-# LANGUAGE KindSignatures, TypeOperators #-}--module Control.IMonad.Trans.Free (-    -- * Free monad transformers-    -- $freet-    IFreeF(..),-    IFreeT(..),-    wrap,-    liftF-    ) where--import Control.Category.Index-import Control.IMonad-import Control.IMonad.Trans--{- $freet-    Indexed free monad transformers lift the constructor signatures to-    the category of indexed Haskell functions: (':->').--> Return ::   r :-> IFreeF f r x-> Wrap   :: f x :-> IFreeF f r x->-> IFreeT :: m (IFreeF f r (IFreeT f m r)) :-> IFreeT f m r--}---- | Indexed equivalent to @FreeF@-data IFreeF f r (x :: * -> *) i = Return (r i) | Wrap (f x i)---- | Indexed equivalent to @FreeT@-newtype IFreeT f m r i = IFreeT { runIFreeT :: m (IFreeF f r (IFreeT f m r)) i }--instance (IFunctor f, IMonad m) => IFunctor (IFreeT f m) where-    fmapI f x = x ?>= returnI . f--instance (IFunctor f, IMonad m) => IMonad (IFreeT f m) where-    returnI = IFreeT . returnI . Return-    bindI f m = IFreeT $-        runIFreeT m ?>= \x ->-        runIFreeT $ case x of-            Return r -> f r-            Wrap   w -> wrap $ fmapI (bindI f) w--instance (IFunctor f) => IMonadTrans (IFreeT f) where-    liftI = IFreeT . fmapI Return---- | Indexed equivalent to @wrap@-wrap :: (IMonad m) => f (IFreeT f m r) :-> IFreeT f m r-wrap = IFreeT . returnI . Wrap---- | Indexed equivalent to @liftF@-liftF :: (IFunctor f, IMonad m) => f r :-> IFreeT f m r-liftF x = wrap $ fmapI returnI x---- FIXME: Add IIdentity so that IFree can be defined in terms of IFreeT

@@ -3,12 +3,54 @@ {-# LANGUAGE Rank2Types #-}  module Control.MFunctor (-    -- * Monads over functors-    MFunctor(..)+    -- * Functors over Monads+    MFunctor(..),+    raise     ) where +import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.Trans.Identity (IdentityT, mapIdentityT)+import Control.Monad.Trans.Maybe (MaybeT, mapMaybeT)+import Control.Monad.Trans.Reader (ReaderT, mapReaderT)+import Control.Monad.Trans.RWS (RWST, mapRWST)+import qualified Control.Monad.Trans.State.Strict as StateStrict+import qualified Control.Monad.Trans.State.Lazy   as StateLazy +import qualified Control.Monad.Trans.Writer.Strict as WriterStrict+import qualified Control.Monad.Trans.Writer.Lazy   as WriterLazy+ -- | A functor in the category of monads class MFunctor t where     {-| Lift a monad morphism from @m@ to @n@ into a monad morphism from         @(t m)@ to @(t n)@ -}-    mapT :: (Monad m, Monad n) => (forall a . m a -> n a) -> t m b -> t n b+    hoist :: (Monad m) => (forall a . m a -> n a) -> t m b -> t n b++instance MFunctor IdentityT where+    hoist nat = mapIdentityT nat++instance MFunctor MaybeT where+    hoist nat = mapMaybeT nat++instance MFunctor (ReaderT r) where+    hoist nat = mapReaderT nat++instance MFunctor (RWST r w s) where+    hoist nat = mapRWST nat++instance MFunctor (StateStrict.StateT s) where+    hoist nat = StateStrict.mapStateT nat++instance MFunctor (StateLazy.StateT s) where+    hoist nat = StateLazy.mapStateT nat++instance MFunctor (WriterStrict.WriterT w) where+    hoist nat = WriterStrict.mapWriterT nat++instance MFunctor (WriterLazy.WriterT w) where+    hoist nat = WriterLazy.mapWriterT nat++{-| Lift the base monad++> raise = hoist lift+-}+raise :: (Monad m, MFunctor t1, MonadTrans t2) => t1 m r -> t1 (t2 m) r+raise = hoist lift

@@ -0,0 +1,32 @@+-- | This module defines functors in the category of proxies++{-# LANGUAGE KindSignatures, Rank2Types #-}++module Control.PFunctor (+    -- * Functors over Proxies+    PFunctor(..),+    raiseP+    ) where++import Control.Proxy.Class (Proxy)+import Control.Proxy.Trans (ProxyTrans(liftP))++-- | A functor in the category of monads+class PFunctor (+    t :: (* -> * -> * -> * -> (* -> *) -> * -> *)+      ->  * -> * -> * -> * -> (* -> *) -> * -> * ) where+    {-| Lift a proxy morphism from @p@ to @q@ into a proxy morphism from+        @(t p)@ to @(t q)@ -}+    hoistP+     :: (Monad m, Proxy p)+     => (forall a' a b' b r1 . p a' a b' b m r1 -> q a' a b' b m r1)+     -> (t p a' a b' b m r2 -> t q a' a b' b m r2)++{-| Lift the base proxy++> raiseP = hoistP liftP+-}+raiseP+ :: (Monad m, Proxy p, PFunctor t1, ProxyTrans t2)+ => t1 p a' a b' b m r -> t1 (t2 p) a' a b' b m r+raiseP = hoistP liftP

@@ -1,14 +1,200 @@--- | Top-level import for the "Control.Pipe" hierarchy+{-| This module remains as a wistful reminder of this library's humble origins.+    This library now builds upon the more general 'Proxy' type, but still keeps+    the @pipes@ name.  Read "Control.Proxy.Tutorial" to learn about this new+    implementation. +    The 'Pipe' type is a monad transformer that enriches the base monad with the+    ability to 'await' or 'yield' data to and from other 'Pipe's. -}+ module Control.Pipe (-    -- * Modules-    -- $modules-    module Control.Pipe.Core+    -- * Types+    -- $types+    Pipe(..),+    Producer,+    Consumer,+    Pipeline,+    -- * Create Pipes+    -- $create+    await,+    yield,+    pipe,+    -- * Compose Pipes+    -- $category+    (<+<),+    (>+>),+    idP,+    PipeC(..),+    -- * Run Pipes+    runPipe     ) where -import Control.Pipe.Core+import Control.Applicative (Applicative(pure, (<*>)))+import Control.Category (Category((.), id), (<<<), (>>>))+import Control.Monad (forever)+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Proxy.Synonym (C)+import Prelude hiding ((.), id) -{- $modules-    "Control.Pipe.Core" provides the core type and primitives.-  -    "Control.Pipe.Tutorial" provides an extended tutorial. -}+{- $types+    The 'Pipe' type is strongly inspired by Mario Blazevic's @Coroutine@ type in+    his concurrency article from Issue 19 of The Monad Reader.+-}++{-|+    The base type for pipes++    * @a@ - The type of input received from upstream pipes++    * @b@ - The type of output delivered to downstream pipes++    * @m@ - The base monad++    * @r@ - The type of the return value+-}+data Pipe a b m r+  = Await (a -> Pipe a b m r)+  | Yield b    (Pipe a b m r)+  | M       (m (Pipe a b m r))+  | Pure r+{-+Technically, the correct implementation that satisfies the monad transformer+laws is:++type PipeF a b x = Await (a -> x) | Yield b x deriving (Functor)++type Pipe a b = FreeT (PipeF a b)+-}++instance (Monad m) => Functor (Pipe a b m) where+    fmap f pr = go pr where+        go p = case p of+            Await   k  -> Await (\a -> go (k a))+            Yield b p' -> Yield b (go p')+            M       m  -> M (m >>= \p' -> return (go p'))+            Pure    r  -> Pure (f r)++instance (Monad m) => Applicative (Pipe a b m) where+    pure = Pure+    pf <*> px = go pf where+        go p = case p of+            Await   k  -> Await (\a -> go (k a))+            Yield b p' -> Yield b (go p')+            M       m  -> M (m >>= \p' -> return (go p'))+            Pure    f  -> fmap f px++instance (Monad m) => Monad (Pipe a b m) where+    return  = Pure+    pm >>= f = go pm where+        go p = case p of+            Await   k  -> Await (\a -> go (k a))+            Yield b p' -> Yield b (go p')+            M       m  -> M (m >>= \p' -> return (go p'))+            Pure    r  -> f r++instance MonadTrans (Pipe a b) where+    lift m = M (m >>= \r -> return (Pure r))++-- | A pipe that produces values+type Producer b m r = Pipe () b m r++-- | A pipe that consumes values+type Consumer a m r = Pipe a C m r++-- | A self-contained pipeline that is ready to be run+type Pipeline m r = Pipe () C m r++{- $create+    'yield' and 'await' are the only two primitives you need to create pipes.+    Since @Pipe a b m@ is a monad, you can assemble 'yield' and 'await'+    statements using ordinary @do@ notation.  Since @Pipe a b@ is also a monad+    transformer, you can use 'lift' to invoke the base monad.  For example, you+    could write a pipe stage that requests permission before forwarding any+    output:++> check :: (Show a) => Pipe a a IO r+> check = forever $ do+>     x <- await+>     lift $ putStrLn $ "Can '" ++ (show x) ++ "' pass?"+>     ok <- read <$> lift getLine+>     when ok (yield x)+-}++{-|+    Wait for input from upstream.++    'await' blocks until input is available from upstream.+-}+await :: Pipe a b m a+await = Await Pure++{-|+    Deliver output downstream.++    'yield' restores control back upstream and binds its value to 'await'.+-}+yield :: b -> Pipe a b m ()+yield b = Yield b (Pure ())++{-|+    Convert a pure function into a pipe++> pipe f = forever $ do+>     x <- await+>     yield (f x)+-}+pipe :: (Monad m) => (a -> b) -> Pipe a b m r+pipe f = go where+    go = Await (\a -> Yield (f a) go)++{- $category+    'Pipe's form a 'Category', meaning that you can compose 'Pipe's using+    ('>+>') and also define an identity 'Pipe': 'idP'.  These satisfy the+    category laws:++> idP >+> p = p+>+> p >+> idP = p+>+> (p1 >+> p2) >+> p3 = p1 >+> (p2 >+> p3)++    @(p1 >+> p2)@ satisfies all 'await's in @p2@ with 'yield's in @p1@.  If any+    'Pipe' terminates the entire 'Pipeline' terminates.+-}++-- | 'Pipe's form a 'Category' instance when you rearrange the type variables+newtype PipeC m r a b = PipeC { unPipeC :: Pipe a b m r}++instance (Monad m) => Category (PipeC m r) where+    id = PipeC idP+    PipeC p1 . PipeC p2 = PipeC $ p1 <+< p2++-- | Corresponds to ('<<<')/('.') from @Control.Category@+(<+<) :: (Monad m) => Pipe b c m r -> Pipe a b m r -> Pipe a c m r+(Yield b p1) <+< p2 = Yield b (p1 <+< p2)+(M       m ) <+< p2 = M (m >>= \p1 -> return (p1 <+< p2))+(Pure    r ) <+< _  = Pure r+(Await   k ) <+< (Yield b p2) = k b <+< p2+p1 <+< (Await k) = Await (\a -> p1 <+< k a)+p1 <+< (M     m) = M (m >>= \p2 -> return (p1 <+< p2))+_  <+< (Pure  r) = Pure r++-- | Corresponds to ('>>>') from @Control.Category@+(>+>) :: (Monad m) => Pipe a b m r -> Pipe b c m r -> Pipe a c m r+p2 >+> p1 = p1 <+< p2++infixr 8 <+<+infixl 8 >+>++-- | Corresponds to 'id' from @Control.Category@+idP :: (Monad m) => Pipe a a m r+idP = go where+    go = Await (\a -> Yield a go)++-- | Run the 'Pipe' monad transformer, converting it back into the base monad+runPipe :: (Monad m) => Pipe () b m r -> m r+runPipe pl = go pl where+    go p = case p of+       Yield _ p' -> go p' +       Await   k  -> go (k ())+       M       m  -> m >>= go+       Pure    r  -> return r

@@ -1,230 +0,0 @@-{-| The 'Pipe' type is a monad transformer that enriches the base monad with the-    ability to 'await' or 'yield' data to and from other 'Pipe's. -}--module Control.Pipe.Core (-    -- * Types-    -- $types-    Pipe(..),-    C,-    Producer,-    Consumer,-    Pipeline,-    -- * Create Pipes-    -- $create-    await,-    yield,-    pipe,-    -- * Compose Pipes-    -- $category-    (<+<),-    (>+>),-    idP,-    PipeC(..),-    -- * Run Pipes-    -- $runpipe-    runPipe-    ) where--import Control.Applicative (Applicative(pure, (<*>)))-import Control.Category (Category((.), id), (<<<), (>>>))-import Control.Monad (forever)-import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Closed (C)-import Prelude hiding ((.), id)--{- $types-    The 'Pipe' type is strongly inspired by Mario Blazevic's @Coroutine@ type in-    his concurrency article from Issue 19 of The Monad Reader.--}--{-|-    The base type for pipes--    * @a@ - The type of input received from upstream pipes--    * @b@ - The type of output delivered to downstream pipes--    * @m@ - The base monad--    * @r@ - The type of the return value--}-data Pipe a b m r-  = Await (a -> Pipe a b m r)-  | Yield b    (Pipe a b m r)-  | M       (m (Pipe a b m r))-  | Pure r-{--type PipeF a b x = Await (a -> x) | Yield b x deriving (Functor)--type Pipe a b = FreeT (PipeF a b)--}--instance (Monad m) => Functor (Pipe a b m) where-    fmap f pr = go pr where-        go p = case p of-            Await   k  -> Await (\a -> go (k a))-            Yield b p' -> Yield b (go p')-            M       m  -> M (m >>= \p' -> return (go p'))-            Pure    r  -> Pure (f r)--instance (Monad m) => Applicative (Pipe a b m) where-    pure = Pure-    pf <*> px = go pf where-        go p = case p of-            Await   k  -> Await (\a -> go (k a))-            Yield b p' -> Yield b (go p')-            M       m  -> M (m >>= \p' -> return (go p'))-            Pure    f  -> fmap f px--instance (Monad m) => Monad (Pipe a b m) where-    return  = Pure-    pm >>= f = go pm where-        go p = case p of-            Await   k  -> Await (\a -> go (k a))-            Yield b p' -> Yield b (go p')-            M       m  -> M (m >>= \p' -> return (go p'))-            Pure    r  -> f r--instance MonadTrans (Pipe a b) where-    lift m = M (m >>= \r -> return (Pure r))---- | A pipe that produces values-type Producer b = Pipe () b---- | A pipe that consumes values-type Consumer b = Pipe b C---- | A self-contained pipeline that is ready to be run-type Pipeline = Pipe () C--{- $create-    'yield' and 'await' are the only two primitives you need to create pipes.-    Since @Pipe a b m@ is a monad, you can assemble 'yield' and 'await'-    statements using ordinary @do@ notation.  Since @Pipe a b@ is also a monad-    transformer, you can use 'lift' to invoke the base monad.  For example, you-    could write a pipe stage that requests permission before forwarding any-    output:--> check :: (Show a) => Pipe a a IO r-> check = forever $ do->     x <- await->     lift $ putStrLn $ "Can '" ++ (show x) ++ "' pass?"->     ok <- read <$> lift getLine->     when ok (yield x)--}--{-|-    Wait for input from upstream.--    'await' blocks until input is available from upstream.--}-await :: Pipe a b m a-await = Await Pure--{-|-    Deliver output downstream.--    'yield' restores control back upstream and binds the result to 'await'.--}-yield :: b -> Pipe a b m ()-yield b = Yield b (Pure ())--{-|-    Convert a pure function into a pipe--> pipe f = forever $ do->     x <- await->     yield (f x)--}-pipe :: (Monad m) => (a -> b) -> Pipe a b m r-pipe f = go where-    go = Await (\a -> Yield (f a) go)--{- $category-    'Pipe's form a 'Category', meaning that you can compose 'Pipe's using-    ('<+<') and also define an identity 'Pipe': 'idP'.  These satisfy the-    category laws:--> idP <+< p = p->-> p <+< idP = p->-> (p1 <+< p2) <+< p3 = p1 <+< (p2 <+< p3)--    'Pipe' composition binds the output of the upstream 'Pipe' to the input of-    the downstream 'Pipe'.  Like Haskell functions, 'Pipe's are lazy, meaning-    that upstream 'Pipe's are only evaluated as far as necessary to generate-    enough input for downstream 'Pipe's.  If any 'Pipe' terminates, it also-    terminates every 'Pipe' composed with it.--}---- | 'Pipe's form a 'Category' instance when you rearrange the type variables-newtype PipeC m r a b = PipeC { unPipeC :: Pipe a b m r}--instance (Monad m) => Category (PipeC m r) where-    id = PipeC idP-    PipeC p1 . PipeC p2 = PipeC $ p1 <+< p2---- | Corresponds to ('<<<')/('.') from @Control.Category@-(<+<) :: (Monad m) => Pipe b c m r -> Pipe a b m r -> Pipe a c m r-(Yield b p1) <+< p2 = Yield b (p1 <+< p2)-(M       m ) <+< p2 = M (m >>= \p1 -> return (p1 <+< p2))-(Pure    r ) <+< _  = Pure r-(Await   k ) <+< (Yield b p2) = k b <+< p2-p1 <+< (Await k) = Await (\a -> p1 <+< k a)-p1 <+< (M     m) = M (m >>= \p2 -> return (p1 <+< p2))-_  <+< (Pure  r) = Pure r---- | Corresponds to ('>>>') from @Control.Category@-(>+>) :: (Monad m) => Pipe a b m r -> Pipe b c m r -> Pipe a c m r-p2 >+> p1 = p1 <+< p2--{- These associativities might help performance since pipe evaluation is-   downstream-biased.  I set them to the same priority as (.). -}-infixr 9 <+<-infixl 9 >+>---- | Corresponds to 'id' from @Control.Category@-idP :: (Monad m) => Pipe a a m r-idP = go where-    go = Await (\a -> Yield a go)--{- $runpipe-    Note that you can also unwrap a 'Pipe' a single step at a time using-    'runFreeT' (since 'Pipe' is just a type synonym for a free monad-    transformer).  This will take you to the next /external/ 'await' or 'yield'-    statement.  This means that a closed 'Pipeline' will unwrap to a single-    step, in which case you would have been better served by 'runPipe'.--}-{-|-    Run the 'Pipe' monad transformer, converting it back into the base monad.--    'runPipe' imposes two conditions:--    * The pipe's input, if any, is trivially satisfiable (i.e. @()@)--    * The pipe does not 'yield' any output--    The latter restriction makes 'runPipe' less polymorphic than it could be,-    and I settled on the restriction for three reasons:--    * It prevents against accidental data loss.--    * It protects against silent failures--    * It prevents wastefully draining a scarce resource by gratuitously-      driving it to completion--    If you believe that discarding output is the appropriate behavior, you can-    specify this by explicitly feeding your output to a pipe that gratuitously-    discards it:--> runPipe $ forever await <+< p--}-runPipe :: (Monad m) => Pipeline m r -> m r-runPipe pl = go pl where-    go p = case p of-       Yield _ p' -> go p' -       Await   k  -> go (k ())-       M       m  -> m >>= go-       Pure    r  -> return r

@@ -1,539 +0,0 @@-{-|-    This module provides the tutorial for "Control.Pipe".--}--module Control.Pipe.Tutorial (-    -- * Types-    -- $type--    -- * Composition-    -- $compose--    -- * Modularity-    -- $modular--    -- * Vertical Concatenation-    -- $vertical--    -- * Return Values-    -- $return--    -- * Termination-    -- $terminate--    -- * Folds-    -- $folds--    -- * Resource Management-    -- $resource--    -- * Bidirectional Pipes-    -- $bidirectional-    ) where---- For documentation-import Control.Category-import Control.Frame hiding (await, yield)-import Control.Monad.Trans.Class-import Control.Pipe--{- $type-    This library represents unidirectional streaming computations using  the-    'Pipe' type.--    'Pipe' is a monad transformer that extends the base monad with the ability-    to 'await' input from or 'yield' output to other 'Pipe's.  'Pipe's resemble-    enumeratees in other libraries because they receive an input stream and-    transform it into a new output stream.--    I'll introduce our first 'Pipe', which is a verbose version of the Prelude's-    'take' function:--> take' :: Int -> Pipe a a IO ()-> take' n = do->     replicateM_ n $ do->         x <- await->         yield x->     lift $ putStrLn "You shall not pass!"--    This 'Pipe' forwards the first @n@ values it receives undisturbed, then it-    outputs a cute message.--    Let's dissect the above 'Pipe''s type to learn a bit about how 'Pipe's work:-->      | Input Type | Output Type | Base monad | Return value-> Pipe   a            a             IO           ()--    So @take'@ 'await's input values of type \'@a@\' from upstream 'Pipe's and-    'yield's output values of type \'@a@\' to downstream 'Pipe's.  @take'@ uses-    'IO' as its base monad because it invokes the 'putStrLn' function.  If we-    were to remove the call to 'putStrLn', the compiler would infer the-    following type instead, which is polymorphic in the base monad:--> take' :: (Monad m) => Int -> Pipe a a m ()--    Now let's create a function that converts a list into a 'Pipe' by 'yield'ing-    each element of the list:--> fromList :: (Monad m) => [b] -> Pipe a b m ()-> fromList = mapM_ yield--    Note that @fromList xs@ is polymorphic in its input.  This is because it-    does not 'await' any input.  If we wanted, we could type-restrict it to:--> fromList :: (Monad m) => [b] -> Pipe () b m ()--    There is no type that forbids a 'Pipe' from 'await'ing, but you can-    guarantee that if it does 'await', the request is trivially satisfiable by-    supplying it with @()@.--    A 'Pipe' that doesn't 'await' (any useful input) can serve as the first-    stage in a 'Pipeline'.  I provide a type synonym for this common case:--> type Producer b m r = Pipe () b m r--    'Producer's resemble enumerators in other libraries because they function as-    data sources.--    You can then use the 'Producer' type synonym to rewrite the type signature-    for @fromList@ as:--> fromList :: (Monad m) => [b] -> Producer b m ()--    Now let's create a 'Pipe' that prints every value delivered to it:--> printer :: (Show b) => Pipe b c IO r-> printer = forever $ do->     x <- await->     lift $ print x--    Here, @printer@ is polymorphic in its output.  We could type-restrict it to-    guarantee it will never 'yield' by setting the output to 'C', an unhabited-    type that \'@C@\'loses the output end:--> printer :: (Show b) => Pipe b C IO r--    A 'Pipe' that never 'yield's can be the final stage in a 'Pipeline'.  Again,-    I provide a type synonym for this common case:--> type Consumer b m r = Pipe b C m r--    So we could instead write @printer@'s type as:--> printer :: (Show b) => Consumer b IO r--    'Consumer's resemble iteratees in other libraries because they function as-    data sinks.--}--{- $compose-    What distinguishes 'Pipe's from every other iteratee implementation is that-    they form a true 'Category'.  Because of this, you can literally compose-    'Pipe's into 'Pipeline's using ordinary composition:--> newtype PipeC m r a b = PipeC { unPipeC :: Pipe a b m r }-> instance Category (PipeC m r) where ...--    For example, you can compose the above 'Pipe's with:--> pipeline :: Pipe () C IO ()-> pipeline = unPipeC $ PipeC printer . PipeC (take' 3) . PipeC (fromList [1..])--    The compiler deduces that the final 'Pipe' must be blocked at both ends,-    meaning it will never 'await' useful input and it will never 'yield' any-    output.  This represents a self-contained 'Pipeline' and I provide a type-    synonym for this common case:--> type Pipeline m r = Pipe () C m r--    Also, I provide '<+<' as a convenience operator for composing 'Pipe's-    without the burden of wrapping and unwrapping newtypes:--> p1 <+< p2 == unPipeC $ PipeC p1 . PipeC p2--    So you can rewrite @pipeline@ as:--> pipeline :: Pipeline IO ()-> pipeline = printer <+< take' 3 <+< fromList [1..]--    Like many other monad transformers, you convert the 'Pipe' monad back to the-    base monad using some sort of \"@run...@\" function.  In this case, it's the-    'runPipe' function:--> runPipe :: (Monad m) => Pipeline m r -> m r--    'runPipe' only works on self-contained 'Pipeline's, but you don't need to-    worry about explicitly type-restricting any of your 'Pipe's.  Self-contained-    'Pipeline's will automatically have polymorphic input and output ends and-    they will type-check when you provide them to 'runPipe'.--    Let's try using 'runPipe':-->>> runPipe pipeline-1-2-3-You shall not pass!--    Fascinating!  Our 'Pipe' terminates even though @printer@ never terminates-    and @fromList@ never terminates when given an infinite list.  To illustrate-    why our 'Pipe' terminates, let's outline the 'Pipe' flow control rules for-    composition:--    * 'Pipe's are lazy, so execution begins at the most downstream 'Pipe'-      (@printer@ in our example).--    * When a 'Pipe' 'await's, it blocks until it receives input from the next-      'Pipe' upstream--    * When a 'Pipe' 'yield's, it blocks until it receives a new 'await' request-      from downstream.--    * If a 'Pipe' terminates, it terminates every other 'Pipe' composed with it.--    All of these flow control rules uniquely follow from the 'Category' laws.--    It might surprise you that termination brings down the entire 'Pipeline'-    until you realize that:--    * Downstream 'Pipe's depending on the result from the terminated 'Pipe'-      cannot proceed--    * Upstream 'Pipe's won't be further evaluated because the terminated 'Pipe'-      will not request any further input from them--    So in our previous example, the 'Pipeline' terminated because \"@take' 3@\"-    terminated and brought down the entire 'Pipeline' with it.--    Actually, these flow control rules will mislead you into thinking that-    composed 'Pipe's behave as a collection of sub-'Pipe's with some sort of-    message passing architecture between them, but nothing could be further from-    the truth! When you compose 'Pipe's, they automatically fuse into a single-    'Pipe' that corresponds to how you would have written the control flow by-    hand.--    For example, if you compose @printer@ and @fromList@:--> printer <+< fromList [1..]--    The result is indistinguishable from:--> lift (mapM_ print [1..])--    ... which is what we would have written by hand if we had not used 'Pipe's-    at all!  All 'runPipe' does is just remove the 'lift'!--}--{- $modular-    Given a loop like:--> loop :: IO r-> loop = forever $ do->     x <- dataSource->     y <- processData x->     dataSink y--    We could decompose it into three separate parts:--> stage1 :: Producer a IO r-> stage1 = forever $ do->     x <- dataSource->     yield x->-> stage2 :: Pipe a b IO r-> stage2 = forever $ do->     x <- await->     y <- processData x->     yield y->->-> stage3 :: Consumer b IO r-> stage3 = forever $ do->     y <- await->     dataSink y->-> stage3 <+< stage2 <+< stage1 = lift loop--    In other words, 'Pipe's let you decompose loops into modular components,-    which promotes loose coupling and allows you to freely mix and match those-    components.--    To demonstrate this, let's define a new data source that indefinitely-    prompts the user for integers:--> prompt :: Producer Int IO a-> prompt = forever $ do->     lift $ putStrLn "Enter a number: "->     n <- read <$> lift getLine->     yield n--    Now we can use it as a drop-in replacement for @fromList@:-->>> runPipe $ printer <+< take' 3 <+< prompt-Enter a number:-1<Enter>-1-Enter a number:-2<Enter>-2-Enter a number:-3<Enter>-3-You shall not pass!---}--{- $vertical-    You can easily \"vertically\" concatenate 'Pipe's, 'Producer's, and-    'Consumer's, all using simple monad sequencing: ('>>').  For example, here-    is how you concatenate 'Producer's:-->>> runPipe $ printer <+< (fromList [1..3] >> fromList [10..12])-1-2-3-10-11-12--    Here's how you would concatenate 'Consumer's:-->>> let print' n = printer <+< take' n :: (Show a) => Int -> Consumer a IO ()->>> runPipe $ (print' 3 >> print' 4) <+< fromList [1..]-1-2-3-You shall not pass!-4-5-6-7-You shall not pass!--   ... but the above example is gratuitous because we could have just-   concatenated the intermediate @take'@ 'Pipe':-->>> runPipe $ printer <+< (take' 3 >> take' 4) <+< fromList [1..]-1-2-3-You shall not pass!-4-5-6-7-You shall not pass!---}--{- $return-    'Pipe' composition imposes an important requirement: You can only compose-    'Pipe's that have the same return type.  For example, I could write the-    following function:--> deliver :: (Monad m) => Int -> Consumer a m [a]-> deliver n = replicateM n await--    ... and I might try to compose it with @fromList@:-->>> runPipe $ deliver 3 <+< fromList [1..10] -- wrong!--    ... but this wouldn't type-check, because @fromList@ has a return type of-    @()@ and @deliver@ has a return type of @[Int]@.  Composition requires that-    every 'Pipe' has a return value ready in case it terminates first.--    Fortunately, we don't have to rewrite the @fromList@ function because we can-    just add a return value using vertical concatenation:-->>> runPipe $ deliver 3 <+< (fromList [1..10] >> return [])-[1,2,3]--    ... although a more idiomatic Haskell version would be:-->>> runPipe $ (Just <$> deliver 3) <+< (fromList [1..10] *> pure Nothing)-Just [1,2,3]--    This forces you to cover all code paths by thinking about what return value-    you would provide if something were to go wrong.  For example, let's say I-    were to make a mistake and request more input than @fromList@ can deliver:-->>> runPipe $ (Just <$> deliver 99) <+< (fromList [1..10] *> pure Nothing)-Nothing--    The type system saved me by forcing me to cover all corner cases and handle-    every way my program could terminate.--}--{- $terminate--    Now what if you wanted to write a 'Pipe' that only reads from its input end-    (i.e. a 'Consumer') and returns a list of every value delivered to it when-    its input 'Pipe' terminates?--> toList :: (Monad m) => Consumer a m [a]-> toList = ???--    You can't write such a 'Pipe' because if its input terminates then it brings-    down @toList@ with it!  This is correct because @toList@ as defined is not-    compositional (yet!).--    To see why, let's say you somehow got @toList@ to work and the following-    imaginary code sample worked:-->>> runPipe $ toList <+< (fromList [1..5] >> return [])-[1,2,3,4,5]--    @toList@ is defined to return its value when the 'Pipe' immediately upstream-    (@fromList@ in this case) terminates.  This behavior immediately leads to a-    problem.  What if I were to insert an \"identity\" 'Pipe' between @toList@-    and @fromList@:--> identity = forever $ await >>= yield-> -- This is how id is actually implemented!--    This 'Pipe' forwards every valued untouched, so we would expect it to not-    have any affect if we were to insert it in the middle:-->>> runPipe $ toList <+< identity <+< (fromList [1..5] >> return [])-??? -- Oops! Something other than [1,2,3,4,5], perhaps even non-termination--    The answer couldn't be @[1,2,3,4,5]@ because @toList@ would monitor -    @identity@ instead of @fromList@ and since @identity@ never terminates-    @toList@ never terminates.  This is what I mean when I say that @toList@'s-    specified behavior is non-compositional.  It only works if it is coupled-    directly to the desired 'Pipe' and breaks when you introduce intermediate-    stages.--    Note that a terminated 'Pipe' only brings down 'Pipe's composed with it.  To-    illustrate this, let's use the following example:--> p = do a <+< b->        c--    @a@, @b@, and @c@ are 'Pipe's, and @c@ shares the same input and output as-    the composite 'Pipe' @a <+< b@, otherwise we cannot combine them within the-    same monad.  In the above example, either @a@ or @b@ could terminate and-    bring down the other one since they are composed, but @c@ is guaranteed to-    continue after @a <+< b@ terminates because it is not composed with them.-    Conceptually, we can think of this as @c@ automatically taking over the-    'Pipe''s channeling responsibilities when @a <+< b@ can no longer continue.-    There is no need to \"restart\" the input or output manually as in some-    other iteratee libraries.--    The @pipes@ library, unlike other iteratee libraries, grounds its vertical-    and horizontal concatenation in category theory by deriving horizontal-    concatenation ('.') from its 'Category' instance and vertical concatenation-    ('>>') from its 'Monad' instance.  This makes it easier to reason about-    'Pipe's because you can leverage your intuition about 'Category's and-    'Monad's to understand their behavior.  The only 'Pipe'-specific primitives-    are 'await' and 'yield'.--}--{- $folds-    While we cannot intercept termination, we can still fold our input.  We can-    embed 'WriterT' in our base monad, since 'Pipe' is a monad transformer, and-    store the result in the monoid:--> toList :: Consumer a (WriterT [a] m) r-> toList = forever $ do->     a <- await->     lift $ tell [a]-->>> execWriterT $ runPipe $ toList <+< fromList [1..4]-[1,2,3,4]--    But what if other pipes have a base monad that is not compatible, such as:--> prompt3 :: Producer Int IO a-> prompt3 = take' 3 <+< prompt--    That's okay, because we can transparently 'lift' any Pipe's base monad,-    using 'hoistFreeT' from @Control.Monad.Trans.Free@ in the @free@ package:-->>> execWriterT $ runPipe $ toList <+< hoistFreeT lift prompt3-3<Enter>-4<Enter>-6<Enter>-[3,4,6]---}--{- $resource-    Pipes handle streaming computations well, but do not handle resource-    management well.  To see why, let's say we have the file \"@test.txt@\"-    with the following contents:--> Line 1-> Line 2-> Line 3--  .. and we wish to lazily read one line at a time from it:--> readFile' :: Handle -> Producer Text IO ()-> readFile' h = do->     eof <- lift $ hIsEOF h->     when (not eof) $ do->         s <- lift $ hGetLine h->         yield s->         readFile' h--    We could then try to be slick and write a lazy version that only reads as-    many lines as we request:--> read' :: FilePath -> Producer Text IO ()-> read' file = do->     lift $ putStrLn "Opening file ..."->     h <- lift $ openFile file ReadMode->     readFile' h->     lift $ putStrLn "Closing file ..."->     lift $ hClose h--    Now compose!-->>> runPipe $ printer <+< read' "test.xt"-Opening file ...-"Line 1"-"Line 2"-"Line 3"-Closing file ...--    So far, so good.  Equally important, the file is never opened if we replace-    @printer@ with a 'Pipe' that never demands input:-->>> runPipe $ (lift $ putStrLn "I don't need input") <+< read' "test.txt"-I don't need input--    There is still one problem, though. What if we wrote:-->>> runPipe $ printer <+< take' 2 <+< read' "test.txt"-Opening file ...-"Line 1"-"Line 2"-You shall not pass!--    Oh no!  While it was lazy and only read two lines from the file, it was also-    too lazy to properly close our file!  \"@take' 2@\" terminated before-    @read'@, preventing @read'@ from properly closing \"test.txt\".  This is why-    'Pipe' composition fails to guarantee deterministic finalization.--    The "Control.Frame" module of this library provides a temporary solution to-    this problem, but in the longer run there will be a more elegant solution-    built on top of "Control.Proxy".--}--{- $bidirectional-    The 'Pipe' type suffers from one restriction: it only handles a-    unidirectional flow of information.  If you want a bidirectional 'Pipe'-    type, then use the 'Proxy' type from "Control.Proxy", which generalizes the-    'Pipe' type to bidirectional flow.--    More importantly, the 'Proxy' type is a strict superset of the 'Pipe' type,-    so all 'Pipe' utilities and extensions are actually written as 'Proxy'-    utilities and extensions, in order to avoid code duplication.--    So if you want to use these extensions, import "Control.Proxy" instead,-    which exports a backwards compatible 'Pipe' implementation along with all-    utilities and extensions.  The 'Pipe' implementation in "Control.Pipe.Core"-    exists purely as a reference implementation for people who wish to study the-    simpler 'Pipe' type when building their own iteratee libraries.--}

@@ -1,32 +1,35 @@--- | Default imports for the "Control.Proxy" hierarchy+{-| Recommended entry import for this library +    Read "Control.Proxy.Tutorial" for an extended proxy tutorial. -}+ module Control.Proxy (     -- * Modules-    -- $modules-    module Control.Proxy.Class,+    -- $default     module Control.Proxy.Core,-    module Control.Proxy.Pipe,-    module Control.Proxy.Trans,-    module Control.Proxy.Prelude+    module Control.Proxy.Core.Fast     ) where -import Control.Proxy.Class import Control.Proxy.Core-import Control.Proxy.Pipe-import Control.Proxy.Trans-import Control.Proxy.Prelude+import Control.Proxy.Core.Fast hiding (Request, Respond, M, Pure) -{- $modules-    "Control.Proxy.Core" provides the core 'Proxy' type.+{- $default+    "Control.Proxy.Core" exports everything except 'runProxy'. -    "Control.Proxy.Class" provides the abstract interface to 'Proxy' operations.+    This library provides two base proxy implementations, each of which export+    their own 'runProxy' function: -    "Control.Proxy.Trans" provides proxy transformers.+    * "Control.Proxy.Core.Fast": This runs faster for code that is not+      'IO'-bound, but it only obeys the monad transformer laws modulo safe+      observation functions. -    "Control.Proxy.Pipe" provides a backwards-compatible re-implementation of-    'Pipe's.+    * "Control.Proxy.Core.Correct": This trades speed on pure code segments, but+       strictly preserves the monad transformer laws. -    "Control.Proxy.Prelude" provides a standard library of proxies.+    This module selects the currently recommended implementation (Fast). -    Consult "Control.Proxy.Tutorial" for an extended tutorial.+    You can switch to the correct implementation by importing+    "Control.Proxy.Core" and "Control.Proxy.Core.Correct".++    You can lock in the fast implementation (in case I change the recommended+    default) by importing "Control.Proxy.Core" and "Control.Proxy.Core.Fast". -}

@@ -1,72 +1,308 @@-{-| This module provides an abstract interface to 'Proxy'-like behavior, so that-    multiple proxy implementations can share the same library of utility-    proxies. -}+{-# LANGUAGE Rank2Types #-} +{-| The 'Proxy' class defines the library's core API.  Everything else in this+    library builds exclusively on top of the 'Proxy' type class so that all+    proxy implementations and extensions can share the same standard library.++    Several of these type classes duplicate methods from familiar type-classes+    (such as ('?>=') duplicating ('>>=')).  You do NOT need to use these+    duplicate methods.  Instead, read the \"Polymorphic proxies\" section below+    which explains their purpose and how they help clean up type signatures. -}+ module Control.Proxy.Class (-    -- * Proxy composition-    Channel(..),-    -- * Proxy request and respond+    -- * Core proxy class+    Proxy(..),+    idT,+    coidT,+    (<-<),+    (<~<),++    -- * request/respond substitution     Interact(..),+    (/</),+    (\<\),++    -- * Laws+    -- $laws++    -- * Polymorphic proxies+    -- $poly+    MonadPlusP(..),+    MonadIOP(..)     ) where -{- * I use educated guesses about which associativy is optimal for each operator-   * Keep precedence lower than function composition, which is 9 at the time of-     of this comment -}+import Control.Monad.IO.Class (MonadIO)++-- Documentation imports+import Control.Monad.Trans.Class (lift)+import Control.MFunctor(hoist)++{- * I make educated guesses about which associativy is most efficient for each+     operator.+   * Keep proxy composition lower in precedence than function composition, which+     is 9 at the time of of this comment, so that users can write things like:++> lift . k >-> p+>+> hoist f . k >-> p+-} infixr 7 <-< infixl 7 >-> infixr 8 /</ infixl 8 \>\ infixl 8 \<\ infixr 8 />/+infixl 1 ?>= -- This should match the fixity of >>= -{-| The 'Channel' class defines an interface to a bidirectional flow of-    information.+{-| The core API for the @pipes@ library -    Laws:+    You should only use 'request', 'respond', and ('>->') +    I only provide ('>~>') for theoretical symmetry, and the remaining methods+    just implement internal type class plumbing.+-}+class Proxy p where+    {-| 'request' input from upstream, passing an argument with the request++        @request a'@ passes @a'@ as a parameter to upstream that upstream may+        use to decide what response to return.  'request' binds the upstream's+        response of type @a@ to its own return value. -}+    request :: (Monad m) => a' -> p a' a b' b m a++    {-| 'respond' with an output for downstream and bind downstream's next+        'request'+          +        @respond b@ satisfies a downstream 'request' by supplying the value @b@.+        'respond' blocks until downstream 'request's a new value and binds the+        argument of type @b'@ from the next 'request' as its return value. -}+    respond :: (Monad m) => b -> p a' a b' b m b'++    {-| Compose two proxies blocked on a 'respond', generating a new proxy+        blocked on a 'respond'++        Begins from the downstream end and satisfies every 'request' with a+        'respond' -}+    (>->)+     :: (Monad m)+     => (b' -> p a' a b' b m r)+     -> (c' -> p b' b c' c m r)+     -> (c' -> p a' a c' c m r)++    {-| Compose two proxies blocked on a 'request', generating a new proxy+        blocked on a 'request'++        Begins from the upstream end and satisfies every 'respond' with a+        'request' -}+    (>~>)+     :: (Monad m)+     => (a -> p a' a b' b m r)+     -> (b -> p b' b c' c m r)+     -> (a -> p a' a c' c m r)++    {-| 'return_P' is identical to 'return', except with a more polymorphic+        constraint. -}+    return_P :: (Monad m) => r -> p a' a b' b m r++    {-| ('?>=') is identical to ('>>='), except with a more polymorphic+        constraint. -}+    (?>=)+     :: (Monad m)+     => p a' a b' b m r -> (r -> p a' a b' b m r') -> p a' a b' b m r'++    {-| 'lift_P' is identical to 'lift', except with a more polymorphic+        constraint. -}+    lift_P :: (Monad m) => m r -> p a' a b' b m r++    {-| 'hoist_P' is identical to 'hoist', except with a more polymorphic+        constraint. -}+    hoist_P+     :: (Monad m)+     => (forall r . m r  -> n r) -> (p a' a b' b m r' -> p a' a b' b n r')++{-| 'idT' forwards requests followed by responses++> idT = request >=> respond >=> idT+-}+idT :: (Monad m, Proxy p) => a' -> p a' a a' a m r+idT = go where+    go a' =+        request a' ?>= \a   ->+        respond a  ?>= \a'2 ->+        go a'2+-- idT = foreverK $ request >=> respond++{-| 'coidT' forwards responses followed by requests++> coidT = respond >=> request >=> coidT+-}+coidT :: (Monad m, Proxy p) => a -> p a' a a' a m r+coidT = go where+    go a =+        respond a  ?>= \a' ->+        request a' ?>= \a2 ->+        go a2+-- coidT = foreverK $ respond >=> request++{-| Compose two proxies blocked on a 'respond', generating a new proxy blocked+    on a 'respond'++    Begins from the downstream end and satisfies every 'request' with a+    'respond' -}+(<-<)+ :: (Monad m, Proxy p)+ => (c' -> p b' b c' c m r)+ -> (b' -> p a' a b' b m r)+ -> (c' -> p a' a c' c m r)+p1 <-< p2 = p2 >-> p1++{-| Compose two proxies blocked on a 'request', generating a new proxy blocked+    on a 'request'++    Begins from the upstream end and satisfies every 'respond' with a 'request'++    You don't need to use this.  I include it only for symmetry. -}+(<~<)+ :: (Monad m, Proxy p)+ => (b -> p b' b c' c m r)+ -> (a -> p a' a b' b m r)+ -> (a -> p a' a c' c m r)+p1 <~< p2 = p2 >~> p1++-- | Two extra Proxy categories of theoretical interest+class Interact p where+    -- | @f \\>\\ g@ replaces all 'request's in 'g' with 'f'.+    (\>\) :: (Monad m)+          => (b' -> p a' a x' x m b)+          -> (c' -> p b' b x' x m c)+          -> (c' -> p a' a x' x m c)++    -- | @f \/>\/ g@ replaces all 'respond's in 'f' with 'g'.+    (/>/) :: (Monad m)+          => (a -> p x' x b' b m a')+          -> (b -> p x' x c' c m b')+          -> (a -> p x' x c' c m a')++-- | @f \/<\/ g@ replaces all 'request's in 'f' with 'g'.+(/</) :: (Monad m, Interact p)+      => (c' -> p b' b x' x m c)+      -> (b' -> p a' a x' x m b)+      -> (c' -> p a' a x' x m c)+p1 /</ p2 = p2 \>\ p1++-- | @f \\<\\ g@ replaces all 'respond's in 'g' with 'f'.+(\<\) :: (Monad m, Interact p)+      => (b -> p x' x c' c m b')+      -> (a -> p x' x b' b m a')+      -> (a -> p x' x c' c m a')+p1 \<\ p2 = p2 />/ p1++{- $laws+    The 'Proxy' class defines an interface to all core proxy capabilities that+    all proxy-like types must implement.++    First, all proxies must support a bidirectional flow of information, defined+    by:++    * ('>->')++    * ('>~>')++    * 'request'++    * 'respond'++    Intuitively, both @p1 >-> p2@ and @p1 >~> p2@ pair each 'request' in @p2@+    with a 'respond' in @p1@.  ('>->') accepts proxies blocked on 'respond' and+    begins from the downstream end, whereas ('>~>') accepts proxies blocked on+    'request' and begins from the upstream end.++    Second, all proxies are monads, defined by:++    * 'return_P'++    * ('?>=')++    These must satify the monad laws using @(>>=) = (?>=)@ and+    @return = return_P@.++    Third, all proxies are monad transformers, defined by:++    * 'lift_P'++    This must satisfy the monad transformer laws, using @lift = lift_P@.++    Fourth, all proxies are functors in the category of monads, defined by:++    * 'hoist_P'++    This must satisfy the functor laws, using @hoist = hoist_P@.++    All 'Proxy' instances must satisfy these additional laws:+     * ('>->') and 'idT' form a category: -> idT >-> f = f+> Define: idT = request >=> respond >=> idT >-> f >-> idT = f+> idT >-> p = p >-> (f >-> g) >-> h = f >-> (g >-> h)+> p >-> idT = p+>+> (p1 >-> p2) >-> p3 = p1 >-> (p2 >-> p3) -    Minimal complete definition:+    * ('>~>') and 'coidT' form a category: -    * 'idT'+> Define: coidT = respond >=> request >=> coidT+>+> coidT >~> p = p+>+> p >~> coidT = p+>+> (p1 >~> p2) >~> p3 = p1 >~> (p2 >~> p3) -    * ('>->') or ('<-<').--}-class Channel p where-    {-| 'idT' acts like a \'T\'ransparent proxy, passing all requests further-        upstream, and passing all responses further downstream. -}-    idT :: (Monad m) => a' -> p a' a a' a m r+    * @(hoistK f)@ defines a functor between proxy categories: -    {-| Compose two proxies, satisfying all requests from downstream with-        responses from upstream. -}-    (>->) :: (Monad m)-          => (b' -> p a' a b' b m r)-          -> (c' -> p b' b c' c m r)-          -> (c' -> p a' a c' c m r)-    p1 >-> p2 = p2 <-< p1+> Define: hoistK f = (hoist f .)+>+> hoistK f (p1 >-> p2) = hoistK f p1 >-> hoistK p2+>+> hoistK f idT = idT+>+> hoistK f (p1 >~> p2) = hoistK f p1 >~> hoistK p2+>+> hoistK f coidT = coidT -    {-| Compose two proxies, satisfying all requests from downstream with-        responses from upstream. -}-    (<-<) :: (Monad m)-          => (c' -> p b' b c' c m r)-          -> (b' -> p a' a b' b m r)-          -> (c' -> p a' a c' c m r)-    p1 <-< p2 = p2 >-> p1+    Also, all proxies must satisfy the following 'Proxy' laws: -{-| The 'Interact' class defines the ability to:+> -- Define: liftK = (lift .)+>+> p1 >-> liftK f = liftK f+>+> p1 >-> (liftK f >=> respond >=> p2) = liftK f >=> respond >=> (p1 >-> p2)+>+> (liftK g >=> respond >=> p1) >-> (liftK f >=> request >=> liftK h >=> p2)+>     = liftK (f >=> g >=> h) >=> (p1 >-> p2)+>+> (liftK g >=> request >=> p1) >-> (liftK f >=> request >=> p2)+>     = liftK (f >=> g) >=> request >=> (p1 >~> p2)+>+> liftK f >~> p2 = liftK f+>+> (liftK f >=> request >=> p1) >~> p2 = liftK f >=> request >=> (p1 >~> p2)+>+> (liftK f >=> respond >=> liftK h >=> p1) >~> (liftK g >=> request >=> p2)+>     = liftK (f >=> g >=> h) >=> (p1 >~> p2)+>+> (liftK f >=> respond >=> p1) >~> (liftK g >=> respond >=> p2)+>     = liftK (f >=> g) >=> (p1 >-> p2) -    * Request input using the 'request' command+    The 'Interact' class exists primarily for theoretical interest and to+    justify some of the functor laws for the 'ProxyTrans' type class.  You will+    probably never use it. +    The 'Interact' class defines the ability to:+         * Replace existing 'request' commands using ('\>\') -    * Respond with output using the 'respond' command-     * Replace existing 'respond' commands using ('/>/')          Laws:@@ -87,56 +323,130 @@ > > (f />/ g) />/ h = f />/ (g />/ h) -    Minimal complete definition:+    Additionally, ('\>\') and ('/>/') distribute in one direction over Kleisli+    composition: -    * 'request',+> a \>\ (b >=> c) = (a \>\ b) >=> (a \>\ c)+>+> a \>\ return = return -    * ('\>\') or ('/</'),+> (b >=> c) />/ a = (b />/ a) >=> (c />/ a)+>+> return />/ a = return+-} -    * 'respond', and+{- $poly+    Many of these type classes contain methods which copy methods from more+    familiar type classes.  These duplicate methods serve two purposes. -    * ('/>/') or ('\<\').--}-class Interact p where-    {-| 'request' input from upstream, passing an argument with the request+    First, this library requires type class instances that would otherwise be+    impossible to define without providing higher-kinded constraints.  Rather+    than use the following illegal polymorphic constraint: -        @request a'@ passes @a'@ as a parameter to upstream that upstream may-        use to decide what response to return.  'request' binds the upstream's-        response to its own return value. -}-    request :: (Monad m) => a' -> p a' a x' x m a+> instance (forall a' a b' b . MonadTrans (p a' a b' b)) => ... -    -- | @f \\>\\ g@ replaces all 'request's in 'g' with 'f'.-    (\>\) :: (Monad m)-          => (b' -> p a' a x' x m b)-          -> (c' -> p b' b x' x m c)-          -> (c' -> p a' a x' x m c)-    p1 \>\ p2 = p2 /</ p1+      ... the instance can instead use the following Haskell98 constraint: -    -- | @f \/<\/ g@ replaces all 'request's in 'f' with 'g'.-    (/</) :: (Monad m)-          => (c' -> p b' b x' x m c)-          -> (b' -> p a' a x' x m b)-          -> (c' -> p a' a x' x m c)-    p1 /</ p2 = p2 \>\ p1+> instance (MonadTransP p) => ... -    {-| 'respond' with an output for downstream and bind downstream's next-        'request'-          -        @respond b@ satisfies a downstream 'request' by supplying the value @b@-        'respond' blocks until downstream 'request's a new value and binds the-        argument from the next 'request' as its return value. -}-    respond :: (Monad m) => a -> p x' x a' a m a'+    Second, these type classes don't require the @FlexibleContexts@ extension+    to use and substantially clean up constraints in type signatures.  They+    convert messy constraints like this: -    -- | @f \/>\/ g@ replaces all 'respond's in 'f' with 'g'.-    (/>/) :: (Monad m)-          => (a -> p x' x b' b m a')-          -> (b -> p x' x c' c m b')-          -> (a -> p x' x c' c m a')-    p1 />/ p2 = p2 \<\ p1+> p :: (MonadP (p a' a b' b m), MonadTrans (p a' a b' b)) => ... -    -- | @f \\<\\ g@ replaces all 'respond's in 'g' with 'f'.-    (\<\) :: (Monad m)-          => (b -> p x' x c' c m b')-          -> (a -> p x' x b' b m a')-          -> (a -> p x' x c' c m a')-    p1 \<\ p2 = p2 />/ p1+      .. into cleaner and more general constraints like this:++> P :: (Proxy p) => ...++    These type classes exist solely for internal plumbing and you should never+    directly use the duplicate methods from them.  Instead, you can use all the+    original type classes as long as you embed your proxy code within at least+    one proxy transformer (or 'IdentityP' if don't use any transformers).  The+    type-class machinery will then automatically convert the messier and less+    polymorphic constraints to the simpler and more general constraints.++    For example, consider the following almost-correct definition for @mapMD@+    (from "Control.Proxy.Prelude.Base"):++> import Control.Monad.Trans.Class+> import Control.Proxy+>+> mapMD f = foreverK $ \a' -> do+>     a <- request a'+>     b <- lift (f a)+>     respond b++    The compiler infers the following messy constraint:++> mapMD+>  :: (Monad m, Monad (p x a x b m), MonadTrans (p x a x b), Proxy p)+>  => (a -> m b) -> x -> p x a x b m r++    Instead, you can embed the code in the @IdentityP@ proxy transformer by+    wrapping it in 'runIdentityK':++> --        |difference|  +> mapMD f = runIdentityK $ foreverK $ \a' -> do+>     a <- request a'+>     b <- lift (f a)+>     respond b++    ... and now the compiler collapses all the constraints into the 'Proxy'+    constraint:++> mapMD :: (Monad m, Proxy p) => (a -> m b) -> x -> p x a x b m r++    You do not incur any performance penalty for writing polymorphic code or+    embedding it in 'IdentityP'.  This library employs several rewrite @RULES@+    which transform your polymorphic code into the equivalent type-specialized+    hand-tuned code.  These rewrite rules fire very robustly and they do not+    require any assistance on your part from compiler pragmas like @INLINE@,+    @NOINLINE@ or @SPECIALIZE@.++    If you nest proxies within proxies:++> example () = do+>     request ()+>     lift $ request ()+>     lift $ lift $ request ()++    ... then you can still keep the nice constraints using:++> example () = runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ do+>     request ()+>     lift $ request ()+>     lift $ lift $ request ()++    You don't need to use 'runIdentityP' \/ 'runIdentityK' if you use any other+    proxy transformers (In fact you can't, it's a type error).  The following+    code example illustrates this, where the 'throw' command (from the 'EitherP'+    proxy transformer) suffices to guide the compiler to the cleaner type+    signature:++> import Control.Monad+> import Control.Proxy+> import qualified Control.Proxy.Trans.Either as E+>+> example :: (Monad m, Proxy p) => () -> Producer (EitherP String p) Char m ()+> example () = do+>     c <- request ()+>     when (c == ' ') $ E.throw "Error: received space"+>     respond c+-}++{-| The @(MonadPlusP p)@ constraint is equivalent to the following constraint:++> (forall a' a b' b m . (Monad m) => MonadPlus (p a' a b' b m)) => ...+-}+class (Proxy p) => MonadPlusP p where+    mzero_P :: (Monad m) => p a' a b' b m r+    mplus_P+     :: (Monad m) => p a' a b' b m r -> p a' a b' b m r -> p a' a b' b m r++{-| The @(MonadIOP p)@ constraint is equivalent to the following constraint:++> (forall a' a b' b m . (MonadIO m) => MonadIO (p a' a b' b m)) => ...+-}+class (Proxy p) => MonadIOP p where+    liftIO_P :: (MonadIO m) => IO r -> p a' a b' b m r

@@ -1,217 +1,45 @@-{-| A 'Proxy' 'request's input from upstream and 'respond's with output to-    downstream.--    For an extended tutorial, consult "Control.Proxy.Tutorial". -}+-- | Default imports for the "Control.Proxy" hierarchy  module Control.Proxy.Core (-    -- * Types-    Proxy(..),-    C,-    Server,-    Client,-    Session,-    -- * Run Sessions -    -- $run-    runProxy,-    runProxyK,-    runSession,-    runSessionK,-    -- * Utility Proxies-    -- $utility-    discard,-    ignore+    -- * Modules+    -- $modules+    module Control.Proxy.Class,+    module Control.Proxy.Synonym,+    module Control.Proxy.Prelude,+    module Control.Proxy.Trans,+    module Control.Proxy.Trans.Identity,+    module Control.Monad,+    module Control.Monad.Trans.Class,+    module Control.MFunctor     ) where -import Control.Applicative (Applicative(pure, (<*>)))-import Control.Monad (ap, forever, liftM, (>=>))-import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.MFunctor (MFunctor(hoist))+import Control.Monad (forever, (>=>), (<=<)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(mapT))-import Control.Proxy.Class (-    Channel(idT, (<-<)), Interact(request, (/</), respond, (\<\)) )-import Data.Closed (C)--{-| A 'Proxy' communicates with an upstream interface and a downstream-    interface.--    The type variables of @Proxy req_a resp_a req_b resp_b m r@ signify:--    * @req_a @ - The request supplied to the upstream interface--    * @resp_a@ - The response provided by the upstream interface--    * @req_b @ - The request supplied by the downstream interface--    * @resp_b@ - The response provided to the downstream interface--    * @m     @ - The base monad--    * @r     @ - The final return value -}-data Proxy a' a b' b m r-  = Request a' (a  -> Proxy a' a b' b m r )-  | Respond b  (b' -> Proxy a' a b' b m r )-  | M          (m    (Proxy a' a b' b m r))-  | Pure r--instance (Monad m) => Functor (Proxy a' a b' b m) where-    fmap f p0 = go p0 where-        go p = case p of-            Request a' fa  -> Request a' (\a  -> go (fa  a ))-            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))-            M          m   -> M (m >>= \p' -> return (go p'))-            Pure       r   -> Pure (f r)--instance (Monad m) => Applicative (Proxy a' a b' b m) where-    pure  = Pure-    pf <*> px = go pf where-        go p = case p of-            Request a' fa  -> Request a' (\a  -> go (fa  a ))-            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))-            M          m   -> M (m >>= \p' -> return (go p'))-            Pure       f   -> fmap f px--instance (Monad m) => Monad (Proxy a' a b' b m) where-    return = Pure-    p0 >>= f = go p0 where-        go p = case p of-            Request a' fa  -> Request a' (\a  -> go (fa  a))-            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))-            M m            -> M (m >>= \p' -> return (go p'))-            Pure r         -> f r--instance MonadTrans (Proxy a' a b' b) where-    lift = M . liftM Pure--instance (MonadIO m) => MonadIO (Proxy a' a b' b m) where-    liftIO = M . liftIO . liftM Pure--instance Channel Proxy where-    idT = \a' -> Request a' $ \a -> Respond a idT-    k1 <-< k2_0 = \c' -> k1 c' |-< k2_0 where-        p1 |-< k2 = case p1 of-            Request b' fb  -> fb <-| k2 b'-            Respond c  fc' -> Respond c (\c' -> fc' c' |-< k2)-            M          m   -> M (m >>= \p1' -> return (p1' |-< k2))-            Pure       r   -> Pure r-        fb <-| p2 = case p2 of-            Request a' fa  -> Request a' (\a -> fb <-| fa a) -            Respond b  fb' -> fb b |-< fb'-            M          m   -> M (m >>= \p2' -> return (fb <-| p2'))-            Pure       r   -> Pure r--instance Interact Proxy where-    request a' = Request a' Pure-    k1 /</ k2 = \a' -> go (k1 a') where-        go p = case p of-            Request b' fb  -> k2 b' >>= \b -> go (fb b)-            Respond x  fx' -> Respond x (\x' -> go (fx' x'))-            M          m   -> M (m >>= \p' -> return (go p'))-            Pure       a   -> Pure a-    respond a = Respond a Pure-    k1 \<\ k2 = \a' -> go (k2 a') where-        go p = case p of-            Request x' fx  -> Request x' (\x -> go (fx x))-            Respond b  fb' -> k1 b >>= \b' -> go (fb' b')-            M          m   -> M (m >>= \p' -> return (go p'))-            Pure       a   -> Pure a--instance MFunctor (Proxy a' a b' b) where-    mapT nat p0 = go p0 where-        go p = case p of-            Request a' fa  -> Request a' (\a  -> go (fa  a ))-            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))-            M          m   -> M (nat (m >>= \p' -> return (go p')))-            Pure       r   -> Pure r--{-| @Server req resp@ receives requests of type @req@ and sends responses of-    type @resp@.--    'Server's only 'respond' and never 'request' anything. -}-type Server req resp = Proxy C   ()   req resp--{-| @Client req resp@ sends requests of type @req@ and receives responses of-    type @resp@.--    'Client's only 'request' and never 'respond' to anything. -}-type Client req resp = Proxy req resp ()  C--{-| A self-contained 'Session', ready to be run by 'runSession'--    'Session's never 'request' anything or 'respond' to anything. -}-type Session         = Proxy C   ()   ()  C--{- $run-    I provide two ways to run proxies:--    * 'runProxy', which discards unhandled output from either end--    * 'runSession', which type restricts its argument to ensure no loose ends--    Both functions require that the input to each end is trivially satisfiable,-    (i.e. @()@).--    I recommend 'runProxy' for most use cases since it is more convenient.--    'runSession' only accepts sessions that do not send unhandled data flying-    off each end, which provides the following benefits:--    * It prevents against accidental data loss.--    * It protects against silent failures--    * It prevents wastefully draining a scarce resource by gratuitously-      driving it to completion--    However, this restriction means that you must either duplicate every utility-    function to specialize them to the end-point positions (which I do not do),-    or explicitly close loose ends using the 'discard' and 'ignore' proxies:+import Control.Proxy.Class+import Control.Proxy.Synonym+import Control.Proxy.Trans+import Control.Proxy.Trans.Identity+import Control.Proxy.Prelude -> runSession $ discard <-< p <-< ignore+{- $modules+    "Control.Proxy.Class" defines the 'Proxy' type class that lets you program+    generically over proxy implementations and their transformers. -    Use the \'@K@\' versions of each command if you are running sessions nested-    within sessions.  They provide a Kleisli arrow as their result suitable to-    be passed to another 'runProxy' / 'runSession' command.--}+    "Control.Proxy.Synonym" defines type synonyms for proxies that don't use all+    of their inputs or outputs, such as 'Pipe's, 'Producer's, and 'Server's. -{-| Run a self-sufficient 'Proxy' Kleisli arrow, converting it back to the base-    monad -}-runProxy :: (Monad m) => (() -> Proxy a' () () b m r) -> m r-runProxy k = go (k ()) where-    go p = case p of-        Request _ fa  -> go (fa  ())-        Respond _ fb' -> go (fb' ())-        M         m   -> m >>= go-        Pure      r   -> return r+    "Control.Proxy.Prelude" provides a standard library of proxies. -{-| Run a self-sufficient 'Proxy' Kleisli arrow, converting it back to a Kleisli-    arrow in the base monad -}-runProxyK :: (Monad m) => (() -> Proxy a () () b m r) -> (() -> m r)-runProxyK p = \() -> runProxy p+    "Control.Proxy.Trans" defines the 'ProxyTrans' type class that lets you+    write your own proxy extensions. -{-| Run a self-contained 'Session' Kleisli arrow, converting it back to the base-    monad -}-runSession :: (Monad m) => (() -> Session m r) -> m r-runSession = runProxy+    "Control.Proxy.Trans.Identity" exports 'runIdentityP', which substantially+    eases writing completely polymorphic proxies. -{-| Run a self-contained 'Session' Kleisli arrow, converting it back to a-    Kleisli arrow in the base monad -}-runSessionK :: (Monad m) => (() -> Session m r) -> (() -> m r)-runSessionK = runProxyK+    "Control.Monad" exports 'forever', ('>=>'), and ('<=<'). -{- $utility-    'discard' provides a fallback client that gratuitously 'request's input-    from a server, but discards all responses.+    "Control.Monad.Trans.Class" exports 'lift'. -    'ignore' provides a fallback server that trivially 'respond's with output-    to a client, but ignores all request parameters.+    "Control.MFunctor" exports 'hoist'. -}---- | Discard all responses-discard :: (Monad m) => () -> Proxy () a () C m r-discard _ = go where-    go = Request () (\_ -> go)---- | Ignore all requests-ignore  :: (Monad m) => a -> Proxy C () a () m r-ignore _ = go where-    go = Respond () (\_ -> go)

@@ -0,0 +1,186 @@+{-| This module provides the correct proxy implementation which strictly+    enforces the monad transformer laws.  You can safely import this module+    without violating any laws or invariants.++    However, I advise that you stick to the 'Proxy' type class API rather than+    import this module so that your code works with both 'Proxy' implementations+    and also works with all proxy transformers. -}++module Control.Proxy.Core.Correct (+    -- * Types+    ProxyCorrect(..),+    ProxyF(..),++    -- * Run Sessions +    -- $run+    runProxy,+    runProxyK,+    runPipe+    ) where++import Control.Applicative (Applicative(pure, (<*>)))+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.MFunctor (MFunctor(hoist))+import Control.Proxy.Class+import Control.Proxy.Synonym (C)++{-| A 'ProxyCorrect' communicates with an upstream interface and a downstream+    interface.++    The type variables of @ProxyCorrect req_a' resp_a req_b' resp_b m r@+    signify:++    * @req_a'@ - The request supplied to the upstream interface++    * @resp_a@ - The response provided by the upstream interface++    * @req_b'@ - The request supplied by the downstream interface++    * @resp_b@ - The response provided to the downstream interface++    * @m     @ - The base monad++    * @r     @ - The final return value -}+data ProxyCorrect a' a b' b m  r =+    Proxy { unProxy :: m (ProxyF a' a b' b r (ProxyCorrect a' a b' b m r)) }++-- | The base functor for the 'ProxyCorrect' type+data ProxyF a' a b' b r x+  = Request a' (a  -> x)+  | Respond b  (b' -> x)+  | Pure    r++instance (Monad m) => Functor (ProxyCorrect a' a b' b m) where+    fmap f p0 = go p0 where+        go p = Proxy (do+            x <- unProxy p+            return (case x of+                Request a' fa  -> Request a' (\a  -> go (fa  a ))+                Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+                Pure       r   -> Pure (f r) ) )++instance (Monad m) => Applicative (ProxyCorrect a' a b' b m) where+    pure r = Proxy (return (Pure r))+    pf <*> px = go pf where+        go p = Proxy (do+            x <- unProxy p+            case x of+                Request a' fa  -> return (Request a' (\a  -> go (fa  a )))+                Respond b  fb' -> return (Respond b  (\b' -> go (fb' b')))+                Pure       f   -> unProxy (fmap f px) )++instance (Monad m) => Monad (ProxyCorrect a' a b' b m) where+    return = \r -> Proxy (return (Pure r))+    p0 >>= f = go p0 where+        go p = Proxy (do+            x <- unProxy p+            case x of+                Request a' fa  -> return (Request a' (\a  -> go (fa  a )))+                Respond b  fb' -> return (Respond b  (\b' -> go (fb' b')))+                Pure       r   -> unProxy (f r) )++instance MonadTrans (ProxyCorrect a' a b' b) where+    lift = lift_P++instance (MonadIO m) => MonadIO (ProxyCorrect a' a b' b m) where+    liftIO m = Proxy (liftIO (m >>= \r -> return (Pure r)))+ -- liftIO = Proxy . liftIO . liftM Pure++instance MonadIOP ProxyCorrect where+    liftIO_P = liftIO++instance Proxy ProxyCorrect where+    fb'_0 >-> fc' = \c' -> fb'_0 >-| fc' c' where+        fb' >-| p1 = Proxy (do+            x <- unProxy p1+            case x of+                Request b' fb  -> unProxy (fb' b' |-> fb)+                Respond c  fc' -> return (Respond c (\c' -> fb' >-| fc' c'))+                Pure       r   -> return (Pure r) )+        p2 |-> fb = Proxy (do+            x <- unProxy p2+            case x of+                Request a' fa  -> return (Request a' (\a -> fa a |-> fb))+                Respond b  fb' -> unProxy (fb' >-| fb b)+                Pure       r   -> return (Pure r) )++    fa_0 >~> fb_0 = \a -> fa_0 a |-> fb_0 where+        fb' >-| p1 = Proxy (do+            x <- unProxy p1+            case x of+                Request b' fb  -> unProxy (fb' b' |-> fb)+                Respond c  fc' -> return (Respond c (\c' -> fb' >-| fc' c'))+                Pure       r   -> return (Pure r) )+        p2 |-> fb = Proxy (do+            x <- unProxy p2+            case x of+                Request a' fa  -> return (Request a' (\a -> fa a |-> fb))+                Respond b  fb' -> unProxy (fb' >-| fb b)+                Pure       r   -> return (Pure r) )++    request a' = Proxy (return (Request a' (\a  -> Proxy (return (Pure a )))))+    respond b  = Proxy (return (Respond b  (\b' -> Proxy (return (Pure b')))))++    return_P = return+    (?>=)   = (>>=)++    lift_P m = Proxy (m >>= \r -> return (Pure r))++    hoist_P = hoist++instance Interact ProxyCorrect where+    k2 \>\ k1 = \a' -> go (k1 a') where+        go p = Proxy (do+            x <- unProxy p+            case x of+                Request b' fb  -> unProxy (k2 b' >>= \b -> go (fb b))+                Respond x  fx' -> return (Respond x (\x' -> go (fx' x')))+                Pure       a   -> return (Pure a) )+    k2 />/ k1 = \a' -> go (k2 a') where+        go p = Proxy (do+            x <- unProxy p+            case x of+                Request x' fx  -> return (Request x' (\x -> go (fx x)))+                Respond b  fb' -> unProxy (k1 b >>= \b' -> go (fb' b'))+                Pure       a   -> return (Pure a) )++instance MFunctor (ProxyCorrect a' a b' b) where+    hoist nat p0 = go p0 where+        go p = Proxy (nat (do+            x <- unProxy p+            return (case x of+                Request a' fa  -> Request a' (\a  -> go (fa  a ))+                Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+                Pure       r   -> Pure r )))++{- $run+    The following commands run self-sufficient proxies, converting them back to+    the base monad.++    These are the only functions specific to the 'ProxyCorrect' type.+    Everything else programs generically over the 'Proxy' type class.++    Use 'runProxyK' if you are running proxies nested within proxies.  It+    provides a Kleisli arrow as its result that you can pass to another+    'runProxy' / 'runProxyK' command. -}++{-| Run a self-sufficient 'ProxyCorrect' Kleisli arrow, converting it back to+    the base monad -}+runProxy :: (Monad m) => (() -> ProxyCorrect a' () () b m r) -> m r+runProxy k = go (k ()) where+    go p = do+        x <- unProxy p+        case x of+            Request _ fa  -> go (fa  ())+            Respond _ fb' -> go (fb' ())+            Pure      r   -> return r++{-| Run a self-sufficient 'ProxyCorrect' Kleisli arrow, converting it back to a+    Kleisli arrow in the base monad -}+runProxyK :: (Monad m) => (() -> ProxyCorrect a' () () b m r) -> (() -> m r)+runProxyK p = \() -> runProxy p++-- | Run the 'Pipe' monad transformer, converting it back to the base monad+runPipe :: (Monad m) => ProxyCorrect a' () () b m r -> m r+runPipe p = runProxy (\_ -> p)

@@ -0,0 +1,238 @@+{-| This is an internal module, meaning that it is unsafe to import unless you+    understand the risks.++    This module provides the fast proxy implementation, which achieves its speed+    by weakening the monad transformer laws.  These laws do not hold if you can+    pattern match on the constructors, as the following counter-example+    illustrates:++> lift . return = M . return . Pure+>+> return = Pure+>+> lift . return /= return++    These laws only hold when viewed through certain safe observation functions,+    like 'runProxy' and 'observe'.++    Also, you really should not use the constructors anyway, let alone the+    concrete type and instead you should stick to the 'Proxy' type class API.+    This not only ensures that your code does not violate the monad transformer+    laws, but also guarantees that it works with the other proxy implementations+    and with any proxy transformers. -}++module Control.Proxy.Core.Fast (+    -- * Types+    ProxyFast(..),++    -- * Run Sessions +    -- $run+    runProxy,+    runProxyK,+    runPipe,++    -- * Safety+    observe+    ) where++import Control.Applicative (Applicative(pure, (<*>)))+-- import Control.Monad (ap, forever, liftM, (>=>))+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.MFunctor (MFunctor(hoist))+import Control.Proxy.Class+import Control.Proxy.Synonym (C)++{-| A 'ProxyFast' communicates with an upstream interface and a downstream+    interface.++    The type variables of @ProxyFast req_a' resp_a req_b' resp_b m r@ signify:++    * @req_a'@ - The request supplied to the upstream interface++    * @resp_a@ - The response provided by the upstream interface++    * @req_b'@ - The request supplied by the downstream interface++    * @resp_b@ - The response provided to the downstream interface++    * @m     @ - The base monad++    * @r     @ - The final return value -}+data ProxyFast a' a b' b m r+  = Request a' (a  -> ProxyFast a' a b' b m r )+  | Respond b  (b' -> ProxyFast a' a b' b m r )+  | M          (m    (ProxyFast a' a b' b m r))+  | Pure    r++instance (Monad m) => Functor (ProxyFast a' a b' b m) where+    fmap f p0 = go p0 where+        go p = case p of+            Request a' fa  -> Request a' (\a  -> go (fa  a ))+            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+            M          m   -> M (m >>= \p' -> return (go p'))+            Pure       r   -> Pure (f r)++instance (Monad m) => Applicative (ProxyFast a' a b' b m) where+    pure      = Pure+    pf <*> px = go pf where+        go p = case p of+            Request a' fa  -> Request a' (\a  -> go (fa  a ))+            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+            M          m   -> M (m >>= \p' -> return (go p'))+            Pure       f   -> fmap f px++instance (Monad m) => Monad (ProxyFast a' a b' b m) where+    return = Pure+    (>>=)  = _bind++_bind+ :: (Monad m)+ => ProxyFast a' a b' b m r+ -> (r -> ProxyFast a' a b' b m r')+ -> ProxyFast a' a b' b m r'+p0 `_bind` f = go p0 where+    go p = case p of+        Request a' fa  -> Request a' (\a  -> go (fa  a))+        Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+        M          m   -> M (m >>= \p' -> return (go p'))+        Pure       r   -> f r++-- | Only satisfies laws modulo 'observe'+instance MonadTrans (ProxyFast a' a b' b) where+    lift = _lift++_lift :: (Monad m) => m r -> ProxyFast a' a b' b m r+_lift m = M (m >>= \r -> return (Pure r))+-- _lift = M . liftM Pure++{- These never fire, for some reason, but keep them until I figure out how to+   get them to work. -}+{-# RULES+    "_lift m ?>= f" forall m f .+        _bind (_lift m) f = M (m >>= \r -> return (f r))+  #-}++instance (MonadIO m) => MonadIO (ProxyFast a' a b' b m) where+    liftIO m = M (liftIO (m >>= \r -> return (Pure r)))+ -- liftIO = M . liftIO . liftM Pure++instance MonadIOP ProxyFast where+    liftIO_P = liftIO++instance Proxy ProxyFast where+    fb'_0 >-> fc'_0 = \c' -> fb'_0 >-| fc'_0 c' where+        p1 |-> fb = case p1 of+            Request a' fa  -> Request a' (\a -> fa a |-> fb)+            Respond b  fb' -> fb' >-| fb b+            M          m   -> M (m >>= \p1' -> return (p1' |-> fb))+            Pure       r   -> Pure r+        fb' >-| p2 = case p2 of+            Request b' fb  -> fb' b' |-> fb+            Respond c  fc' -> Respond c (\c' -> fb' >-| fc' c')+            M          m   -> M (m >>= \p2' -> return (fb' >-| p2'))+            Pure       r   -> Pure r++    fa_0 >~> fb_0 = \a -> fa_0 a |-> fb_0 where+        p1 |-> fb = case p1 of+            Request a' fa  -> Request a' (\a -> fa a |-> fb)+            Respond b  fb' -> fb' >-| fb b+            M          m   -> M (m >>= \p1' -> return (p1' |-> fb))+            Pure       r   -> Pure r+        fb' >-| p2 = case p2 of+            Request b' fb  -> fb' b' |-> fb+            Respond c  fc' -> Respond c (\c' -> fb' >-| fc' c')+            M          m   -> M (m >>= \p2' -> return (fb' >-| p2'))+            Pure       r   -> Pure r++    request a' = Request a' Pure+    respond b  = Respond b  Pure++    return_P = return+    (?>=)   = _bind++    lift_P = _lift++    hoist_P = hoist++{-# RULES+    "_bind (Request a' Pure) f" forall a' f .+        _bind (Request a' Pure) f = Request a' f;+    "_bind (Respond b  Pure) f" forall b  f .+        _bind (Respond b  Pure) f = Respond b  f+  #-}++instance Interact ProxyFast where+    k2 \>\ k1 = \a' -> go (k1 a') where+        go p = case p of+            Request b' fb  -> k2 b' >>= \b -> go (fb b)+            Respond x  fx' -> Respond x (\x' -> go (fx' x'))+            M          m   -> M (m >>= \p' -> return (go p'))+            Pure       a   -> Pure a+    k2 />/ k1 = \a' -> go (k2 a') where+        go p = case p of+            Request x' fx  -> Request x' (\x -> go (fx x))+            Respond b  fb' -> k1 b >>= \b' -> go (fb' b')+            M          m   -> M (m >>= \p' -> return (go p'))+            Pure       a   -> Pure a++instance MFunctor (ProxyFast a' a b' b) where+    hoist nat p0 = go (observe p0) where+        go p = case p of+            Request a' fa  -> Request a' (\a  -> go (fa  a ))+            Respond b  fb' -> Respond b  (\b' -> go (fb' b'))+            M          m   -> M (nat (m >>= \p' -> return (go p')))+            Pure       r   -> Pure r++{- $run+    The following commands run self-sufficient proxies, converting them back to+    the base monad.++    These are the only functions specific to the 'ProxyFast' type.  Everything+    else programs generically over the 'Proxy' type class.++    Use 'runProxyK' if you are running proxies nested within proxies.  It+    provides a Kleisli arrow as its result that you can pass to another+    'runProxy' / 'runProxyK' command. -}++{-| Run a self-sufficient 'ProxyFast' Kleisli arrow, converting it back to the+    base monad -}+runProxy :: (Monad m) => (() -> ProxyFast a' () () b m r) -> m r+runProxy k = go (k ()) where+    go p = case p of+        Request _ fa  -> go (fa  ())+        Respond _ fb' -> go (fb' ())+        M         m   -> m >>= go+        Pure      r   -> return r++{-| Run a self-sufficient 'ProxyFast' Kleisli arrow, converting it back to a+    Kleisli arrow in the base monad -}+runProxyK :: (Monad m) => (() -> ProxyFast a' () () b m r) -> (() -> m r)+runProxyK p = \() -> runProxy p++-- | Run the 'Pipe' monad transformer, converting it back to the base monad+runPipe :: (Monad m) => ProxyFast a' () () b m r -> m r+runPipe p = runProxy (\_ -> p)++{-| The monad transformer laws are correct when viewed through the 'observe'+    function:++> observe (lift (return r)) = observe (return r)+>+> observe (lift (m >>= f)) = observe (lift m >>= lift . f)++    This correctness comes at a moderate cost to performance, so use this+    function sparingly or else you would be better off using+    "Control.Proxy.Core.Correct".++    You do not need to use this function if you use the safe API exported from+    "Control.Proxy", which does not export any functions or constructors that+    can violate the monad transformer laws.+-}+observe :: (Monad m) => ProxyFast a' a b' b m r -> ProxyFast a' a b' b m r+observe p = M (go p) where+    go p = case p of+        M          m'  -> m' >>= go+        Pure       r   -> return (Pure r)+        Request a' fa  -> return (Request a' (\a  -> observe (fa  a )))+        Respond b  fb' -> return (Respond b  (\b' -> observe (fb' b')))

@@ -1,90 +1,197 @@-{-| This module provides an API compatible with "Control.Pipe"+{-# LANGUAGE KindSignatures #-} -    Consult "Control.Pipe.Core" for more extensive documentation and-    "Control.Pipe.Tutorial" for an extended tutorial. -}+{-| This module provides an API similar to "Control.Pipe" for those who prefer+    the classic 'Pipe' API. +    This module differs slightly from "Control.Pipe" in order to promote+    seamless interoperability with both pipes and proxies.  See the \"Upgrade+    Pipes to Proxies\" section below for details. -} module Control.Proxy.Pipe (-    -- * Types-    Pipe,-    Producer,-    Consumer,-    Pipeline,     -- * Create Pipes     await,     yield,     pipe,+     -- * Compose Pipes     (<+<),     (>+>),     idP,-    -- * Run Pipes-    runPipe-    ) where -import Control.Proxy.Core-import Control.Proxy.Class-import Data.Closed (C)--{-| The type variables of @Pipe a b m r@ signify:--    * @a@ - The type of input received from upstream pipes--    * @b@ - The type of output delivered to downstream pipes--    * @m@ - The base monad--    * @r@ - The type of the return value -}-type Pipe   a b = Proxy () a () b+    -- * Synonyms+    Pipeline, --- | A pipe that produces values-type Producer b = Pipe () b+    -- * Run Pipes+    -- $run --- | A pipe that consumes values-type Consumer a = Pipe a  C+    -- * Upgrade Pipes to Proxies+    -- $upgrade+    ) where --- | A self-contained pipeline that is ready to be run-type Pipeline   = Pipe () C+import Control.Monad (forever)+import Control.Proxy.Class (Proxy(request, respond, (>->), (?>=)))+import Control.Proxy.Synonym (Pipe, Consumer, Producer, C)+import Control.Proxy.Trans.Identity (runIdentityP)  {-| Wait for input from upstream -    'await' blocks until input is available -}-await :: (Monad m) => Pipe a b m a+    'await' blocks until input is available from upstream. -}+await :: (Monad m, Proxy p) => Pipe p a b m a await = request ()-{-# INLINE await #-} --- | Convert a pure function into a pipe-pipe :: (Monad m) => (a -> b) -> Pipe a b m r-pipe f = go where-    go = Request () (\a -> Respond (f a) (\() -> go))- {-| Deliver output downstream -    'yield' restores control back downstream and binds the result to 'await'. -}-yield :: (Monad m) => b -> Pipe a b m ()-yield = respond-{-# INLINE yield #-}+    'yield' restores control back downstream and binds its value to 'await'. -}+yield :: (Monad m, Proxy p) => b -> p a' a b' b m ()+yield b = runIdentityP $ do+    respond b+    return () +-- | Convert a pure function into a pipe+pipe :: (Monad m, Proxy p) => (a -> b) -> Pipe p a b m r+pipe f = runIdentityP $ forever $ do+    a <- request ()+    respond (f a)+ infixr 9 <+< infixl 9 >+>  -- | Corresponds to ('<<<')/('.') from @Control.Category@-(<+<) :: (Monad m) => Pipe b c m r -> Pipe a b m r -> Pipe a c m r-p1 <+< p2 = ((\() -> p1) <-< (\() -> p2)) ()+(<+<)+ :: (Monad m, Proxy p) => Pipe p b c m r -> Pipe p a b m r -> Pipe p a c m r+p1 <+< p2 = p2 >+> p1  -- | Corresponds to ('>>>') from @Control.Category@-(>+>) :: (Monad m) => Pipe a b m r -> Pipe b c m r -> Pipe a c m r-(>+>) = flip (<+<)+(>+>)+ :: (Monad m, Proxy p) => Pipe p a b m r -> Pipe p b c m r -> Pipe p a c m r+p1 >+> p2 = ((\() -> p1) >-> (\() -> p2)) ()  -- | Corresponds to 'id' from @Control.Category@-idP :: (Monad m) => Pipe a a m r-idP = go where-    go = Request () (\a -> Respond a (\() -> go))+idP :: (Monad m, Proxy p) => Pipe p a a m r+idP = runIdentityP $ forever $ do+    a <- request ()+    respond a --- | Run the 'Pipe' monad transformer, converting it back to the base monad-runPipe :: (Monad m) => Pipeline m r -> m r-runPipe p' = go p' where-    go p = case p of-        Request _ fa  -> go (fa  ())-        Respond _ fb' -> go (fb' ())-        M         m   -> m >>= go-        Pure      r   -> return r+{-| A self-contained 'Pipeline' that is ready to be run++    'Pipeline's never 'request' nor 'respond'. -}+type Pipeline (p :: * -> * -> * -> * -> (* -> *) -> * -> *) = p C () () C++{- $run+    The "Control.Proxy.Core.Fast" and "Control.Proxy.Core.Correct" modules+    provide their corresponding 'runPipe' functions, specialized to their own+    'Proxy' implementations.++    Each implementation must supply its own 'runPipe' function since it is+    the only non-polymorphic 'Pipe' function and the compiler uses it to+    select which underlying proxy implementation to use. -}++{- $upgrade+    You can upgrade classic 'Pipe' code to work with the proxy ecosystem in+    steps.  Each change enables greater interoperability with proxy utilities+    and transformers and if time permits you should implement the entire upgrade+    for your libraries if you want to take advantage of proxy standard+    libraries.++    First, import "Control.Proxy" and "Control.Proxy.Pipe" instead of+    "Control.Pipe".  Then, add 'ProxyFast' after every 'Pipe', 'Producer', or+    'Consumer' in any type signature.  For example, you would convert this:++> import Control.Pipe+>+> fromList :: (Monad m) => [b] -> Producer b m ()+> fromList xs = mapM_ yield xs++    ... to this:++> import Control.Proxy+> import Control.Proxy.Pipe -- transition import+>+> fromList :: (Monad m) => [b] -> Producer ProxyFast b m ()+> fromList xs = mapM_ yield xs++    The change ensures that all your code now works in the 'ProxyFast' monad,+    which is the faster of the two proxy implementations.++    Second, modify all your 'Pipe's to take an empty '()' as their final+    argument, and translate the following functions:++    * ('<+<') to ('<-<')++    * 'runPipe' to 'runProxy'++    For example, you would convert this:++> import Control.Proxy+> import Control.Proxy.Pipe+>+> fromList :: (Monad m) => [b] -> Producer ProxyFast b m ()+> fromList xs = mapM_ yield xs++    ... to this:++> import Control.Proxy+> import Control.Proxy.Pipe+>+> fromList :: (Monad m) => [b] -> () -> Producer ProxyFast b m ()+> fromList xs () = mapM_ yield xs++    Now when you call these within a @do@ block  you must supplying an+    additional @()@ argument:++> examplePipe () = do+>     a <- request ()+>     fromList [1..a] ()++    This change lets you switch from pipe composition, ('<+<'), to proxy+    composition, ('<-<'), so that you can mix proxy utilities with pipes.++    Third, wrap your pipe's implementation in 'runIdentityP' (which+    "Control.Proxy" exports):++> import Control.Proxy+> import Control.Proxy.Pipe+>+> fromList xs () = runIdentityP $ mapM_ yield xs++    Then replace the 'ProxyFast' in the type signature with a type variable @p@+    constrained by the 'Proxy' type class:++> fromList :: (Monad m, Proxy p) => [b] -> () -> Producer p b m ()++    This change upgrades your 'Pipe' to work natively within proxies and proxy+    transformers, without any manual conversion or lifting.  You can now compose+    or sequence your 'Pipe' within any feature set transparently.++    Finally, replace each 'await' with @request ()@ and each 'yield' with+    'respond'.  Also, replace every 'Pipeline' with 'Session'.  This lets you+    drop the "Control.Proxy.Pipe" import:++> import Control.Proxy+>+> fromList :: (Monad m, Proxy p) => [b] -> () -> Producer p b m ()+> fromList xs () = runIdentityP $ mapM_ respond xs++    Also, I encourage you to continue using the 'Pipe', 'Consumer' and+    'Producer' type synonyms to simplify type signatures.  The following+    examples show how they cleanly mix with proxies and their extensions:++> import Control.Proxy+> import Control.Proxy.Trans.Either as E+> import Control.Proxy.Trans.State+>+> -- A Producer enriched with pipe-local state+> example1 :: (Monad m, Proxy p) => () -> Producer (StateP Int p) Int m r+> example1 () = forever $ do+>     n <- get+>     respond n+>     put (n + 1)+>+> -- A Consumer enriched with error-handling+> example2 :: (Proxy p) => () -> Consumer (EitherP String p) Int IO ()+> example2 () = do+>     n <- request ()+>     if (n == 0)+>         then E.throw "Error: received 0"+>         else lift $ print n++-}

@@ -1,6 +1,7 @@ -- | Entry point for the Control.Proxy.Prelude hierarchy  module Control.Proxy.Prelude (+    -- * Modules     -- $modules     module Control.Proxy.Prelude.Base,     module Control.Proxy.Prelude.IO,@@ -17,5 +18,4 @@     "Control.Proxy.Prelude.IO" provides proxies for simple 'IO'.      "Control.Proxy.Prelude.Kleisli" provides convenience functions for working-    with Kleisli arrows.--}+    with Kleisli arrows. -}

@@ -2,15 +2,19 @@  module Control.Proxy.Prelude.Base (     -- * Maps-    mapB,     mapD,     mapU,-    mapMB,+    mapB,     mapMD,     mapMU,-    execB,+    mapMB,+    useD,+    useU,+    useB,     execD,     execU,+    execB,+     -- * Filters     takeB,     takeB_,@@ -22,45 +26,94 @@     dropWhileU,     filterD,     filterU,+     -- * Lists     fromListS,     fromListC,+     -- * Enumerations     enumFromS,     enumFromC,     enumFromToS,-    enumFromToC-    ) where+    enumFromToC, -import Control.Monad (replicateM_, void, when, (>=>))-import Control.Monad.Trans.Class (lift)-import Control.Proxy.Class (request, respond, idT)-import Control.Proxy.Core (Proxy(..), Server, Client)-import Control.Proxy.Prelude.Kleisli (foreverK, replicateK)+    -- * Folds+    foldD,+    foldU,+    allD,+    allU,+    allD_,+    allU_,+    anyD,+    anyU,+    anyD_,+    anyU_,+    sumD,+    sumU,+    productD,+    productU,+    lengthD,+    lengthU,+    headD,+    headD_,+    headU,+    headU_,+    lastD,+    lastU,+    toListD,+    toListU,+    foldrD,+    foldrU,+    foldlD',+    foldlU', -{-| @(mapB f g)@ applies @f@ to all values going downstream and @g@ to all-    values going upstream.+    -- * Zips and Merges+    zipD,+    mergeD, -    Mnemonic: map \'@B@\'idirectional+    -- * Closed Adapters+    -- $open+    unitD,+    unitU, -> mapB f1 g1 >-> mapB f2 g2 = mapB (f2 . f1) (g1 . g2)->-> mapB id id = idT--}-mapB :: (Monad m) => (a -> b) -> (b' -> a') -> b' -> Proxy a' a b' b m r-mapB f g = go where-    go b' = Request (g b') (\a -> Respond (f a) go)--- mapB f g = foreverK $ request . g >=> respond . f+    -- * Modules+    -- $modules+    module Control.Monad.Trans.State.Strict,+    module Control.Monad.Trans.Writer.Strict,+    module Data.Monoid+    ) where +import Control.MFunctor (hoist)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Writer.Strict (+    WriterT(runWriterT), execWriterT, runWriter, tell )+import Control.Monad.Trans.State.Strict (+    StateT(runStateT), execStateT, runState, execState, get, put )+import Control.Proxy.Class+import Control.Proxy.Synonym+import Control.Proxy.Trans.Identity (runIdentityP, runIdentityK)+import Data.Monoid (+    Monoid,+    Endo(Endo, appEndo),+    All(All, getAll),+    Any(Any, getAny),+    Sum(Sum, getSum),+    Product(Product, getProduct),+    First(First, getFirst),+    Last(Last, getLast) )+ {-| @(mapD f)@ applies @f@ to all values going \'@D@\'ownstream.  > mapD f1 >-> mapD f2 = mapD (f2 . f1) > > mapD id = idT -}-mapD :: (Monad m) => (a -> b) -> x -> Proxy x a x b m r-mapD f = go where-    go x = Request x (\a -> Respond (f a) go)+mapD :: (Monad m, Proxy p) => (a -> b) -> x -> p x a x b m r+mapD f = runIdentityK go where+    go x = do+        a  <- request x+        x2 <- respond (f a)+        go x2 -- mapD f = foreverK $ request >=> respond . f  {-| @(mapU g)@ applies @g@ to all values going \'@U@\'pstream.@@ -69,26 +122,30 @@ > > mapU id = idT -}-mapU :: (Monad m) => (b' -> a') -> b' -> Proxy a' x b' x m r-mapU g = go where-    go b' = Request (g b') (\x -> Respond x go)+mapU :: (Monad m, Proxy p) => (b' -> a') -> b' -> p a' x b' x m r+mapU g = runIdentityK go where+    go b' = do+        x   <- request (g b')+        b'2 <- respond x+        go b'2 -- mapU g = foreverK $ (request . g) >=> respond -{-| @(mapMB f g)@ applies the monadic function @f@ to all values going-    downstream and the monadic function @g@ to all values going upstream.+{-| @(mapB f g)@ applies @f@ to all values going downstream and @g@ to all+    values going upstream. -> mapMB f1 g1 >-> mapMB f2 g2 = mapMB (f1 >=> f2) (g2 >=> g1)+    Mnemonic: map \'@B@\'idirectional++> mapB f1 g1 >-> mapB f2 g2 = mapB (f2 . f1) (g1 . g2) >-> mapMB return return = idT+> mapB id id = idT -}-mapMB :: (Monad m) => (a -> m b) -> (b' -> m a') -> b' -> Proxy a' a b' b m r-mapMB f g = go where-    go b' =-        M (g b' >>= \a' -> return (-        Request a' (\a ->-        M (f a >>= \b -> return (-        Respond b go )))))--- mapMB f g = foreverK $ lift . g >=> request >=> lift . f >=> respond+mapB :: (Monad m, Proxy p) => (a -> b) -> (b' -> a') -> b' -> p a' a b' b m r+mapB f g = runIdentityK go where+    go b' = do+        a   <- request (g b')+        b'2 <- respond (f a )+        go b'2+-- mapB f g = foreverK $ request . g >=> respond . f  {-| @(mapMD f)@ applies the monadic function @f@ to all values going downstream @@ -96,13 +153,14 @@ > > mapMD return = idT -}-mapMD :: (Monad m) => (a -> m b) -> x -> Proxy x a x b m r-mapMD f = go where-    go x =-        Request x (\a ->-        M (f a >>= \b -> return (-        Respond b go )))--- mapMDf = foreverK $ request >=> lift . f >=> respond+mapMD :: (Monad m, Proxy p) => (a -> m b) -> x -> p x a x b m r+mapMD f = runIdentityK go where+    go x = do+        a  <- request x+        b  <- lift (f a)+        x2 <- respond b+        go x2+-- mapMD f = foreverK $ request >=> lift . f >=> respond  {-| @(mapMU g)@ applies the monadic function @g@ to all values going upstream @@ -110,92 +168,166 @@ > > mapMU return = idT -}-mapMU :: (Monad m) => (b' -> m a') -> b' -> Proxy a' x b' x m r-mapMU g = go where-    go b' =-        M (g b' >>= \a' -> return (-        Request a' (\x ->-        Respond x go )))+mapMU :: (Monad m, Proxy p) => (b' -> m a') -> b' -> p a' x b' x m r+mapMU g = runIdentityK go where+    go b' = do+        a'  <- lift (g b')+        x   <- request a'+        b'2 <- respond x+        go b'2 -- mapMU g = foreverK $ lift . g >=> request >=> respond -{-| @(execB md mu)@ executes @mu@ every time values flow upstream through it,-    and executes @md@ every time values flow downstream through it.+{-| @(mapMB f g)@ applies the monadic function @f@ to all values going+    downstream and the monadic function @g@ to all values going upstream. -> execB md1 mu1 >-> execB md2 mu2 = execB (md1 >> md2) (mu2 >> mu1)+> mapMB f1 g1 >-> mapMB f2 g2 = mapMB (f1 >=> f2) (g2 >=> g1) >-> execB (return ()) = idT+> mapMB return return = idT -}-execB :: (Monad m) => m () -> m () -> a' -> Proxy a' a a' a m r-execB md mu = go where-    go a' =-        M (mu >>= \_ -> return (-        Request a' (\a ->-        M (md >>= \_ -> return (-        Respond a go )))))-{- execB md mu = foreverK $ \a' -> do-    lift mu-    a <- request a'-    lift md-    respond a -}+mapMB+ :: (Monad m, Proxy p) => (a -> m b) -> (b' -> m a') -> b' -> p a' a b' b m r+mapMB f g = runIdentityK go where+    go b' = do+        a'  <- lift (g b')+        a   <- request a'+        b   <- lift (f a )+        b'2 <- respond b+        go b'2+-- mapMB f g = foreverK $ lift . g >=> request >=> lift . f >=> respond -{-| @execD md)@ executes @md@ every time values flow downstream through it.+{-| @(useD f)@ executes the monadic function @f@ on all values flowing+    \'@D@\'ownstream +> useD f1 >-> useD f2 = useD (\a -> f1 a >> f2 a)+>+> useD (\_ -> return ()) = idT+-}+useD :: (Monad m, Proxy p) => (a -> m r1) -> x -> p x a x a m r+useD f = runIdentityK go where+    go x = do+        a  <- request x+        lift $ f a+        x2 <- respond a+        go x2++{-| @(useU g)@ executes the monadic function @g@ on all values flowing+    \'@U@\'pstream++> useU g1 >-> useU g2 = useU (\a' -> g2 a' >> g1 a')+>+> useU (\_ -> return ()) = idT+-}+useU :: (Monad m, Proxy p) => (a' -> m r2) -> a' -> p a' x a' x m r+useU g = runIdentityK go where+    go a' = do+        lift $ g a'+        x   <- request a'+        a'2 <- respond x+        go a'2++{-| @(useB f g)@ executes the monadic function @f@ on all values flowing+    downstream and the monadic function @g@ on all values flowing upstream++> useB f1 g1 >-> useB f2 g2 = useB (\a -> f1 a >> f2 a) (\a' -> g2 a' >> g1 a')+>+> useB (\_ -> return ()) (\_ -> return ()) = idT+-}+useB+ :: (Monad m, Proxy p) => (a -> m r1) -> (a' -> m r2) -> a' -> p a' a a' a m r+useB f g = runIdentityK go where+    go a' = do+        lift $ g a'+        a   <- request a'+        lift $ f a+        a'2 <- respond a+        go a'2++{-| @(execD md)@ executes @md@ every time values flow downstream through it.+ > execD md1 >-> execD md2 = execD (md1 >> md2) > > execD (return ()) = idT -}-execD :: (Monad m) => m () -> a' -> Proxy a' a a' a m r-execD md = go where-    go a' =-        Request a' (\a ->-        M (md >>= \_ -> return (-        Respond a go )))+execD :: (Monad m, Proxy p) => m r1 -> a' -> p a' a a' a m r+execD md = runIdentityK go where+    go a' = do+        a   <- request a'+        lift md+        a'2 <- respond a+        go a'2 {- execD md = foreverK $ \a' -> do     a <- request a'     lift md     respond a -} -{-| @execU mu)@ executes @mu@ every time values flow upstream through it.+{-| @(execU mu)@ executes @mu@ every time values flow upstream through it.  > execU mu1 >-> execU mu2 = execU (mu2 >> mu1) > > execU (return ()) = idT -}-execU :: (Monad m) => m () -> a' -> Proxy a' a a' a m r-execU mu = go where-    go a' =-        M (mu >>= \_ -> return (-        Request a' (\a ->-        Respond a go )))+execU :: (Monad m, Proxy p) => m r2 -> a' -> p a' a a' a m r+execU mu = runIdentityK go where+    go a' = do+        lift mu+        a   <- request a'+        a'2 <- respond a+        go a'2 {- execU mu = foreverK $ \a' -> do     lift mu     a <- request a'     respond a -} +{-| @(execB md mu)@ executes @mu@ every time values flow upstream through it,+    and executes @md@ every time values flow downstream through it.++> execB md1 mu1 >-> execB md2 mu2 = execB (md1 >> md2) (mu2 >> mu1)+>+> execB (return ()) = idT+-}+execB :: (Monad m, Proxy p) => m r1 -> m r2 -> a' -> p a' a a' a m r+execB md mu = runIdentityK go where+    go a' = do+        lift mu+        a   <- request a'+        lift md+        a'2 <- respond a+        go a'2+{- execB md mu = foreverK $ \a' -> do+    lift mu+    a <- request a'+    lift md+    respond a -}+ {-| @(takeB n)@ allows @n@ upstream/downstream roundtrips to pass through  > takeB n1 >=> takeB n2 = takeB (n1 + n2)  -- n1 >= 0 && n2 >= 0 > > takeB 0 = return -}-takeB :: (Monad m) => Int -> a' -> Proxy a' a a' a m a'-takeB n0 = go n0 where+takeB :: (Monad m, Proxy p) => Int -> a' -> p a' a a' a m a'+takeB n0 = runIdentityK (go n0) where     go n-        | n <= 0    = Pure-        | otherwise = \a' -> Request a' (\a -> Respond a (go (n - 1)))+        | n <= 0    = return+        | otherwise = \a' -> do+             a   <- request a'+             a'2 <- respond a+             go (n - 1) a'2 -- takeB n = replicateK n $ request >=> respond  -- | 'takeB_' is 'takeB' with a @()@ return value, convenient for composing-takeB_ :: (Monad m) => Int -> a' -> Proxy a' a a' a m ()-takeB_ n0 = go n0 where+takeB_ :: (Monad m, Proxy p) => Int -> a' -> p a' a a' a m ()+takeB_ n0 = runIdentityK (go n0) where     go n-        | n <= 0    = \_ -> Pure ()-        | otherwise = \a' -> Request a' (\a -> Respond a (go (n - 1)))-    +        | n <= 0    = \_ -> return ()+        | otherwise = \a' -> do+            a   <- request a'+            a'2 <- respond a+            go (n - 1) a'2 -- takeB_ n = fmap void (takeB n) -{-| @takeWhileD p@ allows values to pass downstream so long as they satisfy the-     predicate @p@.+{-| @(takeWhileD p)@ allows values to pass downstream so long as they satisfy+    the predicate @p@.  > -- Using the "All" monoid over functions: > mempty = \_ -> True@@ -205,41 +337,32 @@ > > takeWhileD mempty = idT -}-takeWhileD :: (Monad m) => (a -> Bool) -> a' -> Proxy a' a a' a m ()-takeWhileD p = go where-    go a' =-        Request a' (\a ->-        if (p a)-        then Respond a go-        else Pure () )-{-  go a' = do+takeWhileD :: (Monad m, Proxy p) => (a -> Bool) -> a' -> p a' a a' a m ()+takeWhileD p = runIdentityK go where+    go a' = do         a <- request a'         if (p a)-        then do-            a'2 <- respond a-            go a'2-        else return () -}+            then do+                a'2 <- respond a+                go a'2+            else return () -{-| @takeWhileU p@ allows values to pass upstream so long as they satisfy the+{-| @(takeWhileU p)@ allows values to pass upstream so long as they satisfy the     predicate @p@.  > takeWhileU p1 >-> takeWhileU p2 = takeWhileU (p1 <> p2) > > takeWhileD mempty = idT -}-takeWhileU :: (Monad m) => (a' -> Bool) -> a' -> Proxy a' a a' a m ()-takeWhileU p = go where+takeWhileU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' a a' a m ()+takeWhileU p = runIdentityK go where     go a' =         if (p a')-        then Request a' (\a -> Respond a go)-        else Pure ()-{-  go a' =-        if (p a')-        then do-            a <- request a'-            a'2 <- respond a-            go a'2-        else return () -}+            then do+                a   <- request a'+                a'2 <- respond a+                go a'2+            else return_P ()  {-| @(dropD n)@ discards @n@ values going downstream @@ -247,11 +370,13 @@ > > dropD 0 = idT -}-dropD :: (Monad m) => Int -> () -> Proxy () a () a m r-dropD n0 = \() -> go n0 where+dropD :: (Monad m, Proxy p) => Int -> () -> Pipe p a a m r+dropD n0 = \() -> runIdentityP (go n0) where     go n         | n <= 0    = idT ()-        | otherwise = Request () (\_ -> go (n - 1))+        | otherwise = do+            request ()+            go (n - 1) {- dropD n () = do     replicateM_ n $ request ()     idT () -}@@ -262,21 +387,15 @@ > > dropU 0 = idT -}-dropU :: (Monad m) => Int -> a' -> Proxy a' () a' () m r-dropU n0-    | n0 <= 0    = idT-    | otherwise = go (n0 - 1) where-        go n-            | n <= 0    = \_ -> Respond () idT-            | otherwise = \_ -> Respond () (go (n - 1))-{- dropU n a'-    | n <= 0    = idT a'-    | otherwise = do-        replicateM_ (n - 1) $ respond ()-        a'2 <- respond ()-        idT a'2 -}+dropU :: (Monad m, Proxy p) => Int -> a' -> CoPipe p a' a' m r+dropU n0 = runIdentityK (go n0) where+    go n+        | n <= 0    = idT+        | otherwise = \_ -> do+            a' <- respond ()+            go (n - 1) a' -{-| @(dropWhileD p)@ discards values going upstream until one violates the+{-| @(dropWhileD p)@ discards values going downstream until one violates the     predicate @p@.  > -- Using the "Any" monoid over functions:@@ -287,33 +406,31 @@ > > dropWhileD mempty = idT -}-dropWhileD :: (Monad m) => (a -> Bool) -> () -> Proxy () a () a m r-dropWhileD p () = go where-    go = Request () (\a -> if (p a) then go else Respond a idT)-{-  go = do+dropWhileD :: (Monad m, Proxy p) => (a -> Bool) -> () -> Pipe p a a m r+dropWhileD p () = runIdentityP go where+    go = do         a <- request ()         if (p a)-        then go-        else do-            respond a-            idT () -}+            then go+            else do+                x <- respond a+                idT x -{-| @(dropWhileU p)@ discards values going downstream until one violates the+{-| @(dropWhileU p)@ discards values going upstream until one violates the     predicate @p@.  > dropWhileU p1 >-> dropWhileU p2 = dropWhileU (p1 <> p2) > > dropWhileU mempty = idT -}-dropWhileU :: (Monad m) => (a' -> Bool) -> a' -> Proxy a' () a' () m r-dropWhileU p = go where-    go a' = if (p a') then Respond () go else idT a'-{-  go a' =+dropWhileU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> CoPipe p a' a' m r+dropWhileU p = runIdentityK go where+    go a' =         if (p a')-        then do-            a'2 <- respond ()-            go a'2-        else idT a' -}+            then do+                a2 <- respond ()+                go a2+            else idT a'  {-| @(filterD p)@ discards values going downstream if they fail the predicate     @p@@@ -326,13 +443,15 @@ > > filterD mempty = idT -}-filterD :: (Monad m) => (a -> Bool) -> () -> Proxy () a () a m r-filterD p = \() ->  go where-    go = Request () (\a -> if (p a) then Respond a (\_ -> go) else go)-{-  go = do+filterD :: (Monad m, Proxy p) => (a -> Bool) -> () -> Pipe p a a m r+filterD p = \() -> runIdentityP go where+    go = do         a <- request ()-        when (p a) $ respond a-        go -}+        if (p a)+            then do+                respond a+                go+            else go  {-| @(filterU p)@ discards values going upstream if they fail the predicate @p@ @@ -340,65 +459,346 @@ > > filterU mempty = idT -}-filterU :: (Monad m) => (a' -> Bool) -> a' -> Proxy a' () a' () m r-filterU p a'0 = go a'0 where+filterU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> CoPipe p a' a' m r+filterU p = runIdentityK go where     go a' =         if (p a')-        then Request a' (\_ -> Respond () go)-        else Respond () go-{-  go a' = do-        when (p a') $ request a'-        a'2 <- respond ()-        go a'2 -}+        then do+            request a'+            a'2 <- respond ()+            go a'2+        else do+            a'2 <- respond ()+            go a'2 -{-| Convert a list into a 'Server'+{-| Convert a list into a 'Producer'  > fromListS xs >=> fromListS ys = fromListS (xs ++ ys) > > fromListS [] = return -}-fromListS :: (Monad m) => [a] -> () -> Proxy x' x () a m ()-fromListS xs = \_ -> foldr (\e a -> Respond e (\_ -> a)) (Pure ()) xs-{-# INLINE fromListS #-}+fromListS :: (Monad m, Proxy p) => [b] -> () -> Producer p b m ()+fromListS xs = \_ -> foldr (\e a -> respond e ?>= \_ -> a) (return_P ()) xs -- fromListS xs _ = mapM_ respond xs -{-| Convert a list into a 'Client'+{-| Convert a list into a 'CoProducer'  > fromListC xs >=> fromListC ys = fromListC (xs ++ ys) > > fromListC [] = return -}-fromListC :: (Monad m) => [a] -> () -> Proxy a x () y m ()-fromListC xs = \_ -> foldr (\e a -> Request e (\_ -> a)) (Pure ()) xs-{-# INLINE fromListC #-}+fromListC :: (Monad m, Proxy p) => [a'] -> () -> CoProducer p a' m ()+fromListC xs = \_ -> foldr (\e a -> request e ?>= \_ -> a) (return_P ()) xs -- fromListC xs _ = mapM_ request xs --- | 'Server' version of 'enumFrom'-enumFromS :: (Enum a, Monad m) => a -> y' -> Proxy x' x y' a m r-enumFromS a0 = \_ -> go a0 where-    go a = Respond a (\_ -> go (succ a))-{-  go a = do-        _ <- respond a-        go (succ a) -}+-- | 'Producer' version of 'enumFrom'+enumFromS :: (Enum b, Monad m, Proxy p) => b -> () -> Producer p b m r+enumFromS b0 = \_ -> runIdentityP (go b0) where+    go b = do+        respond b+        go (succ b) --- | 'Client' version of 'enumFrom'-enumFromC :: (Enum a, Monad m) => a -> y' -> Proxy a x y' y m r-enumFromC a0 = \_ -> go a0 where-    go a = Request a (\_ -> go (succ a))-{-  go a = do-        _ <- request a-        go (succ a) -}+-- | 'CoProducer' version of 'enumFrom'+enumFromC :: (Enum a', Monad m, Proxy p) => a' -> () -> CoProducer p a' m r+enumFromC a'0 = \_ -> runIdentityP (go a'0) where+    go a' = do+        request a'+        go (succ a') --- | 'Server' version of 'enumFromTo'-enumFromToS :: (Enum a, Ord a, Monad m) => a -> a -> y' -> Proxy x' x y' a m ()-enumFromToS a1 a2 _ = go a1 where-    go n-        | n > a2    = Pure ()-        | otherwise = Respond n (\_ -> go (succ n))+-- | 'Producer' version of 'enumFromTo'+enumFromToS+ :: (Enum b, Ord b, Monad m, Proxy p) => b -> b -> () -> Producer p b m ()+enumFromToS b1 b2 _ = runIdentityP (go b1) where+    go b+        | b > b2    = return ()+        | otherwise = do+            respond b+            go (succ b) --- | 'Client' version of 'enumFromTo'-enumFromToC :: (Enum a, Ord a, Monad m) => a -> a -> y' -> Proxy a x y' y m ()-enumFromToC a1 a2 _ = go a1 where+-- | 'CoProducer' version of 'enumFromTo'+enumFromToC+ :: (Enum a', Ord a', Monad m, Proxy p)+ => a' -> a' -> () -> CoProducer p a' m ()+enumFromToC a1 a2 _ = runIdentityP (go a1) where     go n-        | n > a2 = Pure ()-        | otherwise = Request n (\_ -> go (succ n))+        | n > a2 = return ()+        | otherwise = do+            request n+            go (succ n)++{-| Fold values flowing \'@D@\'ownstream++> foldD f >-> foldD g = foldD (f <> g)+>+> foldD mempty = idT+-}+foldD+ :: (Monad m, Proxy p, Monoid w) => (a -> w) -> x -> p x a x a (WriterT w m) r+foldD f = runIdentityK go where+    go x = do+        a <- request x+        lift $ tell $ f a+        x2 <- respond a+        go x2++{-| Fold values flowing \'@U@\'pstream++> foldU f >-> foldU g = foldU (g <> f)+>+> foldU mempty = idT+-}+foldU+ :: (Monad m, Proxy p, Monoid w)+ => (a' -> w) -> a' -> p a' x a' x (WriterT w m) r+foldU f = runIdentityK go where+    go a' = do+        lift $ tell $ f a'+        x <- request a'+        a'2 <- respond x+        go a'2++{-| Fold that returns whether 'All' values flowing \'@D@\'ownstream satisfy the+    predicate -}+allD :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT All m) r+allD pred = foldD (All . pred)++{-| Fold that returns whether 'All' values flowing \'@U@\'pstream satisfy the+    predicate -}+allU+ :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT All m) r+allU pred = foldU (All . pred)++{-| Fold that returns whether 'All' values flowing \'@D@\'ownstream satisfy the+    predicate++    'allD_' terminates on the first value that fails the predicate -}+allD_ :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT All m) ()+allD_ pred = runIdentityK go where+    go x = do+        a <- request x+        if (pred a)+            then do+                x2 <- respond a+                go x2+            else lift $ tell $ All False++{-| Fold that returns whether 'All' values flowing \'@U@\'pstream satisfy the+    predicate++    'allU_' terminates on the first value that fails the predicate -}+allU_+ :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT All m) ()+allU_ pred = runIdentityK go where+    go a' =+        if (pred a')+            then do+                x   <- request a'+                a'2 <- respond x+                go a'2+            else lift $ tell $ All False++{-| Fold that returns whether 'Any' value flowing \'@D@\'ownstream satisfies+    the predicate -}+anyD :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT Any m) r+anyD pred = foldD (Any . pred)++{-| Fold that returns whether 'Any' value flowing \'@U@\'pstream satisfies+    the predicate -}+anyU+ :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT Any m) r+anyU pred = foldU (Any . pred)++{-| Fold that returns whether 'Any' value flowing \'@D@\'ownstream satisfies the+    predicate++    'anyD_' terminates on the first value that satisfies the predicate -}+anyD_ :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT Any m) ()+anyD_ pred = runIdentityK go where+    go x = do+        a <- request x+        if (pred a)+            then lift $ tell $ Any True+            else do+                x2 <- respond a+                go x2++{-| Fold that returns whether 'Any' value flowing \'@U@\'pstream satisfies the+    predicate++    'anyU_' terminates on the first value that satisfies the predicate -}+anyU_+ :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT Any m) ()+anyU_ pred = runIdentityK go where+    go a' =+        if (pred a')+            then lift $ tell $ Any True+            else do+                x   <- request a'+                a'2 <- respond x+                go a'2++-- | Compute the 'Sum' of all values that flow \'@D@\'ownstream+sumD :: (Monad m, Proxy p, Num a) => x -> p x a x a (WriterT (Sum a) m) r+sumD = foldD Sum++-- | Compute the 'Sum' of all values that flow \'@U@\'pstream+sumU :: (Monad m, Proxy p, Num a') => a' -> p a' x a' x (WriterT (Sum a') m) r+sumU = foldU Sum++-- | Compute the 'Product' of all values that flow \'@D@\'ownstream+productD+ :: (Monad m, Proxy p, Num a) => x -> p x a x a (WriterT (Product a) m) r+productD = foldD Product++-- | Compute the 'Product' of all values that flow \'@U@\'pstream+productU+ :: (Monad m, Proxy p, Num a') => a' -> p a' x a' x (WriterT (Product a') m) r+productU = foldU Product++-- | Count how many values flow \'@D@\'ownstream+lengthD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (Sum Int) m) r+lengthD = foldD (\_ -> Sum 1)++-- | Count how many values flow \'@U@\'pstream+lengthU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (Sum Int) m) r+lengthU = foldU (\_ -> Sum 1)++-- | Retrieve the first value going \'@D@\'ownstream+headD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (First a) m) r+headD = foldD (First . Just)++{-| Retrieve the first value going \'@D@\'ownstream++    'headD_' terminates on the first value it receives -}+headD_ :: (Monad m, Proxy p) => x -> p x a x a (WriterT (First a) m) ()+headD_ x = runIdentityP $ do+    a <- request x+    lift $ tell $ First (Just a)++-- | Retrieve the first value going \'@U@\'pstream+headU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (First a') m) r+headU = foldU (First . Just)++{-| Retrieve the first value going \'@U@\'pstream++    'headU_' terminates on the first value it receives -}+headU_ :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (First a') m) ()+headU_ a' = runIdentityP $ lift $ tell $ First (Just a')++-- | Retrieve the last value going \'@D@\'ownstream+lastD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (Last a) m) r+lastD = foldD (Last . Just)++-- | Retrieve the last value going \'@U@\'pstream+lastU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (Last a') m) r+lastU = foldU (Last . Just)++-- | Fold the values flowing \'@D@\'ownstream into a list+toListD :: (Monad m, Proxy p) => x -> p x a x a (WriterT [a] m) r+toListD = foldD (\x -> [x])++-- | Fold the values flowing \'@U@\'pstream into a list+toListU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT [a'] m) r+toListU = foldU (\x -> [x])++{-| Fold equivalent to 'foldr'++    To see why, consider this isomorphic type for 'foldr':++> foldr :: (a -> b -> b) -> [a] -> Endo b+-}+foldrD+ :: (Monad m, Proxy p) => (a -> b -> b) -> x -> p x a x a (WriterT (Endo b) m) r+foldrD step = foldD (Endo . step)++-- | Fold equivalent to 'foldr'+foldrU+ :: (Monad m, Proxy p)+ => (a' -> b -> b) -> a' -> p a' x a' x (WriterT (Endo b) m) r+foldrU step = foldU (Endo . step)++-- | Left strict fold over \'@D@\'ownstream values+foldlD'+ :: (Monad m, Proxy p) => (b -> a -> b) -> x -> p x a x a (StateT b m) r+foldlD' f = runIdentityK go where+    go x = do+        a  <- request x+        lift $ do+            b <- get+            put $! f b a+        x2 <- respond a+        go x2++-- | Left strict fold over \'@U@\'pstream values+foldlU'+ :: (Monad m, Proxy p) => (b -> a' -> b) -> a' -> p a' x a' x (StateT b m) r+foldlU' f = runIdentityK go where+    go a' = do+        lift $ do+            b <- get+            put $! f b a'+        x   <- request a'+        a'2 <- respond x+        go a'2++-- | Zip values flowing downstream+zipD+ :: (Monad m, Proxy p1, Proxy p2, Proxy p3)+ => () -> Consumer p1 a (Consumer p2 b (Producer p3 (a, b) m)) r+zipD () = runIdentityP $ hoist (runIdentityP . hoist runIdentityP) go where+    go = do+        a <- request ()+        lift $ do+            b <- request ()+            lift $ respond (a, b)+        go++-- | Interleave values flowing downstream using simple alternation+mergeD+ :: (Monad m, Proxy p1, Proxy p2, Proxy p3)+ => () -> Consumer p1 a (Consumer p2 a (Producer p3 a m)) r+mergeD () = runIdentityP $ hoist (runIdentityP . hoist runIdentityP) go where+    go = do+        a1 <- request ()+        lift $ do+            lift $ respond a1+            a2 <- request ()+            lift $ respond a2+        go++{- $open+    Use the @unit@ functions when you need to embed a proxy with a closed end+    within an open proxy.  For example, the following code will not type-check+    because @fromListS [1..]@  is a 'Producer' and has a closed upstream end,+    which conflicts with the 'request' statement preceding it:++> p () = do+>     request ()+>     fromList [1..] ()++    You fix this by composing 'unitD' upstream of it, which replaces its closed+    upstream end with an open polymorphic end:++> p () = do+>     request ()+>     (fromList [1..] <-< unitD) ()++-}++-- | Compose 'unitD' with a closed upstream end to create a polymorphic end+unitD :: (Monad m, Proxy p) => y' -> p x' x y' () m r+unitD _ = runIdentityP go where+    go = do+        respond ()+        go++-- | Compose 'unitU' with a closed downstream end to create a polymorphic end+unitU :: (Monad m, Proxy p) => y' -> p () x y' y m r+unitU _ = runIdentityP go where+    go = do+        request ()+        go++{- $modules+    These modules help you build, run, and extract folds+-}

@@ -3,8 +3,7 @@     Note that 'String's are very inefficient, and I will release future separate     packages with 'ByteString' and 'Text' operations.  I only provide these to     allow users to test simple I/O without requiring additional library-    dependencies.--}+    dependencies. -}  module Control.Proxy.Prelude.IO (     -- * Standard I/O@@ -25,45 +24,46 @@     promptC,     -- * Handle I/O     -- ** Input-    hGetLineD,-    hGetLineU,+    hGetLineS,+    hGetLineC,     -- ** Output     hPrintB,     hPrintD,     hPrintU,     hPutStrLnB,     hPutStrLnD,-    hPutStrLnU+    hPutStrLnU,     ) where  import Control.Monad (forever) import Control.Monad.Trans.Class (lift) import Control.Proxy.Prelude.Kleisli (foreverK)-import Control.Proxy.Core (Proxy, Client, Server)-import Control.Proxy.Class (request, respond)-import System.IO (Handle, hGetLine, hPutStr, hPutStrLn, hPrint, stdin, stdout)+import Control.Proxy.Class (Proxy(request, respond))+import Control.Proxy.Trans.Identity (runIdentityP, runIdentityK)+import Control.Proxy.Synonym (Client, Server, Producer, CoProducer)+import qualified System.IO as IO --- | Get input from 'stdin' one line at a time and send \'@D@\'ownstream-getLineS :: y' -> Proxy x' x y' String IO r-getLineS _ = forever $ do+-- | A 'Producer' that sends lines from 'stdin' downstream+getLineS :: (Proxy p) => () -> Producer p String IO r+getLineS () = runIdentityP $ forever $ do     str <- lift getLine     respond str --- | Get input from 'stdin' one line at a time and send \'@U@\'pstream-getLineC :: y' -> Proxy String x y' y IO r-getLineC _ = forever $ do+-- | A 'CoProducer' that sends lines from 'stdin' upstream+getLineC :: (Proxy p) => () -> CoProducer p String IO r+getLineC () = runIdentityP $ forever $ do     str <- lift getLine     request str  -- | 'read' input from 'stdin' one line at a time and send \'@D@\'ownstream-readLnS :: (Read a) => y' -> Proxy x' x y' a IO r-readLnS _ = forever $ do+readLnS :: (Read b, Proxy p) => () -> Producer p b IO r+readLnS () = runIdentityP $ forever $ do     a <- lift readLn     respond a  -- | 'read' input from 'stdin' one line at a time and send \'@U@\'pstream-readLnC :: (Read a) => y' -> Proxy a x y' y IO r-readLnC _ = forever $ do+readLnC :: (Read a', Proxy p) => () -> CoProducer p a' IO r+readLnC () = runIdentityP $ forever $ do     a <- lift readLn     request a @@ -71,8 +71,8 @@      Prefixes upstream values with \"@U: @\" and downstream values with \"@D: @\" -}-printB :: (Show a, Show a') => a' -> Proxy a' a a' a IO r-printB = foreverK $ \a' -> do+printB :: (Show a', Show a, Proxy p) => a' -> p a' a a' a IO r+printB = runIdentityK $ foreverK $ \a' -> do     lift $ do         putStr "U: "         print a'@@ -83,15 +83,15 @@     respond a  -- | 'print's all values flowing \'@D@\'ownstream to 'stdout'-printD :: (Show a) => x -> Proxy x a x a IO r-printD = foreverK $ \x -> do+printD :: (Show a, Proxy p) => x -> p x a x a IO r+printD = runIdentityK $ foreverK $ \x -> do     a <- request x     lift $ print a     respond a  -- | 'print's all values flowing \'@U@\'pstream to 'stdout'-printU :: (Show a') => a' -> Proxy a' x a' x IO r-printU = foreverK $ \a' -> do+printU :: (Show a', Proxy p) => a' -> p a' x a' x IO r+printU = runIdentityK $ foreverK $ \a' -> do     lift $ print a'     x <- request a'     respond x@@ -100,8 +100,8 @@      Prefixes upstream values with \"@U: @\" and downstream values with \"@D: @\" -}-putStrLnB :: String -> Proxy String String String String IO r-putStrLnB = foreverK $ \a' -> do+putStrLnB :: (Proxy p) => String -> p String String String String IO r+putStrLnB = runIdentityK $ foreverK $ \a' -> do     lift $ do         putStr "U: "         putStrLn a'@@ -112,72 +112,84 @@     respond a  -- | 'putStrLn's all values flowing \'@D@\'ownstream to 'stdout'-putStrLnD :: x -> Proxy x String x String IO r-putStrLnD = foreverK $ \x -> do+putStrLnD :: (Proxy p) => x -> p x String x String IO r+putStrLnD = runIdentityK $ foreverK $ \x -> do     a <- request x     lift $ putStrLn a     respond a  -- | 'putStrLn's all values flowing \'@U@\'pstream to 'stdout'-putStrLnU :: String -> Proxy String x String x IO r-putStrLnU = foreverK $ \a' -> do+putStrLnU :: (Proxy p) => String -> p String x String x IO r+putStrLnU = runIdentityK $ foreverK $ \a' -> do     lift $ putStrLn a'     x <- request a'     respond x  -- | Convert 'stdin'/'stdout' into a line-based 'Server'-promptS :: String -> Proxy x' x String String IO r-promptS = foreverK $ \send -> do+promptS :: (Proxy p) => String -> Server p String String IO r+promptS = runIdentityK $ foreverK $ \send -> do     recv <- lift $ do         putStrLn send         getLine     respond recv  -- | Convert 'stdin'/'stdout' into a line-based 'Client'-promptC :: y' -> Proxy String String y' y IO r-promptC _ = forever $ do+promptC :: (Proxy p) => () -> Client p String String IO r+promptC () = runIdentityP $ forever $ do     send <- lift getLine     recv <- request send     lift $ putStrLn recv --- | Get input from a handle one line at a time and send \'@D@\'ownstream-hGetLineD :: Handle -> y' -> Proxy x' x y' String IO r-hGetLineD h _ = forever $ do-    str <- lift $ hGetLine h-    respond str+-- | A 'Producer' that sends lines from a handle downstream+hGetLineS :: (Proxy p) => IO.Handle -> () -> Producer p String IO ()+hGetLineS h () = runIdentityP go where+    go = do+        eof <- lift $ IO.hIsEOF h+        if eof+            then return ()+            else do+                str <- lift $ IO.hGetLine h+                respond str+                go --- | Get input from a handle one line at a time and send \'@U@\'pstream-hGetLineU :: Handle -> y' -> Proxy String x y' y IO r-hGetLineU h _ = forever $ do-    str <- lift $ hGetLine h-    request str+-- | A 'CoProducer' that sends lines from a 'Handle' upstream+hGetLineC :: (Proxy p) => IO.Handle -> () -> CoProducer p String IO ()+hGetLineC h () = runIdentityP go where+    go = do+        eof <- lift $ IO.hIsEOF h+        if eof+            then return ()+            else do+                str <- lift $ IO.hGetLine h+                request str+                go  {-| 'print's all values flowing through it to a 'Handle'      Prefixes upstream values with \"@U: @\" and downstream values with \"@D: @\" -}-hPrintB :: (Show a, Show a') => Handle -> a' -> Proxy a' a a' a IO r-hPrintB h = foreverK $ \a' -> do+hPrintB :: (Show a, Show a', Proxy p) => IO.Handle -> a' -> p a' a a' a IO r+hPrintB h = runIdentityK $ foreverK $ \a' -> do     lift $ do-        hPutStr h "U: "-        hPrint h a'+        IO.hPutStr h "U: "+        IO.hPrint h a'     a <- request a'     lift $ do-        hPutStr h "D: "-        hPrint h a+        IO.hPutStr h "D: "+        IO.hPrint h a     respond a  -- | 'print's all values flowing \'@D@\'ownstream to a 'Handle'-hPrintD :: (Show a) => Handle -> x -> Proxy x a x a IO r-hPrintD h = foreverK $ \x -> do+hPrintD :: (Show a, Proxy p) => IO.Handle -> x -> p x a x a IO r+hPrintD h = runIdentityK $ foreverK $ \x -> do     a <- request x-    lift $ hPrint h a+    lift $ IO.hPrint h a     respond a  -- | 'print's all values flowing \'@U@\'pstream to a 'Handle'-hPrintU :: (Show a') => Handle -> a' -> Proxy a' x a' x IO r-hPrintU h = foreverK $ \a' -> do-    lift $ hPrint h a'+hPrintU :: (Show a', Proxy p) => IO.Handle -> a' -> p a' x a' x IO r+hPrintU h = runIdentityK $ foreverK $ \a' -> do+    lift $ IO.hPrint h a'     x <- request a'     respond x @@ -185,27 +197,28 @@      Prefixes upstream values with \"@U: @\" and downstream values with \"@D: @\" -}-hPutStrLnB :: Handle -> String -> Proxy String String String String IO r-hPutStrLnB h = foreverK $ \a' -> do+hPutStrLnB+ :: (Proxy p) => IO.Handle -> String -> p String String String String IO r+hPutStrLnB h = runIdentityK $ foreverK $ \a' -> do     lift $ do-        hPutStr h "U: "-        hPutStrLn h a'+        IO.hPutStr h "U: "+        IO.hPutStrLn h a'     a <- request a'     lift $ do-        hPutStr h "D: "-        hPutStrLn h a+        IO.hPutStr h "D: "+        IO.hPutStrLn h a     respond a  -- | 'putStrLn's all values flowing \'@D@\'ownstream to a 'Handle'-hPutStrLnD :: Handle -> x -> Proxy x String x String IO r-hPutStrLnD h = foreverK $ \x -> do+hPutStrLnD :: (Proxy p) => IO.Handle -> x -> p x String x String IO r+hPutStrLnD h = runIdentityK $ foreverK $ \x -> do     a <- request x-    lift $ hPutStrLn h a+    lift $ IO.hPutStrLn h a     respond a  -- | 'putStrLn's all values flowing \'@U@\'pstream to a 'Handle'-hPutStrLnU :: Handle -> String -> Proxy String x String x IO r-hPutStrLnU h = foreverK $ \a' -> do-    lift $ hPutStrLn h a'+hPutStrLnU :: (Proxy p) => IO.Handle -> String -> p String x String x IO r+hPutStrLnU h = runIdentityK $ foreverK $ \a' -> do+    lift $ IO.hPutStrLn h a'     x <- request a'     respond x

@@ -1,36 +1,36 @@+{-# LANGUAGE Rank2Types #-}+ -- | Utility functions for Kleisli arrows  module Control.Proxy.Prelude.Kleisli (     -- * Core utility functions-    -- $utility     foreverK,     replicateK,-    mapK+    liftK,+    hoistK,+    raiseK,     ) where -import Control.Monad (forever, (>=>))+import Control.MFunctor (MFunctor(hoist)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Proxy.Class (Interact(request, respond))-import Data.Closed (C) -{- $utility-    Use 'foreverK' to abstract away the following common pattern:+{-| Compose a \'@K@\'leisli arrow with itself forever +    Use 'foreverK' to abstract away the following common recursion pattern:+ > p a = do >     ... >     a' <- respond b >     p a' -    Using 'foreverK', you can avoid the manual recursion:+    Using 'foreverK', you can instead write:  > p = foreverK $ \a -> do >     ... >     respond b -}---- | Compose a \'@K@\'leisli arrow with itself forever foreverK :: (Monad m) => (a -> m a) -> (a -> m b)-foreverK k = let r = k >=> r in r+foreverK k = let r = \a -> k a >>= r in r {- foreverK uses 'let' to avoid a space leak.    See: http://hackage.haskell.org/trac/ghc/ticket/5205 -} @@ -40,14 +40,48 @@     go n         | n < 1     = return         | n == 1    = k-        | otherwise = k >=> go (n - 1)+        | otherwise = \a -> k a >>= go (n - 1)  {-| Convenience function equivalent to @(lift .)@ -> mapK f >=> mapK g = mapK (f >=> g)+> liftK f >=> liftK g = liftK (f >=> g) >-> mapK return = return+> liftK return = return -}-mapK :: (Monad m, MonadTrans t) => (a -> m b) -> (a -> t m b)-mapK = (lift .)-{-# INLINABLE mapK #-}+liftK :: (Monad m, MonadTrans t) => (a -> m b) -> (a -> t m b)+liftK k a = lift (k a)+-- liftK = (lift .)++{-| Convenience function equivalent to @(hoist f .)@++> hoistK f p1 >-> hoistK f p2 = hoistK f (p1 >-> p2)+>+> hoistK f idT = idT++> hoistK f p1 >=> hoistK f p2 = hoistK f (p1 >=> p2)+>+> hoistK f return = return++> hoistK f . hoistK g = hoistK (f . g)+>+> hoistK id = id+-}+hoistK+ :: (Monad m, MFunctor t)+ => (forall a . m a -> n a) -> ((b' -> t m b) -> (b' -> t n b))+hoistK k p a' = hoist k (p a')+-- hoistK k = (hoist k .)++{-| Convenience function equivalent to @(hoist lift .)@++> raiseK p1 >-> raiseK p2 = raiseK (p1 >-> p2)+>+> raiseK idT = idT++> raiseK p1 >=> raiseK p2 = raiseK (p1 >=> p2)+>+> raiseK return = return+-}+raiseK+ :: (Monad m, MFunctor t1, MonadTrans t2) => (q -> t1 m r) -> (q -> t1 (t2 m) r)+raiseK = (hoist lift .)

@@ -0,0 +1,66 @@+{-# LANGUAGE KindSignatures #-}++{-| These type synonyms simplify type signatures when proxies do not use all+    their type variables. -}++module Control.Proxy.Synonym (+    -- * Synonyms+    Pipe,+    Producer,+    Consumer,+    CoPipe,+    CoProducer,+    CoConsumer,+    Client,+    Server,+    Session,++    -- * Closed+    C+    ) where++-- | A unidirectional 'Proxy'.+type Pipe (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a b = p () a () b++{-| A 'Pipe' that produces values++    'Producer's never 'request'. -}+type Producer (p :: * -> * -> * -> * -> (* -> *) -> * -> *) b = p C () () b++{-| A 'Pipe' that consumes values++    'Consumer's never 'respond'. -}+type Consumer (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a = p () a () C++-- | A 'Pipe' where everything flows upstream+type CoPipe (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a' b' = p a' () b' ()++{-| A 'CoPipe' that produces values flowing upstream++    'CoProducer's never 'respond'. -}+type CoProducer (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a' = p a' () () C++{-| A 'CoConsumer' that consumes values flowing upstream++    'CoConsumer's never 'request'. -}+type CoConsumer (p :: * -> * -> * -> * -> (* -> *) -> * -> *) b' = p C () b' ()++{-| @Server b' b@ receives requests of type @b'@ and sends responses of type+    @b@.++    'Server's never 'request'. -}+type Server (p :: * -> * -> * -> * -> (* -> *) -> * -> *) b' b = p C () b' b++{-| @Client a' a@ sends requests of type @a'@ and receives responses of+    type @a@.++    'Client's never 'respond'. -}+type Client (p :: * -> * -> * -> * -> (* -> *) -> * -> *) a' a = p a' a () C++{-| A self-contained 'Session', ready to be run by 'runSession'++    'Session's never 'request' or 'respond'. -}+type Session (p :: * -> * -> * -> * -> (* -> *) -> * -> *) = p C () () C++-- | The empty type, denoting a \'@C@\'losed end+data C = C -- Constructor not exported, but I include it to avoid EmptyDataDecls

@@ -1,38 +1,71 @@-{-| You can define your own extensions to the 'Proxy' type by writing your own-    \"proxy transformers\".  Proxy transformers are monad transformers that-    correctly lift 'Proxy' composition from the base monad.  Stack multiple-    proxy transformers to chain features together. -}+{-| You can define your own proxy extensions by writing your own \"proxy+    transformers\".  Proxy transformers are monad transformers that also+    correctly lift all proxy operations from the base proxy type to the+    extended proxy type.  Stack multiple proxy transformers to chain features+    together.+-}      module Control.Proxy.Trans (     -- * Proxy Transformers-    ProxyTrans(..)-    )where+    ProxyTrans(..),+    mapP +    -- * Laws+    -- $laws+    ) where+ import Control.Proxy.Class -{-| 'mapP' defines a functor that preserves 'Proxy' composition and Kleisli-    composition.+-- | Uniform interface to lifting proxies+class ProxyTrans t where+    liftP :: (Monad m, Proxy p) => p a' a b' b m r -> t p a' a b' b m r +{-| Lift a 'Proxy' Kleisli arrow++> mapP = (lift .)+-}+mapP :: (Monad m, Proxy p, ProxyTrans t)+     => (q -> p a' a b' b m r) -> (q -> t p a' a b' b m r)+mapP = (liftP .)++{- $laws+     'mapP' defines a functor that preserves five categories:++    * Kleisli category++    * The two Proxy categories++    * \"request\" category++    * \"respond\" category+     Laws:      * Functor between 'Proxy' categories -> mapP (f <-< g) = mapP f <-< mapP g+> mapP (f >-> g) = mapP f >-> mapP g+> > mapP idT = idT +> mapP (f >~> g) = mapP f >~> mapP g+>+> mapP idPush = idPush+     * Functor between Kleisli categories  > mapP (f <=< g) = mapP f <=< mapP g+> > mapP return = return -    Minimal complete definition: 'mapP' or 'liftP'.  Defining 'liftP' is more-    efficient.--}-class ProxyTrans t where-    liftP :: (Monad (p b c d e m), Channel p)-          => p b c d e m r -> t p b c d e m r-    liftP f = mapP (\() -> f) ()+    * Functor between \"request\" categories -    mapP :: (Monad (p b c d e m), Channel p)-         => (a -> p b c d e m r) -> (a -> t p b c d e m r)-    mapP = (liftP .)+> mapP (f /</ g) = mapP f /</ mapP g -- when /</ is defined+>+> mapP request = request++    * Functor between \"respond\" categories++> mapP (f \<\ g) = mapP f \<\ mapP g -- when \<\ is defined+>+> mapP respond = respond+-}

@@ -1,6 +1,6 @@ -- | This module provides the proxy transformer equivalent of 'EitherT'. -{-# LANGUAGE FlexibleContexts, KindSignatures #-}+{-# LANGUAGE KindSignatures #-}  module Control.Proxy.Trans.Either (     -- * EitherP@@ -17,11 +17,12 @@     ) where  import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (liftM, ap, MonadPlus(mzero, mplus))+import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(mapT))-import Control.Proxy.Class (Channel(idT, (>->))) +import Control.MFunctor (MFunctor(hoist))+import Control.PFunctor (PFunctor(hoistP))+import Control.Proxy.Class import Control.Proxy.Trans (ProxyTrans(liftP)) import Prelude hiding (catch) @@ -29,59 +30,114 @@ newtype EitherP e p a' a b' b (m :: * -> *) r   = EitherP { runEitherP :: p a' a b' b m (Either e r) } -instance (Monad (p a' a b' b m)) => Functor (EitherP e p a' a b' b m) where-    fmap = liftM+instance (Proxy              p, Monad m)+       => Functor (EitherP e p a' a b' b m) where+    fmap f p = EitherP (+        runEitherP p ?>= \e ->+        return_P (case e of+            Left  l -> Left l+            Right r -> Right (f r) ) )+ -- fmap f = EitherP . liftM (fmap f) . runEitherP -instance (Monad (p a' a b' b m)) => Applicative (EitherP e p a' a b' b m) where-    pure  = return-    (<*>) = ap+instance (Proxy                  p, Monad m)+       => Applicative (EitherP e p a' a b' b m) where+    pure = return+    fp <*> xp = EitherP (+        runEitherP fp ?>= \e1 ->+        case e1 of+            Left  l -> return_P (Left l)+            Right f ->+                 runEitherP xp ?>= \e2 ->+                 return_P (case e2 of+                      Left l  -> Left  l+                      Right x -> Right (f x) ) )+ -- fp <*> xp = EitherP ((<*>) <$> (runEitherP fp) <*> (runEitherP xp)) -instance (Monad (p a' a b' b m)) => Monad (EitherP e p a' a b' b m) where-    return = right-    m >>= f = EitherP $ do-        e <- runEitherP m-        runEitherP $ case e of-            Left  l -> left l-            Right r -> f    r+instance (Proxy            p, Monad m)+       => Monad (EitherP e p a' a b' b m) where+    return = return_P+    (>>=) = (?>=) -instance (MonadPlus (p a' a b' b m))- => Alternative (EitherP e p a' a b' b m) where+instance (MonadPlusP             p, Monad m)+       => Alternative (EitherP e p a' a b' b m) where     empty = mzero     (<|>) = mplus -instance (MonadPlus (p a' a b' b m))- => MonadPlus (EitherP e p a' a b' b m) where-    mzero = EitherP mzero-    mplus m1 m2 = EitherP $ mplus (runEitherP m1) (runEitherP m2)+instance (MonadPlusP            p )+       => MonadPlusP (EitherP e p) where+    mzero_P = EitherP mzero_P+    mplus_P m1 m2 = EitherP (mplus_P (runEitherP m1) (runEitherP m2)) -instance (MonadTrans (p a' a b' b)) => MonadTrans (EitherP e p a' a b' b) where-    lift = EitherP . lift . liftM Right+instance (MonadPlusP           p, Monad m)+       => MonadPlus (EitherP e p a' a b' b m) where+    mzero = mzero_P+    mplus = mplus_P -instance (MonadIO (p a' a b' b m)) => MonadIO (EitherP e p a' a b' b m) where-    liftIO = EitherP . liftIO . liftM Right+instance (Proxy                 p )+       => MonadTrans (EitherP e p a' a b' b) where+    lift = lift_P -instance (MFunctor (p a' a b' b)) => MFunctor (EitherP e p a' a b' b) where-    mapT nat = EitherP . mapT nat . runEitherP+instance (MonadIOP            p )+       => MonadIOP (EitherP e p) where+    liftIO_P m = EitherP (liftIO_P (m >>= \x -> return (Right x)))+ -- liftIO = EitherP . liftIO . liftM Right -instance (Channel p) => Channel (EitherP e p) where-    idT = EitherP . idT-    p1 >-> p2 = (EitherP .) $ runEitherP . p1 >-> runEitherP . p2+instance (MonadIOP           p, MonadIO m)+       => MonadIO (EitherP e p a' a b' b m) where+    liftIO = liftIO_P +instance (Proxy               p )+       => MFunctor (EitherP e p a' a b' b) where+    hoist = hoist_P++instance (Proxy            p )+       => Proxy (EitherP e p) where+    p1 >-> p2 = \c'1 -> EitherP (+        ((\b' -> runEitherP (p1 b')) >-> (\c'2 -> runEitherP (p2 c'2))) c'1 )+ -- p1 >-> p2 = (EitherP .) $ runEitherP . p1 >-> runEitherP . p2++    p1 >~> p2 = \c'1 -> EitherP (+        ((\b' -> runEitherP (p1 b')) >~> (\c'2 -> runEitherP (p2 c'2))) c'1 )+ -- p1 >~> p2 = (EitherP .) $ runEitherP . p1 >~> runEitherP . p2++    request = \a' -> EitherP (request a' ?>= \a  -> return_P (Right a ))+    respond = \b  -> EitherP (respond b  ?>= \b' -> return_P (Right b'))++    return_P = right+    m ?>= f = EitherP (+        runEitherP m ?>= \e ->+        runEitherP (case e of+            Left  l -> left l+            Right r -> f    r ) )++    lift_P m = EitherP (lift_P (m >>= \x -> return (Right x)))+ -- lift = EitherP . lift . liftM Right++    hoist_P nat p = EitherP (hoist_P nat (runEitherP p))+ -- hoist nat = EitherP . hoist nat . runEitherP+ instance ProxyTrans (EitherP e) where-    liftP = EitherP . liftM Right+    liftP p = EitherP (p ?>= \x -> return_P (Right x))+ -- liftP = EitherP . liftM Right +instance PFunctor (EitherP e) where+    hoistP nat = EitherP . nat . runEitherP+ -- | Run an 'EitherP' \'@K@\'leisi arrow, returning either a 'Left' or 'Right' runEitherK  :: (q -> EitherP e p a' a b' b m r) -> (q -> p a' a b' b m (Either e r))-runEitherK = (runEitherP .)+runEitherK p q = runEitherP (p q)+-- runEitherK = (runEitherP .)  -- | Abort the computation and return a 'Left' result-left :: (Monad (p a' a b' b m)) => e -> EitherP e p a' a b' b m r-left = EitherP . return . Left+left :: (Monad m, Proxy p) => e -> EitherP e p a' a b' b m r+left e = EitherP (return_P (Left e))+-- left = EitherP . return . Left  -- | Synonym for 'return'-right :: (Monad (p a' a b' b m)) => r -> EitherP e p a' a b' b m r-right = EitherP . return . Right+right :: (Monad m, Proxy p) => r -> EitherP e p a' a b' b m r+right r = EitherP (return_P (Right r))+-- right = EitherP . return . Right  {- $symmetry     'EitherP' forms a second symmetric monad over the left type variable.@@ -100,29 +156,26 @@ -}  -- | Synonym for 'left'-throw :: (Monad (p a' a b' b m)) => e -> EitherP e p a' a b' b m r+throw :: (Monad m, Proxy p) => e -> EitherP e p a' a b' b m r throw = left  -- | Resume from an aborted operation catch- :: (Monad (p a' a b' b m))+ :: (Monad m, Proxy p)  => EitherP e p a' a b' b m r        -- ^ Original computation  -> (e -> EitherP f p a' a b' b m r) -- ^ Handler  -> EitherP f p a' a b' b m r        -- ^ Handled computation-catch m f = EitherP $ do-    e <- runEitherP m-    runEitherP $ case e of+catch m f = EitherP (+    runEitherP m ?>= \e ->+    runEitherP (case e of         Left  l -> f     l-        Right r -> right r+        Right r -> right r ))  -- | 'catch' with the arguments flipped handle- :: (Monad (p a' a b' b m))+ :: (Monad m, Proxy p)  => (e -> EitherP f p a' a b' b m r) -- ^ Handler  -> EitherP e p a' a b' b m r        -- ^ Original computation  -> EitherP f p a' a b' b m r        -- ^ Handled computation-handle f m = EitherP $ do-    e <- runEitherP m-    runEitherP $ case e of-        Left  l -> f     l-        Right r -> right r+handle f m = catch m f+-- handle = flip catch

@@ -1,70 +1,136 @@ -- | This module provides the proxy transformer equivalent of 'IdentityT'. -{-# LANGUAGE FlexibleContexts, KindSignatures #-}+{-# LANGUAGE KindSignatures #-}  module Control.Proxy.Trans.Identity (-    -- * IdentityP+    -- * Identity Proxy Transformer     IdentityP(..),+    identityK,     runIdentityK     ) where  import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (liftM, ap, MonadPlus(mzero, mplus))+import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(mapT))-import Control.Proxy.Class (-    Channel(idT    , (>->)), -    Interact(request, (\>\), respond, (/>/)) )+import Control.MFunctor (MFunctor(hoist))+import Control.PFunctor (PFunctor(hoistP))+import Control.Proxy.Class import Control.Proxy.Trans (ProxyTrans(liftP))  -- | The 'Identity' proxy transformer-newtype IdentityP p a' a b' b (m :: * -> *) r-  = IdentityP { runIdentityP :: p a' a b' b m r }+newtype IdentityP p a' a b' b (m :: * -> *) r =+    IdentityP { runIdentityP :: p a' a b' b m r } -instance (Monad (p a' a b' b m)) => Functor (IdentityP p a' a b' b m) where-    fmap = liftM+instance (Proxy              p, Monad m)+       => Functor (IdentityP p a' a b' b m) where+    fmap f p = IdentityP (+        runIdentityP p ?>= \x ->+        return_P (f x) )+ -- fmap = liftM -instance (Monad (p a' a b' b m)) => Applicative (IdentityP p a' a b' b m) where-    pure  = return-    (<*>) = ap+instance (Proxy                  p, Monad m)+       => Applicative (IdentityP p a' a b' b m) where+    pure = return -instance (Monad (p a' a b' b m)) => Monad (IdentityP p a' a b' b m) where-    return = IdentityP . return-    m >>= f = IdentityP $ runIdentityP m >>= runIdentityP . f+    fp <*> xp = IdentityP (+        runIdentityP fp ?>= \f ->+        runIdentityP xp ?>= \x ->+        return_P (f x) )+ -- fp <*> xp = ap -instance (MonadPlus (p a' a b' b m))- => Alternative (IdentityP p a' a b' b m) where+instance (Proxy            p, Monad m)+       => Monad (IdentityP p a' a b' b m) where+    return = return_P+    (>>=) = (?>=)++instance (MonadPlusP             p, Monad m)+       => Alternative (IdentityP p a' a b' b m) where     empty = mzero     (<|>) = mplus -instance (MonadPlus (p a' a b' b m))- => MonadPlus (IdentityP p a' a b' b m) where-    mzero = IdentityP mzero-    mplus m1 m2 = IdentityP $ mplus (runIdentityP m1) (runIdentityP m2)+instance (MonadPlusP            p )+       => MonadPlusP (IdentityP p) where+    mzero_P = IdentityP mzero_P+    mplus_P m1 m2 = IdentityP (mplus_P (runIdentityP m1) (runIdentityP m2)) -instance (MonadTrans (p a' a b' b)) => MonadTrans (IdentityP p a' a b' b) where-    lift = IdentityP . lift+instance (MonadPlusP           p, Monad m)+       => MonadPlus (IdentityP p a' a b' b m) where+    mzero = mzero_P+    mplus = mplus_P -instance (MonadIO (p a' a b' b m)) => MonadIO (IdentityP p a' a b' b m) where-    liftIO = IdentityP . liftIO+instance (Proxy                 p )+       => MonadTrans (IdentityP p a' a b' b) where+    lift = lift_P -instance (MFunctor (p a' a b' b)) => MFunctor (IdentityP p a' a b' b) where-    mapT nat = IdentityP . mapT nat . runIdentityP+instance (MonadIOP            p )+       => MonadIOP (IdentityP p) where+    liftIO_P m = IdentityP (liftIO_P m)+ -- liftIO = IdentityP . liftIO -instance (Channel p) => Channel (IdentityP p) where-    idT = IdentityP . idT-    p1 >-> p2 = (IdentityP .) $ runIdentityP . p1 >-> runIdentityP . p2+instance (MonadIOP           p, MonadIO m)+       => MonadIO (IdentityP p a' a b' b m) where+    liftIO = liftIO_P -instance (Interact p) => Interact (IdentityP p) where-    request = IdentityP . request-    p1 \>\ p2 = (IdentityP .) $ runIdentityP . p1 \>\ runIdentityP . p2-    respond = IdentityP . respond-    p1 />/ p2 = (IdentityP .) $ runIdentityP . p1 />/ runIdentityP . p2+instance (Proxy               p )+       => MFunctor (IdentityP p a' a b' b) where+    hoist = hoist_P +instance (Proxy            p )+       => Proxy (IdentityP p) where+    p1 >-> p2 = \c'1 -> IdentityP (+        ((\c'2 -> runIdentityP (p1 c'2))+     >-> (\b'  -> runIdentityP (p2 b' )) ) c'1 )+ -- p1 >-> p2 = (IdentityP .) $ runIdentityP . p1 >-> runIdentityP . p2++    p1 >~> p2 = \c'1 -> IdentityP (+        ((\c'2 -> runIdentityP (p1 c'2))+     >~> (\b'  -> runIdentityP (p2 b' )) ) c'1 )+ -- p1 >~> p2 = (IdentityP .) $ runIdentityP . p1 >~> runIdentityP . p2++    request = \a' -> IdentityP (request a')+ -- request = P . request++    respond = \b -> IdentityP (respond b)+ -- respond = P . respond++    return_P = \r -> IdentityP (return_P r)+ -- return = P . return++    m ?>= f = IdentityP (+        runIdentityP m ?>= \x ->+        runIdentityP (f x) )++    lift_P m = IdentityP (lift_P m)+ -- lift = P . lift++    hoist_P nat p = IdentityP (hoist_P nat (runIdentityP p))+ -- hoist nat = IdentityP . hoist nat . runIdentityP++instance (Interact            p )+      =>  Interact (IdentityP p) where+    p1 \>\ p2 = \c'1 -> IdentityP (+        ((\b'  -> runIdentityP (p1 b' ))+     \>\ (\c'2 -> runIdentityP (p2 c'2)) ) c'1 )+ -- p1 \>\ p2 = (IdentityP .) $ runIdentityP . p1 \>\ runIdentityP . p2++    p1 />/ p2 = \a1 -> IdentityP (+        ((\a2 -> runIdentityP (p1 a2))+     />/ (\b  -> runIdentityP (p2 b )) ) a1 )+ -- p1 />/ p2 = (IdentityP .) $ runIdentityP . p1 />/ runIdentityP . p2+ instance ProxyTrans IdentityP where     liftP = IdentityP --- | Run an 'IdentityP' \'@K@\'leisli arrow+instance PFunctor IdentityP where+    hoistP nat = IdentityP . nat . runIdentityP++-- | Wrap a \'@K@\'leisli arrow in 'IdentityP'+identityK :: (q -> p a' a b' b m r) -> (q -> IdentityP p a' a b' b m r)+identityK k q = IdentityP (k q)+-- identityK = (IdentityP .)++-- | Run an 'P' \'@K@\'leisli arrow runIdentityK :: (q -> IdentityP p a' a b' b m r) -> (q -> p a' a b' b m r)-runIdentityK = (runIdentityP .)+runIdentityK k q = runIdentityP (k q)+-- runIdentityK = (runIdentityP .)

@@ -1,6 +1,6 @@ -- | This module provides the proxy transformer equivalent of 'MaybeT'. -{-# LANGUAGE FlexibleContexts, KindSignatures #-}+{-# LANGUAGE KindSignatures #-}  module Control.Proxy.Trans.Maybe (     -- * MaybeP@@ -12,68 +12,125 @@     ) where  import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (liftM, ap, MonadPlus(mzero, mplus))+import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(mapT))-import Control.Proxy.Class (Channel(idT, (>->)))+import Control.MFunctor (MFunctor(hoist))+import Control.PFunctor (PFunctor(hoistP))+import Control.Proxy.Class import Control.Proxy.Trans (ProxyTrans(liftP))  -- | The 'Maybe' proxy transformer newtype MaybeP p a' a b' b (m :: * -> *) r   = MaybeP { runMaybeP :: p a' a b' b m (Maybe r) } -instance (Monad (p a' a b' b m)) => Functor (MaybeP p a' a b' b m) where-    fmap = liftM+instance (Proxy           p, Monad m)+       => Functor (MaybeP p a' a b' b m) where+    fmap f p = MaybeP (+        runMaybeP p ?>= \m ->+        return_P (case m of+            Nothing -> Nothing+            Just x  -> Just (f x) ) )+ -- fmap f = MaybeP . fmap (fmap f) . runMaybeP -instance (Monad (p a' a b' b m)) => Applicative (MaybeP p a' a b' b m) where-    pure  = return-    (<*>) = ap+instance (Proxy               p, Monad m)+       => Applicative (MaybeP p a' a b' b m) where+    pure = return -instance (Monad (p a' a b' b m)) => Monad (MaybeP p a' a b' b m) where-    return = MaybeP . return . Just-    m >>= f = MaybeP $ do-        ma <- runMaybeP m-        runMaybeP $ case ma of-            Nothing -> nothing-            Just a  -> f a+    fp <*> xp = MaybeP (+        runMaybeP fp ?>= \m1 ->+        case m1 of+            Nothing -> return_P Nothing+            Just f  ->+                runMaybeP xp ?>= \m2 ->+                case m2 of+                    Nothing -> return_P Nothing+                    Just x  -> return_P (Just (f x)) )+ -- fp <*> xp = MaybeP ((<*>) <$> (runMaybeP fp) <*> (runMaybeP xp)) -instance (Monad (p a' a b' b m)) => Alternative (MaybeP p a' a b' b m) where+instance (Proxy         p, Monad m)+       => Monad (MaybeP p a' a b' b m) where+    return = return_P+    (>>=)  = (?>=)++instance (Proxy               p, Monad m)+       => Alternative (MaybeP p a' a b' b m) where     empty = mzero     (<|>) = mplus -instance (Monad (p a' a b' b m)) => MonadPlus (MaybeP p a' a b' b m) where-    mzero = nothing-    mplus m1 m2 = MaybeP $ do-        ma <- runMaybeP m1-        runMaybeP $ case ma of+instance (Proxy              p )+       => MonadPlusP (MaybeP p) where+    mzero_P = nothing+    mplus_P m1 m2 = MaybeP (+        runMaybeP m1 ?>= \ma ->+        runMaybeP (case ma of             Nothing -> m2-            Just a  -> just a+            Just a  -> just a ) ) -instance (MonadTrans (p a' a b' b)) => MonadTrans (MaybeP p a' a b' b) where-    lift = MaybeP . lift . liftM Just+instance (Proxy             p, Monad m)+       => MonadPlus (MaybeP p a' a b' b m) where+    mzero = mzero_P+    mplus = mplus_P -instance (MonadIO (p a' a b' b m)) => MonadIO (MaybeP p a' a b' b m) where-    liftIO = MaybeP . liftIO . liftM Just+instance (Proxy              p )+       => MonadTrans (MaybeP p a' a b' b) where+    lift = lift_P -instance (MFunctor (p a' a b' b)) => MFunctor (MaybeP p a' a b' b) where-    mapT nat = MaybeP . mapT nat . runMaybeP+instance (MonadIOP         p )+       => MonadIOP (MaybeP p) where+    liftIO_P m = MaybeP (liftIO_P (m >>= \x -> return (Just x)))+ -- liftIO = MaybeP . liftIO . liftM Just -instance (Channel p) => Channel (MaybeP p) where-    idT = MaybeP . idT-    p1 >-> p2 = (MaybeP .) $ runMaybeP . p1 >-> runMaybeP . p2+instance (MonadIOP        p, MonadIO m)+       => MonadIO (MaybeP p a' a b' b m) where+    liftIO = liftIO_P +instance (Proxy            p )+       => MFunctor (MaybeP p a' a b' b) where+    hoist = hoist_P++instance (Proxy         p )+       => Proxy (MaybeP p) where+    p1 >-> p2 = \c'1 -> MaybeP (+        ((\b' -> runMaybeP (p1 b')) >-> (\c'2 -> runMaybeP (p2 c'2))) c'1 )+ -- p1 >-> p2 = (MaybeP .) $ runMaybeP . p1 >-> runMaybeP . p2++    p1 >~> p2 = \c'1 -> MaybeP (+        ((\b' -> runMaybeP (p1 b')) >~> (\c'2 -> runMaybeP (p2 c'2))) c'1 )+ -- p1 >~> p2 = (MaybeP .) $ runMaybeP . p1 >~> runMaybeP . p2++    request = \a' -> MaybeP (request a' ?>= \a  -> return_P (Just a ))+    respond = \b  -> MaybeP (respond b  ?>= \b' -> return_P (Just b'))++    return_P = just+    m ?>= f = MaybeP (+        runMaybeP m ?>= \ma ->+        runMaybeP (case ma of+            Nothing -> nothing+            Just a  -> f a ) )++    lift_P m = MaybeP (lift_P (m >>= \x -> return (Just x)))+ -- lift = MaybeP . lift . liftM Just++    hoist_P nat p = MaybeP (hoist_P nat (runMaybeP p))+ -- hoist nat = MaybeP . hoist nat . runMaybeP+ instance ProxyTrans MaybeP where-    liftP = MaybeP . liftM Just+    liftP p = MaybeP (p ?>= \x -> return_P (Just x))+ -- liftP = MaybeP . liftM Just +instance PFunctor MaybeP where+    hoistP nat = MaybeP . nat . runMaybeP+ -- | Run a 'MaybeP' \'@K@\'leisli arrow, returning the result or 'Nothing' runMaybeK :: (q -> MaybeP p a' a b' b m r) -> (q -> p a' a b' b m (Maybe r))-runMaybeK = (runMaybeP .)+runMaybeK p q = runMaybeP (p q)+-- runMaybeK = (runMaybeP .)  -- | A synonym for 'mzero'-nothing :: (Monad (p a' a b' b m)) => MaybeP p a' a b' b m r-nothing = MaybeP $ return Nothing+nothing :: (Monad m, Proxy p) => MaybeP p a' a b' b m r+nothing = MaybeP (return_P Nothing)  -- | A synonym for 'return'-just :: (Monad (p a' a b' b m)) => r -> MaybeP p a' a b' b m r-just = return+just :: (Monad m, Proxy p) => r -> MaybeP p a' a b' b m r+just r = MaybeP (return_P (Just r))

@@ -1,6 +1,6 @@ -- | This module provides the proxy transformer equivalent of 'ReaderT'. -{-# LANGUAGE FlexibleContexts, KindSignatures #-}+{-# LANGUAGE KindSignatures #-}  module Control.Proxy.Trans.Reader (     -- * ReaderP@@ -15,91 +15,139 @@     ) where  import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (liftM, ap, MonadPlus(mzero, mplus))+import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(mapT))-import Control.Proxy.Class (-    Channel(idT, (>->)), -    Interact(request, (\>\), respond, (/>/)) )+import Control.MFunctor (MFunctor(hoist))+import Control.PFunctor (PFunctor(hoistP))+import Control.Proxy.Class import Control.Proxy.Trans (ProxyTrans(liftP))  -- | The 'Reader' proxy transformer newtype ReaderP i p a' a b' b (m :: * -> *) r   = ReaderP { unReaderP :: i -> p a' a b' b m r } -instance (Monad (p a' a b' b m)) => Functor (ReaderP i p a' a b' b m) where-    fmap = liftM+instance (Proxy              p, Monad m)+       => Functor (ReaderP i p a' a b' b m) where+    fmap f p = ReaderP (\i ->+        unReaderP p i ?>= \x ->+        return_P (f x) ) -instance (Monad (p a' a b' b m)) => Applicative (ReaderP i p a' a b' b m) where-    pure  = return-    (<*>) = ap+instance (Proxy                  p, Monad m)+       => Applicative (ReaderP i p a' a b' b m) where+    pure = return+    p1 <*> p2 = ReaderP (\i ->+        unReaderP p1 i ?>= \f -> +        unReaderP p2 i ?>= \x -> +        return_P (f x) ) -instance (Monad (p a' a b' b m)) => Monad (ReaderP i p a' a b' b m) where-    return a = ReaderP $ \_ -> return a-    m >>= f = ReaderP $ \i -> do-        a <- unReaderP m i-        unReaderP (f a) i+instance (Proxy            p, Monad m)+       => Monad (ReaderP i p a' a b' b m) where+    return = return_P+    (>>=) = (?>=) -instance (MonadPlus (p a' a b' b m))- => Alternative (ReaderP i p a' a b' b m) where+instance (MonadPlusP             p, Monad m)+       => Alternative (ReaderP i p a' a b' b m) where     empty = mzero     (<|>) = mplus -instance (MonadPlus (p a' a b' b m))- => MonadPlus (ReaderP i p a' a b' b m) where-    mzero = ReaderP $ \_ -> mzero-    mplus m1 m2 = ReaderP $ \i -> mplus (unReaderP m1 i) (unReaderP m2 i)+instance (MonadPlusP           p )+       => MonadPlusP (ReaderP i p) where+    mzero_P = ReaderP (\_ -> mzero_P)+    mplus_P m1 m2 = ReaderP (\i -> mplus_P (unReaderP m1 i) (unReaderP m2 i)) -instance (MonadTrans (p a' a b' b)) => MonadTrans (ReaderP i p a' a b' b) where-    lift m = ReaderP $ \_ -> lift m+instance (MonadPlusP           p, Monad m)+       => MonadPlus (ReaderP i p a' a b' b m) where+    mzero = mzero_P+    mplus = mplus_P -instance (MonadIO (p a' a b' b m)) => MonadIO (ReaderP i p a' a b' b m) where-    liftIO m = ReaderP $ \_ -> liftIO m+instance (Proxy                 p )+       => MonadTrans (ReaderP i p a' a b' b) where+    lift = lift_P -instance (MFunctor (p a' a b' b)) => MFunctor (ReaderP i p a' a b' b) where-    mapT nat = ReaderP . fmap (mapT nat) . unReaderP+instance (MonadIOP            p )+       => MonadIOP (ReaderP i p) where+    liftIO_P m = ReaderP (\_ -> liftIO_P m) -instance (Channel p) => Channel (ReaderP i p) where-    idT a = ReaderP $ \_ -> idT a-    (p1 >-> p2) a = ReaderP $ \i ->-        ((`unReaderP` i) . p1 >-> (`unReaderP` i) . p2) a+instance (MonadIOP           p, MonadIO m)+       => MonadIO (ReaderP i p a' a b' b m) where+    liftIO = liftIO_P -instance (Interact p) => Interact (ReaderP i p) where-    request a = ReaderP $ \_ -> request a-    (p1 \>\ p2) a = ReaderP $ \i ->-        ((`unReaderP` i) . p1 \>\ (`unReaderP` i) . p2) a-    respond a = ReaderP $ \_ -> respond a-    (p1 />/ p2) a = ReaderP $ \i ->-        ((`unReaderP` i) . p1 />/ (`unReaderP` i) . p2) a+instance (Proxy               p )+       => MFunctor (ReaderP i p a' a b' b) where+    hoist = hoist_P +instance (Proxy            p  )+       => Proxy (ReaderP i p) where+    p1 >-> p2 = \c'1 -> ReaderP (\i ->+        ((\b'  -> unReaderP (p1 b' ) i)+     >-> (\c'2 -> unReaderP (p2 c'2) i) ) c'1 )+ {- p1 >-> p2 = \c' -> ReaderP $ \i ->+        ((`unReaderP` i) . p1 >-> (`unReaderP` i) . p2) c' -}++    p1 >~> p2 = \c'1 -> ReaderP (\i ->+        ((\b'  -> unReaderP (p1 b' ) i)+     >~> (\c'2 -> unReaderP (p2 c'2) i) ) c'1 )+ {- p1 >~> p2 = \c' -> ReaderP $ \i ->+        ((`unReaderP` i) . p1 >~> (`unReaderP` i) . p2) c' -}++    return_P = \r -> ReaderP (\_ -> return_P r)+    m ?>= f  = ReaderP (\i ->+        unReaderP m i ?>= \a -> +        unReaderP (f a) i )++    request = \a -> ReaderP (\_ -> request a)+    respond = \a -> ReaderP (\_ -> respond a)++    lift_P m = ReaderP (\_ -> lift_P m)++    hoist_P nat p = ReaderP (\i -> hoist_P nat (unReaderP p i))+ -- hoist_P nat = ReaderP . fmap (hoist_P nat) . unReaderP++instance (Interact            p)+       => Interact (ReaderP i p) where+    p1 \>\ p2 = \c'1 -> ReaderP (\i ->+        ((\b'  -> unReaderP (p1 b' ) i)+     \>\ (\c'2 -> unReaderP (p2 c'2) i) ) c'1 )+ {- p1 \>\ p2 = \c' -> ReaderP $ \i ->+        ((`unReaderP` i) . p1 \>\ (`unReaderP` i) . p2) c' -}++    p1 />/ p2 = \a1 -> ReaderP (\i ->+        ((\b  -> unReaderP (p1 b ) i)+     />/ (\a2 -> unReaderP (p2 a2) i) ) a1 )+ {- p1 />/ p2 = \a -> ReaderP $ \i ->+        ((`unReaderP` i) . p1 />/ (`unReaderP` i) . p2) a -}+ instance ProxyTrans (ReaderP i) where-    liftP m = ReaderP $ \_ -> m+    liftP m = ReaderP (\_ -> m) +instance PFunctor (ReaderP i) where+    hoistP nat = ReaderP . (nat .) . unReaderP+ -- | Run a 'ReaderP' computation, supplying the environment runReaderP :: i -> ReaderP i p a' a b' b m r -> p a' a b' b m r runReaderP i m = unReaderP m i  -- | Run a 'ReaderP' \'@K@\'leisli arrow, supplying the environment runReaderK :: i -> (q -> ReaderP i p a' a b' b m r) -> (q -> p a' a b' b m r)-runReaderK i = (runReaderP i .)+runReaderK i p q = runReaderP i (p q)+-- runReaderK i = (runReaderP i .)  -- | Modify a computation's environment (a more general version of 'local') withReaderP- :: (Monad (p a' a b' b m))- => (j -> i) -> ReaderP i p a' a b' b m r -> ReaderP j p a' a b' b m r-withReaderP f r = ReaderP $ unReaderP r . f+ :: (j -> i) -> ReaderP i p a' a b' b m r -> ReaderP j p a' a b' b m r+withReaderP f p = ReaderP (\i -> unReaderP p (f i))+-- withReaderP f p = ReaderP $ unReaderP p . f  -- | Get the environment-ask :: (Monad (p a' a b' b m)) => ReaderP i p a' a b' b m i-ask = ReaderP return+ask :: (Proxy p, Monad m) => ReaderP i p a' a b' b m i+ask = ReaderP return_P  -- | Get a function of the environment-asks :: (Monad (p a' a b' b m)) => (i -> r) -> ReaderP i p a' a b' b m r-asks f = ReaderP (return . f)+asks :: (Proxy p, Monad m) => (i -> r) -> ReaderP i p a' a b' b m r+asks f = ReaderP (\i -> return_P (f i))  -- | Modify a computation's environment (a specialization of 'withReaderP') local- :: (Monad (p a' a b' b m))- => (i -> i) -> ReaderP i p a' a b' b m r -> ReaderP i p a' a b' b m r+ :: (i -> i) -> ReaderP i p a' a b' b m r -> ReaderP i p a' a b' b m r local = withReaderP

@@ -1,8 +1,6 @@-{-| This module provides the proxy transformer equivalent of 'StateT'.--    Sequencing of computations is strict. -}+-- | This module provides the proxy transformer equivalent of 'StateT'. -{-# LANGUAGE FlexibleContexts, KindSignatures #-}+{-# LANGUAGE KindSignatures #-}  module Control.Proxy.Trans.State (     -- * StateP@@ -21,98 +19,148 @@     ) where  import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (liftM, ap, MonadPlus(mzero, mplus))+import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(mapT))-import Control.Proxy.Class (Channel(idT, (>->)))+import Control.MFunctor (MFunctor(hoist))+import Control.PFunctor (PFunctor(hoistP))+import Control.Proxy.Class import Control.Proxy.Trans (ProxyTrans(liftP)) --- | The strict 'State' proxy transformer+-- | The 'State' proxy transformer newtype StateP s p a' a b' b (m :: * -> *) r   = StateP { unStateP :: s -> p a' a b' b m (r, s) } -instance (Monad (p a' a b' b m)) => Functor (StateP s p a' a b' b m) where-    fmap = liftM+instance (Proxy             p, Monad m)+       => Functor (StateP s p a' a b' b m) where+       fmap f p = StateP (\s0 ->+           unStateP p s0 ?>= \(x, s1) ->+           return_P (f x, s1) ) -instance (Monad (p a' a b' b m)) => Applicative (StateP s p a' a b' b m) where-    pure  = return-    (<*>) = ap+{- As far as I can tell, there is no way to write this using an Applicative+   context -}+instance (Proxy                 p, Monad m)+       => Applicative (StateP s p a' a b' b m) where+    pure = return+    p1 <*> p2 = StateP (\s0 ->+        unStateP p1 s0 ?>= \(f, s1) ->+        unStateP p2 s1 ?>= \(x, s2) ->+        return_P (f x, s2) ) -instance (Monad (p a' a b' b m)) => Monad (StateP s p a' a b' b m) where-    return a = StateP $ \s -> return (a, s)-    m >>= f = StateP $ \s -> do-        (a, s') <- unStateP m s-        unStateP (f a) s'+instance (Proxy           p, Monad m)+       => Monad (StateP s p a' a b' b m) where+    return = return_P+    (>>=)  = (?>=) -instance (MonadPlus (p a' a b' b m))- => Alternative (StateP s p a' a b' b m) where+instance (MonadPlusP            p, Monad m)+       => Alternative (StateP s p a' a b' b m) where     empty = mzero     (<|>) = mplus -instance (MonadPlus (p a' a b' b m)) => MonadPlus (StateP s p a' a b' b m) where-    mzero = StateP $ \_ -> mzero-    mplus m1 m2 = StateP $ \s -> mplus (unStateP m1 s) (unStateP m2 s)+instance (MonadPlusP           p )+       => MonadPlusP (StateP s p) where+    mzero_P       = StateP (\_ -> mzero_P)+    mplus_P m1 m2 = StateP (\s -> mplus_P (unStateP m1 s) (unStateP m2 s)) -instance (MonadTrans (p a' a b' b)) => MonadTrans (StateP s p a' a b' b) where-    lift m = StateP $ \s -> lift $ liftM (\r -> (r, s)) m+instance (MonadPlusP          p, Monad m)+       => MonadPlus (StateP s p a' a b' b m) where+    mzero = mzero_P+    mplus = mplus_P -instance (MonadIO (p a' a b' b m)) => MonadIO (StateP s p a' a b' b m) where-    liftIO m = StateP $ \s -> liftIO $ liftM (\r -> (r, s)) m+instance (Proxy                p )+       => MonadTrans (StateP s p a' a b' b) where+    lift = lift_P -instance (MFunctor (p a' a b' b)) => MFunctor (StateP s p a' a b' b) where-    mapT nat = StateP . fmap (mapT nat) . unStateP+instance (MonadIOP           p )+       => MonadIOP (StateP s p) where+    liftIO_P m = StateP (\s -> liftIO_P (m >>= \r -> return (r, s))) -instance (Channel p) => Channel (StateP s p) where-    idT a = StateP $ \_ -> idT a-    (p1 >-> p2) a = StateP $ \s ->-        ((`unStateP` s) . p1 >-> (`unStateP` s) . p2) a+instance (MonadIOP          p, MonadIO m)+       => MonadIO (StateP s p a' a b' b m) where+    liftIO = liftIO_P +instance (Proxy              p )+       => MFunctor (StateP s p a' a b' b) where+    hoist = hoist_P++instance (Proxy           p )+       => Proxy (StateP s p) where+    p1 >-> p2 = \c'1 -> StateP (\s ->+        ((\b' -> unStateP (p1 b') s) >-> (\c'2 -> unStateP (p2 c'2) s)) c'1 )+ {- (p1 >-> p2) = \c' -> StateP $ \s ->+        ((`unStateP` s) . p1 >-> (`unStateP` s) . p2) c' -}++    p1 >~> p2 = \c'1 -> StateP (\s ->+        ((\b' -> unStateP (p1 b') s) >~> (\c'2 -> unStateP (p2 c'2) s)) c'1 )+ {- (p1 >~> p2) = \c' -> StateP $ \s ->+        ((`unStateP` s) . p1 >~> (`unStateP` s) . p2) c' -}++    request = \a' -> StateP (\s -> request a' ?>= \a  -> return_P (a , s))+    respond = \b  -> StateP (\s -> respond b  ?>= \b' -> return_P (b', s))++    return_P = \r -> StateP (\s -> return_P (r, s))+    m ?>= f  = StateP (\s ->+        unStateP m s ?>= \(a, s') ->+        unStateP (f a) s' )++    lift_P m = StateP (\s -> lift_P (m >>= \r -> return (r, s)))++    hoist_P nat p = StateP (\s -> hoist_P nat (unStateP p s))+ -- hoist nat = StateP . fmap (hoist nat) . unStateP+ instance ProxyTrans (StateP s) where-    liftP m = StateP $ \s -> liftM (\r -> (r, s)) m+    liftP m = StateP (\s -> m ?>= \r -> return_P (r, s)) +instance PFunctor (StateP s) where+    hoistP nat = StateP . (nat .) . unStateP+ -- | Run a 'StateP' computation, producing the final result and state runStateP :: s -> StateP s p a' a b' b m r -> p a' a b' b m (r, s) runStateP s m = unStateP m s  -- | Run a 'StateP' \'@K@\'leisli arrow, procuding the final result and state runStateK :: s -> (q -> StateP s p a' a b' b m r) -> (q -> p a' a b' b m (r, s))-runStateK s = (runStateP s .)+runStateK s k q = unStateP (k q) s+-- runStateK s = (runStateP s .)  -- | Evaluate a 'StateP' computation, but discard the final state evalStateP- :: (Monad (p a' a b' b m)) => s -> StateP s p a' a b' b m r -> p a' a b' b m r-evalStateP s = liftM fst . runStateP s+ :: (Proxy p, Monad m) => s -> StateP s p a' a b' b m r -> p a' a b' b m r+evalStateP s p = unStateP p s ?>= \x -> return_P (fst x)+-- evalStateP s = liftM fst . runStateP s  -- | Evaluate a 'StateP' \'@K@\'leisli arrow, but discard the final state evalStateK- :: (Monad (p a' a b' b m))+ :: (Proxy p, Monad m)  => s -> (q -> StateP s p a' a b' b m r) -> (q -> p a' a b' b m r)-evalStateK s = (evalStateP s .)+evalStateK s k q = evalStateP s (k q)+-- evalStateK s = (evalStateP s .)  -- | Evaluate a 'StateP' computation, but discard the final result execStateP- :: (Monad (p a' a b' b m)) => s -> StateP s p a' a b' b m r -> p a' a b' b m s-execStateP s = liftM snd . runStateP s+ :: (Proxy p, Monad m) => s -> StateP s p a' a b' b m r -> p a' a b' b m s+execStateP s p = unStateP p s ?>= \x -> return_P (snd x)+-- execStateP s = liftM snd . runStateP s  -- | Evaluate a 'StateP' \'@K@\'leisli arrow, but discard the final result execStateK- :: (Monad (p a' a b' b m))+ :: (Proxy p, Monad m)  => s -> (q -> StateP s p a' a b' b m r) -> (q -> p a' a b' b m s)-execStateK s = (execStateP s .)+execStateK s k q = execStateP s (k q)+-- execStateK s = (execStateP s .)  -- | Get the current state-get :: (Monad (p a' a b' b m)) => StateP s p a' a b' b m s-get = StateP $ \s -> return (s, s)+get :: (Proxy p, Monad m) => StateP s p a' a b' b m s+get = StateP (\s -> return_P (s, s))  -- | Set the current state-put :: (Monad (p a' a b' b m)) => s -> StateP s p a' a b' b m ()-put s = StateP $ \_ -> return ((), s)+put :: (Proxy p, Monad m) => s -> StateP s p a' a b' b m ()+put s = StateP (\_ -> return_P ((), s))  -- | Modify the current state using a function-modify :: (Monad (p a' a b' b m)) => (s -> s) -> StateP s p a' a b' b m ()-modify f = StateP $ \s -> return ((), f s)+modify :: (Proxy p, Monad m) => (s -> s) -> StateP s p a' a b' b m ()+modify f = StateP (\s -> return_P ((), f s))  -- | Get the state filtered through a function-gets :: (Monad (p a' a b' b m)) => (s -> r) -> StateP s p a' a b' b m r-gets f = StateP $ \s -> return (f s, s)+gets :: (Proxy p, Monad m) => (s -> r) -> StateP s p a' a b' b m r+gets f = StateP (\s -> return_P (f s, s))

@@ -1,415 +0,0 @@--- | This module provides the tutorial for the "Control.Proxy.Trans" hierarchy--module Control.Proxy.Trans.Tutorial (-    -- * Motivation-    -- $motivation--    -- * Proxy Transformers-    -- $proxytrans--    -- * Compatibility-    -- $compatibility--    -- * Proxy Transformer Stacks-    -- $stacks-    ) where--import Control.Monad.Trans.Class-import Control.Monad.Trans.State-import Control.Proxy-import Control.Proxy.Trans.Either-import Control.Proxy.Trans.State--{- $motivation-    In a 'Session', all composed proxies share effects within the base monad.-    To see how, consider the following simple 'Session':--> client1 :: () -> Client () () (StateT Int IO) r-> client1 () = forever $ do->     s <- lift get->     lift $ lift $ putStrLn $ "Client: " ++ show s->     lift $ put (s + 1)->     request ()->-> server1 :: () -> Server () () (StateT Int IO) r-> server1 () = forever $ do->     s <- lift get->     lift $ lift $ putStrLn $ "Server: " ++ show s->     lift $ put (s + 1)->     respond ()-->>> (`evalStateT` 0) $ runProxy $ client1 <-< server1-Client: 0-Server: 1-Client: 2-Server: 3-Client: 4-Server: 5-...--    The client and server share the same state, which is sometimes not what we-    want.  We can easily solve this by running each 'Proxy' with its own local-    state by changing the order of the 'Proxy' and 'StateT' monad transformers:--> client2 :: () -> StateT Int (Client () () IO) r-> client2 () = forever $ do->     s <- get->     lift $ lift $ putStrLn $ "Client: " ++ show s->     put (s + 1)->     lift $ request ()->-> server2 :: () -> StateT Int (Server () () IO) r-> server2 () = forever $ do->     s <- get->     lift $ lift $ putStrLn $ "Server: " ++ show s->     put (s + 1)->     lift $ respond ()--    ... but then we can no longer compose them directly.  We have to first-    unwrap each one with 'evalStateT' before composing:-->>> runProxy $ (`evalStateT` 0) . client2 <-< (`evalStateT` 0) . server2-Client: 0-Server: 0-Client: 1-Server: 1-Client: 2-Server: 2-...--    Here's another example: suppose we want to handle errors within proxies.  We-    could try adding 'EitherT' to the base monad like so:--> import Control.Error->-> client3 :: () -> Client () () (EitherT String IO) ()-> client3 () = forM_ [1..] $ \i -> do->     lift $ lift $ print i->     request ()->-> server3 :: (Monad m) => () -> Server () () (EitherT String m) r-> server3 () = lift $ left "ERROR"-->>> runEithert $ runProxy $ client2 <-< server2-1-Left "ERROR"--    Unfortunately, we can't modify @server2@ to 'catchT' that error because we-    cannot access the inner 'EitherT' monad transformer until we run the-    'Session'.  We'd really prefer to place the 'EitherT' monad transformer-    /outside/ the 'Proxy' monad transformer so that we can catch and handle-    errors locally within a 'Proxy' without disturbing other proxies:--> client4 :: () -> EitherT String (Client () () IO) ()-> client4 () = forM_ [1..] $ \i -> do->     lift $ lift $ print i->     lift $ request ()->-> server4 :: () -> EitherT String (Server () () IO) ()-> server4 () = (forever $ do->     lift $ respond ()->     throwT "Error" )->   `catchT` (\str -> do->         lift $ lift $ putStrLn $ "Caught: " ++ str->         server4 () )--    However, this solution similarly requires unwrapping the client and server-    using 'runEitherT' before composing them:-->>> runProxy $ runEitherT . client4 <-< runEitherT . server4-1-Caught: Error-2-Caught: Error-3-Caught: Error-...---}--{- $proxytrans-    We need some way to layer monad transformers /outside/ the proxy type-    without interfering with 'Proxy' composition.  To do this, we overload-    'Proxy' composition using the 'Channel' type class from-    "Control.Proxy.Class":--> class Channel p where->     idT :: (Monad) m => a' -> p a' a a' a m r->     (>->)->      :: (Monad m)->      => (b' -> p a' a b' b m r)->      -> (c' -> p b' b c' c m r)->      -> (c' -> p a' a c' c m r)--    Obviously, 'Proxy' implements this class:--> instance Channel Proxy where ...--    ... but we would also like our monad transformers layered outside the-    'Proxy' type to also implement the 'Channel' class so that we could compose-    them directly without unwrapping.  Unfortunately, these monad transformers-    do not fit the signature of the 'Channel' class.--    Fortunately, the "Control.Proxy.Trans" hierarchy provides several common-    monad transformers which have been upgraded to fit the 'Channel' type class.-    I call these \"proxy transformers\".--    For example, "Control.Proxy.Trans.State" provides a proxy transformer-    equivalent to @Control.Monad.Trans.State@.  Similarly,-    "Control.Proxy.Trans.Either" provides a proxy transformer equivalent to-    @Control.Monad.Trans.Either@.--    Let's use a working code example to demonstrate how to use them:--> import Control.Proxy.Trans.State-> -> client5 :: () -> StateP Int Proxy () () () C IO r-> client5 () = forever $ do->     s <- get->     liftP $ lift $ putStrLn $ "Client: " ++ show s->     put (s + 1)->     liftP $ request ()->-> server5 :: () -> StateP Int Proxy C () () () IO r-> server5 () = forever $ do->     s <- get->     liftP $ lift $ putStrLn $ "Server: " ++ show s->     put (s + 1)->     liftP $ respond ()--    You'll see that our type signatures changed.  Now we use 'StateP' instead of-    'StateT'.  However, 'StateP' does not transform monads, but instead-    transforms proxies.--    To see this, let's first study the kind of 'StateT'.  If we first define:--> kind MonadKind = * -> *--    Then @StateT s@ takes a monad, and returns a new monad:--> StateT s :: MonadKind -> MonadKind--    Now consider the kind of a 'Proxy'-like type constructor suitable for the-    'Channel' type class:--> kind ProxyKind = * -> * -> * -> * -> (* -> *) -> * -> *--    Then @StateP s@  takes a 'Proxy'-like and returns a new 'Proxy'-like type:--> StateP s :: ProxyKind -> ProxyKind--    This is why I call these \"proxy transformers\" and not monad transformers.-    They all take some 'Proxy'-like type that implements 'Channel' and transform-    it into a new 'Proxy'-like type that also implements 'Channel'.  For-    example, 'StateP' implement the following instance:--> instance (Channel p) => Channel (StateP s p) where ...--    All proxy transformers guarantee that if the base proxy implements the-    'Channel' type class, then the transformed proxy also implements the-    'Channel' type class.  This means that you can build a proxy transformer-    stack, just like you might build a monad transformer stack.--    Unfortunately, in order to use proxy transformers, you must expand out the-    'Client' and 'Server' type synonyms, which are not compatible with proxy-    transformers.  Sorry!  This is why there are no 'Server' or 'Client' type-    synonyms in the types of our new client and server and I had to write out-    all the inputs and outputs.--    Notice how the outermost 'lift' statements in our client and server have-    changed to 'liftP'.  'liftP' replaces 'lift' for proxy transformers, and it-    lifts any action in the base proxy to an action in the transformed proxy.-    In the previous example, the base proxy was 'Proxy' and the transformed-    proxy was @StateP s Proxy@, so 'liftP's type got specialized to:--> liftP :: Proxy a' a b' b m r -> StateP s Proxy a' a b' b m r--    The 'ProxyTrans' class defines 'liftP', and all proxy transformers implement-    the 'ProxyTrans' class.  Since proxies are still monads, 'liftP' must-    behave just like 'lift' and obey the monad transformer laws:--> (liftP .) return = return->-> (liftP .) (f >=> g) = (liftP .) f >=> (liftP .) g--    But, unlike 'lift', 'liftP' obeys one extra set of laws that guarantee it -    also lifts composition sensibly:--> (liftP .) idT = idT->-> (liftP .) (f >-> g) = (liftP .) f >-> (liftP .) g--    In fact, this @(liftP .)@ pattern is so ubiquitous, that the 'ProxyTrans'-    class provides the additional 'mapP' method for convenience:--> mapP = (liftP .)--    Proxy transformers automatically derive how to lift composition correctly-    and also guarantee that the derived composition obeys the category laws if-    the base composition obeyed the category laws.  Since 'Proxy' composition-    obeys the category laws, any proxy transformer stack built on top of it-    automatically derives a composition operation that is correct by-    construction.--    Let's prove this by directly composing our 'StateP'-extended proxies without-    unwrapping them:--> :t client5 <-< server5 :: () -> StateP Int Proxy C () () C IO r--    However, we still have to unwrap the final 'StateP' 'Session' before we can-    pass it to 'runProxy'.  We use 'runStateK' for this purpose:-->>> runProxy $ runStateK 0 $ client5 <-< server5-Client: 0-Server: 0-Client: 1-Server: 1-Client: 2-Server: 2-Client: 3-Server: 3-...--    Keep in mind that 'runStateK' takes the initial state as its first argument,-    unlike 'runStateT'.  I break from the @transformers@ convention for-    syntactic convenience.--    We can similarly fix our 'EitherT' example, using 'EitherP' from-    "Control.Proxy.Trans.Either":--> import Control.Proxy.Trans.Either as E->-> client6 :: () -> EitherP String Proxy () () () C IO ()-> client6 () = forM_ [1..] $ \i -> do->     liftP $ lift $ print i->     liftP $ request ()->-> server6 :: () -> EitherP String Proxy C () () () IO ()-> server6 () = (forever $ do->     liftP $ respond ()->     E.throw "Error" )->   `E.catch` (\str -> do->         liftP $ lift $ putStrLn $ "Caught: " ++ str->         server6 () )-->>> runProxy $ runEitherK $ client6 <-< server6-1-Caught: Error-2-Caught: Error-3-Caught: Error-...---}--{- $compatibility-    Proxy transformers do more than just lift composition.  They automatically-    promote proxies written in the base monad.  For example, what if I wanted to-    use the 'takeB_' proxy from "Control.Proxy.Prelude.Base" to cap the number-    of results?  I can't compose it directly because it uses the 'Proxy' type:--> takeB_ :: (Monad m) => Int -> a' -> Proxy a' a a' a m ()--    ... whereas @client6@ and @server6@ use @EitherP String Proxy@.  However,-    this doesn't matter because we can automatically lift 'takeB_' to be-    compatible with them using 'mapP':-->>> runProxy $ runEitherK $ client6 <-< mapP (takeB_ 2) <-< server6-1-Caught: Error-2-Caught:Error--    'mapP' promotes any proxy written using the base proxy type to automatically-    be compatible with proxies written using the extended proxy type.  This-    means you can safely write utility proxies using the smallest feature set-    they require and promote them as necessary to work with more extended-    feature sets.  This ensures that any proxies you write always remain-    forwards-compatible as people write new extensions.--}--{- $stacks-    You can stack proxy transformers to combine their effects, such as in the-    following example, which combines everything we've used so far:--> client7 :: () -> EitherP String (StateP Int Proxy) () Int () C IO r-> client7 () = do->     n <- liftP get->     liftP $ liftP $ lift $ print n->     n' <- liftP $ liftP $ request ()->     liftP $ put n'->     E.throw "ERROR"-->>> runProxy $ runStateK 0 $ runEitherK $ client7 <-< mapP (mapP (enumFromS 1))-0-(Left "Error", 1)--    But that's still not the full story!  For calls to the base monad (i.e. 'IO'-    in this case), you don't need to precede them with all those 'liftP's.-    Every proxy transformer also correctly derives 'MonadTrans', so you can dig-    straight to the base monad by just calling 'lift' at the outer-most level:--> client7 :: () -> EitherP String (StateP Int Proxy) () Int () C IO r-> client7 () = do->     n <- liftP get->     lift $ print n  -- Much better!->     n' <- liftP $ liftP $ request ()->     liftP $ put n'->     E.throw "ERROR"--    Also, you can combine multiple proxy transformers into a single proxy-    transformer, just like you would with monad transformers:--> newtype BothP e s p a' a b' b m r =->     BothP { unBothP :: EitherP e (StateP s p) a' a b' b m r }->     deriving (Functor, Applicative, Monad, MonadTrans, Channel)-> -> instance ProxyTrans (BothP e s) where->     liftP = BothP . liftP . liftP-> -> runBoth->  :: (Monad m)->  => s->  -> (b' -> BothP e s p a' a b' b m r)->  -> (b' -> p a' a b' b m (Either e r, s))-> runBoth s = runStateK s . runEitherK . fmap unBothP-> -> get' :: (Monad (p a' a b' b m), Channel p)->      => BothP e s p a' a b' b m s-> get' = BothP $ liftP get-> -> put' :: (Monad (p a' a b' b m), Channel p)->      => s -> BothP e s p a' a b' b m ()-> put' x = BothP $ liftP $ put x-> -> throw' :: (Monad (p a' a b' b m), Channel p)->        => e -> BothP e s p a' a b' b m r-> throw' e = BothP $ E.throw e--    Then we can write proxies using this new proxy transformer of ours:--> client8 :: () -> BothP String Int Proxy () Int () C IO r-> client8 () = do->     n <- get'->     lift $ print n->     n' <- liftP $ request ()->     put' n'->     throw' "ERROR"-->>> runProxy $ runBoth 0 $ client8 <-< mapP (enumFromS 1)-0-(Left "ERROR",1)--    Note that 'request' and 'respond' are not automatically liftable, because of-    technical limitations with Haskell type classes.  When I resolve these-    issues they will also be automatically promoted by proxy transformers.  For-    now, you must lift them manually using 'liftP':--> request = (liftP .) request-> respond = (liftP .) respond--    The left 'request' and 'respond' in the above equations are what the lifted-    definitions would be for each proxy transformer if Haskell's type class-    system didn't get in my way.--}

@@ -6,7 +6,7 @@     The underlying implementation uses the state monad to avoid quadratic blowup     from left-associative binds. -} -{-# LANGUAGE FlexibleContexts, KindSignatures #-}+{-# LANGUAGE KindSignatures #-}  module Control.Proxy.Trans.Writer (     -- * WriterP@@ -21,11 +21,12 @@     ) where  import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))-import Control.Monad (liftM, ap, MonadPlus(mzero, mplus))+import Control.Monad (MonadPlus(mzero, mplus)) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.MFunctor (MFunctor(mapT))-import Control.Proxy.Class (Channel(idT, (>->)))+import Control.MFunctor (MFunctor(hoist))+import Control.PFunctor (PFunctor(hoistP))+import Control.Proxy.Class import Control.Proxy.Trans (ProxyTrans(liftP)) import Data.Monoid (Monoid(mempty, mappend)) @@ -33,51 +34,88 @@ newtype WriterP w p a' a b' b (m :: * -> *) r   = WriterP { unWriterP :: w -> p a' a b' b m (r, w) } -instance (Monad (p a' a b' b m))- => Functor (WriterP w p a' a b' b m) where-    fmap = liftM+instance (Proxy              p, Monad m)+       => Functor (WriterP w p a' a b' b m) where+    fmap f p = WriterP (\w0 ->+        unWriterP p w0 ?>= \(x, w1) ->+        return_P (f x, w1) ) -instance (Monad (p a' a b' b m))- => Applicative (WriterP w p a' a b' b m) where-    pure  = return-    (<*>) = ap+instance (Proxy                  p, Monad m)+       => Applicative (WriterP w p a' a b' b m) where+    pure = return+    fp <*> xp = WriterP (\w0 ->+        unWriterP fp w0 ?>= \(f, w1) ->+        unWriterP xp w1 ?>= \(x, w2) ->+        return_P (f x, w2) )+ -- (<*>) = ap -instance (Monad (p a' a b' b m))- => Monad (WriterP w p a' a b' b m) where-    return a = WriterP $ \w -> return (a, w)-    m >>= f = WriterP $ \w -> do-        (a, w') <- unWriterP m w-        unWriterP (f a) w'+instance (Proxy            p, Monad m)+       => Monad (WriterP w p a' a b' b m) where+    return = return_P+    (>>=) = (?>=) -instance (MonadPlus (p a' a b' b m))- => Alternative (WriterP w p a' a b' b m) where+instance (MonadPlusP             p, Monad m)+       => Alternative (WriterP w p a' a b' b m) where     empty = mzero     (<|>) = mplus -instance (MonadPlus (p a' a b' b m))- => MonadPlus (WriterP w p a' a b' b m) where-    mzero = WriterP $ \_ -> mzero-    mplus m1 m2 = WriterP $ \w -> mplus (unWriterP m1 w) (unWriterP m2 w)+instance (MonadPlusP            p )+       => MonadPlusP (WriterP w p) where+    mzero_P       = WriterP (\_ -> mzero_P)+    mplus_P m1 m2 = WriterP (\w -> mplus_P (unWriterP m1 w) (unWriterP m2 w)) -instance (MonadTrans (p a' a b' b))- => MonadTrans (WriterP w p a' a b' b) where-    lift m = WriterP $ \w -> lift $ liftM (\r -> (r, w)) m+instance (MonadPlusP           p, Monad m)+       => MonadPlus (WriterP w p a' a b' b m) where+    mzero = mzero_P+    mplus = mplus_P -instance (MonadIO (p a' a b' b m))- => MonadIO (WriterP w p a' a b' b m) where-    liftIO m = WriterP $ \w ->  liftIO $ liftM (\r -> (r, w)) m+instance (Proxy                 p )+       => MonadTrans (WriterP w p a' a b' b) where+    lift = lift_P -instance (MFunctor (p a' a b' b)) => MFunctor (WriterP w p a' a b' b) where-    mapT nat = WriterP . fmap (mapT nat) . unWriterP+instance (MonadIOP            p )+       => MonadIOP (WriterP w p) where+    liftIO_P m = WriterP (\w -> liftIO_P (m >>= \r -> return (r, w))) -instance (Channel p) => Channel (WriterP w p) where-    idT a = WriterP $ \_ -> idT a-    (p1 >-> p2) a = WriterP $ \w ->-        ((`unWriterP` w) . p1 >-> (`unWriterP` w) . p2) a+instance (MonadIOP           p, MonadIO m)+       => MonadIO (WriterP w p a' a b' b m) where+    liftIO = liftIO_P -instance (Monoid w) => ProxyTrans (WriterP w) where-    liftP m = WriterP $ \w -> liftM (\r -> (r, w)) m+instance (Proxy               p )+       => MFunctor (WriterP w p a' a b' b) where+    hoist = hoist_P +instance (Proxy            p )+       => Proxy (WriterP w p) where+    p1 >-> p2 = \c'1 -> WriterP (\w ->+        ((\b' -> unWriterP (p1 b') w) >-> (\c'2 -> unWriterP (p2 c'2) w)) c'1 )+ {- p1 >-> p2 = \c' -> WriterP $ \w ->+        ((`unWriterP` w) . p1 >-> (`unWriterP` w) . p2) c' -}++    p1 >~> p2 = \c'1 -> WriterP (\w ->+        ((\b' -> unWriterP (p1 b') w) >~> (\c'2 -> unWriterP (p2 c'2) w)) c'1 )+ {- p1 >~> p2 = \c' -> WriterP $ \w ->+        ((`unWriterP` w) . p1 >~> (`unWriterP` w) . p2) c' -}++    request = \a' -> WriterP (\w -> request a' ?>= \a  -> return_P (a,  w))+    respond = \b  -> WriterP (\w -> respond b  ?>= \b' -> return_P (b', w))++    return_P = \r -> WriterP (\w -> return_P (r, w))+    m ?>= f  = WriterP (\w ->+        unWriterP m w ?>= \(a, w') ->+        unWriterP (f a) w' )++    lift_P m = WriterP (\w -> lift_P (m >>= \r -> return (r, w)))++    hoist_P nat p = WriterP (\w -> hoist_P nat (unWriterP p w))+ -- hoist_P nat = WriterP . fmap (hoist_P nat) . unWriterP++instance ProxyTrans (WriterP w) where+    liftP m = WriterP (\w -> m ?>= \r -> return_P (r, w))++instance PFunctor (WriterP w) where+    hoistP nat = WriterP . (nat .) . unWriterP+ -- | Run a 'WriterP' computation, producing the final result and monoid runWriterP :: (Monoid w) => WriterP w p a' a b' b m r -> p a' a b' b m (r, w) runWriterP p = unWriterP p mempty@@ -86,26 +124,31 @@ runWriterK  :: (Monoid w)  => (q -> WriterP w p a' a b' b m r) -> (q -> p a' a b' b m (r, w))-runWriterK = (runWriterP . )+runWriterK k q = runWriterP (k q)+-- runWriterK = (runWriterP . )  -- | Evaluate a 'WriterP' computation, but discard the final result execWriterP- :: (Monad (p a' a b' b m), Monoid w)+ :: (Proxy p, Monad m, Monoid w)  => WriterP w p a' a b' b m r -> p a' a b' b m w-execWriterP m = liftM snd $ runWriterP m+execWriterP m = runWriterP m ?>= \(_, w) -> return_P w+-- execWriterP m = liftM snd $ runWriterP m  -- | Evaluate a 'WriterP' \'@K@\'leisli arrow, but discard the final result execWriterK- :: (Monad (p a' a b' b m), Monoid w)+ :: (Proxy p, Monad m, Monoid w)  => (q -> WriterP w p a' a b' b m r) -> (q -> p a' a b' b m w)-execWriterK = (execWriterP .)+execWriterK k q= execWriterP (k q)  -- | Add a value to the monoid-tell :: (Monad (p a' a b' b m), Monoid w) => w -> WriterP w p a' a b' b m ()-tell w' = WriterP $ \w -> let w'' = mappend w w' in w'' `seq` return ((), w'')+tell :: (Proxy p, Monad m, Monoid w) => w -> WriterP w p a' a b' b m ()+tell w' = WriterP (\w -> let w'' = mappend w w' in w'' `seq` return_P ((), w''))  -- | Modify the result of a writer computation censor- :: (Monad (p a' a b' b m), Monoid w)+ :: (Proxy p, Monad m, Monoid w)  => (w -> w) -> WriterP w p a' a b' b m r -> WriterP w p a' a b' b m r-censor f = WriterP . fmap (liftM (\(a, w) -> (a, f w))) . unWriterP+censor f p = WriterP (\w0 ->+    unWriterP p w0 ?>= \(r, w1) ->+    return_P (r, f w1) )+-- censor f = WriterP . fmap (liftM (\(r, w) -> (r, f w))) . unWriterP

@@ -1,550 +1,1890 @@--- | This module provides the tutorial for "Control.Proxy"--module Control.Proxy.Tutorial (-    -- * Basics-    -- $basics--    -- * Types-    -- $types--    -- * Composition-    -- $composition--    -- * Idioms-    -- $idioms--    -- * Reusability-    -- $reuse--    -- * Mixing monads and composition-    -- $monads--    -- * Utility proxies-    -- $utility--    -- * Pipe compatibility-    -- $pipes-    ) where--import Control.Monad.Trans.Class-import Control.Proxy--{- $basics-    The 'Proxy' type models composable chains of client-server interactions.--    A 'Proxy' is a monad transformer that extends the base monad with the-    ability to 'request' input from upstream and 'respond' with output to-    downstream.--    For example, consider the following toy remote procedure call-    'Server':--> import Control.Proxy-> import Control.Monad.Trans->-> incrementer :: Int -> Server Int Int IO r-> incrementer question = do->     lift $ putStrLn $ "Server received : " ++ show question->     let answer = question + 1->     lift $ putStrLn $ "Server responded: " ++ show answer->     nextQuestion <- respond answer->     incrementer nextQuestion--    We can understand what the 'Server' does just by looking at the type:-->        | Question | Answer | Base monad | Return value-> Server   Int        Int        IO           r--    Our 'Server' receives questions about 'Int's, and responds with answers that-    are 'Int's.  The base monad is 'IO' because our 'Server' 'lift's two-    'putStrLn' statements to chat out loud.  The return value is polymorphic-    because our 'Server' never terminates.--    Note that the base monad doesn't always need to be 'IO'.  Unlike typical-    servers, these kinds of 'Server's are pure syntax trees with no side-    effects unless you call 'lift'.--    Now we can write a 'Client' that interacts with our 'Server':--> import Control.Monad->-> oneTwoThree :: () -> Client Int Int IO ()-> oneTwoThree () = forM_ [1, 2, 3] $ \question -> do->     lift $ putStrLn $ "Client requested: " ++ show question->     answer <- request question->     lift $ putStrLn $ "Client received : " ++ show answer->     lift $ putStrLn "*"--    Again, the type explains what the 'Client' does:-->        | Question | Answer | Base monad | Return value-> Client   Int      | Int    | IO         | ()--    Our 'Client' asks questions about 'Int's and receives answers that are-    'Int's.  The 'Client' also uses 'IO' as the base monad.--    We can then compose the 'Client' and 'Server' into a 'Session' using the-    ('<-<') operator:--> session :: () -> Session IO ()-> session = oneTwoThree <-< incrementer--    The 'Session' type indicates that we have a self-contained session that we-    can run in the 'IO' monad.  We run it using the the 'runProxy' function:-->>> runProxy session :: IO ()-Client requested: 1-Server received : 1-Server responded: 2-Client received : 2-*-Client requested: 2-Server received : 2-Server responded: 3-Client received : 3-*-Client requested: 3-Server received : 3-Server responded: 4-Client received : 4-*--    Now, let's add an intermediate 'Proxy' between the 'Client' and 'Server'-    that subtly tampers with the stream going through it:--> malicious :: Int -> Proxy Int Int Int Int IO r-> malicious question = do->     question' <- if (question > 2)->                  then do->                      lift $ putStrLn "MUAHAHAHA!"->                      return (question + 1)->                  else return question->     answer <- request question'->     nextQuestion <- respond answer->     malicious nextQuestion--    The type tells us what our 'Proxy' does:-->       | Upstream (Server) | Downstream (Client) |->       | Question | Answer | Question |  Answer  | Base monad | Return value-> Proxy   Int        Int      Int         Int       IO           r--    A 'Proxy' bridges two separate interfaces.  The first two parameters define-    the upstream interface (i.e. in the 'Server' direction) and the second two-    parameters define the downstream interface (i.e. in the 'Client' direction).--    We can see if our proxy does its job correctly:-->>> runProxy $ oneTwoThree <-< malicious <-< incrementer-Client requested: 1-Server received : 1-Server responded: 2-Client received : 2-*-Client requested: 2-Server received : 2-Server responded: 3-Client received : 3-*-Client requested: 3-MUAHAHAHA!-Server received : 4-Server responded: 5-Client received : 5-*--    We can also add more proxies as we see fit:-->>> runProxy $ oneTwoThree <-< malicious <-< malicious <-< incrementer -Client requested: 1-Server received : 1-Server responded: 2-Client received : 2-*-Client requested: 2-Server received : 2-Server responded: 3-Client received : 3-*-Client requested: 3-MUAHAHAHA!-MUAHAHAHA!-Server received : 5-Server responded: 6-Client received : 6-*--}--{- $types-    You probably noticed something odd: ('<-<') seems to be composing values of-    different types.  Sometimes it composes a 'Server' or a 'Client' or a-    'Proxy'.  In reality, though, both 'Server' and 'Client' are just type-    synonyms for special cases of 'Proxy':--> type Server arg ret = Proxy C   ()  arg ret-> type Client arg ret = Proxy arg ret ()  C--    A 'Server' is just a 'Proxy' that has no upstream interface, and a 'Client'-    is just a 'Proxy' that has no downstream interface.  In fact, 'Session' is-    also a 'Proxy', one with both ends closed:--> type Session        = Proxy C   ()  ()  C--    The 'Proxy' is the unifying type that all other types derive from and-    ('<-<') always composes two 'Proxy's and returns a new 'Proxy' of the-    correct type.--    You also probably noticed another odd thing: we parametrize every 'Proxy'-    on its initial argument:-->                +- Initial Arg->                |->                v-> incrementer :: Int -> Server         Int Int IO r-> malicious   :: Int -> Proxy  Int Int Int Int IO r-> oneTwoThree :: ()  -> Client Int Int         IO ()->-> session     :: ()  -> Session                IO ()--    This input initializes each 'Proxy' and corresponds to the input on the-    downstream interface.  I will expand the 'Server' and 'Client' type synonyms-    to show this:-->                +- Initial Arg = This -+->                |                      |->                v                      v-> incrementer :: Int -> Proxy  C   ()  Int Int IO r-> malicious   :: Int -> Proxy  Int Int Int Int IO r-> oneTwoThree :: ()  -> Proxy  Int Int ()  C   IO ()->-> session     :: ()  -> Proxy  C   ()  ()  C   IO ()--    Composition supplies the first request through this initial parameter-    and all subsequent requests are bound to 'respond' statements.--    This means that the actual types you compose are all of the form:--> proxy :: req_b -> Proxy req_a resp_a req_b resp_b m r--}--{- $composition-    'Proxy' composition posseses an identity 'Proxy' that is completely-    transparent to anything upstream or downstream of it:--> idT :: (Monad m) => req -> Proxy req resp req resp m r-> idT question = do->     answer       <- request question->     nextQuestion <- respond answer->     idT nextQuestion--    Transparency means that:--> idT <-< p = p->-> p <-< idT = p--    Also, 'Proxy' composition has the nice property that it behaves exactly the-    same way no matter how you group components:--> (p1 <-< p2) <-< p3 = p1 <-< (p2 <-< p3)--    This means that ('<-<') and 'idT' define a category, and the above equations-    are the category laws.  These laws guarantee the following nice-    properties of components:--    * You can reason about each component's behavior independently of other-      components--    * You don't encounter boundary cases between components--    * You don't encounter edge cases at the 'Server' or 'Client' ends--    The semantics of 'Proxy' composition are simple:--    * 'request' blocks until it receives a response from upstream--    * 'respond' blocks until it receives a new request from downstream--    * If any 'Proxy' in the chain terminates, the entire chain terminates--}--{- $idioms-    We frequently encounter the following recurring pattern when writing-    'Proxy's:--> someProxy arg = do->     ...->     nextArg <- respond x->     someProxy nextArg--    "Control.Proxy" provides the 'foreverK' utility function which abstracts-    away this manual recursion:--> foreverK f = f >=> foreverK f--    Using 'foreverK', we can simplify the definition of 'incrementer':--> incrementer = foreverK $ \question -> do->     lift $ putStrLn $ "Server received : " ++ show question->     let answer = question + 1->     lift $ putStrLn $ "Server responded: " ++ show answer->     respond answer--    ... which looks exactly like the way you might write server code in another-    programming language.--    We can similarly simplify 'malicious' this way:--> malicious = foreverK $ \question -> do->     question' <- if (question > 2)->                  then do->                      lift $ putStrLn "MUAHAHAHA!"->                      return (question + 1)->                  else return question->     answer <- request question'->     respond answer--    ... or 'idT':--> idT = foreverK $ \question -> do->     answer <- request question->     respond answer->-> -- or: idT = foreverK (request >=> respond)-> --         = request >=> respond >=> request >=> respond >=> ...--}--{- $reuse-    We can mix and match different components to rapidly define emergent-    behaviors from a resuable set of core primitives.  For example, we could-    replace our client with a command line prompt where the user provides the-    input to the server:--> inputPrompt :: (Read a, Show b) => () -> Client a b IO r-> inputPrompt () = forever $ do->     str <- lift $ getLine->     let a = read str->     b <- request a->     lift $ print b->     lift $ putStrLn "*"-->>> runProxy $ inputPrompt <-< incrementer-42<Enter>-Server received : 42-Server responded: 43-43-*-666<Enter>-Server received : 666-Server responded: 667-667-*--    Oh no, we lost our useful client diagnostic messages!  No worries, we can-    abstract that functionality away into its own component:--> diagnoseClient :: (Show a, Show b) => a -> Proxy a b a b IO r-> diagnoseClient = foreverK $ \a -> do->     lift $ putStrLn $ "Client requested: " ++ show a->     b <- request a->     lift $ putStrLn $ "Client received : " ++ show b->     respond b-->>> runProxy $ inputPrompt <-< diagnoseClient <-< incrementer-42<Enter>-Client requested: 42-Server received : 42-Server responded: 43-Client received : 43-43-*-666<Enter>-Client requested: 666-Server received : 666-Server responded: 667-Client received : 667-667-*--    Because of associativity, we can bundle @inputPrompt@ and @diagnoseClient@-    into a single black box and not worry that the abstraction will leak due to-    grouping issues:--> verboseInput :: (Read a, Show b, Show a) => () -> Client a b IO r-> verboseInput = inputPrompt <-< diagnoseClient-->>> runProxy $ verboseInput <-< incrementer-<Exactly same behavior>--    Or what if I want to cache the results coming out of @incrementer@?  I can-    define a 'Proxy' to cache all requests going through it:--> import qualified Data.Map as M->-> cache :: (Ord a) => a -> Proxy a b a b IO r-> cache = cache' M.empty->-> cache' m a =->     case M.lookup a m of->         Nothing -> do->             b  <- request a->             a' <- respond b->             cache' (M.insert a b m) a'->         Just b  -> do->             lift $ putStrLn "Used cache!"->             a' <- respond b->             cache' m a'-->>> runProxy $ verboseInput <-< cache <-< incrementer -42<Enter>-Client requested: 42-Server received : 42-Server responded: 43-Client received : 43-43-*-42<Enter>-Client requested: 42-Used cache!-Client received : 43-43-*--    Note that I don't distinguish between a \"reverse proxy\" or a \"forward-    proxy\" since composition doesn't distinguish either.  You can attach the-    @cache@ 'Proxy' to a 'Client':--> client' = client <-< cache--    ... or to a 'Server':--> server' = cache <-< server--    ... or anywhere in between.  It's completely up to you!--}--{- $monads-    All the previous examples use a single composition chain, but you need not-    restrict yourself to that design pattern.  Remember that the result of-    composition is a 'Proxy' itself (parametrized by an input), and 'Proxy's are-    'Monad's, so you can bind the result of composition directly within another-    @do@ block to generate complex behaviors:--> mixedClient :: () -> Client Int Int IO r-> mixedClient () = do->     oneTwoThree ()->     -- Here we bind composition within a larger do block->     (inputPrompt <-< cache) ()->-> -- or: mixedClient = oneTwoThree >=> (inputPrompt <-< cache)-->>> runProxy $ mixedClient <-< incrementer-Client requested: 1-Server received : 1-Server responded: 2-Client received : 2-*-Client requested: 2-Server received : 2-Server responded: 3-Client received : 3-*-Client requested: 3-Server received : 3-Server responded: 4-Client received : 4-*-42<Enter>-Server received : 42-Server responded: 43-43-*-42<Enter>-Used cache!-43-*--    So feel free to use your imagination!  Up until the moment you call-    'runProxy', you can freely mix composition or @do@ notation within each-    other.--}--{- $utility-    This library features several utility proxies to get you started.  They all-    reside under the "Control.Proxy.Prelude" hierarchy and they are imported by-    default when you import "Control.Proxy".--    For example, if you wanted to print the first 3 natural numbers, you would-    use:-->>> runProxy $ printD <-< enumFromToS 1 3-1-2-3--    The utility functions follow a systematic naming convention that uses the-    last letter:--    * @D@: Only interacts with values going \'@D@\'ownstream towards the-      'Client'--    * @U@: Only interacts with values going \'@U@\'pstream towards the 'Server'--    * @B@: Interacts with values going \'@B@\'oth ways--    * @C@: Belongs in the \'@C@\'lient position--    * @S@: Belongs in the \'@S@\'server position--    Many utility proxies auto-forward values they receive, such as 'printD'.-    This means we can easily combine multiple handling stages for processing-    values:--> import Control.Proxy-> import System.IO->-> main = do->    h <- openFile "test.txt" WriteMode->    runProxy $ hPrintD h <-< printD <-< enumFromToS 1 3->    hClose h-->>> main-1-2-3--    The above program also wrote the same output to the file "test.txt":--> $ cat test.txt-> 1-> 2-> 3--    'runProxy' discards any output that goes past the endpoints of the session,-    so you don't need to worry about closing off each end.--    This library does not provide 'ByteString' or 'Text' utilities in order to-    reduce the number of dependencies of the main package.  These will be-    released in a separate package in the near future.--}--{- $pipes-    'Proxy's generalize 'Pipe's by permitting communication upstream.-    Fortunately, though, you don't need to rewrite your code if you have already-    used 'Pipe's.  "Control.Proxy" formulates all of the 'Pipe' types and-    primitives in terms of the 'Proxy' type.--    This means that if you wish to upgrade your 'Pipe' code to take advantage of-    upstream communication, you only need to import "Control.Proxy" instead-    of "Control.Pipe" and everything will still work out of the box.  Then you-    can selectively upgrade certain components to communicate upstream as-    necessary.--    To understand how 'Pipe's map onto 'Proxy's, just check out the 'Pipe'-    definition in "Control.Proxy.Pipe":--> type Pipe a b = Proxy () a () b--    In other words, a 'Pipe' is just a 'Proxy' where you never pass any-    information upstream.+{-| This module provides a brief introductory tutorial in the \"Introduction\"+    section followed by a lengthy discussion of the library's design and idioms.+-}++module Control.Proxy.Tutorial (+    -- * Introduction+    -- $intro++    -- * Bidirectionality+    -- $bidir++    -- * Type Synonyms+    -- $synonyms++    -- * Request and Respond+    -- $interact++    -- * Composition+    -- $composition++    -- * The Proxy Class+    -- $class++    -- * Interleaving Effects+    -- $interleave++    -- * Mixing Base Monads+    -- $hoist++    -- * Utilities+    -- $utilities++    -- * Mix Monads and Composition+    -- $mixmonadcomp++    -- * Folds+    -- $folds++    -- * Resource Management+    -- $resource++    -- * Extensions+    -- $extend++    -- * Error handling+    -- $error++    -- * Local state+    -- $state++    -- * Branching, zips, and merges+    -- $branch++    -- * Proxy Transformers+    -- $proxytrans++    -- * Conclusion+    -- $conclusion+    ) where++-- For documentation+import Control.Category+import Control.Monad.Trans.Class+import Control.MFunctor+import Control.PFunctor+import Control.Proxy+import Control.Proxy.Core.Correct (ProxyCorrect)+import Control.Proxy.Trans.Either+import Prelude hiding (catch)++{- $intro+    The @pipes@ library replaces lazy 'IO' with a safe, elegant, and+    theoretically principled alternative.  Use this library if you:++    * want to write high-performance streaming programs++    * believe that lazy 'IO' was a bad idea++    * enjoy composing modular and reusable components++    * love theory and elegant code++    This library unifies many kinds of streaming abstractions, all of which are+    special cases of \"proxies\" (The @pipes@ name is a legacy of one such+    abstraction).++    Let's begin with the simplest 'Proxy': a 'Producer'.  The following+    'Producer' lazily streams lines from a 'Handle'++> import Control.Monad+> import Control.Proxy+> import System.IO+> +> --                Produces Strings ---+----------++> --                                    |          |+> --                                    v          v+> lines' :: (Proxy p) => Handle -> () -> Producer p String IO r+> lines' h () = runIdentityP loop where+>     loop = do+>         eof <- lift $ hIsEOF h+>         if eof+>         then return ()+>         else do+>             str <- lift $ hGetLine h+>             respond str  -- Produce the string+>             loop+>+> -- Ignore the 'runIdentityP' and '()' for now++    But why limit ourselves to streaming lines from some file?  Why not lazily+    generate values from an industrious user?++> --               Uses 'IO' as the base monad --++> --                                             |+> --                                             v+> promptInt :: (Proxy p) => () -> Producer p Int IO r+> promptInt () = runIdentityP $ forever $ do+>     lift $ putStrLn "Enter an Integer:"+>     n <- lift readLn  -- 'lift' invokes an action in the base monad+>     respond n++    Now we need to hook our 'Producer's up to a 'Consumer'.  The following+    'Consumer' endlessly 'request's a stream of 'Show'able values and 'print's+    them:++> --                   Consumes 'a's ---+----------+    +-- Never terminates, so+> --                                    |          |    |   the return value is+> --                                    v          v    v   polymorphic+> printer :: (Proxy p, Show a) => () -> Consumer p a IO r+> printer () = runIdentityP $ forever $ do+>     a <- request ()  -- Consume a value+>     lift $ putStrLn "Received a value:"+>     lift $ print a++    You can compose a 'Producer' and a 'Consumer' using ('>->'), which produces+    a runnable 'Session':++> --                Self-contained session ---+         +--+-- These must match+> --                                          |         |  |   each component+> --                                          v         v  v+> promptInt >-> printer :: (Proxy p) => () -> Session p IO r+>+> lines' h  >-> printer :: (Proxy p) => () -> Session p IO ()++    ('>->') connects each 'request' in @printer@ with a 'respond' in+    @lines'@ or @promptInt@.++    Finally, you use 'runProxy' to run the 'Session' and convert it back to the+    base monad.  First we'll try our @lines'@ 'Producer', which will stream+    lines from the following file:++> $ cat test.txt+> Line 1+> Line 2+> Line 3++    The following program never brings more than a single line into memory (not+    that it matters for such a small file):++>>> withFile "test.txt" $ \h -> runProxy $ lines' h >-> printer+Received a value:+"Line 1"+Received a value:+"Line 2"+Received a value:+"Line 3"++    Similarly, we can lazily stream user input, requesting values from the user+    only when we need them:++>>> runProxy $ promptInt >-> printer :: IO r+Enter an Integer:+1<Enter>+Received a value:+1+Enter an Integer:+5<Enter>+Received a value:+5+...++    The last example proceeds endlessly until we hit @Ctrl-C@ to interrupt it.++    We would like to limit the number of iterations, so lets define an+    intermediate 'Proxy' that behaves like a verbose 'take'.  I will call it a+    'Pipe' (this library's namesake) since values flow through it:++>                           'a's flow in ---+ +--- 'a's flow out+>                                           | |+>                                           v v+> take' :: (Proxy p) => Int -> () -> Pipe p a a IO ()+> take' n () = runIdentityP $ do+>     replicateM_ n $ do+>         a <- request ()+>         respond a+>     lift $ putStrLn "You shall not pass!"++    This 'Pipe' forwards the first @n@ values it receives undisturbed, then it+    outputs a cute message.  You can compose it between the 'Producer' and+    'Consumer' using ('>->'):++>>> runProxy $ promptInt >-> take' 2 >-> printer :: IO ()+Enter an Integer:+9<Enter>+Received a value:+9+Enter an Integer:+2<Enter>+Received a value:+2+You shall not pass!++    When @take' 2@ terminates, it brings down every 'Proxy' composed with it.++    Notice how @promptInt@ behaves lazily and only 'respond's with as many+    values as we 'request'.  We 'request'ed exactly two values, so it only+    prompts the user twice.++    We can already spot several improvements upon traditional lazy 'IO':++    * You can define your own lazy components that have nothing to do with files++    * @pipes@ never uses 'unsafePerformIO' or violates referential transparency.++    * You don't need strictness hacks to ensure the proper ordering of effects++    * You can interleave effects in downstream stages, too++    However, this library can offer even more than that!+-}++{- $bidir+    So far we've only defined proxies that send information downstream in the+    direction of the ('>->') arrow.  However, we don't need to limit ourselves+    to unidirectional communication and we can enhance these proxies with the+    ability to send information upstream with each 'request' that determines+    how upstream stages 'respond'.++    For example, 'Client's generalize 'Consumer's because they can supply an+    argument other than @()@ with each 'request'.  The following 'Client'+    sends three 'request's upstream, each of which provides an 'Int' @argument@+    and expects a 'Bool' @result@:++>                      Sends out 'Int's ---+   +-- Receives back 'Bool's+>                                          |   |+>                                          v   v+> threeReqs :: (Proxy p) => () -> Client p Int Bool IO ()+> threeReqs () = runIdentityP $ forM_ [1, 3, 1] $ \argument -> do+>     lift $ putStrLn $ "Client Sends:   " ++ show (argument :: Int)+>     result <- request argument+>     lift $ putStrLn $ "Client Receives:" ++ show (result :: Bool)+>     lift $ putStrLn "*"++    Notice how 'Client's use \"@request argument@\" instead of+    \"@request ()@\".  This sends \"@argument@\" upstream to parametrize the+    'request'.++    'Server's similarly generalize 'Producer's because they receive arguments+    other than @()@.  The following 'Server' receives 'Int' 'request's and+    'respond's with 'Bool' values:++>                       Receives 'Int's ---+   +--- Replies with 'Bool's+>                                          |   |+>                                          v   v+> comparer :: (Proxy p) => Int -> Server p Int Bool IO r+> comparer = runIdentityK loop where+>     loop argument = do+>         lift $ putStrLn $ "Server Receives:" ++ show (argument :: Int)+>         let result = argument > 2+>         lift $ putStrLn $ "Server Sends:   " ++ show (result :: Bool)+>         nextArgument <- respond result+>         loop nextArgument++    Notice how 'Server's receive their first argument as a parameter and bind+    each subsequent argument using 'respond'.  This library provides a+    combinator which abstracts away this common pattern:++> foreverK :: (Monad m) => (a -> m a) -> a -> m b+> foreverK f = loop where+>     loop argument = do+>          nextArgument <- f argument+>          loop nextArgument+>+> -- or: foreverK f = f >=> foreverK f+> --                = f >=> f >=> f >=> f >=> ...++    We can use this to simplify the @comparer@ 'Server':++> comparer = runIdentityK $ foreverK $ \argument -> do+>     lift $ putStrLn $ "Server Receives:" ++ show argument+>     let result = argument > 2+>     lift $ putStrLn $ "Server Sends:   " ++ show result+>     respond result++    ... which looks just like the way you might write a server's main loop in+    another programming language.++    You can compose a 'Server' and 'Client' using ('>->'), and this also returns+    a runnable 'Session':++> comparer >-> threeReqs :: (Proxy p) => () -> Session p IO ()++    Running this executes the client-server session:++>>> runProxy $ comparer >-> threeReqs :: IO ()+Client Sends:    1+Server Receives: 1+Server Sends:    False+Client Receives: False+*+Client Sends:    3+Server Receives: 3+Server Sends:    True+Client Receives: True+*+Client Sends:    1+Server Receives: 1+Server Sends:    False+Client Receives: False+*++    'Proxy's generalize 'Pipe's because they allow information to flow upstream.+    The following 'Proxy' caches 'request's to reduce the load on the 'Server'+    if the request matches a previous one:++> import qualified Data.Map as M+>+> -- 'p' is the Proxy, as the (Proxy p) constraint indicates+>+> cache :: (Proxy p, Ord key) => key -> p key val key val IO r+> cache = runIdentityK (loop M.empty) where+>     loop _map key = case M.lookup key _map of+>         Nothing -> do+>             val  <- request key+>             key2 <- respond val+>             loop (M.insert key val _map) key2+>         Just val -> do+>             lift $ putStrLn "Used cache!"+>             key2 <- respond val+>             loop _map key2++    You can compose the @cache@ 'Proxy' between the 'Server' and 'Client' using+    ('>->'):++>>> runProxy $ comparer >-> cache >-> threeReqs+Client Sends:    1+Server Receives: 1+Server Sends:    False+Client Receives: False+*+Client Sends:    3+Server Receives: 3+Server Sends:    True+Client Receives: True+*+Client Sends:    1+Used cache!+Client Receives: False+*++    This bidirectional flow of information separates @pipes@ from other+    streaming libraries which are unable to model 'Client's, 'Server's, or+    'Proxy's.  Using @pipes@ you can define interfaces to RPC interfaces, REST+    architectures, message buses, chat clients, web servers, network protocols+    ... you name it!+-}++{- $synonyms+    You might wonder why ('>->') accepts 'Producer's, 'Consumer's, 'Pipe's,+    'Client's, 'Server's, and 'Proxy's.  It turns out that these type-check+    because they are all type synonyms that expand to the following central+    type:++> (Proxy p) => p a' a b' b m r++    Like the name suggests, a 'Proxy' exposes two interfaces: an upstream+    interface and a downstream interface.  Each interface can both send and+    receive values:++> Upstream | Downstream+>     +---------++>     |         |+> a' <==       <== b'+>     |  Proxy  |+> a  ==>       ==> b+>     |         |+>     +---------+++    Proxies are monad transformers that enrich the base monad with the ability+    to send or receive values upstream or downstream:++>   | Sends    | Receives | Receives   | Sends      | Base  | Return+>   | Upstream | Upstream | Downstream | Downstream | Monad | Value+> p   a'         a          b'           b            m       r++    We can selectively close certain inputs or outputs to generate specialized+    proxies.++    For example, a 'Producer' is a 'Proxy' that can only output values to its+    downstream interface:++> Upstream | Downstream+>     +----------++>     |          |+> C  <==        <== ()+>     | Producer |+> () ==>        ==> b+>     |          |+>     +----------++>+> type Producer p b m r = p C () () b m r+>+> -- The 'C' type is uninhabited, so it 'C'loses an output end++    A 'Consumer' is a 'Proxy' that can only receive values on its upstream+    interface:++> Upstream | Downstream+>     +----------++>     |          |+> () <==        <== ()+>     | Consumer |+> a  ==>        ==> C+>     |          |+>     +----------++>+> type Consumer p a m r = p () a () C m r++    A 'Pipe' is a 'Proxy' that can only receive values on its upstream interface+    and send values on its downstream interface:++> Upstream | Downstream+>     +--------++>     |        |+> () <==      <== ()+>     |  Pipe  |+> a  ==>      ==> b+>     |        |+>     +--------++>+> type Pipe p a b m r = p () a () b m r++    When we compose proxies, the type system ensures sure that their input and+    output types match:++>       promptInt    >->    take' 2    >->    printer+>+>     +-----------+       +---------+       +---------++>     |           |       |         |       |         |+> C  <==         <== ()  <==       <== ()  <==       <== ()+>     |           |       |         |       |         |+>     | promptInt |       | take' 2 |       | printer |+>     |           |       |         |       |         |+> () ==>         ==> Int ==>       ==> Int ==>       ==> C+>     |           |       |         |       |         |+>     +-----------+       +---------+       +---------+++    Composition fuses these into a new 'Proxy' that has both ends closed, which+    is a 'Session':++>     +-----------------------------------++>     |                                   |+> C  <==                                 <== ()+>     |                                   |+>     | promptInt >-> take' 2 >-> printer |+>     |                                   |+> () ==>                                 ==> C+>     |                                   |+>     +-----------------------------------++>+> type Session p m r = p C () () C m r++    A 'Client' is a 'Proxy' that only uses its upstream interface:++> Upstream | Downstream+>     +----------++>     |          |+> a' <==        <== ()+>     |  Client  |+> a  ==>        ==> C+>     |          |+>     +----------++>+> type Client p a' a m r = p a' a () C m r++    A 'Server' is a 'Proxy' that only uses its downstream interface:+++> Upstream | Downstream+>     +----------++>     |          |+> C  <==        <== b'+>     |  Server  |+> () ==>        ==> b+>     |          |+>     +----------++>+> type Server p b' b m r = p C () b' b m r++    The compiler ensures that the types match when we compose 'Server's,+    'Proxy's, and 'Client's.++>        comparer   >->     cache   >->      threeReqs+>+>     +----------+        +-------+        +-----------++>     |          |        |       |        |           |+> C  <==        <== Int  <==     <== Int  <==         <== ()+>     |          |        |       |        |           |+>     | comparer |        | cache |        | threeReqs |+>     |          |        |       |        |           |+> () ==>        ==> Bool ==>     ==> Bool ==>         ==> C+>     |          |        |       |        |           |+>     +----------+        +-------+        +-----------+++    This similarly fuses into a 'Session':++>     +----------------------------------++>     |                                  |+> C  <==                                <== ()+>     |                                  |+>     | comparer >-> cache >-> threeReqs |+>     |                                  |+> () ==>                                ==> C+>     |                                  |+>     +----------------------------------+++    @pipes@ encourages substantial code reuse by implementing all abstractions+    as type synonyms on top of a single type class: 'Proxy'.  This makes your+    life easier because:++    * You only use one composition operator: ('>->')++    * You can mix multiple abstractions together as long as the types match+-}++{- $interact+    There are only two ways to interact with other proxies: 'request' and+    'respond'.  Let's examine their type signatures to understand how they+    work:++> request :: (Monad m, Proxy p) => a' -> p a' a b' b m a+>                                  ^                   ^+>                                  |                   |+>                       Argument --+          Result --+++    'request' sends an argument of type @a'@ upstream, and binds a result of+    type @a@.  Whenever you 'request', you block until upstream 'respond's with+    a value.+++> respond :: (Monad m, Proxy p) => b -> p a' a b' b m b'+>                                  ^                  ^+>                                  |                  |+>                         Result --+  Next Argument --+++    'respond' replies with a result of type @b@, and then binds the /next/+    argument of type @b'@.  Whenever you 'respond', you block until downstream+    'request's a new value.++    Wait, if 'respond' always binds the /next/ argument, where does the /first/+    argument come from?  Well, it turns out that every 'Proxy' receives this+    initial argument as an ordinary parameter, as if they all began blocked on+    a 'respond' statement.+   +    We can see this if we take all the previous proxies we defined and fully+    expand every type synonym.  The initial argument of each 'Proxy' matches+    the type parameter corresponding to the return value of 'respond':++>                                          These+>                                    +--  Columns  ---++>                                    |     Match      |+>                                    v                v+> promptInt :: (Proxy p)          => ()  -> p C   ()  ()  Int  IO r+> printer   :: (Proxy p, Show a)  => ()  -> p ()  a   ()  C    IO r+> take'     :: (Proxy p)   => Int -> ()  -> p ()  a   ()  a    IO ()+> comparer  :: (Proxy p)          => Int -> p C   ()  Int Bool IO r+> cache     :: (Proxy p, Ord key) => key -> p key val key val  IO r++    You can also study the type of composition, which follows this same pattern.+    Composition requires two 'Proxy's blocked on a 'respond', and produces a new+    'Proxy' similarly blocked on a 'respond':++> (>->) :: (Monad m, Proxy p)+>  => (b' -> p a' a b' b m r)+>  -> (c' -> p b' b c' c m r)+>  -> (c' -> p a' a c' c m r)+>      ^            ^+>      |   These    |+>      +---Match----+++    This is why 'Producer's, 'Consumer's, and 'Client's all take @()@ as their+    initial argument, because their corresponding 'respond' commands all have a+    return value of @()@.++    This library also provides ('>~>'), which is the dual of the ('>->')+    composition operator.  ('>~>') composes two 'Proxy's blocked on a 'request'+    and returns a new 'Proxy' blocked on a 'request':++> (>~>)+>  :: (Monad m, Proxy p)+>  => (a -> p a' a b' b m r)+>  -> (b -> p b' b c' c m r)+>  -> (a -> p a' a c' c m r)++    Conceptually, ('>->') composes pull-based systems and ('>~>') composes+    push-based systems.++    In fact, if you went back through the previous code and systematically+    replaced every:++    * ('>->') with ('>~>'),++    * 'respond' with 'request', and++    * 'request' with 'respond'++    ... then everything would still work and produce identical behavior, except+    the compiler would now infer the symmetric types with all interfaces+    reversed.  We can therefore conclude the obvious: pull-based systems are+    symmetric to push-based systems.++    Since these two composition operators are perfectly symmetric, I arbitrarily+    standardize on using ('>->') and I provide all standard library proxies+    blocked on 'respond' so that they work with ('>->').  This gives behavior+    more familiar to Haskell programmers that work with lazy pull-based+    functions.  I only include the ('>~>') composition operator for theoretical+    completeness.+-}++{- $composition+    When we compose @(p1 >-> p2)@, composition ensures that @p1@'s downstream+    interface matches @p2@'s upstream interface.  This follows from the type of+    ('>->'):++> (>->) :: (Monad m, Proxy p)+>  => (b' -> p a' a b' b m r)+>  -> (c' -> p b' b c' c m r)+>  -> (c' -> p a' a c' c m r)++    Diagramatically, this looks like:++>         p1     >->      p2+>+>     +--------+      +--------++>     |        |      |        |+> a' <==      <== b' <==      <== c'+>     |   p1   |      |   p2   |+> a  ==>      ==> b  ==>      ==> c+>     |        |      |        |+>     +--------+      +--------+++    @p1@'s downstream @(b', b)@ interface matches @p2@'s upstream @(b', b)@+    interface, so composition connects them on this shared interface.  This+    fuses away the @(b', b)@ interface, leaving behind @p1@'s upstream @(a', a)@+    interface and @p2@'s downstream @(c', c)@ interface:++>     +-----------------++>     |                 |+> a' <==               <== c'+>     |   p1  >->  p2   |+> a  ==>               ==> c+>     |                 |+>     +-----------------+++    Proxy composition has the very nice property that it is associative, meaning+    that it behaves the exact same way no matter how you group composition:++> (p1 >-> p2) >-> p3 = p1 >-> (p2 >-> p3)++    ... so you can safely elide the parentheses:++> p1 >-> p2 >-> p3++    Also, we can define a \'@T@\'ransparent 'Proxy' that auto-forwards values+    both ways:++> idT :: (Monad m, Proxy p) => a' -> p a' a a' a m r+> idT = runIdentityK loop where+>     loop a' = do+>         a   <- request a'+>         a'2 <- respond a+>         loop a'2+>+> -- or: idT = runIdentityK $ foreverK $ request >=> respond+> --         = runIdentityK $ request >=> respond >=> request >=> respond ...++    Diagramatically, this looks like:++>     +-----++>     |     |+> a' <======== a'   <- All values pass+>     | idT |          straight through+> a  ========> a    <- immediately+>     |     |+>     +-----+++    Transparency means that:++> idT >-> p = p+>+> p >-> idT = p++    In other words, 'idT' is an identity of composition.++    This means that proxies form a true 'Category' where ('>->') is composition+    and 'idT' is the identity.   The associativity law and the two+    identity laws are just the 'Category' laws.  The objects of the category are+    the 'Proxy' interfaces.++    These 'Category' laws guarantee the following important properties:++    * You can reason about each proxy's behavior independently of other proxies++    * You don't encounter weird behavior at the interface between two components++    * You don't encounter corner cases at the 'Server' or 'Client' ends of a+     'Session'+-}++{- $class+    All the proxy code we wrote was generic over the 'Proxy' type class, which+    defines the three central operations of this library's API:++    * ('>->'): Proxy composition++    * 'request': Request input from upstream++    * 'respond': Respond with output to downstream++    @pipes@ defines everything in terms of these three operations, which is+    why all the library's utilities are polymorphic over the 'Proxy' type class.++    Let's look at some example instances of the 'Proxy' type class:++> instance Proxy ProxyFast     -- Fastest implementation+> instance Proxy ProxyCorrect  -- Strict monad transformer laws++    These two types provide the two alternative base implementations:++    * 'ProxyFast': This runs significantly faster on pure code segments and+      employs several rewrite rules to optimize your code into the equivalent+      hand-tuned code.++    * 'ProxyCorrect': This uses a monad transformer implementation that is+      correct by construction, but runs about 8x slower on pure code segments.+      However, for 'IO'-bound code, the performance gap is small.++    These two implementations differ only in the 'runProxy' function that they+    export, which is how the compiler selects which 'Proxy' implementation to+    use.++    "Control.Proxy" automatically selects the fast implementation for you, but+    you can always choose the correct implementation instead by replacing+    "Control.Proxy" with the following two imports:++> import Control.Proxy.Core         -- Everything except the base implementation+> import Control.Proxy.Core.Correct -- The alternative base implementation++    These are not the only instances of the 'Proxy' type class!  This library+    also provides several \"proxy transformers\", which are like monad+    transformers except that they also correctly lift the 'Proxy' type class:++> instance (Proxy p) => Proxy (IdentityP p)+> instance (Proxy p) => Proxy (EitherP e p)+> instance (Proxy p) => Proxy (MaybeP    p)+> instance (Proxy p) => Proxy (ReaderP i p)+> instance (Proxy p) => Proxy (StateP  s p)+> instance (Proxy p) => Proxy (WriterP w p)++    All of the 'Proxy' code we wrote so far also works seamlessly with all of+    these proxy transformers.  The 'Proxy' class abstracts over the+    implementation details and extensions so that you can reuse the same library+    code for any feature set.++    This polymorphism comes at a price: you must embed your 'Proxy' code in at+    least one proxy transformer if you want clean type class constraints.  If+    you don't use extensions then you embed your code in the identity proxy+    transformer: 'IdentityP'.  This is why all the examples use 'runIdentityP'+    or 'runIdentityK' to embed their code in 'IdentityP'.  "Control.Proxy.Class"+    provides a longer discussion on this subject.++    Without this 'IdentityP' embedding, the compiler infers uglier constraints,+    which are also significantly less polymorphic.  We can show this by+    removing the 'runIdentityP' call from @promptInt@ and see what type the+    compiler infers:++> promptInt () = forever $ do+>     lift $ putStrLn "Enter an Integer:"+>     n <- lift readLn+>     respond n++>>> :t promptInt -- I've substantially cleaned up the inferred type+promptInt+  :: (Monad (Producer p Int IO), MonadTrans (Producer p Int), Proxy p) =>+     () -> Producer p Int IO r++    All 'Proxy' instances are already monads and monad transformers, but the+    compiler cannot infer that without the 'IdentityP' embedding.  When we embed+    @promptInt@ in 'IdentityP', the compiler collapses the 'Monad' and+    'MonadTrans' constraints into the 'Proxy' constraint.++    Fortunately, you do not pay any performance price for this 'IdentityP'+    embedding or the type class polymorphism.  Your polymorphic code will still+    run very rapidly, as fast as if you had specialized it to a concrete+    'Proxy' instance without the 'IdentityP' embedding.  I've taken great care+    to ensure that all optimizations and rewrite rules always see through these+    abstractions without any assistance on your part.+-}++{- $interleave+    When you compose two proxies, you interleave their effects in the base+    monad.  The following two proxies demonstrate this interleaving of effects:++> downstream :: (Proxy p) => Consumer p () IO ()+> downstream () = runIdentityP $ do+>     lift $ print 1+>     request ()  -- Switch to upstream+>     lift $ print 3+>     request ()  -- Switch to upstream+>+> upstream :: (Proxy p) => Producer p () IO ()+> upstream () = runIdentityP $ do+>     lift $ print 2+>     respond () -- Switch to downstraem+>     lift $ print 4++     "Control.Proxy.Class" enumerates the 'Proxy' laws, which equationally+     define how all 'Proxy' instances must behave.  These laws require that+     @(upstream >-> downstream)@ must reduce to the following:++> upstream >-> downstream  -- This is true no matter what feature+> =                        -- set or 'Proxy' instance you select+> \() -> lift $ do+>     print 1+>     print 2+>     print 3+>     print 4++    Conceptually, 'runProxy' just applies this to @()@ and removes the 'lift':++> runProxy $ upstream >-> downstream+> =+> do print 1+>    print 2+>    print 3+>    print 4++    Let's test this:++>>> runProxy $ upstream >-> downstream+1+2+3+4++    The 'Proxy' laws let you reason about how proxies interleave effects without+    knowing any specifics about the underlying implementation.  Intuitively, the+    'Proxy' laws say that:++    * 'request' blocks until upstream 'respond's++    * 'respond' blocks until downstream 'request's++    * If a 'Proxy' terminates, it terminates every 'Proxy' composed with it++    Several of the utilities in "Control.Proxy.Prelude.Base" use these+    equational laws to rigorously prove things about their behavior.  For+    example, consider the 'mapD' proxy, which applies a function @f@ to all+    values flowing downstream:++> mapD :: (Monad m, Proxy p) => (a -> b) -> x -> p x a x b m r+> mapD f = runIdentityK loop where+>     loop x = do+>         a  <- request x+>         x2 <- respond (f a)+>         loop x2+>+> -- or: mapD f = runIdentityK $ foreverK $ request >=> respond . f++    We can use the 'Proxy' laws to prove that:++> mapD f >-> mapD g = mapD (g . f)+>+> mapD id = idT++    ... which is what we expect.  We can fuse two consecutive 'mapD's into one+    by composing their functions, and mapping 'id' does nothing at all, just+    like the identity proxy: 'idT'.++    In fact, these are just the functor laws in disguise, where 'mapD' defines a+    functor between the category of Haskell function composition and the+    category of 'Proxy' composition.  "Control.Proxy.Prelude.Base" is full of+    utilities like this that are simultaneously practical and theoretically+    elegant.+-}++{- $hoist+    Composition can't interleave two proxies if their base monads do not+    match.  For instance, I might try to modify @promptInt@ to use+    @EitherT String@ to report the error instead of using exceptions:++> import Control.Monad.Trans.Either -- from the "either" package+> import Safe (readMay)+>+> promptInt2 :: (Proxy p) => () -> Producer p Int (EitherT String IO) r+> promptInt2 () = runIdentityP $ forever $ do+>     str <- lift $ lift $ do+>         putStrLn "Enter an Integer:"+>         getLine+>     case readMay str of+>         Nothing -> lift $ left "Could not read Integer"+>         Just n  -> respond n++    However, if I try to compose it with @printer@, I receive a type error:++>>> runEitherT $ runProxy $ promptInt2 >-> printer+<interactive>:2:40:+    Couldn't match expected type `EitherT String IO'+                with actual type `IO'+    ...++    The type error says that @promptInt2@ uses @(EitherT String IO)@ for its+    base monad, but @printer@ uses 'IO' for its base monad, so composition can't+    interleave their effects.++    You can easily fix this using the 'hoist' function from the 'MFunctor' type+    class in "Control.MFunctor", which transforms the base monad of any monad+    transformer, including the 'Proxy' monad transformer.  "Control.MFunctor"+    really belongs in the @transformers@ package, however it currently resides+    here because it requires the @Rank2Types@ extension.++    You will commonly use 'hoist' to 'lift' one proxy's base monad to match+    another proxy's base monad, like so:++>>> runEitherT $ runProxy $ promptInt2 >-> (hoist lift . printer)+Enter an Integer:+Hello<Enter>+Left "Could not read Integer"++    This library provides three syntactic conveniences for making this easier to+    write.++    First, ('.') has higher precedence than ('>->'), so you can drop the+    parentheses:++>>> runEitherT $ runProxy $ promptInt2 >-> hoist lift . printer+...++    Second, "lift" is such a common argument to 'hoist' that "Control.MFunctor"+    provides the 'raise' function:++> raise = hoist lift++>>> runEitherT $ runProxy $ promptInt2 >-> raise . printer+...++    Third, "Control.Proxy.Prelude.Kleisli" provides the 'hoistK' and 'raiseK'+    functions in case you think composition looks ugly:++> hoistK f = (hoist f .)+>+> raiseK = (raise .)++>>> runEitherT $ runProxy $ promptInt2 >-> raiseK printer+...++    Note that "Control.MFunctor" also provides 'MFunctor' instances for all the+    monad transformers in the @transformers@ package.  This means that you can+    fix any incompatibility between two monad transformer stacks just using+    various combinations of 'hoist' and 'lift'.++    To see how, consider the following contrived pathological example where I+    want to mix two very different monad transformer stacks:++> m1 :: StateT s (ReaderT i IO) r+> m2 :: MaybeT   (WriterT w IO) r++    I can interleave their transformers through judicious use of 'hoist' and+    'lift'++> mBoth :: StateT s (MaybeT (ReaderT i (WriterT w IO))) r+> mBoth = do+>     hoist (lift . hoist lift) m1+>     lift (hoist lift m2)+-}++{- $utilities+    The "Control.Proxy.Prelude" heirarchy provides several utility functions+    for common tasks.  We can redefine the previous example functions just by+    composing these utilities.++    For example, 'readLnS' reads values from user input, so we can read 'Int's+    just by specializing its type:++> readLnS :: (Proxy p, Read a) => () -> Producer p a IO r+>+> readIntS :: (Proxy p) => () -> Producer p Int IO r+> readIntS = readLnS++    The @S@ suffix indicates that it belongs in the \'@S@\'erver position.++    @(takeB_ n)@ allows at most @n@ value to pass through it in \'@B@\'oth+    directions:++> takeB_ :: (Monad m, Proxy p) => Int -> a' -> p a' a a' a m ()++    'takeB_' has a more general type than @take'@ because it allows any type of+    value to flow upstream.++     'printD' prints all values flowing \'@D@\'ownstream:++> printD :: (Proxy p, Show a) => x -> p x a x a IO r++    'printD' has a more general type than our original @printer@ because it+    forwards all values further downstream after 'print'ing them.  This means+    that you could use it as an intermediate stage as well.  However, 'printD'+    still type-checks as the most downstream stage, too, since 'runProxy' just+    discards any unused outbound values.++    These utilities do not clash with the Prelude namespace or common libraries+    because they all end with a capital letter suffix that indicates their+    directionality:++    * \'@D@\' suffix: interacts with values flowing \'@D@\'ownstream++    * \'@U@\' suffix: interacts with values flowing \'@U@\'pstream++    * \'@B@\' suffix: interacts with values flowing \'@B@\'oth ways (or:+      \'@B@\'idirectional)++    * \'@S@\' suffix: belongs furthest upstream in the \'@S@\'erver position++    * \'@C@\' suffix: belongs furthest downstream in the \'@C@\'lient position++    We can assemble these functions into a silent version of our previous+    'Session':++>>> runProxy $ readIntS >-> takeB_ 2 >-> printD+4<Enter>+4+39<Enter>+39++    Fortunately, we don't have to give up our previous useful diagnostics.+    We can use 'execU', which executes an action each time values flow upstream+    through it, and 'execD', which executes an action each time values flow+    downstream through it:++> promptInt :: (Proxy p) => () -> Producer p Int IO r+> promptInt = readLnS >-> execU (putStrLn "Enter an Integer:")+>+> printer :: (Proxy p, Show a) => x -> p x a x a IO r+> printer = execD (putStrLn "Received a value:") >-> printD++    Similarly, we can build our old @take'@ on top of 'takeB_':++> take' :: (Proxy p) => Int -> a' -> p a' a a' a m ()+> take' n a' = runIdentityP $ do  -- Remember, we need 'runIdentityP' if+>     takeB_ n a'                 -- we use 'do' notation or 'lift'+>     lift $ putStrLn "You shall not pass!"++>>> runProxy $ promptInt >-> take' 2 >-> printer+<Exact same behavior>++    Or perhaps I want to skip user input for testing and mock @promptInt@ by+    replacing it with a predefined set of values:++>>> runProxy $ fromListS [4, 37, 1] >-> take'2 >-> printer+Received a value:+4+Received a value:+37++    What about our original @lines@ function?  That's just 'hGetLineS':++> hGetLineS :: (Proxy p) => Handle -> () -> Producer p String IO ()++    You could hand-write loops that accomplish these same tasks, but proxies let+    you:++    * Rapidly swap in and out components for testing, debugging, and fast+      prototyping++    * Factor out common patterns into modular components++    * Mix and match simple stages to build sophisticated programs++    This compositional programming style emphasizes building a library of+    reusable components and connecting them like Unix pipes to assemble the+    desired streaming program.+-}++{- $mixmonadcomp+    Composition isn't the only way to assemble proxies.  You can also sequence+    predefined proxies using @do@ notation to generate more elaborate behaviors.++    Most commonly, you will sequence two sources to combine their outputs, very+    similar to how the Unix @cat@ utility behaves:++> threeSources () = do+>     source1 ()+>     source2 ()+>     source3 ()+>+> -- or: threeSources = source1 >=> source2 >=> source3++    As a concrete example, we could create a 'Producer' where our first source+    presets the first few values and then we let the user take over to generate+    the remaining values:++> source1 :: (Proxy p) => () -> Producer p Int IO r+> source1 () = runIdentityP $ do+>     fromListS [4, 4] ()  -- Source 1+>     readLnS ()           -- Source 2+>+> -- or: source1 = runIdentityK (fromListS [4, 4] >=> readLnS)++>>> runProxy $ source1 >-> printD+4+4+70<Enter>+70+34<Enter>+34+...++    What if we only want the user to provide three values?  We can +    selectively throttle it with 'takeB_':++> source2 :: (Proxy p) => () -> Producer p Int IO ()+> source2 () = runIdentityP $ do+>     fromListS [4, 4] ()+>     (readLnS >-> takeB_ 3) () -- You can compose inside a do block!+>+> -- or: source2 = runIdentityK (fromListS [4, 4] >=> (readLnS >-> takeB_ 3))++    Notice that composition works inside of a @do@ block!  This is a very handy+    trick!++>>> runProxy $ source2 >-> printD+4+4+56<Enter>+56+41<Enter>+41+80<Enter>+80++    You can also concatenate sinks, too:++> sink1 :: (Proxy p) => () -> Consumer p Int IO ()+> sink1 () = do+>     (takeB_ 3         >-> printD) () -- Sink 1+>     (takeWhileD (< 4) >-> printD) () -- Sink 2+>+> -- or: sink1 = (takeB_ 3 >-> printD) >=> (takeWhileD (< 4) >-> printD)++>>> runProxy $ source2 >-> sink1+4          -- The first sink+4          -- handles these+68<Enter>  --+68+1<Enter>   -- The second sink+1          -- handles these+5<Enter>   --++    ... but the above example is gratuitous because you can simply concatenate+    the intermediate stages:++> sink2 :: (Proxy p) => () -> Consumer p Int IO ()+> sink2 () = intermediate >-> printD where+>     intermediate () = do+>         takeB_ 3 ()       -- Intermediate stage 1+>         takeWhileD (< 4)  -- Intermediate stage 2+>+> -- or: sink2 = (takeB_ 3 >=> takeWhileD (< 4)) >-> printD++>>> runProxy $ source2 >-> sink2+<Exact same behavior>++    These examples demonstrate the two principal ways to combine proxies:++    * \"Vertical\" composition, using ('>=>') from the Kleisli category++    * \"Horizontal\" composition: using ('>->') from the Proxy category++    You assemble most proxies simply by composing them in one or both of these+    two categories.+-}++{- $folds+    You can fold a stream of values in two ways, both of which use the base+    monad:++    * Use 'WriterT' in the base monad and 'tell' the values to fold++    * Use 'StateT' in the base monad and 'put' strict values++    'WriterT' is more elegant in principle but leaks space for a large number of+    values to fold.  'StateT' does not leak space if you keep the accumulator+    strict, but is less elegant and doesn't guarantee write-only behavior.  To+    remedy this, I am currently working on a stricter 'WriterT' implementation+    that does not leak space to add to the @transformers@ package.++    "Control.Proxy.Prelude.Base" provides several common folds using 'WriterT'+    as the base monad, such as:++    * 'lengthD': Count how many values flow downstream++> lengthD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (Sum Int) m) r++    * 'toListD': Fold the values flowing downstream into a list.++> toListD :: (Monad m, Proxy p) => x -> p x a x a (WriterT [a] m) r++    * 'anyD': Determine whether any values satisfy the predicate++> anyD :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT Any m) r++    These 'WriterT' versions demonstrate how the elegant approach should work in+    principle and they should be okay for folding a medium number of values+    until I release the fixed 'WriterT'.  If space leaks cause problems, you can+    temporarily rewrite the 'WriterT' folds using the following two strict+    'StateT' folds:++    * 'foldlD'': Strictly fold values flowing downstream++> foldlD'+>  :: (Monad m, Proxy p) => (b -> a -> b) -> x -> p x a x a (StateT b m) r++    * 'foldlU'': Strictly fold values flowing upstream++> foldU'+>  :: (Monad m, Proxy p) => (b -> a' -> b) -> a' -> p a' x a' x (StateT b m) r++    Now, let's try these folds out and see if we can build a list from user+    input:++>>> runWriterT $ runProxy $ raiseK promptInt >-> takeB_ 3 >-> toListD+Enter an Integer:+1<Enter>+Enter an Integer:+66<Enter>+Enter an Integer:+5<Enter>+((), [1, 66, 5])++    Notice that @promptInt@ uses 'IO' as its base monad, but 'toListD' uses+    @(WriterT [Int] m)@ as its base monad, so I use 'raiseK' to get the base+    monads to match.++    You can insert these folds anywhere in the middle of a pipeline and they+    still work:++>>> runWriterT $ runProxy $ fromListS [5, 7, 4] >-> lengthD >-> raiseK printD+5+7+4+((), Sum 3)++    You can also run multiple folds at the same time just by adding more+    'WriterT' layers to your base monad:++>>> runWriterT $ runWriterT $ fromListS [9, 10] >-> anyD even >-> raiseK sumD+(((), Any {getAny = True},Sum {getSum = 19})++    I designed certain special folds to terminate the 'Session' early if they+    can compute their result prematurely, in order to draw as little input as+    possible.  These folds end with an underscore, such as 'headD_', which+    terminates the stream once it receives an input:++> headD_ :: (Monad m, Proxy p) => x -> p x a x a (WriterT (First a) m) ()++>>> runWriterT $ runProxy $ fromListS [3, 4, 9] >-> raiseK printD >-> headD_+3+((), First {getFirst = Just 3})++    Compare this to 'headD' without underscore, which folds the entire input:++>>> runWriterT $ runProxy $ fromListS [3, 4, 9] >-> raiseK printD >-> headD+3+4+9+((), First {getFirst = Just 3})++    Use the versions that don't prematurely terminate if you are running+    multiple folds or if you want to continue to use the rest of the input when+    the fold is done.  Use the versions that do prematurely terminate if+    collecting that single fold is the entire purpose of the session.+-}++{- $resource+    This core library provides utilities for lazily streaming from resources,+    but does not provide utilities for lazily managing resource allocation and+    deallocation.  To frame the problem, let's assume that we try to be clever+    and write a streaming utility that lazily opens a file only in response to+    a 'request', such as the following 'Producer':++> readFile' :: FilePath -> () -> Producer p String IO+> readFile' file () = runIdentityP $ do+>     h <- lift $ openFile file ReadMode+>     lift $ putStrLn "Opening file"+>     hGetLineS h ()+>     lift $ putStrLn "Closing file"+>     lift $ hClose h++    This works well if we fully demand the file:++>>> runProxy $ readFile' "test.txt" >-> printD+Opening file+"Line 1"+"Line 2"+"Line 3"+Closing file++    This also works well if we never demand the file at all, in which case we+    never open it:++>>> runProxy $ readFile' "test.txt" >-> return+-- Outputs nothing++    But it gives exactly the wrong behavior if we partially demand the file:++>>> runProxy $ readFile' "test.txt" >-> takeB_ 1 >-> printD+Opening file+"Line 1"++    Notice that this does not close the file, because once @takeB_ 1@ terminates+    it terminates the entire 'Session' and @readFile'@ does not get a chance to+    finalize the file.++    I will release a separate library in the near future that offers lazy+    resource management, too, but in the meantime I advise that you use one of+    the following two strategies to guarantee deterministic resource+    deallocation.++    The first approach opens all resources before running the session and close+    them all afterward.  For example, if I wanted to emulate the Unix @cp@+    command, streaming one line at a time, I would write:++> import System.IO+>+> cp :: FilePath -> FilePath -> IO ()+> cp inFile outFile =+>     withFile file1 ReadMode  $ \hIn  ->+>     withFile file2 WriteMode $ \hOut ->+>     runProxy $ hGetLineS hIn >-> hPutLineS hOut2++    The advantage of this approach is that it:++    * is straightforward,++    * requires no special integration with existing libraries, and++    * is exception safe.++    The disadvantage is that this does not lazily allocate resources, nor does+    this promptly deallocate them.++    The second approach is to use something like 'ResourceT' (from the+    @resourceT@ package) to register finalizers and ensure they get released+    deterministically.  You may prefer this approach if you have previously used+    the @conduit@ library, which uses 'ResourceT' in its base monad to offer+    resource determinism.  You can use 'ResourceT' with @pipes@, too, just by+    including it in the base monad.++    I plan to release a lazy resource management library very soon built on top+    of @pipes@ that behaves similarly to 'ResourceT'.  The main advantages of+    this upcoming implementation will be that it:++    * uses a simpler and pure implementation++    * obeys several useful theoretical laws++    * requires no dependencies other than @pipes@++    However, if you don't need this extra power, then just stick to the former+    simpler approach.  I plan to release all standard libraries to be agnostic+    of the finalization approach to let you use which one you prefer.+-}++{- $extend+    This library provides several extensions that add features on top of the+    base 'Proxy' API.  These extensions behave like monad transformers, except+    that they also lift the 'Proxy' class through the extension so that the+    extended proxy can still 'request', 'respond', compose with other proxies:++> instance (Proxy p) => Proxy (IdentityP p)  -- Equivalent to IdentityT+> instance (Proxy p) => Proxy (EitherP e p)  -- Equivalent to EitherT+> instance (Proxy p) => Proxy (MaybeP    p)  -- Equivalent to MaybeT+> instance (Proxy p) => Proxy (StateP  s p)  -- Equivalent to StateT+> instance (Proxy p) => Proxy (WriterP w p)  -- Equivalent to WriterT++    Each of these proxy transformers provides the same API as the equivalent+    monad transformer (sometimes even more).  The following sections show some+    common problems that these proxy transformers solve.+-}++{- $error++    Our previous @promptInt@ example suffered from one major flaw:++> promptInt2 :: (Proxy p) => () -> Producer p Int (EitherT String IO) r+> promptInt2 () = runIdentityP $ forever $ do+>     str <- lift $ lift $ do+>         putStrLn "Enter an Integer:"+>         getLine+>     case readMay str of+>         Nothing -> lift $ left "Could not read Integer"+>         Just n  -> respond n++    There is no way to recover from the error and resume streaming data.  You+    can only handle 'Left' value after using 'runProxy', but by then it is too +    late.++    We can solve this by switching the order of the two monad transformers, but+    using 'EitherP' this time instead of 'EitherT':++> import qualified Control.Proxy.Trans.Either as E+>+> --               Proxy transformers play+> --               nice with type synonyms --++> --                                         |+> --                                         v+> promptInt3 :: (Proxy p) => () -> Producer (E.EitherP String p) Int IO r+> -- i.e.       (Proxy p) => () -> EitherP String p C () () Int IO r+>+> promptInt3 () = forever $ do+>     str <- lift $ do+>         putStrLn "Enter an Integer:"+>         getLine+>     case readMay str of+>         Nothing -> E.throw "Could not read Integer"+>         Just n' -> respond n++    This example does not need 'runIdentityP' (nor would that type-check)+    because the 'EitherP' proxy transformer gives the compiler enough+    information to generalize the constraints.++    We've swapped the order of the transformers, so now we use 'runEitherK'+    first to unwrap the 'EitherP' followed by 'runProxy'.++> runEitherK+>  :: (q -> EitherP p a' a b' b m r) -> (q -> p a' a b' b m (Either e r))++>>> runProxy $ runEitherK $ promptInt3 >-> printer :: IO (Either String r)+Enter an Integer:+Hello<Enter>+Left "Could not read Integer"++    Notice how we can directly compose @printer@ with @promptInt@.+    This works because @printer@'s base proxy type is completely polymorphic+    over the 'Proxy' type class and doesn't use any features specific to any+    proxy transformers:++>                  'p' type-checks as anything --++>                   that implements 'Proxy'      |+>                                                v+> printer :: (Proxy p, Show a) => () -> Consumer p a IO r++    This means that you can compose @printer@ with anything that implements the+    'Proxy' type class, including 'EitherP', without any lifting.++    'EitherP' lets us catch and handle errors locally without disturbing other+    proxies.  For example, I can define a heartbeat function that just restarts+    a given proxy each time it raises an error:++> heartbeat+>  :: (Proxy p)+>  => E.EitherP String p a' a b' b IO r+>  -> E.EitherP String p a' a b' b IO r+> heartbeat p = p `E.catch` \err -> do+>     lift $ putStrLn err  -- Print the error+>     heartbeat p          -- Restart 'p'++    This uses the 'catch' function from "Control.Proxy.Trans.Either", which+    lets you catch and handle errors locally without disturbing other proxies.++>>> runProxy $ E.runEitherK $ (heartbeat . promptInt3) >-> takeB_ 2 >-> printer+Enter an Integer:+Hello<Enter>+Could not read Integer+Enter an Integer+8+Received a value:+8+Enter an Integer+0+Received a value:+0++    It's very easy to prove that 'EitherP' has only a local effect.  In fact,+    we can run it entirely locally like so:++>>> runProxy $ (E.runEitherK $ heartbeat . promptInt3) >-> takeB_ 2 >-> printer++    Proxy transformers do not use the base monad at all, so you can use them to+    isolate effects from other proxies, as the next section demonstrates.+-}++{- $state+    The 'StateP' proxy lets you embed local state into any 'Proxy' computation.+    For example, we might want to gratuitously use state to generate successive+    numbers:++> import qualified Control.Proxy.Trans.State as S+>+> increment :: (Monad m, Proxy p) => () -> Producer (S.StateP Int p) Int m r+> increment () = forever $ do+>     n <- S.get+>     respond n+>     S.put (n + 1)++    We could then embed it locally into any 'Proxy', such as the following one:++> numbers :: (Monad m, Proxy p) => () -> Producer p Int m ()+> numbers () = runIdentityP $ do+>     (takeB_ 5 <-< S.evalStateK 10 increment) ()+>     S.evalStateK 1  (takeB_ 3 <-< increment) () -- This works, too!++>>> runProxy $ numbers >-> printD+10+11+12+13+14+1+2+3++    We can also prove the effect is local even when you directly compose two+    'StateP' proxies before running them.  Let's define a stateful consumer:++> increment2 :: (Proxy p) => () -> Consumer (S.StateP Int p) Int IO r+> increment2 () = forever $ do+>     nOurs   <- S.get+>     nTheirs <- request ()+>     lift $ print (nTheirs, nOurs)+>     S.put (nOurs + 2)++    .. and hook it up directly to @increment@:++>>> runProxy $ S.evalStateK 0 $ increment >-> takeB_ 3 >-> increment2+(0, 0)+(1, 2)+(2, 4)++    They each share the same initial state, but they isolate their own side+    effects completely from each other.+-}++{- $branch+    So far we've only considered linear chains of proxies, but @pipes@ allows+    you to branch these chains and generate more sophisticated topologies.  The+    trick is to simply nest the 'Proxy' monad transformer within itself.++    For example, if I want to zip two inputs, I can just define the following+    triply nested proxy:++> zipD+>  :: (Monad m, Proxy p1, Proxy p2, Proxy p3)+>  => () -> Consumer p1 a (Consumer p2 b (Consumer p3 (a, b) m)) r+> zipD = runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ forever $ do+>     -- Yes, this 'runIdentityP' mess is necessary.  Sorry!+>+>     a <- request ()               -- Request from the outer 'Consumer'+>     b <- lift $ request ()        -- Request from the inner 'Consumer'+>     lift $ lift $ respond (a, b)  -- Respond to the 'Producer'++    'zipD' behaves analogously to a curried function.  We partially apply it to+    each layer using composition and 'runProxyK' or 'runProxy':++> -- 1st application+> p1 = runProxyK $ zipD <-< fromListS [1..3]+>+> -- 2nd application+> p2 = runProxyK $ p1 <-< fromListS [4..]+>+> -- 3rd application+> p3 = runProxy $ printD <-< p2++>>> p3+(1, 4)+(2, 5)+(3, 6)++    You can use this trick to fork output, too:++> fork+>  :: (Monad m, Proxy p1, Proxy p2, Proxy p3)+>  => () -> Consumer p1 a (Producer p2 a (Producer p3 a m)) r+> fork () =+>     runIdentityP . hoist (runIdentityP . hoist runIdentityP) $ forever $ do+>         a <- request ()          -- Request output from the 'Consumer'+>         lift $ respond a         -- Send output to the outer 'Producer'+>         lift $ lift $ respond a  -- Send output to the inner 'Producer'++    Again, we just keep partially applying it until it is fully applied:++> -- 1st application+> p1 = runProxyK $ fork <-< fromListS [1..3]+>+> -- 2nd application+> p2 = runProxyK $ raiseK printD <-< mapD (> 2) <-< p1+>+> -- 3rd application+> p3 = runProxy  $ printD <-< mapD show <-< p2++>>> p3+False+"1"+False+"2"+True+"3"++    You can even merge or fork proxies that use entirely different feature sets:++> p1 = runProxyK $ S.evalStateK 0 $ fork <-< increment+>+> p2 = runProxyK $ raiseK printD <-< mapD (+ 10) <-< p1+>+> p3 = runProxy  $ E.runEitherK $ printD <-< (takeB_ 3 >=> E.throw) <-< p2++>>> p3+10+0+11+1+12+2+Left ()++    We just forked a @(StateP p1)@ proxy and read out the result in both a+    generic @p2@ proxy and an @(EitherP p3)@ proxy.  That's pretty crazy, but it+    gives you a sense of how versatile and robust proxies can be.++    You can implement arbitrary branching topologies using this trick.  However,+    I want to mention a few caveats:++    * The intermediate partially applied type signatures will be ugly as sin.+      I warned you.++    * You cannot implement cyclic topologies (and cyclic topologies do not make+      sense for proxies anyway)++    * You cannot use this trick to implement a polymorphic zip function of the+      following form:++> zip'  -- You can't define this+>  :: (Monad m, Proxy p)+>  => (() -> Producer p a      m r)+>  -> (() -> Producer p b      m r)+>  -> (() -> Producer p (a, b) m r)++    Partial application requires selecting a 'Proxy' instance, which is why you+    cannot define @zip'@.  You /can/ define a @zip'@ specialized to a concrete+    'Proxy' instance, but I don't really recommend doing that since you should+    always strive to write polymorphic proxies to avoid locking your user into+    a particular feature set.++    With those caveats out of the way, this approach affords many indispensable+    features that other approaches do not allow:++    * It does not require extending the 'Proxy' type class++    * It handles almost every branching scenario, including more complicated+      situations like concurrent interleavings++    * You can branch and merge mixtures of 'Server's, 'Client's, and 'Proxy's++    * You can branch and merge heterogeneous feature sets++    * It is completely polymorphic over the 'Proxy' class and uses no+      implementation-specific details+-}++{- $proxytrans+    There is one last scenario that you will eventually encounter: mixing+    proxies that have incompatible proxy transformer stacks.  You solve this the+    exact same way you mix different monad transformer stacks, except that+    instead of using 'lift' and 'hoist' you use 'liftP' and 'hoistP'.++    For example, we might want to mix @promptInt3@ and @increment2@:++> promptInt3 :: (Proxy p) => () -> Producer (E.EitherP String p) Int IO r+>+> increment2 :: (Proxy p) => () -> Consumer (S.StateP Int p) Int IO r++    Unfortunately, they use two different feature sets so neither one is fully+    polymorphic over the 'Proxy' class and we cannot directly compose them.++    Fortunately, all proxy transformers implement the 'ProxyTrans' class,+    analogous to the 'MonadTrans' class for transformers:++> class ProxyTrans t where+>     liftP+>       :: (Monad m, Proxy p)+>       => p a' a b' b m r -> t p a' a b' b m r+>+>  -- mapP is slightly more elegant+>     mapP+>      :: (Monad m, Proxy p)+>      => (q -> p a' a b' b m r) -> (q -> t p a' a b' b m r)+>     mapP = (liftP . )++    It's very easy to use.  Just use 'mapP' (equivalent to @(liftP .)@ to lift+    one proxy transformer to match another one.  For example, we can 'mapP'+    @increment2@ to match @promptInt3@:++> promptInt3 >-> mapP increment2+>  :: (Proxy p) => () -> Session (EitherP String (StateP Int p)) IO r++>>> runProxy $ S.evalStateK 0 $ E.runEitherK $ promptInt3 >-> mapP increment2+Enter an Integer:+4<Enter>+(4, 0)+Enter an Integer:+5<Enter>+(5, 2)+Enter an Integer:+Hello<Enter>+Left "Could not read Integer"++    ... or we could instead 'mapP' @promptInt3@ to match @increment2@ and switch+    the order of the two proxy transformers:++> mapP promptInt3 >-> increment2+>  :: (Proxy p) => () -> Session (StateP Int (EitherP String p)) IO r++>>> runProxy $ E.runEitherK $ S.evalStateK 0 $ mapP promptInt3 >-> increment2+Enter an Integer:+4<Enter>+(4, 0)+Enter an Integer:+5<Enter>+(5, 2)+Enter an Integer:+Hello<Enter>+Left "Could not read Integer"++    Like monad transformers, proxy transformers lift a base 'Monad' instance+    to an extended 'Monad' instance.  'liftP' exactly mirrors the 'lift'+    function from 'MonadTrans'.  'liftP' takes some base proxy, @p@, that+    implements 'Monad' and \"lift\"s it to an extended proxy, @(t p)@, that also+    implements 'Monad'.++    So for example, I could do something like:++> do liftP $ actionInBaseProxy+>    actionInExtendedProxy++    Monad transformers impose certain laws to ensure that this lifting is+    correct.  These are known as the monad transformer laws;++> (lift .) (f >=> g) = (lift .) f >=> (lift .) g+>+> (lift .) return = return++    If you convert these laws to @do@ notation, they just say:++> do  x <- lift m  =  lift $ do x <- m+>     lift (f x)                f x+>+> lift (return r) = return r++    Proxy transformers require the exact same laws to ensure that they lift the+    base monad to the extended monad correctly.  Just replace 'lift' with+    'liftP':++> (liftP .) (f >=> g) = (liftP .) f >=> (liftP .) g+>+> (liftP .) return = return++    The only difference is that I also include 'mapP' in the 'ProxyTrans' type+    class for convenience, which sweetens these laws a little bit:++> mapP = (lift .)+>+> mapP (f >=> g) = mapP f >=> mapP g  -- These are functor laws!+>+> mapP return = return++    However, proxy transformers do one extra thing above and beyond ordinary+    monad transformers.  Proxy transformers lift the 'Proxy' type class, meaning+    that if the base type implements 'Proxy', so does the extended type.++    This means that we need a set of laws that guarantee that the proxy+    transformer lifts the 'Proxy' instance correctly.  I call these laws the+    \"proxy transformer laws\":++> mapP (f >-> g) = mapP f >-> mapP g  -- These are functor laws, too!+>+> mapP idT = idT++    In other words, a proxy transformer defines a functor from the base+    composition to the extended composition!  Neat!++    But we're not even done, because proxies actually form three other+    categories, only one of which I have mentioned so far, and proxy+    transformers lift these three other categories, too:++> -- The push-based category+>+> mapP (f >~> g) = mapP f >~> mapP g+>+> mapP coidT = coidT++> -- The "request" category+>+> mapP (f \>\ g) = mapP f \>\ mapP g+>+> mapP request = request++> -- The "respond" category+>+> mapP (f />/ g) = mapP f />/ mapP g+>+> mapP respond = respond++    I never even mentioned those last two categories because they are more+    exotic and you probably never need to use them.  However, even if we never+    use those categories they still guarantee two really important laws that we+    should remember:++> mapP request = request+>+> mapP respond = respond++    We can translate those to 'liftP' to get:++> liftP $ request a' = request a'+>+> liftP $ respond b  = respond b++    In other words, 'request' and 'respond' in the extended proxy must behave+    exactly the same as lifting 'request' and 'respond' from the base proxy.++    All the proxy transformers in this library obey the proxy transformer laws,+    which ensure that 'liftP' / 'mapP' always do \"the right thing\".++    Proxy transformers also implement 'hoistP' from the 'PFunctor' class in+    "Control.PFunctor".  This exactly parallels 'hoist' for monad transformers.++    Just like monad transformers, we can mix two completely exotic proxy+    transformer stacks using a combination of 'liftP' and 'hoistP'.  Here's the+    proxy transformer equivalent of the previous example I gave:++> p1 :: (Proxy p) => a' -> StateP s (ReaderP i p) a' a a' a m r+> p2 :: (Proxy p) => a' -> MaybeP   (WriterP w p) a' a a' a m r++    As before, I can interleave their proxy transformers through judicious use+    of 'hoistP' and 'liftP'++> pSequence+>  :: (Proxy p) => StateP s (MaybeP (ReaderP i (WriterP w p))) a' a a' a r+> pSequence a' = do+>     hoistP (liftP . hoistP liftP) (p1 a')+>     liftP (hoistP liftP (p2 a'))++    ... but unlike ordinary monad transformers I could instead mix them by+    composition, too!++> pCompose+>  :: (Proxy p) => StateP s (MaybeP (ReaderP i (WriterP w p))) a' a a' a r+> pCompose =+>      hoistP (liftP . hoistP liftP) . p1+>  >-> liftP . hoistP liftP . p2+-}++{- $conclusion+    The @pipes@ library emphasizes the reuse of a small set of core abstractions+    grounded in theory to implement all functionality:++    * Monads++    * Proxies: ('>->'), 'request', and 'respond'++    * Monad Transformers and Functors on Monads: 'lift' and 'hoist'++    * Proxy Transformers and Functors on Proxies: 'liftP' and 'hoistP'++    However, I don't expect everybody to immediately understand how so few+    primitives can implement such a wide variety of features.  This tutorial+    gives a taste of how many interesting ways you can combine these few+    abstractions, but these examples barely scratch the surface, despite this+    tutorial's length.  So if you don't know how to implement something using+    @pipes@, just ask me and I will be happy to help. -}