module Data.Gibberish.Errors
  ( GibberishErr (..),
    isTrigraphNotFound,
    isImpossibleError,
  ) where

import Control.Exception (Exception ())
import Data.Typeable (Typeable ())

-- | Exceptions that can occur at runtime
data GibberishErr
  = TrigraphNotFound FilePath
  | ImpossibleError
  deriving stock (GibberishErr -> GibberishErr -> Bool
(GibberishErr -> GibberishErr -> Bool)
-> (GibberishErr -> GibberishErr -> Bool) -> Eq GibberishErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GibberishErr -> GibberishErr -> Bool
== :: GibberishErr -> GibberishErr -> Bool
$c/= :: GibberishErr -> GibberishErr -> Bool
/= :: GibberishErr -> GibberishErr -> Bool
Eq, Typeable)

instance Exception GibberishErr

instance Show GibberishErr where
  show :: GibberishErr -> FilePath
show (TrigraphNotFound FilePath
path) = FilePath
"Trigraph file " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> FilePath
show FilePath
path FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" does not exist!"
  show GibberishErr
ImpossibleError = FilePath
"The impossible happened! Please file a bug report."

isTrigraphNotFound :: GibberishErr -> Bool
isTrigraphNotFound :: GibberishErr -> Bool
isTrigraphNotFound (TrigraphNotFound FilePath
_) = Bool
True
isTrigraphNotFound GibberishErr
_ = Bool
False

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