在 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 以这种方式注入异常处理功能，但对我来说似乎很难看。有更好的选择吗？

Answer 1

您遇到的问题是因为您在纯代码中抛出异常：throw 的类型是Exception e => e -> a。纯代码中的异常是不精确和do not guarantee ordering with respect to IO operations。所以catch 看不到纯粹的throw。要解决这个问题，您可以使用evaluate :: a -> IO a，它“可用于对其他 IO 操作进行排序评估”（来自文档）。 evaluate 类似于 return，但它同时强制进行评估。因此，您可以将 liftM ifun getLine 替换为 evaluate . 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 函数就可以正常工作了。

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 -> IO 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
        getLine >>= ifun

myPrompt :: Prompt o String
myPrompt = Prompt (const "> ") (\s -> if s == ""
    then throw $ NoParseException s
    else return 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) 可能更合适。