haskell - 在 happstack 中捕获纯函数的异常

Question

我找不到真正的方法来捕获 happstack 应用程序中纯函数引发的异常。我试过this solution 。当 IO 函数抛出异常时，它可以很好地工作。但是当纯函数抛出异常时它无法处理它。我的代码:

{-# LANGUAGE DeriveDataTypeable #-}

module Main where

import Prelude hiding(catch)
import Control.Monad    (msum, mzero, join)
import Control.Monad.IO.Class(liftIO)
import Happstack.Server
import Text.JSON.Generic
import qualified Data.ByteString.Char8 as B

import Control.Exception

data Res = Res {res :: String, err :: String} deriving (Data, Typeable)

evaluateIt :: Res
evaluateIt = throw (ErrorCall "Something goes wrong!")

somethingWrong :: IO Response
somethingWrong = return $ toResponse $ encodeJSON $ evaluateIt

errorHandler :: SomeException -> ServerPart Response
errorHandler e = ok $ setHeaderBS (B.pack "Content-Type") (B.pack "application/json") $ toResponse $ encodeJSON $ Res {err = show e, res = ""}

indexHTML = tryIO (Just errorHandler) somethingWrong

main :: IO ()
main = do
    simpleHTTP nullConf $ msum [ indexHTML ]

tryIO :: Maybe (SomeException -> ServerPart Response)
         -> IO a
         -> ServerPart a
tryIO mf io = do result <- liftIO $ try io
                 case (result) of Right good -> return good
                                  Left exception -> handle exception mf
      where handle exception (Just handler) = escape $ handler exception
            handle _ Nothing = mzero

我哪里错了？

Answer 1

这是因为return和toResponse的惰性。上线了

tryIO mf io = do result <- liftIO $ try io

somethingWrong 根本不被评估，而您的异常更深一些(在响应内的惰性字节字符串内)，导致它转义了 中的 try tryIO 并在后者未处理的情况下引发。通常，纯代码中的错误可能仅在计算为 NF 时才被捕获，在您的情况下是在 main 之上。