CODEWITHSUNDEEP
haskellerror-handlingstdoutghc
rubik
rubik

Reputation: 9104

Silencing GHC API output (stdout)

I'm using the GHC API to parse a module. If the module contains syntax errors the GHC API writes them to stdout. This interferes with my program, which has another way to report errors. Example session:

$ 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 one should be outputted. How can I make sure the GHC API does not output anything? I'd like to avoid libraries like silently which solve the problem by redirecting stdout to a temporary file.

I already tried to use GHC.defaultErrorHandler, but while I can catch the exception, GHC API still writes 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

Moreover, with this approach I cannot catch the error message (I just get ExitFailure). Removing the line with GHC.defaultErrorHandler gives me the output shown above.

Upvotes: 4

Views: 142

Answers (2)

rubik
rubik

Reputation: 9104

Many thanks to @adamse for pointing me in the right direction! I have found the answer in Hint's code.

It suffices to override logging in the dynamic flags:

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

The default implementation of GHC.log_action can be found here:
http://haddock.stackage.org/lts-3.10/ghc-7.10.2/src/DynFlags.html#defaultLogAction

The code for parsing remains the same in my question, after having removed the line about GHC.defaultErrorHandler, which is no longer needed, assuming one catches exceptions himself.

Upvotes: 2

ase
ase

Reputation: 13471

I have seen this question before and then the answer was to temporarily redirect stdout and stderr.

To redirect stdout to a file as an example:

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

Upvotes: 1

Related Questions