Write Yourself a Scheme in 48 Hours/Error Checking and Exceptions

原文。
https://en.wikibooks.org/wiki/Write_Yourself_a_Scheme_in_48_Hours/Error_Checking_and_Exceptions

现在我们程序里的很多地方，我们要么是忽略了错误，要么是让它默默返回一个像是#f或是0这样表示无意义的默认值。一些像Perl或者是PHP的语言就是用这种方式来处理异常的。然而，这也意味着错误会默默的在整个程序里传递直到最终变成很大的并且让程序员能难定位的问题。我们这里希望一旦有错误发生，它就能立刻被注意到并且让程序停止运行。

首先，我们需要导入Control.Monad.Error库来取得Haskell的内置错误处理函数：

import Control.Monad.Error

在Debian系的系统上，这需要额外安装一个libghc6-mtl-dev包。

然后，让我们为错误也定义一个数据类型：

data LispError = NumArgs Integer [LispVal]
               | TypeMismatch String LispVal
               | Parser ParseError
               | BadSpecialForm String LispVal
               | NotFunction String String
               | UnboundVar String String
               | Default String

这里是到目前为止我们可能会需要的一些构造器，之后我们可能还会想到一些其他的东西然后再添加进去。接下来，我们来定义如何打印LispError并且让它成为Show的一个实例：

showError :: LispError -> String
showError (UnboundVar message varname)  = message ++ ": " ++ varname
showError (BadSpecialForm message form) = message ++ ": " ++ show form
showError (NotFunction message func)    = message ++ ": " ++ show func
showError (NumArgs expected found)      = "Expected " ++ show expected 
                                       ++ " args; found values " ++ unwordsList found
showError (TypeMismatch expected found) = "Invalid type: expected " ++ expected
                                       ++ ", found " ++ show found
showError (Parser parseErr)             = "Parse error at " ++ show parseErr

instance Show LispError where show = showError

接下来是时候让我们自己定义的类型成为一个Error的实例了。这样子我们才能让它同GHC的内置错误处理函数相配合。成为Error的一个实例事实上只需要给它提供一个能通过一条的错误消息或者它自身来进行初始化的函数：

instance Error LispError where
     noMsg = Default "An error has occurred"
     strMsg = Default

接下来我们来定义一个用来表示要么会抛出LispError要么会返回值的函数的类型。还记得我们之前是怎么用Either类型来表示parse中的异常情况的吗？这里也是一样：

type ThrowsError = Either LispError

类型构造器和函数一样也能够柯里化并被部分的调用。一个完整的类型可能是Either LispError Integer或者Either LispError LispVal，但是这里我想写成ThrowsError LispVal这样子。我们仅仅将Either类型部分应用于LispError，于是得到了一个能够可以用在任意类型上的构造器ThrowsError。

这里Either又是一个Monad的实例。这个例子中，在Either操作中被传递的附加信息是是否在这之间有错误发生。如果Either操作中包含的是一个普通值，那绑定操作就会发生，否则就会跳过计算步骤直接传递一个错误。其它语言中的异常就是这样子的，但由于Haskell的惰性求值机制，这里不需要一个额外的控制结构。如果绑定时已经能够判断这个值是一个错误，那么这个函数就永远不会被调用。

除了标准的Monad函数，Either类型还额外提供了另外其他两个函数：

throwError，传入一个Error类型的值然后将它lift成Either类型的Left构造器。
catchError，同时传入一个Either操作和一个将错误转换成另一个Either操作的函数。如果传入的Either操作是一个错误，就会调用传入的函数，举例来讲就会将你的错误通过return转换成一个正常值或者重新抛出另一个错误。

在我们的程序中，我们会能够将所有类型的错误转换成它们对应的字符串表示，然后作为正常值进行返回。让我们来创建这样的一个辅助函数：

trapError action = catchError action (return . show)

调用trapError函数的返回结果是另一个包含合法（Right）数据的Either操作。我们依然需要将数据从Either中抽取出来，这样我们就能讲它传递给其它函数了：

extractValue :: ThrowsError a -> a
extractValue (Right val) = val

我们这里刻意没有定义extractValue函数中传入Left值对应的分支，因为这实际上代表一个程序错误。我们只希望在catchError之后使用extractValue，所以它最好在将不合适的数据注入到其他代码之前就提前挂掉。

现在既然所有的基础架构都齐全了，是时候开始尝试使用我们的处理错误机制了。还记得我们的解析器之前在出错时仅仅会返回一个“No match”提示字符串吗？现在我们来让它能够封装并抛出一个原始的ParseError：

readExpr :: String -> ThrowsError LispVal
readExpr input = case parse parseExpr "lisp" input of
     Left err -> throwError $ Parser err
     Right val -> return val

这里我们通过Parser构造器将最初的ParseError封装成了一个LispError类型，然后使用内置的throwError函数让它能够作为一个ThrowsError类型的Monad返回。由于readExpr函数现在会返回一个Monad值了，我们需要将其他分支也用return封装起来。

