hledger/Shake.hs

811 lines
32 KiB
Haskell
Raw Normal View History

#!/usr/bin/env stack
2018-03-31 04:43:28 +03:00
{- stack exec
--verbosity=info
--package base-prelude
--package directory
--package extra
--package regex
--package safe
--package shake
--package time
ghc
-}
{-
2016-10-28 21:15:10 +03:00
2019-03-06 06:21:45 +03:00
One of two project scripts files (Makefile, Shake.hs). This one
provides a stronger programming language and more platform
independence than Make. It requires stack and will auto-install the
haskell packages above when needed (on first run or when a new
resolver is configured in stack.yaml). Some rules below use additional
tools, including:
2016-10-28 21:15:10 +03:00
- groff
- m4
- makeinfo
- pandoc
- sed
- GNU date (on mac: brew install coreutils)
2016-10-28 21:15:10 +03:00
2019-03-06 06:21:45 +03:00
Compiling this script is recommended, to ensure required packages are
installed, minimise startup delay, and reduce sensitivity to the
current git state (eg when bisecting). To compile, run "./Shake.hs".
(Or "make Shake", or any other make rule depending on Shake).
2016-12-31 01:32:43 +03:00
2019-03-06 06:21:45 +03:00
Once compiled, run ./Shake without any arguments to list commands and
targets (see below).
2019-03-06 06:21:45 +03:00
When developing/troubleshooting this script, these are useful:
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 website
view rule dependency graph:
./Shake --report, open report.html?mode=rule-graph&query=!name(/(doc%7Cimages%7Cjs%7Ccss%7Cfonts%7Ctime%7Capi%7Cui%7Ccsv)/)
2019-01-20 01:49:20 +03:00
2016-10-28 21:15:10 +03:00
-}
{-# 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:
2018-03-31 04:43:28 +03:00
import "directory" System.Directory as S (getDirectoryContents)
import "extra" Data.List.Extra
import "process" System.Process
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
2019-01-20 01:49:20 +03:00
-- import "hledger-lib" Hledger.Utils.Debug
2016-10-28 21:15:10 +03:00
usage = unlines
---------------------------------------79--------------------------------------
2016-10-28 21:15:10 +03:00
["Usage:"
,"./Shake.hs (re)compile this script"
,"./Shake commandhelp build embedded help texts for the hledger CLI"
,"./Shake manuals build txt/man/info/html manuals for all packages"
,"./Shake oldmanuals build old versions of html manuals for all packages"
,"./Shake PKG build a single hledger package and its embedded docs"
,"./Shake build build all hledger packages and their embedded docs"
,"./Shake website build the website and web manuals"
,"./Shake website-all build the website and all web manual versions"
,"./Shake all build all the above"
,"./Shake hledgerorg update the hledger.org website (when run on prod)"
2019-01-20 01:49:20 +03:00
,""
,"./Shake mainpages build the web pages from the main repo"
,"./Shake wikipages build the web pages from the wiki repo"
-- ,"./Shake site/index.md update wiki links on the website home page"
,"./Shake FILE build any individual file"
,"./Shake setversion update all packages from PKG/.version"
,"./Shake changelogs update the changelogs with any new commits"
,"./Shake [PKG/]CHANGES.md[-dry] update or preview this changelog"
,"./Shake [PKG/]CHANGES.md-finalise set final release heading in this changelog"
,"./Shake site/doc/VERSION/.snapshot save current web manuals as this snapshot"
2019-01-20 01:49:20 +03:00
,""
,"./Shake clean clean help texts, manuals, staged site content"
,"./Shake Clean also clean rendered site, object files, Shake's cache"
,"./Shake [help] show these commands"
,"./Shake --help show Shake options (--color, --rebuild, ...)"
,""
,"See also: make help"
2016-10-28 21:15:10 +03:00
]
2019-01-20 00:14:33 +03:00
groff = "groff"
2019-01-20 02:16:08 +03:00
makeinfo = "makeinfo"
pandoc = "pandoc"
-- Must support both BSD sed and GNU sed. Tips:
-- BSD:
-- use [a-z] [0-9] instead of \w \d etc.
-- GNU:
-- backslash-escape {
sed = "sed -E"
2019-01-20 02:16:08 +03:00
-- The kind of markdown used in our doc source files.
fromsrcmd = "-f markdown-smart-tex_math_dollars"
2019-01-20 02:16:08 +03:00
-- The kind of markdown we like to generate for the website.
towebmd = "-t markdown-smart-fenced_divs --atx-headers"
main = do
-- 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
let wikidir = "wiki"
wikipagefilenames <- map dropExtension . filter (".md" `isSuffixOf`) <$> S.getDirectoryContents wikidir
shakeArgs
shakeOptions
{
shakeVerbosity=Quiet
-- ,shakeReport=[".shake.html"]
}
$ do
want ["help"]
phony "help" $ liftIO $ putStrLn usage
phony "all" $ need ["commandhelp", "manuals", "build", "website"]
2019-01-20 01:49:20 +03:00
-- 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
-- documentation versions shown on the website
docversions = [ "0.27", "1.0" , "1.1" , "1.2" , "1.3" , "1.4" , "1.5" , "1.9", "1.10", "1.11", "1.12", "1.13", "1.14" ]
2019-01-20 01:49:20 +03:00
-- main package names, in standard build order
packages = [
"hledger-lib"
,"hledger"
,"hledger-ui"
,"hledger-web"
,"hledger-api"
]
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"])
]
2019-01-20 01:49:20 +03:00
-- man page names (manual names plus a man section number), in suggested reading order
manpageNames = [
"hledger.1"
,"hledger-ui.1"
,"hledger-web.1"
,"hledger-api.1"
,"hledger_journal.5"
,"hledger_csv.5"
2016-04-13 07:10:02 +03:00
,"hledger_timeclock.5"
,"hledger_timedot.5"
]
2017-01-26 17:40:50 +03:00
2019-01-20 01:49:20 +03:00
-- basic manual names, without numbers
2017-12-07 05:16:35 +03:00
manualNames = map manpageNameToManualName manpageNames
2019-01-20 01:49:20 +03:00
-- 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]
2017-12-07 05:16:35 +03:00
-- manuals rendered to nroff, ready for man (hledger/hledger.1)
2019-01-20 01:49:20 +03:00
nroffmanuals = [manpageDir m </> m | m <- manpageNames]
2017-01-26 17:40:50 +03:00
2019-01-20 01:49:20 +03:00
-- manuals rendered to plain text, ready for embedding (hledger/hledger.txt)
txtmanuals = [manualDir m </> m <.> "txt" | m <- manualNames]
2017-01-26 17:40:50 +03:00
2017-12-07 05:16:35 +03:00
-- manuals rendered to info, ready for info (hledger/hledger.info)
2019-01-20 01:49:20 +03:00
infomanuals = [manualDir m </> m <.> "info" | m <- manualNames]
-- individual manuals rendered to markdown, ready for conversion to html (site/hledger.md)
mdmanuals = ["site" </> manpageNameToUri m <.> "md" | m <- manpageNames]
-- latest version of the manuals rendered to html
htmlmanuals = ["site/_site" </> manpageNameToUri m <.> "html" | m <- manpageNames++["manual"]]
-- old versions of the manuals rendered to html
oldhtmlmanuals = map (normalise . ("site/_site/doc" </>) . (<.> "html")) $
[ v </> manpageNameToUri 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")) [
-- from site/*.md
"contributors"
,"download"
,"ledgertips"
,"index"
,"intro"
,"release-notes"
-- some copied from elsewhere
,"README"
,"CONTRIBUTING"
]
2017-01-26 17:40:50 +03:00
-- the html for website pages kept in the wiki repo (cookbook content)
wikipageshtml = map (normalise . ("site/_site" </>) . (<.> ".html")) wikipagefilenames
-- TODO: make website URIs lower-case ?
-- manuals rendered to markdown and combined, ready for web rendering
mdcombinedmanual = "site/manual.md"
2019-01-20 01:49:20 +03:00
-- extensions of static web asset files, to be copied to the website
webassetexts = ["png", "gif", "cur", "js", "css", "eot", "ttf", "woff", "svg"]
2019-01-20 01:49:20 +03:00
-- The directory in which to find this man page.
-- hledger.1 -> hledger/doc, hledger_journal.5 -> hledger-lib/doc
manpageDir m
2017-12-07 05:16:35 +03:00
| '_' `elem` m = "hledger-lib"
| otherwise = dropExtension m
2019-01-20 01:49:20 +03:00
-- The directory in which to find this manual.
2017-12-07 05:16:35 +03:00
-- hledger -> hledger, hledger_journal -> hledger-lib
manualDir m
| '_' `elem` m = "hledger-lib"
| otherwise = m
2019-01-20 01:49:20 +03:00
-- The URI corresponding to this man page.
-- hledger.1 -> hledger, hledger_journal.5 -> journal
manpageNameToUri m | "hledger_" `isPrefixOf` m = dropExtension $ drop 8 m
| otherwise = dropExtension m
2019-01-20 01:49:20 +03:00
-- The man page corresponding to this URI.
-- hledger -> hledger.1, journal -> hledger_journal.5
manpageUriToName u | "hledger" `isPrefixOf` u = u <.> "1"
| otherwise = "hledger_" ++ u <.> "5"
-- MANUALS
2019-01-20 01:49:20 +03:00
-- Generate the manuals in nroff, plain text and info formats.
phony "manuals" $ need $ concat [
nroffmanuals
,infomanuals
,txtmanuals
,htmlmanuals
]
2019-01-20 01:49:20 +03:00
-- Generate nroff man pages suitable for man output.
phony "nroffmanuals" $ need nroffmanuals
2019-01-20 01:49:20 +03:00
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 "|"
2019-01-20 02:16:08 +03:00
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
2019-01-20 01:49:20 +03:00
-- Generate plain text manuals suitable for embedding in
-- executables and viewing with a pager.
phony "txtmanuals" $ need txtmanuals
txtmanuals |%> \out -> do -- hledger/hledger.txt
2017-12-07 07:53:36 +03:00
let src = manualNameToManpageName $ dropExtension out
need [src]
cmd Shell groff "-t -e -mandoc -Tascii" src "| col -bx >" out -- http://www.tldp.org/HOWTO/Man-Page/q10.html
2019-01-20 01:49:20 +03:00
-- Generate Info manuals suitable for viewing with info.
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"
2016-04-19 03:54:55 +03:00
-- 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
2016-04-19 03:54:55 +03:00
cmd Shell
"m4 -P -I" dir commonm4 packagem4 src "|"
2019-01-20 02:16:08 +03:00
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"
2016-04-19 03:54:55 +03:00
"-t texinfo |"
makeinfo "--force --no-split -o" out
2019-01-20 01:49:20 +03:00
-- WEBSITE MARKDOWN SOURCE
2019-01-20 01:49:20 +03:00
-- Generate the individual web manuals' markdown source, using m4
-- and pandoc to tweak content.
phony "mdmanuals" $ need mdmanuals
mdmanuals |%> \out -> do -- site/hledger.md
let manpage = manpageUriToName $ dropExtension $ takeFileName out -- hledger
manual = manpageNameToManualName manpage
dir = manpageDir manpage
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 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 (manual=="hledger") $ need commandmds
2016-04-09 23:36:48 +03:00
liftIO $ writeFile out $ "# " ++ heading ++ "\n\n"
cmd Shell
"m4 -P -DMAN -DWEB -I" dir commonm4 packagem4 src "|"
2019-01-20 02:16:08 +03:00
pandoc fromsrcmd towebmd
"--lua-filter tools/pandoc-demote-headers.lua"
2016-04-09 23:36:48 +03:00
">>" out
2019-01-20 01:49:20 +03:00
-- Generate the combined web manual's markdown source, by
-- concatenating tweaked versions of the individual manuals.
phony "mdcombinedmanual" $ need [ mdcombinedmanual ]
mdcombinedmanual %> \out -> do
need mdmanuals
liftIO $ writeFile mdcombinedmanual $ addToc ""
forM_ mdmanuals $ \f -> do -- site/hledger.md, site/journal.md
cmd_ Shell ("printf '\\n\\n' >>") mdcombinedmanual
2019-02-10 04:49:28 +03:00
cmd_ Shell pandoc f towebmd
"--lua-filter tools/pandoc-drop-toc.lua"
"--lua-filter tools/pandoc-demote-headers.lua"
">>" mdcombinedmanual
2019-01-20 04:31:03 +03:00
-- 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)
2019-01-20 01:49:20 +03:00
-- WEBSITE HTML & ASSETS
2019-02-10 04:49:28 +03:00
phony "website" $ need [
"webassets"
,"mainpages"
,"wikipages"
,"htmlmanuals"
]
phony "website-all" $ need [
"website"
,"oldmanuals"
2019-02-10 04:49:28 +03:00
]
2019-01-20 01:49:20 +03:00
-- 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
2019-01-20 01:49:20 +03:00
| file <- assets ++ [
"files/README"
]
, not ("_site//*" ?== file)
]
2019-01-20 01:49:20 +03:00
-- 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
-- embed the wiki's latest table of contents into the main site's home page
"site/index.md" %> \out -> do
wikicontent <- dropWhile (not . ("#" `isPrefixOf`)) . lines <$> readFile' "wiki/Home.md"
old <- liftIO $ readFileStrictly "site/index.md"
let (startmarker, endmarker) = ("<!-- WIKICONTENT -->", "<!-- ENDWIKICONTENT -->")
(before, after') = break (startmarker `isPrefixOf`) $ lines old
(_, after) = break (endmarker `isPrefixOf`) $ after'
new = unlines $ concat [before, [startmarker], wikicontent, after]
liftIO $ writeFile out new
-- render all web pages from the main repo (manuals, home, download, relnotes etc) as html, saved in site/_site/
phony "mainpages" $ need mainpageshtml
-- render all pages from the wiki as html, saved in site/_site/.
-- We assume there are no filename collisions with mainpages.
phony "wikipages" $ need wikipageshtml
2018-04-28 06:23:14 +03:00
phony "htmlmanuals" $ need htmlmanuals
phony "oldmanuals" $ need oldhtmlmanuals
-- Render one website page (main or wiki) as html, saved in sites/_site/.
-- Wiki pages will have a heading and TOC placeholder prepended.
-- All pages will have github-style wiki links hyperlinked.
"site/_site//*.html" %> \out -> do
let filename = takeBaseName out
pagename = fileNameToPageName filename
iswikipage = filename `elem` wikipagefilenames
isoldmanual = "site/_site/doc/" `isPrefixOf` out
source
| iswikipage = "wiki" </> filename <.> "md"
| 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, maybe add a heading and TOC, pipe it to pandoc, write html out
Stdin . wikiLink . (if iswikipage then addHeading pagename . addToc else id) <$> (readFile' source) >>=
(cmd Shell pandoc "-" fromsrcmd "-t html"
"--template" template
("--metadata=siteRoot:" ++ siteRoot)
("--metadata=\"title:" ++ pagename ++ "\"")
"--lua-filter=tools/pandoc-toc.lua"
"-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 or wiki repos 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 wiki repo
"&& printf 'wiki repo: ' && git -C wiki pull"
-- pull latest main repo - sometimes already done by webhook, not always
"&& printf 'main repo: ' && git pull"
-- Shake.hs might have been updated, but we won't execute the
-- new one, too insecure. Continue with this one.
-- update wiki links on website front page
need [ "site/index.md" ]
-- if it changed, commit (and push) it.
-- XXX the push will cause another webhook invocation of this script, try to avoid
cmd_ Shell
"git diff --quiet -- site/index.md"
"|| ("
"git commit -m ';site: update cookbook links' -m '[ci skip]' site/index.md"
"&& git push"
")"
-- 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
2019-01-20 01:49:20 +03:00
-- 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"
,":!hledger-api"
,":!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
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++"..") "--" 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 writeFile out newfile
)
-- [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 $ writeFile out new
)
-- 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
2019-02-05 22:56:51 +03:00
cmd_ Shell sed "-i -e" ("'s/(_version_}}, *)\\{\\{[^}]+/\\1{{"++version++"/'") 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 && <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
-- tagrelease: \
-- $(call def-help,tagrelease, commit a release tag based on $(VERSIONFILE) for each package )
-- for p in $(PACKAGES); do git tag -f $$p-$(VERSION); done
2019-01-20 01:49:20 +03:00
-- 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 $ mdcombinedmanual : mdmanuals
2019-01-20 01:49:20 +03:00
let snapshot = takeDirectory out
2019-02-10 04:49:28 +03:00
cmd_ Shell "mkdir -p" snapshot
forM_ mdmanuals $ \f -> -- site/hledger.md, site/journal.md
2019-02-10 04:49:28 +03:00
cmd_ Shell "cp" f (snapshot </> takeFileName f)
cmd_ Shell "cp" "site/manual.md" snapshot
cmd_ Shell "cp -r site/images" snapshot
cmd_ Shell "touch" out
2016-04-06 01:40:59 +03:00
-- Cleanup.
phony "clean" $ do
-- putNormal "Cleaning generated help texts, manuals, staged site content"
-- removeFilesAfter "." commandtxts
putNormal "Cleaning generated manuals, staged site content"
removeFilesAfter "." mdmanuals
removeFilesAfter "." [mdcombinedmanual]
removeFilesAfter "." ["site/README.md", "site/CONTRIBUTING.md"]
phony "Clean" $ do
need ["clean"]
putNormal "Cleaning generated site content, object files, shake build cache"
removeFilesAfter "site" ["_*"]
removeFilesAfter "tools" ["*.o","*.p_o","*.hi"]
removeFilesAfter "site" ["*.o","*.p_o","*.hi"]
2016-04-13 06:32:01 +03:00
removeFilesAfter ".shake" ["//*"]
2019-01-20 00:14:33 +03:00
2019-01-20 01:49:20 +03:00
-- 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"
2019-01-20 00:14:33 +03:00
dropDirectory2 = dropDirectory1 . dropDirectory1
readFileStrictly :: FilePath -> IO String
readFileStrictly f = readFile f >>= \s -> C.evaluate (length s) >> return s
-- | Get the current local date.
getCurrentDay :: IO Day
getCurrentDay = do
t <- getZonedTime
return $ localDay (zonedTimeToLocalTime t)
-- markdown helpers
type Markdown = String
-- | Prepend a markdown heading.
addHeading :: String -> Markdown -> Markdown
addHeading h = (("# "++h++"\n\n")++)
-- | Prepend a table of contents placeholder.
addToc :: Markdown -> Markdown
addToc = ((tocMarker++"\n\n")++)
where tocMarker = "$TOC$"
-- | Convert Github-style wikilinks to hledger website links.
wikiLink :: Markdown -> Markdown
wikiLink =
replaceBy wikilinkre wikilinkReplace .
replaceBy labelledwikilinkre labelledwikilinkReplace
-- regex stuff
-- couldn't figure out how to use match subgroups, so we don't
-- wikilinkre = [re|\[\[$([^]]+)]]|] -- [[A]]
-- labelledwikilinkre = [re|\[\[$([^(|)]+)\|$([^]]*)\]\]|] -- [[A|B]]
wikilinkre = [re|\[\[[^]]+]]|] -- [[A]]
labelledwikilinkre = [re|\[\[[^(|)]+\|[^]]*\]\]|] -- [[A|B]]. The | is parenthesised to avoid ending the quasiquoter
-- wikilinkReplace _ loc@RELocation{locationCapture} cap@Capture{capturedText} =
wikilinkReplace _ _ Capture{capturedText} =
-- trace (show (loc,cap)) $
Just $ "["++name++"]("++uri++")"
where
name = init $ init $ drop 2 capturedText
uri = pageNameToUri name
-- labelledwikilinkReplace _ loc@RELocation{locationCapture} cap@Capture{capturedText} =
labelledwikilinkReplace _ _ Capture{capturedText} =
Just $ "["++label++"]("++uri++")"
where
[label,name] = take 2 $ (splitOn "|" $ init $ init $ drop 2 capturedText) ++ [""]
uri = pageNameToUri name
pageNameToUri = (++".html") . intercalate "-" . words
fileNameToPageName = unwords . splitOn "-"
-- | Easier regex replace helper. Replaces each occurrence of a
-- regular expression in src, by transforming each matched text with
-- the given function.
replaceBy re f src = replaceAllCaptures TOP f $ src *=~ re
-- not powerful enough, saved for reference:
-- wikify = (*=~/ wikilinkreplace) . (*=~/ labelledwikilinkreplace)
-- where
-- -- [[A]] -> [A](.../A)
-- wikilinkreplace :: SearchReplace RE String
-- wikilinkreplace = [ed|\[\[$([^]]+)]]///[$1]($1.html)|]
-- -- [[A|B]] -> [A](.../B)
-- labelledwikilinkreplace :: SearchReplace RE String
-- labelledwikilinkreplace = [ed|\[\[$([^(|)]+)\|$([^]]*)\]\]///[$1]($2.html)|]