#!/usr/bin/env stack {- stack script --resolver nightly-2022-07-10 --compile --extra-include-dirs /Library/Developer/CommandLineTools/SDKs/MacOSX12.1.sdk/usr/include/ffi --package base-prelude --package directory --package extra --package process --package regex --package safe --package shake --package time -} {- -- add this to see packages being installed instead of a long silence: --verbosity=info This is one of two collections of maintainer/developer scripts; Makefile is the other. This one, based on shake, provides a stronger programming language and more platform independence. It requires stack and will auto-install the haskell packages above when needed. Some of the commands below require additional command-line tools, including: - hpack (same version that's in current stack release) - GNU date (on mac: brew install coreutils) - groff - m4 - makeinfo - pandoc - sed - mv - cat - rm Some things that may be useful when working on this: - https://docs.haskellstack.org/en/stable/GUIDE/#script-interpreter - watch Shake.hs for compile errors: make ghcid-shake - load Shake.hs in GHCI: make ghci-shake - rebuild things when files change with entr (file watcher), eg: find hledger-lib hledger | entr ./Shake manuals - view rule dependency graph: ./Shake --report, open report.html?mode=rule-graph&query=!name(/(doc%7Cimages%7Cjs%7Ccss%7Cfonts%7Ctime%7Capi%7Cui%7Ccsv)/) -} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} import Prelude () import "base-prelude" BasePrelude import "base" Control.Exception as C -- required packages, keep synced with Makefile -> SHAKEDEPS: import "directory" System.Directory as S (getDirectoryContents) import "extra" Data.List.Extra hiding (headDef, lastDef) import "regex" Text.RE.TDFA.String import "regex" Text.RE.Replace import "safe" Safe import "shake" Development.Shake import "shake" Development.Shake.FilePath import "time" Data.Time -- import "hledger-lib" Hledger.Utils.Debug usage = let scriptname = "Shake" in replaceRe [re|/Shake|] ('/':scriptname) $ unlines ---------------------------------------79-------------------------------------- ["hledger developer scripts. See also: make help" ,"Usage:" ,"./Shake.hs [CMD [ARGS]] run CMD, compiling this script first if needed" ,"./Shake [CMD [ARGS]] run CMD, using the compiled version of this script" ,"./Shake [help] show this help" ,"./Shake cabalfiles [-c] update */*.cabal files from */package.yaml" ,"./Shake setversion [VER] [PKGS] [-c]" ," update versions in source files to */.version or VER" ," and update */*.cabal files" ,"./Shake cmdhelp [-c] update hledger CLI commands' help texts" ,"./Shake mandates update the date shown in some manual formats" ,"./Shake manuals [-c] update all packages' txt/man/info/web manuals" -- ,"./Shake webmanuals update just the web manuals" ,"./Shake changelogs [-c] [-n/--dry-run]" ," update CHANGES.md files, adding new commits & headings" ,"./Shake docs [-c] update all program docs (CLI help, manuals, changelogs)" ,"./Shake site update (render) the website, in ./site" ,"./Shake build [PKGS] build hledger packages and their embedded docs" ,"./Shake clean remove generated texts, manuals" ,"./Shake Clean also remove object files, Shake's cache" ,"./Shake FILE build any individual file" ,"./Shake --help list shake build options (--color, --rebuild, etc." ," Keep shake option arguments adjacent to their flag.)" ,"" ,"See comments in Shake.hs for more detailed descriptions." ,"Add -c/--commit to have commands commit their changes." ,"Add -V/-VV/-VVV to see more verbose output." ,"Add -B, with nothing immediately after it, to force rebuilding." ] -- TODO -- ,"./Shake releasebranch create a new release branch, bump master to next dev version (.99)" -- ,"./Shake majorversion bump to the next major version project-wide, update affected files" -- ,"./Shake minorversion PKGS bump one or more packages to their next minor version project-wide, update affected files" -- ,"./Shake relnotes create draft release notes" -- groff = "groff -c" ++ " -Wall" -- see "groff" below m4 = "m4 -P" makeinfo = "makeinfo --no-split --force --no-warn --no-validate" -- silence makeinfo warnings, comment these to see them pandoc = "pandoc --strip-comments" gitcommit = "git commit --allow-empty" -- We should work with both BSD and GNU sed. Tips: -- use [a-z] [0-9] instead of \w \d etc. -- backslash-escape things like: { & sed = "sed -E" -- We should work with both BSD and GNU grep. grep = "grep -E" -- The kind of markdown used in our doc source files. -- Note: without +hard_line_breaks here, paragraphs get refilled, -- which is good for nice rendered info/man/text output, but so do -- multiline arguments to m4 macros, which is bad eg when using -- _info_ to add Info directives (cf #806). For such situations we -- work around by calling the macro for each line of text, it -- would be nice to find a way to avoid this. fromsrcmd = "-f markdown-smart-tex_math_dollars" -- The kind of org markup used in any org source files. -- In pandoc 2.14, org reader enables smart dashes by default; -- use #+OPTIONS: -:nil in the org file to disable it (-smart here has no effect). -- We also write to markdown+strict, which would undo any smart dashes or quotes). fromorg = "-f org-smart" -- The kind of markdown we like to generate for the website. -- -- This was configured for sphinx+recommonmark+sphinx-markdown-tables; it could be reviewed now that we use mdbook. -- Trying to force the use of pipe_tables here, but sometimes it uses html instead. -- -- --markdown-headings=atx requires pandoc 2.11.2+; with older pandoc use --atx-headers instead. -- -- In pandoc 2.14, "If you are writing Markdown, then the smart extension has the -- reverse effect: what would have been curly quotes comes out straight.". -- So +smart here can fix unwanted smart typography that may have crept in, -- eg from org docs (see above). -- towebmd = "-t markdown+smart-fenced_divs-fenced_code_attributes-simple_tables-multiline_tables-grid_tables-raw_attribute --markdown-headings=atx" main = do -- Gather some IO values used by rules. -- hledger manual also includes the markdown files from here: let commandsdir = "hledger/Hledger/Cli/Commands" commandmds <- filter (not . ("README." `isPrefixOf`) . takeFileName) . filter (".md" `isSuffixOf`) . map (commandsdir ) <$> S.getDirectoryContents commandsdir let commandtxts = map (-<.> "txt") commandmds -- Run the shake rule selected by the first command line argument. -- Other arguments and some custom flags are set aside for the rule -- to use if it wants. -- Option arguments should be kept adjacent to their flag or this will go wrong. (opts, args) <- partition ("-" `isPrefixOf`) <$> getArgs let ruleoptnames = [ "--commit", "-c" ,"--dry-run", "--dry", "-n" ] (ruleopts, shakeopts) = partition (`elem` ruleoptnames) opts commit = any (`elem` ruleopts) ["--commit", "-c"] dryrun = any (`elem` ruleopts) ["--dry-run", "--dry", "-n"] (shakearg, ruleargs) = splitAt 1 args shakeargs = shakeopts ++ shakearg -- print (opts,args,shakeopts,shakearg,shakeargs,ruleopts,ruleargs) withArgs shakeargs $ shakeArgs shakeOptions{ shakeVerbosity=Quiet -- ,shakeReport=[".shake.html"] } $ do -- The rules. want ["help"] phony "help" $ liftIO $ putStr usage -- NAMES, FILES, URIS, HELPERS let -- main package names, in standard build order packages = [ "hledger-lib" ,"hledger" ,"hledger-ui" ,"hledger-web" ] pkgdirs = packages pkgandprojdirs = "" : pkgdirs cabalfiles = [p p <.> "cabal" | p <- packages] changelogs = map ( "CHANGES.md") pkgandprojdirs packagemanversionm4s = [p ".version.m4" | p <- packages] packagemandatem4s = [p ".date.m4" | p <- packages] -- doc files (or related targets) that should be generated -- before building hledger packages. -- [(PKG, [TARGETS])] embeddedFiles = [ -- hledger embeds the plain text command help files and all packages' text/nroff/info manuals ("hledger", commandtxts ++ ["manuals"]) -- hledger-ui imports the hledger-ui manuals from hledger ,("hledger-ui", ["hledger"]) ] -- man page names (manual names plus a man section number), in suggested reading order manpageNames = [ "hledger.1" ,"hledger-ui.1" ,"hledger-web.1" ] -- basic manual names, without numbers manualNames = map manpageNameToManualName manpageNames -- main markdown+m4 source files for manuals (hledger/hledger.m4.md) -- These may include additional files using m4. m4manuals = [manualDir m m <.> "m4.md" | m <- manualNames] -- manuals as plain text, ready for embedding as CLI help (hledger/hledger.txt) txtmanuals = [manualDir m m <.> "txt" | m <- manualNames] -- manuals as nroff, ready for man (hledger/hledger.1) nroffmanuals = [manpageDir m m | m <- manpageNames] -- manuals as info, ready for info (hledger/hledger.info) infomanuals = [manualDir m m <.> "info" | m <- manualNames] -- an Info directory entry for each package's info manual (hledger/dir-entry.texi) infodirentries = [manualDir m "dir-entry.texi" | m <- manualNames] -- a generated Info directory file for easily accessing/linking the dev version of all the info manuals -- infodir = "dir" -- manuals as sphinx-ready markdown, to be rendered as part of the website (hledger/hledger.md) webmanuals = [manualDir m m <.> "md" | m <- manualNames] -- -- old versions of the manuals rendered to html (site/_site/doc/1.14/hledger.html) -- oldhtmlmanuals = map (normalise . ("site/_site/doc" ) . (<.> "html")) $ -- [ v manpageNameToWebManualName p | v <- docversions, v>="1.0", p <- manpageNames ++ ["manual"] ] ++ -- [ v "manual" | v <- docversions, v <"1.0" ] -- before 1.0 there was only the combined manual -- The directory in which to find this man page. -- hledger.1 -> hledger/doc, hledger_journal.5 -> hledger-lib/doc manpageDir m | '_' `elem` m = "hledger-lib" | otherwise = dropExtension m -- The directory in which to find this manual. -- hledger -> hledger, hledger_journal -> hledger-lib manualDir m | '_' `elem` m = "hledger-lib" | otherwise = m -- The web manual name (& URI "slug") corresponding to this man page. -- hledger.1 -> hledger, hledger_journal.5 -> journal manpageNameToWebManualName m | "hledger_" `isPrefixOf` m = dropExtension $ drop 8 m | otherwise = dropExtension m -- The man page corresponding to this web manual name. -- hledger -> hledger.1, journal -> hledger_journal.5 webManualNameToManpageName u | "hledger" `isPrefixOf` u = u <.> "1" | otherwise = "hledger_" ++ u <.> "5" -- VERSION NUMBERS -- Regenerate .cabal files from package.yaml files. -- (used by "cabalfiles" and "setversion") let gencabalfiles = do -- Update cabal files with stack build. -- stack 1.7+ no longer updates cabal files with --dry-run, we must do a full build. -- stack can return zero exit code while failing to update cabal files so -- we need to check for the error message (specifically) on stderr. -- out <- fromStdouterr <$> -- (getting both stdout and stderr here just as an example) -- (cmd (EchoStdout True) (EchoStderr True) Shell "stack build" :: Action (Stdouterr String)) -- when ("was generated with a newer version of hpack" `isInfixOf` out) $ -- liftIO $ putStr out >> exitFailure -- Or update them with hpack directly. -- It should be the same hpack version that's in current stack, to avoid commit conflicts. forM_ pkgdirs $ \d -> cmd_ (Cwd d) Shell "hpack --no-hash" when commit $ do let msg = ";cabal: update cabal files" cmd Shell gitcommit ("-m '"++msg++"' --") cabalfiles -- Update version strings in most "source" files to match what's in PKG/.version. -- If a version number is provided as first argument, save that in PKG/.version files first. -- If one or more subdirectories are provided as arguments, save/update only those. -- Also regenerates .cabal files from package.yaml files. -- See also CONTRIBUTING.md > Version numbers. phony "setversion" $ do let (mver, dirargs) = (headMay ver', drop 1 ver' ++ dirs') where (ver',dirs') = span isVersion ruleargs (specifieddirs, specifiedpkgs) = case dirargs of [] -> (pkgandprojdirs, pkgdirs) ds -> (ds, ds) -- if a version was provided, update .version files in the specified directories let specifiedversionfiles = map ( ".version") specifieddirs case mver of Just v -> liftIO $ forM_ specifiedversionfiles $ flip maybeWriteFile (v++"\n") Nothing -> return () -- update "source" files depending on .version in the specified packages let dependents = map ( ".version.m4") specifiedpkgs ++ map ( "package.yaml") specifiedpkgs need dependents -- and maybe commit them when commit $ do let msg = unwords [ ";pkg: bump" ,case dirargs of [] -> "version" ds -> intercalate ", " ds ++ " version" ,case mver of Nothing -> "" Just v -> "to " ++ v ] cmd Shell gitcommit ("-m '"++msg++"' --") specifiedversionfiles dependents gencabalfiles -- PKG/.version.m4 <- PKG/.version, just updates the _version_ macro "hledger*/.version.m4" %> \out -> do let versionfile = takeDirectory out ".version" need [versionfile] version <- ((head . words) <$>) $ liftIO $ readFile versionfile cmd_ Shell sed "-i -e" ("'s/(_version_}}, *)\\{\\{[^}]+/\\1{{"++version++"/;'") out -- PKG/package.yaml <- PKG/.version, just updates version strings "hledger*/package.yaml" %> \out -> do let versionfile = takeDirectory out ".version" need [versionfile] version <- ((head . words) <$>) $ liftIO $ readFile versionfile let ma:jor:_ = splitOn "." version nextmajorversion = intercalate "." [ma, show $ read jor+1] -- One simple task: update some strings in a small text file. -- Several ugly solutions: -- -- 1. use haskell list utils. Tedious. -- old <- liftIO $ readFileStrictly out -- let isversionline s = "version" `isPrefixOf` (dropWhile isSpace $ takeWhile (not.(`elem` " :")) s) -- (before, _:after) = break isversionline $ lines old -- -- oldversion = words versionline !! 1 -- new = unlines $ before ++ ["version: "++version] ++ after -- liftIO $ writeFile out new -- -- 2. use regular expressions in haskell. Haskell has no portable, -- featureful, replacing, backreference-supporting regex lib yet. -- -- 3. use sed. Have to assume non-GNU sed, eg on mac. -- Things to update in package.yaml: -- -- version: VER cmd_ Shell sed "-i -e" ("'s/(^version *:).*/\\1 "++version++"/'") out -- -- -DVERSION="VER" cmd_ Shell sed "-i -e" ("'s/(-DVERSION=)\"[^\"]+/\\1\""++version++"/'") out -- -- this package's dependencies on other hledger packages (typically hledger-lib, hledger) -- -- This one is a bit tricky, and we do it with these limitations: -- a. We handle bounds in one of these forms (allowing extra whitespace): -- ==A -- >A -- >=A -- >A && =A && bounds to >= bounds. -- -- hledger[-PKG] ==LOWER let versionre = "([0-9]+\\.)*[0-9]+" -- 2 or 3 part version number regexp cmd_ Shell sed "-i -e" ("'s/(hledger(-[a-z]+)?) *== *"++versionre++" *$/\\1 == "++version++"/'") out -- -- hledger[-PKG] >[=]LOWER cmd_ Shell sed "-i -e" ("'s/(hledger(-[a-z]+)?) *>=? *"++versionre++" *$/\\1 >= "++version++"/'") out -- -- hledger[-PKG] >[=]LOWER && =]'" out " || [[ $? == 1 ]]" -- ignore no matches, https://unix.stackexchange.com/a/427598 phony "cabalfiles" $ gencabalfiles -- MANUALS -- Generate the manuals in plain text, nroff, info, and markdown formats. phony "manuals" $ do need $ concat [ nroffmanuals ,infomanuals -- ,[infodir] ,txtmanuals ,webmanuals ] when commit $ do let msg = ";doc: update manuals" cmd Shell gitcommit ("-m '"++msg++"' --") packagemandatem4s nroffmanuals infomanuals infodirentries txtmanuals -- infodir -- Update the dates to show in man pages, to the current month and year. -- Currently must be run manually when needed. -- Dates are stored in PKG/.date.m4, and are committed along with manuals by Shake manuals -c. phony "mandates" $ do date <- chomp . fromStdout <$> (cmd Shell "date +'%B %Y'" :: Action (Stdout String)) forM_ packagemandatem4s $ \f -> do cmd_ Shell ["perl","-pi","-e","'s/(.*)\\{\\{.*}}(.*)$/\\1\\{\\{"++date++"}}\\2/'",f] -- Generate nroff man pages suitable for man output, from the .m4.md source. -- Also updates the _monthyear_ macro to current month and year in hledger*/.date.m4. phony "nroffmanuals" $ need nroffmanuals nroffmanuals |%> \out -> do -- hledger/hledger.1 let src = manpageNameToManualName out <.> "m4.md" commonm4 = "doc/common.m4" commandsm4 = "hledger/Hledger/Cli/Commands/commands.m4" dir = takeDirectory out pkg = dir packagemanversionm4 = dir ".version.m4" packagemandatem4 = dir ".date.m4" tmpl = "doc/manpage.nroff" pkgversion <- liftIO $ readFile $ dir ".version" -- mandate <- formatTime defaultTimeLocale "%B %Y" <$> liftIO getCurrentDay -- XXX not using this.. compare with .date.m4 -- assume any other .m4.md files in dir are included by this one XXX not true in hledger-lib subfiles <- liftIO $ filter (/= src) . filter (".m4.md" `isSuffixOf`) . map (dir ) <$> S.getDirectoryContents dir need $ [src, commonm4, commandsm4, packagemanversionm4, packagemandatem4, tmpl] ++ subfiles when (dir=="hledger") $ need commandmds cmd Shell m4 "-DMANFORMAT -I" dir commonm4 commandsm4 packagemanversionm4 packagemandatem4 src "|" pandoc fromsrcmd "-s" "--template" tmpl ("-V footer='"++pkg++"-"++pkgversion++"'") "--lua-filter tools/pandoc-drop-html-blocks.lua" "--lua-filter tools/pandoc-drop-html-inlines.lua" "--lua-filter tools/pandoc-drop-links.lua" "-o" out -- Generate plain text manuals suitable for embedding in -- executables and viewing with a pager, from the man pages. -- (Depends on the nroffmanuals.) phony "txtmanuals" $ need txtmanuals txtmanuals |%> \out -> do -- hledger/hledger.txt let src = manualNameToManpageName $ dropExtension out need [src] -- cmd Shell groff "-t -e -mandoc -Tascii" src "| col -b >" out -- http://www.tldp.org/HOWTO/Man-Page/q10.html -- Workaround: groff 1.22.4 always calls grotty in a way that adds ANSI/SGR escape codes. -- (groff -c is supposed to switch those to backspaces, which we could -- remove with col -b, but it doesn't as can be seen with groff -V.) -- To get plain text, we run groff's lower-level commands (from -V) and add -cbuo. -- -Wall silences most troff warnings, remove to see them cmd Shell "tbl" src "| eqn -Tascii | troff -Wall -mandoc -Tascii | grotty -cbuo >" out -- Generate Info manuals suitable for viewing with info, from the .m4.md source. infomanuals |%> \out -> do -- hledger/hledger.info let src = out -<.> "m4.md" commonm4 = "doc/common.m4" commandsm4 = "hledger/Hledger/Cli/Commands/commands.m4" dir = takeDirectory out packagemanversionm4 = dir ".version.m4" packagemandatem4 = dir ".date.m4" direntry = dir "dir-entry.texi" -- assume any other .m4.md files in dir are included by this one XXX not true in hledger-lib subfiles <- liftIO $ filter (/= src) . filter (".m4.md" `isSuffixOf`) . map (dir ) <$> S.getDirectoryContents dir need $ [src, commonm4, commandsm4, packagemanversionm4, packagemandatem4, direntry] ++ subfiles when (dir=="hledger") $ need commandmds cmd_ Shell "( cat" direntry ";" m4 "-DINFOFORMAT -I" dir commonm4 commandsm4 packagemanversionm4 packagemandatem4 src "|" -- sed "-e 's/^#(#+)/\\1/'" "|" pandoc fromsrcmd "--lua-filter tools/pandoc-drop-html-blocks.lua" "--lua-filter tools/pandoc-drop-html-inlines.lua" "--lua-filter tools/pandoc-drop-links.lua" -- add "standalone" headers ? sounds good for setting text encoding, -- but messes up quotes ('a' becomes ^Xa^Y) -- "-s" "-t texinfo ) |" makeinfo "-o" out -- XXX This generates ./dir, for previewing latest dev manuals in Info's directory. -- For that we need subdirectory paths like "hledger: (hledger/hledger)", -- but this generates "hledger: (hledger)". Don't regenerate dir for now. -- -- Generate an Info dir file which can be included with info -d -- or INFOPATH to add hledger menu items in Info's Directory. -- infodir %> \out -> do -- need infomanuals -- forM_ infomanuals $ \info -> cmd_ Shell "install-info" info out phony "infomanuals" $ need $ infomanuals -- ++ [infodir] -- WEBSITE MARKDOWN SOURCE -- Generate the individual web manuals' markdown source, using m4 -- and pandoc to tweak content. phony "webmanuals" $ need webmanuals webmanuals |%> \out -> do -- hledger/hledger.md, hledger/hledger-ui.md .. let dir = takeDirectory out -- hledger, hledger-lib manpage = webManualNameToManpageName $ dropExtension $ dropExtension $ takeFileName out -- hledger, journal manual = manpageNameToManualName manpage -- hledger, hledger_journal src = dir manual <.> "m4.md" commonm4 = "doc/common.m4" commandsm4 = "hledger/Hledger/Cli/Commands/commands.m4" packageversionm4 = dir ".version.m4" packagemandatem4 = dir ".date.m4" heading = let h = manual in if "hledger_" `isPrefixOf` h then drop 8 h ++ " format" else h -- assume any other .m4.md files in dir are included by this one XXX not true in hledger-lib subfiles <- liftIO $ filter (/= src) . filter (".m4.md" `isSuffixOf`) . map (dir ) <$> S.getDirectoryContents dir let deps = [src, commonm4, commandsm4, packageversionm4, packagemandatem4] ++ subfiles need deps when (manual=="hledger") $ need commandmds -- add the web page's heading. -- XXX Might be nice to do this atomically with the below, so -- make avoid any double refresh when watch docs with entr/livereload. -- But cmd Shell doesn't handle arguments containing spaces properly. liftIO $ writeFile out $ unlines [ "" ,"
" ,"" ,"# " ++ heading ,"" ,"
" ,"" ,"" ,"
" ,"" ] cmd Shell m4 "-DWEBFORMAT -I" dir commonm4 commandsm4 packageversionm4 packagemandatem4 src "|" pandoc fromsrcmd towebmd "--lua-filter tools/pandoc-demote-headers.lua" ">>" out -- This rule, for updating the live hledger.org site, gets called by: -- 1. github-post-receive (github webhook handler), when something is pushed -- to the main repo on Github. Config: -- /etc/supervisord.conf -> [program:github-post-receive] -- /etc/github-post-receive.conf -- 2. cron, nightly. Config: /etc/crontab -- 3. manually (make site). -- phony "hledgerorg" $ do -- -- XXX ideally we would ensure here that output is logged in site.log, -- -- but I don't know how to do that for the Shake rules. -- -- Instead we'll do the logging in "make site". -- cmd_ Shell -- -- -- print timestamp. On mac, use brew-installed GNU date. -- "PATH=\"/usr/local/opt/coreutils/libexec/gnubin:$PATH\" date --rfc-3339=seconds" -- -- pull latest code and site repos - sometimes already done by webhook, not always -- "&& printf 'code repo: ' && git pull" -- "&& printf 'site repo: ' && git -C site pull" -- -- -- Shake.hs might have been updated, but we won't execute the -- -- new one, too insecure. Continue with this one. -- -- Help: -- ,"./Shake hledgerorg update the hledger.org website (when run on prod)" -- HLEDGER PACKAGES/EXECUTABLES -- build [PKGS] -- Build some or all hledger packages, after generating any doc -- files they embed or import. -- This may also update .cabal files from package.yaml files, and/or install haskell deps. phony "build" $ do let pkgs | null args = packages | otherwise = args sequence_ [ do need $ fromMaybe [] $ lookup pkg embeddedFiles cmd Shell "stack build " pkg :: Action () | pkg <- pkgs ] -- regenerate Hledger/Cli/Commands/*.txt from the .md source files for CLI help phony "cmdhelp" $ do need commandtxts when commit $ do let msg = ";doc: update CLI usage texts" cmd Shell gitcommit ("-m '"++msg++"' --") commandtxts commandtxts |%> \out -> do let src = out -<.> "md" need [src] cmd Shell pandoc fromsrcmd src "--lua-filter" "tools/pandoc-dedent-code-blocks.lua" "-t plain" ">" out -- CHANGELOGS let -- git log showing short commit hashes gitlog = "git log --abbrev-commit" -- git log formats suitable for changelogs/release notes -- %s=subject, %an=author name, %n=newline if needed, %w=width/indent1/indent2, %b=body, %h=hash changelogGitFormat = "--pretty=format:'- %s (%an)%n%w(0,2,2)%b\n'" -- changelogVerboseGitFormat = "--pretty=format:'- %s (%an)%n%w(0,2,2)%b%h' --stat" -- Format a git log message, with one of the formats above, as a changelog item changelogCleanupCmd = unwords [ sed ,"-e 's/^( )*\\* /\1- /'" -- ensure bullet lists in descriptions use hyphens not stars ,"-e 's/ \\(Simon Michael\\)//'" -- strip maintainer's author name ,"-e 's/^- (doc: *)?(updated? *)?changelogs?( *updates?)?$//'" -- strip some variants of "updated changelog" ,"-e 's/^ +\\[ci skip\\] *$//'" -- strip [ci skip] lines ,"-e 's/^ +$//'" -- replace lines containing only spaces with empty lines -- ,"-e 's/\r//'" -- strip windows carriage returns (XXX \r untested. IDEA doesn't like a real ^M here) ,"-e '/./,/^$/!d'" -- replace consecutive newlines with one ] -- Things to exclude when doing git log for project-wide changelog. -- git exclude pathspecs, https://git-scm.com/docs/gitglossary.html#gitglossary-aiddefpathspecapathspec projectChangelogExcludeDirs = unwords [ ":!hledger-lib" ,":!hledger" ,":!hledger-ui" ,":!hledger-web" ,":!tests" ] -- update all changelogs with latest commits phony "changelogs" $ do need changelogs when commit $ do let msg = ";doc: update changelogs" cmd Shell gitcommit ("-m '"++msg++"' --") changelogs -- [PKG/]CHANGES.md -- Add any new non-boring commits to the specified changelog, in -- an idempotent way, minimising manual toil, as follows. We look at: -- -- - the changelog's topmost markdown heading, which can be a -- dev heading (first word is a git revision like 4fffe6e7) or -- a release heading (first word is a release version & tag -- like 1.18.1, second word is a date like 2020-06-21) or a -- package release heading (hledger-ui-1.18.1). -- -- - the package version, in the adjacent .version file, which -- can be a dev version like 1.18.99 (first two digits of last -- part are 97, 98 or 99) or a release version like 1.18.1 -- (any other cabal-style version). -- -- The old changelog heading is removed if it was a dev heading; -- new commits in PKG not prefixed with semicolon are added; -- and a suitable new heading is added: a release heading if -- the package version looks like a release version, otherwise -- a dev heading with the current HEAD revision. -- -- With -n/--dry-run, print new content to stdout instead of -- updating the changelog. -- phonys (\out -> if out `notElem` changelogs then Nothing else Just $ do tags <- lines . fromStdout <$> (cmd Shell "git tag" :: Action (Stdout String)) oldlines <- liftIO $ lines <$> readFileStrictly out let dir = takeDirectory out mpkg | dir=="." = Nothing | otherwise = Just dir (preamble, oldheading:rest) = span isnotheading oldlines where isnotheading = not . ("#" `isPrefixOf`) -- changelog version: a hash or the last release version of this package (or the project) changelogversion = headDef err $ drop 1 $ words oldheading where err = error $ "could not parse changelog heading: "++oldheading -- prepend the package name if we are in a package (not the top-level project directory) maybePrependPackage s = maybe s (++("-"++s)) mpkg toTag = maybePrependPackage isOldRelease rev = isReleaseVersion rev && toTag rev `elem` tags isNewRelease rev = isReleaseVersion rev && toTag rev `notElem` tags -- git revision corresponding to the changelog version: -- a hash (a3f19c15), package release tag (hledger-ui-1.20), or project release tag (1.20) lastrev | isOldRelease changelogversion = toTag changelogversion -- package release tag | isNewRelease changelogversion = trace (out ++ "'s version \""++changelogversion++"\" is not yet tagged, can't list changes") "HEAD" | otherwise = changelogversion -- interesting commit messages between lastrev and HEAD, cleaned up let interestingpaths = fromMaybe projectChangelogExcludeDirs mpkg -- interestingmessages = "--invert-grep --grep '^;'" -- ignore commits beginning with ; -- TODO: update for new commit conventions. ; now means skip CI, -- feat:/imp:/fix: means release notes, pkg:/lib: means changelogs, etc. interestingmessages = "" newitems <- fromStdout <$> (cmd Shell gitlog changelogGitFormat (lastrev++"..") interestingmessages "--" interestingpaths "|" changelogCleanupCmd :: Action (Stdout String)) -- git revision of current HEAD headrev <- unwords . words . fromStdout <$> (cmd Shell gitlog "-1 --pretty=%h -- " interestingpaths :: Action (Stdout String)) -- package version: the version number currently configured for this package (or the project) packageversion <- let versionfile = dir ".version" err = error $ "could not parse a version in "++versionfile in liftIO $ headDef err . words <$> readFileStrictly versionfile date <- liftIO getCurrentDay let -- the new changelog heading will be a final (dated, versioned) heading if -- the configured package version is a new release version (non-dev & non-tagged) (newrev, newheading) | isNewRelease packageversion = (toTag packageversion, unwords [packageversion, show date]) | otherwise = (headrev, headrev) newcontent = "# "++newheading++"\n" ++ newitems newchangelog = unlines preamble ++ newcontent ++ (if isCommitHash changelogversion then "" else oldheading) ++ unlines rest liftIO $ if | lastrev == newrev -> pure () -- putStrLn $ out ++ ": up to date" | dryrun -> putStr $ out ++ ":\n" ++ newcontent | otherwise -> do writeFile out newchangelog putStrLn $ out ++ ": updated to " ++ newrev ) -- Update all program-specific docs, eg after setversion. phony "docs" $ need [ "cmdhelp" ,"manuals" ,"changelogs" ] -- Update (render) the website, which should be checked out as ./site phony "site" $ do need [ "webmanuals" ,"orgfiles" ] cmd_ "make -C site build" phony "orgfiles" $ need [ ".BACKLOG.md" ,".ROADMAP.md" ] -- These org files are converted to markdown for the website. [ ".ROADMAP.md" ,".BACKLOG.md" ] |%> \out -> do let src = drop 1 out -<.> "org" need [src] -- replace the generated top heading with our own so we can insert the TOC after it let heading = dropExtension $ drop 1 out mdlines <- drop 1 . lines . fromStdout <$> (cmd Shell pandoc fromorg towebmd src :: Action (Stdout String)) liftIO $ writeFile out $ unlines $ [ "" ,"" ,"# " ++ heading ,"" ,"
" ,"" ,"" ,"
" ,"" ] ++ mdlines -- XXX try to style backlog items as unnumbered or nested-numbered list items {- -} -- MISC -- Generate the web manuals based on the current checkout and save -- them as the specified versioned snapshot in site/doc/VER/ . -- .snapshot is a dummy file. -- "site/doc/*/.snapshot" %> \out -> do -- need webmanuals -- let snapshot = takeDirectory out -- cmd_ Shell "mkdir -p" snapshot -- forM_ webmanuals $ \f -> -- site/hledger.md, site/journal.md -- cmd_ Shell "cp" f (snapshot takeFileName f) -- cmd_ Shell "cp -r site/images" snapshot -- cmd_ Shell "touch" out -- Help: -- ,"./Shake site/doc/VERSION/.snapshot save current web manuals as this snapshot" -- Cleanup. phony "clean" $ do putNormal "Cleaning object files in tools" removeFilesAfter "tools" ["*.o","*.p_o","*.hi"] phony "Clean" $ do need ["clean"] putNormal "Cleaning shake build cache" removeFilesAfter ".shake" ["//*"] -- Convert numbered man page names to manual names. -- hledger.1 -> hledger, hledger_journal.5 -> hledger_journal manpageNameToManualName = dropNumericSuffix where dropNumericSuffix s = reverse $ case reverse s of c : '.' : cs | isDigit c -> cs cs -> cs -- Convert manual names to numbered man page names. -- hledger -> hledger.1, hledger_journal -> hledger_journal.5 manualNameToManpageName s | '_' `elem` s = s <.> "5" | otherwise = s <.> "1" dropDirectory2 = dropDirectory1 . dropDirectory1 readFileStrictly :: FilePath -> IO String readFileStrictly f = readFile f >>= \s -> C.evaluate (length s) >> return s -- Write new content to a file, only if it's different. maybeWriteFile :: FilePath -> String -> IO () maybeWriteFile f new = do old <- readFileStrictly f when (old /= new) $ writeFile f new -- | Get the current local date. getCurrentDay :: IO Day getCurrentDay = localDay . zonedTimeToLocalTime <$> getZonedTime -- | Replace each occurrence of a regular expression by this string. replaceRe :: RE -> String -> String -> String replaceRe re repl = replaceBy re (\_ _ _ -> Just repl) -- | Replace each occurrence of a regular expression, by transforming -- each matched text with the given function. replaceBy :: RE -> (Match String -> RELocation -> Capture String -> Maybe String) -> String -> String replaceBy re f src = replaceAllCaptures TOP f $ src *=~ re -- | Does this string look like a valid cabal package version ? isVersion s = not (null s) && all (`elem` "0123456789.") s && '.' `elem` s -- | Does this string look like a hledger development version ? -- Ie a version where the first two digits of the last part are the -- special values 97, 98 or 99, indicating alpha/beta/rc or whatever. isDevVersion s = isVersion s && lastpart >= "97" where lastpart = lastDef "" $ splitOn "." s -- | Does this string look like a hledger release version ? -- Ie a cabal package version that's not a hledger development version. isReleaseVersion s = isVersion s && not (isDevVersion s) -- | Does this string look like a git commit hash ? -- Ie a sequence of 7 or more numbers or letters. isCommitHash s = length s > 6 && all isAlphaNum s -- | Remove all trailing newlines/carriage returns. chomp :: String -> String chomp = reverse . dropWhile (`elem` "\r\n") . reverse