mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-16 00:37:33 +03:00
97 lines
4.2 KiB
Haskell
Executable File
97 lines
4.2 KiB
Haskell
Executable File
#!/usr/bin/env runhaskell
|
|
{-
|
|
Make/update hledger release notes from the latest release's changelogs.
|
|
Run this in the root of the hledger repo, in a release branch.
|
|
If you have switched branch recently you may have to kill an unhelpful
|
|
ghc environment file first. Eg: rm -f .ghc.environment* && tools/relnotes.hs
|
|
|
|
This reads the latest release's changes from the main CHANGES.md files,
|
|
converts to release notes format, and inserts this into relnotes.md.
|
|
If there already were release notes for this release (at top of relnotes),
|
|
they will be replaced, except for a manually added "highlights" paragraph if any
|
|
(after the release heading, beginning and ending with **), which is preserved.
|
|
|
|
The release's version is taken from the the first h1 heading in the project CHANGES.md.
|
|
It is assumed that all the other changelogs' first section is also for this version (XXX),
|
|
and that changelogs and relnotes are non-empty with specific layout and heading formats.
|
|
|
|
In the end I wrote this in haskell because everything else was harder.
|
|
-}
|
|
|
|
import Data.Char
|
|
import Data.List
|
|
import System.IO
|
|
import System.Process
|
|
import Text.Printf
|
|
|
|
main = do
|
|
-- gather latest release changes & info
|
|
(projectChangesHeading, projectChanges) <- changelogFirstSection <$> readFile "CHANGES.md"
|
|
(hledgerChangesHeading, hledgerChanges) <- changelogFirstSection <$> readFile "hledger/CHANGES.md"
|
|
(hledgerUiChangesHeading, hledgerUiChanges) <- changelogFirstSection <$> readFile "hledger-ui/CHANGES.md"
|
|
(hledgerWebChangesHeading, hledgerWebChanges) <- changelogFirstSection <$> readFile "hledger-web/CHANGES.md"
|
|
reltags <- lines <$> readProcess "git" ["tag", "--sort=-creatordate", "-l", "[0-9]*"] ""
|
|
let
|
|
[_, ver, date] = words projectChangesHeading
|
|
prevver:_ = drop 1 $ dropWhile (/=ver) reltags
|
|
relauthors <- map (unwords . drop 1 . words) . lines <$> readProcess "git" ["shortlog", "-sn", prevver<>".."<>ver] ""
|
|
|
|
-- convert to release notes format
|
|
let
|
|
newrelnotesheading = printf "## %s hledger-%s\n" date ver
|
|
newrelnotesbody = intercalate "\n\n" [
|
|
changelogHeadingToRelnotesHeading "hledger" hledgerChangesHeading, hledgerChanges,
|
|
changelogHeadingToRelnotesHeading "hledger-ui" hledgerUiChangesHeading, hledgerUiChanges,
|
|
changelogHeadingToRelnotesHeading "hledger-web" hledgerWebChangesHeading, hledgerWebChanges,
|
|
"### project changes " <> ver <> "\n", projectChanges,
|
|
"### credits " <> ver <> "\n", intercalate ",\n" relauthors <> ".\n"
|
|
] <> "\n\n"
|
|
|
|
-- insert or update in relnotes.md
|
|
let relnotesfile = "doc/relnotes.md"
|
|
(preamble, rnlatestver, rnlatesthighlights, rnlatestbody, rest) <-
|
|
relnotesSections <$> readFile' relnotesfile
|
|
-- putStrLn $
|
|
writeFile relnotesfile $
|
|
unlines [
|
|
preamble,
|
|
newrelnotesheading,
|
|
if null rnlatesthighlights then "" else rnlatesthighlights <> "\n",
|
|
newrelnotesbody,
|
|
if rnlatestver == ver then "" else rnlatestbody,
|
|
rest
|
|
] <> "\n"
|
|
|
|
changelogFirstSection alltext =
|
|
case uncons $ dropWhile (not.isReleaseHeading) $ lines alltext of
|
|
Nothing -> ("","")
|
|
Just (l,ls) -> (nl l, strip' $ unlines $ takeWhile (not.isReleaseHeading) ls)
|
|
where
|
|
isReleaseHeading = isPrefixOf "# "
|
|
|
|
changelogHeadingToRelnotesHeading pkgname heading =
|
|
let [_, ver, _] = words heading
|
|
in printf "### %s %s\n" pkgname ver
|
|
|
|
relnotesSections alltext = (unlines preamble, firstsectionver, firstsectionhighlights, firstsectionbody, rest)
|
|
where
|
|
isReleaseHeading = isPrefixOf "## "
|
|
(preamble, (firstsectionheading:ls)) = span (not.isReleaseHeading) $ lines alltext
|
|
firstsectionver = drop 8 $ (!!2) $ words firstsectionheading
|
|
ls2 = dropWhile null ls
|
|
(firstsectionhighlights, ls3) =
|
|
case ls2 of
|
|
('*':'*':_):_ -> (unlines $ takeWhile (not.null) ls2, dropWhile (not.null) ls2)
|
|
_ -> ("", ls2)
|
|
(firstsectionls, restls) = span (not.isReleaseHeading) ls3
|
|
firstsectionbody = unlines $ firstsectionheading : firstsectionls
|
|
rest = unlines restls
|
|
|
|
unlines' = intercalate "\n"
|
|
|
|
lstrip = dropWhile isSpace
|
|
rstrip = reverse . lstrip . reverse
|
|
strip = lstrip . rstrip
|
|
strip' = nl . strip
|
|
nl = (<>"\n")
|