blob: d7b685c1eb46c8c840ccef63b1de2d8da6ea349d (
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
|
module Error.Base (
LispError (..)
, LispResult (..)
, unwrap
) where
import Control.Monad.Except
import Parser
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
unwordsList :: [Expr] -> String
unwordsList = unwords . map show
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, `" ++ fn ++ "` expects " ++ show n ++ " or more expression(s)!"
| otherwise = "Invalid arity, `" ++ fn ++ "` expects " ++ show n ++ " or more expression(s), got value(s): " ++ unwordsList es
show (UnknownFunction fn) = "Cannot apply function: " ++ fn
show (TypeMismatch msg got) = "Type mismatch, expected " ++ msg ++ ", got: " ++ show got
type LispResult = Either LispError
unwrap :: LispResult t -> t
unwrap (Right v) = v
unwrap (Left _) = undefined -- should panic
|
