src/Symantic/Parser/Error.hs

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