Data.Conduit.Error

Data.Conduit.Error.hs

-- | 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'
          where
            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
          where
            recurse = goLeft rp rc
     in goRight (left0 Done) (right0 Done)