48時間でSchemeを書こう/エラー処理と例外

# 参考URL
[48時間でSchemeを書こう/エラー処理と例外](https://ja.wikibooks.org/wiki/48時間でSchemeを書こう/エラー処理と例外)

#ソース
https://github.com/0zawa/scheme_in_48_hours/blob/master/error_checking_and_exceptions.hs


# エラー型定義
エラーが発生したときに原因をわかりやすくするため、
エラー型を定義します。

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

また、LispErrorをShowのインスタンスにして、
表示(文字列化)可能にします。

```hs
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
```

また、LispErrorをErrorのインスタンスにします。
Errorのインスタンスにするとエラーを処理する組み込み関数が
使えるようになります。


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

strMsgは文字列をError型に変えるために定義されているようです。
(noMsg,strMsgを実装する理由についてはイマイチ理解できていません。)


次に、利便性のためEitherのLeftにLispErrorを
固定させた型を定義します。


```hs
type ThrowsError = Either LispError
```

実際に使用する際はRightの型を指定して

```hs
ThrowsError String
ThrowsErrro LispVal
```

のように使用します。


エラーを文字列に変えるための関数を定義します。

```he
trapError action = catchError action (return . show)
```

参考URLの内容では型が書かれていませんが、この型は

```hs
ThrowsError String -> ThrowsError String
```

になります。

catchErrorはactionがエラー(Left値)なら
Leftの値に、渡された関数(return . show)を適用し、
その結果(String)をThrowsErrorに包んで返します。
Right値ならRightの値(String)をそのまま
ThrowsErrorに包んで返却します。


ThrowsErrorのRight値を取り出すための関数も定義します。

```hs
extractValue :: ThrowsError a -> a
extractValue (Right val) = val
```
Left値が入った状態で呼ばれた際は意図的にエラーにするために
Rightのパターンしか記載していないようです。


続いてreadExprをThrowsErrorを返すように修正します。
ThrowsErrorのRight型はLispValです。

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

parse関数の結果がRight値だった場合は結果を
ThrowsErrorのRight値に入れて返します。
Left値の場合はthrowError関数を使って、
ThrowErrorのLeft値にParserエラーとして格納して
返却します。


次にevalを修正します。


```hs
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
```

String,Number,Boolはそのままreturnで
ThrowsErrorに包んでいるだけです。
quoteもquoteされた値をreturnしているだけです。
一番下のbadFormに来るのはどのパターンにも当てはまらなかった場合です。
thorowErrorを使ってLeft値にBadSpecialFormエラーを入れています。
evalに先頭がquote以外のAtomであるListが渡された場合は
少し複雑になります。
まずListの先頭以外をevalで評価します。
argsの各要素に対してevalをする際、
mapではなくmapMが使われています。

もし、

```hs
map eval args
```
とした場合、戻り値の型は[ThrowsError LispVal]になります。
しかし、次のapply関数に渡すためにThrowsError [LispVal]型の結果
が求められます。
そのため

```hs
mapM eval args
```

を行っています。
イメージとしてはmapとmapMの差は以下になります。

```hs
map eval [LispVal]
=> [ThrowsError LispVal,ThrowsError LispVal,ThrowsError LispVal]

mapM eval [LispVal]
=> ThrowsError [LispVal]
```

apply関数も修正します。
lookupに失敗した場合はNotFunctionエラーを返すようになります。
成功した場合の処理はそのままですが、これは
primitves側で変更しているためです。


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

primitivesも修正します。
変更点は戻り値の型だけで、実装はそのままです。
実装の変更はprimitiveから呼ばれるnumericBinop,unpackNumで
対応します。

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

numericBinopを修正します。


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

引数が要素一つのリストだった場合はNumArgsエラーを返しています。
それ以外の場合は、少し複雑ですが、まずparamsにunpackNumを
mapMで適用します。

unpackNumはThrowsError Integer型を返すように修正します。

```hs
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
```

そのためnumericBinopの

```hs
mapM unpackNum params
```
はThrowsError [Integer]を返します。

この結果を
```hs
return . Number . foldl1 op
```

に適用します。
順番に見ていくと、まずfold1 opにunpackNumした[Integer]が
渡されます。
結果opで順々に関数適用されて、結果のIntegerが返されます。
これにNumberコンストラクタを適用してLispVal型にします。
さらにreturnをかけることでThrowsError LispVal型にします。
numbericBinopはThrowsError LispVal型を返すと定義されているので
これで目的の型を返せるようになりました。

最後にmainを修正します。


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

mainの実装もかなり複雑なので、少しずつみていきます。
まず、

```hs
evaled <- return $ liftM show $ readExpr (args !! 0) >>= eval
```
の箇所ですが、

```hs
readExpr (args !! 0) >>= eval
```
は、readExprで得たThrwosError LispValのLispValの部分を
evalに渡します。結果としてThrowsError LispValを得ます。
この結果にliftM showを適用します。

liftMはThrowsErrorの内部、今回はLispValに対し、
指定した関数を適用します。
そのため、liftM show $ ThrowsError LispValの結果は
ThrowsError Stringになります。

この結果に対してreturnを適用しています。
このreturnはmainの中で使われているので、IOに包まれることになります。
更に包まれた中身をevaled変数に入れています。
この結果evaled変数はThrowsError LispValが入ることになります。

次に、

```hs
putStrLn $ extractValue $ trapError evaled
```
の部分を見ていきます。
trapErrorはevaledにThrowsErrorのLeft値が入っている場合、
エラーを文字列に変えて戻します。Left値をRight値に移すような
感じです。
エラーでない場合はそのままの値を戻します。

その結果に対し、extractValueを適用すると、ThrowError Stringの
Stringの部分が取得できます。

その習得したStringに対し、putStrLn関数を適用することで、
これまでの処理結果を表示させています。