diff --git a/Shake.hs b/Shake.hs index 378ca4c44..4346e3e5b 100755 --- a/Shake.hs +++ b/Shake.hs @@ -116,6 +116,8 @@ towebmd = "-t markdown-smart-fenced_divs-fenced_code_attributes-simple_tables-mu main = do + -- 1. gather some IO values used by rules + -- hledger manual also includes the markdown files from here: let commandsdir = "hledger/Hledger/Cli/Commands" commandmds <- @@ -126,557 +128,576 @@ main = do let sitedir = "site" pages <- map takeBaseName . filter (".md" `isSuffixOf`) <$> S.getDirectoryContents sitedir - shakeArgs - shakeOptions - { + args <- getArgs + let args2 = drop 1 args + + -- 2. define the shake rules + + let + rules :: Rules () + rules = do + + want ["help"] + + phony "help" $ liftIO $ putStrLn usage + + phony "all" $ need ["commandhelp", "manuals", "build"] --, "website"] + + -- phony "compile" $ need ["Shake"] + -- "Shake" %> \out -> do + -- need [out <.> "hs"] + -- unit $ cmd "./Shake.hs" -- running as stack script installs deps and compiles + -- putLoud "You can now run ./Shake instead of ./Shake.hs" + + + -- NAMES, FILES, URIS.. + + let + -- main package names, in standard build order + packages = [ + "hledger-lib" + ,"hledger" + ,"hledger-ui" + ,"hledger-web" + ] + + changelogs = "CHANGES.md" : map ( "CHANGES.md") 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" + ,"hledger_journal.5" + ,"hledger_csv.5" + ,"hledger_timeclock.5" + ,"hledger_timedot.5" + ] + + -- 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] + + -- manuals as sphinx-ready markdown, to be rendered as part of the website (hledger/hledger.webmanual.md) + webmanuals = [manualDir m m <.> "webmanual.md" | m <- manualNames] + + -- -- latest version of the manuals rendered to html (site/_site/hledger.html) + -- htmlmanuals = ["site/_site" manpageNameToWebManualName m <.> "html" | m <- manpageNames] + + -- -- 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 html for website pages kept in the main repo + -- mainpageshtml = map (normalise . ("site/_site" ) . (<.> "html")) pages + + -- TODO: make website URIs lower-case ? + + -- extensions of static web asset files, to be copied to the website + -- webassetexts = ["png", "gif", "cur", "js", "css", "eot", "ttf", "woff", "svg"] + + -- 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" + + -- MANUALS + + -- Generate the manuals in plain text, nroff, info, and markdown formats. + phony "manuals" $ need $ + "commandhelp" : + concat [ + nroffmanuals + ,infomanuals + ,txtmanuals + ,webmanuals + ] + + -- Generate nroff man pages suitable for man output, from the .m4.md source. + phony "nroffmanuals" $ need nroffmanuals + nroffmanuals |%> \out -> do -- hledger/hledger.1 + let src = manpageNameToManualName out <.> "m4.md" + commonm4 = "doc/common.m4" + dir = takeDirectory out + packagem4 = dir "defs.m4" + tmpl = "doc/manpage.nroff" + -- assume all other m4 files in dir are included by this one XXX not true in hledger-lib + deps <- liftIO $ filter (/= src) . filter (".m4.md" `isSuffixOf`) . map (dir ) <$> S.getDirectoryContents dir + need $ [src, commonm4, packagem4, tmpl] ++ deps + when (dir=="hledger") $ need commandmds + cmd Shell + "m4 -P -DMAN -I" dir commonm4 packagem4 src "|" + pandoc fromsrcmd "-s" "--template" tmpl + "--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. + 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. + phony "infomanuals" $ need infomanuals + infomanuals |%> \out -> do -- hledger/hledger.info + let src = out -<.> "m4.md" + commonm4 = "doc/common.m4" + dir = takeDirectory out + packagem4 = dir "defs.m4" + -- assume all other m4 files in dir are included by this one XXX not true in hledger-lib + deps <- liftIO $ filter (/= src) . filter (".m4.md" `isSuffixOf`) . map (dir ) <$> S.getDirectoryContents dir + need $ [src, commonm4, packagem4] ++ deps + when (dir=="hledger") $ need commandmds + cmd Shell + "m4 -P -DINFO -I" dir commonm4 packagem4 src "|" + 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" + "-t texinfo |" + makeinfo "--force --no-split -o" out + + + -- 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.webmanual.md, hledger-lib/journal.webmanual.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" + packagem4 = dir "defs.m4" + heading = let h = manual + in if "hledger_" `isPrefixOf` h + then drop 8 h ++ " format" + else h + -- assume any other m4 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, packagem4] ++ 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 -P -DWEB -I" dir commonm4 packagem4 src "|" + pandoc fromsrcmd towebmd + "--lua-filter tools/pandoc-demote-headers.lua" + ">>" out + + -- Copy some extra markdown files from the main repo into the site + -- TODO adding table of contents placeholders + -- [ + -- -- "site/README.md", + -- -- "site/CONTRIBUTING.md" + -- ] |%> \out -> + -- copyFile' (dropDirectory1 out) out -- XXX (map toLower out) + + -- WEBSITE HTML & ASSETS + + -- phony "website" $ need [ + -- "webassets" + -- -- ,"mainpages" + -- -- ,"htmlmanuals" + -- ] + + -- phony "website-all" $ need [ + -- "website" + -- -- ,"oldmanuals" + -- ] + + -- -- copy all static asset files (files with certain extensions + -- -- found under sites, plus one or two more) to sites/_site/ + -- phony "webassets" $ do + -- assets <- getDirectoryFiles "site" (map ("//*" <.>) webassetexts) + -- need [ "site/_site" file + -- | file <- assets ++ [ + -- "files/README" + -- ] + -- , not ("_site//*" ?== file) + -- ] + + -- copy any one of the static asset files to sites/_site/ + -- "site/_site/files/README" : [ "site/_site//*" <.> ext | ext <- webassetexts ] |%> \out -> do + -- copyFile' ("site" dropDirectory2 out) out + + -- render all web pages from the main repo (manuals, home, download, relnotes etc) as html, saved in site/_site/ + -- phony "mainpages" $ need mainpageshtml + + -- phony "htmlmanuals" $ need htmlmanuals + + -- phony "oldmanuals" $ need oldhtmlmanuals + + -- Render one website page as html, saved in sites/_site/. + -- Github-style wiki links will be hyperlinked. + -- "site/_site//*.html" %> \out -> do + -- let filename = takeBaseName out + -- pagename = fileNameToPageName filename + -- isdownloadpage = filename == "download" + -- isoldmanual = "site/_site/doc/" `isPrefixOf` out + -- source + -- | isoldmanual = "site" (drop 11 $ dropExtension out) <.> "md" + -- | otherwise = "site" filename <.> "md" + -- template = "site/site.tmpl" + -- siteRoot = if "site/_site/doc//*" ?== out then "../.." else "." + -- need [source, template] + -- -- read markdown source, link any wikilinks, pipe it to pandoc, write html out + -- Stdin . wikiLink <$> (readFile' source) >>= + -- (cmd Shell pandoc "-" fromsrcmd "-t html" + -- "--template" template + -- ("--metadata=siteRoot:" ++ siteRoot) + -- ("--metadata=\"title:" ++ pagename ++ "\"") + -- "-o" 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. + + -- -- update the live site based on all latest content + -- need [ "website-all" ] + + -- HLEDGER PACKAGES/EXECUTABLES + + phony "build" $ need packages + + -- build any of the hledger packages, after generating any doc + -- files they embed or import. + sequence_ [ phony pkg $ do + need $ fromMaybe [] $ lookup pkg embeddedFiles + cmd Shell "stack build " pkg + | pkg <- packages ] + + phony "commandhelp" $ need 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'" + -- 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" $ need changelogs + + -- show the changelogs updates that would be written + -- phony "changelogs-dry" $ need changelogsdry + + -- [PKG/]CHANGES.md[-dry] <- git log + -- Add commits to the specified changelog since the tag/commit in + -- the topmost heading, also removing that previous heading if it + -- was an interim heading (a commit hash). Or (the -dry variants) + -- just print the new changelog items to stdout without saving. + phonys (\out' -> if + | not $ out' `elem` (changelogs ++ map (++"-dry") changelogs) -> Nothing + | otherwise -> Just $ do + let (out, dryrun) | "-dry" `isSuffixOf` out' = (take (length out' - 4) out', True) + | otherwise = (out', False) + old <- liftIO $ lines <$> readFileStrictly out + + let dir = takeDirectory out + pkg | dir=="." = Nothing + | otherwise = Just dir + gitlogpaths = fromMaybe projectChangelogExcludeDirs pkg + isnotheading = not . ("#" `isPrefixOf`) + iscommithash s = length s > 6 && all isAlphaNum s + (preamble, oldheading:rest) = span isnotheading old + lastversion = words oldheading !! 1 + lastrev | iscommithash lastversion = lastversion + | otherwise = fromMaybe "hledger" pkg ++ "-" ++ lastversion + excludeboring = "--invert-grep --grep '^;'" -- ignore commits beginning with ; + + headrev <- unwords . words . fromStdout <$> + (cmd Shell gitlog "-1 --pretty=%h -- " gitlogpaths :: Action (Stdout String)) + + if headrev == lastrev + then liftIO $ putStrLn $ out ++ ": up to date" + else do + newitems <- fromStdout <$> + (cmd Shell gitlog changelogGitFormat (lastrev++"..") excludeboring "--" gitlogpaths + "|" changelogCleanupCmd :: Action (Stdout String)) + let newcontent = "# "++headrev++"\n\n" ++ newitems + newfile = unlines $ concat [ + preamble + ,[newcontent] + ,if iscommithash lastrev then [] else [oldheading] + ,rest + ] + liftIO $ if dryrun + then putStr newcontent + else do + writeFile out newfile + putStrLn $ out ++ ": updated to " ++ headrev + ) + + -- [PKG/]CHANGES.md-finalise <- PKG/.version + -- Converts the specified changelog's topmost heading, if it is an + -- interim heading (a commit hash), to a permanent heading + -- containing the intended release version (from .version) and + -- today's date. For the project CHANGES.md, the version number + -- in hledger/.version is used. + phonys (\out' -> let suffix = "-finalise" in if + | not $ out' `elem` (map (++suffix) changelogs) -> Nothing + | otherwise -> Just $ do + let + out = take (length out' - length suffix) out' + versiondir = case takeDirectory out of + "." -> "hledger" + d -> d + versionfile = versiondir ".version" + need [versionfile] + version <- ((head . words) <$>) $ liftIO $ readFile versionfile + old <- liftIO $ readFileStrictly out + date <- liftIO getCurrentDay + let (before, _:after) = break ("# " `isPrefixOf`) $ lines old + new = unlines $ before ++ ["# "++version++" "++show date] ++ after + liftIO $ do + writeFile out new + putStrLn $ out ++ ": updated to " ++ version + ) + + -- VERSION NUMBERS + + -- Given the desired version string saved in PKG/.version, update + -- it everywhere needed in the package. See also CONTRIBUTING.md > + -- Version numbers. + + let inAllPackages f = map ( f) packages + + phony "setversion" $ need $ + inAllPackages "defs.m4" + ++ inAllPackages "package.yaml" + + -- PKG/defs.m4 <- PKG/.version + "hledger*/defs.m4" %> \out -> do + let versionfile = takeDirectory out ".version" + need [versionfile] + version <- ((head . words) <$>) $ liftIO $ readFile versionfile + date <- liftIO getCurrentDay + let manualdate = formatTime defaultTimeLocale "%B %Y" date + cmd_ Shell sed "-i -e" ( + "'s/(_version_}}, *)\\{\\{[^}]+/\\1{{"++version++"/;" + ++" s/(_monthyear_}}, *)\\{\\{[^}]+/\\1{{"++manualdate++"/;" + ++"'") + out + + -- PKG/package.yaml <- PKG/.version + "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 -> 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 + + -- 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" ["//*"] + + -- 3. run the shake rule selected by the first command line argument, + -- leaving the other args for the rule to use + + let + opts = shakeOptions{ shakeVerbosity=Quiet -- ,shakeReport=[".shake.html"] } - $ do - want ["help"] + runWithArgs :: Rules () -> [a] -> [String] -> IO (Maybe (Rules ())) + runWithArgs rules _flags args = pure $ Just $ + case args of + [] -> rules + (a:_) -> want [a] >> withoutActions rules - phony "help" $ liftIO $ putStrLn usage - - phony "all" $ need ["commandhelp", "manuals", "build"] --, "website"] - - -- phony "compile" $ need ["Shake"] - -- "Shake" %> \out -> do - -- need [out <.> "hs"] - -- unit $ cmd "./Shake.hs" -- running as stack script installs deps and compiles - -- putLoud "You can now run ./Shake instead of ./Shake.hs" - - - -- NAMES, FILES, URIS.. - - let - -- main package names, in standard build order - packages = [ - "hledger-lib" - ,"hledger" - ,"hledger-ui" - ,"hledger-web" - ] - - changelogs = "CHANGES.md" : map ( "CHANGES.md") 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" - ,"hledger_journal.5" - ,"hledger_csv.5" - ,"hledger_timeclock.5" - ,"hledger_timedot.5" - ] - - -- 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] - - -- manuals as sphinx-ready markdown, to be rendered as part of the website (hledger/hledger.webmanual.md) - webmanuals = [manualDir m m <.> "webmanual.md" | m <- manualNames] - - -- -- latest version of the manuals rendered to html (site/_site/hledger.html) - -- htmlmanuals = ["site/_site" manpageNameToWebManualName m <.> "html" | m <- manpageNames] - - -- -- 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 html for website pages kept in the main repo - -- mainpageshtml = map (normalise . ("site/_site" ) . (<.> "html")) pages - - -- TODO: make website URIs lower-case ? - - -- extensions of static web asset files, to be copied to the website - -- webassetexts = ["png", "gif", "cur", "js", "css", "eot", "ttf", "woff", "svg"] - - -- 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" - - -- MANUALS - - -- Generate the manuals in plain text, nroff, info, and markdown formats. - phony "manuals" $ need $ - "commandhelp" : - concat [ - nroffmanuals - ,infomanuals - ,txtmanuals - ,webmanuals - ] - - -- Generate nroff man pages suitable for man output, from the .m4.md source. - phony "nroffmanuals" $ need nroffmanuals - nroffmanuals |%> \out -> do -- hledger/hledger.1 - let src = manpageNameToManualName out <.> "m4.md" - commonm4 = "doc/common.m4" - dir = takeDirectory out - packagem4 = dir "defs.m4" - tmpl = "doc/manpage.nroff" - -- assume all other m4 files in dir are included by this one XXX not true in hledger-lib - deps <- liftIO $ filter (/= src) . filter (".m4.md" `isSuffixOf`) . map (dir ) <$> S.getDirectoryContents dir - need $ [src, commonm4, packagem4, tmpl] ++ deps - when (dir=="hledger") $ need commandmds - cmd Shell - "m4 -P -DMAN -I" dir commonm4 packagem4 src "|" - pandoc fromsrcmd "-s" "--template" tmpl - "--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. - 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. - phony "infomanuals" $ need infomanuals - infomanuals |%> \out -> do -- hledger/hledger.info - let src = out -<.> "m4.md" - commonm4 = "doc/common.m4" - dir = takeDirectory out - packagem4 = dir "defs.m4" - -- assume all other m4 files in dir are included by this one XXX not true in hledger-lib - deps <- liftIO $ filter (/= src) . filter (".m4.md" `isSuffixOf`) . map (dir ) <$> S.getDirectoryContents dir - need $ [src, commonm4, packagem4] ++ deps - when (dir=="hledger") $ need commandmds - cmd Shell - "m4 -P -DINFO -I" dir commonm4 packagem4 src "|" - 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" - "-t texinfo |" - makeinfo "--force --no-split -o" out - - - -- 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.webmanual.md, hledger-lib/journal.webmanual.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" - packagem4 = dir "defs.m4" - heading = let h = manual - in if "hledger_" `isPrefixOf` h - then drop 8 h ++ " format" - else h - -- assume any other m4 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, packagem4] ++ 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 -P -DWEB -I" dir commonm4 packagem4 src "|" - pandoc fromsrcmd towebmd - "--lua-filter tools/pandoc-demote-headers.lua" - ">>" out - - -- Copy some extra markdown files from the main repo into the site - -- TODO adding table of contents placeholders - -- [ - -- -- "site/README.md", - -- -- "site/CONTRIBUTING.md" - -- ] |%> \out -> - -- copyFile' (dropDirectory1 out) out -- XXX (map toLower out) - - -- WEBSITE HTML & ASSETS - - -- phony "website" $ need [ - -- "webassets" - -- -- ,"mainpages" - -- -- ,"htmlmanuals" - -- ] - - -- phony "website-all" $ need [ - -- "website" - -- -- ,"oldmanuals" - -- ] - - -- -- copy all static asset files (files with certain extensions - -- -- found under sites, plus one or two more) to sites/_site/ - -- phony "webassets" $ do - -- assets <- getDirectoryFiles "site" (map ("//*" <.>) webassetexts) - -- need [ "site/_site" file - -- | file <- assets ++ [ - -- "files/README" - -- ] - -- , not ("_site//*" ?== file) - -- ] - - -- copy any one of the static asset files to sites/_site/ - -- "site/_site/files/README" : [ "site/_site//*" <.> ext | ext <- webassetexts ] |%> \out -> do - -- copyFile' ("site" dropDirectory2 out) out - - -- render all web pages from the main repo (manuals, home, download, relnotes etc) as html, saved in site/_site/ - -- phony "mainpages" $ need mainpageshtml - - -- phony "htmlmanuals" $ need htmlmanuals - - -- phony "oldmanuals" $ need oldhtmlmanuals - - -- Render one website page as html, saved in sites/_site/. - -- Github-style wiki links will be hyperlinked. - -- "site/_site//*.html" %> \out -> do - -- let filename = takeBaseName out - -- pagename = fileNameToPageName filename - -- isdownloadpage = filename == "download" - -- isoldmanual = "site/_site/doc/" `isPrefixOf` out - -- source - -- | isoldmanual = "site" (drop 11 $ dropExtension out) <.> "md" - -- | otherwise = "site" filename <.> "md" - -- template = "site/site.tmpl" - -- siteRoot = if "site/_site/doc//*" ?== out then "../.." else "." - -- need [source, template] - -- -- read markdown source, link any wikilinks, pipe it to pandoc, write html out - -- Stdin . wikiLink <$> (readFile' source) >>= - -- (cmd Shell pandoc "-" fromsrcmd "-t html" - -- "--template" template - -- ("--metadata=siteRoot:" ++ siteRoot) - -- ("--metadata=\"title:" ++ pagename ++ "\"") - -- "-o" 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. - - -- -- update the live site based on all latest content - -- need [ "website-all" ] - - -- HLEDGER PACKAGES/EXECUTABLES - - phony "build" $ need packages - - -- build any of the hledger packages, after generating any doc - -- files they embed or import. - sequence_ [ phony pkg $ do - need $ fromMaybe [] $ lookup pkg embeddedFiles - cmd Shell "stack build " pkg - | pkg <- packages ] - - phony "commandhelp" $ need 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'" - -- 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" $ need changelogs - - -- show the changelogs updates that would be written - -- phony "changelogs-dry" $ need changelogsdry - - -- [PKG/]CHANGES.md[-dry] <- git log - -- Add commits to the specified changelog since the tag/commit in - -- the topmost heading, also removing that previous heading if it - -- was an interim heading (a commit hash). Or (the -dry variants) - -- just print the new changelog items to stdout without saving. - phonys (\out' -> if - | not $ out' `elem` (changelogs ++ map (++"-dry") changelogs) -> Nothing - | otherwise -> Just $ do - let (out, dryrun) | "-dry" `isSuffixOf` out' = (take (length out' - 4) out', True) - | otherwise = (out', False) - old <- liftIO $ lines <$> readFileStrictly out - - let dir = takeDirectory out - pkg | dir=="." = Nothing - | otherwise = Just dir - gitlogpaths = fromMaybe projectChangelogExcludeDirs pkg - isnotheading = not . ("#" `isPrefixOf`) - iscommithash s = length s > 6 && all isAlphaNum s - (preamble, oldheading:rest) = span isnotheading old - lastversion = words oldheading !! 1 - lastrev | iscommithash lastversion = lastversion - | otherwise = fromMaybe "hledger" pkg ++ "-" ++ lastversion - excludeboring = "--invert-grep --grep '^;'" -- ignore commits beginning with ; - - headrev <- unwords . words . fromStdout <$> - (cmd Shell gitlog "-1 --pretty=%h -- " gitlogpaths :: Action (Stdout String)) - - if headrev == lastrev - then liftIO $ putStrLn $ out ++ ": up to date" - else do - newitems <- fromStdout <$> - (cmd Shell gitlog changelogGitFormat (lastrev++"..") excludeboring "--" gitlogpaths - "|" changelogCleanupCmd :: Action (Stdout String)) - let newcontent = "# "++headrev++"\n\n" ++ newitems - newfile = unlines $ concat [ - preamble - ,[newcontent] - ,if iscommithash lastrev then [] else [oldheading] - ,rest - ] - liftIO $ if dryrun - then putStr newcontent - else do - writeFile out newfile - putStrLn $ out ++ ": updated to " ++ headrev - ) - - -- [PKG/]CHANGES.md-finalise <- PKG/.version - -- Converts the specified changelog's topmost heading, if it is an - -- interim heading (a commit hash), to a permanent heading - -- containing the intended release version (from .version) and - -- today's date. For the project CHANGES.md, the version number - -- in hledger/.version is used. - phonys (\out' -> let suffix = "-finalise" in if - | not $ out' `elem` (map (++suffix) changelogs) -> Nothing - | otherwise -> Just $ do - let - out = take (length out' - length suffix) out' - versiondir = case takeDirectory out of - "." -> "hledger" - d -> d - versionfile = versiondir ".version" - need [versionfile] - version <- ((head . words) <$>) $ liftIO $ readFile versionfile - old <- liftIO $ readFileStrictly out - date <- liftIO getCurrentDay - let (before, _:after) = break ("# " `isPrefixOf`) $ lines old - new = unlines $ before ++ ["# "++version++" "++show date] ++ after - liftIO $ do - writeFile out new - putStrLn $ out ++ ": updated to " ++ version - ) - - -- VERSION NUMBERS - - -- Given the desired version string saved in PKG/.version, update - -- it everywhere needed in the package. See also CONTRIBUTING.md > - -- Version numbers. - - let inAllPackages f = map ( f) packages - - phony "setversion" $ need $ - inAllPackages "defs.m4" - ++ inAllPackages "package.yaml" - - -- PKG/defs.m4 <- PKG/.version - "hledger*/defs.m4" %> \out -> do - let versionfile = takeDirectory out ".version" - need [versionfile] - version <- ((head . words) <$>) $ liftIO $ readFile versionfile - date <- liftIO getCurrentDay - let manualdate = formatTime defaultTimeLocale "%B %Y" date - cmd_ Shell sed "-i -e" ( - "'s/(_version_}}, *)\\{\\{[^}]+/\\1{{"++version++"/;" - ++" s/(_monthyear_}}, *)\\{\\{[^}]+/\\1{{"++manualdate++"/;" - ++"'") - out - - -- PKG/package.yaml <- PKG/.version - "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 -> 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 - - -- 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" ["//*"] + -- shakeArgsWith :: ShakeOptions -> [OptDescr (Either String a)] -> ([a] -> [String] -> IO (Maybe (Rules ()))) -> IO () + shakeArgsWith opts [] (runWithArgs rules) -- Convert numbered man page names to manual names.