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 \