[Haskell-cafe] addCatch in conduit

[Michael Snoyman]

On Wed, Nov 5, 2014 at 6:44 PM, Yitzchak Gale <gale at sefer.org> wrote:

> 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-example

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/dbb49aa2a69e00a8817ec98ffc99f0523a84d0eb/conduit/Data/Conduit/Internal/Conduit.hs#L159

The catchC function is similar, but uses MonadBaseControl instead of
MonadCatch:

https://github.com/snoyberg/conduit/blob/dbb49aa2a69e00a8817ec98ffc99f0523a84d0eb/conduit/Data/Conduit/Internal/Conduit.hs#L427

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"
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20141106/4625d970/attachment.html>