module Zinza.Errors where

import Control.Exception         (Exception (..), throwIO)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State (StateT (..))

import Zinza.Pos
import Zinza.Type
import Zinza.Var

errorLoc :: Loc -> String -> String
errorLoc :: Loc -> String -> String
errorLoc Loc
l String
str = String
"Error at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Loc -> String
displayLoc Loc
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
str

-------------------------------------------------------------------------------
-- ParseError
-------------------------------------------------------------------------------

newtype ParseError = ParseError String
  deriving (Int -> ParseError -> String -> String
[ParseError] -> String -> String
ParseError -> String
(Int -> ParseError -> String -> String)
-> (ParseError -> String)
-> ([ParseError] -> String -> String)
-> Show ParseError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ParseError -> String -> String
showsPrec :: Int -> ParseError -> String -> String
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> String -> String
showList :: [ParseError] -> String -> String
Show)

instance Exception ParseError where
    displayException :: ParseError -> String
displayException (ParseError String
err) = String
err

-------------------------------------------------------------------------------
-- CompileError
-------------------------------------------------------------------------------

data CompileError
    = UnboundTopLevelVar Loc Var
    | ShadowingBlock Loc Var
    | UnboundUseBlock Loc Var
    | ARuntimeError RuntimeError
  deriving (Int -> CompileError -> String -> String
[CompileError] -> String -> String
CompileError -> String
(Int -> CompileError -> String -> String)
-> (CompileError -> String)
-> ([CompileError] -> String -> String)
-> Show CompileError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CompileError -> String -> String
showsPrec :: Int -> CompileError -> String -> String
$cshow :: CompileError -> String
show :: CompileError -> String
$cshowList :: [CompileError] -> String -> String
showList :: [CompileError] -> String -> String
Show)

instance Exception CompileError where
    displayException :: CompileError -> String
displayException (UnboundTopLevelVar Loc
loc String
var) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"unbound variable '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
    displayException (ShadowingBlock Loc
loc String
var) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"redefining block '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
    displayException (UnboundUseBlock Loc
loc String
var) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"unbound block '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' used"
    displayException (ARuntimeError RuntimeError
err) =
        RuntimeError -> String
forall e. Exception e => e -> String
displayException RuntimeError
err


-------------------------------------------------------------------------------
-- CompileOrParseError
-------------------------------------------------------------------------------

data CompileOrParseError
    = ACompileError CompileError
    | AParseError ParseError
  deriving (Int -> CompileOrParseError -> String -> String
[CompileOrParseError] -> String -> String
CompileOrParseError -> String
(Int -> CompileOrParseError -> String -> String)
-> (CompileOrParseError -> String)
-> ([CompileOrParseError] -> String -> String)
-> Show CompileOrParseError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CompileOrParseError -> String -> String
showsPrec :: Int -> CompileOrParseError -> String -> String
$cshow :: CompileOrParseError -> String
show :: CompileOrParseError -> String
$cshowList :: [CompileOrParseError] -> String -> String
showList :: [CompileOrParseError] -> String -> String
Show)

instance Exception CompileOrParseError where
    displayException :: CompileOrParseError -> String
displayException (ACompileError CompileError
err) = CompileError -> String
forall e. Exception e => e -> String
displayException CompileError
err
    displayException (AParseError ParseError
err)   = ParseError -> String
forall e. Exception e => e -> String
displayException ParseError
err

-------------------------------------------------------------------------------
-- RuntimeError
-------------------------------------------------------------------------------

data RuntimeError
    = NotBool Loc Ty
    | NotString Loc Ty
    | NotRecord Loc Ty
    | NotList Loc Ty
    | FieldNotInRecord Loc Var Ty
    | NotFunction Loc Ty
    | FunArgDontMatch Loc Ty Ty
    | CustomError Loc String Ty
  deriving (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, 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)

instance Exception RuntimeError where
    displayException :: RuntimeError -> String
displayException (NotBool Loc
loc Ty
ty) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"Not a bool " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
ty
    displayException (NotString Loc
loc Ty
ty) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"Not a string " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
ty
    displayException (NotRecord Loc
loc Ty
ty) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"Not a record " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
ty
    displayException (NotList Loc
loc Ty
ty) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"Not a list " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
ty
    displayException (FieldNotInRecord Loc
loc String
var Ty
ty) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"Field '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' isn't in a record of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
ty
    displayException (NotFunction Loc
loc Ty
ty) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"Not a function " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
ty
    displayException (FunArgDontMatch Loc
loc Ty
tyA Ty
tyB) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
"Function argument type don't match " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
tyA String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"; expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
tyB
    displayException (CustomError Loc
loc String
msg Ty
ty) = Loc -> String -> String
errorLoc Loc
loc (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
        String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ty -> String
displayTy Ty
ty

-- | Class representing errors containing 'RuntimeError's.
--
-- Without bugs, compiled template should not throw any 'RuntimeError's,
-- as they are prevented statically, i.e. reported already as 'CompileError's.
--
class    AsRuntimeError e where asRuntimeError :: RuntimeError -> e
instance AsRuntimeError RuntimeError where asRuntimeError :: RuntimeError -> RuntimeError
asRuntimeError = RuntimeError -> RuntimeError
forall a. a -> a
id
instance AsRuntimeError CompileError where asRuntimeError :: RuntimeError -> CompileError
asRuntimeError = RuntimeError -> CompileError
ARuntimeError

class Monad m => ThrowRuntime m where
    throwRuntime ::  RuntimeError -> m a

instance AsRuntimeError e => ThrowRuntime (Either e) where
    throwRuntime :: forall a. RuntimeError -> Either e a
throwRuntime = e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a)
-> (RuntimeError -> e) -> RuntimeError -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> e
forall e. AsRuntimeError e => RuntimeError -> e
asRuntimeError

instance ThrowRuntime IO where
    throwRuntime :: forall a. RuntimeError -> IO a
throwRuntime = RuntimeError -> IO a
forall e a. Exception e => e -> IO a
throwIO

instance ThrowRuntime m => ThrowRuntime (StateT s m) where
    throwRuntime :: forall a. RuntimeError -> StateT s m a
throwRuntime = m a -> StateT s m a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (RuntimeError -> m a) -> RuntimeError -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeError -> m a
forall a. RuntimeError -> m a
forall (m :: * -> *) a. ThrowRuntime m => RuntimeError -> m a
throwRuntime