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

現(xiàn)在我們程序里的很多地方括袒，我們要么是忽略了錯(cuò)誤钮呀，要么是讓它默默返回一個(gè)像是#f或是0這樣表示無意義的默認(rèn)值。一些像Perl或者是PHP的語言就是用這種方式來處理異常的。然而摊阀，這也意味著錯(cuò)誤會(huì)默默的在整個(gè)程序里傳遞直到最終變成很大的并且讓程序員能難定位的問題。我們這里希望一旦有錯(cuò)誤發(fā)生，它就能立刻被注意到并且讓程序停止運(yùn)行胞此。

首先臣咖，我們需要導(dǎo)入Control.Monad.Error庫來取得Haskell的內(nèi)置錯(cuò)誤處理函數(shù)：

import Control.Monad.Error

在Debian系的系統(tǒng)上，這需要額外安裝一個(gè)libghc6-mtl-dev包漱牵。

然后夺蛇，讓我們?yōu)殄e(cuò)誤也定義一個(gè)數(shù)據(jù)類型：

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

這里是到目前為止我們可能會(huì)需要的一些構(gòu)造器，之后我們可能還會(huì)想到一些其他的東西然后再添加進(jìn)去酣胀。接下來蚊惯，我們來定義如何打印LispError并且讓它成為Show的一個(gè)實(shí)例：

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

接下來是時(shí)候讓我們自己定義的類型成為一個(gè)Error的實(shí)例了。這樣子我們才能讓它同GHC的內(nèi)置錯(cuò)誤處理函數(shù)相配合灵临。成為Error的一個(gè)實(shí)例事實(shí)上只需要給它提供一個(gè)能通過一條的錯(cuò)誤消息或者它自身來進(jìn)行初始化的函數(shù)：

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

接下來我們來定義一個(gè)用來表示要么會(huì)拋出LispError要么會(huì)返回值的函數(shù)的類型。還記得我們之前是怎么用Either類型來表示parse中的異常情況的嗎趴荸？這里也是一樣：

type ThrowsError = Either LispError

類型構(gòu)造器和函數(shù)一樣也能夠柯里化并被部分的調(diào)用儒溉。一個(gè)完整的類型可能是Either LispError Integer或者Either LispError LispVal，但是這里我想寫成ThrowsError LispVal這樣子发钝。我們僅僅將Either類型部分應(yīng)用于LispError顿涣，于是得到了一個(gè)能夠可以用在任意類型上的構(gòu)造器ThrowsError。

這里Either又是一個(gè)Monad的實(shí)例酝豪。這個(gè)例子中涛碑，在Either操作中被傳遞的附加信息是是否在這之間有錯(cuò)誤發(fā)生。如果Either操作中包含的是一個(gè)普通值孵淘，那綁定操作就會(huì)發(fā)生蒲障，否則就會(huì)跳過計(jì)算步驟直接傳遞一個(gè)錯(cuò)誤。其它語言中的異常就是這樣子的瘫证，但由于Haskell的惰性求值機(jī)制揉阎，這里不需要一個(gè)額外的控制結(jié)構(gòu)。如果綁定時(shí)已經(jīng)能夠判斷這個(gè)值是一個(gè)錯(cuò)誤背捌，那么這個(gè)函數(shù)就永遠(yuǎn)不會(huì)被調(diào)用毙籽。

除了標(biāo)準(zhǔn)的Monad函數(shù)，Either類型還額外提供了另外其他兩個(gè)函數(shù)：

1. throwError毡庆，傳入一個(gè)Error類型的值然后將它lift成Either類型的Left構(gòu)造器坑赡。
2. catchError，同時(shí)傳入一個(gè)Either操作和一個(gè)將錯(cuò)誤轉(zhuǎn)換成另一個(gè)Either操作的函數(shù)么抗。如果傳入的Either操作是一個(gè)錯(cuò)誤毅否，就會(huì)調(diào)用傳入的函數(shù)，舉例來講就會(huì)將你的錯(cuò)誤通過return轉(zhuǎn)換成一個(gè)正常值或者重新拋出另一個(gè)錯(cuò)誤乖坠。

在我們的程序中搀突，我們會(huì)能夠?qū)⑺蓄愋偷腻e(cuò)誤轉(zhuǎn)換成它們對(duì)應(yīng)的字符串表示，然后作為正常值進(jìn)行返回。讓我們來創(chuàng)建這樣的一個(gè)輔助函數(shù)：

trapError action = catchError action (return . show)

調(diào)用trapError函數(shù)的返回結(jié)果是另一個(gè)包含合法（Right）數(shù)據(jù)的Either操作仰迁。我們依然需要將數(shù)據(jù)從Either中抽取出來甸昏，這樣我們就能講它傳遞給其它函數(shù)了：

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

我們這里刻意沒有定義extractValue函數(shù)中傳入Left值對(duì)應(yīng)的分支，因?yàn)檫@實(shí)際上代表一個(gè)程序錯(cuò)誤徐许。我們只希望在catchError之后使用extractValue施蜜，所以它最好在將不合適的數(shù)據(jù)注入到其他代碼之前就提前掛掉。

現(xiàn)在既然所有的基礎(chǔ)架構(gòu)都齊全了雌隅，是時(shí)候開始嘗試使用我們的處理錯(cuò)誤機(jī)制了翻默。還記得我們的解析器之前在出錯(cuò)時(shí)僅僅會(huì)返回一個(gè)“No match”提示字符串嗎？現(xiàn)在我們來讓它能夠封裝并拋出一個(gè)原始的ParseError：

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

