cli, addons: reduce boilerplate a little with hledgerCommandMode helper

bin/hledger-chart.hs

@@ -43,28 +43,20 @@ defchartitems    = 10
 defchartsize     = "600x400"
 
 ------------------------------------------------------------------------------
-cmdmode :: Mode RawOpts
-cmdmode = (defAddonCommandMode "hledger-chart") {
-   modeHelp = [here|
-generate a pie chart for the top account balances with the same sign,
+cmdmode = hledgerCommandMode
+  [here| chart
+Generate a pie chart for the top account balances with the same sign,
 in SVG format.
  
 Based on the old hledger-chart package, this is not yet useful.
 It's supposed to show only balances of one sign, but this might be broken.
   |]
-  ,modeHelpSuffix=lines [here|
-  |]
-  ,modeGroupFlags = Group {
-     groupNamed = [generalflagsgroup1]
-    ,groupUnnamed = [
-         flagReq ["chart-output","o"]  (\s opts -> Right $ setopt "chart-output" s opts) "IMGFILE" ("output filename (default: "++defchartoutput++")")
-        ,flagReq ["chart-items"]  (\s opts -> Right $ setopt "chart-items" s opts) "N" ("number of accounts to show (default: "++show defchartitems++")")
-        ,flagReq ["chart-size"]  (\s opts -> Right $ setopt "chart-size" s opts) "WIDTHxHEIGHT" ("image size (default: "++defchartsize++")")
-        ]
-    ,groupHidden = []
-    }
-  ,modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT  AMTEXPR\" ...")
-  }
+  [flagReq ["chart-output","o"]  (\s opts -> Right $ setopt "chart-output" s opts) "IMGFILE" ("output filename (default: "++defchartoutput++")")
+  ,flagReq ["chart-items"]  (\s opts -> Right $ setopt "chart-items" s opts) "N" ("number of accounts to show (default: "++show defchartitems++")")
+  ,flagReq ["chart-size"]  (\s opts -> Right $ setopt "chart-size" s opts) "WIDTHxHEIGHT" ("image size (default: "++defchartsize++")")
+  ]  [generalflagsgroup1]
+  []
+  ([], Just $ argsFlag "[QUERY]")
 ------------------------------------------------------------------------------
 
 data ChartOpts = ChartOpts {

bin/hledger-check-dates.hs

@@ -13,24 +13,19 @@ import Hledger.Cli
 import Text.Printf
 
 ------------------------------------------------------------------------------
-cmdmode = 
-  let m = defAddonCommandMode "check-dates"
-  in m {
-   modeHelp = [here|
+cmdmode = hledgerCommandMode
+  [here| check-dates
 Check that transactions' dates are monotonically increasing.
 With --date2, checks secondary dates instead.
 With --strict, dates must also be unique.
 With a query, only matched transactions' dates are checked.
 Reads the default journal file, or another specified with -f.
+FLAGS
   |]
-  ,modeHelpSuffix=lines [here|
-  |]
-  ,modeGroupFlags = (modeGroupFlags m) {
-     groupUnnamed = [
-      flagNone ["strict"] (\opts -> setboolopt "strict" opts) "makes date comparing strict"
-     ]
-  }
-  }
+  [flagNone ["strict"] (\opts -> setboolopt "strict" opts) "makes date comparing strict"]
+  [generalflagsgroup1]
+  []
+  ([], Just $ argsFlag "[QUERY]")
 ------------------------------------------------------------------------------
 
 main :: IO ()

bin/hledger-dupes.hs

@@ -19,8 +19,8 @@ import Data.String.Here
 import qualified Data.Text as T
 
 ------------------------------------------------------------------------------
-cmdmode = (defAddonCommandMode "dupes") {
-   modeHelp = [here|
+cmdmode = hledgerCommandMode
+  [here| dupes
 Reports duplicates in the account tree: account names having the same leaf
 but different prefixes. In other words, two or more leaves that are
 categorized differently.
@@ -28,9 +28,10 @@ Reads the default journal file, or another specified as an argument.
  
 http://stefanorodighiero.net/software/hledger-dupes.html
   |]
-  ,modeHelpSuffix=lines [here|
-  |]
-  }
+  []
+  [generalflagsgroup1]
+  []
+  ([], Nothing)
 ------------------------------------------------------------------------------
 
 main = do

bin/hledger-equity.hs

@@ -16,18 +16,16 @@ import Hledger.Cli
 
 ------------------------------------------------------------------------------
 cmdmode :: Mode RawOpts
-cmdmode = (defAddonCommandMode "equity") {
-   modeHelp = [here|
-   
+cmdmode = hledgerCommandMode
+  [here| equity
 Print a "closing balances" transaction that brings all accounts (or with
 query arguments, just the matched accounts) to a zero balance, followed by an
 opposite "opening balances" transaction that restores the balances from zero.
 Such transactions can be useful, eg, for bringing account balances across
 file boundaries.
 
-  |]
-  ,modeHelpSuffix=lines [here|
-  
+FLAGS
+
 The opening balances transaction is useful to carry over
 asset/liability balances if you choose to start a new journal file,
 eg at the beginning of the year.
@@ -57,10 +55,11 @@ Open question: how to handle txns spanning a file boundary ? Eg:
 ```
 This command might or might not have some connection to the concept of
 "closing the books" in accounting.
-
   |]
-  ,modeArgs = ([], Just $ argsFlag "[QUERY]")
-  }
+  []
+  [generalflagsgroup1]
+  []
+  ([], Just $ argsFlag "[QUERY]")
 ------------------------------------------------------------------------------
 
 main :: IO ()

bin/hledger-prices.hs

@@ -14,21 +14,14 @@ import Control.Monad
 import Hledger.Cli
 
 ------------------------------------------------------------------------------
-cmdmode =
-  let m = defAddonCommandMode "hledger-prices"
-  in m {
-   modeHelp = [here|
+cmdmode = hledgerCommandMode
+  [here| prices
 Print all prices from the journal.
   |]
-  ,modeHelpSuffix=lines [here|
-  |]
-  ,modeArgs = ([], Nothing)
-  ,modeGroupFlags = (modeGroupFlags m) {
-     groupUnnamed = [
-      flagNone ["costs"] (setboolopt "costs") "print transaction prices from postings instead of market prices"
-     ]
-  }
-  }
+  [flagNone ["costs"] (setboolopt "costs") "print transaction prices from postings instead of market prices"]
+  [generalflagsgroup1]
+  []
+  ([], Nothing)
 ------------------------------------------------------------------------------
 
 showPrice :: MarketPrice -> String

bin/hledger-print-unique.hs

@@ -13,11 +13,11 @@ import Data.String.Here
 import Hledger.Cli
 
 ------------------------------------------------------------------------------
-cmdmode = (defAddonCommandMode "print-unique") {
-   modeHelp = [here|
+cmdmode = hledgerCommandMode
+  [here| print-unique
 Remove transactions which reuse an already-seen description.
-  |]
-  ,modeHelpSuffix=lines [here|
+
+FLAGS
 
 Example:
 ```shell
@@ -31,9 +31,11 @@ $ LEDGER_FILE=unique.journal hledger print-unique
 2015/01/01 test
     (acct:one)             1
 ```
-
   |]
-  }
+  []
+  [generalflagsgroup1]
+  []
+  ([], Nothing)
 ------------------------------------------------------------------------------
 
 main = do

bin/hledger-register-match.hs

@@ -21,16 +21,17 @@ import Hledger.Cli.CliOptions
 import Hledger.Cli ( withJournalDo, postingsReportAsText )
 
 ------------------------------------------------------------------------------
-cmdmode = (defAddonCommandMode "register-match") {
-   modeHelp = [here|
+cmdmode = hledgerCommandMode
+  [here| register-match
 A helper for ledger-autosync. This prints the one posting whose transaction
 description is closest to DESC, in the style of the register command.
 If there are multiple equally good matches, it shows the most recent.
 Query options (options, not arguments) can be used to restrict the search space.
   |]
-  ,modeHelpSuffix=lines [here|
-  |]
-  }
+  []
+  [generalflagsgroup1]
+  []
+  ([], Nothing)
 ------------------------------------------------------------------------------
 
 main = do

bin/hledger-rewrite.hs

@@ -26,16 +26,12 @@ import qualified Data.Algorithm.Diff as D
 import Hledger.Data.AutoTransaction (runModifierTransaction)
 
 ------------------------------------------------------------------------------
-cmdmode = 
-  let m = (defAddonCommandMode "hledger-rewrite")
-  in m {
-   modeHelp = [here|
-
+cmdmode = hledgerCommandMode
+  [here| rewrite
 Print all transactions, adding custom postings to the matched ones.
 
-  |]
-  ,modeHelpSuffix=lines [here|
-  
+FLAGS
+
 This is a start at a generic rewriter of transaction entries.
 It reads the default journal and prints the transactions, like print,
 but adds one or more specified postings to any transactions matching QUERY.
@@ -153,24 +149,19 @@ See also:
 https://github.com/simonmichael/hledger/issues/99
 
   |]
-  ,modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT  AMTEXPR\" ...")
-  ,modeGroupFlags = (modeGroupFlags m) {
-    groupUnnamed = [
-       flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT  AMTEXPR'"
-               "add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR."
-      ,flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool"
-      ]
-    }
-  }
+  [flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT  AMTEXPR'"
+           "add a posting to ACCT, which may be parenthesised. AMTEXPR is either a literal amount, or *N which means the transaction's first matched amount multiplied by N (a decimal number). Two spaces separate ACCT and AMTEXPR."
+  ,flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool"
+  ]
+  [generalflagsgroup1]
+  []
+  ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT  AMTEXPR\" ...")
 ------------------------------------------------------------------------------
 
 -- TODO regex matching and interpolating matched name in replacement
 -- TODO interpolating match groups in replacement
 -- TODO allow using this on unbalanced entries, eg to rewrite while editing
 
-outputflags :: [Flag RawOpts]
-outputflags = [flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool"]
-
 main :: IO ()
 main = do
   opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getHledgerCliOpts cmdmode

hledger/Hledger/Cli/CliOptions.hs

@@ -20,7 +20,8 @@ module Hledger.Cli.CliOptions (
   generalflagsgroup3,
   defMode,
   defCommandMode,
-  defAddonCommandMode,
+  quickAddonCommandMode,
+  hledgerCommandMode,
   argsFlag,
   showModeUsage,
   withAliases,
@@ -206,11 +207,13 @@ defCommandMode names = defMode {
   ,modeValue=[("command", headDef "" names)]
   }
 
--- | A cmdargs mode suitable for a hledger add-on command with the given name.
+-- | A cmdargs mode representing the hledger add-on command with the given name.
 -- Like defCommandMode, but adds a appropriate short help message if the addon name
 -- is recognised, and includes hledger's common input/reporting/help flags as default.
-defAddonCommandMode :: Name -> Mode RawOpts
-defAddonCommandMode name = (defCommandMode [name]) {
+-- Just used by hledger for generating the commands list I think (or possibly for
+-- invoking the addons as well ?)
+quickAddonCommandMode :: Name -> Mode RawOpts
+quickAddonCommandMode name = (defCommandMode [name]) {
    modeHelp = fromMaybe "" $ lookup (stripAddonExtension name) standardAddonsHelp
   ,modeGroupFlags = Group {
       groupUnnamed = []
@@ -219,6 +222,50 @@ defAddonCommandMode name = (defCommandMode [name]) {
      }
   }
 
+-- | A template for a command's CLI help, influencing the content and layout
+-- of the usage text generated by a cmdargs mode. 
+-- It is a multiline string structured like so:
+-- The first line defines the command name (first word) and aliases (any other words). 
+-- From the second line up to a line containing just "FLAGS", or the end, is the preamble,
+-- displayed above the flags list generated by cmdargs. Short help goes here.
+-- Any lines after the FLAGS line are the postamble, displayed below the flags list.
+-- Long help/full manual goes here.
+type HelpTemplate = String
+
+-- | Parse a help template into command names, help preamble, and help postamble lines.
+parseHelpTemplate :: HelpTemplate -> Maybe ([Name], String, [String])
+parseHelpTemplate t =
+  case lines t of
+    [] -> Nothing
+    (l:ls) -> Just (names, preamble, postamblelines)
+      where
+        names = words l
+        (preamblels, postamblels) = break (== "FLAGS") ls
+        preamble = unlines $ reverse $ dropWhile null $ reverse preamblels
+        postamblelines = dropWhile null $ drop 1 postamblels
+
+-- | Build a cmdarg mode suitable for a hledger add-on command,
+-- from a help template and flag/argument specifications.
+-- Reduces boilerplate a little, though the complicated cmdargs
+-- flag and argument specs are still required.
+-- See the addons in bin/ for examples of usage.
+hledgerCommandMode :: HelpTemplate -> [Flag RawOpts] -> [(Help, [Flag RawOpts])] 
+  -> [Flag RawOpts] -> ([Arg RawOpts], Maybe (Arg RawOpts)) -> Mode RawOpts
+hledgerCommandMode tmpl ungroupedflags groupedflags hiddenflags args =
+  case parseHelpTemplate tmpl of
+    Nothing -> error' $ "Could not parse help template:\n"++tmpl++"\n"
+    Just (names, preamble, postamblelines) ->
+      (defCommandMode names) {
+         modeHelp = preamble
+        ,modeHelpSuffix = postamblelines
+        ,modeGroupFlags = Group {
+            groupUnnamed = ungroupedflags
+           ,groupNamed   = groupedflags
+           ,groupHidden  = hiddenflags
+           }
+        ,modeArgs = args
+        }
+
 -- | Built-in descriptions for some of the known addons.
 standardAddonsHelp :: [(String,String)]
 standardAddonsHelp = [

hledger/Hledger/Cli/Main.hs

@@ -99,7 +99,7 @@ mainmode addons = defMode {
        ])
      ]
      ++ case addons of [] -> []
-                       cs -> [("\nAdd-on commands", map defAddonCommandMode cs)]
+                       cs -> [("\nAdd-on commands", map quickAddonCommandMode cs)]
     -- modes in the unnamed group, shown first without a heading:
    ,groupUnnamed = [
         helpmode