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

import Control.Exception
import Control.Monad.Error.Class
import Data.Text qualified as T
import Futhark.Util.Pretty
import Prettyprinter.Render.Text (renderStrict)

-- | 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
$c== :: ErrorClass -> ErrorClass -> Bool
== :: ErrorClass -> ErrorClass -> Bool
$c/= :: ErrorClass -> ErrorClass -> Bool
/= :: 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
$ccompare :: ErrorClass -> ErrorClass -> Ordering
compare :: ErrorClass -> ErrorClass -> Ordering
$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
>= :: ErrorClass -> ErrorClass -> Bool
$cmax :: ErrorClass -> ErrorClass -> ErrorClass
max :: ErrorClass -> ErrorClass -> ErrorClass
$cmin :: ErrorClass -> ErrorClass -> ErrorClass
min :: ErrorClass -> ErrorClass -> 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
$cshowsPrec :: Int -> ErrorClass -> ShowS
showsPrec :: Int -> ErrorClass -> ShowS
$cshow :: ErrorClass -> String
show :: ErrorClass -> String
$cshowList :: [ErrorClass] -> ShowS
showList :: [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 AnsiStyle)
  | -- | An internal compiler error.  The second pretty is extra data
    -- for debugging, which can be written to a file.
    InternalError T.Text T.Text ErrorClass

-- | Print an error intended for human consumption.
prettyCompilerError :: CompilerError -> Doc AnsiStyle
prettyCompilerError :: CompilerError -> Doc AnsiStyle
prettyCompilerError (ExternalError Doc AnsiStyle
e) = Doc AnsiStyle
e
prettyCompilerError (InternalError Text
s Text
_ ErrorClass
_) = Text -> Doc AnsiStyle
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
s

-- | Raise an 'ExternalError' based on a prettyprinting result.
externalError :: (MonadError CompilerError m) => Doc AnsiStyle -> m a
externalError :: forall (m :: * -> *) a.
MonadError CompilerError m =>
Doc AnsiStyle -> m a
externalError = CompilerError -> m a
forall a. CompilerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CompilerError -> m a)
-> (Doc AnsiStyle -> CompilerError) -> Doc AnsiStyle -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> 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 = Doc AnsiStyle -> m a
forall (m :: * -> *) a.
MonadError CompilerError m =>
Doc AnsiStyle -> m a
externalError (Doc AnsiStyle -> m a)
-> (String -> Doc AnsiStyle) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

-- | Raise an v'InternalError' based on a prettyprinting result.
internalErrorS :: (MonadError CompilerError m) => String -> Doc AnsiStyle -> m a
internalErrorS :: forall (m :: * -> *) a.
MonadError CompilerError m =>
String -> Doc AnsiStyle -> m a
internalErrorS String
s Doc AnsiStyle
d =
  CompilerError -> m a
forall a. 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 AnsiStyle -> Text
forall {ann}. Doc ann -> Text
p Doc AnsiStyle
d) ErrorClass
CompilerBug
  where
    p :: Doc ann -> Text
p = SimpleDocStream ann -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream ann -> Text)
-> (Doc ann -> SimpleDocStream ann) -> Doc ann -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LayoutOptions -> Doc ann -> SimpleDocStream ann
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutSmart LayoutOptions
defaultLayoutOptions

-- | 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
$cshowsPrec :: Int -> InternalError -> ShowS
showsPrec :: Int -> InternalError -> ShowS
$cshow :: InternalError -> String
show :: InternalError -> String
$cshowList :: [InternalError] -> ShowS
showList :: [InternalError] -> ShowS
Show)

instance Exception InternalError

-- | Throw an t'InternalError' that is a 'CompilerBug'.
compilerBug :: T.Text -> a
compilerBug :: forall a. 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 :: forall a. 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 :: forall a. 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 :: forall a. 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