aboutsummaryrefslogtreecommitdiff
path: root/src/Error/Base.hs
blob: 509377bc2519ce4870086ac3ab3050542e1570b4 (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
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 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
    show (ArgCount n es)        = "Invalid arity, expected " ++ show n ++ ", 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