[Git][ghc/ghc][master] 2 commits: One-shot Haddock
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Jul 9 10:16:53 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
96acf823 by Sjoerd Visscher at 2024-07-09T06:16:14-04:00
One-shot Haddock
- - - - -
74ec4c06 by Sjoerd Visscher at 2024-07-09T06:16:14-04:00
Remove haddock-stdout test option
Superseded by output handling of Hadrian
- - - - -
25 changed files:
- testsuite/tests/haddock/haddock_testsuite/Makefile
- utils/haddock/.gitignore
- utils/haddock/CHANGES.md
- utils/haddock/doc/invoking.rst
- utils/haddock/haddock-api/src/Haddock.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
- utils/haddock/haddock-api/src/Haddock/Interface.hs
- utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/Options.hs
- utils/haddock/haddock-test/src/Test/Haddock.hs
- utils/haddock/haddock-test/src/Test/Haddock/Config.hs
- utils/haddock/haddock-test/src/Test/Haddock/Xhtml.hs
- utils/haddock/hoogle-test/Main.hs
- utils/haddock/html-test/Main.hs
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug310.html
- utils/haddock/html-test/ref/Bug548.html
- utils/haddock/html-test/ref/BundledPatterns.html
- utils/haddock/html-test/ref/BundledPatterns2.html
- utils/haddock/html-test/src/Bug310.hs
- utils/haddock/hypsrc-test/Main.hs
- utils/haddock/latex-test/Main.hs
Changes:
=====================================
testsuite/tests/haddock/haddock_testsuite/Makefile
=====================================
@@ -27,7 +27,6 @@ htmlTest:
$(ACCEPT) \
--ghc-path='$(TEST_HC)' \
--haddock-path='$(HADDOCK)' \
- --haddock-stdout=haddock-out.log
# Corresponds to the `latex-test` testsuite
.PHONY: latexTest
@@ -43,7 +42,6 @@ latexTest:
$(ACCEPT) \
--ghc-path='$(TEST_HC)' \
--haddock-path='$(HADDOCK)' \
- --haddock-stdout=haddock-out.log
# Corresponds to the `hoogle-test` testsuite
.PHONY: hoogleTest
@@ -59,7 +57,6 @@ hoogleTest:
$(ACCEPT) \
--ghc-path='$(TEST_HC)' \
--haddock-path='$(HADDOCK)' \
- --haddock-stdout=haddock-out.log
# Corresponds to the `hypsrc-test` testsuite
.PHONY: hypsrcTest
@@ -75,4 +72,3 @@ hypsrcTest:
$(ACCEPT) \
--ghc-path='$(TEST_HC)' \
--haddock-path='$(HADDOCK)' \
- --haddock-stdout=haddock-out.log
=====================================
utils/haddock/.gitignore
=====================================
@@ -7,6 +7,10 @@
/hypsrc-test/out/
/latex-test/out/
/hoogle-test/out/
+/html-test/one-shot-out/
+/hypsrc-test/one-shot-out/
+/latex-test/one-shot-out/
+/hoogle-test/one-shot-out/
*.o
*.hi
=====================================
utils/haddock/CHANGES.md
=====================================
@@ -1,5 +1,7 @@
## Changes in 2.32.0
- * add highlighting for inline-code-blocks (sections enclosed in @'s)
+ * Add highlighting for inline-code-blocks (sections enclosed in @'s)
+
+ * Add incremental mode to support rendering documentation one module at a time.
## Changes in 2.28.0
* `hi-haddock` is integrated, which means docstrings are no longer extracted
=====================================
utils/haddock/doc/invoking.rst
=====================================
@@ -542,6 +542,11 @@ The following options are available:
``cabal`` uses temporary `response files
<https://gcc.gnu.org/wiki/Response_Files>`_ to pass arguments to Haddock.
+.. option:: --incremental=<module>
+
+ Use Haddock in :ref:`incremental mode<incremental-mode>`. Haddock will generate
+ documentation for the given module only.
+
Using literate or pre-processed source
--------------------------------------
@@ -604,3 +609,28 @@ files.
Following the steps above will allow you to take full advantage of "hi-haddock"
and generate Haddock documentation from existing build results without requiring
any further compilation.
+
+.. _incremental-mode:
+
+Incremental mode
+----------------
+
+In incremental mode Haddock generates documentation for only one module, making it
+possible to generate documentation incrementally. It is useful when working on
+the documentation, and especially in big packages, since your changes get
+rendered quickly. Incremental mode takes full advantage of "hi-haddock": the
+compiler is never invoked so it's guaranteed that no recompilation will occur.
+
+There are two major downsides to this method:
+
+#. The procedure to get links between modules in incremental mode is the same as
+ for links between packages in normal mode, using :option:`--dump-interface`
+ and :option:`--read-interface`. So for each dependency you will have to
+ pass the location of the ``.haddock`` file with :option:`--read-interface`.
+ It is therefore recommended to use incremental mode in conjunction with a
+ build system like Bazel or Buck to track build dependencies at file level.
+#. Class instances from other modules than where the class is defined are not
+ available in incremental mode. This is because the module where the class is
+ defined has to be rendered before the module with the instance, since that
+ module depends on the former. So it is recommended to do a final pass in
+ normal mode before publishing the documentation to f.e. Hackage.
=====================================
utils/haddock/haddock-api/src/Haddock.hs
=====================================
@@ -166,12 +166,14 @@ haddockWithGhc ghc args = handleTopExceptions $ do
qual <- rightOrThrowE (qualification flags)
sinceQual <- rightOrThrowE (sinceQualification flags)
+ let isOneShotMode = isJust (optOneShot flags)
+
-- Inject dynamic-too into ghc options if the ghc we are using was built with
- -- dynamic linking
+ -- dynamic linking (except when in one-shot mode)
flags'' <- ghc flags $ do
df <- getDynFlags
case lookup "GHC Dynamic" (compilerInfo df) of
- Just "YES" -> return $ Flag_OptGhc "-dynamic-too" : flags
+ Just "YES" | not isOneShotMode -> return $ Flag_OptGhc "-dynamic-too" : flags
_ -> return flags
-- Inject `-j` into ghc options, if given to Haddock
@@ -190,6 +192,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do
-- to compute output file names that are stored in the 'DynFlags' of the
-- resulting 'ModSummary's.
let withDir | Flag_NoTmpCompDir `elem` flags = id
+ | isOneShotMode = id
| otherwise = withTempOutputDir
-- Output warnings about potential misuse of some flags
@@ -218,7 +221,7 @@ haddockWithGhc ghc args = handleTopExceptions $ do
putMsg logger $ renderJson (jsonInterfaceFile ifaceFile)
-- If we were given source files to generate documentation from, do it
- if not (null files) then do
+ if not (null files) || isJust (optOneShot flags) then do
(packages, ifaces, homeLinks) <- readPackagesAndProcessModules flags files
let packageInfo = PackageInfo { piPackageName =
fromMaybe (PackageName mempty) (optPackageName flags)
@@ -514,7 +517,7 @@ render dflags parserOpts logger unit_state flags sinceQual qual ifaces packages
opt_contents_url opt_index_url unicode sincePkg packageInfo
qual pretty withQuickjump
return ()
- unless withBaseURL $ do
+ unless (withBaseURL || isJust (optOneShot flags)) $ do
copyHtmlBits odir libDir themes withQuickjump
writeHaddockMeta odir withQuickjump
@@ -551,7 +554,7 @@ render dflags parserOpts logger unit_state flags sinceQual qual ifaces packages
when (Flag_HyperlinkedSource `elem` flags && not (null ifaces)) $ do
withTiming logger "ppHyperlinkedSource" (const ()) $ do
_ <- {-# SCC ppHyperlinkedSource #-}
- ppHyperlinkedSource (verbosity flags) odir libDir opt_source_css pretty srcMap ifaces
+ ppHyperlinkedSource (verbosity flags) (isJust (optOneShot flags)) odir libDir opt_source_css pretty srcMap ifaces
return ()
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker.hs
=====================================
@@ -8,6 +8,7 @@ module Haddock.Backends.Hyperlinker
, module Haddock.Backends.Hyperlinker.Utils
) where
+import Control.Monad (unless)
import Data.Map as M
import Data.Maybe
import GHC.Data.FastString (mkFastString)
@@ -40,6 +41,8 @@ import Haddock.Utils (Verbosity, out, verbose, writeUtf8File)
-- produced source.
ppHyperlinkedSource
:: Verbosity
+ -> Bool
+ -- ^ In one-shot mode
-> FilePath
-- ^ Output directory
-> FilePath
@@ -53,12 +56,13 @@ ppHyperlinkedSource
-> [Interface]
-- ^ Interfaces for which we create source
-> IO ()
-ppHyperlinkedSource verbosity outdir libdir mstyle pretty srcs' ifaces = do
+ppHyperlinkedSource verbosity isOneShot outdir libdir mstyle pretty srcs' ifaces = do
createDirectoryIfMissing True srcdir
- let cssFile = fromMaybe (defaultCssFile libdir) mstyle
- copyFile cssFile $ srcdir </> srcCssFile
- copyFile (libdir </> "html" </> highlightScript) $
- srcdir </> highlightScript
+ unless isOneShot $ do
+ let cssFile = fromMaybe (defaultCssFile libdir) mstyle
+ copyFile cssFile $ srcdir </> srcCssFile
+ copyFile (libdir </> "html" </> highlightScript) $
+ srcdir </> highlightScript
mapM_ (ppHyperlinkedModuleSource verbosity srcdir pretty srcs) ifaces
where
srcdir = outdir </> hypSrcDir
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml.hs
=====================================
@@ -425,7 +425,7 @@ ppHtmlContents
, not (instIsSig iface)
]
)
- | pinfo <- packages
+ | pinfo <- mergedPackages
]
sig_trees =
[ ( piPackageInfo pinfo
@@ -437,7 +437,7 @@ ppHtmlContents
, instIsSig iface
]
)
- | pinfo <- packages
+ | pinfo <- mergedPackages
]
html =
headHtml doctitle themes mathjax_url Nothing
@@ -459,6 +459,10 @@ ppHtmlContents
toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)
toInstalledDescription = fmap mkMeta . hmi_description . instInfo
+ -- Merge package interfaces from the same package (f.e. like those generated by --incremental)
+ mergedPackages = Map.elems $ Map.fromListWith merge $ map (\p -> ((ppPackageInfo (piPackageInfo p), piVisibility p), p)) packages
+ merge p1 p2 = p1{piInstalledInterfaces = piInstalledInterfaces p1 ++ piInstalledInterfaces p2}
+
ppPrologue :: Maybe Package -> Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
ppPrologue _ _ _ Nothing = noHtml
ppPrologue pkg qual title (Just doc) =
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
=====================================
@@ -193,8 +193,7 @@ subTableSrc pkg qual lnks splice decls = Just $ table << aboves (concatMap subRo
: map (cell . (td <<)) subs
linkHtml :: SrcSpan -> Maybe Module -> DocName -> Html
- linkHtml loc@(RealSrcSpan _ _) mdl dn = links lnks loc splice mdl dn
- linkHtml _ _ _ = noHtml
+ linkHtml loc mdl dn = links lnks loc splice mdl dn
subBlock :: [Html] -> Maybe Html
subBlock [] = Nothing
=====================================
utils/haddock/haddock-api/src/Haddock/Interface.hs
=====================================
@@ -37,6 +37,7 @@ module Haddock.Interface (
import Control.Monad
import Data.List (isPrefixOf)
+import qualified Data.List as List
import Data.Traversable (for)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
@@ -44,6 +45,8 @@ import Debug.Trace (traceMarkerIO)
import System.Exit (exitFailure ) -- TODO use Haddock's die
import Text.Printf
import GHC hiding (verbosity, SuccessFlag(..))
+import GHC.Builtin.Names (mkMainModule_)
+import qualified GHC.Data.EnumSet as EnumSet
import GHC.Data.FastString (unpackFS)
import GHC.Data.Graph.Directed
import GHC.Data.Maybe
@@ -56,16 +59,20 @@ import qualified GHC.Driver.DynFlags as DynFlags
import qualified GHC.Utils.Outputable as Outputable
import GHC.Driver.Session hiding (verbosity)
import GHC.HsToCore.Docs (getMainDeclBinder)
+import GHC.Iface.Load (loadSysInterface)
+import GHC.IfaceToCore (tcIfaceInst, tcIfaceFamInst)
+import GHC.Tc.Utils.Monad (initIfaceLoad, initIfaceLcl)
+import GHC.Tc.Utils.Env (lookupGlobal_maybe)
import GHC.Types.Error (mkUnknownDiagnostic)
import GHC.Types.Name.Occurrence (emptyOccEnv)
+import GHC.Unit.Finder (findImportedModule, FindResult(Found))
+import GHC.Unit.Home.ModInfo
import GHC.Unit.Module.Graph (ModuleGraphNode (..))
import GHC.Unit.Module.ModDetails
+import GHC.Unit.Module.ModIface (mi_semantic_module, mi_boot)
import GHC.Unit.Module.ModSummary (isBootSummary)
-import GHC.Utils.Outputable (Outputable, (<+>), pprModuleName)
+import GHC.Utils.Outputable (Outputable, (<+>), pprModuleName, text)
import GHC.Utils.Error (withTiming)
-import GHC.Unit.Home.ModInfo
-import GHC.Tc.Utils.Env (lookupGlobal_maybe)
-import qualified Data.List as List
#if defined(mingw32_HOST_OS)
import System.IO
@@ -75,7 +82,7 @@ import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))
import Haddock.GhcUtils (moduleString, pretty)
import Haddock.Interface.AttachInstances (attachInstances)
-import Haddock.Interface.Create (createInterface1)
+import Haddock.Interface.Create (createInterface1, createInterface1')
import Haddock.Interface.Rename (renameInterface)
import Haddock.InterfaceFile (InterfaceFile, ifInstalledIfaces, ifLinkEnv)
import Haddock.Options hiding (verbosity)
@@ -108,8 +115,12 @@ processModules verbosity modules flags extIfaces = do
| ext <- extIfaces
, iface <- ifInstalledIfaces ext
]
+ oneShotHiFile = optOneShot flags
- interfaces <- createIfaces verbosity modules flags instIfaceMap
+ interfaces <- maybe
+ (createIfaces verbosity modules flags instIfaceMap)
+ (createOneShotIface verbosity flags instIfaceMap)
+ oneShotHiFile
let exportedNames =
Set.unions $ map (Set.fromList . ifaceExports) $
@@ -118,7 +129,7 @@ processModules verbosity modules flags extIfaces = do
interfaces' <- {-# SCC attachInstances #-}
withTimingM "attachInstances" (const ()) $ do
- attachInstances (exportedNames, mods) interfaces instIfaceMap
+ attachInstances (exportedNames, mods) interfaces instIfaceMap (isJust oneShotHiFile)
-- Combine the link envs of the external packages into one
let extLinks = Map.unions (map ifLinkEnv extIfaces)
@@ -313,6 +324,67 @@ processModule verbosity modSummary flags ifaceMap instIfaceMap = do
return (Just interface)
+-- | Create a single interface from a single module in one-shot mode.
+createOneShotIface
+ :: Verbosity
+ -- ^ Verbosity requested by the caller
+ -> [Flag]
+ -- ^ Command line flags which Hadddock was invoked with
+ -> InstIfaceMap
+ -- ^ Map from module to corresponding installed interface file
+ -> String
+ -- ^ Name of the module
+ -> Ghc [Interface]
+ -- ^ Resulting interfaces
+createOneShotIface verbosity flags instIfaceMap moduleNameStr = do
+
+ let moduleNm = mkModuleName moduleNameStr
+ doc = text "createOneShotIface"
+
+ out verbosity verbose $ "Checking interface " ++ moduleNameStr ++ "..."
+
+ -- Turn on GHC's one-shot mode
+ dflags <- (\df -> df{ ghcMode = OneShot }) <$> getDynFlags
+ modifySession $ hscSetFlags dflags
+ hsc_env <- getSession
+
+ (iface, insts) <- liftIO $ initIfaceLoad hsc_env $ do
+
+ iface <- loadSysInterface doc $ mkMainModule_ moduleNm
+
+ insts <- initIfaceLcl (mi_semantic_module iface) doc (mi_boot iface) $ do
+
+ new_eps_insts <- mapM tcIfaceInst (mi_insts iface)
+ new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface)
+
+ pure (new_eps_insts, new_eps_fam_insts)
+
+ pure (iface, insts)
+
+ -- Update the DynFlags with the extensions from the source file (as stored in the interface file)
+ -- This is instead of ms_hspp_opts from ModSummary, which is not available in one-shot mode.
+ let dflags' = case mi_docs iface of
+ Just docs -> setExtensions $ setLanguage dflags
+ where
+ setLanguage df = lang_set df (docs_language docs)
+ setExtensions df = List.foldl' xopt_set df $ EnumSet.toList (docs_extensions docs)
+ Nothing -> dflags
+
+ -- We should find the module here, otherwise there would have been an error earlier.
+ res <- liftIO $ findImportedModule hsc_env moduleNm NoPkgQual
+ let hieFilePath = case res of
+ Found ml _ -> ml_hie_file ml
+ _ -> throwE "createOneShotIface: module not found"
+
+ !interface <- do
+ logger <- getLogger
+ {-# SCC createInterface #-}
+ withTiming logger "createInterface" (const ()) $
+ runIfM (liftIO . fmap dropErr . lookupGlobal_maybe hsc_env) $
+ createInterface1' flags (hsc_units hsc_env) dflags' hieFilePath iface mempty instIfaceMap insts
+
+ pure [interface]
+
--------------------------------------------------------------------------------
-- * Building of cross-linking environment
--------------------------------------------------------------------------------
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs
=====================================
@@ -24,6 +24,7 @@ module Haddock.Interface.AttachInstances (attachInstances, instHead) where
import Control.Applicative ((<|>))
import Control.Arrow hiding ((<+>))
import Control.DeepSeq (force)
+import Control.Monad (unless)
import Data.Foldable (toList)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
@@ -69,8 +70,8 @@ type Modules = Set.Set Module
type ExportInfo = (ExportedNames, Modules)
-- Also attaches fixities
-attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface]
-attachInstances expInfo ifaces instIfaceMap = do
+attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Bool -> Ghc [Interface]
+attachInstances expInfo ifaces instIfaceMap isOneShot = do
-- We need to keep load modules in which we will look for instances. We've
-- somewhat arbitrarily decided to load all modules which are available -
-- either directly or from a re-export.
@@ -97,8 +98,10 @@ attachInstances expInfo ifaces instIfaceMap = do
(_msgs, mb_index) <- do
hsc_env <- getSession
liftIO $ runTcInteractive hsc_env $ do
- let doc = text "Need interface for haddock"
- initIfaceTcRn $ mapM_ (loadSysInterface doc) mods_to_load
+ -- In one shot mode we don't want to load anything more than is already loaded
+ unless isOneShot $ do
+ let doc = text "Need interface for haddock"
+ initIfaceTcRn $ mapM_ (loadSysInterface doc) mods_to_load
cls_env at InstEnvs{ie_global, ie_local} <- tcGetInstEnvs
fam_env@(pkg_fie, home_fie) <- tcGetFamInstEnvs
-- We use Data.Sequence.Seq because we are creating left associated
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
=====================================
@@ -29,7 +29,7 @@
-- This module provides a single function 'createInterface',
-- which creates a Haddock 'Interface' from the typechecking
-- results 'TypecheckedModule' from GHC.
-module Haddock.Interface.Create (IfM, runIfM, createInterface1) where
+module Haddock.Interface.Create (IfM, runIfM, createInterface1, createInterface1') where
import Control.Arrow (first, (&&&))
import Control.DeepSeq
@@ -84,7 +84,7 @@ createInterface1
-> InstIfaceMap
-> ([ClsInst], [FamInst])
-> IfM m Interface
-createInterface1 flags unit_state mod_sum mod_iface ifaces inst_ifaces (instances, fam_instances) = do
+createInterface1 flags unit_state mod_sum mod_iface ifaces inst_ifaces (instances, fam_instances) =
let
ModSummary
{ -- Cached flags from OPTIONS, INCLUDE and LANGUAGE
@@ -93,9 +93,23 @@ createInterface1 flags unit_state mod_sum mod_iface ifaces inst_ifaces (instance
ms_hspp_opts
, ms_location = modl
} = mod_sum
+ in
+ createInterface1' flags unit_state ms_hspp_opts (ml_hie_file modl) mod_iface ifaces inst_ifaces (instances, fam_instances)
+createInterface1'
+ :: MonadIO m
+ => [Flag]
+ -> UnitState
+ -> DynFlags
+ -> FilePath
+ -> ModIface
+ -> IfaceMap
+ -> InstIfaceMap
+ -> ([ClsInst], [FamInst])
+ -> IfM m Interface
+createInterface1' flags unit_state dflags hie_file mod_iface ifaces inst_ifaces (instances, fam_instances) = do
+ let
sDocContext = DynFlags.initSDocContext dflags Outputable.defaultUserStyle
- dflags = ms_hspp_opts
mLanguage = language dflags
parserOpts = Parser.initParserOpts dflags
mdl = mi_module mod_iface
@@ -230,7 +244,7 @@ createInterface1 flags unit_state mod_sum mod_iface ifaces inst_ifaces (instance
Interface
{ ifaceMod = mdl
, ifaceIsSig = is_sig
- , ifaceHieFile = ml_hie_file modl
+ , ifaceHieFile = hie_file
, ifaceInfo = info
, ifaceDoc = Documentation header_doc mod_warning
, ifaceRnDoc = Documentation Nothing Nothing
=====================================
utils/haddock/haddock-api/src/Haddock/Options.hs
=====================================
@@ -33,6 +33,7 @@ module Haddock.Options
, optShowInterfaceFile
, optLaTeXStyle
, optMathjax
+ , optOneShot
, qualification
, sinceQualification
, verbosity
@@ -122,6 +123,7 @@ data Flag
| Flag_IgnoreLinkSymbol String
| Flag_ParCount (Maybe Int)
| Flag_TraceArgs
+ | Flag_OneShot String
deriving (Eq, Show)
options :: Bool -> [OptDescr Flag]
@@ -156,6 +158,11 @@ options backwardsCompat =
["show-interface"]
(ReqArg Flag_ShowInterface "FILE")
"print the interface in a human readable form"
+ , Option
+ []
+ ["incremental"]
+ (ReqArg Flag_OneShot "MODULE")
+ "generate documentation for a single module only, given its module name"
, -- Option ['S'] ["docbook"] (NoArg Flag_DocBook)
-- "output in DocBook XML",
Option
@@ -473,6 +480,9 @@ optDumpInterfaceFile flags = optLast [str | Flag_DumpInterface str <- flags]
optShowInterfaceFile :: [Flag] -> Maybe FilePath
optShowInterfaceFile flags = optLast [str | Flag_ShowInterface str <- flags]
+optOneShot :: [Flag] -> Maybe String
+optOneShot flags = optLast [str | Flag_OneShot str <- flags]
+
optLaTeXStyle :: [Flag] -> Maybe String
optLaTeXStyle flags = optLast [str | Flag_LaTeXStyle str <- flags]
@@ -551,7 +561,7 @@ reexportFlags :: [Flag] -> [String]
reexportFlags flags = [option | Flag_Reexport option <- flags]
data Visibility = Visible | Hidden
- deriving (Eq, Show)
+ deriving (Eq, Ord, Show)
readIfaceArgs :: [Flag] -> [(DocPaths, Visibility, FilePath)]
readIfaceArgs flags = [parseIfaceOption s | Flag_ReadInterface s <- flags]
=====================================
utils/haddock/haddock-test/src/Test/Haddock.hs
=====================================
@@ -8,10 +8,10 @@ module Test.Haddock
) where
import Control.Monad
-
-import Data.Maybe
-
import qualified Data.ByteString.Char8 as BS
+import qualified Data.Map.Strict as Map
+import Data.Maybe
+import GHC.ResponseFile
import System.Directory
import System.Exit
import System.FilePath
@@ -74,10 +74,10 @@ maybeDiff cfg@(Config{cfgDiffTool = (Just diff)}) files = do
runHaddock :: Config c -> IO Bool
runHaddock cfg@(Config{..}) = do
createEmptyDirectory $ cfgOutDir cfg
+ createEmptyDirectory $ cfgOneShotOutDir cfg
putStrLn "Generating documentation..."
successes <- forM cfgPackages $ \tpkg -> do
- haddockStdOut <- openFile cfgHaddockStdOut WriteMode
let pc =
processConfig
{ pcArgs =
@@ -87,24 +87,83 @@ runHaddock cfg@(Config{..}) = do
, tpkgFiles tpkg
]
, pcEnv = Just cfgEnv
- , pcStdOut = Just haddockStdOut
- , pcStdErr = Just haddockStdOut
}
let msg = "Failed to run Haddock on test package '" ++ tpkgName tpkg ++ "'"
succeeded <- waitForSuccess msg stdout =<< runProcess' cfgHaddockPath pc
unless succeeded $ removeDirectoryRecursive (outDir cfgDirConfig tpkg)
- pure succeeded
+ if cfgSkipOneShot then pure succeeded else do
+ let oneShotDir = oneshotOutDir cfgDirConfig tpkg
+ hiDir = oneShotDir </> "hi"
+ hieDir = oneShotDir </> "hie"
+ responseFile = hiDir </> "response-file"
+ createEmptyDirectory oneShotDir
+ createEmptyDirectory hiDir
+ createEmptyDirectory hieDir
+ writeFile responseFile $ escapeArgs
+ [ "--odir=" ++ oneShotDir
+ , "--optghc=-hidir=" ++ hiDir
+ , "--optghc=-hiedir=" ++ hieDir
+ ]
+
+ -- Build .hi files
+ let pc' =
+ processConfig
+ { pcArgs =
+ concat
+ [
+ [ "--make"
+ , "-haddock"
+ , "-fwrite-interface"
+ , "-fwrite-ide-info"
+ , "-no-keep-o-files"
+ , "-hidir=" ++ hiDir
+ , "-hiedir=" ++ hieDir
+ ]
+ , tpkgFiles tpkg
+ ]
+ , pcEnv = Just cfgEnv
+ }
+ let msg = "Failed to run GHC on test package '" ++ tpkgName tpkg ++ "'"
+ _ <- waitForSuccess msg stdout =<< runProcess' cfgGhcPath pc'
+
+ files <- filter ((== ".hi") . takeExtension) <$> listDirectory hiDir
+ -- Use the output order of GHC as a simple dependency order
+ filesSorted <- Map.elems . Map.fromList <$> traverse (\file -> (,file) <$> getModificationTime (hiDir </> file)) files
+ let srcRef = if "--hyperlinked-source" `elem` cfgHaddockArgs then ",src,visible," else ""
+ loop [] = pure True
+ loop (file : files) = do
+ let hiFile = hiDir </> file
+ haddockFile = hiFile ++ ".haddock"
+ pc =
+ processConfig
+ { pcArgs =
+ concat
+ [ cfgHaddockArgs
+ , [ "@" ++ responseFile
+ , "--incremental=" ++ takeBaseName hiFile
+ , "--dump-interface=" ++ haddockFile
+ ]
+ ]
+ , pcEnv = Just cfgEnv
+ }
+ let msg = "Failed to run Haddock in one-shot mode on file '" ++ hiFile ++ "'"
+ succeeded <- waitForSuccess msg stdout =<< runProcess' cfgHaddockPath pc
+ if succeeded
+ -- Allow subsequent files to depend on this file
+ then do
+ appendFile responseFile $
+ escapeArgs [ "--read-interface=" ++ srcRef ++ haddockFile ]
+ loop files
+ else pure False
+ succeeded2 <- loop filesSorted
+ when succeeded2 $ do
+ removeDirectoryRecursive hiDir
+ removeDirectoryRecursive hieDir
+ pure succeeded2
let somethingFailed = any not successes
- when somethingFailed $
- putStrLn
- ( "Haddock output is at '"
- ++ cfgHaddockStdOut
- ++ "'. "
- ++ "This file can be set with `--haddock-stdout`."
- )
pure somethingFailed
checkFile :: Config c -> FilePath -> IO CheckResult
@@ -114,11 +173,20 @@ checkFile cfg file = do
then do
mout <- readOut cfg file
mref <- readRef cfg file
- return $ case (mout, mref) of
+ case (mout, mref) of
(Just out, Just ref)
- | ccfgEqual ccfg out ref -> Pass
- | otherwise -> Fail
- _ -> Error "Failed to parse input files"
+ | ccfgEqual ccfg out ref ->
+ if cfgSkipOneShot cfg || dcfgCheckIgnoreOneShot (cfgDirConfig cfg) file
+ then return Pass
+ else do
+ mOneShotOut <- readOneShotOut cfg file
+ return $ case mOneShotOut of
+ Just oneShotOut
+ | ccfgEqual ccfg oneShotOut out -> Pass
+ | otherwise -> Fail
+ Nothing -> Error "Failed to parse one-shot input file"
+ | otherwise -> return Fail
+ _ -> return $ Error "Failed to parse input files"
else return NoRef
where
ccfg = cfgCheckConfig cfg
@@ -147,11 +215,21 @@ readOut cfg file =
ccfg = cfgCheckConfig cfg
dcfg = cfgDirConfig cfg
+readOneShotOut :: Config c -> FilePath -> IO (Maybe c)
+readOneShotOut cfg file =
+ fmap (ccfgClean ccfg file) . ccfgRead ccfg . BS.unpack
+ <$> BS.readFile (oneShotOutFile dcfg file)
+ where
+ ccfg = cfgCheckConfig cfg
+ dcfg = cfgDirConfig cfg
+
diffFile :: Config c -> FilePath -> FilePath -> IO ()
diffFile cfg diff file = do
Just out <- readOut cfg file
+ Just oneShotOut <- readOneShotOut cfg file
Just ref <- readRef cfg file
writeFile outFile' $ ccfgDump ccfg out
+ writeFile oneShotOutFile' $ ccfgDump ccfg oneShotOut
writeFile refFile' $ ccfgDump ccfg ref
putStrLn $ "Diff for file \"" ++ file ++ "\":"
@@ -162,11 +240,20 @@ diffFile cfg diff file = do
{ pcArgs = [outFile', refFile']
, pcStdOut = Just stdout
}
- waitForProcess handle >> return ()
+ void $ waitForProcess handle
+ handle' <-
+ runProcess' diff $
+ processConfig
+ { pcArgs = [oneShotOutFile', outFile']
+ , pcStdOut = Just stdout
+ }
+ void $ waitForProcess handle'
+ return ()
where
dcfg = cfgDirConfig cfg
ccfg = cfgCheckConfig cfg
outFile' = outFile dcfg file <.> "dump"
+ oneShotOutFile' = oneShotOutFile dcfg file <.> "dump"
refFile' = outFile dcfg file <.> "ref" <.> "dump"
maybeAcceptFile :: Config c -> FilePath -> CheckResult -> IO CheckResult
@@ -185,8 +272,14 @@ maybeAcceptFile _ _ result = pure result
outDir :: DirConfig -> TestPackage -> FilePath
outDir dcfg tpkg = dcfgOutDir dcfg </> tpkgName tpkg
+oneshotOutDir :: DirConfig -> TestPackage -> FilePath
+oneshotOutDir dcfg tpkg = dcfgOneShotOutDir dcfg </> tpkgName tpkg
+
outFile :: DirConfig -> FilePath -> FilePath
outFile dcfg file = dcfgOutDir dcfg </> file
+oneShotOutFile :: DirConfig -> FilePath -> FilePath
+oneShotOutFile dcfg file = dcfgOneShotOutDir dcfg </> file
+
refFile :: DirConfig -> FilePath -> FilePath
refFile dcfg file = dcfgRefDir dcfg </> file
=====================================
utils/haddock/haddock-test/src/Test/Haddock/Config.hs
=====================================
@@ -4,7 +4,7 @@
module Test.Haddock.Config
( TestPackage(..), CheckConfig(..), DirConfig(..), Config(..)
, defaultDirConfig
- , cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir
+ , cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir, cfgOneShotOutDir
, parseArgs, checkOpt, loadConfig
) where
@@ -57,8 +57,10 @@ data DirConfig = DirConfig
{ dcfgSrcDir :: FilePath
, dcfgRefDir :: FilePath
, dcfgOutDir :: FilePath
+ , dcfgOneShotOutDir :: FilePath
, dcfgResDir :: FilePath
, dcfgCheckIgnore :: FilePath -> Bool
+ , dcfgCheckIgnoreOneShot :: FilePath -> Bool
}
@@ -67,8 +69,10 @@ defaultDirConfig baseDir = DirConfig
{ dcfgSrcDir = baseDir </> "src"
, dcfgRefDir = baseDir </> "ref"
, dcfgOutDir = baseDir </> "out"
+ , dcfgOneShotOutDir = baseDir </> "one-shot-out"
, dcfgResDir = rootDir </> "resources"
, dcfgCheckIgnore = const False
+ , dcfgCheckIgnoreOneShot = const False
}
where
rootDir = baseDir </> ".."
@@ -76,29 +80,30 @@ defaultDirConfig baseDir = DirConfig
data Config c = Config
{ cfgHaddockPath :: FilePath
+ , cfgGhcPath :: FilePath
, cfgPackages :: [TestPackage]
, cfgHaddockArgs :: [String]
- , cfgHaddockStdOut :: FilePath
, cfgDiffTool :: Maybe FilePath
, cfgEnv :: Environment
, cfgAccept :: Bool
, cfgCheckConfig :: CheckConfig c
, cfgDirConfig :: DirConfig
+ , cfgSkipOneShot :: Bool
}
-cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir :: Config c -> FilePath
+cfgSrcDir, cfgRefDir, cfgOutDir, cfgResDir, cfgOneShotOutDir :: Config c -> FilePath
cfgSrcDir = dcfgSrcDir . cfgDirConfig
cfgRefDir = dcfgRefDir . cfgDirConfig
cfgOutDir = dcfgOutDir . cfgDirConfig
cfgResDir = dcfgResDir . cfgDirConfig
+cfgOneShotOutDir = dcfgOneShotOutDir . cfgDirConfig
data Flag
= FlagHaddockPath FilePath
| FlagHaddockOptions String
- | FlagHaddockStdOut FilePath
| FlagGhcPath FilePath
| FlagDiffTool FilePath
| FlagNoDiff
@@ -118,10 +123,6 @@ flagsHaddockOptions flags = concat
[ words opts | FlagHaddockOptions opts <- flags ]
-flagsHaddockStdOut :: [Flag] -> Maybe FilePath
-flagsHaddockStdOut flags = mlast [ path | FlagHaddockStdOut path <- flags ]
-
-
flagsDiffTool :: [Flag] -> Maybe FilePath
flagsDiffTool flags = mlast [ path | FlagDiffTool path <- flags ]
@@ -132,8 +133,6 @@ options =
"path to Haddock executable to exectue tests with"
, Option [] ["haddock-options"] (ReqArg FlagHaddockOptions "OPTS")
"additional options to run Haddock with"
- , Option [] ["haddock-stdout"] (ReqArg FlagHaddockStdOut "FILE")
- "where to redirect Haddock output"
, Option [] ["ghc-path"] (ReqArg FlagGhcPath "FILE")
"path ghc executable"
, Option [] ["diff-tool"] (ReqArg FlagDiffTool "PATH")
@@ -196,7 +195,7 @@ loadConfig ccfg dcfg flags files = do
, queriedGhcPath
]
- ghcPath <- case ghc_path of
+ cfgGhcPath <- case ghc_path of
Just path -> pure path
Nothing -> do
hPutStrLn stderr "GHC executable not found; consider using the `--ghc-path` flag."
@@ -213,11 +212,9 @@ loadConfig ccfg dcfg flags files = do
, pure ["--optghc=-w"]
, pure ["--optghc=-hide-all-packages"]
, pure $ flagsHaddockOptions flags
- , baseDependencies ghcPath
+ , baseDependencies cfgGhcPath
]
- let cfgHaddockStdOut = fromMaybe defaultStdOut (flagsHaddockStdOut flags)
-
cfgDiffTool <- if FlagNoDiff `elem` flags
then pure Nothing
else (<|>) <$> pure (flagsDiffTool flags) <*> defaultDiffTool
@@ -226,6 +223,7 @@ loadConfig ccfg dcfg flags files = do
let cfgCheckConfig = ccfg
let cfgDirConfig = dcfg
+ let cfgSkipOneShot = False
return $ Config { .. }
@@ -307,7 +305,7 @@ baseDependencies ghcPath = do
htmlDirOpt = listToMaybe (haddockHTMLs pkg)
pure (unitId, ifaceOpt, htmlDirOpt)
-
+
defaultDiffTool :: IO (Maybe FilePath)
defaultDiffTool =
=====================================
utils/haddock/haddock-test/src/Test/Haddock/Xhtml.hs
=====================================
@@ -7,6 +7,7 @@ module Test.Haddock.Xhtml
, stripAnchorsWhen
, stripIdsWhen
, stripFooter
+ , fixAttrValueWhen
) where
{-
@@ -48,19 +49,19 @@ type Value = String
--
-- * match an attribute key
-- * check something about the value
--- * if the check succeeded, replace the value with a dummy value
-stripAttrValueWhen
+-- * if the check succeeded, apply a function to the value
+fixAttrValueWhen
:: Attr
-- ^ attribute key
- -> Value
- -- ^ dummy attribute value
+ -> (Value -> Value)
+ -- ^ update attribute value function
-> (Value -> Bool)
-- ^ determine whether we should modify the attribute
-> Xml
-- ^ input XML
-> Xml
-- ^ output XML
-stripAttrValueWhen key fallback p (Xml body) = Xml (filterAttrs body)
+fixAttrValueWhen key f p (Xml body) = Xml (filterAttrs body)
where
keyEq = key ++ "=\""
@@ -69,11 +70,24 @@ stripAttrValueWhen key fallback p (Xml body) = Xml (filterAttrs body)
| Just valRest <- stripPrefix keyEq b
, Just (val, rest) <- spanToEndOfString valRest =
if p val
- then keyEq ++ fallback ++ "\"" ++ filterAttrs rest
+ then keyEq ++ f val ++ "\"" ++ filterAttrs rest
else keyEq ++ val ++ "\"" ++ filterAttrs rest
| otherwise =
c : filterAttrs cs
+stripAttrValueWhen
+ :: Attr
+ -- ^ attribute key
+ -> Value
+ -- ^ dummy attribute value
+ -> (Value -> Bool)
+ -- ^ determine whether we should modify the attribute
+ -> Xml
+ -- ^ input XML
+ -> Xml
+ -- ^ output XML
+stripAttrValueWhen key fallback = fixAttrValueWhen key (const fallback)
+
-- | Spans to the next (unescaped) @\"@ character.
--
-- >>> spanToEndOfString "no closing quotation"
=====================================
utils/haddock/hoogle-test/Main.hs
=====================================
@@ -17,9 +17,14 @@ checkConfig = CheckConfig
, ccfgEqual = (==) `on` crlfToLf
}
+multiModuleTests :: [String]
+multiModuleTests = ["modules", "type-sigs"]
dirConfig :: DirConfig
-dirConfig = defaultDirConfig $ takeDirectory __FILE__
+dirConfig = (defaultDirConfig $ takeDirectory __FILE__)
+ -- Multi-module hoogle tests don't make sense for one-shot mode
+ { dcfgCheckIgnoreOneShot = (`elem` (fmap (</> "test.txt") multiModuleTests))
+ }
main :: IO ()
=====================================
utils/haddock/html-test/Main.hs
=====================================
@@ -23,6 +23,7 @@ checkConfig = CheckConfig
dirConfig :: DirConfig
dirConfig = (defaultDirConfig $ takeDirectory __FILE__)
{ dcfgCheckIgnore = checkIgnore
+ , dcfgCheckIgnoreOneShot = (`elem` ignoredOneShotTests) . takeBaseName
}
@@ -31,6 +32,11 @@ main = do
cfg <- parseArgs checkConfig dirConfig =<< getArgs
runAndCheck $ cfg
{ cfgHaddockArgs = cfgHaddockArgs cfg ++ ["--pretty-html", "--html"]
+#ifdef mingw32_HOST_OS
+ , cfgSkipOneShot = False -- Current test setup makes the argument list too long on Windows
+#else
+ , cfgSkipOneShot = False
+#endif
}
@@ -47,7 +53,7 @@ stripIfRequired mdl =
preserveLinksModules :: [String]
preserveLinksModules = ["Bug253.html", "NamespacedIdentifiers.html"]
-ingoredTests :: [FilePath]
+ingoredTests :: [String]
ingoredTests =
[
-- Currently some declarations are exported twice
@@ -56,6 +62,19 @@ ingoredTests =
"B"
]
+ignoredOneShotTests :: [String]
+ignoredOneShotTests =
+ [
+ -- Class instances don't travel up the dependency chain in one-shot mode
+ "Bug1004"
+ , "OrphanInstancesClass"
+ , "OrphanInstancesType"
+ , "TypeFamilies2"
+ -- Warnings are not stored in .haddock files https://github.com/haskell/haddock/issues/223
+ , "DeprecatedReExport"
+ , "HiddenInstancesB"
+ ]
+
checkIgnore :: FilePath -> Bool
checkIgnore file | takeBaseName file `elem` ingoredTests = True
checkIgnore file@(c:_) | takeExtension file == ".html" && isUpper c = False
=====================================
utils/haddock/html-test/ref/Bug1004.html
=====================================
@@ -147,6 +147,8 @@
> f g :: k -> <a href="#" title="Data.Kind"
>Type</a
>)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc empty"
> </td
@@ -311,6 +313,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -385,6 +389,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -538,6 +544,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -590,6 +598,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -642,6 +652,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -742,6 +754,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -814,6 +828,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc empty"
> </td
@@ -868,6 +884,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -946,6 +964,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1040,6 +1060,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1098,6 +1120,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1168,6 +1192,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1226,6 +1252,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1274,6 +1302,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1470,6 +1500,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1556,6 +1588,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1624,6 +1658,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1706,6 +1742,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -1940,6 +1978,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc empty"
> </td
@@ -2096,6 +2136,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -2176,6 +2218,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -2246,6 +2290,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -2308,6 +2354,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -2430,6 +2478,8 @@
> f g :: k -> <a href="#" title="Data.Kind"
>Type</a
>)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -2524,6 +2574,8 @@
> (<a href="#" title="Bug1004"
>Product</a
> f g a)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
=====================================
utils/haddock/html-test/ref/Bug310.html
=====================================
@@ -57,8 +57,8 @@
>type family</span
> (a :: <a href="#" title="GHC.TypeLits"
>Natural</a
- >) <a id="t:-43-" class="def"
- >+</a
+ >) <a id="t:-45-" class="def"
+ >-</a
> (b :: <a href="#" title="GHC.TypeLits"
>Natural</a
>) :: <a href="#" title="GHC.TypeLits"
=====================================
utils/haddock/html-test/ref/Bug548.html
=====================================
@@ -119,6 +119,8 @@
> -> <a href="#" title="Data.Kind"
>Type</a
>)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc empty"
> </td
@@ -259,6 +261,8 @@
> (<a href="#" title="Bug548"
>WrappedArrow</a
> a b)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -335,6 +339,8 @@
> (<a href="#" title="Bug548"
>WrappedArrow</a
> a b)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -427,6 +433,8 @@
> (<a href="#" title="Bug548"
>WrappedArrow</a
> a b)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -489,6 +497,8 @@
> (<a href="#" title="Bug548"
>WrappedArrow</a
> a b c)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -723,6 +733,8 @@
> (<a href="#" title="Bug548"
>WrappedArrow</a
> a b c)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc empty"
> </td
@@ -857,6 +869,8 @@
> -> <a href="#" title="Data.Kind"
>Type</a
>)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
@@ -929,6 +943,8 @@
> (<a href="#" title="Bug548"
>WrappedArrow</a
> a b c)</span
+ > <a href="#" class="selflink"
+ >#</a
></td
><td class="doc"
><p
=====================================
utils/haddock/html-test/ref/BundledPatterns.html
=====================================
@@ -80,7 +80,7 @@
>Vec</a
> n a -> <a href="#" title="BundledPatterns"
>Vec</a
- > (n <a href="#" title="Bug310"
+ > (n <a href="#" title="GHC.TypeLits"
>+</a
> 1) a</li
></ul
@@ -114,7 +114,7 @@
>RTree</a
> d a -> <a href="#" title="BundledPatterns"
>RTree</a
- > (d <a href="#" title="Bug310"
+ > (d <a href="#" title="GHC.TypeLits"
>+</a
> 1) a</li
></ul
@@ -193,7 +193,7 @@
>Vec</a
> n a -> <a href="#" title="BundledPatterns"
>Vec</a
- > (n <a href="#" title="Bug310"
+ > (n <a href="#" title="GHC.TypeLits"
>+</a
> 1) a <span class="fixity"
>infixr 5</span
@@ -398,7 +398,7 @@
>RTree</a
> d a -> <a href="#" title="BundledPatterns"
>RTree</a
- > (d <a href="#" title="Bug310"
+ > (d <a href="#" title="GHC.TypeLits"
>+</a
> 1) a</td
><td class="doc"
=====================================
utils/haddock/html-test/ref/BundledPatterns2.html
=====================================
@@ -72,7 +72,7 @@
>Vec</a
> n a -> <a href="#" title="BundledPatterns2"
>Vec</a
- > (n <a href="#" title="Bug310"
+ > (n <a href="#" title="GHC.TypeLits"
>+</a
> 1) a</li
><li
@@ -114,7 +114,7 @@
>RTree</a
> d a -> <a href="#" title="BundledPatterns2"
>RTree</a
- > (d <a href="#" title="Bug310"
+ > (d <a href="#" title="GHC.TypeLits"
>+</a
> 1) a</li
></ul
@@ -175,7 +175,7 @@
>Vec</a
> n a -> <a href="#" title="BundledPatterns2"
>Vec</a
- > (n <a href="#" title="Bug310"
+ > (n <a href="#" title="GHC.TypeLits"
>+</a
> 1) a <span class="fixity"
>infixr 5</span
@@ -392,7 +392,7 @@
>RTree</a
> d a -> <a href="#" title="BundledPatterns2"
>RTree</a
- > (d <a href="#" title="Bug310"
+ > (d <a href="#" title="GHC.TypeLits"
>+</a
> 1) a</td
><td class="doc"
=====================================
utils/haddock/html-test/src/Bug310.hs
=====================================
@@ -1,5 +1,5 @@
{-# LANGUAGE Haskell2010 #-}
{-# LANGUAGE ExplicitNamespaces #-}
-module Bug310 ( type (+) ) where
+module Bug310 ( type (-) ) where
import GHC.TypeLits
=====================================
utils/haddock/hypsrc-test/Main.hs
=====================================
@@ -20,11 +20,13 @@ checkConfig = CheckConfig
, ccfgEqual = (==) `on` dumpXml
}
where
- strip _ = stripAnchors' . stripLinks' . stripIds' . stripFooter
-
+ strip _ = fixPaths . stripAnchors' . stripLinks' . stripIds' . stripFooter
+
stripLinks' = stripLinksWhen $ \href -> "#local-" `isPrefixOf` href
stripAnchors' = stripAnchorsWhen $ \name -> "local-" `isPrefixOf` name
stripIds' = stripIdsWhen $ \name -> "local-" `isPrefixOf` name
+ -- One-shot hyperlinked source links to other modules as if they are in another package
+ fixPaths = fixAttrValueWhen "href" (drop 7) ("../src/" `isPrefixOf`)
dirConfig :: DirConfig
=====================================
utils/haddock/latex-test/Main.hs
=====================================
@@ -21,6 +21,8 @@ checkConfig = CheckConfig
dirConfig :: DirConfig
dirConfig = (defaultDirConfig $ takeDirectory __FILE__)
{ dcfgCheckIgnore = (`elem` ["haddock.sty", "main.tex"]) . takeFileName
+ -- Just a discrepancy in output order
+ , dcfgCheckIgnoreOneShot = (`elem` ["ConstructorArgs.tex"]) . takeFileName
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8bf6fd68001bc1dabdd974506fc735e22e8257a9...74ec4c0640e96feb8930b96e9ec64dd0aa03f2bf
--
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8bf6fd68001bc1dabdd974506fc735e22e8257a9...74ec4c0640e96feb8930b96e9ec64dd0aa03f2bf
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240709/90db88cb/attachment-0001.html>
More information about the ghc-commits
mailing list