slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

addons, doc: a new help scheme, more automated and usable

Browse Source 
The previous cleanup defined long help separately from the usage text
generated by cmdargs. This meant keeping flag descriptions synced
between the two, and also the short help was often too verbose and
longer than the long help.

Now, the non-usage bits of long help are defined as pre and postambles
within the cmdargs mode, letting cmdargs generate the long help
including all flags. We derive the short help from this by truncating
at the start of the hledger common flags.

Most of the bundled addons (all but hledger-budget) now use the
new scheme and have pretty reasonable -h and --help output.
We can do more to reduce boilerplate for addon authors.
This commit is contained in:
Simon Michael 2017-01-24 08:59:22 -08:00
parent f4eb9e23e3
commit daf6732368
8 changed files with 192 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
bin/hledger-chart.hs
View File

@ -38,38 +38,22 @@ import Text.Printf
import Hledger import Hledger
import Hledger.Cli hiding (progname,progversion) import Hledger.Cli hiding (progname,progversion)
doc = [here|
Usage:
```
$ hledger-chart [FILE]
Generates primitive pie charts of account balances, in SVG format.
...common hledger options...
```
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.
Copyright (c) 2007-2017 Simon Michael <simon@joyful.com>
Released under GPL version 3 or later.
|]
-- options
-- progname = "hledger-chart"
-- progversion = progname ++ " dev"
defchartoutput = "hledger.svg" defchartoutput = "hledger.svg"
defchartitems = 10 defchartitems = 10
defchartsize = "600x400" defchartsize = "600x400"
chartmode :: Mode RawOpts ------------------------------------------------------------------------------
chartmode = (defAddonCommandMode "hledger-chart") { cmdmode :: Mode RawOpts
modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...") cmdmode = (defAddonCommandMode "hledger-chart") {
,modeHelp = "generate a pie chart image for the top account balances (of one sign only)" modeHelp = [here|
,modeHelpSuffix=[] 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 { ,modeGroupFlags = Group {
groupNamed = [generalflagsgroup1] groupNamed = [generalflagsgroup1]
,groupUnnamed = [ ,groupUnnamed = [
@ -79,7 +63,9 @@ chartmode = (defAddonCommandMode "hledger-chart") {
] ]
,groupHidden = [] ,groupHidden = []
} }
,modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...")
} }
------------------------------------------------------------------------------
data ChartOpts = ChartOpts { data ChartOpts = ChartOpts {
chart_output_ :: FilePath chart_output_ :: FilePath
@ -96,7 +82,7 @@ defchartopts = ChartOpts
getHledgerChartOpts :: IO ChartOpts getHledgerChartOpts :: IO ChartOpts
getHledgerChartOpts = do getHledgerChartOpts = do
cliopts <- getHledgerOptsOrShowHelp chartmode doc cliopts <- getHledgerCliOpts cmdmode
return defchartopts { return defchartopts {
chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" $ rawopts_ cliopts chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" $ rawopts_ cliopts
,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" $ rawopts_ cliopts ,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" $ rawopts_ cliopts
@ -104,8 +90,6 @@ getHledgerChartOpts = do
,cliopts_ = cliopts ,cliopts_ = cliopts
} }
-- main
main :: IO () main :: IO ()
main = do main = do
chopts <- getHledgerChartOpts chopts <- getHledgerChartOpts

91
bin/hledger-check-dates.hs
View File

@ -13,66 +13,29 @@ import Hledger.Cli
import Text.Printf import Text.Printf
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
doc = [here| cmdmode =
let m = defAddonCommandMode "check-dates"
$ hledger-check-dates -h in m {
check-dates [OPTIONS] [ARGS] modeHelp = [here|
check that transactions' date are monotonically increasing Check that transactions' dates are monotonically increasing.
With --date2, checks secondary dates instead.
Flags:
--strict makes date comparing strict
...common hledger options...
With --strict, dates must also be unique. With --strict, dates must also be unique.
With --date2, checks transactions' secondary dates. With a query, only matched transactions' dates are checked.
Reads the default journal file, or another specified with -f. Reads the default journal file, or another specified with -f.
|]
|] ,modeHelpSuffix=lines [here|
------------------------------------------------------------------------------ |]
,modeGroupFlags = (modeGroupFlags m) {
argsmode :: Mode RawOpts groupUnnamed = [
argsmode = (defAddonCommandMode "check-dates")
{ modeHelp = "check that transactions' date are monotonically increasing"
, modeGroupFlags = Group
{ groupNamed =
[ ("Input",inputflags)
, ("Reporting",reportflags)
, ("Misc",helpflags)
]
,groupUnnamed = [
flagNone ["strict"] (\opts -> setboolopt "strict" opts) "makes date comparing strict" flagNone ["strict"] (\opts -> setboolopt "strict" opts) "makes date comparing strict"
] ]
, groupHidden = []
}
} }
}
data FoldAcc a b = FoldAcc ------------------------------------------------------------------------------
{ fa_error :: Maybe a
, fa_previous :: Maybe b
}
foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b
foldWhile _ acc [] = acc
foldWhile fold acc (a:as) =
case fold a acc of
acc@FoldAcc{fa_error=Just _} -> acc
acc -> foldWhile fold acc as
checkTransactions :: (Transaction -> Transaction -> Bool)
-> [Transaction] -> FoldAcc Transaction Transaction
checkTransactions compare ts =
foldWhile fold FoldAcc{fa_error=Nothing, fa_previous=Nothing} ts
where
fold current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}
fold current acc@FoldAcc{fa_previous=Just previous} =
if compare previous current
then acc{fa_previous=Just current}
else acc{fa_error=Just current}
main :: IO () main :: IO ()
main = do main = do
opts <- getHledgerOptsOrShowHelp argsmode doc opts <- getHledgerCliOpts cmdmode
withJournalDo opts $ withJournalDo opts $
\CliOpts{rawopts_=opts,reportopts_=ropts} j -> do \CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
d <- getCurrentDay d <- getCurrentDay
@ -100,3 +63,27 @@ main = do
(show $ date error) (show $ date error)
(show $ tsourcepos error) (show $ tsourcepos error)
(showTransactionUnelided error) (showTransactionUnelided error)
data FoldAcc a b = FoldAcc
{ fa_error :: Maybe a
, fa_previous :: Maybe b
}
foldWhile :: (a -> FoldAcc a b -> FoldAcc a b) -> FoldAcc a b -> [a] -> FoldAcc a b
foldWhile _ acc [] = acc
foldWhile fold acc (a:as) =
case fold a acc of
acc@FoldAcc{fa_error=Just _} -> acc
acc -> foldWhile fold acc as
checkTransactions :: (Transaction -> Transaction -> Bool)
-> [Transaction] -> FoldAcc Transaction Transaction
checkTransactions compare ts =
foldWhile fold FoldAcc{fa_error=Nothing, fa_previous=Nothing} ts
where
fold current acc@FoldAcc{fa_previous=Nothing} = acc{fa_previous=Just current}
fold current acc@FoldAcc{fa_previous=Just previous} =
if compare previous current
then acc{fa_previous=Just current}
else acc{fa_error=Just current}

28
bin/hledger-dupes.hs
View File

@ -18,22 +18,25 @@ import Data.Function
import Data.String.Here import Data.String.Here
import qualified Data.Text as T import qualified Data.Text as T
doc = [here| ------------------------------------------------------------------------------
cmdmode = (defAddonCommandMode "dupes") {
Usage: modeHelp = [here|
```
$ hledger-dupes [FILE]
...common hledger options...
```
Reports duplicates in the account tree: account names having the same leaf Reports duplicates in the account tree: account names having the same leaf
but different prefixes. In other words, two or more leaves that are but different prefixes. In other words, two or more leaves that are
categorized differently. categorized differently.
Reads the default journal file, or another specified as an argument. Reads the default journal file, or another specified as an argument.
http://stefanorodighiero.net/software/hledger-dupes.html http://stefanorodighiero.net/software/hledger-dupes.html
|]
,modeHelpSuffix=lines [here|
|]
}
------------------------------------------------------------------------------
|] main = do
opts <- getHledgerCliOpts cmdmode
withJournalDo opts $ \CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
mapM_ render $ dupes $ accountsNames j
accountsNames :: Journal -> [(String, AccountName)] accountsNames :: Journal -> [(String, AccountName)]
accountsNames j = map leafAndAccountName as accountsNames j = map leafAndAccountName as
@ -53,8 +56,3 @@ dupes l = zip dupLeafs dupAccountNames
render :: (String, [AccountName]) -> IO () render :: (String, [AccountName]) -> IO ()
render (leafName, accountNameL) = printf "%s as %s\n" leafName (concat $ intersperse ", " (map T.unpack accountNameL)) render (leafName, accountNameL) = printf "%s as %s\n" leafName (concat $ intersperse ", " (map T.unpack accountNameL))
main = do
opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "dupes") doc
withJournalDo opts $ \CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
mapM_ render $ dupes $ accountsNames j

42
bin/hledger-equity.hs
View File

@ -15,21 +15,16 @@ import Data.Time.Calendar
import Hledger.Cli import Hledger.Cli
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
doc = [here| cmdmode :: Mode RawOpts
cmdmode = (defAddonCommandMode "equity") {
Usage: modeHelp = [here|
``` Print a "closing balances" transaction that brings all accounts (or with
$ hledger-equity -h query arguments, just the matched accounts) to a zero balance, followed by an
equity [OPTIONS] [QUERY] opposite "opening balances" transaction that restores the balances from zero.
print a "closing balances" transaction that brings all accounts (or with Such transactions can be useful, eg, for bringing account balances across
query arguments, just the matched accounts) to a zero balance, followed by an file boundaries.
opposite "opening balances" transaction that restores the balances from zero. |]
Such transactions can be useful, eg, for bringing account balances across ,modeHelpSuffix=lines [here|
file boundaries.
...common hledger options...
```
The opening balances transaction is useful to carry over The opening balances transaction is useful to carry over
asset/liability balances if you choose to start a new journal file, asset/liability balances if you choose to start a new journal file,
eg at the beginning of the year. eg at the beginning of the year.
@ -58,25 +53,14 @@ Open question: how to handle txns spanning a file boundary ? Eg:
This command might or might not have some connection to the concept of This command might or might not have some connection to the concept of
"closing the books" in accounting. "closing the books" in accounting.
|]
|]
------------------------------------------------------------------------------
equitymode :: Mode RawOpts
equitymode =
(defAddonCommandMode "equity")
{ modeHelp =
"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."
,modeArgs = ([], Just $ argsFlag "[QUERY]") ,modeArgs = ([], Just $ argsFlag "[QUERY]")
} }
------------------------------------------------------------------------------
main :: IO () main :: IO ()
main = do main = do
opts <- getHledgerOptsOrShowHelp equitymode doc opts <- getHledgerCliOpts cmdmode
withJournalDo opts $ withJournalDo opts $
\CliOpts{reportopts_=ropts} j -> do \CliOpts{reportopts_=ropts} j -> do
today <- getCurrentDay today <- getCurrentDay

21
bin/hledger-print-unique.hs
View File

@ -13,25 +13,18 @@ import Data.String.Here
import Hledger.Cli import Hledger.Cli
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
doc = [here| cmdmode = (defAddonCommandMode "print-unique") {
modeHelp = [here|
Usage:
```
$ hledger-print-unique -h
hledger-print-unique [OPTIONS] [ARGS]
...common hledger options...
```
Print only journal entries which are unique by description (or Print only journal entries which are unique by description (or
something else). Reads the default or specified journal, or stdin. something else). Reads the default or specified journal, or stdin.
|]
|] ,modeHelpSuffix=lines [here|
|]
}
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
main = do main = do
putStrLn "(-f option not supported)" opts <- getHledgerCliOpts cmdmode
opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "hledger-print-unique") doc
withJournalDo opts $ withJournalDo opts $
\opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts} \opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts}
where where

