Disabling GHC API output (stdout)

Question

I use the GHC API to parse the module. If the module contains syntax errors, the GHC API writes them to stdout. This interferes with my program, which has a different way of reporting bugs. Session Example:

$ 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)

Only the last should be displayed. How can I make sure the GHC API does not output anything? I would like to avoid libraries like the ones silentlythat solve the problem by redirecting stdout to a temporary file.

I already tried to use it GHC.defaultErrorHandler, but so far I can catch the exception, the GHC API is still writing to stdout. Relevant Code:

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

Also, with this approach, I cannot catch the error message (I just get it ExitFailure). Deleting a line using GHC.defaultErrorHandlergives me the result shown above.

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