diff --git a/bin/hledger-chart.hs b/bin/hledger-chart.hs index f86667138..f653e6141 100755 --- a/bin/hledger-chart.hs +++ b/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 { diff --git a/bin/hledger-check-dates.hs b/bin/hledger-check-dates.hs index e2e34d23a..3967f0976 100755 --- a/bin/hledger-check-dates.hs +++ b/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 () diff --git a/bin/hledger-dupes.hs b/bin/hledger-dupes.hs index 2227c3d0d..d8afac29d 100755 --- a/bin/hledger-dupes.hs +++ b/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 diff --git a/bin/hledger-equity.hs b/bin/hledger-equity.hs index 99ca61967..7527b4531 100755 --- a/bin/hledger-equity.hs +++ b/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 () diff --git a/bin/hledger-prices.hs b/bin/hledger-prices.hs index fe23f3f6d..dbabfaacc 100755 --- a/bin/hledger-prices.hs +++ b/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 diff --git a/bin/hledger-print-unique.hs b/bin/hledger-print-unique.hs index fb291c16a..61dd5cdae 100755 --- a/bin/hledger-print-unique.hs +++ b/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 diff --git a/bin/hledger-register-match.hs b/bin/hledger-register-match.hs index cd82eac34..31d2320ab 100755 --- a/bin/hledger-register-match.hs +++ b/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 diff --git a/bin/hledger-rewrite.hs b/bin/hledger-rewrite.hs index 19923e1c9..eebc05bbe 100755 --- a/bin/hledger-rewrite.hs +++ b/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 diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 222acd219..b05ea5dca 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/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 = [ diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 1822b66d9..0110ff9d3 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/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