{-# 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
(ErrorClass -> ErrorClass -> Bool)
-> (ErrorClass -> ErrorClass -> Bool) -> Eq ErrorClass
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
Eq ErrorClass
-> (ErrorClass -> ErrorClass -> Ordering)
-> (ErrorClass -> ErrorClass -> Bool)
-> (ErrorClass -> ErrorClass -> Bool)
-> (ErrorClass -> ErrorClass -> Bool)
-> (ErrorClass -> ErrorClass -> Bool)
-> (ErrorClass -> ErrorClass -> ErrorClass)
-> (ErrorClass -> ErrorClass -> ErrorClass)
-> Ord 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
$cp1Ord :: Eq ErrorClass
Ord, Int -> ErrorClass -> ShowS
[ErrorClass] -> ShowS
ErrorClass -> String
(Int -> ErrorClass -> ShowS)
-> (ErrorClass -> String)
-> ([ErrorClass] -> ShowS)
-> Show ErrorClass
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) = Doc -> String
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 :: Doc -> m a
externalError = CompilerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompilerError -> m a) -> (Doc -> CompilerError) -> Doc -> m a
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 :: String -> m a
externalErrorS = Doc -> m a
forall (m :: * -> *) a. MonadError CompilerError m => Doc -> m a
externalError (Doc -> m a) -> (String -> Doc) -> String -> m a
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 :: String -> Doc -> m a
internalErrorS String
s Doc
d =
  CompilerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompilerError -> m a) -> CompilerError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ErrorClass -> CompilerError
InternalError (String -> Text
T.pack String
s) (Doc -> Text
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
(Int -> InternalError -> ShowS)
-> (InternalError -> String)
-> ([InternalError] -> ShowS)
-> Show InternalError
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 :: Text -> a
compilerBug = InternalError -> a
forall a e. Exception e => e -> a
throw (InternalError -> a) -> (Text -> InternalError) -> Text -> a
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 :: Text -> a
compilerLimitation = InternalError -> a
forall a e. Exception e => e -> a
throw (InternalError -> a) -> (Text -> InternalError) -> Text -> a
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 :: String -> a
compilerBugS = Text -> a
forall a. Text -> a
compilerBug (Text -> a) -> (String -> Text) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

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