沉默GHC输出(stdout)

Question

我使用GHC来解析一个模块。如果模块包含语法错误，则GHC将它们写入stdout。这会干扰我的程序，这有另一种方法来报告错误。示例会话：

$ 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没有输出任何内容？我希望避免像silently这样的库，它通过将stdout重定向到一个临时文件来解决这个问题。

我已经尝试过使用GHC.defaultErrorHandler，但是虽然我可以捕获异常，但是GHC仍然会写到stdout。相关守则：

-- | 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为我指明了正确的方向！我在暗示的密码中找到了答案。

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

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