在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

你遇到的问题是因为你在纯代码中抛出异常:throwis 的类型Exception e => e -> a.纯代码中的异常是不精确的,并且不保证对IO操作的排序.所以catch看不到纯洁throw.要解决这个问题,您可以使用evaluate :: a -> IO a"可用于订购与其他IO操作相关的评估"(来自文档). evaluate就像回归一样,但它同时强制进行评估.因此,你可以替换liftM ifun getLine使用 evaluate . ifun =<< getline,这迫使ifun过程中已被评估runPrompt IO行动.(回想一下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功能将正常工作.