在Haskell中捕获异常

Question

在Haskell中，异常只能在抛出后立即捕获，并且不像Java或Python一样被传递。下面是一个简短的例子:

{-# LANGUAGE DeriveDataTypeable #-}

import System.IO
import Control.Monad
import Control.Exception
import Data.Typeable

data MyException = NoParseException String deriving (Show, Typeable)
instance Exception MyException

-- Prompt consists of two functions:
-- The first converts an output paramter to String being printed to the screen.
-- The second parses user's input.
data Prompt o i = Prompt (o -> String) (String -> i)

-- runPrompt accepts a Prompt and an output parameter. It converts the latter
-- to an output string using the first function passed in Prompt, then runs
-- getline and returns user's input parsed with the second function passed
-- in Prompt.
runPrompt :: Prompt o i -> o -> IO i
runPrompt (Prompt ofun ifun) o = do
        putStr (ofun o)
        hFlush stdout
        liftM ifun getLine

myPrompt = Prompt (const "> ") (\s -> if s == ""
    then throw $ NoParseException s
    else s)

handleEx :: MyException -> IO String
handleEx (NoParseException s) = return ("Illegal string: " ++ s)

main = catch (runPrompt myPrompt ()) handleEx >>= putStrLn

运行程序后，当你仅按下[Enter]而没有输入任何内容时，我应该会看到输出：Illegal string:。但实际上出现了：prog: NoParseException ""。假设现在Prompt类型和runPrompt函数在模块外定义在通用库中，并且不能更改以处理传递给Prompt构造函数的函数中的异常。那么我如何在不更改runPrompt的情况下处理异常呢？

我考虑过添加第三个字段到Prompt中来注入异常处理函数，但这种方式对我来说似乎很丑陋。有更好的选择吗？

- Sventimir

Answer 1

你遇到的问题是因为你在纯代码中抛出了异常： throw 的类型是 Exception e => e -> a。 纯代码中的异常是不精确的，并且不能保证与 IO 操作的顺序。 因此，catch 不会看到纯 throw。 为了解决这个问题，你可以使用 evaluate :: a -> IO a，它“可以用于将评估与其他 IO 操作排序”（来自文档）。 evaluate 类似于 return，但它同时强制进行评估。 因此，你可以用 evaluate . ifun =<< getline 替换 liftM ifun getLine，这会强制在 runPrompt IO 操作期间对 ifun 进行评估。 （回想一下，liftM f mx = return . f =<< mx，所以这是相同的，但对评估有更多的控制。）而且，不改变任何其他内容，你会得到正确的答案：

*Main> :main
> 
Illegal string: 

---

实际上，在这里我不会使用异常。在Haskell代码中，人们并不经常使用异常，尤其是在纯代码中。我更愿意编写Prompt，以便将输入函数的潜在故障编码到类型中：

data Prompt o i = Prompt (o -> String) (String -> Either MyException i)

然后，运行提示符只会返回一个 Either：

runPrompt :: Prompt o i -> o -> IO (Either MyException i)
runPrompt (Prompt ofun ifun) o = do putStr $ ofun o
                                    hFlush stdout
                                    ifun `liftM` getLine

我们需要修改myPrompt，使用Left和Right代替throw：

myPrompt :: Prompt a String
myPrompt = Prompt (const "> ") $ \s ->
             if null s
               then Left $ NoParseException s
               else Right s

然后我们使用 either :: (a -> c) -> (b -> c) -> Either a b -> c 来处理异常。

handleEx :: MyException -> IO String
handleEx (NoParseException s) = return $ "Illegal string: " ++ s

main :: IO ()
main = putStrLn =<< either handleEx return =<< runPrompt myPrompt ()

额外的无关注释：你会注意到我做了一些风格上的改变。唯一我认为真正重要的是使用null s，而不是s == ""。

如果你真的想要在顶层恢复旧的行为，你可以编写runPromptException :: Prompt o i -> o -> IO i，它将把Left作为异常抛出：

runPromptException :: Prompt o i -> o -> IO i
runPromptException p o = either throwIO return =<< runPrompt p o

我们不需要在这里使用evaluate，因为我们正在使用throwIO，它用于在IO计算中抛出精确的异常。有了这个，您旧的main函数将正常工作。

- Antal Spector-Zabusky

---

哎呀，我今晚剩下的时间都要上课了。非常感谢。 :) - Sventimir

Answer 2

如果你查看myPrompt的类型，你会发现它是Prompt o String，即不在IO中。最小的修复方法如下：

{-# LANGUAGE DeriveDataTypeable #-}

import System.IO
import Control.Monad
import Control.Exception
import Data.Typeable

data MyException = NoParseException String deriving (Show, Typeable)
instance Exception MyException

-- Prompt consists of two functions:
-- The first converts an output paramter to String being printed to the screen.
-- The second parses user's input.
data Prompt o i = Prompt (o -> String) (String -> <b>IO</b> i)

-- runPrompt accepts a Prompt and an output parameter. It converts the latter
-- to an output string using the first function passed in Prompt, then runs
-- getline and returns user's input parsed with the second function passed
-- in Prompt.
runPrompt :: Prompt o i -> o -> IO i
runPrompt (Prompt ofun ifun) o = do
        putStr (ofun o)
        hFlush stdout
        <b>getLine >>= ifun</b>

myPrompt :: Prompt o String
myPrompt = Prompt (const "> ") (\s -> if s == ""
    then throw $ NoParseException s
    else <b>return</b> s)

handleEx :: MyException -> IO String
handleEx (NoParseException s) = return ("Illegal string: " ++ s)

main = catch (runPrompt myPrompt ()) handleEx >>= putStrLn

尽管更合适的方式可能是Prompt o i e = Prompt (o -> String) (String -> Either i e)。

- Ry-

---

啊，我现在明白了。所以异常只会传播到调用链中后续函数返回IO a的地方，是吗？虽然我希望将函数保持在Prompt内部纯净，但现在它可以工作了。但是解析始终容易出错，因此也许将其标记为IO是明智的选择。或者放置Either以保持纯度。 非常感谢。 :) - Sventimir