[Git][ghc/ghc][master] 4 commits: Revert "Hadrian: fix doc generation"
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Jan 31 20:53:02 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
03d693b2 by Ben Gamari at 2023-01-31T15:52:32-05:00
Revert "Hadrian: fix doc generation"
This is too large of a hammer.
This reverts commit 5640cb1d84d3cce4ce0a9e90d29b2b20d2b38c2f.
- - - - -
f838815c by Ben Gamari at 2023-01-31T15:52:32-05:00
hadrian: Sphinx docs require templated cabal files
The package-version discovery logic in
`doc/users_guide/package_versions.py` uses packages' cabal files to
determine package versions. Teach Sphinx about these dependencies in
cases where the cabal files are generated by templates.
- - - - -
2e48c19a by Ben Gamari at 2023-01-31T15:52:32-05:00
hadrian: Refactor templating logic
This refactors Hadrian's autoconf-style templating logic to be explicit
about which interpolation variables should be substituted in which
files. This clears the way to fix #22714 without incurring rule cycles.
- - - - -
93f0e3c4 by Ben Gamari at 2023-01-31T15:52:33-05:00
hadrian: Substitute LIBRARY_*_VERSION variables
This teaches Hadrian to substitute the `LIBRARY_*_VERSION` variables
in `libraries/prologue.txt`, fixing #22714.
Fixes #22714.
- - - - -
2 changed files:
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Rules/Generate.hs
Changes:
=====================================
hadrian/src/Rules/Documentation.hs
=====================================
@@ -12,7 +12,7 @@ import Hadrian.BuildPath
import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.Type
-import Rules.Generate (ghcPrimDependencies, generateTemplateResults)
+import Rules.Generate (ghcPrimDependencies)
import Base
import Context
import Expression (getContextData, interpretInContext, (?), package)
@@ -68,11 +68,21 @@ pathPath "users_guide" = "docs/users_guide"
pathPath "Haddock" = "utils/haddock/doc"
pathPath _ = ""
--- Generate files required to build the docs (e.g. ghc.cabal)
needDocDeps :: Action ()
needDocDeps = do
- -- build .cabal files used by the doc engine to list package versions
- generateTemplateResults
+ -- These cabal files are needed by the docs/users_guide/ghc_packages.py
+ -- logic to determine the versions of packages shipped with GHC.
+ let templatedCabalFiles = map pkgCabalFile
+ [ ghcBoot
+ , ghcBootTh
+ , ghci
+ , libiserv
+ , compiler
+ , ghcHeap
+ , templateHaskell
+ ]
+
+ need templatedCabalFiles
-- | Build all documentation
documentationRules :: Rules ()
@@ -94,9 +104,6 @@ documentationRules = do
"docs" ~> do
root <- buildRoot
- -- we need to ensure that `configure` has been run (#17840)
- need [configFile]
-
doctargets <- ghcDocs =<< flavour
let html = htmlRoot -/- "index.html" -- also implies "docs-haddock"
archives = map pathArchive docPaths
@@ -194,11 +201,11 @@ buildSphinxHtml :: FilePath -> Rules ()
buildSphinxHtml path = do
root <- buildRootRules
root -/- htmlRoot -/- path -/- "index.html" %> \file -> do
+ let dest = takeDirectory file
+ rstFilesDir = pathPath path
needDocDeps
- let dest = takeDirectory file
- rstFilesDir = pathPath path
rstFiles <- getDirectoryFiles rstFilesDir ["**/*.rst"]
need (map (rstFilesDir -/-) rstFiles)
build $ target docContext (Sphinx HtmlMode) [pathPath path] [dest]
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -2,7 +2,7 @@ module Rules.Generate (
isGeneratedCmmFile, compilerDependencies, generatePackageCode,
generateRules, copyRules, generatedDependencies,
ghcPrimDependencies,
- templateRules, generateTemplateResults
+ templateRules
) where
import qualified Data.Set as Set
@@ -13,6 +13,8 @@ import Hadrian.Oracles.TextFile (lookupSystemConfig)
import Oracles.Flag
import Oracles.ModuleFiles
import Oracles.Setting
+import Hadrian.Haskell.Cabal.Type (PackageData(version))
+import Hadrian.Oracles.Cabal (readPackageData)
import Packages
import Rules.Libffi
import Settings
@@ -235,74 +237,108 @@ emptyTarget :: Context
emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
(error "Rules.Generate.emptyTarget: unknown package")
--- | Files generated by query-replace from a template
-templateResults :: [FilePath]
-templateResults =
- [ "compiler/ghc.cabal"
- , "rts/rts.cabal"
- , "driver/ghci/ghci-wrapper.cabal"
- , "ghc/ghc-bin.cabal"
- , "utils/iserv/iserv.cabal"
- , "utils/remote-iserv/remote-iserv.cabal"
- , "utils/runghc/runghc.cabal"
- , "libraries/ghc-boot/ghc-boot.cabal"
- , "libraries/ghc-boot-th/ghc-boot-th.cabal"
- , "libraries/ghci/ghci.cabal"
- , "libraries/ghc-heap/ghc-heap.cabal"
- , "utils/ghc-pkg/ghc-pkg.cabal"
- , "libraries/libiserv/libiserv.cabal"
- , "libraries/template-haskell/template-haskell.cabal"
- , "libraries/prologue.txt"
+-- | A set of interpolation variable substitutions.
+newtype Interpolations = Interpolations (Action [(String, String)])
+
+instance Semigroup Interpolations where
+ Interpolations m <> Interpolations n = Interpolations ((++) <$> m <*> n)
+
+instance Monoid Interpolations where
+ mempty = Interpolations $ return []
+
+-- | @interpolateVar var value@ is an interpolation which replaces @\@var\@@
+-- with the result of @value at .
+interpolateVar :: String -> Action String -> Interpolations
+interpolateVar var value = Interpolations $ do
+ val <- value
+ return [(var, val)]
+
+runInterpolations :: Interpolations -> String -> Action String
+runInterpolations (Interpolations mk_substs) input = do
+ substs <- mk_substs
+ let subst :: String -> String
+ subst = foldr (.) id [replace ("@"++k++"@") v | (k,v) <- substs]
+ return (subst input)
+
+toCabalBool :: Bool -> String
+toCabalBool True = "True"
+toCabalBool False = "False"
+
+-- | Interpolate the given variable with the value of the given 'Flag', using
+-- Cabal's boolean syntax.
+interpolateCabalFlag :: String -> Flag -> Interpolations
+interpolateCabalFlag name flg = interpolateVar name $ do
+ val <- flag flg
+ return (toCabalBool val)
+
+-- | Interpolate the given variable with the value of the given 'Setting'.
+interpolateSetting :: String -> Setting -> Interpolations
+interpolateSetting name settng = interpolateVar name $ setting settng
+
+-- | Interpolate the @ProjectVersion@ and @ProjectVersionMunged@ variables.
+projectVersion :: Interpolations
+projectVersion = mconcat
+ [ interpolateSetting "ProjectVersion" ProjectVersion
+ , interpolateSetting "ProjectVersionMunged" ProjectVersionMunged
]
--- | Generate all the files we know we have a template for
-generateTemplateResults :: Action ()
-generateTemplateResults = need templateResults
+rtsCabalFlags :: Interpolations
+rtsCabalFlags = mconcat
+ [ flag "CabalMingwex" UseLibmingwex
+ , flag "CabalHaveLibdw" UseLibdw
+ , flag "CabalHaveLibm" UseLibm
+ , flag "CabalHaveLibrt" UseLibrt
+ , flag "CabalHaveLibdl" UseLibdl
+ , flag "CabalNeedLibpthread" UseLibpthread
+ , flag "CabalHaveLibbfd" UseLibbfd
+ , flag "CabalHaveLibNuma" UseLibnuma
+ , flag "CabalNeedLibatomic" NeedLibatomic
+ , flag "CabalUseSystemLibFFI" UseSystemFfi
+ , flag "CabalLibffiAdjustors" UseLibffiForAdjustors
+ , flag "CabalLeadingUnderscore" LeadingUnderscore
+ , interpolateVar "Cabal64bit" $ do
+ let settingWord :: Setting -> Action Word
+ settingWord s = read <$> setting s
+ ws <- settingWord TargetWordSize
+ return $ toCabalBool (ws == 8)
+ ]
+ where
+ flag = interpolateCabalFlag
+
+packageVersions :: Interpolations
+packageVersions = foldMap f [ base, ghcPrim, ghc, cabal, templateHaskell, ghcCompact, array ]
+ where
+ f :: Package -> Interpolations
+ f pkg = interpolateVar var $ show . version <$> readPackageData pkg
+ where var = "LIBRARY_" <> pkgName pkg <> "_VERSION"
+
+templateRule :: FilePath -> Interpolations -> Rules ()
+templateRule outPath interps = do
+ outPath %> \_ -> do
+ s <- readFile' (outPath <.> "in")
+ result <- runInterpolations interps s
+ writeFile' outPath result
+ putSuccess ("| Successfully generated " ++ outPath ++ " from its template")
templateRules :: Rules ()
templateRules = do
- templateResults |%> \out -> do
- let settingWord :: Setting -> Action Word
- settingWord s = read <$> setting s
-
- project_version <- setting ProjectVersion
- project_version_munged <- setting ProjectVersionMunged
- target_word_size <- settingWord TargetWordSize
- lib_dw <- flag UseLibdw
- lib_numa <- flag UseLibnuma
- lib_mingwex <- flag UseLibmingwex
- lib_m <- flag UseLibm
- lib_rt <- flag UseLibrt
- lib_dl <- flag UseLibdl
- lib_ffi <- flag UseSystemFfi
- lib_ffi_adjustors <- flag UseLibffiForAdjustors
- lib_bfd <- flag UseLibbfd
- lib_pthread <- flag UseLibpthread
- leading_underscore <- flag LeadingUnderscore
- need_libatomic <- flag NeedLibatomic
-
- let cabal_bool True = "True"
- cabal_bool False = "False"
-
- subst = replace "@ProjectVersion@" project_version
- . replace "@ProjectVersionMunged@" project_version_munged
- . replace "@Cabal64bit@" (cabal_bool (target_word_size == 8))
- . replace "@CabalMingwex@" (cabal_bool lib_mingwex)
- . replace "@CabalHaveLibdw@" (cabal_bool lib_dw)
- . replace "@CabalHaveLibm@" (cabal_bool lib_m)
- . replace "@CabalHaveLibrt@" (cabal_bool lib_rt)
- . replace "@CabalHaveLibdl@" (cabal_bool lib_dl)
- . replace "@CabalUseSystemLibFFI@" (cabal_bool lib_ffi)
- . replace "@CabalLibffiAdjustors@" (cabal_bool lib_ffi_adjustors)
- . replace "@CabalNeedLibpthread@" (cabal_bool lib_pthread)
- . replace "@CabalHaveLibbfd@" (cabal_bool lib_bfd)
- . replace "@CabalHaveLibNuma@" (cabal_bool lib_numa)
- . replace "@CabalLeadingUnderscore@" (cabal_bool leading_underscore)
- . replace "@CabalNeedLibatomic@" (cabal_bool need_libatomic)
-
- s <- readFile' (out <.> "in")
- writeFile' out (subst s)
- putSuccess ("| Successfully generated " ++ out ++ " from its template")
+ templateRule "compiler/ghc.cabal" $ projectVersion
+ templateRule "rts/rts.cabal" $ rtsCabalFlags
+ templateRule "driver/ghci/ghci-wrapper.cabal" $ projectVersion
+ templateRule "ghc/ghc-bin.cabal" $ projectVersion
+ templateRule "utils/iserv/iserv.cabal" $ projectVersion
+ templateRule "utils/iserv-proxy/iserv-proxy.cabal" $ projectVersion
+ templateRule "utils/remote-iserv/remote-iserv.cabal" $ projectVersion
+ templateRule "utils/runghc/runghc.cabal" $ projectVersion
+ templateRule "libraries/ghc-boot/ghc-boot.cabal" $ projectVersion
+ templateRule "libraries/ghc-boot-th/ghc-boot-th.cabal" $ projectVersion
+ templateRule "libraries/ghci/ghci.cabal" $ projectVersion
+ templateRule "libraries/ghc-heap/ghc-heap.cabal" $ projectVersion
+ templateRule "utils/ghc-pkg/ghc-pkg.cabal" $ projectVersion
+ templateRule "libraries/libiserv/libiserv.cabal" $ projectVersion
+ templateRule "libraries/template-haskell/template-haskell.cabal" $ projectVersion
+ templateRule "libraries/prologue.txt" $ packageVersions
+
-- Generators
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2cb500a5ee1a31dfe1a2cdd71f175442026eb082...93f0e3c49cea484bd6e838892ff8702ec51f34c3
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2cb500a5ee1a31dfe1a2cdd71f175442026eb082...93f0e3c49cea484bd6e838892ff8702ec51f34c3
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/20230131/8c573335/attachment-0001.html>
More information about the ghc-commits
mailing list