aboutsummaryrefslogtreecommitdiff
path: root/src/Error/Base.hs
blob: 747904a57834b9122a28b6222a3b9dfb13d0f26d (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           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
               | 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