接下来，我们修改eval函数的类型签名让它也根据情况能返回对应Monad值，并且添加一个专门用来在遇到识别不了的模式时抛出异常的分支：

eval :: LispVal -> ThrowsError LispVal
eval val@(String _) = return val
eval val@(Number _) = return val
eval val@(Bool _) = return val
eval (List [Atom "quote", val]) = return val
eval (List (Atom func : args)) = mapM eval args >>= apply func
eval badForm = throwError $ BadSpecialForm "Unrecognized special form" badForm

由于在函数应用分支中我们会递归的调用eval函数（现在会返回一个Monad值），我们需要进行一点修改。首先我们要把map函数修改成mapM，后者将一个Monad中的函数映射向一个列表并将每个返回值继续作为操作并按顺序进行绑定，最后返回一系列计算结果的列表。而在Error这个Monad中，这一连串操作都会逐一进行计算，除非其中任意一个失败了，那就会抛出一个异常--成功时你会得到一个Right [result]，而失败则是一个Left error。接下来，我们用Monad的绑定操作符来将结果传入被部分应用的apply func，同样当任何操作失败时都返回一个错误。

接下来我们来修改apply函数让它也能够在遇到识别不了的模式时抛出错误：

apply :: String -> [LispVal] -> ThrowsError LispVal
apply func args = maybe (throwError $ NotFunction "Unrecognized primitive function args" func)
                        ($ args)
                        (lookup func primitives)

我们没有给函数调用符($ args)添加一个return。这是因为我们接下来会改变primitives函数，使从lookup中返回的函数也会返回一个ThrowsError操作：

primitives :: [(String, [LispVal] -> ThrowsError LispVal)]

同样，显然我们还需要修改numericBinop函数，让它在只接受到一个参数的时候抛出错误：

numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> ThrowsError LispVal
numericBinop op           []  = throwError $ NumArgs 2 []
numericBinop op singleVal@[_] = throwError $ NumArgs 2 singleVal
numericBinop op params        = mapM unpackNum params >>= return . Number . foldl1 op

由于需要获取实际传入函数的值用作错误报告，我们这里使用一个at模式来捕捉单值传入的情况。我们对一个单元素列表进行匹配，而且我们实际上不关心它到底是什么。我们同样也需要使用mapM来按顺序连接unpackNum的结果，因为每一次unpackNum调用都可能会因TypeMismatch而出错：

unpackNum :: LispVal -> ThrowsError Integer
unpackNum (Number n) = return n
unpackNum (String n) = let parsed = reads n in 
                           if null parsed 
                             then throwError $ TypeMismatch "number" $ String n
                             else return $ fst $ parsed !! 0
unpackNum (List [n]) = unpackNum n
unpackNum notNum     = throwError $ TypeMismatch "number" notNum

最后，我们需要改变主函数来最终使用这整套Error Monad体系。这貌似有一点复杂，因为现在我们需要同时处理两种Monad（Error和IO）了。事实上，我们需要重新用do代码块来组织逻辑，因为要通过point-free风格来处理这种一个Monad的结果嵌套在另一个Monad中的情况几乎是不可能的：

main :: IO ()
main = do
     args <- getArgs
     evaled <- return $ liftM show $ readExpr (args !! 0) >>= eval
     putStrLn $ extractValue $ trapError evaled

现在我们的新函数是这样子的：

args是命令行参数的列表
evaled以下操作的结果
1. 获取第一个参数(args !! 0)
2. 解析(readExpr)
3. 传递给eval函数（>>= eval 绑定符比$符号优先级高）
4. 在Error Monad中调用show函数（注意我们整个操作的类型是IO (Either LispError String)，因此evaled的类型是Either LispError String。必须要这样子因为一方面我们的trapError函数需要将Error类型转化成字符串，而另一方面它也需要和正常情况下的类型匹配）
Caught则是以下操作的结果
1. 对evaled调用trapError函数，将错误转化成对应的字符串形式
2. 调用extractValue函数将Either LispError String操作中的值取出来
3. 通过putStrLn函数打印结果。

编译并运行程序，并尝试抛出一系列异常：

$ ghc -package parsec -o errorcheck [../code/listing5.hs listing5.hs]
$ ./errorcheck "(+ 2 \"two\")"
Invalid type: expected number, found "two"
$ ./errorcheck "(+ 2)"
Expected 2 args; found values 2
$ ./errorcheck "(what? 2)"
Unrecognized primitive function args: "what?"

一些读者反应这里和之后的一些例子需要添加--make参数才能成功进行编译。实际上这个参数是让GHC编译出一个完整的可执行程序，并搜索出所有在导入声明中列出的依赖。上述的命令尽管在我的系统里工作正常，但是如果你失败的话，加上--make试试。

Write Yourself a Scheme in 48 Hours/Error Checking and Exceptions

你可能感兴趣的:(Write Yourself a Scheme in 48 Hours/Error Checking and Exceptions)