我找不到真正的方法来捕获 happstack 应用程序中纯函数抛出的异常。我试过这个解决方案。当 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
我哪里错了?