Simple example of "composing" MonadErrors

MonadErrorComposed.hs

data SmallError = Error1 | Error2 | Error3 deriving (Show, Eq)
data MediumError = Error4 | Error5 | Error6 deriving (Show, Eq)

class HasSmallError e where
    fromSmallError :: SmallError -> e
    toSmallError   :: e -> Maybe SmallError

class HasMediumError e where
    fromMediumError :: MediumError -> e
    toMediumError   :: e -> Maybe MediumError

data BigError = SmallError SmallError | MediumError MediumError
    deriving (Show, Eq)

instance Exception BigError

instance HasSmallError BigError where
    fromSmallError e = SmallError e

    toSmallError (SmallError e) = Just e
    toSmallError _              = Nothing

instance HasMediumError BigError where
    fromMediumError e = MediumError e

    toMediumError (MediumError e) = Just e
    toMediumError _               = Nothing

newtype MyMonad a = MyMonad { unMyMonad :: ReaderT Config IO a }
    deriving (Functor, Applicative, Monad, MonadIO, MonadReader Config)

runMyMonad :: MyMonad a -> Config -> IO a
runMyMonad m config = runReaderT (unMyMonad m) config

instance MonadError BigError MyMonad where
    throwError = liftIO . throwIO
    catchError m f = do
        config <- ask
        liftIO $ catch (runMyMonad m config) (flip runMyMonad config . f)

throwSmallAndMedium :: ( MonadError e m
                       , HasSmallError e
                       , HasMediumError e
                       )
                    => m ()
throwSmallAndMedium = do
    throwError $ fromSmallError Error1
    throwError $ fromMediumError Error4

catchSmallAndMedium :: ( MonadIO m
                       , MonadError e m
                       , HasSmallError e
                       , HasMediumError e
                       )
                    => m ()
catchSmallAndMedium = catchError throwSmallAndMedium \e -> liftIO $ case () of
    _ | Just e <- toSmallError e  -> print e
      | Just e <- toMediumError e -> print e
      | otherwise                 -> undefined