bal, reg, stats: clarify report modes, output, options
- try to clarify naming and meaning of balance/register report modes and kinds of "balance" displayed. Added balance --change and register --cumulative flags to clarify report modes. - with multiple --change/--cumulative/--historical flags use the last instead of complaining - register -A is now affected by -H - options cleanups
This commit is contained in:
		
							parent
							
								
									c1ddbfc08a
								
							
						
					
					
						commit
						69ebc3b159
					
				@ -75,7 +75,7 @@ flatShowsExclusiveBalance    = True
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
-- | Generate a simple balance report, containing the matched accounts and
 | 
					-- | Generate a simple balance report, containing the matched accounts and
 | 
				
			||||||
-- their balances (change of balance) during the specified period.
 | 
					-- their balances (change of balance) during the specified period.
 | 
				
			||||||
-- This is like periodBalanceReport with a single column (but more mature,
 | 
					-- This is like PeriodChangeReport with a single column (but more mature,
 | 
				
			||||||
-- eg this can do hierarchical display).
 | 
					-- eg this can do hierarchical display).
 | 
				
			||||||
balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
 | 
					balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
 | 
				
			||||||
balanceReport opts q j = (items, total)
 | 
					balanceReport opts q j = (items, total)
 | 
				
			||||||
@ -137,7 +137,7 @@ balanceReportItem opts q a
 | 
				
			|||||||
-- -- the above using the newer multi balance report code:
 | 
					-- -- the above using the newer multi balance report code:
 | 
				
			||||||
-- balanceReport' opts q j = (items, total)
 | 
					-- balanceReport' opts q j = (items, total)
 | 
				
			||||||
--   where
 | 
					--   where
 | 
				
			||||||
--     MultiBalanceReport (_,mbrrows,mbrtotals) = periodBalanceReport opts q j
 | 
					--     MultiBalanceReport (_,mbrrows,mbrtotals) = PeriodChangeReport opts q j
 | 
				
			||||||
--     items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows]
 | 
					--     items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows]
 | 
				
			||||||
--     total = headDef 0 mbrtotals
 | 
					--     total = headDef 0 mbrtotals
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -173,7 +173,7 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, items, totalsrow
 | 
				
			|||||||
           | (a,changes) <- acctBalChanges
 | 
					           | (a,changes) <- acctBalChanges
 | 
				
			||||||
           , let displayedBals = case balancetype_ opts of
 | 
					           , let displayedBals = case balancetype_ opts of
 | 
				
			||||||
                                  HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
 | 
					                                  HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
 | 
				
			||||||
                                  CumulativeBalance -> drop 1 $ scanl (+) nullmixedamt changes
 | 
					                                  CumulativeChange -> drop 1 $ scanl (+) nullmixedamt changes
 | 
				
			||||||
                                  _                 -> changes
 | 
					                                  _                 -> changes
 | 
				
			||||||
           , let rowtot = sum displayedBals
 | 
					           , let rowtot = sum displayedBals
 | 
				
			||||||
           , let rowavg = averageMixedAmounts displayedBals
 | 
					           , let rowavg = averageMixedAmounts displayedBals
 | 
				
			||||||
 | 
				
			|||||||
@ -47,7 +47,10 @@ type PostingsReportItem = (Maybe Day    -- The posting date, if this is the firs
 | 
				
			|||||||
                                        -- the interval.
 | 
					                                        -- the interval.
 | 
				
			||||||
                          ,Maybe String -- The posting's transaction's description, if this is the first posting in the transaction.
 | 
					                          ,Maybe String -- The posting's transaction's description, if this is the first posting in the transaction.
 | 
				
			||||||
                          ,Posting      -- The posting, possibly with the account name depth-clipped.
 | 
					                          ,Posting      -- The posting, possibly with the account name depth-clipped.
 | 
				
			||||||
                          ,MixedAmount  -- The running total after this posting (or with --average, the running average).
 | 
					                          ,MixedAmount  -- The running total after this posting, or with --average,
 | 
				
			||||||
 | 
					                                        -- the running average posting amount. With --historical,
 | 
				
			||||||
 | 
					                                        -- postings before the report start date are included in
 | 
				
			||||||
 | 
					                                        -- the running total/average.
 | 
				
			||||||
                          )
 | 
					                          )
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Select postings from the journal and add running balance and other
 | 
					-- | Select postings from the journal and add running balance and other
 | 
				
			||||||
