aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock.hs
diff options
context:
space:
mode:
authoralexbiehl-gc <72160047+alexbiehl-gc@users.noreply.github.com>2021-02-07 18:14:46 +0100
committerGitHub <noreply@github.com>2021-02-07 18:14:46 +0100
commit0f7ff041fb824653a7930e1292b81f34df1e967d (patch)
tree3e7f15ac3b0abe417797ec89275aa1209f6ca297 /haddock-api/src/Haddock.hs
parent9f597b6647a53624eaf501a34bfb4d8d15425929 (diff)
parent010f0320dff64e3f86091ba4691bc69ce6999647 (diff)
Merge pull request #1317 from bgamari/wip/ghc-head-merge
Merge ghc-8.10 into ghc-head
Diffstat (limited to 'haddock-api/src/Haddock.hs')
-rw-r--r--haddock-api/src/Haddock.hs17
1 files changed, 8 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 8bf932df..2b6e2d57 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,12 +69,12 @@ 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.Driver.Env
import GHC.Utils.Error
import GHC.Unit
import GHC.Utils.Panic (handleGhcException)
import GHC.Data.FastString
-import qualified GHC.Runtime.Loader
--------------------------------------------------------------------------------
-- * Exception handling
@@ -188,7 +190,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
@@ -430,7 +432,7 @@ render dflags unit_state flags sinceQual qual ifaces installedIfaces extSrcMap =
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 ()
@@ -477,10 +479,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''
- hsc_env <- GHC.getSession
- hsc_env'' <- liftIO (GHC.Runtime.Loader.initializePlugins hsc_env)
- _ <- GHC.setSession hsc_env''
- ghcActs (hsc_dflags hsc_env'')
+ ghcActs dynflags''
where
-- ignore sublists of flags that start with "+RTS" and end in "-RTS"
@@ -696,7 +695,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"