- ghc-commits - Haskell.org

[Git][ghc/ghc] Pushed new branch wip/27162/rts-explicit-dllimport_work
by David Eichmann (＠DavidEichmann) 28 Apr '26

28 Apr '26

David Eichmann pushed new branch wip/27162/rts-explicit-dllimport_work at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/27162/rts-explicit-dllimport_… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: ghc: Distinguish between having an interpreter and having an internal one
by Marge Bot (＠marge-bot) 28 Apr '26

28 Apr '26

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 366fd8dc by Sven Tennie at 2026-04-28T09:02:22-04:00 ghc: Distinguish between having an interpreter and having an internal one Actually, these are related but different things: - ghc can run an interpreter (either internal or external) - ghc is compiled with an internal interpreter Splitting the logic solves compiler warnings and expresses the intent better. - - - - - 65d3f5cb by Vladislav Zavialov at 2026-04-28T09:02:22-04:00 Refactor HsWildCardTy to use HoleKind (#27111) The payload of this patch is that the extension fields of HsWildCardTy and HsHole now match: type instance XWildCardTy Ghc{Ps,Rn} = HoleKind type instance XHole Ghc{Ps,Rn} = HoleKind This is progress towards unification of HsExpr and HsType. Test case: T25121_status In addition to that, exact-printing of infix holes is fixed. Test case: PprInfixHole - - - - - 5c151036 by fendor at 2026-04-28T09:02:23-04:00 Expose startupHpc as an rts symbol - - - - - 4f2b28ad by fendor at 2026-04-28T09:02:23-04:00 Make HPC work with bytecode interpreter Add support to generate .tix files from bytecode objects and the bytecode interpreter. Conceptually, we insert HPC ticks into the bytecode similar to how we insert breakpoints. HPC and breakpoints do not share the same tick array but we use a separate tick-array for hpc/breakpoint ticks during bytecode generation. We teach the bytecode interpreter to handle hpc ticks. The implementation is quite trivial, simply increment the counter in the global hpc_ticks array for the respective module. This hpc_ticks array is generated as part of the `CStub`, so we can rely on it existing. A tricky bit is "registering" a bytecode object for HPC instrumentation. In the compiled case, this is achieved via CStub and initializer/finalizers `.init` sections which are called when the executable is run. After the initializers have been invoked, which is before `hs_init_ghc`, we then call `startup_hpc` in `hs_init_ghc` iff any modules were "registered" for hpc instrumentation via `hs_hpc_module`. Since bytecode objects are loaded after starting up GHCi, this workflow doesn't work for supporting `hpc` and the `hpc` run-time is never started, even if a module is added for instrumentation. We fix this issue by employing the same technique as is for `SptEntry`s: * We introduce a new field to `CompiledByteCode`, called `ByteCodeHpcInfo` which contains enough information to call `hs_hpc_module`, allowing us to register the module for `hpc` instrumentation`. * After registering the module, we unconditionally call `startupHpc`, to make sure the .tix file is written. Calling `startupHpc` multiple times is safe. Calling `hs_hpc_module` multiple times for the same module is also safe. If we didn't register the hpc module in this way, evaluating a bytecode object instrumented with `-fhpc` without registering it in the `hpc` run-time will simply not generate any `.tix` files for this bytecode object. However, this shouldn't happen if everything is set up correctly. Closes #27036 - - - - - 0cf0c1e6 by Vladislav Zavialov at 2026-04-28T09:02:24-04:00 Move NamespaceSpecifier from x-fields into the AST proper (#26678) This refactoring moves NamespaceSpecifier out of extension fields and into the AST proper, as it is part of the user-written source, and is not pass-specific. Summary of changes: * Move NamespaceSpecifier from GHC/Hs/Basic.hs to Language/Haskell/Syntax/ImpExp.hs and parameterise it by the compiler pass, creating the necessary extension points * Move NamespaceSpecifier out of XFixitySig into FixitySig * Move NamespaceSpecifier out of XIEThingAll (IEThingAllExt) into IEThingAll * Move NamespaceSpecifier out of XIEWholeNamespace (IEWholeNamespaceExt) into IEWholeNamespace This is a pure refactoring with no change in behaviour. - - - - - f88ba364 by Simon Peyton Jones at 2026-04-28T09:02:26-04:00 Fix assertion check in checkResultTy As #27210 shows, the assertion was a little bit too eager. I refactored a bit by moving some code from GHC.Tc.Gen.App to GHC.Tc.Utils.Unify; see the new function tcSubTypeApp, which replaces tcSubTypeDS - - - - - 108 changed files: - + changelog.d/T19174.md - + changelog.d/bytecode-interpreter-hpc-support - + changelog.d/ghc-api-holes-ast-27111 - + changelog.d/ghc-api-namespace-specifier-26678 - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Binary.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Driver/Backend.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Hs/Basic.hs - compiler/GHC/Hs/Binds.hs - compiler/GHC/Hs/Decls.hs - compiler/GHC/Hs/Expr.hs-boot - compiler/GHC/Hs/ImpExp.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Coverage.hs - compiler/GHC/HsToCore/Docs.hs - compiler/GHC/HsToCore/Quote.hs - compiler/GHC/HsToCore/Ticks.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Iface/Tidy.hs - compiler/GHC/Linker/Loader.hs - compiler/GHC/Parser.y - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Rename/Bind.hs - compiler/GHC/Rename/Env.hs - compiler/GHC/Rename/HsType.hs - compiler/GHC/Rename/Module.hs - compiler/GHC/Rename/Names.hs - compiler/GHC/Rename/Pat.hs - compiler/GHC/Runtime/Interpreter.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Export.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/HsType.hs - compiler/GHC/Tc/Gen/Pat.hs - compiler/GHC/Tc/Utils/Unify.hs - compiler/GHC/ThToHs.hs - compiler/GHC/Types/HpcInfo.hs - compiler/GHC/Types/Name/Reader.hs - compiler/GHC/Unit/Module/ModGuts.hs - compiler/Language/Haskell/Syntax/Binds.hs - compiler/Language/Haskell/Syntax/Decls.hs - compiler/Language/Haskell/Syntax/Extension.hs - compiler/Language/Haskell/Syntax/ImpExp.hs - ghc/GHC/Driver/Session/Mode.hs - ghc/GHCi/UI.hs - ghc/Main.hs - ghc/ghc-bin.cabal.in - hadrian/src/Settings/Packages.hs - + libraries/ghci/GHCi/Coverage.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - libraries/ghci/ghci.cabal.in - rts/Disassembler.c - rts/Hpc.c - rts/Interpreter.c - rts/RtsSymbols.c - rts/include/rts/Bytecodes.h - testsuite/tests/ghc-api/T25121_status.stdout - testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr - testsuite/tests/hpc/Makefile - testsuite/tests/hpc/T17073.stdout → testsuite/tests/hpc/T17073a.stdout - + testsuite/tests/hpc/T17073b.stdout - testsuite/tests/hpc/T20568.stdout → testsuite/tests/hpc/T20568a.stdout - + testsuite/tests/hpc/T20568b.stdout - testsuite/tests/hpc/all.T - testsuite/tests/hpc/fork/Makefile - testsuite/tests/hpc/function/Makefile - testsuite/tests/hpc/function/test.T - + testsuite/tests/hpc/function/tough1.stderr - + testsuite/tests/hpc/function/tough1.stdout - testsuite/tests/hpc/function2/test.T - + testsuite/tests/hpc/function2/tough3.script - + testsuite/tests/hpc/ghc_ghci/BytecodeMain.hs - testsuite/tests/hpc/ghc_ghci/Makefile - + testsuite/tests/hpc/ghc_ghci/hpc_ghc_ghci_bytecode.stdout - + testsuite/tests/hpc/ghc_ghci/hpc_ghci01.stdout - + testsuite/tests/hpc/ghc_ghci/hpc_ghci02.stdout - testsuite/tests/hpc/ghc_ghci/test.T - testsuite/tests/hpc/simple/Makefile - + testsuite/tests/hpc/simple/hpc002.hs - + testsuite/tests/hpc/simple/hpc002.stdout - + testsuite/tests/hpc/simple/hpc003.hs - + testsuite/tests/hpc/simple/hpc003.script - + testsuite/tests/hpc/simple/hpc003.stdout - testsuite/tests/hpc/simple/test.T - testsuite/tests/parser/should_compile/T20846.stderr - testsuite/tests/printer/Makefile - + testsuite/tests/printer/PprInfixHole.hs - testsuite/tests/printer/all.T - + testsuite/tests/typecheck/should_fail/T27210.hs - + testsuite/tests/typecheck/should_fail/T27210.stderr - testsuite/tests/typecheck/should_fail/all.T - utils/check-exact/ExactPrint.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs - utils/haddock/haddock-api/src/Haddock/Convert.hs - utils/haddock/haddock-api/src/Haddock/GhcUtils.hs - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e326cd4cc39d48d8e03dbe41a518e3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e326cd4cc39d48d8e03dbe41a518e3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/27162/rts-explicit-dllimport] 28 commits: Simplify mkTick
by David Eichmann (＠DavidEichmann) 28 Apr '26

28 Apr '26

David Eichmann pushed to branch wip/27162/rts-explicit-dllimport at Glasgow Haskell Compiler / GHC Commits: 2dadf3b0 by sheaf at 2026-04-16T13:28:39-04:00 Simplify mkTick This commit simplifies 'GHC.Core.Utils.mkTick', removing the accumulating parameter 'rest' which was suspiciously treating a bunch of different ticks as a group, and moving the group as a whole around the AST, ignoring that the ticks in the group might have different placement properties. The most important change is that we revert the logic (added in 85b0aae2) that allowed ticks to be placed around coercions, which caused serious issues (e.g. #27121). It was just a mistake, as it doesn't make sense to put a tick around a coercion. Also adds Note [Pushing SCCs inwards] which clarifies the logic for pushing SCCs into lambdas, constructor applications, and dropping SCCs around non-function variables (in particular the treatment of splittable ticks). A few other changes are also implemented: - simplify 'can_split' predicate (no functional change) - combine profiling ticks into one when possible Fixes #26878, #26941 and #27121 Co-authored-by: simonpj <simon.peytonjones(a)gmail.com> - - - - - a0d6f1f4 by Simon Jakobi at 2026-04-16T13:29:28-04:00 Add regression test for #9074 Closes #9074. - - - - - d178ee89 by Sylvain Henry at 2026-04-16T13:30:25-04:00 Add changelog for #15973 - - - - - e8a196c6 by sheaf at 2026-04-16T13:31:19-04:00 Deal with 'noSpec' in 'coreExprToPmLit' This commit makes two separate changes relating to 'GHC.HsToCore.Pmc.Solver.Types.coreExprAsPmLit': 1. Commit 7124e4ad mistakenly marked deferred errors as non-canonical, which led to the introduction of 'nospec' wrappers in the generated Core. This reverts that accident by declaring deferred errors as being canonical, avoiding spurious 'nospec' wrapping. 2. Look through magic identity-like Ids such as 'nospec', 'inline' and 'lazy' in 'coreExprAsPmLit', just like Core Prep does. There might genuinely be incoherent evidence, but that shouldn't obstruct the pattern match checker. See test T27124a. Fixes #25926 #27124 ------------------------- Metric Decrease: T3294 ------------------------- - - - - - 8cb99552 by Sylvain Henry at 2026-04-16T19:22:43-04:00 hadrian: warn when package index is missing (#16484) Since cabal-install 3.0 we can query the path of remote-repo-cache and check if hackage package index is present. Fixes #16484 - - - - - d6ce7477 by Richard Eisenberg at 2026-04-16T19:23:25-04:00 Teach hadrian to --skip-test. Fixes #27188. This adds the --skip-test flag to `hadrian build`, as documented in the patch. - - - - - 7666f4a9 by Fendor at 2026-04-17T22:29:51-04:00 Migrate `ghc-pkg` to use `OsPath` and `file-io` `ghc-pkg` should use UNC paths as much as possible to avoid MAX_PATH issues on windows. `file-io` uses UNC Paths by default on windows, ensuring we use the correct APIs and that we finally are no longer plagued by MAX_PATH issues in CI and private machines. On top of it, the higher correctness of `OsPath` is appreciated in this small codebase. Also, we improve memory usage very slightly, due to the more efficient memory representation of `OsPath` over `FilePath` Adds `ghc-pkg` regression test for MAX_PATH on windows Make sure `ghc-pkg` behaves as expected when long paths (> 255) are involved on windows. Let's generate a testcase where we can actually observe that `ghc-pkg` behaves as epxected. See the documentation for windows on Maximum Path Length Limitation: * `https://learn.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation` Adds changelog entry for long path support in ghc-pkg. - - - - - 78434e8c by Simon Peyton Jones at 2026-04-17T22:30:38-04:00 Kill off the substitution in Lint Now that we have invariant (NoTypeShadowing) we no longer need Lint to carry an ambient substitution. This makes it simpler and faster. A really worthwhile refactor. There are some knock-on effects * Linting join points after worker/wrapper. See Note [Join points and beta redexes] * Running a type substitution after the desugarer. See Note [Substituting type-lets] in the new module GHC.Core.SubstTypeLets Implements #27078 Most perf tests don't use Lint so we won't see a perf incresae. But T1969, which uses -O0 and Lint, gets 1.3% worse because it has to run the SubstTypeLets pass which is a somewhat expensive no-op Overall though compile-time allocations are down 0.1%. Metric Increase: T1969 - - - - - 86ca6c2c by mangoiv at 2026-04-17T22:31:22-04:00 testsuite: inline elemCoreTest Some weird (probably python scoping) rule caused elemCoreTest, a regex being out of scope on ubuntu, presumably because of a newer python version. This patch just inlines the regex, which fixes the issue. Fixes #27193 - - - - - 72d6dc74 by aparker at 2026-04-20T20:15:44-04:00 NCG: Implement constant folding for vector simd ops (Issue #25030) - - - - - b9cab907 by sheaf at 2026-04-20T20:15:44-04:00 Mark some SIMD tests as broken on i386 optllvm As seen in #25498, several SIMD tests are broken on i386 in the optllvm way. This commit marks them as "expect_broken". - - - - - 76528cc3 by Wolfgang Jeltsch at 2026-04-20T20:16:25-04:00 Move most of the `System.IO` implementation into `base` This involves a rewrite of the `combine` helper function to avoid the use of `last`, which would now be flagged as an error. Metric Decrease: LinkableUsage01 T3294 Metric Increase: T12227 T12707 T5642 - - - - - 04d143c0 by Luite Stegeman at 2026-04-21T14:05:33-04:00 rts: add a few missing i386 relocations in the rts linker - - - - - 014087e7 by Luite Stegeman at 2026-04-21T14:05:34-04:00 CodeOutput: Fix finalizers on multiple platforms - ELF platforms: emit .fini_array section - wasm32/Darwin: emit initializer with __cxa_atexit call - Windows: use -Wl,--whole-archive to prevent dropping finalizer symbols - rts linker: fix crash/assertion failure unloading objects with finalizers fixes #27072 - - - - - 915bba6f by Simon Jakobi at 2026-04-21T14:06:16-04:00 Add regression test for #10531 Closes #10531. - - - - - 86a646a6 by Andreas Klebinger at 2026-04-22T13:00:05-04:00 Revert use of generic instances for compiler time perf reasons. Revert "Derive Semigroup/Monoid for instances believed could be derived in #25871" This reverts commit 11a04cbb221cc404fe00d65d7c951558ede4caa9. Revert "add Ghc.Data.Pair deriving" This reverts commit 15d9ce449e1be8c01b89fd39bdf1e700ea7d1dce. - - - - - bc9ee1cf by Wen Kokke at 2026-04-22T13:00:51-04:00 hadrian: Fix docs to remove static flavour In 638f6548, the static flavour was turned into into the fully_static flavour transformer. However, this commit did not update flavours.md. - - - - - cc9cc6d5 by Cheng Shao at 2026-04-23T09:40:46+00:00 configure: bump LlvmMaxVersion to 23 This patch bumps `LlvmMaxVersion` to 23 to support LLVM 22.x releases. - - - - - 2ea7ef8e by Cheng Shao at 2026-04-23T09:46:26+00:00 changelog: add llvm 22.x support - - - - - 5574ee10 by Cheng Shao at 2026-04-24T08:24:30-04:00 compiler: avoid unused temporary `appendFS` operands This patch fixes unused temporary `appendFS` operands in the codebase that are retained in the `FastString` table after concatenation. Rewrite rules are added so that if an operand is `fsLit`/`mkFastString`, the `appendFS` application is rewritten to append the `ShortByteString` operands first. The patch also fixes `sconcat` behavior to align with `mconcat` for the same reason. Fixes #27205. - - - - - 4ed78760 by mangoiv at 2026-04-24T08:25:13-04:00 contributing: adjust MR template to be less verbose - MR template only shows text that is relevant for submissiong - MR template was rewritten so it's readable from a user's and reviewer's perspective Resolves #27165 Co-Authored-By: @sheaf - - - - - 87db83e2 by Cheng Shao at 2026-04-24T14:37:21-04:00 ci: bump freebsd boot ghc to 9.10.3 This commit bumps freebsd boot ghc to 9.10.3 to align with other platforms and prevent outdated boot libs in boot ghc to block the freebsd job. - - - - - 17e3a0b7 by Cheng Shao at 2026-04-24T14:37:21-04:00 compiler: improve Binary instance of Array This patch improves the `Binary` instance of `Array`: - We no longer allocate intermediate lists. When serializing an `Array`, we iterate over the elements directly; when deserializing it, we allocate the result `Array` and fill it in a loop. - Now we only serialize the array bounds tuple; the length field is not needed. Closes #27109. - - - - - 2d30f7d3 by sheaf at 2026-04-24T14:38:23-04:00 Vendor mini-QuickCheck for testsuite This commit extracts the vendored QuickCheck implementation from the foundation testsuite to make it more broadly available in the GHC testsuite, and makes use of it in the simd006 test (which also used a vendored QuickCheck implementation). On the way, we update the linear congruential generator to avoid the shortcoming of only generating 31 bit large numbers. Fixes #25990 and #25969. - - - - - 1350271b by sheaf at 2026-04-27T09:32:53-04:00 Ensure TcM plugins are only initialised once This commit ensures we keep TcM plugins (typechecker plugins, defaulting plugins and hole fit plugins) running all the way through desugaring, instead of stopping them at the end of typechecking. To do this, the "stop" actions of TcPlugin and DefaultingPlugin are split into two: one for the "post-typecheck" action, and one for the final shutdown action (after desugaring). This allows the plugins to be invoked by the pattern match checker (during desugaring) without having to be repeatedly re-initialised and stopped, fixing #26839. In the process, this commit modifies 'initTc' and 'initTcInteractive', adding an extra argument that describes whether to start/stop the 'TcM' plugins. See Note [Stop TcM plugins after desugaring] for an overview. - - - - - 42549222 by sheaf at 2026-04-27T09:33:50-04:00 Hadrian: add --keep-response-files This commit adds a Hadrian flag that allows response files to be retained. This is useful for debugging a failing Hadrian command line. - - - - - 40564e8d by sheaf at 2026-04-27T09:34:46-04:00 hadrian/build-cabal.bat: fix build on Windows Commit 8cb99552f6 introduced a warning for a missing package index. However, the logic was faulty on Windows: the piping was broken, and "remote-repo-cache:" was being interpreted as a (malformed) drive letter, leading to the error: The filename, directory name, or volume label syntax is incorrect. This commit fixes that by using a temporary file instead of piping. - - - - - b10444a1 by Duncan Coutts at 2026-04-28T13:14:52+01:00 Use __attribute__((dllimport)) for external RTS symbol declarations This is needed to be hygenic about DLL symbol imports and exports. The attribute is ignored on platforms other than Windows. Use of the attribute however means that external data symbols do not have a compile-time constant address (they are loaded using an indirection). This means we have to adjust the rtsSyms initial linker table so that it is a local constant in a function, rather than a global constant. We now define it within a function that pre-populates the symbol table with the RTS symbols. - - - - - 206 changed files: - .gitlab/generate-ci/gen_ci.hs - .gitlab/jobs.yaml - .gitlab/merge_request_templates/Default.md - + changelog.d/T15973 - + changelog.d/T27121.md - + changelog.d/T27124.md - + changelog.d/binary-array-no-list - + changelog.d/fix-finalizers-27072 - + changelog.d/ghc-pkg-long-path-support - + changelog.d/hadrian-response-files.md - + changelog.d/hadrian-warn-missing-package-index-16484 - + changelog.d/llvm-22 - + changelog.d/simd_constant_folding - + changelog.d/skip-test - + changelog.d/tcplugin_init.md - + changelog.d/tcplugins-pmc.md - + changelog.d/typecheckModule-API.md - + changelog.d/withTcPlugins.md - compiler/GHC.hs - compiler/GHC/Cmm/Opt.hs - compiler/GHC/CmmToAsm/X86/CodeGen.hs - compiler/GHC/CmmToLlvm/CodeGen.hs - compiler/GHC/Core/Lint.hs - + compiler/GHC/Core/Lint/SubstTypeLets.hs - compiler/GHC/Core/Opt/FloatOut.hs - compiler/GHC/Core/Opt/OccurAnal.hs - compiler/GHC/Core/Opt/WorkWrap/Utils.hs - compiler/GHC/Core/Subst.hs - compiler/GHC/Core/Utils.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Data/FastString.hs - compiler/GHC/Data/Pair.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Config/Core/Lint.hs - compiler/GHC/Driver/Env/Types.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Pipeline/Monad.hs - compiler/GHC/Driver/Pipeline/Phases.hs - compiler/GHC/Hs/Type.hs - compiler/GHC/HsToCore.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/HsToCore/Pmc/Solver/Types.hs - compiler/GHC/HsToCore/Types.hs - compiler/GHC/Linker/Executable.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Heap/Inspect.hs - compiler/GHC/Runtime/Loader.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Hole.hs - compiler/GHC/Tc/Module.hs - compiler/GHC/Tc/Solver/Default.hs - compiler/GHC/Tc/Solver/Rewrite.hs - compiler/GHC/Tc/Solver/Solve.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Utils/Backpack.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Tc/Utils/TcMType.hs - compiler/GHC/Types/ForeignStubs.hs - compiler/GHC/Types/Tickish.hs - compiler/GHC/Types/Unique/DSet.hs - compiler/GHC/Unit/State.hs - compiler/GHC/Utils/Binary.hs - compiler/GHC/Utils/Misc.hs - compiler/GHC/Utils/Ppr/Colour.hs - compiler/ghc.cabal.in - configure.ac - docs/users_guide/extending_ghc.rst - ghc/GHCi/UI/Info.hs - hadrian/build-cabal - hadrian/build-cabal.bat - hadrian/doc/flavours.md - hadrian/doc/make.md - hadrian/doc/testsuite.md - hadrian/src/Builder.hs - hadrian/src/CommandLine.hs - hadrian/src/Hadrian/Builder/Ar.hs - hadrian/src/Hadrian/Utilities.hs - hadrian/src/Settings/Builders/RunTest.hs - libraries/base/src/Control/Concurrent.hs - libraries/base/src/GHC/IO/Handle.hs - libraries/base/src/Prelude.hs - libraries/base/src/System/IO.hs - libraries/base/src/Text/Printf.hs - libraries/base/tests/perf/all.T - libraries/ghc-boot/GHC/Unit/Database.hs - libraries/ghc-boot/ghc-boot.cabal.in - libraries/ghc-heap/tests/tso_and_stack_closures.hs - libraries/ghc-internal/src/GHC/Internal/System/IO.hs - rts/Linker.c - rts/LinkerInternals.h - rts/RtsSymbols.c - rts/RtsSymbols.h - rts/linker/Elf.c - testsuite/driver/runtests.py - testsuite/driver/testglobals.py - testsuite/driver/testlib.py - + testsuite/tests/MiniQuickCheck.hs - testsuite/tests/cabal/Makefile - testsuite/tests/cabal/all.T - + testsuite/tests/cabal/ghcpkg10.stdout - + testsuite/tests/codeGen/should_run/T27072d.hs - + testsuite/tests/codeGen/should_run/T27072d.stdout - + testsuite/tests/codeGen/should_run/T27072d_c.c - + testsuite/tests/codeGen/should_run/T27072d_check.c - + testsuite/tests/codeGen/should_run/T27072w.hs - + testsuite/tests/codeGen/should_run/T27072w.stdout - + testsuite/tests/codeGen/should_run/T27072w_c.c - testsuite/tests/codeGen/should_run/all.T - testsuite/tests/corelint/LintEtaExpand.stderr - testsuite/tests/corelint/T21115b.stderr - + testsuite/tests/driver/T10531/A.hs - + testsuite/tests/driver/T10531/B.hs - + testsuite/tests/driver/T10531/C.hs - + testsuite/tests/driver/T10531/Makefile - + testsuite/tests/driver/T10531/all.T - testsuite/tests/ghc-api/T26910.hs - testsuite/tests/ghc-api/T6145.hs - + testsuite/tests/ghci/T9074/Makefile - + testsuite/tests/ghci/T9074/T9074.hs - + testsuite/tests/ghci/T9074/T9074.stdout - + testsuite/tests/ghci/T9074/T9074a.c - + testsuite/tests/ghci/T9074/T9074b.c - + testsuite/tests/ghci/T9074/all.T - testsuite/tests/ghci/should_run/tc-plugin-ghci/TcPluginGHCi.hs - testsuite/tests/interface-stability/base-exports.stdout - testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs - testsuite/tests/interface-stability/base-exports.stdout-mingw32 - testsuite/tests/interface-stability/base-exports.stdout-ws-32 - testsuite/tests/numeric/should_run/all.T - testsuite/tests/numeric/should_run/foundation.hs - + testsuite/tests/overloadedstrings/should_fail/T25926.hs - + testsuite/tests/overloadedstrings/should_fail/T25926.stderr - + testsuite/tests/overloadedstrings/should_fail/T27124.hs - + testsuite/tests/overloadedstrings/should_fail/T27124.stderr - + testsuite/tests/overloadedstrings/should_fail/all.T - + testsuite/tests/overloadedstrings/should_run/T27124a.hs - testsuite/tests/overloadedstrings/should_run/all.T - testsuite/tests/plugins/defaulting-plugin/DefaultInterference.hs - testsuite/tests/plugins/defaulting-plugin/DefaultInvalid.hs - testsuite/tests/plugins/defaulting-plugin/DefaultLifted.hs - testsuite/tests/plugins/defaulting-plugin/DefaultMultiParam.hs - testsuite/tests/plugins/echo-plugin/Echo.hs - + testsuite/tests/profiling/should_compile/T27121.hs - + testsuite/tests/profiling/should_compile/T27121_aux.hs - testsuite/tests/profiling/should_compile/all.T - testsuite/tests/quasiquotation/T7918.hs - + testsuite/tests/rts/linker/T27072/Lib.c - + testsuite/tests/rts/linker/T27072/Makefile - + testsuite/tests/rts/linker/T27072/T27072.stdout - + testsuite/tests/rts/linker/T27072/all.T - + testsuite/tests/rts/linker/T27072/main.c - + testsuite/tests/simd/should_run/Makefile - + testsuite/tests/simd/should_run/T25030.hs - + testsuite/tests/simd/should_run/T25030.stdout - testsuite/tests/simd/should_run/all.T - testsuite/tests/simd/should_run/simd006.hs - + testsuite/tests/simplCore/should_compile/T26941.hs - + testsuite/tests/simplCore/should_compile/T26941_aux.hs - testsuite/tests/simplCore/should_compile/all.T - testsuite/tests/tcplugins/Common.hs - testsuite/tests/tcplugins/RewritePerfPlugin.hs - testsuite/tests/tcplugins/T11462_Plugin.hs - testsuite/tests/tcplugins/T11525_Plugin.hs - testsuite/tests/tcplugins/T26395_Plugin.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_Ghci.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_Ghci.script - + testsuite/tests/tcplugins/TcPlugin_InitStop_Ghci.stderr - + testsuite/tests/tcplugins/TcPlugin_InitStop_Ghci.stdout - + testsuite/tests/tcplugins/TcPlugin_InitStop_NoCode.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_NoCode.hs-boot - + testsuite/tests/tcplugins/TcPlugin_InitStop_NoCode.stderr - + testsuite/tests/tcplugins/TcPlugin_InitStop_NoCode_aux.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_Warn.hs - + testsuite/tests/tcplugins/TcPlugin_InitStop_Warn.stderr - testsuite/tests/tcplugins/all.T - + testsuite/tests/tcplugins/tc-plugin-initstop/Makefile - + testsuite/tests/tcplugins/tc-plugin-initstop/Setup.hs - + testsuite/tests/tcplugins/tc-plugin-initstop/TcPlugin_InitStop_Plugin.hs - + testsuite/tests/tcplugins/tc-plugin-initstop/tc-plugin-initstop.cabal - testsuite/tests/th/all.T - testsuite/tests/typecheck/should_compile/T9497a.stderr - testsuite/tests/typecheck/should_compile/holes.stderr - testsuite/tests/typecheck/should_compile/holes3.stderr - testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr - testsuite/tests/typecheck/should_fail/T9497d.stderr - testsuite/tests/typecheck/should_run/T9497a-run.stderr - testsuite/tests/typecheck/should_run/T9497b-run.stderr - testsuite/tests/typecheck/should_run/T9497c-run.stderr - testsuite/tests/wasm/should_run/control-flow/LoadCmmGroup.hs - utils/ghc-pkg/Main.hs - utils/ghc-pkg/ghc-pkg.cabal.in - utils/haddock/haddock-api/src/Haddock/Interface/AttachInstances.hs - utils/haddock/html-test/ref/Bug1004.html - utils/haddock/html-test/ref/Bug973.html - utils/haddock/html-test/ref/ConstructorPatternExport.html - utils/haddock/html-test/ref/DefaultSignatures.html - utils/haddock/html-test/ref/Hash.html - utils/haddock/html-test/ref/PatternSyns.html - utils/haddock/html-test/ref/PatternSyns2.html - utils/haddock/html-test/ref/QuasiExpr.html - utils/haddock/html-test/ref/Test.html The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d28c0873e7c47c60bf1411ab51fb90… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d28c0873e7c47c60bf1411ab51fb90… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/27183] lint-changelog: also reject MRs which manually modify changelog files that changelog-d owns
by Zubin (＠wz1000) 28 Apr '26

28 Apr '26

Zubin pushed to branch wip/27183 at Glasgow Haskell Compiler / GHC Commits: 1d33272d by Zubin Duggal at 2026-04-28T17:28:33+05:30 lint-changelog: also reject MRs which manually modify changelog files that changelog-d owns - - - - - 3 changed files: - .gitlab-ci.yml - hadrian/src/Rules/Changelog.hs - utils/changelog-d/ChangelogD.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -274,6 +274,24 @@ lint-changelog: # Build changelog-d and validate all entries (checks required fields, section names, MR number) - .gitlab/ci.sh configure - .gitlab/ci.sh run_hadrian test --test-root-dirs="testsuite/tests/linters" --only=changelog-d + # Reject MRs that directly modify any path listed in + # changelog.d/config's markdown-targets: those files are regenerated + # from fragments at release time. + - export TOOL_OUTPUT=_build/changelog-d-markdown-targets.txt + - .gitlab/ci.sh run_hadrian list-markdown-targets + - | + paths=$(cat "$TOOL_OUTPUT") + touched=$(git diff --name-only "$base..$CI_COMMIT_SHA" -- $paths) + if [ -n "$touched" ]; then + echo "ERROR: This MR modifies a per-library changelog file directly:" + echo "$touched" | sed 's/^/ /' + echo + echo "These files are generated at release time from changelog.d/" + echo "fragments. Please add a fragment in changelog.d/ with the" + echo "appropriate 'section:' instead of editing the file directly." + echo "If this is a deliberate exception, apply the 'no-changelog' label." + exit 1 + fi dependencies: [] rules: - if: '$CI_MERGE_REQUEST_LABELS =~ /.*marge_bot_batch_merge_job.*/' ===================================== hadrian/src/Rules/Changelog.hs ===================================== @@ -7,6 +7,7 @@ import Packages import Settings.Program (programContext) import qualified System.Directory as IO +import qualified System.Environment as IO -- | Rules for generating and managing changelog entries. -- @@ -14,6 +15,8 @@ import qualified System.Directory as IO -- hadrian/build changelog -- generate RST release notes -- hadrian/build changelog --changelog-version=10.2.1 -- with explicit version -- hadrian/build libraries-changelog-markdown -- emit per-library Markdown bullets to stdout +-- hadrian/build list-markdown-targets -- print one repo-relative path per +-- markdown-targets: row, used by CI -- hadrian/build changelog-clear -- remove old entries changelogRules :: Rules () changelogRules = do @@ -47,6 +50,17 @@ changelogRules = do , "--libraries-changelog-markdown" ] + phony "list-markdown-targets" $ do + ctx <- programContext stage0Boot changelogD + progPath <- programPath ctx + need [progPath] + top <- topDirectory + let args = [top -/- "changelog.d/", "--list-markdown-targets"] + mOut <- liftIO $ IO.lookupEnv "TOOL_OUTPUT" + case mOut of + Nothing -> cmd_ [progPath] args + Just fp -> quietly $ (cmd (FileStdout fp) [progPath] args :: Action ()) + phony "changelog-clear" $ do top <- topDirectory let dir = top -/- "changelog.d" ===================================== utils/changelog-d/ChangelogD.hs ===================================== @@ -20,7 +20,7 @@ import Data.Set (Set) import Data.Traversable (for) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.Environment (getArgs) -import System.Exit (exitFailure) +import System.Exit (ExitCode(..), exitFailure, exitWith) import System.FilePath ((</>), dropTrailingPathSeparator, takeDirectory) import System.IO (hPutStrLn, stderr) @@ -72,6 +72,10 @@ usage = unlines , " to a single section. Without this, all" , " configured markdown-targets are emitted," , " separated by HTML-comment markers." + , " --list-markdown-targets Print one repo-relative path per line for" + , " every entry in `markdown-targets:`. Used" + , " by CI to source the list of files MRs are" + , " not allowed to edit directly." , " --help Show this help" ] @@ -79,13 +83,14 @@ parseArgs :: [String] -> Either String Opts parseArgs = go defaultOpts where defaultOpts = Opts - { optDirectory = "changelog.d" - , optVersion = Nothing - , optValidate = False - , optExpectMR = Nothing - , optExpectCLC = False - , optMarkdown = False - , optMdSection = Nothing + { optDirectory = "changelog.d" + , optVersion = Nothing + , optValidate = False + , optExpectMR = Nothing + , optExpectCLC = False + , optMarkdown = False + , optMdSection = Nothing + , optListTargets = False } go opts [] = Right opts @@ -102,6 +107,8 @@ parseArgs = go defaultOpts go opts { optMarkdown = True } rest go opts ("--section" : s : rest) = go opts { optMdSection = Just s } rest go _ ("--section" : []) = Left "--section requires an argument" + go opts ("--list-markdown-targets" : rest) = + go opts { optListTargets = True } rest go _ (('-':'-':opt) : _) = Left $ "Unknown option: --" ++ opt go _ (('-':opt) : _) = Left $ "Unknown option: -" ++ opt go opts (dir : rest) = go opts { optDirectory = dir } rest @@ -148,6 +155,10 @@ makeChangelog Opts {..} = do either (exitWithExc . PlainError) return $ parseWith parseConfig filename contents + when optListTargets $ do + for_ (cfgMarkdownTargets cfg) (putStrLn . mtPath) + exitWith ExitSuccess + -- Read only regular files, skipping config, dotfiles, and any -- subdirectories (e.g. golden-output dirs alongside test fragments). dirContents <- filter (not . isTmpFile) <$> listDirectory optDirectory @@ -619,6 +630,7 @@ data Opts = Opts , optExpectCLC :: Bool -- ^ Require entry matched by --expect-mr to have clc: , optMarkdown :: Bool -- ^ Emit per-library Markdown to stdout , optMdSection :: Maybe String -- ^ Restrict markdown emission to one section + , optListTargets :: Bool -- ^ List markdown-targets paths to stdout } deriving (Show) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d33272d67fcc4c8cdeec7bd976d315… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1d33272d67fcc4c8cdeec7bd976d315… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/27183] changelog-d: Add support for emitting markdown for library changelogs
by Zubin (＠wz1000) 28 Apr '26

28 Apr '26

Zubin pushed to branch wip/27183 at Glasgow Haskell Compiler / GHC Commits: 84998393 by Zubin Duggal at 2026-04-28T17:11:45+05:30 changelog-d: Add support for emitting markdown for library changelogs Now library changelog entries are written in changelog.d/ uniformly, and the changelog-d tool gains functionality to output markdown fragments for the library changelog files. The fragments will be spliced into the respective files at release time by the release manager. Also changes the lint-changelog CI job to ensure that changes which touch base have a changelog entry and a CLC proposal. Fixes #27183 - - - - - 12 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - changelog.d/config - docs/users_guide/ghc_config.py.in - hadrian/src/Rules/Changelog.hs - libraries/integer-gmp/integer-gmp.cabal - testsuite/tests/linters/Makefile - utils/changelog-d/ChangelogD.hs - utils/changelog-d/README.md - + utils/changelog-d/tests/config - + utils/changelog-d/tests/expected/test-parser-rewriter.md - + utils/changelog-d/tests/test-parser-rewriter Changes: ===================================== .gitlab-ci.yml ===================================== @@ -247,6 +247,9 @@ ghc-linters: # Check that MRs include a changelog entry in changelog.d/. # Skipped if the MR has the ~"no-changelog" label. +# +# If MR's diff touches libraries/base/, the changelog must also have a non-empty +# `clc:` field. lint-changelog: stage: tool-lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" @@ -254,6 +257,7 @@ lint-changelog: variables: BUILD_FLAVOUR: default CHANGELOG_EXPECT_MR: "$CI_MERGE_REQUEST_IID" + CHANGELOG_EXPECT_CLC: "" script: # Check that the MR adds at least one changelog entry - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" "$CI_MERGE_REQUEST_TARGET_BRANCH_NAME" @@ -276,6 +280,10 @@ lint-changelog: when: never - if: '$CI_MERGE_REQUEST_LABELS =~ /.*no-changelog.*/' when: never + - changes: + - libraries/base/**/* + variables: + CHANGELOG_EXPECT_CLC: "1" - if: $CI_MERGE_REQUEST_ID - *drafts-can-fail-lint ===================================== .gitlab/merge_request_templates/Default.md ===================================== @@ -23,7 +23,8 @@ https://gitlab.haskell.org/ghc/ghc/-/wikis/Contributing-a-Patch - [ ] This MR solves the problem described in the following issue:  - [ ] A changelog entry was added in `changelog.d/` for user-facing changes (see [changelog guide][changelog]). If this MR does not need a changelog entry, the ~"no-changelog" label was applied. -- [ ] This MR does not make any significant changes to `base`, or it has an accompanying [CLC proposal](https://github.com/haskell/core-libraries-committee#base-package). +- [ ] This MR does not make any significant changes to `base`, or it has an accompanying [CLC proposal](https://github.com/haskell/core-libraries-committee#base-package) + and the changelog fragment uses `section: base` with the `clc: #<proposal>` field set. - [ ] If this MR has the potential to break user programs, the ~"user-facing" label was applied to test against head.hackage. - [ ] All commits are either individually buildable or squashed. ===================================== changelog.d/config ===================================== @@ -27,6 +27,7 @@ sections: { cmm Cmm build-tools Build tools base ``base`` library + ghc-internal ``ghc-internal`` library ghc-prim ``ghc-prim`` library ghc-lib ``ghc`` library ghc-heap ``ghc-heap`` library @@ -36,6 +37,18 @@ sections: { ghc-toolchain ``ghc-toolchain`` } +-- markdown-targets: sections that also need to end up in +-- per-library changelog files. The optional third token +-- lists extra fields that might be required for this section +-- like `clc` for base. +markdown-targets: { + base libraries/base/changelog.md clc + ghc-internal libraries/ghc-internal/CHANGELOG.md + ghc-prim libraries/ghc-prim/changelog.md + ghc-experimental libraries/ghc-experimental/CHANGELOG.md + template-haskell libraries/template-haskell/changelog.md +} + included-libraries-preamble: { The package database provided with this distribution also contains a number of packages other than GHC itself. See the changelogs provided with these packages ===================================== docs/users_guide/ghc_config.py.in ===================================== @@ -7,12 +7,14 @@ if parse_version(sphinx.__version__) >= parse_version("4.0.0"): 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#%s'), 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '%s'), 'ghc-mr': ('https://gitlab.haskell.org/ghc/ghc/-/merge_requests/%s', '!%s'), + 'clc': ('https://github.com/haskell/core-libraries-committee/issues/%s', 'CLC proposal #%s'), } else: extlinks = { 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#'), 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', ''), 'ghc-mr': ('https://gitlab.haskell.org/ghc/ghc/-/merge_requests/%s', '!'), + 'clc': ('https://github.com/haskell/core-libraries-committee/issues/%s', 'CLC proposal #'), } libs_base_uri = '../libraries' ===================================== hadrian/src/Rules/Changelog.hs ===================================== @@ -11,8 +11,9 @@ import qualified System.Directory as IO -- | Rules for generating and managing changelog entries. -- -- Targets: --- hadrian/build changelog -- generate release notes +-- hadrian/build changelog -- generate RST release notes -- hadrian/build changelog --changelog-version=10.2.1 -- with explicit version +-- hadrian/build libraries-changelog-markdown -- emit per-library Markdown bullets to stdout -- hadrian/build changelog-clear -- remove old entries changelogRules :: Rules () changelogRules = do @@ -25,19 +26,6 @@ changelogRules = do ctx <- programContext stage0Boot changelogD progPath <- programPath ctx need [progPath] - - -- These cabal files are needed by changelog-d to determine the - -- versions of packages shipped with GHC. - let templatedCabalFiles = map pkgCabalFile - [ ghcBoot - , ghcBootTh - , ghcExperimental - , ghcInternal - , ghci - , compiler - , ghcHeap - , templateHaskell - ] need templatedCabalFiles top <- topDirectory @@ -47,6 +35,18 @@ changelogRules = do :: Action () putSuccess $ "| Generated release notes: " ++ outFile + phony "libraries-changelog-markdown" $ do + ctx <- programContext stage0Boot changelogD + progPath <- programPath ctx + need [progPath] + need templatedCabalFiles + + top <- topDirectory + cmd_ [progPath] + [ top -/- "changelog.d/" + , "--libraries-changelog-markdown" + ] + phony "changelog-clear" $ do top <- topDirectory let dir = top -/- "changelog.d" @@ -54,3 +54,17 @@ changelogRules = do let toRemove = filter (\f -> f /= "config" && not (isPrefixOf "." f)) entries liftIO $ mapM_ (IO.removeFile . (dir -/-)) toRemove putSuccess $ "| Removed " ++ show (length toRemove) ++ " changelog entries" + where + -- These cabal files are needed by changelog-d to determine the + -- versions of packages shipped with GHC. + templatedCabalFiles = map pkgCabalFile + [ ghcBoot + , ghcBootTh + , ghcExperimental + , ghcInternal + , ghci + , compiler + , ghcHeap + , templateHaskell + , base + ] ===================================== libraries/integer-gmp/integer-gmp.cabal ===================================== @@ -13,6 +13,9 @@ build-type: Simple homepage: https://www.haskell.org/ghc/ bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +extra-source-files: + changelog.md + description: This package used to provide an implementation of the standard 'Integer' type based on the ===================================== testsuite/tests/linters/Makefile ===================================== @@ -30,8 +30,12 @@ notes: (cd $(TOP)/.. && $(LINT_NOTES) broken-refs) changelog-d: -ifdef CHANGELOG_EXPECT_MR +ifneq "$(CHANGELOG_EXPECT_MR)" "" +ifneq "$(CHANGELOG_EXPECT_CLC)" "" + (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate --expect-mr $(CHANGELOG_EXPECT_MR) --expect-clc) +else (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate --expect-mr $(CHANGELOG_EXPECT_MR)) +endif else (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate) endif ===================================== utils/changelog-d/ChangelogD.hs ===================================== @@ -10,15 +10,15 @@ module Main (main) where import Control.Exception (Exception (..)) -import Control.Monad (unless, void, when) -import Data.Char (isSpace) +import Control.Monad (filterM, unless, void, when) +import Data.Char (isAlpha, isSpace) import Data.Foldable (for_, toList, traverse_) import Data.Function (on) -import Data.List (intercalate, sort, sortBy) +import Data.List (find, intercalate, isPrefixOf, isSuffixOf, sort, sortBy, stripPrefix) import Data.Maybe (isJust, isNothing, mapMaybe) import Data.Set (Set) import Data.Traversable (for) -import System.Directory (listDirectory) +import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath ((</>), dropTrailingPathSeparator, takeDirectory) @@ -58,16 +58,35 @@ usage = unlines , " Collect changelog entries and produce release notes." , "" , "Options:" - , " --version <version> Version number for RST file header (e.g. 10.2.1)" - , " --validate Validate entries only, no output" - , " --expect-mr <N> Check that at least one entry references MR !N" - , " --help Show this help" + , " --version <version> Version number for RST file header (e.g. 10.2.1)" + , " --validate Validate entries only, no output" + , " --expect-mr <N> Check that at least one entry references MR !N" + , " --expect-clc Require the entry matched by --expect-mr" + , " to have a non-empty 'clc:' field. Used by" + , " CI for MRs touching base." + , " --libraries-changelog-markdown Emit per-library Markdown bullets to" + , " stdout (suppresses RST emission). Output" + , " is intended to be pasted into each" + , " libraries/<lib>/changelog.md by hand;" + , " --section <key> Restrict --libraries-changelog-markdown" + , " to a single section. Without this, all" + , " configured markdown-targets are emitted," + , " separated by HTML-comment markers." + , " --help Show this help" ] parseArgs :: [String] -> Either String Opts parseArgs = go defaultOpts where - defaultOpts = Opts "changelog.d" Nothing False Nothing + defaultOpts = Opts + { optDirectory = "changelog.d" + , optVersion = Nothing + , optValidate = False + , optExpectMR = Nothing + , optExpectCLC = False + , optMarkdown = False + , optMdSection = Nothing + } go opts [] = Right opts go _ ("--help" : _) = Left "" @@ -78,6 +97,11 @@ parseArgs = go defaultOpts [(mr, "")] -> go opts { optExpectMR = Just mr } rest _ -> Left $ "--expect-mr requires a number, got: " ++ n go _ ("--expect-mr" : []) = Left "--expect-mr requires an argument" + go opts ("--expect-clc" : rest) = go opts { optExpectCLC = True } rest + go opts ("--libraries-changelog-markdown" : rest) = + go opts { optMarkdown = True } rest + go opts ("--section" : s : rest) = go opts { optMdSection = Just s } rest + go _ ("--section" : []) = Left "--section requires an argument" go _ (('-':'-':opt) : _) = Left $ "Unknown option: --" ++ opt go _ (('-':opt) : _) = Left $ "Unknown option: -" ++ opt go opts (dir : rest) = go opts { optDirectory = dir } rest @@ -124,9 +148,14 @@ makeChangelog Opts {..} = do either (exitWithExc . PlainError) return $ parseWith parseConfig filename contents + -- Read only regular files, skipping config, dotfiles, and any + -- subdirectories (e.g. golden-output dirs alongside test fragments). dirContents <- filter (not . isTmpFile) <$> listDirectory optDirectory + fragmentNames <- + filterM (\name -> doesFileExist (optDirectory </> name)) + (filter (/= "config") $ sort dirContents) allEntries <- fmap Map.fromList $ - for (filter (/= "config") $ sort dirContents) $ \name -> do + for fragmentNames $ \name -> do let fp = optDirectory </> name contents <- BS.readFile fp entry <- parseEntryFile fp contents @@ -140,17 +169,38 @@ makeChangelog Opts {..} = do exitWithExc $ PlainError "Validation failed." -- Check expected MR number if specified - for_ optExpectMR $ \expectedMR -> do - let expectedMRNum = MRNumber expectedMR - entriesWithMR = Map.filter (\e -> expectedMRNum `Set.member` entryMrs e) allEntries - when (Map.null entriesWithMR && not (Map.null allEntries)) $ do - hPutStrLn stderr $ "Warning: No changelog entry references this MR (!" ++ show expectedMR ++ ")." - hPutStrLn stderr $ "Add 'mrs: !" ++ show expectedMR ++ "' to your changelog entry." - hPutStrLn stderr "" - exitFailure + matchedByMR <- case optExpectMR of + Nothing -> pure Map.empty + Just expectedMR -> do + let expectedMRNum = MRNumber expectedMR + withMR = Map.filter (\e -> expectedMRNum `Set.member` entryMrs e) allEntries + when (Map.null withMR && not (Map.null allEntries)) $ do + hPutStrLn stderr $ "Warning: No changelog entry references this MR (!" ++ show expectedMR ++ ")." + hPutStrLn stderr $ "Add 'mrs: !" ++ show expectedMR ++ "' to your changelog entry." + hPutStrLn stderr "" + exitFailure + pure withMR + + -- --expect-clc: assert that the MR-matched entry has clc: set. + when optExpectCLC $ case optExpectMR of + Nothing -> exitWithExc $ PlainError + "--expect-clc requires --expect-mr (which entry to check?)" + Just expectedMR -> + when (not (Map.null matchedByMR) + && all (Set.null . entryClcs) matchedByMR) $ do + hPutStrLn stderr $ + "Error: changelog entry for !" ++ show expectedMR + ++ " does not have a 'clc:' field." + hPutStrLn stderr + "Changes to base or user-facing changes require a CLC proposal." + hPutStrLn stderr "Add 'clc: #<proposal>' to your changelog entry." + exitFailure unless optValidate $ - outputRST optDirectory optVersion cfg (Map.elems allEntries) + if optMarkdown + then outputMarkdown optDirectory cfg optMdSection + (Map.elems allEntries) + else outputRST optDirectory optVersion cfg (Map.elems allEntries) ------------------------------------------------------------------------------- -- RST output @@ -218,6 +268,9 @@ formatEntry Entry {..} = ] ++ [ "(:ghc-mr:`" ++ show n ++ "`)" | MRNumber n <- Set.toList entryMrs + ] ++ + [ "(:clc:`" ++ show n ++ "`)" + | CLCNumber n <- Set.toList entryClcs ] description = maybe "" (\d -> "\n" ++ trim d ++ "\n\n") entryDescription @@ -262,25 +315,281 @@ generateIncludedLibraries baseDir preamble libs = do where fst3 (a, _, _) = a - extractField :: String -> String -> Maybe String - extractField fieldName contents = - case mapMaybe (matchField fieldName) (lines contents) of - (v:_) -> Just v - [] -> Nothing - - matchField :: String -> String -> Maybe String - matchField fieldName line = - let stripped = dropWhile isSpace line - (key, rest) = break (\c -> c == ':' || isSpace c) stripped - in if map toLower' key == map toLower' fieldName - then case dropWhile isSpace rest of - (':':val) -> Just (trim (dropWhile isSpace val)) - _ -> Nothing - else Nothing - - toLower' c - | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) - | otherwise = c +extractField :: String -> String -> Maybe String +extractField fieldName contents = + case mapMaybe (matchField fieldName) (lines contents) of + (v:_) -> Just v + [] -> Nothing + +matchField :: String -> String -> Maybe String +matchField fieldName line = + let stripped = dropWhile isSpace line + (key, rest) = break (\c -> c == ':' || isSpace c) stripped + in if map toLower' key == map toLower' fieldName + then case dropWhile isSpace rest of + (':':val) -> Just (trim (dropWhile isSpace val)) + _ -> Nothing + else Nothing + +toLower' :: Char -> Char +toLower' c + | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) + | otherwise = c + +------------------------------------------------------------------------------- +-- Markdown output +------------------------------------------------------------------------------- + +-- | Emit per-library Markdown bullets to stdout. +-- +-- With 'mSect' set, emit just that section's bullets (used interactively). +-- Without it, emit every section listed in @markdown-targets:@, separated +-- by HTML comments naming each section +outputMarkdown + :: FilePath -- ^ changelog.d directory (used to locate cabal files) + -> Cfg + -> Maybe String -- ^ --section <key> + -> [Entry] + -> IO () +outputMarkdown dir Cfg{..} mSect entries = do + targets <- case mSect of + Just key -> case find ((== key) . mtSection) cfgMarkdownTargets of + Nothing -> exitWithExc $ PlainError $ + "Unknown markdown section: " ++ key + ++ "\nKnown sections: " + ++ intercalate ", " (map mtSection cfgMarkdownTargets) + Just mt -> pure [mt] + Nothing -> pure cfgMarkdownTargets + + let multi = isNothing mSect + baseDir = takeDirectory (dropTrailingPathSeparator dir) + + case mSect of + Just key | not (any (\mt -> mtSection mt == key) cfgMarkdownTargets) -> + -- impossible; handled above + pure () + Just key | null (entriesFor key entries) -> + exitWithExc $ PlainError $ "No entries for section " ++ key + _ -> pure () + + for_ targets $ \mt -> do + let es = entriesFor (mtSection mt) entries + unless (null es) $ do + when multi $ do + putStrLn $ "" + putStrLn "" + libVer <- readLibraryVersion baseDir (mtPath mt) + putStrLn $ "## " ++ libVer ++ " *TBA*" + putStrLn "" + for_ (sortBy (flip compare `on` hasDescription) es) $ \entry -> + putStr (formatEntryMd entry) + when multi $ putStrLn "" + +entriesFor :: String -> [Entry] -> [Entry] +entriesFor key = filter $ \e -> case entrySection e of + Just (Section s) -> s == key + Nothing -> False + +-- | Given the path of a library's @changelog.md@ (repo-relative), find the +-- sibling @*.cabal@ (or @*.cabal.in@) and read the @version:@ field. +readLibraryVersion :: FilePath -> FilePath -> IO String +readLibraryVersion baseDir mdPath = do + let libDir = takeDirectory mdPath + libDirFs = baseDir </> libDir + exists <- doesDirectoryExist libDirFs + if not exists + then do + hPutStrLn stderr $ "Warning: directory does not exist: " ++ libDirFs + pure "?.?.?" + else do + candidates <- listDirectory libDirFs + let cabals = filter (\f -> ".cabal" `isSuffixOf` f) candidates + -- Prefer non-templated *.cabal over *.cabal.in (the former is + -- the rendered file Hadrian needs before invoking us). + ranked = sortBy (compare `on` (\f -> if ".cabal.in" `isSuffixOf` f then (1::Int) else 0)) cabals + case ranked of + [] -> do + hPutStrLn stderr $ + "Warning: no .cabal file under " ++ libDir + pure "?.?.?" + (cf:_) -> do + contents <- readFile (libDirFs </> cf) + case extractField "version" contents of + Just v -> pure v + Nothing -> do + hPutStrLn stderr $ + "Warning: could not parse version from " ++ libDir </> cf + pure "?.?.?" + +-- | Format an Entry as a Markdown bullet. Mirrors 'formatEntry' for RST +-- but emits Markdown links for issues/MRs/CLC and rewrites RST inline +-- markup to markdown. +formatEntryMd :: Entry -> String +formatEntryMd Entry{..} = indentBulletMd (header ++ description) + where + header = unwords $ + [ rstToMarkdown entrySynopsis ] ++ + [ mdLink ("#" ++ show n) + ("https://gitlab.haskell.org/ghc/ghc/issues/" ++ show n) + | IssueNumber n <- Set.toList entryIssues + ] ++ + [ mdLink ("!" ++ show n) + ("https://gitlab.haskell.org/ghc/ghc/-/merge_requests/" ++ show n) + | MRNumber n <- Set.toList entryMrs + ] ++ + [ mdLink ("CLC proposal #" ++ show n) + ("https://github.com/haskell/core-libraries-committee/issues/" ++ show n) + | CLCNumber n <- Set.toList entryClcs + ] + + description = maybe "" (\d -> "\n\n" ++ rstToMarkdown (trim d) ++ "\n") entryDescription + + mdLink :: String -> String -> String + mdLink txt url = "(" ++ "[" ++ txt ++ "](" ++ url ++ ")" ++ ")" + +-- | Indent text as a Markdown bullet: the first line gets @"* "@ prefix, +-- subsequent lines are indented two spaces. Mirrors 'indentBullet'. +indentBulletMd :: String -> String +indentBulletMd = unlines . go . lines + where + go [] = [] + go (x:xs) = ("* " ++ x) : map indentLine xs + indentLine "" = "" + indentLine s = " " ++ s + +------------------------------------------------------------------------------- +-- RST -> Markdown rewriting +------------------------------------------------------------------------------- +-- +-- Applies the following rules: +-- +-- | RST | Markdown | +-- | -------------------------------------------------| ------------------------------------------------------------------------------------------------------ | +-- | ``code`` (double-backtick) | `code` (single-backtick) | +-- | `text <url>`_ | [text](url) | +-- | :ghc-ticket:`N` | [#N](https://gitlab.haskell.org/ghc/ghc/issues/N) | +-- | :ghc-mr:`N` | [!N](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/N) | +-- | :ghc-wiki:`p` | [p](https://gitlab.haskell.org/ghc/ghc/wikis/p) | +-- | :clc:`N` | [CLC proposal #N](https://github.com/haskell/core-libraries-committee/issues/N) | +-- | :ghc-flag:`-foo` | `-foo` | +-- | :extension:`E` | `E` | +-- | :ghci-cmd:`X`, :rts-flag:`X` | `X` | +-- | :base-ref:`Mod.id` `` | `Mod.id` | +-- | :th-ref:, :cabal-ref: ,:ghc-prim-ref: | `ref` | +-- | .. code-block:: lang + indented body | Triple-backtick fenced block with `lang` | +-- | .. note:: / .. warning:: | `> **Note:**` / `> **Warning:**` blockquote | + +rstToMarkdown :: String -> String +rstToMarkdown s = + let trailingNL = not (null s) && last s == '\n' + body = intercalate "\n" . blockPass . lines . inlinePass $ s + in body ++ (if trailingNL then "\n" else "") + +inlinePass :: String -> String +inlinePass [] = [] +-- Double-backtick code: ``code`` → `code` +inlinePass ('`':'`':rest) = + case breakOnSubstring "``" rest of + (body, _:_:after) -> "`" ++ body ++ "`" ++ inlinePass after + _ -> '`':'`': inlinePass rest +-- RST hyperlink: `text <url>`_ → [text](url) +inlinePass ('`':rest) + | Just (txt, url, after) <- pickRstLink rest = + "[" ++ trim txt ++ "](" ++ url ++ ")" ++ inlinePass after +-- :role:`body` interpreted-text role +inlinePass (':':rest) + | Just (role, body, after) <- pickRole rest = + renderRole role body ++ inlinePass after +inlinePass (c:cs) = c : inlinePass cs + +breakOnSubstring :: String -> String -> (String, String) +breakOnSubstring needle = go + where + go [] = ([], []) + go s@(c:cs) + | needle `isPrefixOf` s = ([], s) + | otherwise = + let (a, b) = go cs in (c:a, b) + +-- | Try to consume a @\`text \<url\>\`_@ RST hyperlink starting after the +-- leading backtick. Returns @(text, url, rest)@ on success. +pickRstLink :: String -> Maybe (String, String, String) +pickRstLink xs = do + let (txt, r1) = break (== '<') xs + case r1 of + '<':r2 -> do + let (url, r3) = break (== '>') r2 + case r3 of + '>':'`':'_':'_':after -> Just (txt, url, after) + '>':'`':'_':after -> Just (txt, url, after) + _ -> Nothing + _ -> Nothing + +-- | Try to consume a @role:\`body\`@ interpreted-text role starting just +-- after the leading colon. +pickRole :: String -> Maybe (String, String, String) +pickRole xs = + let (name, r1) = span (\c -> isAlpha c || c == '-') xs + in case (null name, r1) of + (False, ':':'`':r2) -> case break (== '`') r2 of + (body, '`':after) | not (null body) -> Just (name, body, after) + _ -> Nothing + _ -> Nothing + +-- | Render a known interpreted-text role to Markdown. +renderRole :: String -> String -> String +renderRole role body = case role of + "ghc-ticket" -> mdLink ("#" ++ body) ("https://gitlab.haskell.org/ghc/ghc/issues/" ++ body) + "ghc-mr" -> mdLink ("!" ++ body) ("https://gitlab.haskell.org/ghc/ghc/-/merge_requests/" ++ body) + "ghc-wiki" -> mdLink body ("https://gitlab.haskell.org/ghc/ghc/wikis/" ++ body) + "clc" -> mdLink ("CLC proposal #" ++ body) + ("https://github.com/haskell/core-libraries-committee/issues/" ++ body) + "ghc-flag" -> "`" ++ body ++ "`" + "extension" -> "`" ++ body ++ "`" + "ghci-cmd" -> "`" ++ body ++ "`" + "rts-flag" -> "`" ++ body ++ "`" + "doc" -> body + "base-ref" -> "`" ++ body ++ "`" + "th-ref" -> "`" ++ body ++ "`" + "cabal-ref" -> "`" ++ body ++ "`" + "ghc-prim-ref" -> "`" ++ body ++ "`" + _ -> ":" ++ role ++ ":`" ++ body ++ "`" + where + mdLink txt url = "[" ++ txt ++ "](" ++ url ++ ")" + +-- | Block-level transforms applied after the inline pass. +blockPass :: [String] -> [String] +blockPass [] = [] +blockPass (l:rest) + | Just lang <- stripPrefix ".. code-block:: " (trim l) = + let (body, rest') = takeIndentedBlock rest + in ("```" ++ lang) : map (dropIndent 4) body ++ ["```"] ++ blockPass rest' + | trim l == ".. note::" = + let (body, rest') = takeIndentedBlock rest + in "> **Note:**" : map (("> " ++) . dropIndent 4) body ++ blockPass rest' + | trim l == ".. warning::" = + let (body, rest') = takeIndentedBlock rest + in "> **Warning:**" : map (("> " ++) . dropIndent 4) body ++ blockPass rest' + | otherwise = l : blockPass rest + +-- | Take a block of indented (or blank) lines following a directive; stop +-- at the first non-blank, non-indented line. +takeIndentedBlock :: [String] -> ([String], [String]) +takeIndentedBlock = go . dropWhile null + where + go [] = ([], []) + go (x:xs) + | null x = let (a, b) = go xs in (x:a, b) + | take 1 x == " " = let (a, b) = go xs in (x:a, b) + | otherwise = ([], x:xs) + +-- | Drop up to @n@ leading spaces from a line. +dropIndent :: Int -> String -> String +dropIndent _ "" = "" +dropIndent 0 s = s +dropIndent n (' ':cs) = dropIndent (n-1) cs +dropIndent _ s = s ------------------------------------------------------------------------------- -- Section grouping @@ -303,10 +612,13 @@ groupBySections sectionDefs entries = ------------------------------------------------------------------------------- data Opts = Opts - { optDirectory :: FilePath - , optVersion :: Maybe String - , optValidate :: Bool - , optExpectMR :: Maybe Int -- ^ Expected MR number + { optDirectory :: FilePath + , optVersion :: Maybe String + , optValidate :: Bool + , optExpectMR :: Maybe Int -- ^ Expected MR number + , optExpectCLC :: Bool -- ^ Require entry matched by --expect-mr to have clc: + , optMarkdown :: Bool -- ^ Emit per-library Markdown to stdout + , optMdSection :: Maybe String -- ^ Restrict markdown emission to one section } deriving (Show) @@ -332,6 +644,24 @@ instance C.Parsec MRNumber where instance C.Pretty MRNumber where pretty (MRNumber n) = PP.char '!' PP.<> PP.int n +newtype CLCNumber = CLCNumber Int + deriving (Eq, Ord, Show) + +instance C.Parsec CLCNumber where + parsec = do + _ <- P.char '#' + CLCNumber <$> P.integral + +instance C.Pretty CLCNumber where + pretty (CLCNumber n) = PP.char '#' PP.<> PP.int n + +data MarkdownTarget = MarkdownTarget + { mtSection :: String -- ^ section key matching an entry's `section:` + , mtPath :: FilePath -- ^ target changelog path, repo-relative + , mtRequiredFields :: [String] -- ^ extra required-fields when this section is used + } + deriving (Show) + newtype Section = Section String deriving (Eq, Ord, Show) @@ -351,6 +681,7 @@ data Cfg = Cfg , cfgPreamble :: String , cfgIncludedLibraries :: [(FilePath, String)] -- ^ (cabalPath, description) , cfgIncludedLibrariesPreamble :: String + , cfgMarkdownTargets :: [MarkdownTarget] } deriving (Show) @@ -364,6 +695,7 @@ parseConfig fields0 = do , cfgPreamble = cfgRawPreamble raw , cfgIncludedLibraries = parseIncludedLibraries (cfgRawIncludedLibraries raw) , cfgIncludedLibrariesPreamble = cfgRawIncludedLibrariesPreamble raw + , cfgMarkdownTargets = parseMarkdownTargets (cfgRawMarkdownTargets raw) } where (fields, sections) = C.partitionFields fields0 @@ -378,6 +710,7 @@ data CfgRaw = CfgRaw , cfgRawPreamble :: String , cfgRawIncludedLibraries :: String , cfgRawIncludedLibrariesPreamble :: String + , cfgRawMarkdownTargets :: String } cfgRawRequiredFieldsL :: Functor f => (Set String -> f (Set String)) -> CfgRaw -> f CfgRaw @@ -395,6 +728,9 @@ cfgRawIncludedLibrariesL f s = (\x -> s { cfgRawIncludedLibraries = x }) <$> f ( cfgRawIncludedLibrariesPreambleL :: Functor f => (String -> f String) -> CfgRaw -> f CfgRaw cfgRawIncludedLibrariesPreambleL f s = (\x -> s { cfgRawIncludedLibrariesPreamble = x }) <$> f (cfgRawIncludedLibrariesPreamble s) +cfgRawMarkdownTargetsL :: Functor f => (String -> f String) -> CfgRaw -> f CfgRaw +cfgRawMarkdownTargetsL f s = (\x -> s { cfgRawMarkdownTargets = x }) <$> f (cfgRawMarkdownTargets s) + cfgRawGrammar :: C.ParsecFieldGrammar CfgRaw CfgRaw cfgRawGrammar = CfgRaw <$> C.monoidalFieldAla "required-fields" (C.alaSet' C.FSep C.Token) cfgRawRequiredFieldsL @@ -402,6 +738,7 @@ cfgRawGrammar = CfgRaw <*> C.freeTextFieldDef "preamble" cfgRawPreambleL <*> C.freeTextFieldDef "included-libraries" cfgRawIncludedLibrariesL <*> C.freeTextFieldDef "included-libraries-preamble" cfgRawIncludedLibrariesPreambleL + <*> C.freeTextFieldDef "markdown-targets" cfgRawMarkdownTargetsL parseSections :: String -> [(String, String)] parseSections = mapMaybe parseLine . lines @@ -419,6 +756,20 @@ parseIncludedLibraries = mapMaybe parseLine . lines (path, rest) | not (null path) -> Just (path, trim rest) _ -> Nothing +-- | Parse the @markdown-targets:@ block. +-- +-- Each non-empty, non-comment line is +-- <section-key> <path> [<extra-required-field>...] +-- The extra tokens declare additional fields required of any entry whose section: matches. +parseMarkdownTargets :: String -> [MarkdownTarget] +parseMarkdownTargets = mapMaybe parseLine . lines + where + parseLine l = case words (trim l) of + [] -> Nothing + [_] -> Nothing -- need at least section + path + (sect:path:extra) -> + Just $ MarkdownTarget sect path extra + ------------------------------------------------------------------------------- -- Entry ------------------------------------------------------------------------------- @@ -428,6 +779,7 @@ data Entry = Entry , entryDescription :: Maybe String , entryMrs :: Set MRNumber , entryIssues :: Set IssueNumber + , entryClcs :: Set CLCNumber , entrySection :: Maybe Section } deriving (Show) @@ -447,6 +799,9 @@ entryMrsL f s = (\x -> s { entryMrs = x }) <$> f (entryMrs s) entryIssuesL :: Functor f => (Set IssueNumber -> f (Set IssueNumber)) -> Entry -> f Entry entryIssuesL f s = (\x -> s { entryIssues = x }) <$> f (entryIssues s) +entryClcsL :: Functor f => (Set CLCNumber -> f (Set CLCNumber)) -> Entry -> f Entry +entryClcsL f s = (\x -> s { entryClcs = x }) <$> f (entryClcs s) + entrySectionL :: Functor f => (Maybe Section -> f (Maybe Section)) -> Entry -> f Entry entrySectionL f s = (\x -> s { entrySection = x }) <$> f (entrySection s) @@ -477,6 +832,7 @@ entryGrammar = Entry <*> C.freeTextField "description" entryDescriptionL <*> C.monoidalFieldAla "mrs" (C.alaSet C.NoCommaFSep) entryMrsL <*> C.monoidalFieldAla "issues" (C.alaSet C.NoCommaFSep) entryIssuesL + <*> C.monoidalFieldAla "clc" (C.alaSet C.NoCommaFSep) entryClcsL <*> C.optionalField "section" entrySectionL ------------------------------------------------------------------------------- @@ -510,8 +866,21 @@ validateEntry cfg entry = foldMap (\validator -> validator cfg entry) validateRequiredFields :: Validator validateRequiredFields Cfg{..} Entry{..} = fmap RequiredFieldError $ - mapMaybe checkField $ Set.toList cfgRequiredFields + mapMaybe checkField $ Set.toList effectiveRequired where + -- Effective required-fields = global cfgRequiredFields + extras for the + -- entry's section as declared in cfgMarkdownTargets + -- (e.g. `base` adds `clc`). + effectiveRequired = + cfgRequiredFields `Set.union` + Set.fromList + [ f + | Just (Section sect) <- [entrySection] + , mt <- cfgMarkdownTargets + , mtSection mt == sect + , f <- mtRequiredFields mt + ] + checkField :: String -> Maybe RequiredFieldError checkField reqField = case fieldIsEmpty reqField of Left err -> Just err @@ -522,6 +891,7 @@ validateRequiredFields Cfg{..} Entry{..} = fmap RequiredFieldError $ fieldIsEmpty "description" = pure $ isNothing entryDescription fieldIsEmpty "mrs" = pure $ null entryMrs fieldIsEmpty "issues" = pure $ null entryIssues + fieldIsEmpty "clc" = pure $ null entryClcs fieldIsEmpty "section" = pure $ isNothing entrySection fieldIsEmpty f = Left $ UnknownRequiredField f ===================================== utils/changelog-d/README.md ===================================== @@ -23,46 +23,55 @@ description: { **Required fields:** `section`, `synopsis`, `mrs`, `issues` -**Optional fields:** `description` +**Optional fields:** `description`, `clc` + +**Conditionally required**: entries with `section: base` MUST also include a `clc:` +field referencing the CLC proposal authorising the change. If your MR doesn't need a changelog entry, apply the `no-changelog` label. ### Fields -| Field | Format | Description | -| ------------- | ------------------------------- | -----------------------------------------------| -| `synopsis` | Free-form RST | Brief description of the change | -| `mrs` | `!N` (space-separated) | MR number(s) | -| `issues` | `#N` (space-separated) | Issue number(s) | -| `section` | Section key (see below) | GHC component | -| `description` | Free-form RST in `{ ... }` | Extended details. Printed after the main entry | +| Field | Format | Description | +| ------------- | -------------------------- | ----------------------------------------------------- | +| `synopsis` | Free-form RST | Brief description of the change | +| `mrs` | `!N` (space-separated) | MR number(s) | +| `issues` | `#N` (space-separated) | Issue number(s) | +| `clc` | `#N` (space-separated) | CLC proposal number(s). Required for `section: base`. | +| `section` | Section key (see below) | GHC component | +| `description` | Free-form RST | Extended details. Printed after the main entry | ### Section keys -| Key | Heading | -| ------------------ | -------------------------------- | -| `language` | Language | -| `compiler` | Compiler | -| `profiling` | Profiling | -| `codegen` | Code generation | -| `llvm-backend` | LLVM backend | -| `js-backend` | JavaScript backend | -| `wasm-backend` | WebAssembly backend | -| `ghci` | GHCi | -| `rts` | Runtime system | -| `linker` | Linker | -| `bytecode` | Bytecode compiler | -| `packaging` | Packaging & build system | -| `cmm` | Cmm | -| `build-tools` | Build tools | -| `base` | ``base`` library | -| `ghc-prim` | ``ghc-prim`` library | -| `ghc-lib` | ``ghc`` library | -| `ghc-heap` | ``ghc-heap`` library | -| `ghc-experimental` | ``ghc-experimental`` library | -| `template-haskell` | ``template-haskell`` library | -| `ghc-pkg` | ``ghc-pkg`` | -| `ghc-toolchain` | ``ghc-toolchain`` | +The "Markdown" column indicates whether entries in that section also flow to +a per-library `changelog.md`. Sections without a +Markdown target appear only in the GHC release notes RST. + +| Key | Heading | Markdown target | +| ------------------ | ---------------------------- | ---------------------------------------------- | +| `language` | Language | — | +| `compiler` | Compiler | — | +| `profiling` | Profiling | — | +| `codegen` | Code generation | — | +| `llvm-backend` | LLVM backend | — | +| `js-backend` | JavaScript backend | — | +| `wasm-backend` | WebAssembly backend | — | +| `ghci` | GHCi | — | +| `rts` | Runtime system | — | +| `linker` | Linker | — | +| `bytecode` | Bytecode compiler | — | +| `packaging` | Packaging & build system | — | +| `cmm` | Cmm | — | +| `build-tools` | Build tools | — | +| `base` | ``base`` library | `libraries/base/changelog.md` | +| `ghc-internal` | ``ghc-internal`` library | `libraries/ghc-internal/CHANGELOG.md` | +| `ghc-prim` | ``ghc-prim`` library | `libraries/ghc-prim/changelog.md` | +| `ghc-lib` | ``ghc`` library | — | +| `ghc-heap` | ``ghc-heap`` library | — | +| `ghc-experimental` | ``ghc-experimental`` library | `libraries/ghc-experimental/CHANGELOG.md` | +| `template-haskell` | ``template-haskell`` library | `libraries/template-haskell/changelog.md` | +| `ghc-pkg` | ``ghc-pkg`` | — | +| `ghc-toolchain` | ``ghc-toolchain`` | — | ### Entry format @@ -83,20 +92,34 @@ library's `Distribution.Fields` parser ## Configuration The file `changelog.d/config` declares the structure of the generated release -notes: required fields, section names, preamble text, and the included-libraries -table. Edit it when adding new sections or changing release note formatting. +notes: required fields, section names, preamble text, the included-libraries +table, and the `markdown-targets:` mapping that wires sections to per-library +`changelog.md` files. Edit it when adding new sections or changing release-note +formatting. + +The `markdown-targets:` block is the source of truth for "which section's +entries get a Markdown emission, and which extra fields (e.g. `clc`) are +required for that section." Each line is `<section-key> <path> [<extra-required-field>...]`. ## For maintainers ### Hadrian targets -Generate release notes: +Generate RST release notes (existing behaviour): ``` hadrian/build changelog # uses project version hadrian/build changelog --changelog-version=10.2.1 # explicit version ``` Output: `docs/users_guide/<version>-notes.rst` +Generate per-library Markdown bullets: + +``` +hadrian/build libraries-changelog-markdown +``` + +Output is one stream containing every configured `markdown-targets:` section. + Clear entries after branch cut: ``` @@ -108,3 +131,25 @@ Validate entries: ``` hadrian/build test --only=changelog-d ``` + +### RST -> Markdown rewrite rules + +`--libraries-changelog-markdown` rewrites the inline RST in each entry to Markdown: + +| RST | Markdown | +| -------------------------------------------------| ------------------------------------------------------------------------------------------------------ | +| ``code`` (double-backtick) | `code` (single-backtick) | +| `text <url>`_ | [text](url) | +| :ghc-ticket:`N` | [#N](https://gitlab.haskell.org/ghc/ghc/issues/N) | +| :ghc-mr:`N` | [!N](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/N) | +| :ghc-wiki:`p` | [p](https://gitlab.haskell.org/ghc/ghc/wikis/p) | +| :clc:`N` | [CLC proposal #N](https://github.com/haskell/core-libraries-committee/issues/N) | +| :ghc-flag:`-foo` | `-foo` | +| :extension:`E` | `E` | +| :ghci-cmd:`X`, :rts-flag:`X` | `X` | +| :base-ref:`Mod.id` `` | `Mod.id` | +| :th-ref:, :cabal-ref: ,:ghc-prim-ref: | `ref` | +| .. code-block:: lang + indented body | Triple-backtick fenced block with `lang` | +| .. note:: / .. warning:: | `> **Note:**` / `> **Warning:**` blockquote | + + ===================================== utils/changelog-d/tests/config ===================================== @@ -0,0 +1,9 @@ +required-fields: synopsis mrs issues section + +sections: { + base ``base`` library +} + +markdown-targets: { + base _fake/changelog.md clc +} ===================================== utils/changelog-d/tests/expected/test-parser-rewriter.md ===================================== @@ -0,0 +1,33 @@ +## ?.?.? *TBA* + +* Self-test fixture exercising the parser/rewriter. Uses double-backtick `code`, + RST hyperlinks [the changelog wiki](https://gitlab.haskell.org/ghc/ghc/-/wikis/contributing/changelog), + GHC-flavoured roles [#12345](https://gitlab.haskell.org/ghc/ghc/issues/12345), [!6789](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6789), [commentary/compiler](https://gitlab.haskell.org/ghc/ghc/wikis/commentary/co…, + [CLC proposal #123](https://github.com/haskell/core-libraries-committee/issues/123), `-fxxx`, `TypeApplications`, `:type`, + `-N`, haddock cross-refs `Data.Maybe.fromMaybe`, + `Language.Haskell.TH.Lib`, `Distribution.Simple`, + `GHC.Prim`, the internal-doc role, and an :unknown-role:`pass-through`. ([#26002](https://gitlab.haskell.org/ghc/ghc/issues/26002)) ([!15830](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15830)) ([CLC proposal #0](https://github.com/haskell/core-libraries-committee/issues/0)) + + This description block exercises block-level rewrites and inline rewrites + inside a multi-line braced field. + + Inline forms inside the description: `inline code`, `DataKinds`, + [!15830](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15830), `Control.Applicative`, and a [bare RST link](https://example.invalid/). + + > **Note:** + > This is an RST note admonition. It should render as a Markdown + > blockquote prefixed with `> **Note:**`. + > + > **Warning:** + > This is an RST warning admonition. It should render as a Markdown + > blockquote prefixed with `> **Warning:**`. + > + ```haskell + foo :: Int -> Int + foo x = x + 1 + bar :: String + bar = "hello" + + ``` + After the code block, plain prose continues. Verify that the renderer + exits the fenced block correctly and resumes paragraph flow here. ===================================== utils/changelog-d/tests/test-parser-rewriter ===================================== @@ -0,0 +1,48 @@ +-- This file exercises every construct supported by changelog-d's parser +-- and RST -> Markdown rewriter. It is kept in tree as a regression +-- fixture: when the parser or rewriter is touched, run +-- cabal run changelog-d -- --validate changelog.d/ +-- cabal run changelog-d -- --libraries-changelog-markdown changelog.d/ +-- and visually compare the output. The tool treats this like any +-- other fragment, so it WILL appear in `--version`'ed RST and in +-- `--libraries-changelog-markdown` output. Delete it before cutting a +-- release, or move it under utils/changelog-d/tests/ if/when that +-- directory is wired up. +section: base +synopsis: Self-test fixture exercising the parser/rewriter. Uses double-backtick ``code``, + RST hyperlinks `the changelog wiki <https://gitlab.haskell.org/ghc/ghc/-/wikis/contributing/changelog>`_, + GHC-flavoured roles :ghc-ticket:`12345`, :ghc-mr:`6789`, :ghc-wiki:`commentary/compiler`, + :clc:`123`, :ghc-flag:`-fxxx`, :extension:`TypeApplications`, :ghci-cmd:`:type`, + :rts-flag:`-N`, haddock cross-refs :base-ref:`Data.Maybe.fromMaybe`, + :th-ref:`Language.Haskell.TH.Lib`, :cabal-ref:`Distribution.Simple`, + :ghc-prim-ref:`GHC.Prim`, the :doc:`internal-doc` role, and an :unknown-role:`pass-through`. +issues: #26002 +mrs: !15830 +clc: #0 + +description: { + This description block exercises block-level rewrites and inline rewrites + inside a multi-line braced field. + + Inline forms inside the description: ``inline code``, :extension:`DataKinds`, + :ghc-mr:`15830`, :base-ref:`Control.Applicative`, and a `bare RST link + <https://example.invalid/>`_. + + .. note:: + This is an RST note admonition. It should render as a Markdown + blockquote prefixed with ``> **Note:**``. + + .. warning:: + This is an RST warning admonition. It should render as a Markdown + blockquote prefixed with ``> **Warning:**``. + + .. code-block:: haskell + + foo :: Int -> Int + foo x = x + 1 + bar :: String + bar = "hello" + + After the code block, plain prose continues. Verify that the renderer + exits the fenced block correctly and resumes paragraph flow here. +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84998393f2f217119785f80ab21ceac… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/84998393f2f217119785f80ab21ceac… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/27183] changelog-d: Add support for emitting markdown for library changelogs
by Zubin (＠wz1000) 28 Apr '26

28 Apr '26

Zubin pushed to branch wip/27183 at Glasgow Haskell Compiler / GHC Commits: 553822f6 by Zubin Duggal at 2026-04-28T17:10:53+05:30 changelog-d: Add support for emitting markdown for library changelogs Now library changelog entries are written in changelog.d/ uniformly, and the changelog-d tool gains functionality to output markdown fragments for the library changelog files. The fragments will be spliced into the respective files at release time by the release manager. Also changes the lint-changelog CI job to ensure that changes which touch base have a changelog entry and a CLC proposal. Fixes #27183 - - - - - 12 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - changelog.d/config - docs/users_guide/ghc_config.py.in - hadrian/src/Rules/Changelog.hs - libraries/integer-gmp/integer-gmp.cabal - testsuite/tests/linters/Makefile - utils/changelog-d/ChangelogD.hs - utils/changelog-d/README.md - + utils/changelog-d/tests/config - + utils/changelog-d/tests/expected/test-parser-rewriter.md - + utils/changelog-d/tests/test-parser-rewriter Changes: ===================================== .gitlab-ci.yml ===================================== @@ -247,6 +247,9 @@ ghc-linters: # Check that MRs include a changelog entry in changelog.d/. # Skipped if the MR has the ~"no-changelog" label. +# +# If MR's diff touches libraries/base/, the changelog must also have a non-empty +# `clc:` field. lint-changelog: stage: tool-lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" @@ -254,6 +257,7 @@ lint-changelog: variables: BUILD_FLAVOUR: default CHANGELOG_EXPECT_MR: "$CI_MERGE_REQUEST_IID" + CHANGELOG_EXPECT_CLC: "" script: # Check that the MR adds at least one changelog entry - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" "$CI_MERGE_REQUEST_TARGET_BRANCH_NAME" @@ -276,6 +280,10 @@ lint-changelog: when: never - if: '$CI_MERGE_REQUEST_LABELS =~ /.*no-changelog.*/' when: never + - changes: + - libraries/base/**/* + variables: + CHANGELOG_EXPECT_CLC: "1" - if: $CI_MERGE_REQUEST_ID - *drafts-can-fail-lint ===================================== .gitlab/merge_request_templates/Default.md ===================================== @@ -23,7 +23,8 @@ https://gitlab.haskell.org/ghc/ghc/-/wikis/Contributing-a-Patch - [ ] This MR solves the problem described in the following issue:  - [ ] A changelog entry was added in `changelog.d/` for user-facing changes (see [changelog guide][changelog]). If this MR does not need a changelog entry, the ~"no-changelog" label was applied. -- [ ] This MR does not make any significant changes to `base`, or it has an accompanying [CLC proposal](https://github.com/haskell/core-libraries-committee#base-package). +- [ ] This MR does not make any significant changes to `base`, or it has an accompanying [CLC proposal](https://github.com/haskell/core-libraries-committee#base-package) + and the changelog fragment uses `section: base` with the `clc: #<proposal>` field set. - [ ] If this MR has the potential to break user programs, the ~"user-facing" label was applied to test against head.hackage. - [ ] All commits are either individually buildable or squashed. ===================================== changelog.d/config ===================================== @@ -27,6 +27,7 @@ sections: { cmm Cmm build-tools Build tools base ``base`` library + ghc-internal ``ghc-internal`` library ghc-prim ``ghc-prim`` library ghc-lib ``ghc`` library ghc-heap ``ghc-heap`` library @@ -36,6 +37,18 @@ sections: { ghc-toolchain ``ghc-toolchain`` } +-- markdown-targets: sections that also need to end up in +-- per-library changelog files. The optional third token +-- lists extra fields that might be required for this section +-- like `clc` for base. +markdown-targets: { + base libraries/base/changelog.md clc + ghc-internal libraries/ghc-internal/CHANGELOG.md + ghc-prim libraries/ghc-prim/changelog.md + ghc-experimental libraries/ghc-experimental/CHANGELOG.md + template-haskell libraries/template-haskell/changelog.md +} + included-libraries-preamble: { The package database provided with this distribution also contains a number of packages other than GHC itself. See the changelogs provided with these packages ===================================== docs/users_guide/ghc_config.py.in ===================================== @@ -7,12 +7,14 @@ if parse_version(sphinx.__version__) >= parse_version("4.0.0"): 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#%s'), 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '%s'), 'ghc-mr': ('https://gitlab.haskell.org/ghc/ghc/-/merge_requests/%s', '!%s'), + 'clc': ('https://github.com/haskell/core-libraries-committee/issues/%s', 'CLC proposal #%s'), } else: extlinks = { 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#'), 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', ''), 'ghc-mr': ('https://gitlab.haskell.org/ghc/ghc/-/merge_requests/%s', '!'), + 'clc': ('https://github.com/haskell/core-libraries-committee/issues/%s', 'CLC proposal #'), } libs_base_uri = '../libraries' ===================================== hadrian/src/Rules/Changelog.hs ===================================== @@ -11,8 +11,9 @@ import qualified System.Directory as IO -- | Rules for generating and managing changelog entries. -- -- Targets: --- hadrian/build changelog -- generate release notes +-- hadrian/build changelog -- generate RST release notes -- hadrian/build changelog --changelog-version=10.2.1 -- with explicit version +-- hadrian/build libraries-changelog-markdown -- emit per-library Markdown bullets to stdout -- hadrian/build changelog-clear -- remove old entries changelogRules :: Rules () changelogRules = do @@ -25,19 +26,6 @@ changelogRules = do ctx <- programContext stage0Boot changelogD progPath <- programPath ctx need [progPath] - - -- These cabal files are needed by changelog-d to determine the - -- versions of packages shipped with GHC. - let templatedCabalFiles = map pkgCabalFile - [ ghcBoot - , ghcBootTh - , ghcExperimental - , ghcInternal - , ghci - , compiler - , ghcHeap - , templateHaskell - ] need templatedCabalFiles top <- topDirectory @@ -47,6 +35,18 @@ changelogRules = do :: Action () putSuccess $ "| Generated release notes: " ++ outFile + phony "libraries-changelog-markdown" $ do + ctx <- programContext stage0Boot changelogD + progPath <- programPath ctx + need [progPath] + need templatedCabalFiles + + top <- topDirectory + cmd_ [progPath] + [ top -/- "changelog.d/" + , "--libraries-changelog-markdown" + ] + phony "changelog-clear" $ do top <- topDirectory let dir = top -/- "changelog.d" @@ -54,3 +54,17 @@ changelogRules = do let toRemove = filter (\f -> f /= "config" && not (isPrefixOf "." f)) entries liftIO $ mapM_ (IO.removeFile . (dir -/-)) toRemove putSuccess $ "| Removed " ++ show (length toRemove) ++ " changelog entries" + where + -- These cabal files are needed by changelog-d to determine the + -- versions of packages shipped with GHC. + templatedCabalFiles = map pkgCabalFile + [ ghcBoot + , ghcBootTh + , ghcExperimental + , ghcInternal + , ghci + , compiler + , ghcHeap + , templateHaskell + , base + ] ===================================== libraries/integer-gmp/integer-gmp.cabal ===================================== @@ -13,6 +13,9 @@ build-type: Simple homepage: https://www.haskell.org/ghc/ bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +extra-source-files: + changelog.md + description: This package used to provide an implementation of the standard 'Integer' type based on the ===================================== testsuite/tests/linters/Makefile ===================================== @@ -30,8 +30,12 @@ notes: (cd $(TOP)/.. && $(LINT_NOTES) broken-refs) changelog-d: -ifdef CHANGELOG_EXPECT_MR +ifneq "$(CHANGELOG_EXPECT_MR)" "" +ifneq "$(CHANGELOG_EXPECT_CLC)" "" + (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate --expect-mr $(CHANGELOG_EXPECT_MR) --expect-clc) +else (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate --expect-mr $(CHANGELOG_EXPECT_MR)) +endif else (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate) endif ===================================== utils/changelog-d/ChangelogD.hs ===================================== @@ -10,15 +10,15 @@ module Main (main) where import Control.Exception (Exception (..)) -import Control.Monad (unless, void, when) -import Data.Char (isSpace) +import Control.Monad (filterM, unless, void, when) +import Data.Char (isAlpha, isSpace) import Data.Foldable (for_, toList, traverse_) import Data.Function (on) -import Data.List (intercalate, sort, sortBy) +import Data.List (find, intercalate, isPrefixOf, isSuffixOf, sort, sortBy, stripPrefix) import Data.Maybe (isJust, isNothing, mapMaybe) import Data.Set (Set) import Data.Traversable (for) -import System.Directory (listDirectory) +import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath ((</>), dropTrailingPathSeparator, takeDirectory) @@ -58,16 +58,35 @@ usage = unlines , " Collect changelog entries and produce release notes." , "" , "Options:" - , " --version <version> Version number for RST file header (e.g. 10.2.1)" - , " --validate Validate entries only, no output" - , " --expect-mr <N> Check that at least one entry references MR !N" - , " --help Show this help" + , " --version <version> Version number for RST file header (e.g. 10.2.1)" + , " --validate Validate entries only, no output" + , " --expect-mr <N> Check that at least one entry references MR !N" + , " --expect-clc Require the entry matched by --expect-mr" + , " to have a non-empty 'clc:' field. Used by" + , " CI for MRs touching base." + , " --libraries-changelog-markdown Emit per-library Markdown bullets to" + , " stdout (suppresses RST emission). Output" + , " is intended to be pasted into each" + , " libraries/<lib>/changelog.md by hand;" + , " --section <key> Restrict --libraries-changelog-markdown" + , " to a single section. Without this, all" + , " configured markdown-targets are emitted," + , " separated by HTML-comment markers." + , " --help Show this help" ] parseArgs :: [String] -> Either String Opts parseArgs = go defaultOpts where - defaultOpts = Opts "changelog.d" Nothing False Nothing + defaultOpts = Opts + { optDirectory = "changelog.d" + , optVersion = Nothing + , optValidate = False + , optExpectMR = Nothing + , optExpectCLC = False + , optMarkdown = False + , optMdSection = Nothing + } go opts [] = Right opts go _ ("--help" : _) = Left "" @@ -78,6 +97,11 @@ parseArgs = go defaultOpts [(mr, "")] -> go opts { optExpectMR = Just mr } rest _ -> Left $ "--expect-mr requires a number, got: " ++ n go _ ("--expect-mr" : []) = Left "--expect-mr requires an argument" + go opts ("--expect-clc" : rest) = go opts { optExpectCLC = True } rest + go opts ("--libraries-changelog-markdown" : rest) = + go opts { optMarkdown = True } rest + go opts ("--section" : s : rest) = go opts { optMdSection = Just s } rest + go _ ("--section" : []) = Left "--section requires an argument" go _ (('-':'-':opt) : _) = Left $ "Unknown option: --" ++ opt go _ (('-':opt) : _) = Left $ "Unknown option: -" ++ opt go opts (dir : rest) = go opts { optDirectory = dir } rest @@ -124,9 +148,14 @@ makeChangelog Opts {..} = do either (exitWithExc . PlainError) return $ parseWith parseConfig filename contents + -- Read only regular files, skipping config, dotfiles, and any + -- subdirectories (e.g. golden-output dirs alongside test fragments). dirContents <- filter (not . isTmpFile) <$> listDirectory optDirectory + fragmentNames <- + filterM (\name -> doesFileExist (optDirectory </> name)) + (filter (/= "config") $ sort dirContents) allEntries <- fmap Map.fromList $ - for (filter (/= "config") $ sort dirContents) $ \name -> do + for fragmentNames $ \name -> do let fp = optDirectory </> name contents <- BS.readFile fp entry <- parseEntryFile fp contents @@ -140,17 +169,38 @@ makeChangelog Opts {..} = do exitWithExc $ PlainError "Validation failed." -- Check expected MR number if specified - for_ optExpectMR $ \expectedMR -> do - let expectedMRNum = MRNumber expectedMR - entriesWithMR = Map.filter (\e -> expectedMRNum `Set.member` entryMrs e) allEntries - when (Map.null entriesWithMR && not (Map.null allEntries)) $ do - hPutStrLn stderr $ "Warning: No changelog entry references this MR (!" ++ show expectedMR ++ ")." - hPutStrLn stderr $ "Add 'mrs: !" ++ show expectedMR ++ "' to your changelog entry." - hPutStrLn stderr "" - exitFailure + matchedByMR <- case optExpectMR of + Nothing -> pure Map.empty + Just expectedMR -> do + let expectedMRNum = MRNumber expectedMR + withMR = Map.filter (\e -> expectedMRNum `Set.member` entryMrs e) allEntries + when (Map.null withMR && not (Map.null allEntries)) $ do + hPutStrLn stderr $ "Warning: No changelog entry references this MR (!" ++ show expectedMR ++ ")." + hPutStrLn stderr $ "Add 'mrs: !" ++ show expectedMR ++ "' to your changelog entry." + hPutStrLn stderr "" + exitFailure + pure withMR + + -- --expect-clc: assert that the MR-matched entry has clc: set. + when optExpectCLC $ case optExpectMR of + Nothing -> exitWithExc $ PlainError + "--expect-clc requires --expect-mr (which entry to check?)" + Just expectedMR -> + when (not (Map.null matchedByMR) + && all (Set.null . entryClcs) matchedByMR) $ do + hPutStrLn stderr $ + "Error: changelog entry for !" ++ show expectedMR + ++ " does not have a 'clc:' field." + hPutStrLn stderr + "Changes to base or user-facing changes require a CLC proposal." + hPutStrLn stderr "Add 'clc: #<proposal>' to your changelog entry." + exitFailure unless optValidate $ - outputRST optDirectory optVersion cfg (Map.elems allEntries) + if optMarkdown + then outputMarkdown optDirectory cfg optMdSection + (Map.elems allEntries) + else outputRST optDirectory optVersion cfg (Map.elems allEntries) ------------------------------------------------------------------------------- -- RST output @@ -218,6 +268,9 @@ formatEntry Entry {..} = ] ++ [ "(:ghc-mr:`" ++ show n ++ "`)" | MRNumber n <- Set.toList entryMrs + ] ++ + [ "(:clc:`" ++ show n ++ "`)" + | CLCNumber n <- Set.toList entryClcs ] description = maybe "" (\d -> "\n" ++ trim d ++ "\n\n") entryDescription @@ -262,25 +315,281 @@ generateIncludedLibraries baseDir preamble libs = do where fst3 (a, _, _) = a - extractField :: String -> String -> Maybe String - extractField fieldName contents = - case mapMaybe (matchField fieldName) (lines contents) of - (v:_) -> Just v - [] -> Nothing - - matchField :: String -> String -> Maybe String - matchField fieldName line = - let stripped = dropWhile isSpace line - (key, rest) = break (\c -> c == ':' || isSpace c) stripped - in if map toLower' key == map toLower' fieldName - then case dropWhile isSpace rest of - (':':val) -> Just (trim (dropWhile isSpace val)) - _ -> Nothing - else Nothing - - toLower' c - | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) - | otherwise = c +extractField :: String -> String -> Maybe String +extractField fieldName contents = + case mapMaybe (matchField fieldName) (lines contents) of + (v:_) -> Just v + [] -> Nothing + +matchField :: String -> String -> Maybe String +matchField fieldName line = + let stripped = dropWhile isSpace line + (key, rest) = break (\c -> c == ':' || isSpace c) stripped + in if map toLower' key == map toLower' fieldName + then case dropWhile isSpace rest of + (':':val) -> Just (trim (dropWhile isSpace val)) + _ -> Nothing + else Nothing + +toLower' :: Char -> Char +toLower' c + | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) + | otherwise = c + +------------------------------------------------------------------------------- +-- Markdown output +------------------------------------------------------------------------------- + +-- | Emit per-library Markdown bullets to stdout. +-- +-- With 'mSect' set, emit just that section's bullets (used interactively). +-- Without it, emit every section listed in @markdown-targets:@, separated +-- by HTML comments naming each section +outputMarkdown + :: FilePath -- ^ changelog.d directory (used to locate cabal files) + -> Cfg + -> Maybe String -- ^ --section <key> + -> [Entry] + -> IO () +outputMarkdown dir Cfg{..} mSect entries = do + targets <- case mSect of + Just key -> case find ((== key) . mtSection) cfgMarkdownTargets of + Nothing -> exitWithExc $ PlainError $ + "Unknown markdown section: " ++ key + ++ "\nKnown sections: " + ++ intercalate ", " (map mtSection cfgMarkdownTargets) + Just mt -> pure [mt] + Nothing -> pure cfgMarkdownTargets + + let multi = isNothing mSect + baseDir = takeDirectory (dropTrailingPathSeparator dir) + + case mSect of + Just key | not (any (\mt -> mtSection mt == key) cfgMarkdownTargets) -> + -- impossible; handled above + pure () + Just key | null (entriesFor key entries) -> + exitWithExc $ PlainError $ "No entries for section " ++ key + _ -> pure () + + for_ targets $ \mt -> do + let es = entriesFor (mtSection mt) entries + unless (null es) $ do + when multi $ do + putStrLn $ "" + putStrLn "" + libVer <- readLibraryVersion baseDir (mtPath mt) + putStrLn $ "## " ++ libVer ++ " *TBA*" + putStrLn "" + for_ (sortBy (flip compare `on` hasDescription) es) $ \entry -> + putStr (formatEntryMd entry) + when multi $ putStrLn "" + +entriesFor :: String -> [Entry] -> [Entry] +entriesFor key = filter $ \e -> case entrySection e of + Just (Section s) -> s == key + Nothing -> False + +-- | Given the path of a library's @changelog.md@ (repo-relative), find the +-- sibling @*.cabal@ (or @*.cabal.in@) and read the @version:@ field. +readLibraryVersion :: FilePath -> FilePath -> IO String +readLibraryVersion baseDir mdPath = do + let libDir = takeDirectory mdPath + libDirFs = baseDir </> libDir + exists <- doesDirectoryExist libDirFs + if not exists + then do + hPutStrLn stderr $ "Warning: directory does not exist: " ++ libDirFs + pure "?.?.?" + else do + candidates <- listDirectory libDirFs + let cabals = filter (\f -> ".cabal" `isSuffixOf` f) candidates + -- Prefer non-templated *.cabal over *.cabal.in (the former is + -- the rendered file Hadrian needs before invoking us). + ranked = sortBy (compare `on` (\f -> if ".cabal.in" `isSuffixOf` f then (1::Int) else 0)) cabals + case ranked of + [] -> do + hPutStrLn stderr $ + "Warning: no .cabal file under " ++ libDir + pure "?.?.?" + (cf:_) -> do + contents <- readFile (libDirFs </> cf) + case extractField "version" contents of + Just v -> pure v + Nothing -> do + hPutStrLn stderr $ + "Warning: could not parse version from " ++ libDir </> cf + pure "?.?.?" + +-- | Format an Entry as a Markdown bullet. Mirrors 'formatEntry' for RST +-- but emits Markdown links for issues/MRs/CLC and rewrites RST inline +-- markup to markdown. +formatEntryMd :: Entry -> String +formatEntryMd Entry{..} = indentBulletMd (header ++ description) + where + header = unwords $ + [ rstToMarkdown entrySynopsis ] ++ + [ mdLink ("#" ++ show n) + ("https://gitlab.haskell.org/ghc/ghc/issues/" ++ show n) + | IssueNumber n <- Set.toList entryIssues + ] ++ + [ mdLink ("!" ++ show n) + ("https://gitlab.haskell.org/ghc/ghc/-/merge_requests/" ++ show n) + | MRNumber n <- Set.toList entryMrs + ] ++ + [ mdLink ("CLC proposal #" ++ show n) + ("https://github.com/haskell/core-libraries-committee/issues/" ++ show n) + | CLCNumber n <- Set.toList entryClcs + ] + + description = maybe "" (\d -> "\n\n" ++ rstToMarkdown (trim d) ++ "\n") entryDescription + + mdLink :: String -> String -> String + mdLink txt url = "(" ++ "[" ++ txt ++ "](" ++ url ++ ")" ++ ")" + +-- | Indent text as a Markdown bullet: the first line gets @"* "@ prefix, +-- subsequent lines are indented two spaces. Mirrors 'indentBullet'. +indentBulletMd :: String -> String +indentBulletMd = unlines . go . lines + where + go [] = [] + go (x:xs) = ("* " ++ x) : map indentLine xs + indentLine "" = "" + indentLine s = " " ++ s + +------------------------------------------------------------------------------- +-- RST -> Markdown rewriting +------------------------------------------------------------------------------- +-- +-- Applies the following rules: +-- +-- | RST | Markdown | +-- | -------------------------------------------------| ------------------------------------------------------------------------------------------------------ | +-- | ``code`` (double-backtick) | `code` (single-backtick) | +-- | `text <url>`_ | [text](url) | +-- | :ghc-ticket:`N` | [#N](https://gitlab.haskell.org/ghc/ghc/issues/N) | +-- | :ghc-mr:`N` | [!N](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/N) | +-- | :ghc-wiki:`p` | [p](https://gitlab.haskell.org/ghc/ghc/wikis/p) | +-- | :clc:`N` | [CLC proposal #N](https://github.com/haskell/core-libraries-committee/issues/N) | +-- | :ghc-flag:`-foo` | `-foo` | +-- | :extension:`E` | `E` | +-- | :ghci-cmd:`X`, :rts-flag:`X` | `X` | +-- | :base-ref:`Mod.id` `` | `Mod.id` | +-- | :th-ref:, :cabal-ref: ,:ghc-prim-ref: | `ref` | +-- | .. code-block:: lang + indented body | Triple-backtick fenced block with `lang` | +-- | .. note:: / .. warning:: | `> **Note:**` / `> **Warning:**` blockquote | + +rstToMarkdown :: String -> String +rstToMarkdown s = + let trailingNL = not (null s) && last s == '\n' + body = intercalate "\n" . blockPass . lines . inlinePass $ s + in body ++ (if trailingNL then "\n" else "") + +inlinePass :: String -> String +inlinePass [] = [] +-- Double-backtick code: ``code`` → `code` +inlinePass ('`':'`':rest) = + case breakOnSubstring "``" rest of + (body, _:_:after) -> "`" ++ body ++ "`" ++ inlinePass after + _ -> '`':'`': inlinePass rest +-- RST hyperlink: `text <url>`_ → [text](url) +inlinePass ('`':rest) + | Just (txt, url, after) <- pickRstLink rest = + "[" ++ trim txt ++ "](" ++ url ++ ")" ++ inlinePass after +-- :role:`body` interpreted-text role +inlinePass (':':rest) + | Just (role, body, after) <- pickRole rest = + renderRole role body ++ inlinePass after +inlinePass (c:cs) = c : inlinePass cs + +breakOnSubstring :: String -> String -> (String, String) +breakOnSubstring needle = go + where + go [] = ([], []) + go s@(c:cs) + | needle `isPrefixOf` s = ([], s) + | otherwise = + let (a, b) = go cs in (c:a, b) + +-- | Try to consume a @\`text \<url\>\`_@ RST hyperlink starting after the +-- leading backtick. Returns @(text, url, rest)@ on success. +pickRstLink :: String -> Maybe (String, String, String) +pickRstLink xs = do + let (txt, r1) = break (== '<') xs + case r1 of + '<':r2 -> do + let (url, r3) = break (== '>') r2 + case r3 of + '>':'`':'_':'_':after -> Just (txt, url, after) + '>':'`':'_':after -> Just (txt, url, after) + _ -> Nothing + _ -> Nothing + +-- | Try to consume a @role:\`body\`@ interpreted-text role starting just +-- after the leading colon. +pickRole :: String -> Maybe (String, String, String) +pickRole xs = + let (name, r1) = span (\c -> isAlpha c || c == '-') xs + in case (null name, r1) of + (False, ':':'`':r2) -> case break (== '`') r2 of + (body, '`':after) | not (null body) -> Just (name, body, after) + _ -> Nothing + _ -> Nothing + +-- | Render a known interpreted-text role to Markdown. +renderRole :: String -> String -> String +renderRole role body = case role of + "ghc-ticket" -> mdLink ("#" ++ body) ("https://gitlab.haskell.org/ghc/ghc/issues/" ++ body) + "ghc-mr" -> mdLink ("!" ++ body) ("https://gitlab.haskell.org/ghc/ghc/-/merge_requests/" ++ body) + "ghc-wiki" -> mdLink body ("https://gitlab.haskell.org/ghc/ghc/wikis/" ++ body) + "clc" -> mdLink ("CLC proposal #" ++ body) + ("https://github.com/haskell/core-libraries-committee/issues/" ++ body) + "ghc-flag" -> "`" ++ body ++ "`" + "extension" -> "`" ++ body ++ "`" + "ghci-cmd" -> "`" ++ body ++ "`" + "rts-flag" -> "`" ++ body ++ "`" + "doc" -> body + "base-ref" -> "`" ++ body ++ "`" + "th-ref" -> "`" ++ body ++ "`" + "cabal-ref" -> "`" ++ body ++ "`" + "ghc-prim-ref" -> "`" ++ body ++ "`" + _ -> ":" ++ role ++ ":`" ++ body ++ "`" + where + mdLink txt url = "[" ++ txt ++ "](" ++ url ++ ")" + +-- | Block-level transforms applied after the inline pass. +blockPass :: [String] -> [String] +blockPass [] = [] +blockPass (l:rest) + | Just lang <- stripPrefix ".. code-block:: " (trim l) = + let (body, rest') = takeIndentedBlock rest + in ("```" ++ lang) : map (dropIndent 4) body ++ ["```"] ++ blockPass rest' + | trim l == ".. note::" = + let (body, rest') = takeIndentedBlock rest + in "> **Note:**" : map (("> " ++) . dropIndent 4) body ++ blockPass rest' + | trim l == ".. warning::" = + let (body, rest') = takeIndentedBlock rest + in "> **Warning:**" : map (("> " ++) . dropIndent 4) body ++ blockPass rest' + | otherwise = l : blockPass rest + +-- | Take a block of indented (or blank) lines following a directive; stop +-- at the first non-blank, non-indented line. +takeIndentedBlock :: [String] -> ([String], [String]) +takeIndentedBlock = go . dropWhile null + where + go [] = ([], []) + go (x:xs) + | null x = let (a, b) = go xs in (x:a, b) + | take 1 x == " " = let (a, b) = go xs in (x:a, b) + | otherwise = ([], x:xs) + +-- | Drop up to @n@ leading spaces from a line. +dropIndent :: Int -> String -> String +dropIndent _ "" = "" +dropIndent 0 s = s +dropIndent n (' ':cs) = dropIndent (n-1) cs +dropIndent _ s = s ------------------------------------------------------------------------------- -- Section grouping @@ -303,10 +612,13 @@ groupBySections sectionDefs entries = ------------------------------------------------------------------------------- data Opts = Opts - { optDirectory :: FilePath - , optVersion :: Maybe String - , optValidate :: Bool - , optExpectMR :: Maybe Int -- ^ Expected MR number + { optDirectory :: FilePath + , optVersion :: Maybe String + , optValidate :: Bool + , optExpectMR :: Maybe Int -- ^ Expected MR number + , optExpectCLC :: Bool -- ^ Require entry matched by --expect-mr to have clc: + , optMarkdown :: Bool -- ^ Emit per-library Markdown to stdout + , optMdSection :: Maybe String -- ^ Restrict markdown emission to one section } deriving (Show) @@ -332,6 +644,24 @@ instance C.Parsec MRNumber where instance C.Pretty MRNumber where pretty (MRNumber n) = PP.char '!' PP.<> PP.int n +newtype CLCNumber = CLCNumber Int + deriving (Eq, Ord, Show) + +instance C.Parsec CLCNumber where + parsec = do + _ <- P.char '#' + CLCNumber <$> P.integral + +instance C.Pretty CLCNumber where + pretty (CLCNumber n) = PP.char '#' PP.<> PP.int n + +data MarkdownTarget = MarkdownTarget + { mtSection :: String -- ^ section key matching an entry's `section:` + , mtPath :: FilePath -- ^ target changelog path, repo-relative + , mtRequiredFields :: [String] -- ^ extra required-fields when this section is used + } + deriving (Show) + newtype Section = Section String deriving (Eq, Ord, Show) @@ -351,6 +681,7 @@ data Cfg = Cfg , cfgPreamble :: String , cfgIncludedLibraries :: [(FilePath, String)] -- ^ (cabalPath, description) , cfgIncludedLibrariesPreamble :: String + , cfgMarkdownTargets :: [MarkdownTarget] } deriving (Show) @@ -364,6 +695,7 @@ parseConfig fields0 = do , cfgPreamble = cfgRawPreamble raw , cfgIncludedLibraries = parseIncludedLibraries (cfgRawIncludedLibraries raw) , cfgIncludedLibrariesPreamble = cfgRawIncludedLibrariesPreamble raw + , cfgMarkdownTargets = parseMarkdownTargets (cfgRawMarkdownTargets raw) } where (fields, sections) = C.partitionFields fields0 @@ -378,6 +710,7 @@ data CfgRaw = CfgRaw , cfgRawPreamble :: String , cfgRawIncludedLibraries :: String , cfgRawIncludedLibrariesPreamble :: String + , cfgRawMarkdownTargets :: String } cfgRawRequiredFieldsL :: Functor f => (Set String -> f (Set String)) -> CfgRaw -> f CfgRaw @@ -395,6 +728,9 @@ cfgRawIncludedLibrariesL f s = (\x -> s { cfgRawIncludedLibraries = x }) <$> f ( cfgRawIncludedLibrariesPreambleL :: Functor f => (String -> f String) -> CfgRaw -> f CfgRaw cfgRawIncludedLibrariesPreambleL f s = (\x -> s { cfgRawIncludedLibrariesPreamble = x }) <$> f (cfgRawIncludedLibrariesPreamble s) +cfgRawMarkdownTargetsL :: Functor f => (String -> f String) -> CfgRaw -> f CfgRaw +cfgRawMarkdownTargetsL f s = (\x -> s { cfgRawMarkdownTargets = x }) <$> f (cfgRawMarkdownTargets s) + cfgRawGrammar :: C.ParsecFieldGrammar CfgRaw CfgRaw cfgRawGrammar = CfgRaw <$> C.monoidalFieldAla "required-fields" (C.alaSet' C.FSep C.Token) cfgRawRequiredFieldsL @@ -402,6 +738,7 @@ cfgRawGrammar = CfgRaw <*> C.freeTextFieldDef "preamble" cfgRawPreambleL <*> C.freeTextFieldDef "included-libraries" cfgRawIncludedLibrariesL <*> C.freeTextFieldDef "included-libraries-preamble" cfgRawIncludedLibrariesPreambleL + <*> C.freeTextFieldDef "markdown-targets" cfgRawMarkdownTargetsL parseSections :: String -> [(String, String)] parseSections = mapMaybe parseLine . lines @@ -419,6 +756,20 @@ parseIncludedLibraries = mapMaybe parseLine . lines (path, rest) | not (null path) -> Just (path, trim rest) _ -> Nothing +-- | Parse the @markdown-targets:@ block. +-- +-- Each non-empty, non-comment line is +-- <section-key> <path> [<extra-required-field>...] +-- The extra tokens declare additional fields required of any entry whose section: matches. +parseMarkdownTargets :: String -> [MarkdownTarget] +parseMarkdownTargets = mapMaybe parseLine . lines + where + parseLine l = case words (trim l) of + [] -> Nothing + [_] -> Nothing -- need at least section + path + (sect:path:extra) -> + Just $ MarkdownTarget sect path extra + ------------------------------------------------------------------------------- -- Entry ------------------------------------------------------------------------------- @@ -428,6 +779,7 @@ data Entry = Entry , entryDescription :: Maybe String , entryMrs :: Set MRNumber , entryIssues :: Set IssueNumber + , entryClcs :: Set CLCNumber , entrySection :: Maybe Section } deriving (Show) @@ -447,6 +799,9 @@ entryMrsL f s = (\x -> s { entryMrs = x }) <$> f (entryMrs s) entryIssuesL :: Functor f => (Set IssueNumber -> f (Set IssueNumber)) -> Entry -> f Entry entryIssuesL f s = (\x -> s { entryIssues = x }) <$> f (entryIssues s) +entryClcsL :: Functor f => (Set CLCNumber -> f (Set CLCNumber)) -> Entry -> f Entry +entryClcsL f s = (\x -> s { entryClcs = x }) <$> f (entryClcs s) + entrySectionL :: Functor f => (Maybe Section -> f (Maybe Section)) -> Entry -> f Entry entrySectionL f s = (\x -> s { entrySection = x }) <$> f (entrySection s) @@ -477,6 +832,7 @@ entryGrammar = Entry <*> C.freeTextField "description" entryDescriptionL <*> C.monoidalFieldAla "mrs" (C.alaSet C.NoCommaFSep) entryMrsL <*> C.monoidalFieldAla "issues" (C.alaSet C.NoCommaFSep) entryIssuesL + <*> C.monoidalFieldAla "clc" (C.alaSet C.NoCommaFSep) entryClcsL <*> C.optionalField "section" entrySectionL ------------------------------------------------------------------------------- @@ -510,8 +866,21 @@ validateEntry cfg entry = foldMap (\validator -> validator cfg entry) validateRequiredFields :: Validator validateRequiredFields Cfg{..} Entry{..} = fmap RequiredFieldError $ - mapMaybe checkField $ Set.toList cfgRequiredFields + mapMaybe checkField $ Set.toList effectiveRequired where + -- Effective required-fields = global cfgRequiredFields + extras for the + -- entry's section as declared in cfgMarkdownTargets + -- (e.g. `base` adds `clc`). + effectiveRequired = + cfgRequiredFields `Set.union` + Set.fromList + [ f + | Just (Section sect) <- [entrySection] + , mt <- cfgMarkdownTargets + , mtSection mt == sect + , f <- mtRequiredFields mt + ] + checkField :: String -> Maybe RequiredFieldError checkField reqField = case fieldIsEmpty reqField of Left err -> Just err @@ -522,6 +891,7 @@ validateRequiredFields Cfg{..} Entry{..} = fmap RequiredFieldError $ fieldIsEmpty "description" = pure $ isNothing entryDescription fieldIsEmpty "mrs" = pure $ null entryMrs fieldIsEmpty "issues" = pure $ null entryIssues + fieldIsEmpty "clc" = pure $ null entryClcs fieldIsEmpty "section" = pure $ isNothing entrySection fieldIsEmpty f = Left $ UnknownRequiredField f ===================================== utils/changelog-d/README.md ===================================== @@ -23,46 +23,55 @@ description: { **Required fields:** `section`, `synopsis`, `mrs`, `issues` -**Optional fields:** `description` +**Optional fields:** `description`, `clc` + +**Conditionally required**: entries with `section: base` MUST also include a `clc:` +field referencing the CLC proposal authorising the change. If your MR doesn't need a changelog entry, apply the `no-changelog` label. ### Fields -| Field | Format | Description | -| ------------- | ------------------------------- | -----------------------------------------------| -| `synopsis` | Free-form RST | Brief description of the change | -| `mrs` | `!N` (space-separated) | MR number(s) | -| `issues` | `#N` (space-separated) | Issue number(s) | -| `section` | Section key (see below) | GHC component | -| `description` | Free-form RST in `{ ... }` | Extended details. Printed after the main entry | +| Field | Format | Description | +| ------------- | -------------------------- | ----------------------------------------------------- | +| `synopsis` | Free-form RST | Brief description of the change | +| `mrs` | `!N` (space-separated) | MR number(s) | +| `issues` | `#N` (space-separated) | Issue number(s) | +| `clc` | `#N` (space-separated) | CLC proposal number(s). Required for `section: base`. | +| `section` | Section key (see below) | GHC component | +| `description` | Free-form RST | Extended details. Printed after the main entry | ### Section keys -| Key | Heading | -| ------------------ | -------------------------------- | -| `language` | Language | -| `compiler` | Compiler | -| `profiling` | Profiling | -| `codegen` | Code generation | -| `llvm-backend` | LLVM backend | -| `js-backend` | JavaScript backend | -| `wasm-backend` | WebAssembly backend | -| `ghci` | GHCi | -| `rts` | Runtime system | -| `linker` | Linker | -| `bytecode` | Bytecode compiler | -| `packaging` | Packaging & build system | -| `cmm` | Cmm | -| `build-tools` | Build tools | -| `base` | ``base`` library | -| `ghc-prim` | ``ghc-prim`` library | -| `ghc-lib` | ``ghc`` library | -| `ghc-heap` | ``ghc-heap`` library | -| `ghc-experimental` | ``ghc-experimental`` library | -| `template-haskell` | ``template-haskell`` library | -| `ghc-pkg` | ``ghc-pkg`` | -| `ghc-toolchain` | ``ghc-toolchain`` | +The "Markdown" column indicates whether entries in that section also flow to +a per-library `changelog.md`. Sections without a +Markdown target appear only in the GHC release notes RST. + +| Key | Heading | Markdown target | +| ------------------ | ---------------------------- | ---------------------------------------------- | +| `language` | Language | — | +| `compiler` | Compiler | — | +| `profiling` | Profiling | — | +| `codegen` | Code generation | — | +| `llvm-backend` | LLVM backend | — | +| `js-backend` | JavaScript backend | — | +| `wasm-backend` | WebAssembly backend | — | +| `ghci` | GHCi | — | +| `rts` | Runtime system | — | +| `linker` | Linker | — | +| `bytecode` | Bytecode compiler | — | +| `packaging` | Packaging & build system | — | +| `cmm` | Cmm | — | +| `build-tools` | Build tools | — | +| `base` | ``base`` library | `libraries/base/changelog.md` | +| `ghc-internal` | ``ghc-internal`` library | `libraries/ghc-internal/CHANGELOG.md` | +| `ghc-prim` | ``ghc-prim`` library | `libraries/ghc-prim/changelog.md` | +| `ghc-lib` | ``ghc`` library | — | +| `ghc-heap` | ``ghc-heap`` library | — | +| `ghc-experimental` | ``ghc-experimental`` library | `libraries/ghc-experimental/CHANGELOG.md` | +| `template-haskell` | ``template-haskell`` library | `libraries/template-haskell/changelog.md` | +| `ghc-pkg` | ``ghc-pkg`` | — | +| `ghc-toolchain` | ``ghc-toolchain`` | — | ### Entry format @@ -83,20 +92,34 @@ library's `Distribution.Fields` parser ## Configuration The file `changelog.d/config` declares the structure of the generated release -notes: required fields, section names, preamble text, and the included-libraries -table. Edit it when adding new sections or changing release note formatting. +notes: required fields, section names, preamble text, the included-libraries +table, and the `markdown-targets:` mapping that wires sections to per-library +`changelog.md` files. Edit it when adding new sections or changing release-note +formatting. + +The `markdown-targets:` block is the source of truth for "which section's +entries get a Markdown emission, and which extra fields (e.g. `clc`) are +required for that section." Each line is `<section-key> <path> [<extra-required-field>...]`. ## For maintainers ### Hadrian targets -Generate release notes: +Generate RST release notes (existing behaviour): ``` hadrian/build changelog # uses project version hadrian/build changelog --changelog-version=10.2.1 # explicit version ``` Output: `docs/users_guide/<version>-notes.rst` +Generate per-library Markdown bullets: + +``` +hadrian/build libraries-changelog-markdown +``` + +Output is one stream containing every configured `markdown-targets:` section. + Clear entries after branch cut: ``` @@ -108,3 +131,25 @@ Validate entries: ``` hadrian/build test --only=changelog-d ``` + +### RST -> Markdown rewrite rules + +`--libraries-changelog-markdown` rewrites the inline RST in each entry to Markdown: + +| RST | Markdown | +| -------------------------------------------------| ------------------------------------------------------------------------------------------------------ | +| ``code`` (double-backtick) | `code` (single-backtick) | +| `text <url>`_ | [text](url) | +| :ghc-ticket:`N` | [#N](https://gitlab.haskell.org/ghc/ghc/issues/N) | +| :ghc-mr:`N` | [!N](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/N) | +| :ghc-wiki:`p` | [p](https://gitlab.haskell.org/ghc/ghc/wikis/p) | +| :clc:`N` | [CLC proposal #N](https://github.com/haskell/core-libraries-committee/issues/N) | +| :ghc-flag:`-foo` | `-foo` | +| :extension:`E` | `E` | +| :ghci-cmd:`X`, :rts-flag:`X` | `X` | +| :base-ref:`Mod.id` `` | `Mod.id` | +| :th-ref:, :cabal-ref: ,:ghc-prim-ref: | `ref` | +| .. code-block:: lang + indented body | Triple-backtick fenced block with `lang` | +| .. note:: / .. warning:: | `> **Note:**` / `> **Warning:**` blockquote | + + ===================================== utils/changelog-d/tests/config ===================================== @@ -0,0 +1,15 @@ +-- Minimal config for running changelog-d against the test fixture in +-- this directory. Mirrors the structure of the project-root +-- changelog.d/config but only declares the sections + markdown-targets +-- the fixture exercises. The path declared in markdown-targets is a +-- placeholder; readLibraryVersion warns and falls back to "?.?.?" when +-- the directory does not exist, which is captured in the golden output. +required-fields: synopsis mrs issues section + +sections: { + base ``base`` library +} + +markdown-targets: { + base _fake/changelog.md clc +} ===================================== utils/changelog-d/tests/expected/test-parser-rewriter.md ===================================== @@ -0,0 +1,33 @@ +## ?.?.? *TBA* + +* Self-test fixture exercising the parser/rewriter. Uses double-backtick `code`, + RST hyperlinks [the changelog wiki](https://gitlab.haskell.org/ghc/ghc/-/wikis/contributing/changelog), + GHC-flavoured roles [#12345](https://gitlab.haskell.org/ghc/ghc/issues/12345), [!6789](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6789), [commentary/compiler](https://gitlab.haskell.org/ghc/ghc/wikis/commentary/co…, + [CLC proposal #123](https://github.com/haskell/core-libraries-committee/issues/123), `-fxxx`, `TypeApplications`, `:type`, + `-N`, haddock cross-refs `Data.Maybe.fromMaybe`, + `Language.Haskell.TH.Lib`, `Distribution.Simple`, + `GHC.Prim`, the internal-doc role, and an :unknown-role:`pass-through`. ([#26002](https://gitlab.haskell.org/ghc/ghc/issues/26002)) ([!15830](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15830)) ([CLC proposal #0](https://github.com/haskell/core-libraries-committee/issues/0)) + + This description block exercises block-level rewrites and inline rewrites + inside a multi-line braced field. + + Inline forms inside the description: `inline code`, `DataKinds`, + [!15830](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15830), `Control.Applicative`, and a [bare RST link](https://example.invalid/). + + > **Note:** + > This is an RST note admonition. It should render as a Markdown + > blockquote prefixed with `> **Note:**`. + > + > **Warning:** + > This is an RST warning admonition. It should render as a Markdown + > blockquote prefixed with `> **Warning:**`. + > + ```haskell + foo :: Int -> Int + foo x = x + 1 + bar :: String + bar = "hello" + + ``` + After the code block, plain prose continues. Verify that the renderer + exits the fenced block correctly and resumes paragraph flow here. ===================================== utils/changelog-d/tests/test-parser-rewriter ===================================== @@ -0,0 +1,48 @@ +-- This file exercises every construct supported by changelog-d's parser +-- and RST -> Markdown rewriter. It is kept in tree as a regression +-- fixture: when the parser or rewriter is touched, run +-- cabal run changelog-d -- --validate changelog.d/ +-- cabal run changelog-d -- --libraries-changelog-markdown changelog.d/ +-- and visually compare the output. The tool treats this like any +-- other fragment, so it WILL appear in `--version`'ed RST and in +-- `--libraries-changelog-markdown` output. Delete it before cutting a +-- release, or move it under utils/changelog-d/tests/ if/when that +-- directory is wired up. +section: base +synopsis: Self-test fixture exercising the parser/rewriter. Uses double-backtick ``code``, + RST hyperlinks `the changelog wiki <https://gitlab.haskell.org/ghc/ghc/-/wikis/contributing/changelog>`_, + GHC-flavoured roles :ghc-ticket:`12345`, :ghc-mr:`6789`, :ghc-wiki:`commentary/compiler`, + :clc:`123`, :ghc-flag:`-fxxx`, :extension:`TypeApplications`, :ghci-cmd:`:type`, + :rts-flag:`-N`, haddock cross-refs :base-ref:`Data.Maybe.fromMaybe`, + :th-ref:`Language.Haskell.TH.Lib`, :cabal-ref:`Distribution.Simple`, + :ghc-prim-ref:`GHC.Prim`, the :doc:`internal-doc` role, and an :unknown-role:`pass-through`. +issues: #26002 +mrs: !15830 +clc: #0 + +description: { + This description block exercises block-level rewrites and inline rewrites + inside a multi-line braced field. + + Inline forms inside the description: ``inline code``, :extension:`DataKinds`, + :ghc-mr:`15830`, :base-ref:`Control.Applicative`, and a `bare RST link + <https://example.invalid/>`_. + + .. note:: + This is an RST note admonition. It should render as a Markdown + blockquote prefixed with ``> **Note:**``. + + .. warning:: + This is an RST warning admonition. It should render as a Markdown + blockquote prefixed with ``> **Warning:**``. + + .. code-block:: haskell + + foo :: Int -> Int + foo x = x + 1 + bar :: String + bar = "hello" + + After the code block, plain prose continues. Verify that the renderer + exits the fenced block correctly and resumes paragraph flow here. +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/553822f637a3585068d147c9c050cad… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/553822f637a3585068d147c9c050cad… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/27183] changelog-d: Add support for emitting markdown for library changelogs
by Zubin (＠wz1000) 28 Apr '26

28 Apr '26

Zubin pushed to branch wip/27183 at Glasgow Haskell Compiler / GHC Commits: ed6faa1b by Zubin Duggal at 2026-04-28T17:06:04+05:30 changelog-d: Add support for emitting markdown for library changelogs Now library changelog entries are written in changelog.d/ uniformly, and the changelog-d tool gains functionality to output markdown fragments for the library changelog files. The fragments will be spliced into the respective files at release time by the release manager. Also changes the lint-changelog CI job to ensure that changes which touch base have a changelog entry and a CLC proposal. Fixes #27183 - - - - - 12 changed files: - .gitlab-ci.yml - .gitlab/merge_request_templates/Default.md - changelog.d/config - docs/users_guide/ghc_config.py.in - hadrian/src/Rules/Changelog.hs - libraries/integer-gmp/integer-gmp.cabal - testsuite/tests/linters/Makefile - utils/changelog-d/ChangelogD.hs - utils/changelog-d/README.md - + utils/changelog-d/tests/config - + utils/changelog-d/tests/expected/test-parser-rewriter.md - + utils/changelog-d/tests/test-parser-rewriter Changes: ===================================== .gitlab-ci.yml ===================================== @@ -247,6 +247,9 @@ ghc-linters: # Check that MRs include a changelog entry in changelog.d/. # Skipped if the MR has the ~"no-changelog" label. +# +# If MR's diff touches libraries/base/, the changelog must also have a non-empty +# `clc:` field. lint-changelog: stage: tool-lint image: "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-deb13:$DOCKER_REV" @@ -254,6 +257,7 @@ lint-changelog: variables: BUILD_FLAVOUR: default CHANGELOG_EXPECT_MR: "$CI_MERGE_REQUEST_IID" + CHANGELOG_EXPECT_CLC: "" script: # Check that the MR adds at least one changelog entry - git fetch "$CI_MERGE_REQUEST_PROJECT_URL" "$CI_MERGE_REQUEST_TARGET_BRANCH_NAME" @@ -276,6 +280,10 @@ lint-changelog: when: never - if: '$CI_MERGE_REQUEST_LABELS =~ /.*no-changelog.*/' when: never + - changes: + - libraries/base/**/* + variables: + CHANGELOG_EXPECT_CLC: "1" - if: $CI_MERGE_REQUEST_ID - *drafts-can-fail-lint ===================================== .gitlab/merge_request_templates/Default.md ===================================== @@ -23,7 +23,8 @@ https://gitlab.haskell.org/ghc/ghc/-/wikis/Contributing-a-Patch - [ ] This MR solves the problem described in the following issue:  - [ ] A changelog entry was added in `changelog.d/` for user-facing changes (see [changelog guide][changelog]). If this MR does not need a changelog entry, the ~"no-changelog" label was applied. -- [ ] This MR does not make any significant changes to `base`, or it has an accompanying [CLC proposal](https://github.com/haskell/core-libraries-committee#base-package). +- [ ] This MR does not make any significant changes to `base`, or it has an accompanying [CLC proposal](https://github.com/haskell/core-libraries-committee#base-package) + and the changelog fragment uses `section: base` with the `clc: #<proposal>` field set. - [ ] If this MR has the potential to break user programs, the ~"user-facing" label was applied to test against head.hackage. - [ ] All commits are either individually buildable or squashed. ===================================== changelog.d/config ===================================== @@ -27,6 +27,7 @@ sections: { cmm Cmm build-tools Build tools base ``base`` library + ghc-internal ``ghc-internal`` library ghc-prim ``ghc-prim`` library ghc-lib ``ghc`` library ghc-heap ``ghc-heap`` library @@ -36,6 +37,18 @@ sections: { ghc-toolchain ``ghc-toolchain`` } +-- markdown-targets: sections that also need to end up in +-- per-library changelog files. The optional third token +-- lists extra fields that might be required for this section +-- like `clc` for base. +markdown-targets: { + base libraries/base/changelog.md clc + ghc-internal libraries/ghc-internal/CHANGELOG.md + ghc-prim libraries/ghc-prim/changelog.md + ghc-experimental libraries/ghc-experimental/CHANGELOG.md + template-haskell libraries/template-haskell/changelog.md +} + included-libraries-preamble: { The package database provided with this distribution also contains a number of packages other than GHC itself. See the changelogs provided with these packages ===================================== docs/users_guide/ghc_config.py.in ===================================== @@ -7,12 +7,14 @@ if parse_version(sphinx.__version__) >= parse_version("4.0.0"): 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#%s'), 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', '%s'), 'ghc-mr': ('https://gitlab.haskell.org/ghc/ghc/-/merge_requests/%s', '!%s'), + 'clc': ('https://github.com/haskell/core-libraries-committee/issues/%s', 'CLC proposal #%s'), } else: extlinks = { 'ghc-ticket': ('https://gitlab.haskell.org/ghc/ghc/issues/%s', '#'), 'ghc-wiki': ('https://gitlab.haskell.org/ghc/ghc/wikis/%s', ''), 'ghc-mr': ('https://gitlab.haskell.org/ghc/ghc/-/merge_requests/%s', '!'), + 'clc': ('https://github.com/haskell/core-libraries-committee/issues/%s', 'CLC proposal #'), } libs_base_uri = '../libraries' ===================================== hadrian/src/Rules/Changelog.hs ===================================== @@ -11,8 +11,9 @@ import qualified System.Directory as IO -- | Rules for generating and managing changelog entries. -- -- Targets: --- hadrian/build changelog -- generate release notes +-- hadrian/build changelog -- generate RST release notes -- hadrian/build changelog --changelog-version=10.2.1 -- with explicit version +-- hadrian/build libraries-changelog-markdown -- emit per-library Markdown bullets to stdout -- hadrian/build changelog-clear -- remove old entries changelogRules :: Rules () changelogRules = do @@ -25,19 +26,6 @@ changelogRules = do ctx <- programContext stage0Boot changelogD progPath <- programPath ctx need [progPath] - - -- These cabal files are needed by changelog-d to determine the - -- versions of packages shipped with GHC. - let templatedCabalFiles = map pkgCabalFile - [ ghcBoot - , ghcBootTh - , ghcExperimental - , ghcInternal - , ghci - , compiler - , ghcHeap - , templateHaskell - ] need templatedCabalFiles top <- topDirectory @@ -47,6 +35,21 @@ changelogRules = do :: Action () putSuccess $ "| Generated release notes: " ++ outFile + phony "libraries-changelog-markdown" $ do + ctx <- programContext stage0Boot changelogD + progPath <- programPath ctx + need [progPath] + need templatedCabalFiles + + top <- topDirectory + -- cmd_ (no FileStdout) lets the binary's stdout flow through to + -- the invoking terminal, so the release manager can pipe it to a + -- file or scratch buffer. + cmd_ [progPath] + [ top -/- "changelog.d/" + , "--libraries-changelog-markdown" + ] + phony "changelog-clear" $ do top <- topDirectory let dir = top -/- "changelog.d" @@ -54,3 +57,17 @@ changelogRules = do let toRemove = filter (\f -> f /= "config" && not (isPrefixOf "." f)) entries liftIO $ mapM_ (IO.removeFile . (dir -/-)) toRemove putSuccess $ "| Removed " ++ show (length toRemove) ++ " changelog entries" + where + -- These cabal files are needed by changelog-d to determine the + -- versions of packages shipped with GHC. + templatedCabalFiles = map pkgCabalFile + [ ghcBoot + , ghcBootTh + , ghcExperimental + , ghcInternal + , ghci + , compiler + , ghcHeap + , templateHaskell + , base + ] ===================================== libraries/integer-gmp/integer-gmp.cabal ===================================== @@ -13,6 +13,9 @@ build-type: Simple homepage: https://www.haskell.org/ghc/ bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +extra-source-files: + changelog.md + description: This package used to provide an implementation of the standard 'Integer' type based on the ===================================== testsuite/tests/linters/Makefile ===================================== @@ -30,8 +30,12 @@ notes: (cd $(TOP)/.. && $(LINT_NOTES) broken-refs) changelog-d: -ifdef CHANGELOG_EXPECT_MR +ifneq "$(CHANGELOG_EXPECT_MR)" "" +ifneq "$(CHANGELOG_EXPECT_CLC)" "" + (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate --expect-mr $(CHANGELOG_EXPECT_MR) --expect-clc) +else (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate --expect-mr $(CHANGELOG_EXPECT_MR)) +endif else (cd $(TOP)/.. && $(CHANGELOG_D) changelog.d/ --validate) endif ===================================== utils/changelog-d/ChangelogD.hs ===================================== @@ -10,15 +10,15 @@ module Main (main) where import Control.Exception (Exception (..)) -import Control.Monad (unless, void, when) -import Data.Char (isSpace) +import Control.Monad (filterM, unless, void, when) +import Data.Char (isAlpha, isSpace) import Data.Foldable (for_, toList, traverse_) import Data.Function (on) -import Data.List (intercalate, sort, sortBy) +import Data.List (find, intercalate, isPrefixOf, isSuffixOf, sort, sortBy, stripPrefix) import Data.Maybe (isJust, isNothing, mapMaybe) import Data.Set (Set) import Data.Traversable (for) -import System.Directory (listDirectory) +import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.Environment (getArgs) import System.Exit (exitFailure) import System.FilePath ((</>), dropTrailingPathSeparator, takeDirectory) @@ -58,16 +58,35 @@ usage = unlines , " Collect changelog entries and produce release notes." , "" , "Options:" - , " --version <version> Version number for RST file header (e.g. 10.2.1)" - , " --validate Validate entries only, no output" - , " --expect-mr <N> Check that at least one entry references MR !N" - , " --help Show this help" + , " --version <version> Version number for RST file header (e.g. 10.2.1)" + , " --validate Validate entries only, no output" + , " --expect-mr <N> Check that at least one entry references MR !N" + , " --expect-clc Require the entry matched by --expect-mr" + , " to have a non-empty 'clc:' field. Used by" + , " CI for MRs touching base." + , " --libraries-changelog-markdown Emit per-library Markdown bullets to" + , " stdout (suppresses RST emission). Output" + , " is intended to be pasted into each" + , " libraries/<lib>/changelog.md by hand;" + , " --section <key> Restrict --libraries-changelog-markdown" + , " to a single section. Without this, all" + , " configured markdown-targets are emitted," + , " separated by HTML-comment markers." + , " --help Show this help" ] parseArgs :: [String] -> Either String Opts parseArgs = go defaultOpts where - defaultOpts = Opts "changelog.d" Nothing False Nothing + defaultOpts = Opts + { optDirectory = "changelog.d" + , optVersion = Nothing + , optValidate = False + , optExpectMR = Nothing + , optExpectCLC = False + , optMarkdown = False + , optMdSection = Nothing + } go opts [] = Right opts go _ ("--help" : _) = Left "" @@ -78,6 +97,11 @@ parseArgs = go defaultOpts [(mr, "")] -> go opts { optExpectMR = Just mr } rest _ -> Left $ "--expect-mr requires a number, got: " ++ n go _ ("--expect-mr" : []) = Left "--expect-mr requires an argument" + go opts ("--expect-clc" : rest) = go opts { optExpectCLC = True } rest + go opts ("--libraries-changelog-markdown" : rest) = + go opts { optMarkdown = True } rest + go opts ("--section" : s : rest) = go opts { optMdSection = Just s } rest + go _ ("--section" : []) = Left "--section requires an argument" go _ (('-':'-':opt) : _) = Left $ "Unknown option: --" ++ opt go _ (('-':opt) : _) = Left $ "Unknown option: -" ++ opt go opts (dir : rest) = go opts { optDirectory = dir } rest @@ -124,9 +148,14 @@ makeChangelog Opts {..} = do either (exitWithExc . PlainError) return $ parseWith parseConfig filename contents + -- Read only regular files, skipping config, dotfiles, and any + -- subdirectories (e.g. golden-output dirs alongside test fragments). dirContents <- filter (not . isTmpFile) <$> listDirectory optDirectory + fragmentNames <- + filterM (\name -> doesFileExist (optDirectory </> name)) + (filter (/= "config") $ sort dirContents) allEntries <- fmap Map.fromList $ - for (filter (/= "config") $ sort dirContents) $ \name -> do + for fragmentNames $ \name -> do let fp = optDirectory </> name contents <- BS.readFile fp entry <- parseEntryFile fp contents @@ -140,17 +169,38 @@ makeChangelog Opts {..} = do exitWithExc $ PlainError "Validation failed." -- Check expected MR number if specified - for_ optExpectMR $ \expectedMR -> do - let expectedMRNum = MRNumber expectedMR - entriesWithMR = Map.filter (\e -> expectedMRNum `Set.member` entryMrs e) allEntries - when (Map.null entriesWithMR && not (Map.null allEntries)) $ do - hPutStrLn stderr $ "Warning: No changelog entry references this MR (!" ++ show expectedMR ++ ")." - hPutStrLn stderr $ "Add 'mrs: !" ++ show expectedMR ++ "' to your changelog entry." - hPutStrLn stderr "" - exitFailure + matchedByMR <- case optExpectMR of + Nothing -> pure Map.empty + Just expectedMR -> do + let expectedMRNum = MRNumber expectedMR + withMR = Map.filter (\e -> expectedMRNum `Set.member` entryMrs e) allEntries + when (Map.null withMR && not (Map.null allEntries)) $ do + hPutStrLn stderr $ "Warning: No changelog entry references this MR (!" ++ show expectedMR ++ ")." + hPutStrLn stderr $ "Add 'mrs: !" ++ show expectedMR ++ "' to your changelog entry." + hPutStrLn stderr "" + exitFailure + pure withMR + + -- --expect-clc: assert that the MR-matched entry has clc: set. + when optExpectCLC $ case optExpectMR of + Nothing -> exitWithExc $ PlainError + "--expect-clc requires --expect-mr (which entry to check?)" + Just expectedMR -> + when (not (Map.null matchedByMR) + && all (Set.null . entryClcs) matchedByMR) $ do + hPutStrLn stderr $ + "Error: changelog entry for !" ++ show expectedMR + ++ " does not have a 'clc:' field." + hPutStrLn stderr + "Changes to base or user-facing changes require a CLC proposal." + hPutStrLn stderr "Add 'clc: #<proposal>' to your changelog entry." + exitFailure unless optValidate $ - outputRST optDirectory optVersion cfg (Map.elems allEntries) + if optMarkdown + then outputMarkdown optDirectory cfg optMdSection + (Map.elems allEntries) + else outputRST optDirectory optVersion cfg (Map.elems allEntries) ------------------------------------------------------------------------------- -- RST output @@ -218,6 +268,9 @@ formatEntry Entry {..} = ] ++ [ "(:ghc-mr:`" ++ show n ++ "`)" | MRNumber n <- Set.toList entryMrs + ] ++ + [ "(:clc:`" ++ show n ++ "`)" + | CLCNumber n <- Set.toList entryClcs ] description = maybe "" (\d -> "\n" ++ trim d ++ "\n\n") entryDescription @@ -262,25 +315,281 @@ generateIncludedLibraries baseDir preamble libs = do where fst3 (a, _, _) = a - extractField :: String -> String -> Maybe String - extractField fieldName contents = - case mapMaybe (matchField fieldName) (lines contents) of - (v:_) -> Just v - [] -> Nothing - - matchField :: String -> String -> Maybe String - matchField fieldName line = - let stripped = dropWhile isSpace line - (key, rest) = break (\c -> c == ':' || isSpace c) stripped - in if map toLower' key == map toLower' fieldName - then case dropWhile isSpace rest of - (':':val) -> Just (trim (dropWhile isSpace val)) - _ -> Nothing - else Nothing - - toLower' c - | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) - | otherwise = c +extractField :: String -> String -> Maybe String +extractField fieldName contents = + case mapMaybe (matchField fieldName) (lines contents) of + (v:_) -> Just v + [] -> Nothing + +matchField :: String -> String -> Maybe String +matchField fieldName line = + let stripped = dropWhile isSpace line + (key, rest) = break (\c -> c == ':' || isSpace c) stripped + in if map toLower' key == map toLower' fieldName + then case dropWhile isSpace rest of + (':':val) -> Just (trim (dropWhile isSpace val)) + _ -> Nothing + else Nothing + +toLower' :: Char -> Char +toLower' c + | c >= 'A' && c <= 'Z' = toEnum (fromEnum c + 32) + | otherwise = c + +------------------------------------------------------------------------------- +-- Markdown output +------------------------------------------------------------------------------- + +-- | Emit per-library Markdown bullets to stdout. +-- +-- With 'mSect' set, emit just that section's bullets (used interactively). +-- Without it, emit every section listed in @markdown-targets:@, separated +-- by HTML comments naming each section +outputMarkdown + :: FilePath -- ^ changelog.d directory (used to locate cabal files) + -> Cfg + -> Maybe String -- ^ --section <key> + -> [Entry] + -> IO () +outputMarkdown dir Cfg{..} mSect entries = do + targets <- case mSect of + Just key -> case find ((== key) . mtSection) cfgMarkdownTargets of + Nothing -> exitWithExc $ PlainError $ + "Unknown markdown section: " ++ key + ++ "\nKnown sections: " + ++ intercalate ", " (map mtSection cfgMarkdownTargets) + Just mt -> pure [mt] + Nothing -> pure cfgMarkdownTargets + + let multi = isNothing mSect + baseDir = takeDirectory (dropTrailingPathSeparator dir) + + case mSect of + Just key | not (any (\mt -> mtSection mt == key) cfgMarkdownTargets) -> + -- impossible; handled above + pure () + Just key | null (entriesFor key entries) -> + exitWithExc $ PlainError $ "No entries for section " ++ key + _ -> pure () + + for_ targets $ \mt -> do + let es = entriesFor (mtSection mt) entries + unless (null es) $ do + when multi $ do + putStrLn $ "" + putStrLn "" + libVer <- readLibraryVersion baseDir (mtPath mt) + putStrLn $ "## " ++ libVer ++ " *TBA*" + putStrLn "" + for_ (sortBy (flip compare `on` hasDescription) es) $ \entry -> + putStr (formatEntryMd entry) + when multi $ putStrLn "" + +entriesFor :: String -> [Entry] -> [Entry] +entriesFor key = filter $ \e -> case entrySection e of + Just (Section s) -> s == key + Nothing -> False + +-- | Given the path of a library's @changelog.md@ (repo-relative), find the +-- sibling @*.cabal@ (or @*.cabal.in@) and read the @version:@ field. +readLibraryVersion :: FilePath -> FilePath -> IO String +readLibraryVersion baseDir mdPath = do + let libDir = takeDirectory mdPath + libDirFs = baseDir </> libDir + exists <- doesDirectoryExist libDirFs + if not exists + then do + hPutStrLn stderr $ "Warning: directory does not exist: " ++ libDirFs + pure "?.?.?" + else do + candidates <- listDirectory libDirFs + let cabals = filter (\f -> ".cabal" `isSuffixOf` f) candidates + -- Prefer non-templated *.cabal over *.cabal.in (the former is + -- the rendered file Hadrian needs before invoking us). + ranked = sortBy (compare `on` (\f -> if ".cabal.in" `isSuffixOf` f then (1::Int) else 0)) cabals + case ranked of + [] -> do + hPutStrLn stderr $ + "Warning: no .cabal file under " ++ libDir + pure "?.?.?" + (cf:_) -> do + contents <- readFile (libDirFs </> cf) + case extractField "version" contents of + Just v -> pure v + Nothing -> do + hPutStrLn stderr $ + "Warning: could not parse version from " ++ libDir </> cf + pure "?.?.?" + +-- | Format an Entry as a Markdown bullet. Mirrors 'formatEntry' for RST +-- but emits Markdown links for issues/MRs/CLC and rewrites RST inline +-- markup to markdown. +formatEntryMd :: Entry -> String +formatEntryMd Entry{..} = indentBulletMd (header ++ description) + where + header = unwords $ + [ rstToMarkdown entrySynopsis ] ++ + [ mdLink ("#" ++ show n) + ("https://gitlab.haskell.org/ghc/ghc/issues/" ++ show n) + | IssueNumber n <- Set.toList entryIssues + ] ++ + [ mdLink ("!" ++ show n) + ("https://gitlab.haskell.org/ghc/ghc/-/merge_requests/" ++ show n) + | MRNumber n <- Set.toList entryMrs + ] ++ + [ mdLink ("CLC proposal #" ++ show n) + ("https://github.com/haskell/core-libraries-committee/issues/" ++ show n) + | CLCNumber n <- Set.toList entryClcs + ] + + description = maybe "" (\d -> "\n\n" ++ rstToMarkdown (trim d) ++ "\n") entryDescription + + mdLink :: String -> String -> String + mdLink txt url = "(" ++ "[" ++ txt ++ "](" ++ url ++ ")" ++ ")" + +-- | Indent text as a Markdown bullet: the first line gets @"* "@ prefix, +-- subsequent lines are indented two spaces. Mirrors 'indentBullet'. +indentBulletMd :: String -> String +indentBulletMd = unlines . go . lines + where + go [] = [] + go (x:xs) = ("* " ++ x) : map indentLine xs + indentLine "" = "" + indentLine s = " " ++ s + +------------------------------------------------------------------------------- +-- RST -> Markdown rewriting +------------------------------------------------------------------------------- +-- +-- Applies the following rules: +-- +-- | RST | Markdown | +-- | -------------------------------------------------| ------------------------------------------------------------------------------------------------------ | +-- | ``code`` (double-backtick) | `code` (single-backtick) | +-- | `text <url>`_ | [text](url) | +-- | :ghc-ticket:`N` | [#N](https://gitlab.haskell.org/ghc/ghc/issues/N) | +-- | :ghc-mr:`N` | [!N](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/N) | +-- | :ghc-wiki:`p` | [p](https://gitlab.haskell.org/ghc/ghc/wikis/p) | +-- | :clc:`N` | [CLC proposal #N](https://github.com/haskell/core-libraries-committee/issues/N) | +-- | :ghc-flag:`-foo` | `-foo` | +-- | :extension:`E` | `E` | +-- | :ghci-cmd:`X`, :rts-flag:`X` | `X` | +-- | :base-ref:`Mod.id` `` | `Mod.id` | +-- | :th-ref:, :cabal-ref: ,:ghc-prim-ref: | `ref` | +-- | .. code-block:: lang + indented body | Triple-backtick fenced block with `lang` | +-- | .. note:: / .. warning:: | `> **Note:**` / `> **Warning:**` blockquote | + +rstToMarkdown :: String -> String +rstToMarkdown s = + let trailingNL = not (null s) && last s == '\n' + body = intercalate "\n" . blockPass . lines . inlinePass $ s + in body ++ (if trailingNL then "\n" else "") + +inlinePass :: String -> String +inlinePass [] = [] +-- Double-backtick code: ``code`` → `code` +inlinePass ('`':'`':rest) = + case breakOnSubstring "``" rest of + (body, _:_:after) -> "`" ++ body ++ "`" ++ inlinePass after + _ -> '`':'`': inlinePass rest +-- RST hyperlink: `text <url>`_ → [text](url) +inlinePass ('`':rest) + | Just (txt, url, after) <- pickRstLink rest = + "[" ++ trim txt ++ "](" ++ url ++ ")" ++ inlinePass after +-- :role:`body` interpreted-text role +inlinePass (':':rest) + | Just (role, body, after) <- pickRole rest = + renderRole role body ++ inlinePass after +inlinePass (c:cs) = c : inlinePass cs + +breakOnSubstring :: String -> String -> (String, String) +breakOnSubstring needle = go + where + go [] = ([], []) + go s@(c:cs) + | needle `isPrefixOf` s = ([], s) + | otherwise = + let (a, b) = go cs in (c:a, b) + +-- | Try to consume a @\`text \<url\>\`_@ RST hyperlink starting after the +-- leading backtick. Returns @(text, url, rest)@ on success. +pickRstLink :: String -> Maybe (String, String, String) +pickRstLink xs = do + let (txt, r1) = break (== '<') xs + case r1 of + '<':r2 -> do + let (url, r3) = break (== '>') r2 + case r3 of + '>':'`':'_':'_':after -> Just (txt, url, after) + '>':'`':'_':after -> Just (txt, url, after) + _ -> Nothing + _ -> Nothing + +-- | Try to consume a @role:\`body\`@ interpreted-text role starting just +-- after the leading colon. +pickRole :: String -> Maybe (String, String, String) +pickRole xs = + let (name, r1) = span (\c -> isAlpha c || c == '-') xs + in case (null name, r1) of + (False, ':':'`':r2) -> case break (== '`') r2 of + (body, '`':after) | not (null body) -> Just (name, body, after) + _ -> Nothing + _ -> Nothing + +-- | Render a known interpreted-text role to Markdown. +renderRole :: String -> String -> String +renderRole role body = case role of + "ghc-ticket" -> mdLink ("#" ++ body) ("https://gitlab.haskell.org/ghc/ghc/issues/" ++ body) + "ghc-mr" -> mdLink ("!" ++ body) ("https://gitlab.haskell.org/ghc/ghc/-/merge_requests/" ++ body) + "ghc-wiki" -> mdLink body ("https://gitlab.haskell.org/ghc/ghc/wikis/" ++ body) + "clc" -> mdLink ("CLC proposal #" ++ body) + ("https://github.com/haskell/core-libraries-committee/issues/" ++ body) + "ghc-flag" -> "`" ++ body ++ "`" + "extension" -> "`" ++ body ++ "`" + "ghci-cmd" -> "`" ++ body ++ "`" + "rts-flag" -> "`" ++ body ++ "`" + "doc" -> body + "base-ref" -> "`" ++ body ++ "`" + "th-ref" -> "`" ++ body ++ "`" + "cabal-ref" -> "`" ++ body ++ "`" + "ghc-prim-ref" -> "`" ++ body ++ "`" + _ -> ":" ++ role ++ ":`" ++ body ++ "`" + where + mdLink txt url = "[" ++ txt ++ "](" ++ url ++ ")" + +-- | Block-level transforms applied after the inline pass. +blockPass :: [String] -> [String] +blockPass [] = [] +blockPass (l:rest) + | Just lang <- stripPrefix ".. code-block:: " (trim l) = + let (body, rest') = takeIndentedBlock rest + in ("```" ++ lang) : map (dropIndent 4) body ++ ["```"] ++ blockPass rest' + | trim l == ".. note::" = + let (body, rest') = takeIndentedBlock rest + in "> **Note:**" : map (("> " ++) . dropIndent 4) body ++ blockPass rest' + | trim l == ".. warning::" = + let (body, rest') = takeIndentedBlock rest + in "> **Warning:**" : map (("> " ++) . dropIndent 4) body ++ blockPass rest' + | otherwise = l : blockPass rest + +-- | Take a block of indented (or blank) lines following a directive; stop +-- at the first non-blank, non-indented line. +takeIndentedBlock :: [String] -> ([String], [String]) +takeIndentedBlock = go . dropWhile null + where + go [] = ([], []) + go (x:xs) + | null x = let (a, b) = go xs in (x:a, b) + | take 1 x == " " = let (a, b) = go xs in (x:a, b) + | otherwise = ([], x:xs) + +-- | Drop up to @n@ leading spaces from a line. +dropIndent :: Int -> String -> String +dropIndent _ "" = "" +dropIndent 0 s = s +dropIndent n (' ':cs) = dropIndent (n-1) cs +dropIndent _ s = s ------------------------------------------------------------------------------- -- Section grouping @@ -303,10 +612,13 @@ groupBySections sectionDefs entries = ------------------------------------------------------------------------------- data Opts = Opts - { optDirectory :: FilePath - , optVersion :: Maybe String - , optValidate :: Bool - , optExpectMR :: Maybe Int -- ^ Expected MR number + { optDirectory :: FilePath + , optVersion :: Maybe String + , optValidate :: Bool + , optExpectMR :: Maybe Int -- ^ Expected MR number + , optExpectCLC :: Bool -- ^ Require entry matched by --expect-mr to have clc: + , optMarkdown :: Bool -- ^ Emit per-library Markdown to stdout + , optMdSection :: Maybe String -- ^ Restrict markdown emission to one section } deriving (Show) @@ -332,6 +644,24 @@ instance C.Parsec MRNumber where instance C.Pretty MRNumber where pretty (MRNumber n) = PP.char '!' PP.<> PP.int n +newtype CLCNumber = CLCNumber Int + deriving (Eq, Ord, Show) + +instance C.Parsec CLCNumber where + parsec = do + _ <- P.char '#' + CLCNumber <$> P.integral + +instance C.Pretty CLCNumber where + pretty (CLCNumber n) = PP.char '#' PP.<> PP.int n + +data MarkdownTarget = MarkdownTarget + { mtSection :: String -- ^ section key matching an entry's `section:` + , mtPath :: FilePath -- ^ target changelog path, repo-relative + , mtRequiredFields :: [String] -- ^ extra required-fields when this section is used + } + deriving (Show) + newtype Section = Section String deriving (Eq, Ord, Show) @@ -351,6 +681,7 @@ data Cfg = Cfg , cfgPreamble :: String , cfgIncludedLibraries :: [(FilePath, String)] -- ^ (cabalPath, description) , cfgIncludedLibrariesPreamble :: String + , cfgMarkdownTargets :: [MarkdownTarget] } deriving (Show) @@ -364,6 +695,7 @@ parseConfig fields0 = do , cfgPreamble = cfgRawPreamble raw , cfgIncludedLibraries = parseIncludedLibraries (cfgRawIncludedLibraries raw) , cfgIncludedLibrariesPreamble = cfgRawIncludedLibrariesPreamble raw + , cfgMarkdownTargets = parseMarkdownTargets (cfgRawMarkdownTargets raw) } where (fields, sections) = C.partitionFields fields0 @@ -378,6 +710,7 @@ data CfgRaw = CfgRaw , cfgRawPreamble :: String , cfgRawIncludedLibraries :: String , cfgRawIncludedLibrariesPreamble :: String + , cfgRawMarkdownTargets :: String } cfgRawRequiredFieldsL :: Functor f => (Set String -> f (Set String)) -> CfgRaw -> f CfgRaw @@ -395,6 +728,9 @@ cfgRawIncludedLibrariesL f s = (\x -> s { cfgRawIncludedLibraries = x }) <$> f ( cfgRawIncludedLibrariesPreambleL :: Functor f => (String -> f String) -> CfgRaw -> f CfgRaw cfgRawIncludedLibrariesPreambleL f s = (\x -> s { cfgRawIncludedLibrariesPreamble = x }) <$> f (cfgRawIncludedLibrariesPreamble s) +cfgRawMarkdownTargetsL :: Functor f => (String -> f String) -> CfgRaw -> f CfgRaw +cfgRawMarkdownTargetsL f s = (\x -> s { cfgRawMarkdownTargets = x }) <$> f (cfgRawMarkdownTargets s) + cfgRawGrammar :: C.ParsecFieldGrammar CfgRaw CfgRaw cfgRawGrammar = CfgRaw <$> C.monoidalFieldAla "required-fields" (C.alaSet' C.FSep C.Token) cfgRawRequiredFieldsL @@ -402,6 +738,7 @@ cfgRawGrammar = CfgRaw <*> C.freeTextFieldDef "preamble" cfgRawPreambleL <*> C.freeTextFieldDef "included-libraries" cfgRawIncludedLibrariesL <*> C.freeTextFieldDef "included-libraries-preamble" cfgRawIncludedLibrariesPreambleL + <*> C.freeTextFieldDef "markdown-targets" cfgRawMarkdownTargetsL parseSections :: String -> [(String, String)] parseSections = mapMaybe parseLine . lines @@ -419,6 +756,20 @@ parseIncludedLibraries = mapMaybe parseLine . lines (path, rest) | not (null path) -> Just (path, trim rest) _ -> Nothing +-- | Parse the @markdown-targets:@ block. +-- +-- Each non-empty, non-comment line is +-- <section-key> <path> [<extra-required-field>...] +-- The extra tokens declare additional fields required of any entry whose section: matches. +parseMarkdownTargets :: String -> [MarkdownTarget] +parseMarkdownTargets = mapMaybe parseLine . lines + where + parseLine l = case words (trim l) of + [] -> Nothing + [_] -> Nothing -- need at least section + path + (sect:path:extra) -> + Just $ MarkdownTarget sect path extra + ------------------------------------------------------------------------------- -- Entry ------------------------------------------------------------------------------- @@ -428,6 +779,7 @@ data Entry = Entry , entryDescription :: Maybe String , entryMrs :: Set MRNumber , entryIssues :: Set IssueNumber + , entryClcs :: Set CLCNumber , entrySection :: Maybe Section } deriving (Show) @@ -447,6 +799,9 @@ entryMrsL f s = (\x -> s { entryMrs = x }) <$> f (entryMrs s) entryIssuesL :: Functor f => (Set IssueNumber -> f (Set IssueNumber)) -> Entry -> f Entry entryIssuesL f s = (\x -> s { entryIssues = x }) <$> f (entryIssues s) +entryClcsL :: Functor f => (Set CLCNumber -> f (Set CLCNumber)) -> Entry -> f Entry +entryClcsL f s = (\x -> s { entryClcs = x }) <$> f (entryClcs s) + entrySectionL :: Functor f => (Maybe Section -> f (Maybe Section)) -> Entry -> f Entry entrySectionL f s = (\x -> s { entrySection = x }) <$> f (entrySection s) @@ -477,6 +832,7 @@ entryGrammar = Entry <*> C.freeTextField "description" entryDescriptionL <*> C.monoidalFieldAla "mrs" (C.alaSet C.NoCommaFSep) entryMrsL <*> C.monoidalFieldAla "issues" (C.alaSet C.NoCommaFSep) entryIssuesL + <*> C.monoidalFieldAla "clc" (C.alaSet C.NoCommaFSep) entryClcsL <*> C.optionalField "section" entrySectionL ------------------------------------------------------------------------------- @@ -510,8 +866,21 @@ validateEntry cfg entry = foldMap (\validator -> validator cfg entry) validateRequiredFields :: Validator validateRequiredFields Cfg{..} Entry{..} = fmap RequiredFieldError $ - mapMaybe checkField $ Set.toList cfgRequiredFields + mapMaybe checkField $ Set.toList effectiveRequired where + -- Effective required-fields = global cfgRequiredFields + extras for the + -- entry's section as declared in cfgMarkdownTargets + -- (e.g. `base` adds `clc`). + effectiveRequired = + cfgRequiredFields `Set.union` + Set.fromList + [ f + | Just (Section sect) <- [entrySection] + , mt <- cfgMarkdownTargets + , mtSection mt == sect + , f <- mtRequiredFields mt + ] + checkField :: String -> Maybe RequiredFieldError checkField reqField = case fieldIsEmpty reqField of Left err -> Just err @@ -522,6 +891,7 @@ validateRequiredFields Cfg{..} Entry{..} = fmap RequiredFieldError $ fieldIsEmpty "description" = pure $ isNothing entryDescription fieldIsEmpty "mrs" = pure $ null entryMrs fieldIsEmpty "issues" = pure $ null entryIssues + fieldIsEmpty "clc" = pure $ null entryClcs fieldIsEmpty "section" = pure $ isNothing entrySection fieldIsEmpty f = Left $ UnknownRequiredField f ===================================== utils/changelog-d/README.md ===================================== @@ -23,46 +23,55 @@ description: { **Required fields:** `section`, `synopsis`, `mrs`, `issues` -**Optional fields:** `description` +**Optional fields:** `description`, `clc` + +**Conditionally required**: entries with `section: base` MUST also include a `clc:` +field referencing the CLC proposal authorising the change. If your MR doesn't need a changelog entry, apply the `no-changelog` label. ### Fields -| Field | Format | Description | -| ------------- | ------------------------------- | -----------------------------------------------| -| `synopsis` | Free-form RST | Brief description of the change | -| `mrs` | `!N` (space-separated) | MR number(s) | -| `issues` | `#N` (space-separated) | Issue number(s) | -| `section` | Section key (see below) | GHC component | -| `description` | Free-form RST in `{ ... }` | Extended details. Printed after the main entry | +| Field | Format | Description | +| ------------- | -------------------------- | ----------------------------------------------------- | +| `synopsis` | Free-form RST | Brief description of the change | +| `mrs` | `!N` (space-separated) | MR number(s) | +| `issues` | `#N` (space-separated) | Issue number(s) | +| `clc` | `#N` (space-separated) | CLC proposal number(s). Required for `section: base`. | +| `section` | Section key (see below) | GHC component | +| `description` | Free-form RST | Extended details. Printed after the main entry | ### Section keys -| Key | Heading | -| ------------------ | -------------------------------- | -| `language` | Language | -| `compiler` | Compiler | -| `profiling` | Profiling | -| `codegen` | Code generation | -| `llvm-backend` | LLVM backend | -| `js-backend` | JavaScript backend | -| `wasm-backend` | WebAssembly backend | -| `ghci` | GHCi | -| `rts` | Runtime system | -| `linker` | Linker | -| `bytecode` | Bytecode compiler | -| `packaging` | Packaging & build system | -| `cmm` | Cmm | -| `build-tools` | Build tools | -| `base` | ``base`` library | -| `ghc-prim` | ``ghc-prim`` library | -| `ghc-lib` | ``ghc`` library | -| `ghc-heap` | ``ghc-heap`` library | -| `ghc-experimental` | ``ghc-experimental`` library | -| `template-haskell` | ``template-haskell`` library | -| `ghc-pkg` | ``ghc-pkg`` | -| `ghc-toolchain` | ``ghc-toolchain`` | +The "Markdown" column indicates whether entries in that section also flow to +a per-library `changelog.md`. Sections without a +Markdown target appear only in the GHC release notes RST. + +| Key | Heading | Markdown target | +| ------------------ | ---------------------------- | ---------------------------------------------- | +| `language` | Language | — | +| `compiler` | Compiler | — | +| `profiling` | Profiling | — | +| `codegen` | Code generation | — | +| `llvm-backend` | LLVM backend | — | +| `js-backend` | JavaScript backend | — | +| `wasm-backend` | WebAssembly backend | — | +| `ghci` | GHCi | — | +| `rts` | Runtime system | — | +| `linker` | Linker | — | +| `bytecode` | Bytecode compiler | — | +| `packaging` | Packaging & build system | — | +| `cmm` | Cmm | — | +| `build-tools` | Build tools | — | +| `base` | ``base`` library | `libraries/base/changelog.md` | +| `ghc-internal` | ``ghc-internal`` library | `libraries/ghc-internal/CHANGELOG.md` | +| `ghc-prim` | ``ghc-prim`` library | `libraries/ghc-prim/changelog.md` | +| `ghc-lib` | ``ghc`` library | — | +| `ghc-heap` | ``ghc-heap`` library | — | +| `ghc-experimental` | ``ghc-experimental`` library | `libraries/ghc-experimental/CHANGELOG.md` | +| `template-haskell` | ``template-haskell`` library | `libraries/template-haskell/changelog.md` | +| `ghc-pkg` | ``ghc-pkg`` | — | +| `ghc-toolchain` | ``ghc-toolchain`` | — | ### Entry format @@ -83,20 +92,34 @@ library's `Distribution.Fields` parser ## Configuration The file `changelog.d/config` declares the structure of the generated release -notes: required fields, section names, preamble text, and the included-libraries -table. Edit it when adding new sections or changing release note formatting. +notes: required fields, section names, preamble text, the included-libraries +table, and the `markdown-targets:` mapping that wires sections to per-library +`changelog.md` files. Edit it when adding new sections or changing release-note +formatting. + +The `markdown-targets:` block is the source of truth for "which section's +entries get a Markdown emission, and which extra fields (e.g. `clc`) are +required for that section." Each line is `<section-key> <path> [<extra-required-field>...]`. ## For maintainers ### Hadrian targets -Generate release notes: +Generate RST release notes (existing behaviour): ``` hadrian/build changelog # uses project version hadrian/build changelog --changelog-version=10.2.1 # explicit version ``` Output: `docs/users_guide/<version>-notes.rst` +Generate per-library Markdown bullets: + +``` +hadrian/build libraries-changelog-markdown +``` + +Output is one stream containing every configured `markdown-targets:` section. + Clear entries after branch cut: ``` @@ -108,3 +131,25 @@ Validate entries: ``` hadrian/build test --only=changelog-d ``` + +### RST -> Markdown rewrite rules + +`--libraries-changelog-markdown` rewrites the inline RST in each entry to Markdown: + +| RST | Markdown | +| -------------------------------------------------| ------------------------------------------------------------------------------------------------------ | +| ``code`` (double-backtick) | `code` (single-backtick) | +| `text <url>`_ | [text](url) | +| :ghc-ticket:`N` | [#N](https://gitlab.haskell.org/ghc/ghc/issues/N) | +| :ghc-mr:`N` | [!N](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/N) | +| :ghc-wiki:`p` | [p](https://gitlab.haskell.org/ghc/ghc/wikis/p) | +| :clc:`N` | [CLC proposal #N](https://github.com/haskell/core-libraries-committee/issues/N) | +| :ghc-flag:`-foo` | `-foo` | +| :extension:`E` | `E` | +| :ghci-cmd:`X`, :rts-flag:`X` | `X` | +| :base-ref:`Mod.id` `` | `Mod.id` | +| :th-ref:, :cabal-ref: ,:ghc-prim-ref: | `ref` | +| .. code-block:: lang + indented body | Triple-backtick fenced block with `lang` | +| .. note:: / .. warning:: | `> **Note:**` / `> **Warning:**` blockquote | + + ===================================== utils/changelog-d/tests/config ===================================== @@ -0,0 +1,15 @@ +-- Minimal config for running changelog-d against the test fixture in +-- this directory. Mirrors the structure of the project-root +-- changelog.d/config but only declares the sections + markdown-targets +-- the fixture exercises. The path declared in markdown-targets is a +-- placeholder; readLibraryVersion warns and falls back to "?.?.?" when +-- the directory does not exist, which is captured in the golden output. +required-fields: synopsis mrs issues section + +sections: { + base ``base`` library +} + +markdown-targets: { + base _fake/changelog.md clc +} ===================================== utils/changelog-d/tests/expected/test-parser-rewriter.md ===================================== @@ -0,0 +1,33 @@ +## ?.?.? *TBA* + +* Self-test fixture exercising the parser/rewriter. Uses double-backtick `code`, + RST hyperlinks [the changelog wiki](https://gitlab.haskell.org/ghc/ghc/-/wikis/contributing/changelog), + GHC-flavoured roles [#12345](https://gitlab.haskell.org/ghc/ghc/issues/12345), [!6789](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6789), [commentary/compiler](https://gitlab.haskell.org/ghc/ghc/wikis/commentary/co…, + [CLC proposal #123](https://github.com/haskell/core-libraries-committee/issues/123), `-fxxx`, `TypeApplications`, `:type`, + `-N`, haddock cross-refs `Data.Maybe.fromMaybe`, + `Language.Haskell.TH.Lib`, `Distribution.Simple`, + `GHC.Prim`, the internal-doc role, and an :unknown-role:`pass-through`. ([#26002](https://gitlab.haskell.org/ghc/ghc/issues/26002)) ([!15830](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15830)) ([CLC proposal #0](https://github.com/haskell/core-libraries-committee/issues/0)) + + This description block exercises block-level rewrites and inline rewrites + inside a multi-line braced field. + + Inline forms inside the description: `inline code`, `DataKinds`, + [!15830](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15830), `Control.Applicative`, and a [bare RST link](https://example.invalid/). + + > **Note:** + > This is an RST note admonition. It should render as a Markdown + > blockquote prefixed with `> **Note:**`. + > + > **Warning:** + > This is an RST warning admonition. It should render as a Markdown + > blockquote prefixed with `> **Warning:**`. + > + ```haskell + foo :: Int -> Int + foo x = x + 1 + bar :: String + bar = "hello" + + ``` + After the code block, plain prose continues. Verify that the renderer + exits the fenced block correctly and resumes paragraph flow here. ===================================== utils/changelog-d/tests/test-parser-rewriter ===================================== @@ -0,0 +1,48 @@ +-- This file exercises every construct supported by changelog-d's parser +-- and RST -> Markdown rewriter. It is kept in tree as a regression +-- fixture: when the parser or rewriter is touched, run +-- cabal run changelog-d -- --validate changelog.d/ +-- cabal run changelog-d -- --libraries-changelog-markdown changelog.d/ +-- and visually compare the output. The tool treats this like any +-- other fragment, so it WILL appear in `--version`'ed RST and in +-- `--libraries-changelog-markdown` output. Delete it before cutting a +-- release, or move it under utils/changelog-d/tests/ if/when that +-- directory is wired up. +section: base +synopsis: Self-test fixture exercising the parser/rewriter. Uses double-backtick ``code``, + RST hyperlinks `the changelog wiki <https://gitlab.haskell.org/ghc/ghc/-/wikis/contributing/changelog>`_, + GHC-flavoured roles :ghc-ticket:`12345`, :ghc-mr:`6789`, :ghc-wiki:`commentary/compiler`, + :clc:`123`, :ghc-flag:`-fxxx`, :extension:`TypeApplications`, :ghci-cmd:`:type`, + :rts-flag:`-N`, haddock cross-refs :base-ref:`Data.Maybe.fromMaybe`, + :th-ref:`Language.Haskell.TH.Lib`, :cabal-ref:`Distribution.Simple`, + :ghc-prim-ref:`GHC.Prim`, the :doc:`internal-doc` role, and an :unknown-role:`pass-through`. +issues: #26002 +mrs: !15830 +clc: #0 + +description: { + This description block exercises block-level rewrites and inline rewrites + inside a multi-line braced field. + + Inline forms inside the description: ``inline code``, :extension:`DataKinds`, + :ghc-mr:`15830`, :base-ref:`Control.Applicative`, and a `bare RST link + <https://example.invalid/>`_. + + .. note:: + This is an RST note admonition. It should render as a Markdown + blockquote prefixed with ``> **Note:**``. + + .. warning:: + This is an RST warning admonition. It should render as a Markdown + blockquote prefixed with ``> **Warning:**``. + + .. code-block:: haskell + + foo :: Int -> Int + foo x = x + 1 + bar :: String + bar = "hello" + + After the code block, plain prose continues. Verify that the renderer + exits the fenced block correctly and resumes paragraph flow here. +} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed6faa1ba45dc442f31315e1b88f0e3… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed6faa1ba45dc442f31315e1b88f0e3… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/27183
by Zubin (＠wz1000) 28 Apr '26

28 Apr '26

Zubin pushed new branch wip/27183 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/27183 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26989] 2 commits: Do not use mkCast during typechecking
by Simon Peyton Jones (＠simonpj) 28 Apr '26

28 Apr '26

Simon Peyton Jones pushed to branch wip/T26989 at Glasgow Haskell Compiler / GHC Commits: 9ec89815 by Simon Peyton Jones at 2026-04-28T11:48:38+01:00 Do not use mkCast during typechecking This commit fixes #27219. The problem was that the typechecker was using `mkCast`, whose assertion checks legitimately fail when applied to types that contain unification variables. - - - - - bd1503ad by Simon Peyton Jones at 2026-04-28T11:50:14+01:00 More improvements * pushCoValArg and pushCoTyArg return tyL, which is helpful for the caller * Don't optimise coercions if the type-substitution is empty. See Note [Optimising coercions] - - - - - 4 changed files: - compiler/GHC/Core/Opt/Arity.hs - compiler/GHC/Core/Opt/Simplify/Iteration.hs - compiler/GHC/Core/TyCo/Subst.hs - compiler/GHC/Tc/Types/Evidence.hs Changes: ===================================== compiler/GHC/Core/Opt/Arity.hs ===================================== @@ -2875,43 +2875,44 @@ pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, MCoercion) -- 'co' is always Representational pushCoArg co arg | Type ty <- arg - = do { (ty', m_co') <- pushCoTyArg co ty + = do { (_, ty', m_co') <- pushCoTyArg co ty ; return (Type ty', m_co') } | otherwise - = do { (arg_mco, m_co') <- pushCoValArg co + = do { (_, arg_mco, m_co') <- pushCoValArg co ; let arg_mco' = checkReflexiveMCo arg_mco -- checkReflexiveMCo: see Note [Check for reflexive casts in eta expansion] -- The coercion is very often (arg_co -> res_co), but without -- the argument coercion actually being ReflCo ; return (arg `mkCastMCo` arg_mco', m_co') } -pushCoTyArg :: CoercionR -> Type -> Maybe (Type, MCoercionR) +pushCoTyArg :: CoercionR -> Type -> Maybe (Type, Type, MCoercionR) -- We have (fun |> co) @ty -- Push the coercion through to return -- (fun @ty') |> co' -- 'co' is always Representational -- If the returned coercion is Nothing, then it would have been reflexive; -- it's faster not to compute it, though. -pushCoTyArg co ty +pushCoTyArg co arg_ty -- The following is inefficient - don't do `eqType` here, the coercion -- optimizer will take care of it. See #14737. -- -- | tyL `eqType` tyR -- -- = Just (ty, Nothing) - | isReflCo co - = Just (ty, MRefl) + | Just (ty, _) <- isReflCo_maybe co + = Just (ty, arg_ty, MRefl) | isForAllTy_ty tyL - = assertPpr (isForAllTy_ty tyR) (ppr co $$ ppr ty) $ - Just (ty `mkCastTy` co1, MCo co2) + = assertPpr (isForAllTy_ty tyR) (ppr co $$ ppr arg_ty) $ + Just (tyL, arg_ty `mkCastTy` co1, MCo co2) | otherwise = Nothing where - Pair tyL tyR = coercionKind co - -- co :: tyL ~R tyR - -- tyL = forall (a1 :: k1). ty1 - -- tyR = forall (a2 :: k2). ty2 + -- co :: tyL ~R tyR + -- tyL = forall (a1 :: k1). ty1 + -- tyR = forall (a2 :: k2). ty2 + tyL = coercionLKind co + tyR = coercionRKind co -- Used only in asssertions and debug messages co1 = mkSymCo (mkSelCo SelForAll co) -- co1 :: k2 ~N k1 @@ -2919,30 +2920,32 @@ pushCoTyArg co ty -- kinds of the types related by a coercion between forall-types. -- See the SelCo case in GHC.Core.Lint. - co2 = mkInstCo co (mkGReflLeftCo Nominal ty co1) - -- co2 :: ty1[ (ty|>co1)/a1 ] ~R ty2[ ty/a2 ] + co2 = mkInstCo co (mkGReflLeftCo Nominal arg_ty co1) + -- co2 :: ty1[ (arg_ty|>co1)/a1 ] ~R ty2[ arg_ty/a2 ] -- Arg of mkInstCo is always nominal, hence Nominal --- | If @pushCoValArg co = Just (co_arg, co_res)@, then +-- | If @pushCoValArg co = Just (tyL, co_arg, co_res)@, then -- --- > (\x.body) |> co = (\y. let { x = y |> co_arg } in body) |> co_res) +-- co :: tyL ~R# tyR +-- and +-- (\x.body) |> co = (\y. let { x = y |> co_arg } in body) |> co_res) -- -- or, equivalently -- --- > (fun |> co) arg = (fun (arg |> co_arg)) |> co_res +-- (fun |> co) arg = (fun (arg |> co_arg)) |> co_res -- -- If the LHS is well-typed, then so is the RHS. In particular, the argument -- @arg |> co_arg@ is guaranteed to have a fixed 'RuntimeRep', in the sense of -- Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. -pushCoValArg :: CoercionR -> Maybe (MCoercionR, MCoercionR) +pushCoValArg :: CoercionR -> Maybe (Type, MCoercionR, MCoercionR) pushCoValArg co -- The following is inefficient - don't do `eqType` here, the coercion -- optimizer will take care of it. See #14737. -- -- | tyL `eqType` tyR -- -- = Just (mkRepReflCo arg, Nothing) - | isReflCo co - = Just (MRefl, MRefl) + | Just (ty, _) <- isReflCo_maybe co + = Just (ty, MRefl, MRefl) | isFunTy tyL , (_, co1, co2) <- decomposeFunCo co @@ -2961,7 +2964,7 @@ pushCoValArg co (vcat [ text "co:" <+> ppr co , text "old_arg_ty:" <+> ppr old_arg_ty , text "new_arg_ty:" <+> ppr new_arg_ty ]) $ - Just (coToMCo (mkSymCo co1), coToMCo co2) + Just (tyL, coToMCo (mkSymCo co1), coToMCo co2) -- Critically, coToMCo to checks for ReflCo; the whole coercion may not -- be reflexive, but either of its components might be -- We could use isReflexiveCo, but it's not clear if the benefit @@ -2970,9 +2973,12 @@ pushCoValArg co | otherwise = Nothing where - old_arg_ty = funArgTy tyR + tyL = coercionLKind co new_arg_ty = funArgTy tyL - Pair tyL tyR = coercionKind co + + -- These two are used only in assertions and debug messages + tyR = coercionRKind co + old_arg_ty = funArgTy tyR pushCoercionIntoLambda :: HasDebugCallStack => InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr) ===================================== compiler/GHC/Core/Opt/Simplify/Iteration.hs ===================================== @@ -17,8 +17,7 @@ import GHC.Driver.Flags import GHC.Core import GHC.Core.Opt.Simplify.Monad import GHC.Core.Opt.ConstantFold -import GHC.Core.Type hiding ( substCo, substTy, substTyVar, extendTvSubst, extendCvSubst ) -import GHC.Core.TyCo.Compare( eqType ) +import GHC.Core.Opt.Stats ( Tick(..) ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Inline import GHC.Core.Opt.Simplify.Utils @@ -26,11 +25,14 @@ import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs ) import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) +import qualified GHC.Core.Coercion as Coercion import GHC.Core.Reduction import GHC.Core.Coercion.Opt ( optCoercion ) +import GHC.Core.Type hiding ( substCo, substTy, substTyVar, extendTvSubst, extendCvSubst ) +import GHC.Core.TyCo.Compare( eqType ) +import GHC.Core.TyCo.Subst( isEmptyTvSubst ) import GHC.Core.FamInstEnv ( FamInstEnv, topNormaliseType_maybe ) import GHC.Core.DataCon -import GHC.Core.Opt.Stats ( Tick(..) ) import GHC.Core.Ppr ( pprCoreExpr ) import GHC.Core.Unfold import GHC.Core.Unfold.Make @@ -1399,16 +1401,38 @@ simplCoercionF env co cont simplCoercion :: SimplEnv -> InCoercion -> SimplM OutCoercion simplCoercion env co - = do { let opt_co | reSimplifying env = substCo env co - | otherwise = optCoercion opts subst co - -- If (reSimplifying env) is True we have already simplified - -- this coercion once, and we don't want do so again; doing - -- so repeatedly risks non-linear behaviour - -- See Note [Inline depth] in GHC.Core.Opt.Simplify.Env - ; seqCo opt_co `seq` return opt_co } + = seqCo opt_co `seq` return opt_co where + -- See Note [Optimising coercions] + -- NB: substCo has a short-cut when both type and coercion substs are empty + opt_co | subst_only = Coercion.substCo subst co + | otherwise = optCoercion opts subst co + subst = getTCvSubst env opts = seOptCoercionOpts env + subst_only = isEmptyTvSubst subst || reSimplifying env + +{- Note [Optimising coercions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Some programs have very big coercions and we'd like to avoid repeatedly +re-optimising them: + +* If the type-substitution is empty (common when no further transformations + are taking place) then there is generally no point in re-optimising. + If there is a type substitution, however, Refls may appear. + Example where this isEmptyTCvSubst test really helped: aT5030. + + Actually, if this is a "freshly-made" coercion (one built in the previous + iteration of the Simplifier, or a previous pass) then perhaps optimisations + /could/ occur; but we check for reflexivity in `rebuild_go`, and that's the + big win. Otherwise having a bigger-than necessary coercion is no so bad. + +* (reSimplifying env) is True we are in the body of an inlined function + so we (conservatively) and we don't want do so again; doing so repeatedly + risks non-linear behaviour. See Note [Inline depth] in GHC.Core.Opt.Simplify.Env. + + But if the inlining did a type substitution maybe we should re-optimise? +-} ----------------------------------- -- | Push a TickIt context outwards past applications and cases, as @@ -1742,6 +1766,9 @@ pushCast :: SimplEnv -> OutCoercion -> SimplCont -> SimplM SimplCont pushCast env co cont = go co True cont where + + -- ToDo: pushCast Refl (ApplylToVal arg1 (ApplyToVal arg2 ...)) + -- will do lots of unnecessary work. go :: OutCoercion -> Bool -> SimplCont -> SimplM SimplCont go co1 _ (CastIt { sc_co = co2, sc_cont = cont }) -- See Note [Optimising reflexivity] = go (mkTransCo co1 co2) False cont @@ -1749,12 +1776,12 @@ pushCast env co cont -- See Note [Avoid re-simplifying coercions] go co co_is_opt (ApplyToTy { sc_arg_ty = arg_ty, sc_cont = tail }) - | Just (arg_ty', m_co') <- pushCoTyArg co arg_ty + | Just (tyL, arg_ty', m_co') <- pushCoTyArg co arg_ty = {-#SCC "addCoerce-pushCoTyArg" #-} do { tail' <- go_mco m_co' co_is_opt tail ; return (ApplyToTy { sc_arg_ty = arg_ty' , sc_cont = tail' - , sc_hole_ty = coercionLKind co }) } + , sc_hole_ty = tyL }) } -- NB! As the cast goes past, the -- type of the hole changes (#16312) @@ -1768,16 +1795,14 @@ pushCast env co cont = -- pushCoValArg duplicates the coercion, so optimise first go (optOutCoercion (zapSubstEnv env) co co_is_opt) True cont --- ToDo: return coercionLKind. And similarly pushCoTyArg - - | Just (m_co1, m_co2) <- pushCoValArg co + | Just (tyL, m_co1, m_co2) <- pushCoValArg co = {-#SCC "addCoerce-pushCoValArg" #-} - do { tail' <- go_mco m_co2 co_is_opt tail + do { tail' <- go_mco m_co2 True tail ; return (ApplyToVal { sc_arg = arg , sc_env = arg_se , sc_cast = arg_mco `mkTransMCo` m_co1 , sc_cont = tail' - , sc_hole_ty = coercionLKind co }) } + , sc_hole_ty = tyL }) } go co co_is_opt cont | isReflCo co = return cont -- Having this at the end makes a huge @@ -1785,8 +1810,6 @@ pushCast env co cont -- See Note [Optimising reflexivity] | otherwise = return (CastIt { sc_co = co, sc_opt = co_is_opt, sc_cont = cont }) --- ToDo: pushCast Refl (ApplylToVal arg1 (ApplyToVal arg2 ...)) will do lots of unnecessary work. - -- If the first parameter is MRefl, then simplifying revealed a -- reflexive coercion. Omit. go_mco :: MOutCoercion -> Bool -> SimplCont -> SimplM SimplCont ===================================== compiler/GHC/Core/TyCo/Subst.hs ===================================== @@ -12,7 +12,7 @@ module GHC.Core.TyCo.Subst -- * Substitutions Subst(..), TvSubstEnv, CvSubstEnv, IdSubstEnv, emptyIdSubstEnv, emptyTvSubstEnv, emptyCvSubstEnv, composeTCvSubst, - emptySubst, mkEmptySubst, isEmptyTCvSubst, isEmptySubst, + emptySubst, mkEmptySubst, isEmptyTvSubst, isEmptyTCvSubst, isEmptySubst, mkSubst, mkTCvSubst, mkTvSubst, mkCvSubst, mkIdSubst, getTvSubstEnv, getIdSubstEnv, getCvSubstEnv, substInScopeSet, setInScope, getSubstRangeTyCoFVs, @@ -262,6 +262,11 @@ isEmptySubst :: Subst -> Bool isEmptySubst (Subst _ id_env tv_env cv_env) = isEmptyVarEnv id_env && isEmptyVarEnv tv_env && isEmptyVarEnv cv_env +-- | Checks if the type substitution (only) is empty +isEmptyTvSubst :: Subst -> Bool +isEmptyTvSubst (Subst _ _ tv_env _) + = isEmptyVarEnv tv_env + -- | Checks whether the tyvar and covar environments are empty. -- This function should be used over 'isEmptySubst' when substituting -- for types, because types currently do not contain expressions; we can ===================================== compiler/GHC/Tc/Types/Evidence.hs ===================================== @@ -59,7 +59,6 @@ import GHC.Tc.Utils.TcType import GHC.Core import GHC.Core.Coercion.Axiom import GHC.Core.Coercion -import GHC.Core.Utils( mkCast ) import GHC.Core.Ppr () -- Instance OutputableBndr TyVar import GHC.Core.Predicate import GHC.Core.Type @@ -932,7 +931,8 @@ evCastE ee co | assertPpr (coercionRole co == Representational) (vcat [text "Coercion of wrong role passed to evCastE:", ppr ee, ppr co]) $ isReflCo co = ee - | otherwise = mkCast ee co + | otherwise = Cast ee co -- Do not call mkCast because its assertion + -- checks fail on un-zonked terms (#27219) evDFunApp :: DFunId -> [Type] -> [EvExpr] -> EvTerm -- Dictionary instance application, including when the "dictionary function" View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bbd56e8ba16b562d10b5b94d92dbc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9bbd56e8ba16b562d10b5b94d92dbc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/jeltsch/more-efficient-home-unit-imports-finding.with-debugging] WIP: fix failing test boot1 and multipleHomeUnits_reexport
by Hannes Siebenhandl (＠fendor) 28 Apr '26

28 Apr '26

Hannes Siebenhandl pushed to branch wip/jeltsch/more-efficient-home-unit-imports-finding.with-debugging at Glasgow Haskell Compiler / GHC Commits: 862cd76a by fendor at 2026-04-28T11:26:02+02:00 WIP: fix failing test boot1 and multipleHomeUnits_reexport - - - - - 1 changed file: - compiler/GHC/Unit/Finder.hs Changes: ===================================== compiler/GHC/Unit/Finder.hs ===================================== @@ -214,7 +214,6 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb | otherwise -> pprPanic "findImportModule" (ppr mod_name $$ ppr mb_pkg $$ ppr (homeUnitId <$> mb_home_unit) $$ ppr uid $$ ppr (map fst all_opts)) OtherPkg _ -> pkg_import where - cached_module_providers = M.findWithDefault Set.empty mod_name (cu_providers complete_home_units) mb_home_unit_id = homeUnitId <$> mb_home_unit all_opts = case mb_home_unit_id of Nothing -> other_fopts @@ -249,42 +248,42 @@ findImportedModuleNoHsc fc fopts ue complete_home_units mb_home_unit mod_name mb units = case mb_home_unit_id of Nothing -> ue_homeUnitState ue Just home_unit_id -> HUG.homeUnitEnv_units $ ue_findHomeUnitEnv home_unit_id ue + hpt_deps :: Set.Set UnitId hpt_deps = homeUnitDepends units + + -- TODO: this predicate is wrong, we need something more focused + sorted_deps = case finder_lookupHomeInterfaces fopts of + True -> Set.toList hpt_deps + False -> sortHomeUnitsByLikelihoodFor complete_home_units mb_home_unit_id mod_name hpt_deps + + other_fopts = + [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue))) + | uid <- sorted_deps + ] + +sortHomeUnitsByLikelihoodFor :: CompleteUnits -> Maybe UnitId -> ModuleName -> Set.Set UnitId -> [UnitId] +sortHomeUnitsByLikelihoodFor complete_home_units mb_home_unit_id mod_name hpt_deps = + let + cached_module_providers = M.findWithDefault Set.empty mod_name (cu_providers complete_home_units) cached_providing_deps = Set.intersection cached_module_providers hpt_deps other_cached_providing_deps = Set.toList $ maybe cached_providing_deps (\u -> Set.delete u cached_providing_deps) mb_home_unit_id uncached_providing_deps = - let candidates = Set.difference hpt_deps (cu_inventory complete_home_units) + let candidates = Set.difference hpt_deps cached_module_providers excluded = maybe cached_providing_deps (\u -> Set.insert u cached_providing_deps) mb_home_unit_id in Set.toList (Set.difference candidates excluded) - other_providing_deps = other_cached_providing_deps ++ uncached_providing_deps - other_fopts = - [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue))) - | uid <- other_providing_deps - ] - !() = pprTrace "findImportedModuleNoHsc" (vcat lines) () where - - lines = [ - -- text "complete_home_units" <+> ppr complete_home_units, - -- text "mb_home_unit " <+> ppr mb_home_unit, - text "mod_name:" <+> ppr mod_name, - text "cached_module_providers:" <+> ppr cached_module_providers, - text "mb_home_unit_id:" <+> ppr mb_home_unit_id, - -- text "all_opts:" <+> ppr all_opts, - -- text "any_home_import:" <+> ppr any_home_import, - -- text "pkg_import:" <+> ppr pkg_import , - -- text "unqual_import:" <+> ppr unqual_import, - -- text "units:" <+> ppr units , - text "hpt_deps:" <+> ppr hpt_deps, - text "cached_providing_deps:" <+> ppr cached_providing_deps, - text "other_cached_providing_deps:" <+> ppr other_cached_providing_deps, - text "uncached_providing_deps:" <+> ppr uncached_providing_deps, - text "other_providing_deps:" <+> ppr other_providing_deps - -- text "other_fopts:" <+> ppr other_fopts - ] + all_deps = other_cached_providing_deps ++ uncached_providing_deps + in + assertPpr + (hpt_deps == Set.fromList all_deps) + ( text "Sorting must not remove HomeUnits" + $$ text "Module:" <+> ppr mod_name + $$ text "Original:" <+> ppr hpt_deps + $$ text "Sorted: " <+> ppr (Set.fromList all_deps)) + all_deps -- | Locate a plugin module requested by the user, for a compiler -- plugin. This consults the same set of exposed packages as View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/862cd76afdafce25019b79d918e63ad… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/862cd76afdafce25019b79d918e63ad… You're receiving this email because of your account on gitlab.haskell.org.

1 0