@ -70,9 +73,15 @@ postingsReport opts q j = (totallabel, items)
 | 
				
			|||||||
          showempty = empty_ opts || average_ opts
 | 
					          showempty = empty_ opts || average_ opts
 | 
				
			||||||
 | 
					
 | 
				
			||||||
      -- posting report items ready for display
 | 
					      -- posting report items ready for display
 | 
				
			||||||
      items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth startbal runningcalc 1
 | 
					      items = dbg1 "postingsReport items" $ postingsReportItems displayps (nullposting,Nothing) whichdate depth startbal runningcalc startnum
 | 
				
			||||||
        where
 | 
					        where
 | 
				
			||||||
          startbal = if balancetype_ opts == HistoricalBalance then sumPostings precedingps else 0
 | 
					          historical = balancetype_ opts == HistoricalBalance
 | 
				
			||||||
 | 
					          precedingsum = sumPostings precedingps
 | 
				
			||||||
 | 
					          precedingavg | null precedingps = 0
 | 
				
			||||||
 | 
					                       | otherwise        = precedingsum `divideMixedAmount` (fromIntegral $ length precedingps)
 | 
				
			||||||
 | 
					          startbal | average_ opts = if historical then precedingavg else 0
 | 
				
			||||||
 | 
					                   | otherwise     = if historical then precedingsum else 0
 | 
				
			||||||
 | 
					          startnum = if historical then length precedingps + 1 else 1
 | 
				
			||||||
          runningcalc | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i) -- running average
 | 
					          runningcalc | average_ opts = \i avg amt -> avg + (amt - avg) `divideMixedAmount` (fromIntegral i) -- running average
 | 
				
			||||||
                      | otherwise     = \_ bal amt -> bal + amt                                              -- running total
 | 
					                      | otherwise     = \_ bal amt -> bal + amt                                              -- running total
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -46,13 +46,15 @@ import Hledger.Utils
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
type FormatStr = String
 | 
					type FormatStr = String
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Which balance is being shown in a multi-column balance report.
 | 
					-- | Which "balance" is being shown in a balance report.
 | 
				
			||||||
data BalanceType = PeriodBalance     -- ^ The change of balance in each period.
 | 
					data BalanceType = PeriodChange      -- ^ The change of balance in each period.
 | 
				
			||||||
                 | CumulativeBalance -- ^ The accumulated balance at each period's end, starting from zero at the report start date.
 | 
					                 | CumulativeChange  -- ^ The accumulated change across multiple periods.
 | 
				
			||||||
                 | HistoricalBalance -- ^ The historical balance at each period's end, starting from the account balances at the report start date.
 | 
					                 | HistoricalBalance -- ^ The historical ending balance, including the effect of
 | 
				
			||||||
 | 
					                                     --   all postings before the report period. Unless altered by,
 | 
				
			||||||
 | 
					                                     --   a query, this is what you would see on a bank statement.
 | 
				
			||||||
  deriving (Eq,Show,Data,Typeable)
 | 
					  deriving (Eq,Show,Data,Typeable)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
instance Default BalanceType where def = PeriodBalance
 | 
					instance Default BalanceType where def = PeriodChange
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ?
 | 
					-- | Should accounts be displayed: in the command's default style, hierarchically, or as a flat list ?
 | 
				
			||||||
data AccountListMode = ALDefault | ALTree | ALFlat deriving (Eq, Show, Data, Typeable)
 | 
					data AccountListMode = ALDefault | ALTree | ALFlat deriving (Eq, Show, Data, Typeable)
 | 
				
			||||||
@ -116,30 +118,46 @@ defreportopts = ReportOpts
 | 
				
			|||||||
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
 | 
					rawOptsToReportOpts :: RawOpts -> IO ReportOpts
 | 
				
			||||||
