blob: 008a2fc0f14290bba1fd55dc22afd416f54fb599 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
module Error.Base ( LispError (..)
, LispResult (..)
, unwrap
) where
import Base (Expr (..))
import Control.Monad.Except
import Text.Parsec
import Text.Parsec.Error
import Text.ParserCombinators.Parsec
data LispError = Parse ParseError
| BadForm String Expr
| ArgCount String Int [Expr]
| UnknownFunction String
| TypeMismatch String Expr
| UnboundVariable String
unwordsList :: [Expr] -> String
unwordsList = unwords . map show
literal :: String -> String
literal v = "`" <> v <> "`"
instance Show LispError where
show (Parse e) = "Parser Error: " ++ show e
show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr
-- TODO: clean this up
show (ArgCount fn n es)
| null es = "Invalid arity, " ++ literal fn ++ " expects " ++ show n ++ " or more expression(s)!"
| otherwise = "Invalid arity, " ++ literal fn ++ " expects " ++ show n ++ " or more expression(s), got value(s): " ++ unwordsList es
show (UnknownFunction fn) = "Cannot apply function: " ++ literal fn
show (TypeMismatch msg got) = "Type mismatch, expected " ++ literal msg ++ ", got: " ++ show got
show (UnboundVariable name) = "Possibly unbound variable: " ++ literal name
type LispResult = Either LispError
unwrap :: LispResult t -> t
unwrap (Right v) = v
unwrap (Left _) = undefined -- should panic
|
