{-# LANGUAGE FlexibleContexts #-}

-- | Futhark error definitions.
module Futhark.Error
  ( CompilerError (..),
    ErrorClass (..),
    externalError,
    externalErrorS,
    InternalError (..),
    compilerBug,
    compilerBugS,
    compilerLimitation,
    compilerLimitationS,
    internalErrorS,
  )
where

import Control.Exception
import Control.Monad.Error.Class
import qualified Data.Text as T
import Futhark.Util.Pretty

-- | There are two classes of internal errors: actual bugs, and
-- implementation limitations.  The latter are already known and need
-- not be reported.
data ErrorClass
  = CompilerBug
  | CompilerLimitation
  deriving (ErrorClass -> ErrorClass -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorClass -> ErrorClass -> Bool
$c/= :: ErrorClass -> ErrorClass -> Bool
== :: ErrorClass -> ErrorClass -> Bool
$c== :: ErrorClass -> ErrorClass -> Bool
Eq, Eq ErrorClass
ErrorClass -> ErrorClass -> Bool
ErrorClass -> ErrorClass -> Ordering
ErrorClass -> ErrorClass -> ErrorClass
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorClass -> ErrorClass -> ErrorClass
$cmin :: ErrorClass -> ErrorClass -> ErrorClass
max :: ErrorClass -> ErrorClass -> ErrorClass
$cmax :: ErrorClass -> ErrorClass -> ErrorClass
>= :: ErrorClass -> ErrorClass -> Bool
$c>= :: ErrorClass -> ErrorClass -> Bool
> :: ErrorClass -> ErrorClass -> Bool
$c> :: ErrorClass -> ErrorClass -> Bool
<= :: ErrorClass -> ErrorClass -> Bool
$c<= :: ErrorClass -> ErrorClass -> Bool
< :: ErrorClass -> ErrorClass -> Bool
$c< :: ErrorClass -> ErrorClass -> Bool
compare :: ErrorClass -> ErrorClass -> Ordering
$ccompare :: ErrorClass -> ErrorClass -> Ordering
Ord, Int -> ErrorClass -> ShowS
[ErrorClass] -> ShowS
ErrorClass -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorClass] -> ShowS
$cshowList :: [ErrorClass] -> ShowS
show :: ErrorClass -> String
$cshow :: ErrorClass -> String
showsPrec :: Int -> ErrorClass -> ShowS
$cshowsPrec :: Int -> ErrorClass -> ShowS
Show)

-- | A compiler error.
data CompilerError
  = -- | An error that happened due to something the user did, such as
    -- provide incorrect code or options.
    ExternalError Doc
  | -- | An internal compiler error.  The second text is extra data
    -- for debugging, which can be written to a file.
    InternalError T.Text T.Text ErrorClass

instance Show CompilerError where
  show :: CompilerError -> String
show (ExternalError Doc
s) = forall a. Pretty a => a -> String
pretty Doc
s
  show (InternalError Text
s Text
_ ErrorClass
_) = Text -> String
T.unpack Text
s

-- | Raise an 'ExternalError' based on a prettyprinting result.
externalError :: MonadError CompilerError m => Doc -> m a
externalError :: forall (m :: * -> *) a. MonadError CompilerError m => Doc -> m a
externalError = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> CompilerError
ExternalError

-- | Raise an 'ExternalError' based on a string.
externalErrorS :: MonadError CompilerError m => String -> m a
externalErrorS :: forall (m :: * -> *) a. MonadError CompilerError m => String -> m a
externalErrorS = forall (m :: * -> *) a. MonadError CompilerError m => Doc -> m a
externalError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text

-- | Raise an v'InternalError' based on a prettyprinting result.
internalErrorS :: MonadError CompilerError m => String -> Doc -> m a
internalErrorS :: forall (m :: * -> *) a.
MonadError CompilerError m =>
String -> Doc -> m a
internalErrorS String
s Doc
d =
  forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> Text -> ErrorClass -> CompilerError
InternalError (String -> Text
T.pack String
s) (forall a. Pretty a => a -> Text
prettyText Doc
d) ErrorClass
CompilerBug

-- | An error that is not the users fault, but a bug (or limitation)
-- in the compiler.  Compiler passes should only ever report this
-- error - any problems after the type checker are *our* fault, not
-- the users.  These are generally thrown as IO exceptions, and caught
-- at the top level.
data InternalError = Error ErrorClass T.Text
  deriving (Int -> InternalError -> ShowS
[InternalError] -> ShowS
InternalError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalError] -> ShowS
$cshowList :: [InternalError] -> ShowS
show :: InternalError -> String
$cshow :: InternalError -> String
showsPrec :: Int -> InternalError -> ShowS
$cshowsPrec :: Int -> InternalError -> ShowS
Show)

instance Exception InternalError

-- | Throw an t'InternalError' that is a 'CompilerBug'.
compilerBug :: T.Text -> a
compilerBug :: forall a. Text -> a
compilerBug = forall a e. Exception e => e -> a
throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorClass -> Text -> InternalError
Error ErrorClass
CompilerBug

-- | Throw an t'InternalError' that is a 'CompilerLimitation'.
compilerLimitation :: T.Text -> a
compilerLimitation :: forall a. Text -> a
compilerLimitation = forall a e. Exception e => e -> a
throw forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorClass -> Text -> InternalError
Error ErrorClass
CompilerLimitation

-- | Like 'compilerBug', but with a 'String'.
compilerBugS :: String -> a
compilerBugS :: forall a. String -> a
compilerBugS = forall a. Text -> a
compilerBug forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

-- | Like 'compilerLimitation', but with a 'String'.
compilerLimitationS :: String -> a
compilerLimitationS :: forall a. String -> a
compilerLimitationS = forall a. Text -> a
compilerLimitation forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack