Question

我试图在snap中使用runGHC来过滤掉只能编译的代码。但是，我正在使用tryIO，但是当有编译错误而不是只返回一个空字符串时，我的webhandler仍会抛出异常。

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

解析ok的代码：

*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
""

在Snap中使用“runghc”而不是抛出webhandler异常。使用tryIO仍然会出错

2 个答案: