aboutsummaryrefslogtreecommitdiff
path: root/src/Error/Base.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Error/Base.hs')
-rw-r--r--src/Error/Base.hs24
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 @@
1module Error.Base ( 1module Error.Base ( LispError (..)
2 LispError (..) 2 , LispResult (..)
3 , LispResult (..) 3 , unwrap
4 , unwrap 4 ) where
5 ) where
6 5
7import Control.Monad.Except 6import Control.Monad.Except
8import Parser 7import 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
19unwordsList :: [Expr] -> String 19unwordsList :: [Expr] -> String
20unwordsList = unwords . map show 20unwordsList = unwords . map show
21 21
22literal :: String -> String
23literal v = "`" <> v <> "`"
24
22instance Show LispError where 25instance 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
32type LispResult = Either LispError 36type LispResult = Either LispError
33 37