20
bin/hledger-register-match.hs
View File

@ -21,26 +21,20 @@ import Hledger.Cli.CliOptions
import Hledger.Cli ( withJournalDo, postingsReportAsText ) import Hledger.Cli ( withJournalDo, postingsReportAsText )
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
doc = [here| cmdmode = (defAddonCommandMode "register-match") {
modeHelp = [here|
Usage:
```
$ hledger-register-match -h
hledger-register-match [OPTIONS] [ARGS]
...common hledger options...
```
A helper for ledger-autosync. This prints the one posting whose transaction A helper for ledger-autosync. This prints the one posting whose transaction
description is closest to DESC, in the style of the register command. description is closest to DESC, in the style of the register command.
If there are multiple equally good matches, it shows the most recent. 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. Query options (options, not arguments) can be used to restrict the search space.
|]
|] ,modeHelpSuffix=lines [here|
|]
}
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
main = do main = do
opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "hledger-register-match") doc opts <- getHledgerCliOpts cmdmode
withJournalDo opts match withJournalDo opts match
match :: CliOpts -> Journal -> IO () match :: CliOpts -> Journal -> IO ()

86
bin/hledger-rewrite.hs
View File

@ -26,25 +26,16 @@ import qualified Data.Algorithm.Diff as D
import Hledger.Data.AutoTransaction (runModifierTransaction) import Hledger.Data.AutoTransaction (runModifierTransaction)
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
doc = [here| cmdmode =
let m = (defAddonCommandMode "hledger-rewrite")
in m {
modeHelp = [here|
Usage: Print all journal entries, with custom postings added to the matched ones
```
$ hledger-rewrite -h
hledger-rewrite [OPTIONS] [QUERY] --add-posting "ACCT AMTEXPR" ...
print all journal entries, with custom postings added to the matched ones
Flags: |]
--add-posting='ACCT AMTEXPR' add a posting to ACCT, which may be ,modeHelpSuffix=lines [here|
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.
--diff generate diff suitable as an input for
...common hledger options...
```
A start at a generic rewriter of journal entries. A start at a generic rewriter of journal entries.
Reads the default journal and prints the entries, like print, Reads the default journal and prints the entries, like print,
but adds the specified postings to any entries matching PATTERNS. but adds the specified postings to any entries matching PATTERNS.
@ -62,7 +53,8 @@ rewrites.hledger may consist of entries like:
(reserve:grocery) *0.25 ; reserve 25% for grocery (reserve:grocery) *0.25 ; reserve 25% for grocery
(reserve:) *0.25 ; reserve 25% for grocery (reserve:) *0.25 ; reserve 25% for grocery
``` ```
Note the single quotes to protect the dollar sign from bash, and the two spaces between account and amount. Note the single quotes to protect the dollar sign from bash,
and the two spaces between account and amount.
See the command-line help for more details. See the command-line help for more details.
Currently does not work when invoked via hledger, run it directly instead. Currently does not work when invoked via hledger, run it directly instead.
@ -72,28 +64,39 @@ TODO:
- should allow regex matching and interpolating matched name in replacement - should allow regex matching and interpolating matched name in replacement
- should apply all matching rules to a transaction, not just one - should apply all matching rules to a transaction, not just one
- should be possible to use this on unbalanced entries, eg while editing one - should be possible to use this on unbalanced entries, eg while editing one
|]
------------------------------------------------------------------------------
cmdmode :: Mode RawOpts |]
cmdmode = (defAddonCommandMode "hledger-rewrite") { ,modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...")
modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...") ,modeGroupFlags = (modeGroupFlags m) {
,modeHelp = "print all journal entries, with custom postings added to the matched ones" groupUnnamed = [
,modeGroupFlags = Group { flagReq ["add-posting"] (\s opts -> Right $ setopt "add-posting" s opts) "'ACCT AMTEXPR'"
groupNamed = [("Input", inputflags) "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."
,("Output", outputflags) ,flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool"
,("Reporting", reportflags) ]
,("Misc", helpflags)
]
,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."]
,groupHidden = []
} }
} }
------------------------------------------------------------------------------
outputflags :: [Flag RawOpts] outputflags :: [Flag RawOpts]
outputflags = [flagNone ["diff"] (setboolopt "diff") "generate diff suitable as an input for patch tool"] 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
d <- getCurrentDay
let q = queryFromOpts d ropts
modifier <- modifierTransactionFromOpts rawopts
withJournalDo opts $ \opts' j@Journal{jtxns=ts} -> do
-- create re-writer
let modifiers = modifier : jmodifiertxns j
-- Note that some query matches require transaction. Thus modifiers
-- pipeline should include txnTieKnot on every step.
modifier' = foldr (flip (.) . fmap txnTieKnot . runModifierTransaction q) id modifiers
-- rewrite matched transactions
let j' = j{jtxns=map modifier' ts}
-- run the print command, showing all transactions
outputFromOpts rawopts opts'{reportopts_=ropts{query_=""}} j j'
postingp' :: T.Text -> IO Posting postingp' :: T.Text -> IO Posting
postingp' t = runErroringJournalParser (postingp Nothing <* eof) t' >>= \case postingp' t = runErroringJournalParser (postingp Nothing <* eof) t' >>= \case
Left err -> fail err Left err -> fail err
@ -195,20 +198,3 @@ mapDiff = \case
D.First x -> Del x D.First x -> Del x
D.Second x -> Add x D.Second x -> Add x
D.Both x _ -> Ctx x D.Both x _ -> Ctx x
main :: IO ()
main = do
opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getHledgerOptsOrShowHelp cmdmode doc
d <- getCurrentDay
let q = queryFromOpts d ropts
modifier <- modifierTransactionFromOpts rawopts
withJournalDo opts $ \opts' j@Journal{jtxns=ts} -> do
-- create re-writer
let modifiers = modifier : jmodifiertxns j
-- Note that some query matches require transaction. Thus modifiers
-- pipeline should include txnTieKnot on every step.
modifier' = foldr (flip (.) . fmap txnTieKnot . runModifierTransaction q) id modifiers
-- rewrite matched transactions
let j' = j{jtxns=map modifier' ts}
-- run the print command, showing all transactions
outputFromOpts rawopts opts'{reportopts_=ropts{query_=""}} j j'

