-
-
Notifications
You must be signed in to change notification settings - Fork 320
/
Shake.hs
executable file
·913 lines (805 loc) · 41.9 KB
/
Shake.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
#!/usr/bin/env stack
{- stack script --resolver nightly-2024-12-19 --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/topics/scripts
- 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: for heavier project scripting. See also Justfile"
,"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 hledger-install-version" update some version strs in hledger-install"
,"./Shake cmddocs [-c] update all hledger's COMMAND.md and COMMAND.txt files,"
," used for --help, manuals etc. (run after changing"
," COMMAND.md or command options or general options)"
,"./Shake mandates update the date shown in some manual formats"
,"./Shake manuals [-c] update the packages' embedded info/man/txt 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 -B (on its own) to force rebuilding."
,"Add -V/-VV/-VVV/-VVVV to see more verbose output."
,"Add --skip-commands to try to avoid running external commands"
,"(not a true dry run; some cmd calls may still run, code may do IO, etc)."
]
-- 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
-- setversion [VER] [PKGS] [-c]
-- Update version strings in all packages, or just the ones specified.
-- If a version number is provided as first argument, save that in .version files first.
-- Then update various source files to match what's in their nearby .version file, such as:
-- package.yaml files, .cabal files (regenerating from package.yaml), .version.m4 files.
-- With -c, also commit the changes.
-- 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: set"
,case dirargs of
[] -> "version"
ds -> intercalate ", " ds ++ " version"
,case mver of
Nothing -> ""
Just v -> "to " ++ v
]
commitIfChanged msg $ specifiedversionfiles ++ dependents
gencabalfiles
-- Update some of the version strings in hledger-install/hledger-install.sh. Manual fixup will be needed.
-- Not done by setversion since that is used on master, where the production hledger-install is.
phony "hledger-install-version" $ do
let versionfile = ".version"
let out = "hledger-install/hledger-install.sh"
version <- ((headDef (error $ "failed to read " <> versionfile) . words) <$>) $ liftIO $ readFile versionfile
cmd_ Shell sed "-i -e" ("'s/(^HLEDGER_INSTALL_VERSION)=.*/\\1='`date +%Y%m%d`'/'") out
cmd_ Shell sed "-i -e" ("'s/(^HLEDGER(|_LIB|_UI|_WEB)_VERSION)=.*/\\1="++version++"/'") out
-- PKG/.version.m4 <- PKG/.version, just updates the _version_ macro
"hledger*/.version.m4" %> \out -> do
let versionfile = takeDirectory out </> ".version"
need [versionfile]
version <- ((headDef (error $ "failed to read " <> versionfile) . 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 <- ((headDef (error $ "failed to read " <> versionfile) . 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.
-- NB you should run "Shake cmddocs" before this, it's not automatic (?)
phony "manuals" $ do
need $ concat [
nroffmanuals
,infomanuals
-- ,[infodir]
,txtmanuals
,webmanuals
]
when commit $
commitIfChanged ";doc: update embedded manuals" $
concat [commandmds, 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
-- XXX eqn complains on nonascii chars, not needed ?
-- cmd Shell "tbl" src "| eqn -Tascii | troff -Wall -mandoc -Tascii | grotty -cbuo >" out
-- XXX how to silence wide table warnings (generated by tbl, reported by troff) ?
cmd Shell "tbl" src "| 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
args' = drop 1 args
pkgs | null args' = packages
| otherwise = args'
sequence_ [ do
need $ fromMaybe [] $ lookup pkg embeddedFiles
cmd Shell "stack build " pkg :: Action ()
| pkg <- pkgs
]
-- Using the current hledger build, run all commands to update their options help in COMMAND.md,
-- then regenerate all the COMMAND.txt from COMMAND.md.
-- With -c, also commit any changes in the .md and .txt files.
-- The hledger build should up to date when running this. XXX how to check ? need ["build"] is circular
phony "cmddocs" $ do
liftIO $ putStrLn "please ensure the hledger build is up to date. Running all commands..."
need commandtxts
when commit $ commitIfChanged ";doc: update command docs" $ commandmds <> commandtxts
-- Regenerate Hledger/Cli/Commands/*.txt from the corresponding .md files,
-- after first updating the options help within those.
commandtxts |%> \out -> do
let src = out -<.> "md"
liftIO $ putStrLn ("generating " <> out)
need [src <.> "new"] -- 1. depend on phony target that updates the options help in src
need [src] -- 2. depend on the now updated src
cmd Shell
pandoc fromsrcmd src "--lua-filter" "tools/pandoc-dedent-code-blocks.lua" "-t plain" ">" out
-- -- 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.
-- -- NB hledger executables should be up to date, see cmddocs
-- phony "optdocs" $ do
-- need commandmdsnew
-- when commit $ commitIfChanged ";doc: update command flag docs" commandmds
-- hledger/Hledger/Cli/Commands/CMD.md.new: a phony target that updates the ```flags block
-- within hledger/Hledger/Cli/Commands/CMD.md with the output of "stack run -- hledger CMD --help".
-- If that fails, a warning is printed and it carries on, keeping the old options help.
-- NB this needs the hledger build to be up to date, see cmddocs.
phonys $ \out ->
if not $ "hledger/Hledger/Cli/Commands/" `isPrefixOf` out && ".md.new" `isSuffixOf` out
then Nothing
else Just $ do
let src = dropExtension out
need [src]
srcls <- fmap lines $ liftIO $ readFileStrictly src
let
(pre,rest) = break (=="```flags") srcls
(_,post) = span (/="```") rest
let cmdname = map toLower $ takeBaseName src
do
let shellcmd = "stack exec -- hledger -h " <> cmdname
-- liftIO $ putStrLn $ "running " <> shellcmd <> " to get options help"
cmdhelp <- lines . fromStdout <$> (cmd Shell shellcmd :: 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]
-- This is supposed to print the error but otherwise ignore it, making this action a no-op,
-- in case hledger is not yet built/runnable.
`actionCatch` \(e::C.IOException) -> return ()
-- XXX should somehow control the output and elide the verbose "not found on path" errors
-- let elide err
-- | "path: [" `isInfixOf` err = takeWhile (/='[') err <> "..."
-- | otherwise = err
-- in \(e::C.IOException) -> liftIO $ hPutStrLn stderr $ elide $ show e -- not used
-- CHANGELOGS
-- update all changelogs with latest commits
phony "changelogs" $ do
need changelogs
when commit $ commitIfChanged ";doc: update changelogs" changelogs
-- [PKG/]CHANGES.md [-n|--dry-run]
-- Add any new commit messages to the specified changelog, idempotently.
-- Or with -n/--dry-run, just print the new content to stdout.
-- Assumptions/requirements:
-- 1. All releases nowadays are full releases (including all four packages).
-- 2. The changelog's topmost markdown heading text is a release heading like "1.18.1 2020-06-21", or a more recent commit id like "4fffe6e7".
-- 3. When a release heading is added to a changelog, a corresponding release tag is also created.
phonys (\out -> if out `notElem` changelogs
then Nothing
else Just $ do
let
-- shell command to run git log showing short commit hashes.
-- In 2024 git is showing 9 digits, 1 more than jj - show 8 for easier interop
gitlog = "git log --abbrev=8"
-- a git log format 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"
-- shell command to format a git log message with the above format, as a changelog item
commitMessageToChangelogItemCmd = 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
]
-- Directories to exclude when doing git log for the project changelog.
-- https://git-scm.com/docs/gitglossary.html#gitglossary-aiddefpathspecapathspec
projectChangelogExcludes = unwords [
":!hledger-lib"
,":!hledger"
,":!hledger-ui"
,":!hledger-web"
,":!tests"
]
mpkg = if dir=="." then Nothing else Just dir where dir = takeDirectory out
-- Parse the changelog.
oldlines <- liftIO $ lines <$> readFileStrictly out
let
(preamble, oldheading:rest) = span isnotheading oldlines where isnotheading = not . ("#" `isPrefixOf`)
oldversion = headDef err $ drop 1 $ words oldheading
where err = error $ "could not parse changelog heading: "++oldheading
-- Find the latest commit that has been scanned for this changelog, as a commit id or tag name.
lastscannedrev
| isCommitHash oldversion = oldversion
| otherwise = maybe oldversion (++("-"++oldversion)) mpkg
-- Find the latest commit (HEAD).
latestrev <- unwords . words . fromStdout <$> (cmd Shell gitlog "-1 --pretty=%h" :: Action (Stdout String))
-- If it's newer,
when (lastscannedrev /= latestrev) $ do
-- Find the new commit messages relevant to this changelog, and clean them.
let scanpath = fromMaybe projectChangelogExcludes mpkg
newitems <- fromStdout <$> (cmd Shell
"set -o pipefail;" -- so git log failure will cause this action to fail
gitlog changelogGitFormat (lastscannedrev++"..") "--" scanpath
"|" commitMessageToChangelogItemCmd
:: Action (Stdout String))
-- Add the new heading and change items to the changelog, or print them.
let newcontent = "# " ++ latestrev ++ "\n" ++ newitems
liftIO $ if dryrun
then putStr $ out ++ ":\n" ++ newcontent
else do
writeFile out $ concat [
unlines preamble
,newcontent
,if isCommitHash oldversion then "" else oldheading
,unlines rest
]
putStrLn (out ++ ": updated to " ++ latestrev)
)
-- 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"
]
cmd_ "make -C site build"
-- Markdown generated from org files, 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 for \"" ++ 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