Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
-- | Conduit piping with error handling.
module Data.Conduit.Error where
import Data.Conduit.Internal
infixr 2 .|?
(.|?) :: Monad m => ConduitT a b m (Either e ()) -> ConduitT b c m (Either e r) -> ConduitT a c m (Either e r)
ConduitT left0 .|? ConduitT right0 =
ConduitT $ \rest ->
let goRight left right =
case right of
HaveOutput p o -> HaveOutput (recurse p) o
NeedInput rp rc -> goLeft rp rc left
Done r2 -> rest r2
PipeM mp -> PipeM (fmap recurse mp)
Leftover right' i -> goRight (HaveOutput left i) right'
recurse = goRight left
goLeft rp rc left =
case left of
HaveOutput left' o -> goRight left' (rp o)
NeedInput left' lc -> NeedInput (recurse . left') (recurse . lc)
Done r1 ->
-- Extra step add-on to normal conduit.
case r1 of
Left e -> rest (Left e)
Right r1' -> goRight (Done (pure r1')) (rc r1')
PipeM mp -> PipeM (fmap recurse mp)
Leftover left' i -> Leftover (recurse left') i
recurse = goLeft rp rc
in goRight (left0 Done) (right0 Done)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.