Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base: 43a3be81f7
...
compare: a44598b2b9
  • 5 commits
  • 3 files changed
  • 0 commit comments
  • 1 contributor
Commits on May 18, 2012
@Gabriel439 Used better variable names and made the "comult" half of the implemen…
…tation use

more polymorphic types to reflect the fact that the proof can be built up with
the comult part as an intermediate layer.
e360d28
Commits on May 19, 2012
@Gabriel439 Changed type names, moved newtype to Prompt, and fixed catch/finally …
…so they

work on Ensures and not just Frames.
8fa06ac
@Gabriel439 Updated documentation. d014c04
@Gabriel439 Updated documentation. d436a06
Commits on May 20, 2012
@Gabriel439 Did a lot of reworking of types to ensure that 'finallyP' and 'catchP…
…' work

both before and after the 'close'.
a44598b
Showing with 448 additions and 113 deletions.
  1. +100 −32 Control/Pipe.hs
  2. +6 −22 Control/Pipe/Common.hs
  3. +342 −59 Control/Pipe/Final.hs
View
132 Control/Pipe.hs
@@ -179,7 +179,7 @@ You shall not pass!
> printer <+< fromList [1..]
- The result is identical to:
+ The result is indistinguishable from:
> lift (mapM_ print [1..])
@@ -326,7 +326,7 @@ Nothing
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!
+ compositional (yet!).
To see why, let's say you somehow got @toList@ to work and the following
imaginary code sample worked:
@@ -376,13 +376,14 @@ Nothing
other iteratee libraries.
The @pipes@ library, unlike other iteratee libraries, grounds its vertical
- and horizontal concatenation in mathematics by deriving horizontal
+ 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
pipes 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'.
+ Here's another problem with 'Pipe' composition: resource finalization.
Composition has one important defect: resource finalization. Let's say we
have the file \"test.txt\" with the following contents:
@@ -400,55 +401,121 @@ Nothing
> yield s
> readFile' h
- We can use our 'Monad' and 'Category' instances to generate a lazy version
- that only reads as many lines as we request:
+ We could then try to be slick and use our 'Monad' and 'Category' instances
+ to generate a lazy version that only reads as many lines as we request:
-> read' n = do
-> lift $ putStrLn "Opening file ..."
-> h <- lift $ openFile "test.txt"
-> take' n <+< readFile' h
-> lift $ putStrLn "Closing file ..."
-> lift $ hClose h
+> read' = do
+> lift $ putStrLn "Opening file ..."
+> h <- lift $ openFile "test.txt"
+> readFile' h
+> lift $ putStrLn "Closing file ..."
+> lift $ hClose h
Now compose!
->>> runPipe $ printer <+< read' 2
-Opening file ...
-"This is a test."
-"Don't panic!"
-Closing file ...
-
->>> runPipe $ printer <+< read' 99
+>>> runPipe $ printer <+< read'
Opening file ...
"This is a test."
"Don't panic!"
"Calm down, please!"
Closing file ...
- In the first example, @take' n <+< readFile' h@ terminates because
- @take'@ only requested 2 lines. In the second example, it terminates
- because @readFile'@ ran out of input. However, in both cases the pipe never reads more lines than we request and frees \"test.txt\" immediately when it
- was no longer needed.
-
- Even more importantly, the @file@ is never opened if we replace @printer@
- with a pipe that never demands input:
+ 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' 2
+>>> runPipe $ (lift $ putStrLn "I don't need input") <+< read'
I don't need input
There is still one problem, though. What if we wrote:
->>> runPipe $ printer <+< take' 1 <+< read' 3
+>>> runPipe $ printer <+< take' 1 <+< read'
Opening file ...
"This is a test."
Oh no! Our pipe didn't properly close our file! @take' 1@ terminated
- before @read' 3@, preventing @read' 3@ from properly closing \"test.txt\".
+ before @read'@, preventing @read'@ from properly closing \"test.txt\".
+ 'Pipe' composition also fails to guarantee deterministic finalization.
+
+ So how could we implement finalization, then? The answer is to build a
+ higher-order type on top of 'Pipe' and define a new composition that permits
+ prompt, deterministic finalization.
+
+ To do this, we import 'Control.Pipe.Final', which exports the 'Frame' type,
+ analogous to the 'Pipe' type, except more powerful. To demonstrate it in
+ action, let's rewrite our @take'@ function to be a 'Frame' instead.
+
+> take' :: Int -> Frame a a IO ()
+> take' n
+> | n < 1 = Prompt $ close $ lift $ putStrLn "You shall not pass!"
+> | otherwise = Prompt $ do
+> replicateM_ (n - 1) $ do
+> x <- awaitF
+> yieldF x
+> x <- awaitF
+> close $ do
+> lift $ putStrLn "You shall not pass!"
+> yieldF x
+
+ The type signature looks the same, except 'Pipe' has been replaced with
+ 'Frame'. Also, now we have 'awaitF' instead of 'await' and 'yieldF' instead
+ of 'yield'. However, you'll notice two new things: 'Prompt' and 'close'.
+
+ 'Prompt' serves a newtype constructor to give clearer type errors and
+ abstract away the underlying implementation. The reason is that if you were
+ to expand out the full type that 'Prompt' wraps you would get:
+
+> Pipe (Maybe a) (m (), b) m (Producer (m (), b)) m r
+> -- Yuck!
+
+ However, you don't need to understand that type to use 'Frame's, so forget
+ about it. Really, the only reason the type is that complicated is because I
+ avoid using language extensions to implement 'Frame's, otherwise it would be
+ much simpler.
+
+ 'close' matters a lot, though. It signals when we no longer need input
+ from upstream. If you try to 'await' after the 'close', you will get a type
+ error.
+
+ 'close' tells composition when it is safe to finalize upstream frames. When
+ you 'close' a frame, composition finalizes every upstream frame immediately.
+ Composition actually removes the upstream frames completely when you 'close'
+ a frame, which is why it is a type error to 'await' past that point, since
+ composition wouldn't even know how to supply it with input.
+
+ However, I haven't really shown you how to register finalizers. That's
+ easy, since you just use 'catchP' or 'finallyP', which are identical to
+ their exception-handling counterparts, except they handle terminations.
+ Let's rewrite our @read'@ function using finalizers:
+
+> readFile' :: FilePath -> Frame () T.Text IO ()
+> readFile' file = Prompt $ do
+> h <- lift $ openFile file ReadMode
+> finallyP (putStrLn ("Closing " ++ file) >> hClose h) $ go h
+> where
+> go h = do
+> eof <- lift $ hIsEOF h
+> case eof of
+> True -> close $ return ()
+> False -> do
+> line <- lift $ T.hGetLine h
+> yieldF line
+> go h
+
+> readFile' :: Handle -> Ensure Text IO ()
+> readFile' h = do
+> eof <- lift $ hIsEOF h
+> when (not eof) $ do
+> s <- lift $ hGetLine h
+> yieldF s
+> readFile' h
+>
+> read' :: Frame Void Text IO ()
+> read' = Prompt $ do
+> lift $ putStrLn "Opening file ..."
+> h <- lift $ openFile "test.txt"
+> finallyP (putStrLn "Closing file ..." >> hClose h)
+> (readFile' h)
- So for now, you will have to manually ensure that resources get finalized
- deterministically and promptly. I am currently working on a solution that
- handles automatic, prompt, and deterministic finalization of resources while
- preserving compositionality, but until then you are on your own.
-}
module Control.Pipe (module Control.Pipe.Common) where
@@ -456,4 +523,5 @@ module Control.Pipe (module Control.Pipe.Common) where
import Control.Category
import Control.Monad.Trans.Class
import Control.Pipe.Common
+import Control.Pipe.Final
import Data.Void
View
28 Control/Pipe/Common.hs
@@ -24,7 +24,6 @@ module Control.Pipe.Common (
(>+>),
idP,
-- $category
-
-- * Run Pipes
-- $runpipe
runPipe
@@ -41,27 +40,16 @@ import Prelude hiding ((.), id)
{- $summary
I completely expose the 'Pipe' data type and internals in order to encourage
people to write their own 'Pipe' functions. This does not compromise the
- correctness or safety of the library whatsoever and you can feel free to
- use the constructors directly without violating any laws or invariants.
+ correctness or safety of the library at all and you can feel free to use the
+ constructors directly without violating any laws or invariants.
I promote using the 'Monad' and 'Category' instances to build and compose
pipes, but this does not mean that they are the only option. In fact, any
combinator provided by other iteratee libraries can be recreated for pipes,
- too. However, I don't copy the functions found in other libraries in order
- to encourage people to find principled and theoretically grounded solutions
- rather than devise ad-hoc solutions characteristic of other libraries.
-
- For example, you can't create a pipe like @toList@ that folds a pipe it is
- composed with, but nothing prevents you from writing a function that folds a
- pipe without using composition:
-
-> fold' :: (Monad m) => Producer a m r -> m [a]
-> fold' p = do
-> x <- runFreeT p
-> case x of
-> Pure _ -> return []
-> Wrap (Await f) -> fold' $ f ()
-> Wrap (Yield (a, p)) -> liftM (p:) (fold' p)
+ too. However, this core library does not provide many of the functions
+ found in other libraries in order to encourage people to find principled and
+ theoretically grounded solutions rather than devise ad-hoc solutions
+ characteristic of other iteratee implementations.
-}
{- $types
@@ -148,12 +136,8 @@ pipe f = forever $ await >>= yield . f
instance you have to wrap the 'Pipe' type using a newtype in order to
rearrange the type variables:
-}
-
newtype Lazy m r a b = Lazy { unLazy :: Pipe a b m r}
-{- If you assume id = forever $ await >>= yield, then this is the only Category
- instance possible. I couldn't find any other useful definition of id, but
- perhaps I'm not being creative enough. -}
instance (Monad m) => Category (Lazy m r) where
id = Lazy idP
Lazy p1 . Lazy p2 = Lazy $ p1 <+< p2
View
401 Control/Pipe/Final.hs
@@ -1,58 +1,298 @@
-module Control.Pipe.Final where
+module Control.Pipe.Final (
+ -- * Introduction
+ -- $intro
+ -- * Types
+ Prompt,
+ Ensure,
+ Frame(..),
+ Stack,
+ -- * Create Frames
+ -- $create
+ yieldF,
+ awaitF,
+ -- * Prompt Finalization
+ -- $prompt
+ close,
+ bindClosed,
+ reopen,
+ -- * Ensure Finalization
+ -- $ensure
+ catchP,
+ finallyP,
+ -- * Compose Frames
+ -- $compose
+ (<-<),
+ (>->),
+ idF,
+ FrameC(..),
+ -- * Run Frames
+ -- $run
+ runFrame
+ ) where
import Control.Applicative
+import Control.Category
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Free
import Control.Pipe.Common
import Data.Void
+import Prelude hiding ((.), id)
--- TODO: Turn all type synonyms into newtypes for clearer type errors
+{- $intro
+ A 'Frame' is a higher-order type built on top of 'Pipe'. It enables a
+ richer composition with the ability to finalize resources:
--- Pipe with a 'D'owngraded stage
-type PipeD a b m r = Pipe a b m (Producer b m r)
+ * Promptly: You can close resources when you no longer need input from them
--- 'S'afe pipe that finalizes resources promptly and deterministically
-type PipeS a b m r = Pipe (Maybe a) (m (), b) m r
+ * Deterministically: It ensures that every 'Frame' is finalized no matter
+ which frame terminates
--- Safe pipe with a downgrade stage
-type Frame a b m r = PipeD (Maybe a) (m (), b) m r
+ 'Frame's differ from 'Pipe's in that they do not form monads, but instead
+ form parametrized monads. Unfortunately, parametrized monads are not
+ mainstream in Haskell and require a ton of extensions along with a modified
+ Prelude in order to recover @do@ notation, so this first release of the
+ 'Frame' implementation essentially \"in-lines\" the parametrized monad by
+ splitting it into two monads. Future releases will split off a version that
+ takes advantage of parametrized monads for a much simpler underlying type
+ and a significantly cleaner implementation.
-(<~<) :: (Monad m) => PipeD b c m r -> PipeD a b m r -> PipeD a c m r
+ The section on \"Types\" is an in-depth explanation of the underlying type,
+ which is unfortunately complicated because of in-lining the parametrized
+ monad. I tried to strike a balance between using newtypes to improve type
+ errors and abstract over the internals and using type synonyms to avoid
+ newtype hell.
+
+ Ordinary users should start at the section \"Create Frames\", but if you
+ encounter weird type errors and want to understand them, then consult the
+ \"Types\" section.
+-}
+
+{-|
+ An illustrative type synonym that demonstrates how 'Prompt' finalization
+ works
+
+ This type simulates a parametrized monad by breaking it up into two monads
+ where the first monad returns the second one. The first monad permits any
+ pipe code and the second monad only permits pipe code that doesn't need
+ input.
+
+ This allows the finalization machinery to safely and promptly finalize
+ upstream before beginning the second block, so the earlier the code
+ transitions to the second monad (using the 'close' function), the more
+ promptly upstream gets finalized.
+
+ For example if @p = Pipe@, the first monad is an ordinary 'Pipe' and the
+ second monad is a 'Producer':
+
+> Prompt Pipe a b m r = Pipe a b m (Pipe () b m r)
+
+ The finalization machinery also finalizes downstream pipes when the
+ second monad terminates. I use this trick to ensure a strict ordering of
+ finalizers from upstream to downstream.
+
+ I don't actually use the 'Prompt' type synonym, since that requires
+ newtyping everything, but I will reference it in documentation to clarify
+ type signatures.
+-}
+type Prompt p a b m r = p a b m (p () b m r)
+
+{-|
+ A pipe type that 'Ensure's deterministic finalization
+
+ The finalization machinery uses the input and output ends in different ways
+ to finalize the pipe when another pipe terminates first.
+
+ If an upstream pipe terminates first, the current pipe will receive a
+ 'Nothing' once. This allows it to finalize itself and if it terminates then
+ its return value takes precedence over upstream's return value. However, if
+ it 'await's again, it defers to upstream's return value and never regains
+ control.
+
+ On the output end, the pipe must supply its most up-to-date finalizer
+ alongside every value it 'yield's downstream. This finalizer is guaranteed
+ to be called if downstream terminates first.
+
+ The combination of these two tricks allows a bidirectional guarantee of
+ deterministic finalization that satisfies the 'Category' laws.
+-}
+type Ensure a b m r = Pipe (Maybe a) (m (), b) m r
+
+{-|
+ A pipe type that combines 'Prompt' and 'Ensure' to enable both prompt and
+ deterministic finalization.
+
+ The name connotes a stack frame, since finalized pipes can be thought of as
+ forming the 'Category' of stack frames, where upstream finalization is
+ equivalent to finalizing the heap, and downstream finalization is equivalent
+ to throwing an exception up the stack.
+
+ The type is equivalent to:
+
+> type Frame a b m r = Prompt Ensure a b m r
+-}
+newtype Frame a b m r = Frame { unFrame ::
+ Pipe (Maybe a) (m (), b) m (Pipe (Maybe ()) (m (), b) m r) }
+
+instance (Monad m) => Functor (Frame a b m) where
+ fmap f (Frame p) = Frame $ fmap (fmap f) p
+
+-- | A 'Stack' is a 'Frame' that doesn't need input and doesn't generate output
+type Stack m r = Frame () Void m r
+
+{- $create
+ The first step to convert 'Pipe' code to 'Frame' code is to replace all
+ 'yield's with 'yieldF's and all 'await's with 'awaitF's.
+
+> contrived = do --> contrived = do
+> x1 <- await --> x1 <- awaitF
+> yield x1 --> yieldF x1
+> x2 <- await --> x2 <- awaitF
+> yield x2 --> yieldF x2
+-}
+
+-- | Like 'yield', but also yields an empty finalizer alongside the value
+yieldF :: (Monad m) => b -> Ensure a b m ()
+yieldF x = yield (unit, x)
+
+-- | Like 'await', but ignores all 'Nothing's and just awaits again
+awaitF :: (Monad m) => Ensure a b m a
+awaitF = await >>= maybe awaitF return
+
+{- $prompt
+ The second step to convert 'Pipe' code to 'Frame' code is to mark the point
+ where your 'Pipe' no longer 'await's by wrapping it in the 'close' function
+ and then wrapping the 'Pipe' in a 'Frame' newtype:
+
+> contrived :: (Monad m) => Frame a a m ()
+> contrived = Frame $ do
+> x1 <- awaitF
+> yieldF x1
+> x2 <- awaitF
+> close $ yieldF x2
+
+ If a non-terminating pipe demands input indefinitely, there is no need to
+ 'close' it. It will type-check if the return value is polymorphic as a
+ result of non-termination.
+-}
+
+{-|
+ Use this to mark when a 'Frame' no longer requires input. The earlier the
+ better!
+-}
+close :: (Monad m) => Ensure () b m r -> Ensure a b m (Ensure () b m r)
+close = pure
+
+{-|
+ Use this to bind to the 'close'd half of the frame if you want to continue
+ where it left off but you still don't require input.
+
+ This function would not be necessary if 'Prompt' were implemented as a
+ parametrized monad, so if it seems ugly, that's because it is.
+-}
+bindClosed :: (Monad m) =>
+ Frame a b m r1 -> (r1 -> Ensure () b m r2) -> Frame a b m r2
+bindClosed (Frame p) f = Frame $ fmap (>>= f) p
+
+{-|
+ Use this to 'reopen' a 'Frame' if you change your mind and decide you want
+ to continue to 'await' input after all.
+
+ This postpones finalization of upstream until you 'close' the input end
+ again.
+-}
+reopen :: (Monad m) => Frame a b m r -> Ensure a b m r
+reopen (Frame p) = join $ fmap (<+< (forever $ yield $ Just ())) p
+
+{- $ensure
+ The third (optional) step to convert 'Pipe' code to 'Frame' code is to use
+ 'catchP' or 'finallyP' to register finalizers for blocks of code.
+
+> contrived :: Frame a a IO ()
+> contrived = Frame $ do
+> catchP (putStrLn "Stage 1 interrupted") $ do
+> x1 <- awaitF
+> catchP (putStrLn "Stage 1(b) interrupted") $ yieldF x1
+> catchP (putStrLn "Stage 2 interrupted") $ do
+> x2 <- awaitF
+> close $ yieldF x2
+-}
+
+{-|
+ @catchP m p@ registers @m@ to be called only if another composed
+ pipe terminates before @p@ is done.
+-}
+catchP :: (Monad m) => m () -> Ensure a b m r -> Ensure a b m r
+catchP m p = FreeT $ do
+ x <- runFreeT p
+ runFreeT $ case x of
+ Pure r -> pure r
+ Wrap (Yield ((m', b), p')) -> wrap $ Yield ((m' >> m, b), catchP m p')
+ Wrap (Await f) -> wrap $ Await $ \e -> case e of
+ Nothing -> lift m >> catchP m (f e)
+ Just _ -> catchP m (f e)
+{- catchP is equivalent to:
+
+awaitF' m = await >>= maybe (lift m >> awaitF' m) return
+
+yieldF' m x = yield (m, x)
+
+catchP m p = reopen $
+ (forever $ awaitF >>= yieldF' m)
+ <-< Frame (fmap close p)
+ <-< (forever $ awaitF' m >>= yieldF) -}
+
+{-|
+ 'finallyP' is like 'catchP' except that it also calls the finalizer if @p@
+ completes normally.
+-}
+finallyP :: (Monad m) => m () -> Ensure a b m r -> Ensure a b m r
+finallyP m p = do
+ r <- catchP m p
+ lift m
+ return r
+
+(<~<) :: (Monad m)
+ => Pipe b c m (Pipe x c m r)
+ -> Pipe a b m (Pipe x b m r)
+ -> Pipe a c m (Pipe x c m r)
p1 <~< p2 = FreeT $ do
x1 <- runFreeT p1
runFreeT $ case x1 of
- Pure p1' -> pure p1'
+ Pure p1' -> pure p1'
Wrap (Yield y) -> wrap $ Yield $ fmap (<~< p2) y
- Wrap (Await f) -> FreeT $ do
+ Wrap (Await f1) -> FreeT $ do
let p1 = FreeT $ return x1
x2 <- runFreeT p2
runFreeT $ case x2 of
- Pure p2' -> pure $ p1 <~| p2'
- Wrap (Yield (b, p2')) -> f b <~< p2'
- Wrap (Await a) -> wrap $ Await $ fmap (p1 <~<) a
+ Pure p2' -> pure $ p1 <~| p2'
+ Wrap (Yield (b2, p2')) -> f1 b2 <~< p2'
+ Wrap (Await f2 ) -> wrap $ Await $ fmap (p1 <~<) f2
-(<~|) :: (Monad m) => PipeD b c m r -> Producer b m r -> Producer c m r
+(<~|) :: (Monad m)
+ => Pipe b c m (Pipe x c m r)
+ -> Pipe x b m r
+ -> Pipe x c m r
p1 <~| p2 = FreeT $ do
x1 <- runFreeT p1
runFreeT $ case x1 of
- Pure p' -> p'
+ Pure p1' -> p1'
Wrap (Yield y) -> wrap $ Yield $ fmap (<~| p2) y
Wrap (Await f) -> FreeT $ do
let p1 = FreeT $ return x1
x2 <- runFreeT p2
runFreeT $ case x2 of
- Pure r -> pure r
- Wrap (Yield (b, p2')) -> f b <~| p2'
- Wrap (Await a) -> wrap $ Await $ fmap (p1 <~|) a
+ Pure r -> pure r
+ Wrap (Yield (b2, p2')) -> f b2 <~| p2'
+ Wrap (Await f2 ) -> wrap $ Await $ fmap (p1 <~|) f2
unit :: (Monad m) => m ()
unit = return ()
mult :: (Monad m)
=> m ()
- -> PipeD (Maybe b ) (m (), c) m r
- -> PipeD (Maybe (m (), b)) (m (), c) m r
+ -> Pipe (Maybe b ) (m (), c) m (Pipe x (m (), c) m r)
+ -> Pipe (Maybe (m (), b)) (m (), c) m (Pipe x (m (), c) m r)
mult m p = FreeT $ do
x <- runFreeT p
runFreeT $ case x of
@@ -63,28 +303,28 @@ mult m p = FreeT $ do
Just (m', b) -> mult m' (f $ Just b )
comult :: (Monad m)
- => PipeD (Maybe a) (m (), b) m r
- -> PipeD (Maybe a) (Maybe (m (), b)) m r
+ => Pipe (Maybe a) b m (Pipe x b m r)
+ -> Pipe (Maybe a) (Maybe b) m (Pipe x (Maybe b) m r)
comult p = FreeT $ do
x <- runFreeT p
runFreeT $ case x of
Pure p' -> pure $ warn p'
- Wrap (Yield (b', p')) -> wrap $ Yield (Just b', comult p')
+ Wrap (Yield (b, p')) -> wrap $ Yield (Just b, comult p')
Wrap (Await f) -> wrap $ Await $ \e -> case e of
Nothing -> schedule $ comult (f e)
Just _ -> comult (f e)
-warn :: (Monad m) =>
- Producer (m (), b) m r
- -> Producer (Maybe (m (), b)) m r
+warn :: (Monad m)
+ => Pipe x b m r
+ -> Pipe x (Maybe b) m r
warn p = do
r <- pipe Just <+< p
yield Nothing
return r
schedule :: (Monad m)
- => PipeD (Maybe a) (Maybe (m (), b)) m r
- -> PipeD (Maybe a) (Maybe (m (), b)) m r
+ => Pipe (Maybe a) (Maybe b) m (Pipe x (Maybe b) m r)
+ -> Pipe (Maybe a) (Maybe b) m (Pipe x (Maybe b) m r)
schedule p = FreeT $ do
x <- runFreeT p
runFreeT $ case x of
@@ -92,51 +332,94 @@ schedule p = FreeT $ do
Wrap (Await f) -> wrap $ Yield (Nothing, wrap $ Await f)
Wrap (Yield y) -> wrap $ Yield $ fmap schedule y
-awaitF' :: (Monad m) => m () -> Pipe (Maybe a) b m a
-awaitF' m = await >>= maybe (lift m >> awaitF) return
+{- $compose
+ The fourth step to convert 'Pipe' code to 'Frame' code is to use ('<-<') to
+ compose 'Frame's instead of ('<+<').
-yieldF' :: (Monad m) => m () -> b -> Pipe a (m (), b) m ()
-yieldF' m x = yield (m, x)
+> printer :: Frame a Void IO r
+> fromList :: (Monad m) => [a] -> Frame () a m ()
+>
+> p :: Frame () Void IO ()
+> p = printer <-< contrived <-< fromList [1..]
--- catchU unit = id
-catchU :: (Monad m) => m () -> Frame a b m r -> Frame a b m r
-catchU m p = (forever $ awaitF >>= yieldF' m) <-< p
+ Similarly, 'idF' replaces 'idP'.
--- catchD counit = id
-catchD :: (Monad m) => m () -> Frame a b m r -> Frame a b m r
-catchD m p = p <-< (forever $ awaitF' m >>= yieldF)
+ When a 'Frame' terminates, the 'FrameC' category strictly orders the
+ finalizers from upstream to downstream. Specifically
--- The API intended for library users
+ * When any 'Frame' 'close's its input end, it finalizes all frames upstream
+ of it. These finalizers are ordered from upstream to downstream.
+ * A 'Frame' is responsible for finalizing its own resources under ordinary
+ operation (either manually, or using 'finallyP').
+
+ * When a 'Frame' terminates, everything downstream of it is finalized.
+ These finalizers are ordered from upstream to downstream.
+
+ The 'Category' instance for 'FrameC' provides the same strong guarantees as
+ the 'Lazy' category. This confers many practical advantages:
+
+ * Registered finalizers are guaranteed to be called exactly once.
+ Finalizers are never duplicated or dropped in corner cases.
+
+ * The grouping of composition will never affect the ordering or behavior of
+ finalizers.
+
+ * Finalization does not grow more complex the more 'Frame's you add in your
+ 'Stack'.
+
+ * You can reason about the finalization behavior of each 'Frame'
+ independently of other 'Frame's it is composed with.
+-}
+
+-- | Corresponds to 'id' from @Control.Category@
idF :: (Monad m) => Frame a a m r
-idF = forever $ awaitF >>= yieldF
+idF = Frame $ forever $ awaitF >>= yieldF
+-- | Corresponds to ('<<<')/('.') from @Control.Category@
(<-<) :: (Monad m) => Frame b c m r -> Frame a b m r -> Frame a c m r
-p1 <-< p2 = mult unit p1 <~< comult p2
+(Frame p1) <-< (Frame p2) = Frame $ mult unit p1 <~< comult p2
-yieldF :: (Monad m) => b -> Pipe a (m (), b) m ()
-yieldF x = yield (unit, x)
+-- | Corresponds to ('>>>') from @Control.Category@
+(>->) :: (Monad m) => Frame a b m r -> Frame b c m r -> Frame a c m r
+(>->) = flip (<-<)
-awaitF :: (Monad m) => Pipe (Maybe a) b m a
-awaitF = await >>= maybe awaitF return
+newtype FrameC m r a b = FrameC { unFrameC :: Frame a b m r }
-produce :: (Monad m) => Producer (m (), b) m r -> Frame a b m r
-produce = pure
+instance (Monad m) => Category (FrameC m r) where
+ (FrameC p1) . (FrameC p2) = FrameC $ p1 <-< p2
+ id = FrameC idF
-upgrade :: (Monad m) => Frame a b m r -> PipeS a b m r
-upgrade p = join $ fmap (<+< (forever $ yield ())) p
+{- $run
+ The final step to convert 'Pipe' code to 'Frame' code is to replace
+ 'runPipe' with 'runFrame'.
-catchP :: (Monad m) => m () -> Frame a b m r -> Frame a b m r
-catchP m = catchU m . catchD m
+> printer :: Frame a Void IO r
+> take :: (Monad m) => Int -> Frame a a m ()
+> fromList :: (Monad m) => [a] -> Frame () a m ()
-finallyP :: (Monad m) => m () -> Frame a b m r -> Frame a b m r
-finallyP m p = do
- r <- catchP m p
- lift m
- return r
+>>> runFrame $ printer <-< contrived <-< fromList [1..]
+1
+2
+
+>>> runFrame $ printer <-< contrived <-< fromList [1]
+1
+Stage 2 interrupted
+
+>>> runFrame $ printer <-< take 1 <-< contrived <-< fromList [1..]
+Stage 1(b) interrupted
+Stage 1 interrupted
+1
+
+For the last example, remember that 'take' is written to 'close' its input end
+before yielding its final value, which is why the finalizers run before
+@printer@ receives the 1.
+
+-}
-runFrame :: (Monad m) => Frame () Void m r -> m r
-runFrame p = go (upgrade p) where
+-- | Convert a 'Frame' back to the base monad.
+runFrame :: (Monad m) => Stack m r -> m r
+runFrame p = go (reopen p) where
go p = do
x <- runFreeT p
case x of

No commit comments for this range

Something went wrong with that request. Please try again.