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: <!-- issue number here (please open a new issue if there isn't one) --> - [ ] 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 $ "<!-- ===== " ++ mtSection mt + ++ " (" ++ mtPath mt ++ ") ===== -->" + 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/compiler), + [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/553822f637a3585068d147c9c050cad9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/553822f637a3585068d147c9c050cad9... You're receiving this email because of your account on gitlab.haskell.org.