在Snap中使用“ runghc”，而不抛出Webhandler异常。 使用tryIO仍然会出现错误

Question

我正在尝试在snap内使用runGHC来仅过滤出可以编译的代码。 但是，我正在使用tryIO，但是当出现编译错误而不是仅返回空String时，我的Web处理程序仍然会引发异常。

import           Exception (tryIO)

...

runOnFileName :: String -> IO (String)
runOnFileName inp = do
   res <- sanitizeSource inp
   case res of
       Just (code, _, _, _)    -> return $ ppr code
       Nothing                 -> return ""

sanitizeSourceString :: String -> String -> IO (String)
sanitizeSourceString fn contents = do
  tmpdir <- getTemporaryDirectory
  let tmp = tmpdir </> fn ++ ".hs"
  exists <- doesFileExist tmp
  unless exists $ writeFile tmp $ contents
  runOnFileName tmp


sanitizeSource :: String -> IO (Maybe RenamedSource)
sanitizeSource inp =  do 
      runGhc (Just libdir) $ do
        dflags <- getSessionDynFlags
        let dflags' = foldl xopt_set dflags
                            [Opt_Cpp, Opt_ImplicitPrelude, Opt_MagicHash]
        setSessionDynFlags dflags
        target <- guessTarget inp Nothing
        setTargets [target]
        load LoadAllTargets
        modSum <- getModSummary $ mkModuleName "Main"
        p <- parseModule modSum
        t <- typecheckModule p
        d <- desugarModule t
        return $ renamedSource d



... in my handler...
eitherSan <- liftIO $ tryIO $ sanitizeSourceString (T.unpack uuid) (fromMaybe "" content)
let sanitized = case eitherSan of
    Left _ -> ""
    Right r -> r

但是，如果我传递未编译的“内容”，则处理程序将失败并显示

 A web handler threw an exception. Details Parse error: naked expression at top level

或任何编译器错误。 我以为tryIO应该捕获异常。

Answer 1

Daniel Fischer的问题是您正在使用哪个tryIO 。 就是说， tryIO仅捕获IO异常等，在这种情况下，您应该使用Control.Exception的组合器，或者tryIO捕获多态异常，但是您没有指定要捕获的异常，因此它默认为某种东西愚蠢（像单元）一样，您需要更明确，或者某种程度上，不会引发异常，但是在sanitizeString返回的thunk中仅隐藏了一个错误值，需要在（内部）强制（通过调用evaluate ） try阻止。

Answer 2

你需要捕捉SourceError ， GhcApiError和SomeException使用gcatch 。 这是您的代码的独立版本：

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad
import GHC
import GHC.Paths ( libdir )
import DynFlags
import Outputable
import System.FilePath
import System.Directory

import Control.Exception (SomeException)
import HscTypes (SourceError, GhcApiError)

runOnFileName :: String -> IO (String)
runOnFileName inp = do
   res <- sanitizeSource inp
   case res of
       Just (code, _, _, _)    -> return $ showSDoc tracingDynFlags (ppr code)
       Nothing                 -> return ""

sanitizeSourceString :: String -> String -> IO (String)
sanitizeSourceString fn contents = do
  tmpdir <- getTemporaryDirectory
  let tmp = tmpdir </> fn ++ ".hs"
  exists <- doesFileExist tmp
  unless exists $ writeFile tmp $ contents
  runOnFileName tmp

sanitizeSource :: String -> IO (Maybe RenamedSource)
sanitizeSource inp = (sanitizeSource' inp)
   `gcatch` (\(e  :: SourceError)   -> return Nothing)
   `gcatch` (\(g  :: GhcApiError)   -> return Nothing)
   `gcatch` (\(se :: SomeException) -> return Nothing)

sanitizeSource' :: String -> IO (Maybe RenamedSource)
sanitizeSource' inp =  do
      runGhc (Just libdir) $ do
        dflags <- getSessionDynFlags
        let dflags' = foldl xopt_set dflags
                            [Opt_Cpp, Opt_ImplicitPrelude, Opt_MagicHash]
        setSessionDynFlags dflags
        target <- guessTarget inp Nothing
        setTargets [target]
        load LoadAllTargets
        modSum <- getModSummary $ mkModuleName "Main"
        p <- parseModule modSum
        t <- typecheckModule p
        d <- desugarModule t
        return $ renamedSource d

eg1 = "module Main where\n\nf x = x + 1\n\nmain = undefined\n" -- will compile
eg2 = "module Main where\n\nf = x + 1\n\nmain = undefined\n"   -- won't compile

会话示例：

*Main> :!rm -v /tmp/*hs

可以解析的代码：

*Main> r1 <- sanitizeSourceString "fn_eg1" eg1
*Main> r1
"Main.f x = x GHC.Num.+ 1\nMain.main = GHC.Err.undefined"

现在，无法解析的代码。 打印了一个错误，但是r2确实获得了空字符串，因此正确捕获了异常：

*Main> r2 <- sanitizeSourceString "fn_eg2" eg2

/tmp/fn_eg2.hs:3:5: Not in scope: `x'
*Main> r2
""