simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-11-07 21:15:19 +03:00
Code Issues Projects Releases Wiki Activity
91d5308783
hledger/Shake.hs
Simon Michael 91d5308783 ;tools: Shake cmdhelp -> cmddocs, now runs hledger to update flag docs 
Now, updating a command's docs (for hledger manual and for --help) requires
running the command (with stack exec -- hledger). The sequence is now
a bit recursive:

1. Run hledger CMD -h to update CMD.md with the latest cmdargs help output for CMD's flags.
   CMD.md is included in the hledger manual, when rendering that.
2. Convert CMD.md to CMD.txt, with pandoc.
3. Build hledger, embedding CMD.txt for cmdargs to use as -h output.

This need only be done after changing command docs or flags, and
hopefully won't be a hassle. Shake cmddocs now shows progress output
to make things clearer.
2024-06-07 14:35:31 -07:00

926 lines
42 KiB
Haskell
Executable File
Raw Blame History

#!/usr/bin/env stack
{- stack script --resolver nightly-2024-05-01 --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
Heavy project scripts, with file dependencies, using https://shakebuild.com.
See also justfile, Makefile.
Also uses tools like:
- hpack (same version that's in current stack release)
- GNU date (on mac, get it with brew install coreutils)
- pandoc, groff, m4, makeinfo, 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 Debug.Trace
-- import "hledger-lib" Hledger.Utils.Debug
usage =
let scriptname = "Shake" in replaceRe [re|/Shake|] ('/':scriptname) $
unlines
---------------------------------------79--------------------------------------
["Shake: heavy project scripting. See also: justfile, Makefile"
,"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 flagdocs [-c] update flags in hledger CLI command docs
-- ," (run after changing command flags)"
,"./Shake cmddocs [-c] update hledger CLI command help and docs"
," (run after changing command flags or docs)"
,"./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 -cASCII_PUNCTUATION=1 --no-split --force --no-warn --no-validate" -- silence makeinfo warnings, comment these to see them
pandoc = "pandoc --strip-comments"
-- 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 <-
sort . filter (not . ("README." `isPrefixOf`) . takeFileName) . filter (".md" `isSuffixOf`) . map (commandsdir </>)
<$> S.getDirectoryContents commandsdir
let
commandmdsnew = map (<.> "new") commandmds
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 $ commitIfChanged ";cabal: update cabal files" 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
]
commitIfChanged 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 && <B
-- >=A && <B
-- b. We set
-- the new lower bound to: this package's new version, V
-- the new upper bound if any, to: the next major version after V
-- both of which may not be what's desired.
-- c. We convert > 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 && <UPPER
let
pat = "(hledger(-[a-z]+)?) *>=? *"++versionre++" *&& *< *"++versionre++" *$"
rpl = "\\1 >="++version++" \\&\\& <"++nextmajorversion -- This was a beast. These ampersands must be backslash-escaped.
arg = "'s/"++pat++"/"++rpl++"/'"
cmd_ Shell sed "-i -e" arg out
let pkg = takeDirectory out
when (pkg /= "hledger-lib") $ liftIO $ do
putStrLn $ out++": hledger bounds are (improve if needed):"
cmd_ Shell grep "'^ *- +hledger.*[<>=]'" 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 $
commitIfChanged ";doc: update manuals" $
concat [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 [
"<!-- " ++ "Generated by \"Shake webmanuals\" from " ++ unwords deps ++ " -->"
,"<div class=\"docversions\"></div>"
,""
,"# " ++ heading
,""
,"<div class=\"pagetoc manual\">"
,""
,"<!-- toc -->"
,"</div>"
,""
]
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
]
-- Update each Hledger/Cli/Commands/*.md, replacing the flags block with latest --help output,
-- or a placeholder if there are no command-specific flags.
-- For hledger manual and also for cmddocs below.
phony "flagdocs" $ do
need commandmdsnew
when commit $ commitIfChanged ";doc: update command flag docs" commandmds
-- hledger/Hledger/Cli/Commands/CMD.md.new: updates the command-specific flags help
-- within hledger/Hledger/Cli/Commands/CMD.md. Runs "stack exec -- hledger CMD -h".
phonys $ \out ->
if not $ ".md.new" `isSuffixOf` out
then Nothing
else Just $ do
let src = dropExtension out
need [src]
liftIO $ putStrLn ("running hledger, updating flags in " <> src)
srcls <- fmap lines $ liftIO $ readFileStrictly src
let
(pre,rest) = break (=="```flags") srcls
(_,post) = span (/="```") rest
let cmdname = map toLower $ takeBaseName src
cmdhelp <- lines . fromStdout <$> (cmd Shell $ "stack exec -- hledger -h " <> cmdname :: Action (Stdout String))
let
cmdflagshelp = takeWhile (not.null) $ dropWhile (/="Flags:") cmdhelp
cmdflagshelp'
| null cmdflagshelp = ["Flags:","no command-specific flags"]
| otherwise = cmdflagshelp
liftIO $ writeFile src $ unlines $ concat [pre, ["```flags"], cmdflagshelp', post]
-- Regenerate Hledger/Cli/Commands/*.txt, rendering the corresponding .md files as plain text.
-- Also updates cmddocs first.
-- For commands' --help output.
phony "cmddocs" $ do
need commandtxts
when commit $ commitIfChanged ";doc: update help" commandtxts
commandtxts |%> \out -> do
let src = out -<.> "md"
liftIO $ putStrLn ("generating " <> out)
need [src <.> "new"] -- 1. update flags doc in src
need [src] -- 2. depend on 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 $ commitIfChanged ";doc: update changelogs" 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 [
"cmddocs"
,"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 [
-- "doc/BACKLOG.md"
]
-- These org files are converted to markdown for the website.
[ -- "doc/BACKLOG.md"
] |%> \out -> do
let src = out -<.> "org"
need [src]
-- replace the generated top heading with our own so we can insert the TOC after it
let heading = dropExtension out
mdlines <- drop 1 . lines . fromStdout <$> (cmd Shell pandoc fromorg towebmd src :: Action (Stdout String))
liftIO $ writeFile out $ unlines $ [
"<!-- " ++ "Generated by \"Shake " ++ out ++ " from " ++ src ++ " -->"
,""
,"# " ++ heading
,""
,"<div class=\"pagetoc\">"
,""
,"<!-- toc -->"
,"</div>"
,""
] ++ mdlines
-- XXX try to style backlog items as unnumbered or nested-numbered list items
{-
<style>
main>ol {
list-style: none;
padding-inline-start: 1em;
counter-reset: item;
}
/* XXX when there are subitems, pandoc wraps all in a <p>,
* which forces a line break after the :before text
*/
main>ol>li:before {
content: counters(item, ".") ". ";
counter-increment: item;
}
*/
main>ol>li {
}
</style>
-}
-- 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" ["//*"]
-- Git commit the given files with the given message if they have changes,
-- otherwise print a no change message and continue.
commitIfChanged msg files = do
diffs <- (/=ExitSuccess) . fromExit <$> cmd Shell "git diff --no-ext-diff --quiet --exit-code --" files
if diffs
then cmd Shell ("git commit -m '"++msg++"' --") files
else liftIO $ putStrLn $ "nothing to commit (\"" ++ msg ++ "\")"
-- 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
Reference in New Issue View Git Blame Copy Permalink