静音 GHC API 输出 (stdout)

Question

我正在使用 GHC API 来解析模块。如果模块包含语法错误，GHC API 会将它们写入标准输出。这会干扰我的程序，它有另一种报告错误的方式。示例会话：

$ prog ../stack/src/Stack/Package.hs

../stack/src/Stack/Package.hs:669:0:
     error: missing binary operator before token "("
     #if MIN_VERSION_Cabal(1, 22, 0)
     ^

../stack/src/Stack/Package.hs:783:0:
     error: missing binary operator before token "("
     #if MIN_VERSION_Cabal(1, 22, 0)
     ^
../stack/src/Stack/Package.hs
    error: 1:1 argon: phase `C pre-processor' failed (exitcode = 1)

应该只输出最后一个。如何确保 GHC API 不输出任何内容？我想避免像 silently 这样的库，它们通过将 stdout 重定向到临时文件来解决问题。

我已经尝试使用GHC.defaultErrorHandler，但是虽然我可以捕捉到异常，但 GHC API 仍然会写入标准输出。相关代码：

-- | Parse a module with specific instructions for the C pre-processor.
parseModuleWithCpp :: CppOptions
                   -> FilePath
                   -> IO (Either (Span, String) LModule)
parseModuleWithCpp cppOptions file =
  GHC.defaultErrorHandler GHC.defaultFatalMessager (GHC.FlushOut $ return ()) $
    GHC.runGhc (Just libdir) $ do
      dflags <- initDynFlags file
      let useCpp = GHC.xopt GHC.Opt_Cpp dflags
      fileContents <-
        if useCpp
          then getPreprocessedSrcDirect cppOptions file
          else GHC.liftIO $ readFile file
      return $
        case parseFile dflags file fileContents of
          GHC.PFailed ss m -> Left (srcSpanToSpan ss, GHC.showSDoc dflags m)
          GHC.POk _ pmod   -> Right pmod

此外，使用这种方法我无法捕获错误消息（我只收到ExitFailure）。删除带有GHC.defaultErrorHandler 的行会给我上面显示的输出。

Answer 1

非常感谢 @adamse 为我指明了正确的方向！我在 Hint 的代码中找到了答案。

覆盖动态标志中的日志记录就足够了：

initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
initDynFlags file = do
    dflags0 <- GHC.getSessionDynFlags
    src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file
    (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 src_opts
    let dflags2 = dflags1 { GHC.log_action = customLogAction }
    void $ GHC.setSessionDynFlags dflags2
    return dflags2

customLogAction :: GHC.LogAction
customLogAction dflags severity _ _ msg =
    case severity of
      GHC.SevFatal -> fail $ GHC.showSDoc dflags msg
      _            -> return ()  -- do nothing in the other cases (debug, info, etc.)

GHC.log_action 的默认实现可以在这里找到：
http://haddock.stackage.org/lts-3.10/ghc-7.10.2/src/DynFlags.html#defaultLogAction

在我删除了关于GHC.defaultErrorHandler 的行之后，我的问题中的解析代码保持不变，这不再需要，假设一个人自己捕获了异常。

Answer 2

我之前看到过这个问题，然后答案是暂时重定向stdout和stderr。

以将stdout重定向到一个文件为例：

import GHC.IO.Handle
import System.IO

main = do file <- openFile "stdout" WriteMode
          stdout' <- hDuplicate stdout -- you might want to keep track
                                       -- of the original stdout
          hDuplicateTo file stdout -- makes the second Handle a
                                   -- duplicate of the first
          putStrLn "hi"
          hClose file