addCatch in conduit

In getting the dtd library to compile with recent versions of conduit (yes, I know that it's deprecated and Michael longer supports it, but we still need it), we came across the following bit of code: -- (snip) -- CI.ConduitM $ addCatch $ CI.unConduitM src0 where -- (snip) -- addCatch :: (MonadThrow m, MonadBaseControl IO m) => CI.Pipe l i o u m r -> CI.Pipe l i o u m r addCatch (CI.HaveOutput src close x) = CI.HaveOutput (addCatch src) (addCatch' close) x addCatch (CI.NeedInput p c) = CI.NeedInput (addCatch . p) (addCatch . c) addCatch (CI.Done r) = CI.Done r addCatch (CI.PipeM msrc) = CI.PipeM (addCatch' $ liftM addCatch msrc) addCatch (CI.Leftover p i) = CI.Leftover (addCatch p) i addCatch' m = m `Lifted.catch` throw rr We adapted it to the new ConduitM type simply by changing the first line to: CI.ConduitM $ addCatch . CI.unConduitM src0 Not bad, a diff of exactly one character. It compiles and seems to work. Does this sound reasonable? Obviously, we would love to get rid of this use of conduit internals. addCatch seems like a general operation, not specific to this library. Is there a way to do this in modern conduit without dipping into internals? If not - can we propose to add it? Thanks, Yitz

On Wed, Nov 5, 2014 at 6:44 PM, Yitzchak Gale
In getting the dtd library to compile with recent versions of conduit (yes, I know that it's deprecated and Michael longer supports it, but we still need it), we came across the following bit of code:
-- (snip) -- CI.ConduitM $ addCatch $ CI.unConduitM src0 where -- (snip) -- addCatch :: (MonadThrow m, MonadBaseControl IO m) => CI.Pipe l i o u m r -> CI.Pipe l i o u m r addCatch (CI.HaveOutput src close x) = CI.HaveOutput (addCatch src) (addCatch' close) x addCatch (CI.NeedInput p c) = CI.NeedInput (addCatch . p) (addCatch . c) addCatch (CI.Done r) = CI.Done r addCatch (CI.PipeM msrc) = CI.PipeM (addCatch' $ liftM addCatch msrc) addCatch (CI.Leftover p i) = CI.Leftover (addCatch p) i
addCatch' m = m `Lifted.catch` throw rr
We adapted it to the new ConduitM type simply by changing the first line to:
CI.ConduitM $ addCatch . CI.unConduitM src0
Not bad, a diff of exactly one character. It compiles and seems to work. Does this sound reasonable?
Obviously, we would love to get rid of this use of conduit internals. addCatch seems like a general operation, not specific to this library. Is there a way to do this in modern conduit without dipping into internals? If not - can we propose to add it?
Thanks, Yitz
That won't work due to how the CPS/codensity transform works. You'll end up applying the exception catcher to the *entire* pipeline, not just the part that's currently delimited. To give a more easily understood example, it's best to look at difference lists (which I think are always a good way to understand CPS better). I've put together an example here: https://www.fpcomplete.com/user/snoyberg/random-code-snippets/cps-transform-... badMap ends up lower casing the entire list. If you stare at it long enough, the reason becomes obvious: we're keeping our current portion of the list as a function, applying that function to the rest of the list, and *then* applying our map. Instead, goodMap needs to apply the current portion of the list to the empty list to get a concrete list that can be traversed, traverse it, and then convert it back to a difference list. However, this is a little bit inefficient, since we'll first traverse the list once to apply the mapped function, and then traverse it a second time to go back to the CPS version. Instead, we can combine the two into a single step, leading to more efficient (but less readable) code in efficientMap. All that said: the functionality you need there is now provided by conduit out of the box via its `MonadCatch` (from the exceptions package) instance. It may be useful to look at its implementation: https://github.com/snoyberg/conduit/blob/dbb49aa2a69e00a8817ec98ffc99f0523a8... The catchC function is similar, but uses MonadBaseControl instead of MonadCatch: https://github.com/snoyberg/conduit/blob/dbb49aa2a69e00a8817ec98ffc99f0523a8... Full code of my snippet for the lazy: import Data.Char (toLower) import Data.Monoid newtype DList a = DList { unDList :: [a] -> [a] } instance Monoid (DList a) where mempty = DList id mappend (DList x) (DList y) = DList (x . y) fromList :: [a] -> DList a fromList xs = DList (xs ++) toList :: DList a -> [a] toList (DList x) = x [] badMap :: (a -> a) -> DList a -> DList a badMap f d = DList $ map f . unDList d goodMap :: (a -> b) -> DList a -> DList b goodMap f = fromList . map f . toList efficientMap :: (a -> b) -> DList a -> DList b efficientMap f = DList . go . toList where go [] = id go (x:xs) = (f x:) . go xs main :: IO () main = do putStrLn $ toList $ badMap toLower (fromList "HELLO") <> fromList "WORLD" putStrLn $ toList $ goodMap toLower (fromList "HELLO") <> fromList "WORLD" putStrLn $ toList $ efficientMap toLower (fromList "HELLO") <> fromList "WORLD"
participants (2)
-
Michael Snoyman
-
Yitzchak Gale