From 9198449ee39a63183c87cb916a63898e5cd0f298 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 24 May 2020 16:13:30 -0700 Subject: [PATCH] areg: an account transaction register like the ones in ui/web (#1294) ;areg: debug output ;areg: show a title indicating which account was picked This might be a bit of a pain for scripting, but otherwise it can be quite confusing if your argument matches an account you didn't expect. ;areg: improve CSV headings ;areg: show at most two commodities per amount --- .../Reports/AccountTransactionsReport.hs | 37 ++- hledger-lib/Hledger/Reports/ReportOptions.hs | 9 +- hledger/Hledger/Cli/Commands.hs | 5 + hledger/Hledger/Cli/Commands/Aregister.hs | 243 ++++++++++++++++++ hledger/Hledger/Cli/Commands/Aregister.md | 67 +++++ hledger/Hledger/Cli/Commands/Aregister.txt | 60 +++++ hledger/hledger.cabal | 4 +- hledger/hledger.m4.md | 4 + hledger/package.yaml | 2 + 9 files changed, 417 insertions(+), 14 deletions(-) create mode 100644 hledger/Hledger/Cli/Commands/Aregister.hs create mode 100644 hledger/Hledger/Cli/Commands/Aregister.md create mode 100644 hledger/Hledger/Cli/Commands/Aregister.txt diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index 09e1257d9..d820ffb4b 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -91,16 +91,23 @@ accountTransactionsReport ropts j reportq thisacctq = (label, items) reportq -- get all transactions - ts1 = jtxns j + ts1 = + -- ptraceAtWith 5 (("ts1:\n"++).pshowTransactions) $ + jtxns j -- apply any cur:SYM filters in reportq' symq = filterQuery queryIsSym reportq' - ts2 = (if queryIsNull symq then id else map (filterTransactionAmounts symq)) ts1 + ts2 = + ptraceAtWith 5 (("ts2:\n"++).pshowTransactions) $ + (if queryIsNull symq then id else map (filterTransactionAmounts symq)) ts1 -- keep just the transactions affecting this account (via possibly realness or status-filtered postings) realq = filterQuery queryIsReal reportq' statusq = filterQuery queryIsStatus reportq' - ts3 = filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2 + ts3 = + traceAt 3 ("thisacctq: "++show thisacctq) $ + ptraceAtWith 5 (("ts3:\n"++).pshowTransactions) $ + filter (matchesTransaction thisacctq . filterTransactionPostings (And [realq, statusq])) ts2 -- maybe convert these transactions to cost or value prices = journalPriceOracle (infer_value_ ropts) j @@ -114,19 +121,23 @@ accountTransactionsReport ropts j reportq thisacctq = (label, items) tval = case value_ ropts of Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast today multiperiod t v Nothing -> id - ts4 = map tval ts3 + ts4 = + ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ + map tval ts3 -- sort by the transaction's register date, for accurate starting balance -- these are not yet filtered by tdate, we want to search them all for priorps - ts5 = sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4 + ts5 = + ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) $ + sortBy (comparing (transactionRegisterDate reportq' thisacctq)) ts4 (startbal,label) | balancetype_ ropts == HistoricalBalance = (sumPostings priorps, balancelabel) | otherwise = (nullmixedamt, totallabel) where - priorps = dbg1 "priorps" $ + priorps = dbg5 "priorps" $ filter (matchesPosting - (dbg1 "priorq" $ + (dbg5 "priorq" $ And [thisacctq, tostartdateq, datelessreportq])) $ transactionsPostings ts5 tostartdateq = @@ -136,16 +147,20 @@ accountTransactionsReport ropts j reportq thisacctq = (label, items) mstartdate = queryStartDate (date2_ ropts) reportq' datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq' - -- now should we include only transactions dated inside report period ? - -- or all transactions with any posting inside the report period ? an option ? - -- filtering might apply some other query terms here too. I think we should. - filtertxns = True + -- accountTransactionsReportItem will keep transactions of any date which have any posting inside the report period. + -- Should we also require that transaction date is inside the report period ? + -- Should we be filtering by reportq here to apply other query terms (?) + -- Make it an option for now. + filtertxns = txn_dates_ ropts items = reverse $ accountTransactionsReportItems reportq' thisacctq startbal negate $ (if filtertxns then filter (reportq' `matchesTransaction`) else id) $ ts5 +pshowTransactions :: [Transaction] -> String +pshowTransactions = pshow . map (\t -> unwords [show $ tdate t, T.unpack $ tdescription t]) + -- | Generate transactions report items from a list of transactions, -- using the provided user-specified report query, a query specifying -- which account to use as the focus, a starting balance, a sign-setting diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index e4ac47260..181fee90f 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -85,6 +85,7 @@ instance Default AccountListMode where def = ALFlat -- or query arguments, but not all. Some are used only by certain -- commands, as noted below. data ReportOpts = ReportOpts { + -- for most reports: today_ :: Maybe Day -- ^ The current date. A late addition to ReportOpts. -- Optional, but when set it may affect some reports: -- Reports use it when picking a -V valuation date. @@ -105,9 +106,11 @@ data ReportOpts = ReportOpts { -- and quoted if needed (see 'quoteIfNeeded') -- ,average_ :: Bool - -- register command only + -- for posting reports (register) ,related_ :: Bool - -- balance-type commands only + -- for account transactions reports (aregister) + ,txn_dates_ :: Bool + -- for balance reports (bal, bs, cf, is) ,balancetype_ :: BalanceType ,accountlistmode_ :: AccountListMode ,drop_ :: Int @@ -163,6 +166,7 @@ defreportopts = ReportOpts def def def + def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = checkReportOpts <$> do @@ -186,6 +190,7 @@ rawOptsToReportOpts rawopts = checkReportOpts <$> do ,query_ = unwords . map quoteIfNeeded $ listofstringopt "args" rawopts' -- doesn't handle an arg like "" right ,average_ = boolopt "average" rawopts' ,related_ = boolopt "related" rawopts' + ,txn_dates_ = boolopt "txn-dates" rawopts' ,balancetype_ = balancetypeopt rawopts' ,accountlistmode_ = accountlistmodeopt rawopts' ,drop_ = posintopt "drop" rawopts' diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index cfdfe279e..d9d3ba858 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -20,6 +20,7 @@ module Hledger.Cli.Commands ( ,module Hledger.Cli.Commands.Accounts ,module Hledger.Cli.Commands.Activity ,module Hledger.Cli.Commands.Add + ,module Hledger.Cli.Commands.Aregister ,module Hledger.Cli.Commands.Balance ,module Hledger.Cli.Commands.Balancesheet ,module Hledger.Cli.Commands.Balancesheetequity @@ -66,6 +67,7 @@ import Hledger.Cli.Version import Hledger.Cli.Commands.Accounts import Hledger.Cli.Commands.Activity import Hledger.Cli.Commands.Add +import Hledger.Cli.Commands.Aregister import Hledger.Cli.Commands.Balance import Hledger.Cli.Commands.Balancesheet import Hledger.Cli.Commands.Balancesheetequity @@ -102,6 +104,7 @@ builtinCommands = [ (accountsmode , accounts) ,(activitymode , activity) ,(addmode , add) + ,(aregistermode , aregister) ,(balancemode , balance) ,(balancesheetequitymode , balancesheetequity) ,(balancesheetmode , balancesheet) @@ -172,6 +175,7 @@ commandsList = unlines [ ," rewrite generate automated postings/diffs (old, use --auto)" ,"" ,"Financial reports:" + ," aregister (areg) show transactions in a particular account" ," balancesheet (bs) show assets, liabilities and net worth" ," balancesheetequity (bse) show assets, liabilities and equity" ," cashflow (cf) show changes in liquid assets" @@ -291,6 +295,7 @@ tests_Hledger_Cli = tests "Hledger.Cli" [ tests_Commands = tests "Commands" [ tests_Balance ,tests_Register + ,tests_Aregister -- some more tests easiest to define here: diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs new file mode 100644 index 000000000..3d9757d6a --- /dev/null +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -0,0 +1,243 @@ +{-| + +The @aregister@ command lists a single account's transactions, +like the account register in hledger-ui and hledger-web, +and unlike the register command which lists postings across multiple accounts. + +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} + +module Hledger.Cli.Commands.Aregister ( + aregistermode + ,aregister + -- ,showPostingWithBalanceForVty + ,tests_Aregister +) where + +import Control.Monad (when) +import Data.Aeson (toJSON) +import Data.Aeson.Text (encodeToLazyText) +import Data.List +import Data.Maybe +-- import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL +import Data.Time (addDays) +import Safe (headDef) +import System.Console.CmdArgs.Explicit +import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) + +import Hledger +import Hledger.Cli.CliOptions +import Hledger.Cli.Utils + +aregistermode = hledgerCommandMode + $(embedFileRelative "Hledger/Cli/Commands/Aregister.txt") + ([ + flagNone ["txn-dates"] (setboolopt "txn-dates") + "filter strictly by transaction date, not posting date. Warning: this can show a wrong running balance." + ,flagNone ["no-elide"] (setboolopt "no-elide") "don't limit amount commodities shown to 2" + -- flagNone ["cumulative"] (setboolopt "change") + -- "show running total from report start date (default)" + -- ,flagNone ["historical","H"] (setboolopt "historical") + -- "show historical running total/balance (includes postings before report start date)\n " + -- ,flagNone ["average","A"] (setboolopt "average") + -- "show running average of posting amounts instead of total (implies --empty)" + -- ,flagNone ["related","r"] (setboolopt "related") "show postings' siblings instead" + -- ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign" + ,flagReq ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" + ("set output width (default: " ++ +#ifdef mingw32_HOST_OS + show defaultWidth +#else + "terminal width" +#endif + ++ " or $COLUMNS). -wN,M sets description width as well." + ) + ,outputFormatFlag ["txt","csv","json"] + ,outputFileFlag + ]) + [generalflagsgroup1] + hiddenflags + ([], Just $ argsFlag "ACCTPAT [QUERY]") + +-- based on Hledger.UI.RegisterScreen: + +-- | Print an account register report for a specified account. +aregister :: CliOpts -> Journal -> IO () +aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do + d <- getCurrentDay + -- the first argument specifies the account, any remaining arguments are a filter query + let args' = listofstringopt "args" rawopts + when (null args') $ error' "aregister needs an account, please provide an account name or pattern" + let + (apat:queryargs) = args' + acct = headDef (error' $ show apat++" did not match any account") $ + filter (regexMatches apat . T.unpack) $ journalAccountNames j + -- gather report options + inclusive = True -- tree_ ropts + thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct + ropts' = ropts{ + query_=unwords $ map quoteIfNeeded $ queryargs + -- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX + ,depth_=Nothing + -- always show historical balance + ,balancetype_= HistoricalBalance + } + reportq = And [queryFromOpts d ropts', excludeforecastq (isJust $ forecast_ ropts)] + where + -- As in RegisterScreen, why ? XXX + -- Except in forecast mode, exclude future/forecast transactions. + excludeforecastq True = Any + excludeforecastq False = -- not:date:tomorrow- not:tag:generated-transaction + And [ + Not (Date $ DateSpan (Just $ addDays 1 d) Nothing) + ,Not (Tag "generated-transaction" Nothing) + ] + -- run the report + -- TODO: need to also pass the queries so we can choose which date to render - move them into the report ? + (balancelabel,items) = accountTransactionsReport ropts' j reportq thisacctq + items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $ + reverse items + -- select renderer + render | fmt=="json" = (++"\n") . T.unpack . TL.toStrict . encodeToLazyText . toJSON + | fmt=="csv" = (++"\n") . printCSV . accountTransactionsReportAsCsv reportq thisacctq + | fmt=="txt" = accountTransactionsReportAsText opts reportq thisacctq + | otherwise = const $ error' $ unsupportedOutputFormatError fmt + where + fmt = outputFormatFromOpts opts + + writeOutput opts $ render (balancelabel,items') + +accountTransactionsReportAsCsv :: Query -> Query -> AccountTransactionsReport -> CSV +accountTransactionsReportAsCsv reportq thisacctq (_,is) = + ["txnidx","date","code","description","otheraccounts","change","balance"] + : map (accountTransactionsReportItemAsCsvRecord reportq thisacctq) is + +accountTransactionsReportItemAsCsvRecord :: Query -> Query -> AccountTransactionsReportItem -> CsvRecord +accountTransactionsReportItemAsCsvRecord + reportq thisacctq + (t@Transaction{tindex,tcode,tdescription}, _, _issplit, otheracctsstr, change, balance) + = [idx,date,code,desc,otheracctsstr,amt,bal] + where + idx = show tindex + date = showDate $ transactionRegisterDate reportq thisacctq t + code = T.unpack tcode + desc = T.unpack tdescription + amt = showMixedAmountOneLineWithoutPrice False change + bal = showMixedAmountOneLineWithoutPrice False balance + +-- | Render a register report as plain text suitable for console output. +accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> String +accountTransactionsReportAsText + copts@CliOpts{reportopts_=ReportOpts{no_elide_}} reportq thisacctq (_balancelabel,items) + = unlines $ title : + map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items + where + amtwidth = maximumStrict $ 12 : map (strWidth . showamt . itemamt) items + balwidth = maximumStrict $ 12 : map (strWidth . showamt . itembal) items + showamt + | no_elide_ = showMixedAmountOneLineWithoutPrice False -- color_ + | otherwise = showMixedAmountElided False + itemamt (_,_,_,_,a,_) = a + itembal (_,_,_,_,_,a) = a + -- show a title indicating which account was picked, which can be confusing otherwise + title = maybe "" (("Transactions in "++).(++" and subaccounts:")) macct + where + -- XXX temporary hack ? recover the account name from the query + macct = case filterQuery queryIsAcct thisacctq of + Acct r -> Just $ init $ init $ init $ init $ init $ tail r -- Acct "^JS:expenses(:|$)" + _ -> Nothing -- shouldn't happen + +-- | Render one account register report line item as plain text. Layout is like so: +-- @ +-- <---------------- width (specified, terminal width, or 80) --------------------> +-- date (10) description other accounts change (12) balance (12) +-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaa AAAAAAAAAAAA AAAAAAAAAAAA +-- @ +-- If description's width is specified, account will use the remaining space. +-- Otherwise, description and account divide up the space equally. +-- +-- Returns a string which can be multi-line, eg if the running balance +-- has multiple commodities. +-- +accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> String +accountTransactionsReportItemAsText + copts@CliOpts{reportopts_=ReportOpts{color_,no_elide_}} + reportq thisacctq preferredamtwidth preferredbalwidth + (t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance) + -- Transaction -- the transaction, unmodified + -- Transaction -- the transaction, as seen from the current account + -- Bool -- is this a split (more than one posting to other accounts) ? + -- String -- a display string describing the other account(s), if any + -- MixedAmount -- the amount posted to the current account(s) (or total amount posted) + -- MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction + + = intercalate "\n" $ + concat [fitString (Just datewidth) (Just datewidth) True True date + ," " + ,fitString (Just descwidth) (Just descwidth) True True desc + ," " + ,fitString (Just acctwidth) (Just acctwidth) True True accts + ," " + ,fitString (Just amtwidth) (Just amtwidth) True False amtfirstline + ," " + ,fitString (Just balwidth) (Just balwidth) True False balfirstline + ] + : + [concat [spacer + ,fitString (Just amtwidth) (Just amtwidth) True False a + ," " + ,fitString (Just balwidth) (Just balwidth) True False b + ] + | (a,b) <- zip amtrest balrest + ] + where + -- calculate widths + (totalwidth,mdescwidth) = registerWidthsFromOpts copts + (datewidth, date) = (10, showDate $ transactionRegisterDate reportq thisacctq t) + (amtwidth, balwidth) + | shortfall <= 0 = (preferredamtwidth, preferredbalwidth) + | otherwise = (adjustedamtwidth, adjustedbalwidth) + where + mincolwidth = 2 -- columns always show at least an ellipsis + maxamtswidth = max 0 (totalwidth - (datewidth + 1 + mincolwidth + 2 + mincolwidth + 2 + 2)) + shortfall = (preferredamtwidth + preferredbalwidth) - maxamtswidth + amtwidthproportion = fromIntegral preferredamtwidth / fromIntegral (preferredamtwidth + preferredbalwidth) + adjustedamtwidth = round $ amtwidthproportion * fromIntegral maxamtswidth + adjustedbalwidth = maxamtswidth - adjustedamtwidth + + remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth) + (descwidth, acctwidth) = (w, remaining - 2 - w) + where + w = fromMaybe ((remaining - 2) `div` 2) mdescwidth + + -- gather content + desc = T.unpack tdescription + accts = -- T.unpack $ elideAccountName acctwidth $ T.pack + otheracctsstr + showamt + | no_elide_ = showMixedAmountOneLineWithoutPrice color_ + | otherwise = showMixedAmountElided color_ + amt = showamt change + bal = showamt balance + -- alternate behaviour, show null amounts as 0 instead of blank + -- amt = if null amt' then "0" else amt' + -- bal = if null bal' then "0" else bal' + (amtlines, ballines) = (lines amt, lines bal) + (amtlen, ballen) = (length amtlines, length ballines) + numlines = max 1 (max amtlen ballen) + (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat "" -- posting amount is top-aligned + (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned + spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' ' + +-- tests + +tests_Aregister = tests "Aregister" [ + + ] diff --git a/hledger/Hledger/Cli/Commands/Aregister.md b/hledger/Hledger/Cli/Commands/Aregister.md new file mode 100644 index 000000000..30d4d1fd5 --- /dev/null +++ b/hledger/Hledger/Cli/Commands/Aregister.md @@ -0,0 +1,67 @@ +aregister, areg\ +Show transactions affecting a particular account, and the account's +running balance. + +_FLAGS + +`aregister` shows the transactions affecting a particular account +(and its subaccounts), from the point of view of that account. +Each line shows: + +- the transaction's (or posting's, see below) date +- the names of the other account(s) involved +- the net change to this account's balance +- the account's historical running balance (including balance from + transactions before the report start date). + +With `aregister`, each line represents a whole transaction - as in +hledger-ui, hledger-web, and your bank statement. By contrast, the +`register` command shows individual postings, across all accounts. +You might prefer `aregister` for reconciling with real-world +asset/liability accounts, and `register` for reviewing detailed +revenues/expenses. + +An account must be specified as the first argument, which should be +the full account name or an account pattern (regular expression). +aregister will show transactions in this account (the first one +matched) and any of its subaccounts. + +Any additional arguments form a query which will filter the +transactions shown. + +Transactions making a net change of zero are not shown by default; +add the `-E/--empty` flag to show them. + +## aregister and custom posting dates + +Transactions whose date is outside the report period can still be +shown, if they have a posting to this account dated inside the report +period. (And in this case it's the posting date that is shown.) +This ensures that `aregister` can show an accurate historical running +balance, matching the one shown by `register -H` with the same +arguments. + +To filter strictly by transaction date instead, add the `--txn-dates` +flag. If you use this flag and some of your postings have custom +dates, it's probably best to assume the running balance is wrong. + +### Output format + +This command also supports the +[output destination](hledger.html#output-destination) and +[output format](hledger.html#output-format) options +The output formats supported are `txt`, `csv`, and `json`. + +Examples: + +Show all transactions and historical running balance in the first +account whose name contains "checking": +```shell +$ hledger areg checking +``` + +Show transactions and historical running balance in all asset accounts +during july: +```shell +$ hledger areg assets date:jul +``` diff --git a/hledger/Hledger/Cli/Commands/Aregister.txt b/hledger/Hledger/Cli/Commands/Aregister.txt new file mode 100644 index 000000000..602c793cd --- /dev/null +++ b/hledger/Hledger/Cli/Commands/Aregister.txt @@ -0,0 +1,60 @@ +aregister, areg +Show transactions affecting a particular account, and the account's +running balance. + +_FLAGS + +aregister shows the transactions affecting a particular account (and its +subaccounts), from the point of view of that account. Each line shows: + +- the transaction's (or posting's, see below) date +- the names of the other account(s) involved +- the net change to this account's balance +- the account's historical running balance (including balance from + transactions before the report start date). + +This is different from register, which shows individual postings. With +aregister, each line represents a whole transaction - as in hledger-ui, +hledger-web, and your bank statement. You might prefer aregister for +reconciling with real-world asset/liability accounts, and register for +reviewing detailed revenues/expenses. + +An account must be specified as the first argument, which should be the +full account name or an account pattern (regular expression). aregister +will show transactions in this account (the first one matched) and any +of its subaccounts. + +Any additional arguments form a query which will filter the transactions +shown. + +Transactions making a net change of zero are not shown by default; add +the -E/--empty flag to show them. + +aregister and custom posting dates + +Transactions whose date is outside the report period can still be shown, +if they have a posting to this account dated inside the report period. +(And in this case it's the posting date that is shown.) This ensures +that aregister can show an accurate historical running balance, matching +the one shown by register -H with the same arguments. + +To filter strictly by transaction date instead, add the --txn-dates +flag. If you use this flag and some of your postings have custom dates, +it's probably best to assume the running balance is wrong. + +Output format + +This command also supports the output destination and output format +options The output formats supported are txt, csv, and json. + +Examples: + +Show all transactions and historical running balance in the first +account whose name contains "checking": + +$ hledger areg checking + +Show transactions and historical running balance in all asset accounts +during july: + +$ hledger areg assets date:jul diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 5a772ed64..dc51971c2 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: bf35436858458ba596817d0df9607254f9cc89ef56e8e33c50592da42d6ab9a6 +-- hash: c1625e78b08f4636b95a4c4913115d62e4603dbfbd9d715188f442a33ae2016d name: hledger version: 1.18.99 @@ -61,6 +61,7 @@ extra-source-files: Hledger/Cli/Commands/Accounts.txt Hledger/Cli/Commands/Activity.txt Hledger/Cli/Commands/Add.txt + Hledger/Cli/Commands/Aregister.txt Hledger/Cli/Commands/Balance.txt Hledger/Cli/Commands/Balancesheet.txt Hledger/Cli/Commands/Balancesheetequity.txt @@ -116,6 +117,7 @@ library Hledger.Cli.Commands.Accounts Hledger.Cli.Commands.Activity Hledger.Cli.Commands.Add + Hledger.Cli.Commands.Aregister Hledger.Cli.Commands.Balance Hledger.Cli.Commands.Balancesheet Hledger.Cli.Commands.Balancesheetequity diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 0739bb7a6..d188e9404 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -1553,6 +1553,10 @@ _include_(Hledger/Cli/Commands/Activity.md) _include_(Hledger/Cli/Commands/Add.md) +## aregister + +_include_(Hledger/Cli/Commands/Aregister.md) + ## balance _include_({{Hledger/Cli/Commands/Balance.md}}) diff --git a/hledger/package.yaml b/hledger/package.yaml index c1fb0ba65..8b025df0f 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -55,6 +55,7 @@ extra-source-files: - Hledger/Cli/Commands/Accounts.txt - Hledger/Cli/Commands/Activity.txt - Hledger/Cli/Commands/Add.txt +- Hledger/Cli/Commands/Aregister.txt - Hledger/Cli/Commands/Balance.txt - Hledger/Cli/Commands/Balancesheet.txt - Hledger/Cli/Commands/Balancesheetequity.txt @@ -163,6 +164,7 @@ library: - Hledger.Cli.Commands.Accounts - Hledger.Cli.Commands.Activity - Hledger.Cli.Commands.Add + - Hledger.Cli.Commands.Aregister - Hledger.Cli.Commands.Balance - Hledger.Cli.Commands.Balancesheet - Hledger.Cli.Commands.Balancesheetequity