rawOptsToReportOpts rawopts = checkReportOpts <$> do
 | 
					rawOptsToReportOpts rawopts = checkReportOpts <$> do
 | 
				
			||||||
  d <- getCurrentDay
 | 
					  d <- getCurrentDay
 | 
				
			||||||
 | 
					  let rawopts' = checkRawOpts rawopts
 | 
				
			||||||
  return defreportopts{
 | 
					  return defreportopts{
 | 
				
			||||||
     period_      = periodFromRawOpts d rawopts
 | 
					     period_      = periodFromRawOpts d rawopts'
 | 
				
			||||||
    ,interval_    = intervalFromRawOpts rawopts
 | 
					    ,interval_    = intervalFromRawOpts rawopts'
 | 
				
			||||||
    ,clearedstatus_ = clearedStatusFromRawOpts rawopts
 | 
					    ,clearedstatus_ = clearedStatusFromRawOpts rawopts'
 | 
				
			||||||
    ,cost_        = boolopt "cost" rawopts
 | 
					    ,cost_        = boolopt "cost" rawopts'
 | 
				
			||||||
    ,depth_       = maybeintopt "depth" rawopts
 | 
					    ,depth_       = maybeintopt "depth" rawopts'
 | 
				
			||||||
    ,display_     = maybedisplayopt d rawopts
 | 
					    ,display_     = maybedisplayopt d rawopts'
 | 
				
			||||||
    ,date2_       = boolopt "date2" rawopts
 | 
					    ,date2_       = boolopt "date2" rawopts'
 | 
				
			||||||
    ,empty_       = boolopt "empty" rawopts
 | 
					    ,empty_       = boolopt "empty" rawopts'
 | 
				
			||||||
    ,no_elide_    = boolopt "no-elide" rawopts
 | 
					    ,no_elide_    = boolopt "no-elide" rawopts'
 | 
				
			||||||
    ,real_        = boolopt "real" rawopts
 | 
					    ,real_        = boolopt "real" rawopts'
 | 
				
			||||||
    ,format_      = maybestringopt "format" rawopts -- XXX move to CliOpts or move validation from Cli.CliOptions to here
 | 
					    ,format_      = maybestringopt "format" rawopts' -- XXX move to CliOpts or move validation from Cli.CliOptions to here
 | 
				
			||||||
    ,query_       = unwords $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right
 | 
					    ,query_       = unwords $ listofstringopt "args" rawopts' -- doesn't handle an arg like "" right
 | 
				
			||||||
    ,average_     = boolopt "average" rawopts
 | 
					    ,average_     = boolopt "average" rawopts'
 | 
				
			||||||
    ,related_     = boolopt "related" rawopts
 | 
					    ,related_     = boolopt "related" rawopts'
 | 
				
			||||||
    ,balancetype_ = balancetypeopt rawopts
 | 
					    ,balancetype_ = balancetypeopt rawopts'
 | 
				
			||||||
    ,accountlistmode_ = accountlistmodeopt rawopts
 | 
					    ,accountlistmode_ = accountlistmodeopt rawopts'
 | 
				
			||||||
    ,drop_        = intopt "drop" rawopts
 | 
					    ,drop_        = intopt "drop" rawopts'
 | 
				
			||||||
    ,row_total_   = boolopt "row-total" rawopts
 | 
					    ,row_total_   = boolopt "row-total" rawopts'
 | 
				
			||||||
    ,no_total_    = boolopt "no-total" rawopts
 | 
					    ,no_total_    = boolopt "no-total" rawopts'
 | 
				
			||||||
    ,value_       = boolopt "value" rawopts
 | 
					    ,value_       = boolopt "value" rawopts'
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Do extra validation of opts, raising an error if there is trouble.
 | 
					-- | Do extra validation of raw option values, raising an error if there's a problem.
 | 
				
			||||||
 | 
					checkRawOpts :: RawOpts -> RawOpts
 | 
				
			||||||
 | 
					checkRawOpts rawopts
 | 
				
			||||||
 | 
					-- our standard behaviour is to accept conflicting options actually,
 | 
				
			||||||
 | 
					-- using the last one - more forgiving for overriding command-line aliases
 | 
				
			||||||
 | 
					--   | countopts ["change","cumulative","historical"] > 1
 | 
				
			||||||
 | 
					--     = optserror "please specify at most one of --change, --cumulative, --historical"
 | 
				
			||||||
 | 
					--   | countopts ["flat","tree"] > 1
 | 
				
			||||||
 | 
					--     = optserror "please specify at most one of --flat, --tree"
 | 
				
			||||||
 | 
					--   | countopts ["daily","weekly","monthly","quarterly","yearly"] > 1
 | 
				
			||||||
 | 
					--     = optserror "please specify at most one of --daily, "
 | 
				
			||||||
 | 
					  | otherwise = rawopts
 | 
				
			||||||
 | 
					--   where
 | 
				
			||||||
 | 
					--     countopts = length . filter (`boolopt` rawopts)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					-- | Do extra validation of report options, raising an error if there's a problem.
 | 
				
			||||||
checkReportOpts :: ReportOpts -> ReportOpts
 | 
					checkReportOpts :: ReportOpts -> ReportOpts
 | 
				
			||||||
checkReportOpts ropts@ReportOpts{..} =
 | 
					checkReportOpts ropts@ReportOpts{..} =
 | 
				
			||||||
  either optserror (const ropts) $ do
 | 
					  either optserror (const ropts) $ do
 | 
				
			||||||
@ -155,14 +173,11 @@ accountlistmodeopt rawopts =
 | 
				
			|||||||
    _          -> ALDefault
 | 
					    _          -> ALDefault
 | 
				
			||||||
 | 
					
 | 
				
			||||||
balancetypeopt :: RawOpts -> BalanceType
 | 
					balancetypeopt :: RawOpts -> BalanceType
 | 
				
			||||||
balancetypeopt rawopts
 | 
					balancetypeopt rawopts =
 | 
				
			||||||
    | length [o | o <- ["cumulative","historical"], isset o] > 1
 | 
					  case reverse $ filter (`elem` ["change","cumulative","historical"]) $ map fst rawopts of
 | 
				
			||||||
                         = optserror "please specify at most one of --cumulative and --historical"
 | 
					    ("historical":_) -> HistoricalBalance
 | 
				
			||||||
    | isset "cumulative" = CumulativeBalance
 | 
					    ("cumulative":_) -> CumulativeChange
 | 
				
			||||||
    | isset "historical" = HistoricalBalance
 | 
					    _                -> PeriodChange
 | 
				
			||||||
    | otherwise          = PeriodBalance
 | 
					 | 
				
			||||||
    where
 | 
					 | 
				
			||||||
      isset = flip boolopt rawopts
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- Get the period specified by the intersection of -b/--begin, -e/--end and/or
 | 
					-- Get the period specified by the intersection of -b/--begin, -e/--end and/or
 | 
				
			||||||
-- -p/--period options, using the given date to interpret relative date expressions.
 | 
					-- -p/--period options, using the given date to interpret relative date expressions.
 | 
				
			||||||
 | 
				
			|||||||
@ -239,8 +239,8 @@ module Hledger.Cli.Balance (
 | 
				
			|||||||
 ,balance
 | 
					 ,balance
 | 
				
			||||||
 ,balanceReportAsText
 | 
					 ,balanceReportAsText
 | 
				
			||||||
 ,balanceReportItemAsText
 | 
					 ,balanceReportItemAsText
 | 
				
			||||||
 ,periodBalanceReportAsText
 | 
					 ,periodChangeReportAsText
 | 
				
			||||||
 ,cumulativeBalanceReportAsText
 | 
					 ,cumulativeChangeReportAsText
 | 
				
			||||||
 ,historicalBalanceReportAsText
 | 
					 ,historicalBalanceReportAsText
 | 
				
			||||||
 ,tests_Hledger_Cli_Balance
 | 
					 ,tests_Hledger_Cli_Balance
 | 
				
			||||||
) where
 | 
					) where
 | 
				
			||||||
@ -267,17 +267,21 @@ balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don
 | 
				
			|||||||
  modeHelp = "show accounts and balances" `withAliases` aliases
 | 
					  modeHelp = "show accounts and balances" `withAliases` aliases
 | 
				
			||||||
 ,modeGroupFlags = C.Group {
 | 
					 ,modeGroupFlags = C.Group {
 | 
				
			||||||
     groupUnnamed = [
 | 
					     groupUnnamed = [
 | 
				
			||||||
      flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show accounts as a tree (default in simple reports)"
 | 
					      flagNone ["change"] (\opts -> setboolopt "change" opts)
 | 
				
			||||||
     ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list (default in multicolumn mode)"
 | 
					        "show balance change in each period (default)"
 | 
				
			||||||
     ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"
 | 
					     ,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts)
 | 
				
			||||||
     ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "singlecolumn mode: use this custom line format"
 | 
					        "show balance change accumulated across periods (in multicolumn reports)"
 | 
				
			||||||
     ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "tree mode: don't squash boring parent accounts"
 | 
					     ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts)
 | 
				
			||||||
     ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "show historical ending balances, reflecting postings before report start"
 | 
					        "show historical ending balance in each period (includes postings before report start date)\n "
 | 
				
			||||||
     ,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) "in multicolumn mode: show ending balances accumulated from 0 at report start"
 | 
					     ,flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show accounts as a tree; amounts include subaccounts (default in simple reports)"
 | 
				
			||||||
     ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "multicolumn mode: show a row average column"
 | 
					     ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list; amounts exclude subaccounts except when account is depth-clipped (default in multicolumn reports)\n "
 | 
				
			||||||
     ,flagNone ["row-total","T"] (\opts -> setboolopt "row-total" opts) "multicolumn mode: show a row total column"
 | 
					     ,flagNone ["value","V"] (setboolopt "value") "convert amounts to current market value in their default valuation commodity"
 | 
				
			||||||
     ,flagNone ["no-total","N"] (\opts -> setboolopt "no-total" opts) "don't show the final total row"
 | 
					     ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a row average column (in multicolumn reports)"
 | 
				
			||||||
     ,flagNone ["value","V"] (setboolopt "value") "show amounts as their current market value in their default valuation commodity"
 | 
					     ,flagNone ["row-total","T"] (\opts -> setboolopt "row-total" opts) "show a row total column (in multicolumn reports)"
 | 
				
			||||||
 | 
					     ,flagNone ["no-total","N"] (\opts -> setboolopt "no-total" opts) "omit the final total row"
 | 
				
			||||||
 | 
					     ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "omit N leading account name parts (in flat mode)"
 | 
				
			||||||
 | 
					     ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "don't squash boring parent accounts (in tree mode)"
 | 
				
			||||||
 | 
					     ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)"
 | 
				
			||||||
     ]
 | 
					     ]
 | 
				
			||||||
     ++ outputflags
 | 
					     ++ outputflags
 | 
				
			||||||
    ,groupHidden = []
 | 
					    ,groupHidden = []
 | 
				
			||||||
