module Language.Lambda.Shared.Errors
  ( LambdaException(..),
    isLambdaException,
    isLetError,
    isParseError,
    isImpossibleError
  ) where

import RIO

data LambdaException
  -- | An expression that cannot be parsed
  -- Examples:
  --
  --     \x y
  --     = y
  = ParseError Text

  -- | A let binding nested in another expression
  -- Examples:
  --
  --     \x. let y = z
  --     x (let y = z)
  | InvalidLet Text -- ^ A let binding nested in another expression

  -- | The expected type does not match the actual type
  -- Examples:
  --
  --     (\x: X. x) (y:Y)
  | TyMismatchError Text

  -- | A catch-all error that indicates a bug in this project
  | ImpossibleError
  deriving (LambdaException -> LambdaException -> Bool
(LambdaException -> LambdaException -> Bool)
-> (LambdaException -> LambdaException -> Bool)
-> Eq LambdaException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LambdaException -> LambdaException -> Bool
$c/= :: LambdaException -> LambdaException -> Bool
== :: LambdaException -> LambdaException -> Bool
$c== :: LambdaException -> LambdaException -> Bool
Eq, Typeable)

instance Exception LambdaException

instance Display LambdaException where
  textDisplay :: LambdaException -> Text
textDisplay (ParseError Text
txt) = Text
"Parse error " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt
  textDisplay (InvalidLet Text
txt) = Text
"Illegal nested let: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txt
  textDisplay LambdaException
ImpossibleError = Text
"An impossible error occurred! Please file a bug."

instance Show LambdaException where
  show :: LambdaException -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String)
-> (LambdaException -> Text) -> LambdaException -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LambdaException -> Text
forall a. Display a => a -> Text
textDisplay

-- | Returns true if the passed in value is a LamdbaExpression. Can be used, for example,
-- as a `shouldThrow` matcher
isLambdaException :: LambdaException -> Bool
isLambdaException :: LambdaException -> Bool
isLambdaException LambdaException
_ = Bool
True

isLetError :: LambdaException -> Bool
isLetError :: LambdaException -> Bool
isLetError (InvalidLet Text
_) = Bool
True
isLetError LambdaException
_ = Bool
False

isParseError :: LambdaException -> Bool
isParseError :: LambdaException -> Bool
isParseError (ParseError Text
_) = Bool
True
isParseError LambdaException
_ = Bool
False

isImpossibleError :: LambdaException -> Bool
isImpossibleError :: LambdaException -> Bool
isImpossibleError LambdaException
ImpossibleError = Bool
True
isImpossibleError LambdaException
_ = Bool
False