Write Yourself a Scheme in 48 Hours(5)

5. 插曲：检查错误

目前，在代码的很多地方我们要么忽略了错误，要么静默的指定像#f或者0这种没有任何意义的“默认”值。一些语言 - 像Perl和PHP - 用这种方式工作的不错。但是，它常常意味着那些错误在整个程序里安静的传递知道它们变成大的问题，这说明除错机制对程序员相当不方便。我们希望一旦错误信 号发生它们立刻产生excution。

首先，我们需要导入Control.Monad.Error库来取得Haskell内建错误函数:

import Control.Monad.Error

 接下来，我们应该定义一个数据类型来表示错误：

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数据类型分析来表现异常？我们这里用同样的方法：

type ThrowsError = Either LispError

 类型构造符像函数一样结合也能部分应用。一个完整的类型应该是"Either LispError Integer" 或是"Either LispError LispVal",但是我们想表达成"ThrowsError LispVal" 等等。我们值部分应用Either给LispVal，创建了一个我们可以用在任意数据类型的类型构造符。

Either也是另一个monad实例。在这里，在Either动作中传递的“附加信息”是是否一个错误发生了。绑定在函数上的是Either动作有一个 正常值，或者无须计算直接传递一个错误。这是异常如何在其它语言中工作，但由于Haskell是惰性计算的，这里不需要一个分开的流程控制结构。如果绑定 判断这个值已经是一个错误，那么函数永远不会被调用。

Either monad也提供了两个额外的函数：

1. throwError,它会取一个错误值并提升它进Either的左（错误）构造符
2. catchError,它会取一个Either动作和一个函数并将一个错误转换成另一个Either动作。如果这个动作表示一个错误，它应用给其它函数，你可以这样使用：用return将错误值转换成正常值或者重新抛出另一个错误。

在我们的程序里，我们将转换所有的错误成为它们的字符串表现形式然后作为正常值返回。让我们创建一个帮助函数来为我们做这件事：

trapError action = catchError action (return . show)

 调用trapError的结果是另一个Either动作，它会总是返回有效（右边的）数据。我们仍然想将数据从Either monad中解开，这样它就能传递给其它函数：

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

 这里，我们首先用LispError构造符Parser来包装原始的ParseError，然后用内建函数throwError来返回ThrowsError monad中的值。因为readExpr现在返回一个monadic 值，我们需要将其它返回函数的值包装。

下一步，我们改变eval函数的类型签名来返回一个monadic值，相应的调整返回值，添加一个当我们遇见我们无法识别时抛出错误的分句：

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（现在返回一个monadic值），我们需要改变它。首先， 我们需要改变map为mapM，它映射一个monadic函数给一个列表，用bind将动作结果按顺序排列，最后返回里值的列表。在Error monad里面，按顺序执行所有的计算但是如果任意出错会抛出一个错误值-成功时返回Right [result]，或者失败时返回Left error。接下来，我们用monadic "bind"操作符来将结果传入部分应用的"apply func"，再次当任何操作失败时返回错误。

下一步，我们改变apply自身让它当不识别函数时抛出一个错误：

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

 我们没有添加一个返回状态给函数($ args)。我们正要改变我们的原始函数，使从lookup中返回的函数能够返回ThrowError动作：

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

 当然，我们需要改变numericBinop函数实现这些原始函数让它在只有一个参数时抛出错误：

numericBinop :: (Integer -> Integer -> Integer) -> [LispVal] -> ThrowsError LispVal
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-notation，因为这几乎不可能当结果是一个monad嵌套在另一个里面时用point-free风格：

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

 这是这个新函数干的事情：

1. args是一个命令行参数列表
2. evaled是这些的结果：
   1. 取出第一个参数 (args !!0)
   2. 分析它 (readExpr)
   3. 将结果传给eval(>>= eval; 绑定操作符比函数有更高的优先级)
   4. 在Error monad中调用show。
   再次注意整个动作是IO (Either LispError String)类型，计算值是Either LispError String类型。它必须是这个类型，因为我们trapError函数只能转换错误成为字符串，而那个类型必须和普通值相匹配
3. caught是这些的结果：
   1. 在求值后调用trapError，将错误转换成为字符串表现形式。
   2. 调用extractValue来从Either LispError String动作中取出字符串
   3. 用putStrLn打印结果

编译并运行新代码，然后尝试抛出一些错误：

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

 一些读者反应你需要添加--make标志来建立这个例子，和后面的一些例子。这个标志告诉GHC建立一个完整可执行的程序，搜索出所有在导入声明中列出的依赖。上面的命令在我的系统里工作正常，但是如果在你的系统失败，用--make试试。