Merge commit '1e56f63c3197e7ca1c1e506e083c2bad25d08793' into ghc-9.0

1 files changed, 8 insertions, 9 deletions

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 63ceeb16..8dfee5bc 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -42,6 +42,8 @@ import Haddock.Utils
 import Haddock.GhcUtils (modifySessionDynFlags, setOutputDir)
 
 import Control.Monad hiding (forM_)
+import Control.Monad.IO.Class (MonadIO(..))
+import Data.Bifunctor (second)
 import Data.Foldable (forM_, foldl')
 import Data.Traversable (for)
 import Data.List (isPrefixOf)
@@ -53,9 +55,9 @@ import Data.Version (makeVersion)
 import qualified Data.Map as Map
 import System.IO
 import System.Exit
+import System.FilePath
 
 #ifdef IN_GHC_TREE
-import System.FilePath
 import System.Environment (getExecutablePath)
 #else
 import qualified GHC.Paths as GhcPaths
@@ -67,11 +69,11 @@ import Text.ParserCombinators.ReadP (readP_to_S)
 import GHC hiding (verbosity)
 import GHC.Settings.Config
 import GHC.Driver.Session hiding (projectVersion, verbosity)
+import GHC.Utils.Outputable (defaultUserStyle, withPprStyle)
 import GHC.Utils.Error
 import GHC.Unit
 import GHC.Utils.Panic (handleGhcException)
 import GHC.Data.FastString
-import qualified GHC.Runtime.Loader
 
 --------------------------------------------------------------------------------
 -- * Exception handling
@@ -181,7 +183,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do
     forM_ (optShowInterfaceFile flags) $ \path -> liftIO $ do
       mIfaceFile <- readInterfaceFiles freshNameCache [(("", Nothing), path)] noChecks
       forM_ mIfaceFile $ \(_, ifaceFile) -> do
-        putMsg dflags (renderJson (jsonInterfaceFile ifaceFile))
+        logOutput dflags $ withPprStyle defaultUserStyle (renderJson (jsonInterfaceFile ifaceFile))
 
     if not (null files) then do
       (packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files
@@ -424,7 +426,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
   when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do
     withTiming dflags' "ppHyperlinkedSource" (const ()) $ do
       _ <- {-# SCC ppHyperlinkedSource #-}
-           ppHyperlinkedSource odir libDir opt_source_css pretty srcMap ifaces
+           ppHyperlinkedSource (verbosity flags) odir libDir opt_source_css pretty srcMap ifaces
       return ()
 
 
@@ -471,10 +473,7 @@ withGhc' libDir needHieFiles flags ghcActs = runGhc (Just libDir) $ do
   -- that may need to be re-linked: Haddock doesn't do any
   -- dynamic or static linking at all!
   _ <- setSessionDynFlags dynflags''
-  hscenv <- GHC.getSession
-  dynflags''' <- liftIO (GHC.Runtime.Loader.initializePlugins hscenv dynflags'')
-  _ <- setSessionDynFlags dynflags'''
-  ghcActs dynflags'''
+  ghcActs dynflags''
   where
 
     -- ignore sublists of flags that start with "+RTS" and end in "-RTS"
@@ -690,7 +689,7 @@ getPrologue dflags flags =
       h <- openFile filename ReadMode
       hSetEncoding h utf8
       str <- hGetContents h -- semi-closes the handle
-      return . Just $! parseParas dflags Nothing str
+      return . Just $! second (fmap rdrName) $ parseParas dflags Nothing str
     _ -> throwE "multiple -p/--prologue options"