symantic-grammar/Language/Symantic/Grammar/Error.hs

   1 {-# LANGUAGE TypeApplications #-}
   2 module Language.Symantic.Grammar.Error where
   3
   4 import Data.Either (Either(..))
   5 import Data.Function (($), (.))
   6 import Data.Proxy (Proxy)
   7
   8 -- * Class 'ErrorInj'
   9 class ErrorInj a b where
  10         errorInj :: a -> b
  11 instance ErrorInj err e => ErrorInj err (Either e a) where
  12         errorInj = Left . errorInj
  13
  14 liftError ::
  15  forall e0 err e1 a.
  16  ErrorInj e0 e1 =>
  17  ErrorInj e1 err =>
  18  Proxy e1 -> Either e0 a -> Either err a
  19 liftError _e1 (Right a) = Right a
  20 liftError _e1 (Left e)  = Left $ errorInj @e1 @err $ errorInj @e0 @e1 e