0

我试图在 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应该捕获异常。

4

2 回答 2

1

Daniel Fischer 关于tryIO您使用的是哪个问题是关键。也就是说，要么tryIO仅捕获 IO 异常等，在这种情况下，您应该使用来自的组合子Control.Exception，或者tryIO捕获多态异常，但您没有指定要捕获的异常，因此它默认为愚蠢的东西（如单元）并且您需要更加明确，或者以某种方式不会引发异常，但只有一个错误值隐藏在 sanitizeString 返回的 thunk 中，需要evaluate在块内强制（通过调用）try。

于 2013-02-05T00:45:05.957 回答
0

您需要捕获SourceError,GhcApiError和SomeExceptionusing 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
""
于 2014-05-21T08:30:20.533 回答