Composing the erros of different stages.

gistfile1.hs

{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}

module Main where

import           System.IO
import           Control.Applicative
import           Control.Monad
import           Control.Monad.Trans
import           Control.Monad.Error
import qualified Control.Arrow as A
import qualified Control.Monad.State as S
import           Data.Char
import           Data.Maybe
import           Pipes
import           Pipes.Core
import           Pipes.Lift
import qualified Pipes.Prelude as P

source :: MonadError String m => Producer Int m ()
source = each [1,2,3]

destination :: (MonadIO m, MonadError String m) => Consumer Int m ()
destination = do
    a <- await
    liftIO $ putStrLn $ show a
    throwError "boooooo"

data FooErr = Err1 String | Err2 String

instance Error FooErr where
    noMsg = Err1 ""

zoomError :: Monad m => (a -> s) -> ErrorT a m x -> ErrorT s m x
zoomError f = mapErrorT . liftM . A.left $ f

main :: IO ()
main = do
    result <- runErrorT . runEffect $ hoist (zoomError Err1) source >->
                                      hoist (zoomError Err2) destination
    case result of
        Right _ -> return ()
        Left err -> case err of
            Err1 err1 -> putStrLn err1
            Err2 err2 -> putStrLn err2