這里我們通過Parser構(gòu)造器將最初的ParseError封裝成了一個(gè)LispError類型恰起，然后使用內(nèi)置的throwError函數(shù)讓它能夠作為一個(gè)ThrowsError類型的Monad返回修械。由于readExpr函數(shù)現(xiàn)在會(huì)返回一個(gè)Monad值了，我們需要將其他分支也用return封裝起來检盼。

接下來肯污，我們修改eval函數(shù)的類型簽名讓它也根據(jù)情況能返回對(duì)應(yīng)Monad值，并且添加一個(gè)專門用來在遇到識(shí)別不了的模式時(shí)拋出異常的分支：

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

由于在函數(shù)應(yīng)用分支中我們會(huì)遞歸的調(diào)用eval函數(shù)（現(xiàn)在會(huì)返回一個(gè)Monad值）吨枉，我們需要進(jìn)行一點(diǎn)修改蹦渣。首先我們要把map函數(shù)修改成mapM，后者將一個(gè)Monad中的函數(shù)映射向一個(gè)列表并將每個(gè)返回值繼續(xù)作為操作并按順序進(jìn)行綁定貌亭，最后返回一系列計(jì)算結(jié)果的列表柬唯。而在Error這個(gè)Monad中，這一連串操作都會(huì)逐一進(jìn)行計(jì)算圃庭，除非其中任意一個(gè)失敗了锄奢，那就會(huì)拋出一個(gè)異常--成功時(shí)你會(huì)得到一個(gè)Right [result]，而失敗則是一個(gè)Left error剧腻。接下來斟薇，我們用Monad的綁定操作符來將結(jié)果傳入被部分應(yīng)用的apply func，同樣當(dāng)任何操作失敗時(shí)都返回一個(gè)錯(cuò)誤恕酸。

接下來我們來修改apply函數(shù)讓它也能夠在遇到識(shí)別不了的模式時(shí)拋出錯(cuò)誤：

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

我們沒有給函數(shù)調(diào)用符($ args)添加一個(gè)return堪滨。這是因?yàn)槲覀兘酉聛頃?huì)改變primitives函數(shù)，使從lookup中返回的函數(shù)也會(huì)返回一個(gè)ThrowsError操作：

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

同樣蕊温，顯然我們還需要修改numericBinop函數(shù)袱箱，讓它在只接受到一個(gè)參數(shù)的時(shí)候拋出錯(cuò)誤：

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

由于需要獲取實(shí)際傳入函數(shù)的值用作錯(cuò)誤報(bào)告，我們這里使用一個(gè)at模式來捕捉單值傳入的情況义矛。我們對(duì)一個(gè)單元素列表進(jìn)行匹配发笔，而且我們實(shí)際上不關(guān)心它到底是什么。我們同樣也需要使用mapM來按順序連接unpackNum的結(jié)果凉翻，因?yàn)槊恳淮蝩npackNum調(diào)用都可能會(huì)因TypeMismatch而出錯(cuò)：

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

最后了讨，我們需要改變主函數(shù)來最終使用這整套Error Monad體系。這貌似有一點(diǎn)復(fù)雜，因?yàn)楝F(xiàn)在我們需要同時(shí)處理兩種Monad（Error和IO）了前计。事實(shí)上胞谭，我們需要重新用do代碼塊來組織邏輯，因?yàn)橐ㄟ^point-free風(fēng)格來處理這種一個(gè)Monad的結(jié)果嵌套在另一個(gè)Monad中的情況幾乎是不可能的：

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

現(xiàn)在我們的新函數(shù)是這樣子的：

1. args是命令行參數(shù)的列表
2. evaled以下操作的結(jié)果
   1. 獲取第一個(gè)參數(shù)(args !! 0)
   2. 解析(readExpr)
   3. 傳遞給eval函數(shù)（>>= eval 綁定符比$符號(hào)優(yōu)先級(jí)高）
   4. 在Error Monad中調(diào)用show函數(shù)（注意我們整個(gè)操作的類型是IO (Either LispError String)男杈，因此evaled的類型是Either LispError String丈屹。必須要這樣子因?yàn)橐环矫嫖覀兊膖rapError函數(shù)需要將Error類型轉(zhuǎn)化成字符串，而另一方面它也需要和正常情況下的類型匹配）
3. Caught則是以下操作的結(jié)果
   1. 對(duì)evaled調(diào)用trapError函數(shù)伶棒，將錯(cuò)誤轉(zhuǎn)化成對(duì)應(yīng)的字符串形式
   2. 調(diào)用extractValue函數(shù)將Either LispError String操作中的值取出來
   3. 通過putStrLn函數(shù)打印結(jié)果旺垒。

編譯并運(yùn)行程序，并嘗試拋出一系列異常：

$ 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?"

一些讀者反應(yīng)這里和之后的一些例子需要添加--make參數(shù)才能成功進(jìn)行編譯肤无。實(shí)際上這個(gè)參數(shù)是讓GHC編譯出一個(gè)完整的可執(zhí)行程序先蒋，并搜索出所有在導(dǎo)入聲明中列出的依賴。上述的命令盡管在我的系統(tǒng)里工作正常宛渐，但是如果你失敗的話鞭达，加上--make試試。