@ -305,7 +309,7 @@ balance opts@CliOpts{reportopts_=ropts} j = do
 | 
				
			|||||||
          let report
 | 
					          let report
 | 
				
			||||||
                -- For --historical/--cumulative, we must use multiBalanceReport.
 | 
					                -- For --historical/--cumulative, we must use multiBalanceReport.
 | 
				
			||||||
                -- (This forces --no-elide.)
 | 
					                -- (This forces --no-elide.)
 | 
				
			||||||
                | balancetype_ ropts `elem` [HistoricalBalance, CumulativeBalance]
 | 
					                | balancetype_ ropts `elem` [HistoricalBalance, CumulativeChange]
 | 
				
			||||||
                  = let ropts' | flat_ ropts = ropts
 | 
					                  = let ropts' | flat_ ropts = ropts
 | 
				
			||||||
                               | otherwise   = ropts{accountlistmode_=ALTree}
 | 
					                               | otherwise   = ropts{accountlistmode_=ALTree}
 | 
				
			||||||
                    in singleBalanceReport ropts' (queryFromOpts d ropts) j
 | 
					                    in singleBalanceReport ropts' (queryFromOpts d ropts) j
 | 
				
			||||||
@ -323,8 +327,8 @@ balance opts@CliOpts{reportopts_=ropts} j = do
 | 
				
			|||||||
              render = case format of
 | 
					              render = case format of
 | 
				
			||||||
                "csv" -> \ropts r -> (++ "\n") $ printCSV $ multiBalanceReportAsCsv ropts r
 | 
					                "csv" -> \ropts r -> (++ "\n") $ printCSV $ multiBalanceReportAsCsv ropts r
 | 
				
			||||||
                _     -> case baltype of
 | 
					                _     -> case baltype of
 | 
				
			||||||
                  PeriodBalance     -> periodBalanceReportAsText
 | 
					                  PeriodChange     -> periodChangeReportAsText
 | 
				
			||||||
                  CumulativeBalance -> cumulativeBalanceReportAsText
 | 
					                  CumulativeChange -> cumulativeChangeReportAsText
 | 
				
			||||||
                  HistoricalBalance -> historicalBalanceReportAsText
 | 
					                  HistoricalBalance -> historicalBalanceReportAsText
 | 
				
			||||||
          writeOutput opts $ render ropts $ convert report
 | 
					          writeOutput opts $ render ropts $ convert report
 | 
				
			||||||
 | 
					
 | 
				
			||||||
