aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock.hs17
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs3
-rw-r--r--haddock-api/src/Haddock/Interface.hs14
-rw-r--r--haddock-api/src/Haddock/Parser.hs2
4 files changed, 19 insertions, 17 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index d955ae4f..9158d83c 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -69,8 +69,10 @@ import Text.ParserCombinators.ReadP (readP_to_S)
import GHC hiding (verbosity)
import GHC.Settings.Config
import GHC.Driver.Session hiding (projectVersion, verbosity)
+import GHC.Driver.Config.Logger (initLogFlags)
import GHC.Driver.Env
import GHC.Utils.Error
+import GHC.Utils.Logger
import GHC.Types.Name.Cache
import GHC.Unit
import GHC.Utils.Panic (handleGhcException)
@@ -192,7 +194,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do
name_cache <- freshNameCache
mIfaceFile <- readInterfaceFiles name_cache [(("", Nothing), path)] noChecks
forM_ mIfaceFile $ \(_, ifaceFile) -> do
- putMsg logger dflags $ renderJson (jsonInterfaceFile ifaceFile)
+ putMsg logger $ renderJson (jsonInterfaceFile ifaceFile)
if not (null files) then do
(packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files
@@ -282,7 +284,7 @@ renderStep logger dflags unit_state flags sinceQual nameQual pkgs interfaces = d
-- | Render the interfaces with whatever backend is specified in the flags.
render :: Logger -> DynFlags -> UnitState -> [Flag] -> SinceQual -> QualOption -> [Interface]
-> [InstalledInterface] -> Map Module FilePath -> IO ()
-render logger dflags unit_state flags sinceQual qual ifaces installedIfaces extSrcMap = do
+render log' dflags unit_state flags sinceQual qual ifaces installedIfaces extSrcMap = do
let
title = fromMaybe "" (optTitle flags)
@@ -298,6 +300,7 @@ render logger dflags unit_state flags sinceQual qual ifaces installedIfaces extS
dflags'
| unicode = gopt_set dflags Opt_PrintUnicodeSyntax
| otherwise = dflags
+ logger = setLogFlags log' (initLogFlags dflags')
visibleIfaces = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ]
@@ -372,7 +375,7 @@ render logger dflags unit_state flags sinceQual qual ifaces installedIfaces extS
let withQuickjump = Flag_QuickJumpIndex `elem` flags
when (Flag_GenIndex `elem` flags) $ do
- withTiming logger dflags' "ppHtmlIndex" (const ()) $ do
+ withTiming logger "ppHtmlIndex" (const ()) $ do
_ <- {-# SCC ppHtmlIndex #-}
ppHtmlIndex odir title pkgStr
themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls
@@ -382,7 +385,7 @@ render logger dflags unit_state flags sinceQual qual ifaces installedIfaces extS
copyHtmlBits odir libDir themes withQuickjump
when (Flag_GenContents `elem` flags) $ do
- withTiming logger dflags' "ppHtmlContents" (const ()) $ do
+ withTiming logger "ppHtmlContents" (const ()) $ do
_ <- {-# SCC ppHtmlContents #-}
ppHtmlContents unit_state odir title pkgStr
themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
@@ -392,7 +395,7 @@ render logger dflags unit_state flags sinceQual qual ifaces installedIfaces extS
copyHtmlBits odir libDir themes withQuickjump
when (Flag_Html `elem` flags) $ do
- withTiming logger dflags' "ppHtml" (const ()) $ do
+ withTiming logger "ppHtml" (const ()) $ do
_ <- {-# SCC ppHtml #-}
ppHtml unit_state title pkgStr visibleIfaces reexportedIfaces odir
prologue
@@ -427,14 +430,14 @@ render logger dflags unit_state flags sinceQual qual ifaces installedIfaces extS
]
when (Flag_LaTeX `elem` flags) $ do
- withTiming logger dflags' "ppLatex" (const ()) $ do
+ withTiming logger "ppLatex" (const ()) $ do
_ <- {-# SCC ppLatex #-}
ppLaTeX title pkgStr visibleIfaces odir (fmap _doc prologue) opt_latex_style
libDir
return ()
when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do
- withTiming logger dflags' "ppHyperlinkedSource" (const ()) $ do
+ withTiming logger "ppHyperlinkedSource" (const ()) $ do
_ <- {-# SCC ppHyperlinkedSource #-}
ppHyperlinkedSource (verbosity flags) odir libDir opt_source_css pretty srcMap ifaces
return ()
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
index 94395218..49e2c66f 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
@@ -10,6 +10,7 @@ import Data.List ( isPrefixOf, isSuffixOf )
import qualified Data.ByteString as BS
+import GHC.Platform
import GHC.Types.SourceText
import GHC.Driver.Session
import GHC.Utils.Error ( mkPlainMsgEnvelope, pprLocMsgEnvelope )
@@ -49,9 +50,11 @@ parse dflags fpath bs = case unP (go False []) initState of
initState = initParserState pflags buf start
buf = stringBufferFromByteString bs
start = mkRealSrcLoc (mkFastString fpath) 1 1
+ arch_os = platformArchOS (targetPlatform dflags)
pflags = mkParserOpts (warningFlags dflags)
(extensionFlags dflags)
(mkPlainMsgEnvelope dflags)
+ (supportedLanguagesAndExtensions arch_os)
(safeImportsOn dflags)
False -- lex Haddocks as comment tokens
True -- produce comment tokens
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 2486c752..2e9b2f7e 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -56,7 +56,7 @@ import qualified Data.Set as Set
import GHC hiding (verbosity)
import GHC.Data.FastString (unpackFS)
import GHC.Data.Graph.Directed (flattenSCCs)
-import GHC.Driver.Env (hsc_dflags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units)
+import GHC.Driver.Env (hscUpdateFlags, hsc_home_unit, hsc_logger, hsc_static_plugins, hsc_units)
import GHC.Driver.Monad (modifySession, withTimingM)
import GHC.Driver.Session hiding (verbosity)
import GHC.HsToCore.Docs (getMainDeclBinder)
@@ -145,11 +145,8 @@ createIfaces verbosity modules flags instIfaceMap = do
let
installHaddockPlugin :: HscEnv -> HscEnv
- installHaddockPlugin hsc_env = hsc_env
- {
- hsc_dflags =
- gopt_set (hsc_dflags hsc_env) Opt_PluginTrustworthy
- , hsc_static_plugins =
+ installHaddockPlugin hsc_env = hscUpdateFlags (flip gopt_set Opt_PluginTrustworthy) $ hsc_env
+ { hsc_static_plugins =
haddockPlugin : hsc_static_plugins hsc_env
}
@@ -212,7 +209,7 @@ plugin verbosity flags instIfaceMap = liftIO $ do
| otherwise = do
hsc_env <- getTopEnv
ifaces <- liftIO $ readIORef ifaceMapRef
- (iface, modules) <- withTiming (hsc_logger hsc_env) (hsc_dflags hsc_env)
+ (iface, modules) <- withTiming (hsc_logger hsc_env)
"processModule" (const ()) $
processModule1 verbosity flags ifaces instIfaceMap hsc_env mod_summary tc_gbl_env
@@ -266,9 +263,8 @@ processModule1 verbosity flags ifaces inst_ifaces hsc_env mod_summary tc_gbl_env
(!interface, messages) <- do
logger <- getLogger
- dflags <- getDynFlags
{-# SCC createInterface #-}
- withTiming logger dflags "createInterface" (const ()) $ runIfM (fmap Just . tcLookupGlobal) $
+ withTiming logger "createInterface" (const ()) $ runIfM (fmap Just . tcLookupGlobal) $
createInterface1 flags unit_state mod_summary tc_gbl_env
ifaces inst_ifaces
diff --git a/haddock-api/src/Haddock/Parser.hs b/haddock-api/src/Haddock/Parser.hs
index ab2fa549..53cf98ad 100644
--- a/haddock-api/src/Haddock/Parser.hs
+++ b/haddock-api/src/Haddock/Parser.hs
@@ -19,7 +19,7 @@ import Documentation.Haddock.Types
import Haddock.Types
import GHC.Driver.Session ( DynFlags )
-import GHC.Driver.Config
+import GHC.Driver.Config.Parser (initParserOpts)
import GHC.Data.FastString ( fsLit )
import GHC.Parser.Lexer ( initParserState, unP, ParseResult(POk, PFailed) )
import GHC.Parser ( parseIdentifier )
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-23 02:59:25 +0000