101
hledger/Hledger/Cli/CliOptions.hs
View File

@ -28,7 +28,7 @@ module Hledger.Cli.CliOptions (
-- * CLI options -- * CLI options
CliOpts(..), CliOpts(..),
defcliopts, defcliopts,
getHledgerOptsOrShowHelp, getHledgerCliOpts,
decodeRawOpts, decodeRawOpts,
rawOptsToCliOpts, rawOptsToCliOpts,
checkCliOpts, checkCliOpts,
@ -165,41 +165,50 @@ generalflagsgroup3 = (generalflagstitle, helpflags)
-- cmdargs mode constructors -- cmdargs mode constructors
-- | A basic cmdargs mode template with a single flag: -h. -- | An empty cmdargs mode to use as a template.
-- Modes describe the top-level command, ie the program, or a subcommand,
-- telling cmdargs how to parse a command line and how to
-- generate the command's usage text.
defMode :: Mode RawOpts defMode :: Mode RawOpts
defMode = Mode { defMode = Mode {
modeNames = [] modeNames = [] -- program/command name(s)
,modeHelp = "" ,modeHelp = "" -- short help for this command
,modeHelpSuffix = [] ,modeHelpSuffix = [] -- text displayed after the usage
,modeValue = [] ,modeGroupFlags = Group { -- description of flags accepted by the command
,modeArgs = ([], Nothing) groupNamed = [] -- named groups of flags
,modeCheck = Right ,groupUnnamed = [] -- ungrouped flags
,modeReform = const Nothing ,groupHidden = [] -- flags not displayed in the usage
,modeExpandAt = True }
,modeGroupFlags = Group { ,modeArgs = ([], Nothing) -- description of arguments accepted by the command
groupNamed = [] ,modeValue = [] -- value returned when this mode is used to parse a command line
,groupUnnamed = [ ,modeCheck = Right -- whether the mode's value is correct
flagNone ["h"] (setboolopt "h") "Show command usage." ,modeReform = const Nothing -- function to convert the value back to a command line arguments
-- ,flagNone ["help"] (setboolopt "help") "Show long help." ,modeExpandAt = True -- expand @ arguments for program ?
] ,modeGroupModes = toGroup [] -- sub-modes
,groupHidden = []
}
,modeGroupModes = toGroup []
} }
-- | A cmdargs mode suitable for a hledger built-in command -- | A cmdargs mode suitable for a hledger built-in command
-- with the given names (primary name + optional aliases). -- with the given names (primary name + optional aliases).
-- The default flags are short and long help (-h and --help).
-- The usage message shows [QUERY] as argument. -- The usage message shows [QUERY] as argument.
defCommandMode :: [Name] -> Mode RawOpts defCommandMode :: [Name] -> Mode RawOpts
defCommandMode names = defMode { defCommandMode names = defMode {
modeNames=names modeNames=names
,modeValue=[("command", headDef "" names)] ,modeGroupFlags = Group {
groupNamed = []
,groupUnnamed = [
flagNone ["h"] (setboolopt "h") "Show usage."
-- ,flagNone ["help"] (setboolopt "help") "Show long help."
]
,groupHidden = [] -- flags not displayed in the usage
}
,modeArgs = ([], Just $ argsFlag "[QUERY]") ,modeArgs = ([], Just $ argsFlag "[QUERY]")
,modeValue=[("command", headDef "" names)]
} }
-- | A cmdargs mode suitable for a hledger add-on command with the given name. -- | A cmdargs mode suitable for a hledger add-on command with the given name.
-- Like defCommandMode, but adds a appropriate short help message if the addon name -- Like defCommandMode, but adds a appropriate short help message if the addon name
-- is recognised, and includes hledger's general flags (input + reporting + help flags) as default. -- is recognised, and includes hledger's common input/reporting/help flags as default.
defAddonCommandMode :: Name -> Mode RawOpts defAddonCommandMode :: Name -> Mode RawOpts
defAddonCommandMode name = (defCommandMode [name]) { defAddonCommandMode name = (defCommandMode [name]) {
modeHelp = fromMaybe "" $ lookup (stripAddonExtension name) standardAddonsHelp modeHelp = fromMaybe "" $ lookup (stripAddonExtension name) standardAddonsHelp
@ -361,32 +370,46 @@ checkCliOpts opts =
Right _ -> Right () Right _ -> Right ()
-- XXX check registerWidthsFromOpts opts -- XXX check registerWidthsFromOpts opts
-- | Parse common hledger options from the command line using the given -- | A helper for addon commands: this parses options and arguments from
-- hledger-style cmdargs mode and return them as a CliOpts. -- the current command line using the given hledger-style cmdargs mode,
-- Or, when -h or --help is present, print the mode's usage message -- and returns a CliOpts. Or, with --help or -h present, it prints
-- or the provided long help and exit the program. -- long or short help, and exits the program.
--
-- When --debug is present, also prints some debug output. -- When --debug is present, also prints some debug output.
-- --
-- The long help is assumed to possibly contain markdown literal blocks -- The help texts are generated from the mode.
-- delimited by lines beginning with ``` - these delimiters are removed. -- Long help includes the full usage description generated by cmdargs
-- Also it is assumed to lack a terminating newline, which is added. -- (including all supported options), framed by whatever pre- and postamble
-- text the mode specifies. It's intended that this forms a complete
-- help document or manual.
-- --
-- This is useful for addon commands. -- Short help is a truncated version of the above: the preamble and
getHledgerOptsOrShowHelp :: Mode RawOpts -> String -> IO CliOpts -- the first part of the usage, up to the first line containing "flags:"
getHledgerOptsOrShowHelp mode' longhelp = do -- (normally this marks the start of the common hledger flags);
-- plus a mention of --help and the (presumed supported) common
-- hledger options not displayed.
--
-- Tips:
-- Empty lines in the pre/postamble are removed by cmdargs;
-- add a space character to preserve them.
--
getHledgerCliOpts :: Mode RawOpts -> IO CliOpts
getHledgerCliOpts mode' = do
args' <- getArgs args' <- getArgs
let rawopts = decodeRawOpts $ processValue mode' args' let rawopts = decodeRawOpts $ processValue mode' args'
opts <- rawOptsToCliOpts rawopts opts <- rawOptsToCliOpts rawopts
debugArgs args' opts debugArgs args' opts
when ("help" `inRawOpts` rawopts_ opts) $ putStrLn longhelp' >> exitSuccess when ("help" `inRawOpts` rawopts_ opts) $ putStr longhelp >> exitSuccess
when ("h" `inRawOpts` rawopts_ opts) $ putStr (showModeUsage mode') >> exitSuccess when ("h" `inRawOpts` rawopts_ opts) $ putStr shorthelp >> exitSuccess
return opts return opts
where where
longhelp' = unlines $ map hideBlockDelimiters $ lines longhelp longhelp = showModeUsage mode'
where shorthelp =
hideBlockDelimiters ('`':'`':'`':_) = "" unlines $
hideBlockDelimiters l = l (reverse $ dropWhile null $ reverse $ takeWhile (not . ("flags:" `isInfixOf`)) $ lines longhelp)
++
[""
," See --help for full detail, including common hledger options."
]
-- | Print debug info about arguments and options if --debug is present. -- | Print debug info about arguments and options if --debug is present.
debugArgs :: [String] -> CliOpts -> IO () debugArgs :: [String] -> CliOpts -> IO ()
debugArgs args' opts = debugArgs args' opts =