module Language.Ginger.RuntimeError
where

import Data.Text (Text)
import Control.Exception
import Text.Printf

import Language.Ginger.SourcePosition

data RuntimeError
  = ArgumentError 
      Text -- ^ Callee
      Text -- ^ Argument (position or name)
      Text -- ^ Expected argument
      Text -- ^ Actual argument
  | TagError
      Text -- ^ Identifier / object / context
      Text -- ^ Expected type(s)
      Text -- ^ Actual type
  | NonCallableObjectError 
      Text -- ^ Object that was attempted to be used as a callable
  | NotInScopeError
      Text -- ^ Identifier
  | NotImplementedError
      Text -- ^ The thing that isn't implemented
  | NumericError
      Text -- ^ Identifier / object / context
      Text -- ^ Error description
  | TemplateFileNotFoundError
      Text -- ^ Template name
  | TemplateParseError
      Text -- ^ Template name
      Text -- ^ Error message
  | FatalError
      Text
  | GenericError
      Text
  | PositionedError
      !SourcePosition
      !RuntimeError
  deriving (Int -> RuntimeError -> String -> String
[RuntimeError] -> String -> String
RuntimeError -> String
(Int -> RuntimeError -> String -> String)
-> (RuntimeError -> String)
-> ([RuntimeError] -> String -> String)
-> Show RuntimeError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> RuntimeError -> String -> String
showsPrec :: Int -> RuntimeError -> String -> String
$cshow :: RuntimeError -> String
show :: RuntimeError -> String
$cshowList :: [RuntimeError] -> String -> String
showList :: [RuntimeError] -> String -> String
Show, RuntimeError -> RuntimeError -> Bool
(RuntimeError -> RuntimeError -> Bool)
-> (RuntimeError -> RuntimeError -> Bool) -> Eq RuntimeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RuntimeError -> RuntimeError -> Bool
== :: RuntimeError -> RuntimeError -> Bool
$c/= :: RuntimeError -> RuntimeError -> Bool
/= :: RuntimeError -> RuntimeError -> Bool
Eq)

instance Exception RuntimeError where

-- | Pretty-print a 'RuntimeError'. The output is meant to be useful as a
-- user-facing error message.
prettyRuntimeError :: RuntimeError -> String
prettyRuntimeError :: RuntimeError -> String
prettyRuntimeError (NotImplementedError Text
what) =
  String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Not implemented: %s"
    Text
what
prettyRuntimeError (ArgumentError Text
callee Text
argument Text
expected Text
actual) =
  String -> Text -> Text -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Argument error in argument '%s' to %s: expected %s, but got %s."
    Text
argument Text
callee Text
expected Text
actual
prettyRuntimeError (TagError Text
context Text
expected Text
actual) =
  String -> Text -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Type error in %s: expected %s, but got %s."
    Text
context Text
expected Text
actual
prettyRuntimeError (NonCallableObjectError Text
obj) =
  String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Non-callable error: %s is not callable."
    Text
obj
prettyRuntimeError (NotInScopeError Text
thing) =
  String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Not in scope: %s"
    Text
thing
prettyRuntimeError (NumericError Text
context Text
what) =
  String -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Numeric error in %s: %s"
    Text
context Text
what
prettyRuntimeError (TemplateFileNotFoundError Text
name) =
  String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Template file not found: %s"
    Text
name
prettyRuntimeError (TemplateParseError Text
name Text
msg) =
  String -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Template parser error in %s:\n%s"
    Text
name Text
msg
prettyRuntimeError (GenericError Text
what) =
  String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"Error: %s"
    Text
what
prettyRuntimeError (FatalError Text
what) =
  String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"FATAL ERROR: %s"
    Text
what
prettyRuntimeError (PositionedError (SourcePosition Text
file Int
line Int
column) RuntimeError
err) =
  String -> Text -> Int -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"In %s:%i:%i:\n%s"
    Text
file Int
line Int
column (RuntimeError -> String
prettyRuntimeError RuntimeError
err)