diff --git a/bin/hledger-chart.hs b/bin/hledger-chart.hs index c810b602a..f86667138 100755 --- a/bin/hledger-chart.hs +++ b/bin/hledger-chart.hs @@ -38,38 +38,22 @@ import Text.Printf import Hledger 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 -Released under GPL version 3 or later. - -|] - --- options - --- progname = "hledger-chart" --- progversion = progname ++ " dev" - defchartoutput = "hledger.svg" defchartitems = 10 defchartsize = "600x400" -chartmode :: Mode RawOpts -chartmode = (defAddonCommandMode "hledger-chart") { - modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...") - ,modeHelp = "generate a pie chart image for the top account balances (of one sign only)" - ,modeHelpSuffix=[] +------------------------------------------------------------------------------ +cmdmode :: Mode RawOpts +cmdmode = (defAddonCommandMode "hledger-chart") { + modeHelp = [here| +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 = [ @@ -79,7 +63,9 @@ chartmode = (defAddonCommandMode "hledger-chart") { ] ,groupHidden = [] } + ,modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...") } +------------------------------------------------------------------------------ data ChartOpts = ChartOpts { chart_output_ :: FilePath @@ -96,7 +82,7 @@ defchartopts = ChartOpts getHledgerChartOpts :: IO ChartOpts getHledgerChartOpts = do - cliopts <- getHledgerOptsOrShowHelp chartmode doc + cliopts <- getHledgerCliOpts cmdmode return defchartopts { chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" $ rawopts_ cliopts ,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" $ rawopts_ cliopts @@ -104,8 +90,6 @@ getHledgerChartOpts = do ,cliopts_ = cliopts } --- main - main :: IO () main = do chopts <- getHledgerChartOpts diff --git a/bin/hledger-check-dates.hs b/bin/hledger-check-dates.hs index 830b94b7a..e2e34d23a 100755 --- a/bin/hledger-check-dates.hs +++ b/bin/hledger-check-dates.hs @@ -13,66 +13,29 @@ import Hledger.Cli import Text.Printf ------------------------------------------------------------------------------ -doc = [here| - -$ hledger-check-dates -h -check-dates [OPTIONS] [ARGS] - check that transactions' date are monotonically increasing - -Flags: - --strict makes date comparing strict - -...common hledger options... - +cmdmode = + let m = defAddonCommandMode "check-dates" + in m { + modeHelp = [here| +Check that transactions' dates are monotonically increasing. +With --date2, checks secondary dates instead. 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. - -|] ------------------------------------------------------------------------------- - -argsmode :: Mode RawOpts -argsmode = (defAddonCommandMode "check-dates") - { modeHelp = "check that transactions' date are monotonically increasing" - , modeGroupFlags = Group - { groupNamed = - [ ("Input",inputflags) - , ("Reporting",reportflags) - , ("Misc",helpflags) - ] - ,groupUnnamed = [ + |] + ,modeHelpSuffix=lines [here| + |] + ,modeGroupFlags = (modeGroupFlags m) { + groupUnnamed = [ 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 = do - opts <- getHledgerOptsOrShowHelp argsmode doc + opts <- getHledgerCliOpts cmdmode withJournalDo opts $ \CliOpts{rawopts_=opts,reportopts_=ropts} j -> do d <- getCurrentDay @@ -100,3 +63,27 @@ main = do (show $ date error) (show $ tsourcepos 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} + diff --git a/bin/hledger-dupes.hs b/bin/hledger-dupes.hs index fed8a7c28..2227c3d0d 100755 --- a/bin/hledger-dupes.hs +++ b/bin/hledger-dupes.hs @@ -18,22 +18,25 @@ import Data.Function import Data.String.Here import qualified Data.Text as T -doc = [here| - -Usage: -``` -$ hledger-dupes [FILE] - -...common hledger options... -``` +------------------------------------------------------------------------------ +cmdmode = (defAddonCommandMode "dupes") { + modeHelp = [here| 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. Reads the default journal file, or another specified as an argument. - + 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 j = map leafAndAccountName as @@ -53,8 +56,3 @@ dupes l = zip dupLeafs dupAccountNames render :: (String, [AccountName]) -> IO () 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 diff --git a/bin/hledger-equity.hs b/bin/hledger-equity.hs index 76f6c3ee0..b26dd0912 100755 --- a/bin/hledger-equity.hs +++ b/bin/hledger-equity.hs @@ -15,21 +15,16 @@ import Data.Time.Calendar import Hledger.Cli ------------------------------------------------------------------------------ -doc = [here| - -Usage: -``` -$ hledger-equity -h -equity [OPTIONS] [QUERY] - 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. - -...common hledger options... -``` - +cmdmode :: Mode RawOpts +cmdmode = (defAddonCommandMode "equity") { + modeHelp = [here| +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| 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. @@ -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 "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]") } +------------------------------------------------------------------------------ main :: IO () main = do - opts <- getHledgerOptsOrShowHelp equitymode doc + opts <- getHledgerCliOpts cmdmode withJournalDo opts $ \CliOpts{reportopts_=ropts} j -> do today <- getCurrentDay diff --git a/bin/hledger-print-unique.hs b/bin/hledger-print-unique.hs index f7f9920d4..70f106e3a 100755 --- a/bin/hledger-print-unique.hs +++ b/bin/hledger-print-unique.hs @@ -13,25 +13,18 @@ import Data.String.Here import Hledger.Cli ------------------------------------------------------------------------------ -doc = [here| - -Usage: -``` -$ hledger-print-unique -h -hledger-print-unique [OPTIONS] [ARGS] - -...common hledger options... -``` - +cmdmode = (defAddonCommandMode "print-unique") { + modeHelp = [here| Print only journal entries which are unique by description (or something else). Reads the default or specified journal, or stdin. - -|] + |] + ,modeHelpSuffix=lines [here| + |] + } ------------------------------------------------------------------------------ main = do - putStrLn "(-f option not supported)" - opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "hledger-print-unique") doc + opts <- getHledgerCliOpts cmdmode withJournalDo opts $ \opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts} where diff --git a/bin/hledger-register-match.hs b/bin/hledger-register-match.hs index f855b4516..cd82eac34 100755 --- a/bin/hledger-register-match.hs +++ b/bin/hledger-register-match.hs @@ -21,26 +21,20 @@ import Hledger.Cli.CliOptions import Hledger.Cli ( withJournalDo, postingsReportAsText ) ------------------------------------------------------------------------------ -doc = [here| - -Usage: -``` -$ hledger-register-match -h -hledger-register-match [OPTIONS] [ARGS] - -...common hledger options... -``` - +cmdmode = (defAddonCommandMode "register-match") { + modeHelp = [here| 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| + |] + } ------------------------------------------------------------------------------ main = do - opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "hledger-register-match") doc + opts <- getHledgerCliOpts cmdmode withJournalDo opts match match :: CliOpts -> Journal -> IO () diff --git a/bin/hledger-rewrite.hs b/bin/hledger-rewrite.hs index b5246f496..778ae8e00 100755 --- a/bin/hledger-rewrite.hs +++ b/bin/hledger-rewrite.hs @@ -26,25 +26,16 @@ import qualified Data.Algorithm.Diff as D import Hledger.Data.AutoTransaction (runModifierTransaction) ------------------------------------------------------------------------------ -doc = [here| +cmdmode = + let m = (defAddonCommandMode "hledger-rewrite") + in m { + modeHelp = [here| -Usage: -``` -$ hledger-rewrite -h -hledger-rewrite [OPTIONS] [QUERY] --add-posting "ACCT AMTEXPR" ... - print all journal entries, with custom postings added to the matched ones +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 - 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... -``` + |] + ,modeHelpSuffix=lines [here| + A start at a generic rewriter of journal entries. Reads the default journal and prints the entries, like print, 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:) *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. 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 apply all matching rules to a transaction, not just 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\" ...") - ,modeHelp = "print all journal entries, with custom postings added to the matched ones" - ,modeGroupFlags = Group { - groupNamed = [("Input", inputflags) - ,("Output", outputflags) - ,("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 = [] + |] + ,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" + ] } } +------------------------------------------------------------------------------ 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 + 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 = runErroringJournalParser (postingp Nothing <* eof) t' >>= \case Left err -> fail err @@ -195,20 +198,3 @@ mapDiff = \case D.First x -> Del x D.Second x -> Add 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' diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 2d391a680..45197ddd0 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -28,7 +28,7 @@ module Hledger.Cli.CliOptions ( -- * CLI options CliOpts(..), defcliopts, - getHledgerOptsOrShowHelp, + getHledgerCliOpts, decodeRawOpts, rawOptsToCliOpts, checkCliOpts, @@ -165,41 +165,50 @@ generalflagsgroup3 = (generalflagstitle, helpflags) -- 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 { - modeNames = [] - ,modeHelp = "" - ,modeHelpSuffix = [] - ,modeValue = [] - ,modeArgs = ([], Nothing) - ,modeCheck = Right - ,modeReform = const Nothing - ,modeExpandAt = True - ,modeGroupFlags = Group { - groupNamed = [] - ,groupUnnamed = [ - flagNone ["h"] (setboolopt "h") "Show command usage." - -- ,flagNone ["help"] (setboolopt "help") "Show long help." - ] - ,groupHidden = [] - } - ,modeGroupModes = toGroup [] +defMode = Mode { + modeNames = [] -- program/command name(s) + ,modeHelp = "" -- short help for this command + ,modeHelpSuffix = [] -- text displayed after the usage + ,modeGroupFlags = Group { -- description of flags accepted by the command + groupNamed = [] -- named groups of flags + ,groupUnnamed = [] -- ungrouped flags + ,groupHidden = [] -- flags not displayed in the usage + } + ,modeArgs = ([], Nothing) -- description of arguments accepted by the command + ,modeValue = [] -- value returned when this mode is used to parse a command line + ,modeCheck = Right -- whether the mode's value is correct + ,modeReform = const Nothing -- function to convert the value back to a command line arguments + ,modeExpandAt = True -- expand @ arguments for program ? + ,modeGroupModes = toGroup [] -- sub-modes } -- | A cmdargs mode suitable for a hledger built-in command -- 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. defCommandMode :: [Name] -> Mode RawOpts defCommandMode names = defMode { 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]") + ,modeValue=[("command", headDef "" names)] } -- | 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 --- 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 = (defCommandMode [name]) { modeHelp = fromMaybe "" $ lookup (stripAddonExtension name) standardAddonsHelp @@ -361,32 +370,46 @@ checkCliOpts opts = Right _ -> Right () -- XXX check registerWidthsFromOpts opts --- | Parse common hledger options from the command line using the given --- hledger-style cmdargs mode and return them as a CliOpts. --- Or, when -h or --help is present, print the mode's usage message --- or the provided long help and exit the program. --- +-- | A helper for addon commands: this parses options and arguments from +-- the current command line using the given hledger-style cmdargs mode, +-- and returns a CliOpts. Or, with --help or -h present, it prints +-- long or short help, and exits the program. -- When --debug is present, also prints some debug output. -- --- The long help is assumed to possibly contain markdown literal blocks --- delimited by lines beginning with ``` - these delimiters are removed. --- Also it is assumed to lack a terminating newline, which is added. +-- The help texts are generated from the mode. +-- Long help includes the full usage description generated by cmdargs +-- (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. -getHledgerOptsOrShowHelp :: Mode RawOpts -> String -> IO CliOpts -getHledgerOptsOrShowHelp mode' longhelp = do +-- Short help is a truncated version of the above: the preamble and +-- the first part of the usage, up to the first line containing "flags:" +-- (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 let rawopts = decodeRawOpts $ processValue mode' args' opts <- rawOptsToCliOpts rawopts debugArgs args' opts - when ("help" `inRawOpts` rawopts_ opts) $ putStrLn longhelp' >> exitSuccess - when ("h" `inRawOpts` rawopts_ opts) $ putStr (showModeUsage mode') >> exitSuccess + when ("help" `inRawOpts` rawopts_ opts) $ putStr longhelp >> exitSuccess + when ("h" `inRawOpts` rawopts_ opts) $ putStr shorthelp >> exitSuccess return opts where - longhelp' = unlines $ map hideBlockDelimiters $ lines longhelp - where - hideBlockDelimiters ('`':'`':'`':_) = "" - hideBlockDelimiters l = l + longhelp = showModeUsage mode' + shorthelp = + unlines $ + (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. debugArgs :: [String] -> CliOpts -> IO () debugArgs args' opts =