content: {-# LANGUAGE CPP, TemplateHaskell, RecordWildCards, ScopedTypeVariables #-}
  -- Copyright   : (c) JP Moresmau 2011,
  --                   Well-Typed 2012
  -- (JP Moresmau's buildwrapper package used as template for GHC API use)
  --
  -- | Implementation details of the calls to GHC that compute information
  -- based on source files, provides progress information while doing so
  -- and optionally compiles, links and executes code.
  --
  -- Only @IdeSession.GHC.Run@ and @IdeSession.GHC.HsWalk@ should import
  -- any modules from the ghc package and the modules should not be reexported
  -- anywhere else, with the exception of @IdeSession.GHC.Server@.
  module Run
    ( -- * Re-exported GHC API
      Ghc
    , runFromGhc
    , liftIO
    , GhcException
    , ghandle
    , ghandleJust
    , getModuleGraph
    , moduleNameString
    , ms_mod_name, ms_hs_date
      -- * Processing source files (including compilation)
    , compileInGhc
    , collectSrcError
    , DynamicOpts
    , submitStaticOpts
    , optsToDynFlags
    , DynFlags(hooks)
    , defaultDynFlags
    , getSessionDynFlags
    , setSessionDynFlags
    , parseDynamicFlags
    , hsExtensions
    , importList
    , autocompletion
      -- * Executing snippets
    , runInGhc
    , RunCmd(..)
    , RunResult(..)
    , RunBufferMode(..)
    , breakFromSpan
    , printVars
    ) where
  
  #define DEBUG 0
  
  import Prelude hiding (id, mod, span)
  import qualified Control.Exception as Ex
  import Control.Monad (filterM, liftM, void, when)
  import Control.Monad.Trans.Class (lift)
  import Control.Monad.Trans.Maybe (MaybeT(..))
  import Control.Applicative ((<$>))
  import Data.List ((\\))
  import Data.Maybe (catMaybes, listToMaybe)
  import Data.Text (Text)
  import Data.Array (Array)
  import qualified Data.Array as Array
  import qualified Data.Text as Text
  import System.FilePath.Find (find, always, extension)
  import System.Process
  import System.IO.Unsafe (unsafePerformIO)
  
  #if defined(GHC_761)
  -- http://hackage.haskell.org/trac/ghc/ticket/7548
  -- is not fixed in this version. Compilation should fail,
  -- because the problem is not minor and not easy to spot otherwise.
  #error "GHC 7.6.1 is broken (#7548) and not supported"
  #endif
  
  import Bag (bagToList)
  import DynFlags (defaultDynFlags)
  import Exception (ghandle)
  import ErrUtils (ErrMsg)
  import FastString (unpackFS, mkFastString)
  import GHC hiding (
      ModuleName
    , RunResult(..)
    , BreakInfo(..)
    , getBreak
    )
  import GhcMonad (liftIO)
  import OccName (occEnvElts)
  import Outputable (PprStyle, mkUserStyle)
  import RdrName (GlobalRdrEnv, GlobalRdrElt, gre_name)
  import RnNames (rnImports)
  import SrcLoc (mkRealSrcSpan, mkRealSrcLoc)
  import TcRnMonad (initTc)
  import TcRnTypes (RnM)
  import RtClosureInspect (Term)
  import qualified HscTypes
  import qualified GHC           as GHC
  import qualified Config        as GHC
  import qualified Outputable    as GHC
  import qualified ByteCodeInstr as GHC
  import qualified Id            as GHC
  
  #if __GLASGOW_HASKELL__ >= 706
  import ErrUtils   ( MsgDoc )
  #else
  import ErrUtils   ( Message )
  #endif
  
  import IdeSession.GHC.API
  import IdeSession.Types.Public (RunBufferMode(..), Targets(..))
  import IdeSession.Types.Private
  import qualified IdeSession.Types.Public as Public
  import IdeSession.Util
  import IdeSession.Util.PortableFiles (toExecutable)
  import IdeSession.Strict.Container
  import IdeSession.Strict.IORef
  import qualified IdeSession.Strict.List as StrictList
  import qualified IdeSession.Strict.Map  as StrictMap
  
  import HsWalk (idInfoForName)
  import Haddock
  import Debug
  import Conv
  import FilePathCaching
  import Break
  import GhcShim
  
  type DynamicOpts = [Located String]
  
  -- | Set static flags at server startup and return dynamic flags.
  submitStaticOpts :: [String] -> IO DynamicOpts
  submitStaticOpts opts = do
    (dynFlags, _) <- parseStaticFlags (map noLoc opts)
    return dynFlags
  
  -- | Create dynamic flags from their command-line names.
  optsToDynFlags :: [String] -> DynamicOpts
  optsToDynFlags = map noLoc
  
  getGhcLibdir :: IO FilePath
  getGhcLibdir = do
    let ghcbinary = toExecutable $ "ghc-" ++ GHC.cProjectVersion
    out <- readProcess ghcbinary ["--print-libdir"] ""
    case lines out of
      [libdir] -> return libdir
      _        -> fail "cannot parse output of ghc --print-libdir"
  
  runFromGhc :: Ghc a -> IO a
  runFromGhc a = do
    libdir <- getGhcLibdir
    runGhc (Just libdir) a
  
  -- | Version of handleJust for use in the GHC monad
  ghandleJust :: Ex.Exception e => (e -> Maybe b) -> (b -> Ghc a) -> Ghc a -> Ghc a
  ghandleJust p handler a = ghandle handler' a
    where
      handler' e = case p e of
                     Nothing -> liftIO $ Ex.throwIO e
                     Just b  -> handler b
  
  -- | Compile a set of targets
  --
  -- Returns the errors, loaded modules, and mapping from filenames to modules
  compileInGhc :: FilePath            -- ^ target directory, only used for 'TargetsExclude'
               -> Bool                -- ^ should we generate code
               -> Targets             -- ^ targets
               -> StrictIORef (Strict [] SourceError) -- ^ the IORef where GHC stores errors
               -> Ghc ( Strict [] SourceError
                      , [ModuleName]
                      , Strict (Map FilePath) ModuleId
                      )
  compileInGhc configSourcesDir generateCode mTargets errsRef = do
      -- Reset errors storage.
      liftIO $ writeIORef errsRef StrictList.nil
      -- Compute new GHC flags.
      flags1 <- getSessionDynFlags
      -- Let GHC API print "compiling M ... done." for each module.
      let verbosityNew :: Int
          verbosityNew = 1
          (hscTargetNew, ghcLinkNew)
            | generateCode = (HscInterpreted, LinkInMemory)
            | otherwise    = (HscNothing,     NoLink)
          flagsNeedChange = hscTargetNew /= hscTarget flags1
                            || ghcLinkNew /= ghcLink flags1
                            || verbosityNew /= verbosity flags1
          flags = flags1 {
                           hscTarget = hscTargetNew,
                           ghcLink = ghcLinkNew,
                           verbosity = verbosityNew
                         }
      handleErrors flags $ do
        defaultCleanupHandler flags $ do
          -- Set up the GHC flags.
          when flagsNeedChange $ void $ setSessionDynFlags flags
          setTargets =<< computeTargets
          void $ load LoadAllTargets
  
      -- Collect info
      errs    <- liftIO $ readIORef errsRef
      loaded  <- getLoaded
      fileMap <- getFileMap
      return ( StrictList.reverse errs
             , loaded
             , StrictMap.fromList $ fileMap
             )
    where
      getLoaded :: Ghc [ModuleName]
      getLoaded = do
        graph <- getModuleGraph
        names <- filterM isLoaded $ map ms_mod_name graph
        return $ map (Text.pack . moduleNameString) names
  
      getFileMap :: Ghc [(FilePath, ModuleId)]
      getFileMap = do
          dflags <- getSessionDynFlags
          let aux :: ModSummary -> Maybe (FilePath, ModuleId)
              aux summary = do
                hs <- ml_hs_file $ ms_location summary
                return (hs, importModuleId dflags (ms_mod summary))
          graph <- getModuleGraph
          return $ catMaybes $ map aux graph
  
      computeTargets :: Ghc [Target]
      computeTargets = do
        targetIds <- case mTargets of
          TargetsInclude include -> return (map targetIdFromFile include)
          TargetsExclude exclude -> liftIO $ do
            allPaths <- find always ((`elem` hsExtensions) `liftM` extension)
                                    configSourcesDir
            let paths = allPaths \\ exclude
            return (map targetIdFromFile paths)
        return (map targetWithId targetIds)
  
      targetWithId :: TargetId -> Target
      targetWithId targetId = Target {
          targetId           = targetId
        , targetAllowObjCode = True
        , targetContents     = Nothing
        }
  
      targetIdFromFile :: FilePath -> TargetId
      targetIdFromFile path = TargetFile path Nothing
  
      sourceErrorHandler :: DynFlags -> HscTypes.SourceError -> Ghc ()
      sourceErrorHandler _flags e = liftIO $ do
        debug dVerbosity $ "handleSourceError: " ++ show e
        errs <- readIORef errsRef
        e'   <- fromHscSourceError e
        writeIORef errsRef (force e' StrictList.++ errs)
  
      -- A workaround for http://hackage.haskell.org/trac/ghc/ticket/7430.
      -- Some errors are reported as exceptions instead.
      ghcExceptionHandler :: DynFlags -> GhcException -> Ghc ()
      ghcExceptionHandler _flags e = liftIO $ do
        let eText   = Text.pack $ show e  -- no SrcSpan as a field in GhcException
            fromEx  = Text.pack $ "<from GhcException>"
            exError = SourceError KindError (TextSpan fromEx) eText
              -- though it may be embedded in string
        debug dVerbosity $ "handleOtherErrors: " ++ Text.unpack eText
        errs <- readIORef errsRef
        writeIORef errsRef (exError `StrictList.cons` errs)
  
      handleErrors :: DynFlags -> Ghc () -> Ghc ()
      handleErrors flags = ghandle (ghcExceptionHandler flags)
                         . handleSourceError (sourceErrorHandler flags)
  
  importList :: ModSummary -> Ghc (Strict [] Import)
  importList summary = do
    dflags  <- getSessionDynFlags
  
    -- TODO: This is lossy. We might want a more accurate data type.
    let unLIE :: LIE RdrName -> Text
        unLIE (L _ name) = Text.pack $ pretty dflags GHC.defaultUserStyle name
  
  #if __GLASGOW_HASKELL__ >= 710
    let unLocNames :: Located [LIE name] -> [LIE name]
        unLocNames (L _ names) = names
  #else
    let unLocNames :: [LIE name] -> [LIE name]
        unLocNames names = names
  #endif
  
  #if __GLASGOW_HASKELL__ >= 710
    let mkImportEntities :: Maybe (Bool, Located [LIE RdrName]) -> ImportEntities
  #else
    let mkImportEntities :: Maybe (Bool, [LIE RdrName]) -> ImportEntities
  #endif
        mkImportEntities Nothing               = ImportAll
        mkImportEntities (Just (True, names))  = ImportHiding (force $ map unLIE (unLocNames names))
        mkImportEntities (Just (False, names)) = ImportOnly   (force $ map unLIE (unLocNames names))
  
    let goImp :: Located (ImportDecl RdrName) -> Import
        goImp (L _ decl) = Import {
            importModule    = importModuleId' dflags (ideclPkgQual decl) (unLoc (ideclName decl))
          , importPackage   = force $ ((Text.pack . unpackFS) <$> ideclPkgQual decl)
          , importQualified = ideclQualified decl
          , importImplicit  = ideclImplicit decl
          , importAs        = force $ ((Text.pack . moduleNameString) <$> ideclAs decl)
          , importEntities  = mkImportEntities (ideclHiding decl)
          }
  
    return . force $ map goImp (ms_srcimps summary)
                  ++ map goImp (ms_textual_imps summary)
  
  autocompletion :: ModSummary -> Ghc (Strict [] IdInfo)
  autocompletion summary = do
    dflags  <- getSessionDynFlags
    session <- getSession
  
    let pkgDeps = pkgDepsFromModSummary dflags summary
    linkEnv <- liftIO $ linkEnvForDeps dflags pkgDeps
  
    let eltsToAutocompleteMap :: GlobalRdrElt -> Ghc IdInfo
        eltsToAutocompleteMap elt = do
          let name          = gre_name elt
              currentModule = Nothing -- Must be imported (TH stage restriction)
          (idProp, Just idScope) <- idInfoForName dflags
                                                  name
                                                  UseSite
                                                  (Just elt)
                                                  currentModule
                                                  (homeModuleFor dflags linkEnv)
          return IdInfo{..}
  
        autoEnvs :: ModSummary -> IO [GlobalRdrElt]
        autoEnvs ms@ModSummary{ ms_mod
                                   , ms_hsc_src
                                   , ms_srcimps
                                   , ms_textual_imps
                                   } = do
          let go :: RnM (a, GlobalRdrEnv, b, c) -> IO [GlobalRdrElt]
              go op = do
  #if GHC_AFTER_710_1
                -- Not sure if this is the same thing that GHC would
                -- pass in, but this is just to initialize the state,
                -- and will be overridden before any uses.
                let srcSpan = mkRealSrcSpan loc loc
                    loc = mkRealSrcLoc (mkFastString (HscTypes.msHsFilePath ms)) 1 1
                ((_warns, _errs), res) <- initTc session ms_hsc_src False ms_mod srcSpan op
  #else
                ((_warns, _errs), res) <- initTc session ms_hsc_src False ms_mod op
  #endif
                case res of
                  Nothing -> do
                    -- TODO: deal with import errors
  #if DEBUG
                    appendFile "/tmp/ghc.importerrors" $ show
                                                       . map GHC.showSDoc
                                                       $ ErrUtils.pprErrMsgBag _errs
  #endif
                    return []
                  Just (_, elts, _, _) ->
                    return . concat $ occEnvElts elts
          env1 <- go $ rnImports ms_srcimps
          env2 <- go $ rnImports ms_textual_imps
          return $ env1 ++ env2
  
    envs    <- liftIO $ autoEnvs summary
    idIs    <- mapM eltsToAutocompleteMap envs
    return $ force idIs
  
  -- | Run a snippet.
  runInGhc :: RunCmd -> Ghc RunResult
  runInGhc cmd = do
    flags <- getSessionDynFlags
    defaultCleanupHandler flags . handleErrors $ do
        runRes <- runCmd cmd
        case runRes of
          GHC.RunOk _ ->
            return RunOk
          GHC.RunException ex ->
            return $ RunProgException (showExWithClass ex)
          GHC.RunBreak _tid names mBreakInfo -> do
            Just info <- importBreakInfo mBreakInfo names
            return $ RunBreak info
    where
      handleError :: Show a => a -> Ghc RunResult
      handleError = return . RunGhcException . show
  
      -- "such-and-such not in scope" is reported as a source error
      -- not sure when GhcExceptions are thrown (if at all)
      handleErrors :: Ghc RunResult -> Ghc RunResult
      handleErrors = handleSourceError handleError
                   . ghandle (handleError :: GhcException -> Ghc RunResult)
  
  -- | Auxiliary to 'runInGhc'
  runCmd :: RunCmd -> Ghc GHC.RunResult
  runCmd (RunStmt {..}) = do
      setContext $ [ IIDecl $ simpleImportDecl $ mkModuleName runCmdModule
                   , IIDecl $ simpleImportDecl $ mkModuleName "IdeBackendRTS"
                   ]
      runStmt expr RunToCompletion
    where
      expr :: String
      expr = fqn "run "
          ++ "(" ++ fqBMode runCmdStdout ++ ")"
          ++ "(" ++ fqBMode runCmdStderr ++ ")"
          ++ "(" ++ runCmdModule ++ "." ++ runCmdFunction ++ ")"
  
      fqn :: String -> String
      fqn = (++) "IdeBackendRTS."
  
      fqBMode :: RunBufferMode -> String
      fqBMode RunNoBuffering =
        fqn "RunNoBuffering"
      fqBMode (RunLineBuffering t) =
        fqn "RunLineBuffering (" ++ fqMInt t ++ ")"
      fqBMode (RunBlockBuffering sz t) =
        fqn "RunBlockBuffering (" ++ fqMInt sz ++ ") (" ++ fqMInt t ++ ")"
  
      fqMInt :: Maybe Int -> String
      fqMInt Nothing  = fqn "Nothing"
      fqMInt (Just n) = fqn "Just " ++ show n
  runCmd Resume =
      resume (const True) RunToCompletion
  
  {------------------------------------------------------------------------------
    Dealing with breakpoints
  ------------------------------------------------------------------------------}
  
  -- | We store a print context whenever we hit a breakpoint so that we have
  -- sufficient context for subsequent requests for pretty-printing types
  printContext :: StrictIORef PprStyle
  {-# NOINLINE printContext #-}
  printContext = unsafePerformIO $
    newIORef (mkUserStyle alwaysQualify GHC.AllTheWay)
  
  getPrintContext :: Ghc PprStyle
  getPrintContext = liftIO $ readIORef printContext
  
  setPrintContext :: PprStyle -> Ghc ()
  setPrintContext ctxt = liftIO $ writeIORef printContext ctxt
  
  breakFromSpan :: ModuleName        -- ^ Module containing the breakpoint
                -> Public.SourceSpan -- ^ Location of the breakpoint
                -> Bool              -- ^ New value for the breakpoint
                -> Ghc (Maybe Bool)    -- ^ Old valeu of the breakpoint (if valid)
  breakFromSpan modName span newValue = runMaybeT $ do
      modInfo <- MaybeT $ getModuleInfo mod
      let ModBreaks{..} = modInfoModBreaks modInfo
  
      breakIndex <- MaybeT $ return $ findBreakIndex modBreaks_locs
      oldValue   <- MaybeT $ getBreak modBreaks_flags breakIndex
  
      lift $ setBreak modBreaks_flags breakIndex newValue
      return oldValue
    where
      findBreakIndex :: Array BreakIndex SrcSpan -> Maybe BreakIndex
      findBreakIndex breaks = listToMaybe
                            . catMaybes
                            . map matchesSpan
                            . Array.assocs
                            $ breaks
  
      matchesSpan :: (BreakIndex, SrcSpan) -> Maybe BreakIndex
      matchesSpan (_, UnhelpfulSpan _) = Nothing
      matchesSpan (i, RealSrcSpan span') =
        if  srcSpanStartLine span' == Public.spanFromLine   span
         && srcSpanStartCol  span' == Public.spanFromColumn span
         && srcSpanEndLine   span' == Public.spanToLine     span
         && srcSpanEndCol    span' == Public.spanToColumn   span
        then Just i
        else Nothing
  
      mod :: Module
      mod = mkModule mainPackageKey (mkModuleName . Text.unpack $ modName)
  
  importBreakInfo :: Maybe GHC.BreakInfo
                  -> [Name]
                  -> Ghc (Maybe BreakInfo)
  importBreakInfo (Just GHC.BreakInfo{..}) names = runMaybeT $ do
      modInfo          <- MaybeT $ getModuleInfo breakInfo_module
      printUnqualified <- MaybeT $ mkPrintUnqualifiedForModule modInfo
  
      let ModBreaks{..} = modInfoModBreaks modInfo
          srcSpan       = modBreaks_locs Array.! breakInfo_number
          pprStyle      = mkUserStyle printUnqualified GHC.AllTheWay
  
      lift $ do
        setPrintContext pprStyle
  
        localVars           <- mkTerms >>= mapM (exportVar pprStyle)
        ProperSpan srcSpan' <- liftIO $ extractEitherSpan srcSpan
        prettyResTy         <- prettyM pprStyle breakInfo_resty
  
        return BreakInfo {
            breakInfoModule      = mod
          , breakInfoSpan        = srcSpan'
          , breakInfoResultType  = Text.pack prettyResTy
          , breakInfoVariableEnv = localVars
          }
    where
      mkTerms :: Ghc [(Id, Term)]
      mkTerms = resolveNames names >>= evaluateIds False False
  
      -- we ignore the package (because it's always the home package)
      mod = Text.pack . moduleNameString . GHC.moduleName $ breakInfo_module
  importBreakInfo Nothing _names = error "importBreakInfo: missing case"
  
  printVars :: String -> Bool -> Bool -> Ghc Public.VariableEnv
  printVars vars bind forceEval =
    getPrintContext            >>= \unqual ->
    parseNames vars            >>=
    resolveNames               >>=
    evaluateIds bind forceEval >>=
    mapM (exportVar unqual)
  
  exportVar :: PprStyle -> (Id, Term) -> Ghc (Public.Name, Public.Type, Public.Value)
  exportVar pprStyle (var, term) = do
      nameStr <- prettyM     pprStyle             (GHC.idName var)
      typeStr <- prettyTypeM pprStyle showForalls (GHC.idType var)
      termStr <- prettyM     pprStyle             term
      return (Text.pack nameStr, Text.pack typeStr, Text.pack termStr)
    where
      showForalls  = False
  
  -----------------------
  -- Source error conversion and collection
  --
  
  collectSrcError :: StrictIORef (Strict [] SourceError)
                  -> (String -> IO ())
                  -> (String -> IO ())
                  -> DynFlags
                  -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
  collectSrcError errsRef handlerOutput handlerRemaining flags
                  severity srcspan style msg = do
    -- Prepare debug prints.
    debug dVerbosity
     $  "Severity: "   ++ show severity
     ++ "  SrcSpan: "  ++ show srcspan
  -- ++ "  PprStyle: " ++ show style
     ++ "  MsgDoc: "
     ++ showSDocForUser flags (queryQual style) msg
     ++ "\n"
    -- Actually collect errors.
    collectSrcError'
      errsRef handlerOutput handlerRemaining flags severity srcspan style msg
  
  collectSrcError' :: StrictIORef (Strict [] SourceError)
                   -> (String -> IO ())
                   -> (String -> IO ())
                   -> DynFlags
                   -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
  collectSrcError' errsRef _ _ flags severity srcspan style msg
    | Just errKind <- case severity of
                        SevWarning -> Just KindWarning
                        SevError   -> Just KindError
                        SevFatal   -> Just KindError
                        _          -> Nothing
    = do let msgstr = showSDocForUser flags (queryQual style) msg
         sp <- extractEitherSpan srcspan
         modifyIORef errsRef (StrictList.cons $ SourceError errKind sp (Text.pack msgstr))
  
  collectSrcError' _errsRef handlerOutput _ flags SevOutput _srcspan style msg
    = let msgstr = showSDocForUser flags (queryQual style) msg
       in handlerOutput msgstr
  
  collectSrcError' _errsRef _ handlerRemaining flags _severity _srcspan style msg
    = let msgstr = showSDocForUser flags (queryQual style) msg
       in handlerRemaining msgstr
  
  -- TODO: perhaps make a honest SrcError from the first span from the first
  -- error message and put the rest into the message string? That probably
  -- entains string-search-and-replace inside the message string not to
  -- duplicate the first span, because the types involved are abstract.
  -- And even then, all the file paths but the first would be out of
  -- our control (and so, e.g., not relative to the project root).
  -- But at least the IDE could point somewhere in the code.
  -- | Convert GHC's SourceError type into ours.
  fromHscSourceError :: forall m. MonadFilePathCaching m => HscTypes.SourceError -> m [SourceError]
  fromHscSourceError = mapM aux . bagToList . HscTypes.srcErrorMessages
    where
      aux :: ErrMsg -> m SourceError
      aux e = do
        let err   = Text.pack (show e)
            noloc = Text.pack "<no location info>"
  
        case sourceErrorSpan e of
          Just real -> do
            xSpan <- extractEitherSpan real
            return $ SourceError KindError xSpan err
          Nothing ->
            return $ SourceError KindError (TextSpan noloc) err
  
  -----------------------
  -- GHC version compat
  --
  
  #if __GLASGOW_HASKELL__ < 706
  type MsgDoc = Message
  #endif
  
  showSDocForUser :: DynFlags -> PrintUnqualified -> MsgDoc -> String
  #if __GLASGOW_HASKELL__ >= 706
  showSDocForUser  flags uqual msg = GHC.showSDocForUser flags uqual msg
  #else
  showSDocForUser _flags uqual msg = GHC.showSDocForUser       uqual msg
  #endif
  
  showSDocDebug :: DynFlags -> MsgDoc -> String
  #if __GLASGOW_HASKELL__ >= 706
  showSDocDebug  flags msg = GHC.showSDocDebug flags msg
  #else
  showSDocDebug _flags msg = GHC.showSDocDebug        msg
  #endif
  
  queryQual :: PprStyle -> PrintUnqualified
  #if __GLASGOW_HASKELL__ >= 710
  queryQual = GHC.queryQual
  #else
  queryQual style = (GHC.qualName style, GHC.qualModule style)
  #endif
  
  
  -----------------------
  -- Debug
  --
  
  _debugPpContext :: DynFlags -> String -> Ghc ()
  _debugPpContext flags msg = do
    context <- getContext
    liftIO $ debug dVerbosity
      $ msg ++ ": " ++ showSDocDebug flags (GHC.ppr context)
  