MonadError + Hierarchical Error

monaderror.hs

import Control.Monad.Except
import Data.Generics.Product
import Data.Generics.Sum
import Data.Kind
import GHC.Generics

newtype Err1 = Err1 String
  deriving stock (Generic)

newtype Err2 = Err2 String
  deriving stock (Generic)

data Err = MkErr1 Err1 | MkErr2 Err2
  deriving stock (Generic)

throwError' ::
  forall e e1 (m :: Type -> Type) a.
  (AsType e1 e, MonadError e m) =>
  e1 ->
  m a
throwError' = throwError . injectTyped

foo :: (AsType Err1 err, MonadError err m) => m ()
foo = throwError' (Err1 "foo error")

foo2 :: (AsType Err2 err, MonadError err m) => m ()
foo2 = throwError' (Err2 "foo error")

main :: IO ()
main = do
  r <- runExceptT @Err $ do
    foo
    foo2
  case r of
    Right _ -> putStrLn "OK"
    Left _ -> putStrLn "KO"