@ -389,6 +393,7 @@ tests_balanceReportAsText = [
 | 
				
			|||||||
 ]
 | 
					 ]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
{-
 | 
					{-
 | 
				
			||||||
 | 
					:r
 | 
				
			||||||
This implementation turned out to be a bit convoluted but implements the following algorithm for formatting:
 | 
					This implementation turned out to be a bit convoluted but implements the following algorithm for formatting:
 | 
				
			||||||
 | 
					
 | 
				
			||||||
- If there is a single amount, print it with the account name directly:
 | 
					- If there is a single amount, print it with the account name directly:
 | 
				
			||||||
@ -477,8 +482,8 @@ multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, (coltotals,to
 | 
				
			|||||||
           )]
 | 
					           )]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Render a multi-column period balance report as plain text suitable for console output.
 | 
					-- | Render a multi-column period balance report as plain text suitable for console output.
 | 
				
			||||||
periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
 | 
					periodChangeReportAsText :: ReportOpts -> MultiBalanceReport -> String
 | 
				
			||||||
periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
 | 
					periodChangeReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
 | 
				
			||||||
  unlines $
 | 
					  unlines $
 | 
				
			||||||
  ([printf "Balance changes in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
 | 
					  ([printf "Balance changes in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
 | 
				
			||||||
  trimborder $ lines $
 | 
					  trimborder $ lines $
 | 
				
			||||||
@ -511,8 +516,8 @@ periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotal
 | 
				
			|||||||
                                    ))
 | 
					                                    ))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Render a multi-column cumulative balance report as plain text suitable for console output.
 | 
					-- | Render a multi-column cumulative balance report as plain text suitable for console output.
 | 
				
			||||||
cumulativeBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
 | 
					cumulativeChangeReportAsText :: ReportOpts -> MultiBalanceReport -> String
 | 
				
			||||||
cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
 | 
					cumulativeChangeReportAsText opts r@(MultiBalanceReport (colspans, items, (coltotals,tot,avg))) =
 | 
				
			||||||
  unlines $
 | 
					  unlines $
 | 
				
			||||||
  ([printf "Ending balances (cumulative) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
 | 
					  ([printf "Ending balances (cumulative) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $
 | 
				
			||||||
  trimborder $ lines $
 | 
					  trimborder $ lines $
 | 
				
			||||||
 | 
				
			|||||||
@ -147,8 +147,8 @@ reportflags = [
 | 
				
			|||||||
 | 
					
 | 
				
			||||||
-- | Common output-related flags: --output-file, --output-format...
 | 
					-- | Common output-related flags: --output-file, --output-format...
 | 
				
			||||||
outputflags = [
 | 
					outputflags = [
 | 
				
			||||||
   flagReq  ["output-file","o"]   (\s opts -> Right $ setopt "output-file" s opts) "FILE[.FMT]" "write output to FILE instead of stdout. A recognised FMT suffix influences the format."
 | 
					   flagReq  ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats:\ntxt, csv."
 | 
				
			||||||
  ,flagReq  ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats: txt, csv."
 | 
					  ,flagReq  ["output-file","o"]   (\s opts -> Right $ setopt "output-file" s opts) "FILE" "write output to FILE. A file extension matching one of the above formats selects that format."
 | 
				
			||||||
  ]
 | 
					  ]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
argsFlag :: FlagHelp -> Arg RawOpts
 | 
					argsFlag :: FlagHelp -> Arg RawOpts
 | 
				
			||||||
 | 
				
			|||||||
@ -32,19 +32,22 @@ registermode = (defCommandMode $ ["register"] ++ aliases) {
 | 
				
			|||||||
  modeHelp = "show postings and running total" `withAliases` aliases
 | 
					  modeHelp = "show postings and running total" `withAliases` aliases
 | 
				
			||||||
 ,modeGroupFlags = Group {
 | 
					 ,modeGroupFlags = Group {
 | 
				
			||||||
     groupUnnamed = [
 | 
					     groupUnnamed = [
 | 
				
			||||||
      flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "show historical running balance, reflecting prior postings"
 | 
					      flagNone ["cumulative"]         (\opts -> setboolopt "change" opts)
 | 
				
			||||||
     ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a running average instead of the running total (implies --empty)"
 | 
					        "show running total from report start date (default)"
 | 
				
			||||||
 | 
					     ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts)
 | 
				
			||||||
 | 
					        "show historical running total/balance (includes postings before report start date)\n "
 | 
				
			||||||
 | 
					     ,flagNone ["average","A"] (\opts -> setboolopt "average" opts)
 | 
				
			||||||
 | 
					        "show running average of posting amounts instead of total (implies --empty)"
 | 
				
			||||||
     ,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show postings' siblings instead"
 | 
					     ,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show postings' siblings instead"
 | 
				
			||||||
     ,flagReq  ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N"
 | 
					     ,flagReq  ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N"
 | 
				
			||||||
      (unlines
 | 
					      ("set output width (default: " ++
 | 
				
			||||||
       ["set output width (default:"
 | 
					 | 
				
			||||||
#ifdef mingw32_HOST_OS
 | 
					#ifdef mingw32_HOST_OS
 | 
				
			||||||
       ,(show defaultWidth)
 | 
					       show defaultWidth
 | 
				
			||||||
#else
 | 
					#else
 | 
				
			||||||
       ,"terminal width"
 | 
					       "terminal width"
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
       ,"or COLUMNS. -wN,M sets description width as well)"
 | 
					       ++ " or $COLUMNS). -wN,M sets description width as well."
 | 
				
			||||||
       ])
 | 
					       )
 | 
				
			||||||
    ]
 | 
					    ]
 | 
				
			||||||
     ++ outputflags
 | 
					     ++ outputflags
 | 
				
			||||||
    ,groupHidden = []
 | 
					    ,groupHidden = []
 | 
				
			||||||
 | 
				
			|||||||
@ -33,7 +33,7 @@ statsmode = (defCommandMode $ ["stats"] ++ aliases) {
 | 
				
			|||||||
  modeHelp = "show some journal statistics" `withAliases` aliases
 | 
					  modeHelp = "show some journal statistics" `withAliases` aliases
 | 
				
			||||||
 ,modeGroupFlags = Group {
 | 
					 ,modeGroupFlags = Group {
 | 
				
			||||||
     groupUnnamed = [
 | 
					     groupUnnamed = [
 | 
				
			||||||
        flagReq  ["output-file","o"]   (\s opts -> Right $ setopt "output-file" s opts) "FILE[.FMT]" "write output to FILE instead of stdout. A recognised FMT suffix influences the format."
 | 
					        flagReq  ["output-file","o"]   (\s opts -> Right $ setopt "output-file" s opts) "FILE" "write output to FILE.  A file extension matching one of the above formats selects that format."
 | 
				
			||||||
        ]
 | 
					        ]
 | 
				
			||||||
    ,groupHidden = []
 | 
					    ,groupHidden = []
 | 
				
			||||||
    ,groupNamed = [generalflagsgroup1]
 | 
					    ,groupNamed = [generalflagsgroup1]
 | 
				
			||||||
 | 
				
			|||||||
@ -1,46 +1,49 @@
 | 
				
			|||||||
## balance
 | 
					## balance
 | 
				
			||||||
Show accounts and their balances. Alias: bal.
 | 
					Show accounts and their balances. Alias: bal.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`--tree`
 | 
					`--change`
 | 
				
			||||||
: show short account names, as a tree
 | 
					: show balance change in each period (default)
 | 
				
			||||||
 | 
					 | 
				
			||||||
`--flat`
 | 
					 | 
				
			||||||
: show full account names, as a list (default)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
`--drop=N`
 | 
					 | 
				
			||||||
: in flat mode: omit N leading account name parts
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
`--format=LINEFORMAT`
 | 
					 | 
				
			||||||
: in single-column balance reports: use this custom line format
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
`--no-elide`
 | 
					 | 
				
			||||||
: in tree mode: don't squash boring parent accounts
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
`-H --historical`
 | 
					 | 
				
			||||||
: show historical ending balances, reflecting postings before report start
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
`--cumulative`
 | 
					`--cumulative`
 | 
				
			||||||
: in multicolumn mode: show ending balances accumulated from 0 at report start
 | 
					: show balance change accumulated across periods (in multicolumn reports)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`-H --historical`
 | 
				
			||||||
 | 
					: show historical ending balance in each period (includes postings before report start date)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`--tree`
 | 
				
			||||||
 | 
					: show accounts as a tree; amounts include subaccounts (default in simple reports)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`--flat`
 | 
				
			||||||
 | 
					: show accounts as a list; amounts exclude subaccounts except when account is depth-clipped (default in multicolumn reports)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`-V --value`
 | 
				
			||||||
 | 
					: convert amounts to current market value in their default valuation commodity
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-A --average`
 | 
					`-A --average`
 | 
				
			||||||
: in multicolumn mode: show a row average column
 | 
					: show a row average column (in multicolumn mode)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-T --row-total`
 | 
					`-T --row-total`
 | 
				
			||||||
: in multicolumn mode: show a row total column
 | 
					: show a row total column (in multicolumn mode)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-N --no-total`
 | 
					`-N --no-total`
 | 
				
			||||||
: don't show the final total row
 | 
					: don't show the final total row
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-V --value`
 | 
					`--drop=N`
 | 
				
			||||||
: show amounts as their current market value in their default valuation commodity
 | 
					: omit N leading account name parts (in flat mode)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-o FILE[.FMT] --output-file=FILE[.FMT]`
 | 
					`--no-elide`
 | 
				
			||||||
: write output to FILE instead of stdout. A recognised FMT suffix influences the format.
 | 
					: don't squash boring parent accounts (in tree mode)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`--format=LINEFORMAT`
 | 
				
			||||||
 | 
					: in single-column balance reports: use this custom line format
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-O FMT --output-format=FMT     `
 | 
					`-O FMT --output-format=FMT     `
 | 
				
			||||||
: select the output format. Supported formats:
 | 
					: select the output format. Supported formats:
 | 
				
			||||||
txt, csv.
 | 
					txt, csv.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`-o FILE --output-file=FILE`
 | 
				
			||||||
 | 
					: write output to FILE.  A file extension matching one of the above formats selects that format.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
The balance command displays accounts and balances.
 | 
					The balance command displays accounts and balances.
 | 
				
			||||||
It is hledger's most featureful and most useful command.
 | 
					It is hledger's most featureful and most useful command.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
				
			|||||||
@ -329,13 +329,13 @@ Show transactions from the journal.
 | 
				
			|||||||
`-m STR --match=STR             `
 | 
					`-m STR --match=STR             `
 | 
				
			||||||
: show the transaction whose description is most similar to STR, and is most recent
 | 
					: show the transaction whose description is most similar to STR, and is most recent
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-o FILE[.FMT] --output-file=FILE[.FMT]`
 | 
					 | 
				
			||||||
: write output to FILE instead of stdout. A recognised FMT suffix influences the format.
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
`-O FMT --output-format=FMT     `
 | 
					`-O FMT --output-format=FMT     `
 | 
				
			||||||
: select the output format. Supported formats:
 | 
					: select the output format. Supported formats:
 | 
				
			||||||
txt, csv.
 | 
					txt, csv.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`-o FILE --output-file=FILE`
 | 
				
			||||||
 | 
					: write output to FILE.  A file extension matching one of the above formats selects that format.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
```shell
 | 
					```shell
 | 
				
			||||||
$ hledger print
 | 
					$ hledger print
 | 
				
			||||||
2008/01/01 income
 | 
					2008/01/01 income
 | 
				
			||||||
@ -376,11 +376,14 @@ and
 | 
				
			|||||||
## register
 | 
					## register
 | 
				
			||||||
Show postings and their running total. Alias: reg.
 | 
					Show postings and their running total. Alias: reg.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`--cumulative`
 | 
				
			||||||
 | 
					: show running total from report start date (default)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-H --historical`
 | 
					`-H --historical`
 | 
				
			||||||
: show historical running balance, reflecting prior postings
 | 
					: show historical running total/balance (includes postings before report start date)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-A --average`
 | 
					`-A --average`
 | 
				
			||||||
: show a running average instead of the running total (implies --empty)
 | 
					: show running average of posting amounts instead of total (implies --empty)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-r --related`
 | 
					`-r --related`
 | 
				
			||||||
: show postings' siblings instead
 | 
					: show postings' siblings instead
 | 
				
			||||||
@ -388,13 +391,13 @@ Show postings and their running total. Alias: reg.
 | 
				
			|||||||
`-w N --width=N`
 | 
					`-w N --width=N`
 | 
				
			||||||
: set output width (default: terminal width or COLUMNS. -wN,M sets description width as well)
 | 
					: set output width (default: terminal width or COLUMNS. -wN,M sets description width as well)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-o FILE[.FMT] --output-file=FILE[.FMT]`
 | 
					 | 
				
			||||||
: write output to FILE instead of stdout. A recognised FMT suffix influences the format.
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
`-O FMT --output-format=FMT     `
 | 
					`-O FMT --output-format=FMT     `
 | 
				
			||||||
: select the output format. Supported formats:
 | 
					: select the output format. Supported formats:
 | 
				
			||||||
txt, csv.
 | 
					txt, csv.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					`-o FILE --output-file=FILE`
 | 
				
			||||||
 | 
					: write output to FILE.  A file extension matching one of the above formats selects that format.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
The register command displays postings, one per line, and their
 | 
					The register command displays postings, one per line, and their
 | 
				
			||||||
running total.  This is typically used with a [query](#queries)
 | 
					running total.  This is typically used with a [query](#queries)
 | 
				
			||||||
selecting a particular account, to see that account's activity:
 | 
					selecting a particular account, to see that account's activity:
 | 
				
			||||||
@ -423,6 +426,7 @@ The `--depth` option limits the amount of sub-account detail displayed.
 | 
				
			|||||||
The `--average`/`-A` flag shows the running average posting amount
 | 
					The `--average`/`-A` flag shows the running average posting amount
 | 
				
			||||||
instead of the running total (so, the final number displayed is the
 | 
					instead of the running total (so, the final number displayed is the
 | 
				
			||||||
average for the whole report period). This flag implies `--empty` (see below).
 | 
					average for the whole report period). This flag implies `--empty` (see below).
 | 
				
			||||||
 | 
					It is affected by `--historical`.
 | 
				
			||||||
It works best when showing just one account and one commodity.
 | 
					It works best when showing just one account and one commodity.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
The `--related`/`-r` flag shows the *other* postings in the transactions
 | 
					The `--related`/`-r` flag shows the *other* postings in the transactions
 | 
				
			||||||
@ -502,8 +506,8 @@ The register command also supports the
 | 
				
			|||||||
## stats
 | 
					## stats
 | 
				
			||||||
Show some journal statistics.
 | 
					Show some journal statistics.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
`-o FILE[.FMT] --output-file=FILE[.FMT]`
 | 
					`-o FILE --output-file=FILE`
 | 
				
			||||||
: write output to FILE instead of stdout. A recognised FMT suffix influences the format.
 | 
					: write output to FILE.  A file extension matching one of the above formats selects that format.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
```shell
 | 
					```shell
 | 
				
			||||||
$ hledger stats
 | 
					$ hledger stats
 | 
				
			||||||
 | 
				
			|||||||
		Loading…
	
		Reference in New Issue
	
	Block a user