diff options
Diffstat (limited to 'src/Error/Base.hs')
-rw-r--r-- | src/Error/Base.hs | 24 |
1 files changed, 14 insertions, 10 deletions
diff --git a/src/Error/Base.hs b/src/Error/Base.hs index d7b685c..ef32d52 100644 --- a/src/Error/Base.hs +++ b/src/Error/Base.hs | |||
@@ -1,8 +1,7 @@ | |||
1 | module Error.Base ( | 1 | module Error.Base ( LispError (..) |
2 | LispError (..) | 2 | , LispResult (..) |
3 | , LispResult (..) | 3 | , unwrap |
4 | , unwrap | 4 | ) where |
5 | ) where | ||
6 | 5 | ||
7 | import Control.Monad.Except | 6 | import Control.Monad.Except |
8 | import Parser | 7 | import Parser |
@@ -15,19 +14,24 @@ data LispError = Parse ParseError | |||
15 | | ArgCount String Int [Expr] | 14 | | ArgCount String Int [Expr] |
16 | | UnknownFunction String | 15 | | UnknownFunction String |
17 | | TypeMismatch String Expr | 16 | | TypeMismatch String Expr |
17 | | UnboundVariable String | ||
18 | 18 | ||
19 | unwordsList :: [Expr] -> String | 19 | unwordsList :: [Expr] -> String |
20 | unwordsList = unwords . map show | 20 | unwordsList = unwords . map show |
21 | 21 | ||
22 | literal :: String -> String | ||
23 | literal v = "`" <> v <> "`" | ||
24 | |||
22 | instance Show LispError where | 25 | instance Show LispError where |
23 | show (Parse e) = "Parser Error: " ++ show e | 26 | show (Parse e) = "Parser Error: " ++ show e |
24 | show (BadForm s expr) = "Bad Form: " ++ s ++ ": " ++ show expr | 27 | show (BadForm s expr) = "Bad Form: " ++ literal s ++ ": " ++ show expr |
25 | -- TODO: clean this up | 28 | -- TODO: clean this up |
26 | show (ArgCount fn n es) | 29 | show (ArgCount fn n es) |
27 | | null es = "Invalid arity, `" ++ fn ++ "` expects " ++ show n ++ " or more expression(s)!" | 30 | | null es = "Invalid arity, " ++ literal fn ++ " expects " ++ show n ++ " or more expression(s)!" |
28 | | otherwise = "Invalid arity, `" ++ fn ++ "` expects " ++ show n ++ " or more expression(s), got value(s): " ++ unwordsList es | 31 | | otherwise = "Invalid arity, " ++ literal fn ++ " expects " ++ show n ++ " or more expression(s), got value(s): " ++ unwordsList es |
29 | show (UnknownFunction fn) = "Cannot apply function: " ++ fn | 32 | show (UnknownFunction fn) = "Cannot apply function: " ++ literal fn |
30 | show (TypeMismatch msg got) = "Type mismatch, expected " ++ msg ++ ", got: " ++ show got | 33 | show (TypeMismatch msg got) = "Type mismatch, expected " ++ literal msg ++ ", got: " ++ show got |
34 | show (UnboundVariable name) = "Possibly unbound variable: " ++ literal name | ||
31 | 35 | ||
32 | type LispResult = Either LispError | 36 | type LispResult = Either LispError |
33 | 37 | ||