mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-10 05:39:31 +03:00
lib,cli,ui,web: Introduce ReportSpec, which holds ReportOpts, the day of
the report, and the parsed Query.
This commit is contained in:
parent
2ea1cf102c
commit
d0d39e6153
@ -82,8 +82,8 @@ type AccountTransactionsReportItem =
|
||||
totallabel = "Period Total"
|
||||
balancelabel = "Historical Total"
|
||||
|
||||
accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport
|
||||
accountTransactionsReport ropts j reportq thisacctq = (label, items)
|
||||
accountTransactionsReport :: ReportSpec -> Journal -> Query -> Query -> AccountTransactionsReport
|
||||
accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = (label, items)
|
||||
where
|
||||
-- a depth limit should not affect the account transactions report
|
||||
-- seems unnecessary for some reason XXX
|
||||
@ -115,11 +115,11 @@ accountTransactionsReport ropts j reportq thisacctq = (label, items)
|
||||
styles = journalCommodityStyles j
|
||||
periodlast =
|
||||
fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
|
||||
reportPeriodOrJournalLastDay ropts j
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
reportPeriodOrJournalLastDay rspec j
|
||||
mreportlast = reportPeriodLastDay rspec
|
||||
multiperiod = interval_ ropts /= NoInterval
|
||||
tval = case value_ ropts of
|
||||
Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast (today_ ropts) multiperiod t v
|
||||
Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast (rsToday rspec) multiperiod t v
|
||||
Nothing -> id
|
||||
ts4 =
|
||||
ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $
|
||||
|
@ -23,7 +23,7 @@ import Hledger.Data
|
||||
import Hledger.Read (mamountp')
|
||||
import Hledger.Query
|
||||
import Hledger.Utils
|
||||
import Hledger.Reports.MultiBalanceReport (multiBalanceReportWith)
|
||||
import Hledger.Reports.MultiBalanceReport (multiBalanceReport)
|
||||
import Hledger.Reports.ReportOptions
|
||||
import Hledger.Reports.ReportTypes
|
||||
|
||||
@ -61,10 +61,10 @@ flatShowsExclusiveBalance = True
|
||||
-- their balances (change of balance) during the specified period.
|
||||
-- If the normalbalance_ option is set, it adjusts the sorting and sign of
|
||||
-- amounts (see ReportOpts and CompoundBalanceCommand).
|
||||
balanceReport :: ReportOpts -> Journal -> BalanceReport
|
||||
balanceReport ropts j = (rows, total)
|
||||
balanceReport :: ReportSpec -> Journal -> BalanceReport
|
||||
balanceReport rspec j = (rows, total)
|
||||
where
|
||||
report = multiBalanceReportWith ropts j (journalPriceOracle (infer_value_ ropts) j)
|
||||
report = multiBalanceReport rspec j
|
||||
rows = [( prrFullName row
|
||||
, prrDisplayName row
|
||||
, prrDepth row - 1 -- BalanceReport uses 0-based account depths
|
||||
@ -101,8 +101,8 @@ Right samplejournal2 =
|
||||
tests_BalanceReport = tests "BalanceReport" [
|
||||
|
||||
let
|
||||
(opts,journal) `gives` r = do
|
||||
let opts' = opts{query_=And [queryFromFlags opts, query_ opts]}
|
||||
(rspec,journal) `gives` r = do
|
||||
let opts' = rspec{rsQuery=And [queryFromFlags $ rsOpts rspec, rsQuery rspec]}
|
||||
(eitems, etotal) = r
|
||||
(aitems, atotal) = balanceReport opts' journal
|
||||
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
|
||||
@ -112,10 +112,10 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
tests "balanceReport" [
|
||||
|
||||
test "no args, null journal" $
|
||||
(defreportopts, nulljournal) `gives` ([], 0)
|
||||
(defreportspec, nulljournal) `gives` ([], 0)
|
||||
|
||||
,test "no args, sample journal" $
|
||||
(defreportopts, samplejournal) `gives`
|
||||
(defreportspec, samplejournal) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")
|
||||
,("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00")
|
||||
@ -128,7 +128,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "with --tree" $
|
||||
(defreportopts{accountlistmode_=ALTree}, samplejournal) `gives`
|
||||
(defreportspec{rsOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives`
|
||||
([
|
||||
("assets","assets",0, mamountp' "$0.00")
|
||||
,("assets:bank","bank",1, mamountp' "$2.00")
|
||||
@ -145,7 +145,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "with --depth=N" $
|
||||
(defreportopts{depth_=Just 1}, samplejournal) `gives`
|
||||
(defreportspec{rsOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives`
|
||||
([
|
||||
("expenses", "expenses", 0, mamountp' "$2.00")
|
||||
,("income", "income", 0, mamountp' "$-2.00")
|
||||
@ -153,7 +153,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "with depth:N" $
|
||||
(defreportopts{query_=Depth 1}, samplejournal) `gives`
|
||||
(defreportspec{rsQuery=Depth 1}, samplejournal) `gives`
|
||||
([
|
||||
("expenses", "expenses", 0, mamountp' "$2.00")
|
||||
,("income", "income", 0, mamountp' "$-2.00")
|
||||
@ -161,11 +161,11 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "with date:" $
|
||||
(defreportopts{query_=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
(defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
([], 0)
|
||||
|
||||
,test "with date2:" $
|
||||
(defreportopts{query_=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
(defreportspec{rsQuery=Date2 $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
|
||||
,("income:salary","income:salary",0,mamountp' "$-1.00")
|
||||
@ -173,7 +173,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "with desc:" $
|
||||
(defreportopts{query_=Desc $ toRegexCI' "income"}, samplejournal) `gives`
|
||||
(defreportspec{rsQuery=Desc $ toRegexCI' "income"}, samplejournal) `gives`
|
||||
([
|
||||
("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
|
||||
,("income:salary","income:salary",0, mamountp' "$-1.00")
|
||||
@ -181,7 +181,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "with not:desc:" $
|
||||
(defreportopts{query_=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives`
|
||||
(defreportspec{rsQuery=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives`
|
||||
([
|
||||
("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00")
|
||||
,("assets:cash","assets:cash",0, mamountp' "$-2.00")
|
||||
@ -192,7 +192,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "with period on a populated period" $
|
||||
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}, samplejournal) `gives`
|
||||
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2)}}, samplejournal) `gives`
|
||||
(
|
||||
[
|
||||
("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")
|
||||
@ -201,7 +201,7 @@ tests_BalanceReport = tests "BalanceReport" [
|
||||
Mixed [usd 0])
|
||||
|
||||
,test "with period on an unpopulated period" $
|
||||
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}, samplejournal) `gives`
|
||||
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3)}}, samplejournal) `gives`
|
||||
([], 0)
|
||||
|
||||
|
||||
|
@ -65,12 +65,12 @@ type BudgetReport = PeriodicReport DisplayName BudgetCell
|
||||
-- actual balance changes from the regular transactions,
|
||||
-- and compare these to get a 'BudgetReport'.
|
||||
-- Unbudgeted accounts may be hidden or renamed (see budgetRollup).
|
||||
budgetReport :: ReportOpts -> Bool -> DateSpan -> Journal -> BudgetReport
|
||||
budgetReport ropts' assrt reportspan j = dbg1 "sortedbudgetreport" budgetreport
|
||||
budgetReport :: ReportSpec -> Bool -> DateSpan -> Journal -> BudgetReport
|
||||
budgetReport rspec assrt reportspan j = dbg1 "sortedbudgetreport" budgetreport
|
||||
where
|
||||
-- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled
|
||||
-- and that reports with and without --empty make sense when compared side by side
|
||||
ropts = ropts' { accountlistmode_ = ALTree }
|
||||
ropts = (rsOpts rspec){ accountlistmode_ = ALTree }
|
||||
showunbudgeted = empty_ ropts
|
||||
budgetedaccts =
|
||||
dbg2 "budgetedacctsinperiod" $
|
||||
@ -83,9 +83,9 @@ budgetReport ropts' assrt reportspan j = dbg1 "sortedbudgetreport" budgetreport
|
||||
actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j
|
||||
budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j
|
||||
actualreport@(PeriodicReport actualspans _ _) =
|
||||
dbg1 "actualreport" $ multiBalanceReport ropts{empty_=True} actualj
|
||||
dbg1 "actualreport" $ multiBalanceReport rspec{rsOpts=ropts{empty_=True}} actualj
|
||||
budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =
|
||||
dbg1 "budgetgoalreport" $ multiBalanceReport ropts{empty_=True} budgetj
|
||||
dbg1 "budgetgoalreport" $ multiBalanceReport rspec{rsOpts=ropts{empty_=True}} budgetj
|
||||
budgetgoalreport'
|
||||
-- If no interval is specified:
|
||||
-- budgetgoalreport's span might be shorter actualreport's due to periodic txns;
|
||||
|
@ -32,25 +32,25 @@ type EntriesReport = [EntriesReportItem]
|
||||
type EntriesReportItem = Transaction
|
||||
|
||||
-- | Select transactions for an entries report.
|
||||
entriesReport :: ReportOpts -> Journal -> EntriesReport
|
||||
entriesReport ropts@ReportOpts{..} j@Journal{..} =
|
||||
sortBy (comparing getdate) $ filter (query_ `matchesTransaction`) $ map tvalue jtxns
|
||||
entriesReport :: ReportSpec -> Journal -> EntriesReport
|
||||
entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =
|
||||
sortBy (comparing getdate) $ filter (rsQuery rspec `matchesTransaction`) $ map tvalue jtxns
|
||||
where
|
||||
getdate = transactionDateFn ropts
|
||||
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
|
||||
tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
|
||||
where
|
||||
pvalue p = maybe p
|
||||
(postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast mreportlast today_ False p)
|
||||
(postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast mreportlast (rsToday rspec) False p)
|
||||
value_
|
||||
where
|
||||
periodlast = fromMaybe today_ $ reportPeriodOrJournalLastDay ropts j
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
|
||||
mreportlast = reportPeriodLastDay rspec
|
||||
|
||||
tests_EntriesReport = tests "EntriesReport" [
|
||||
tests "entriesReport" [
|
||||
test "not acct" $ (length $ entriesReport defreportopts{query_=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1
|
||||
,test "date" $ (length $ entriesReport defreportopts{query_=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3
|
||||
test "not acct" $ (length $ entriesReport defreportspec{rsQuery=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1
|
||||
,test "date" $ (length $ entriesReport defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3
|
||||
]
|
||||
]
|
||||
|
||||
|
@ -90,61 +90,61 @@ type ClippedAccountName = AccountName
|
||||
-- CompoundBalanceCommand). hledger's most powerful and useful report, used
|
||||
-- by the balance command (in multiperiod mode) and (via compoundBalanceReport)
|
||||
-- by the bs/cf/is commands.
|
||||
multiBalanceReport :: ReportOpts -> Journal -> MultiBalanceReport
|
||||
multiBalanceReport ropts j = multiBalanceReportWith ropts j (journalPriceOracle infer j)
|
||||
where infer = infer_value_ ropts
|
||||
multiBalanceReport :: ReportSpec -> Journal -> MultiBalanceReport
|
||||
multiBalanceReport rspec j = multiBalanceReportWith rspec j (journalPriceOracle infer j)
|
||||
where infer = infer_value_ $ rsOpts rspec
|
||||
|
||||
-- | A helper for multiBalanceReport. This one takes an extra argument,
|
||||
-- a PriceOracle to be used for looking up market prices. Commands which
|
||||
-- run multiple reports (bs etc.) can generate the price oracle just
|
||||
-- once for efficiency, passing it to each report by calling this
|
||||
-- function directly.
|
||||
multiBalanceReportWith :: ReportOpts -> Journal -> PriceOracle -> MultiBalanceReport
|
||||
multiBalanceReportWith ropts' j priceoracle = report
|
||||
multiBalanceReportWith :: ReportSpec -> Journal -> PriceOracle -> MultiBalanceReport
|
||||
multiBalanceReportWith rspec' j priceoracle = report
|
||||
where
|
||||
-- Queries, report/column dates.
|
||||
reportspan = dbg "reportspan" $ calculateReportSpan ropts' j
|
||||
ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan
|
||||
valuation = makeValuation ropts' j priceoracle -- Must use ropts' instead of ropts,
|
||||
reportspan = dbg "reportspan" $ calculateReportSpan rspec' j
|
||||
rspec = dbg "reportopts" $ makeReportQuery rspec' reportspan
|
||||
valuation = makeValuation rspec' j priceoracle -- Must use rspec' instead of rspec,
|
||||
-- so the reportspan isn't used for valuation
|
||||
|
||||
-- Group postings into their columns.
|
||||
colps = dbg'' "colps" $ getPostingsByColumn ropts j reportspan
|
||||
colps = dbg'' "colps" $ getPostingsByColumn rspec j reportspan
|
||||
colspans = dbg "colspans" $ M.keys colps
|
||||
|
||||
-- The matched accounts with a starting balance. All of these should appear
|
||||
-- in the report, even if they have no postings during the report period.
|
||||
startbals = dbg' "startbals" $ startingBalances ropts j reportspan
|
||||
startbals = dbg' "startbals" $ startingBalances rspec j reportspan
|
||||
|
||||
-- Generate and postprocess the report, negating balances and taking percentages if needed
|
||||
report = dbg' "report" $
|
||||
generateMultiBalanceReport ropts j valuation colspans colps startbals
|
||||
generateMultiBalanceReport rspec j valuation colspans colps startbals
|
||||
|
||||
-- | Generate a compound balance report from a list of CBCSubreportSpec. This
|
||||
-- shares postings between the subreports.
|
||||
compoundBalanceReport :: ReportOpts -> Journal -> [CBCSubreportSpec]
|
||||
compoundBalanceReport :: ReportSpec -> Journal -> [CBCSubreportSpec]
|
||||
-> CompoundBalanceReport
|
||||
compoundBalanceReport ropts j = compoundBalanceReportWith ropts j (journalPriceOracle infer j)
|
||||
where infer = infer_value_ ropts
|
||||
compoundBalanceReport rspec j = compoundBalanceReportWith rspec j (journalPriceOracle infer j)
|
||||
where infer = infer_value_ $ rsOpts rspec
|
||||
|
||||
-- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
|
||||
compoundBalanceReportWith :: ReportOpts -> Journal -> PriceOracle
|
||||
compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle
|
||||
-> [CBCSubreportSpec] -> CompoundBalanceReport
|
||||
compoundBalanceReportWith ropts' j priceoracle subreportspecs = cbr
|
||||
compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
|
||||
where
|
||||
-- Queries, report/column dates.
|
||||
reportspan = dbg "reportspan" $ calculateReportSpan ropts' j
|
||||
ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan
|
||||
valuation = makeValuation ropts' j priceoracle -- Must use ropts' instead of ropts,
|
||||
reportspan = dbg "reportspan" $ calculateReportSpan rspec' j
|
||||
rspec = dbg "reportopts" $ makeReportQuery rspec' reportspan
|
||||
valuation = makeValuation rspec' j priceoracle -- Must use ropts' instead of ropts,
|
||||
-- so the reportspan isn't used for valuation
|
||||
|
||||
-- Group postings into their columns.
|
||||
colps = dbg'' "colps" $ getPostingsByColumn ropts{empty_=True} j reportspan
|
||||
colps = dbg'' "colps" $ getPostingsByColumn rspec{rsOpts=(rsOpts rspec){empty_=True}} j reportspan
|
||||
colspans = dbg "colspans" $ M.keys colps
|
||||
|
||||
-- The matched accounts with a starting balance. All of these should appear
|
||||
-- in the report, even if they have no postings during the report period.
|
||||
startbals = dbg' "startbals" $ startingBalances ropts j reportspan
|
||||
startbals = dbg' "startbals" $ startingBalances rspec j reportspan
|
||||
|
||||
subreports = map generateSubreport subreportspecs
|
||||
where
|
||||
@ -152,11 +152,12 @@ compoundBalanceReportWith ropts' j priceoracle subreportspecs = cbr
|
||||
( cbcsubreporttitle
|
||||
-- Postprocess the report, negating balances and taking percentages if needed
|
||||
, prNormaliseSign cbcsubreportnormalsign $
|
||||
generateMultiBalanceReport ropts' j valuation colspans colps' startbals'
|
||||
generateMultiBalanceReport rspec' j valuation colspans colps' startbals'
|
||||
, cbcsubreportincreasestotal
|
||||
)
|
||||
where
|
||||
ropts' = ropts{normalbalance_=Just cbcsubreportnormalsign}
|
||||
rspec' = rspec{rsOpts=ropts}
|
||||
ropts = (rsOpts rspec){normalbalance_=Just cbcsubreportnormalsign}
|
||||
-- Filter the column postings according to each subreport
|
||||
colps' = filter (matchesPosting $ cbcsubreportquery j) <$> colps
|
||||
startbals' = HM.filterWithKey (\k _ -> matchesAccount (cbcsubreportquery j) k) startbals
|
||||
@ -182,19 +183,20 @@ compoundBalanceReportWith ropts' j priceoracle subreportspecs = cbr
|
||||
-- TODO: Do we want to check whether to bother calculating these? isHistorical
|
||||
-- and startDate is not nothing, otherwise mempty? This currently gives a
|
||||
-- failure with some totals which are supposed to be 0 being blank.
|
||||
startingBalances :: ReportOpts -> Journal -> DateSpan -> HashMap AccountName Account
|
||||
startingBalances ropts j reportspan =
|
||||
acctChangesFromPostings ropts' . map fst $ getPostings ropts' j
|
||||
startingBalances :: ReportSpec -> Journal -> DateSpan -> HashMap AccountName Account
|
||||
startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j reportspan =
|
||||
acctChangesFromPostings rspec' . map fst $ getPostings rspec' j
|
||||
where
|
||||
rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'}
|
||||
ropts' = case accountlistmode_ ropts of
|
||||
ALTree -> ropts{query_=startbalq, period_=precedingperiod, no_elide_=True}
|
||||
ALFlat -> ropts{query_=startbalq, period_=precedingperiod}
|
||||
ALTree -> ropts{period_=precedingperiod, no_elide_=True}
|
||||
ALFlat -> ropts{period_=precedingperiod}
|
||||
|
||||
-- q projected back before the report start date.
|
||||
-- When there's no report start date, in case there are future txns (the hledger-ui case above),
|
||||
-- we use emptydatespan to make sure they aren't counted as starting balance.
|
||||
startbalq = dbg'' "startbalq" $ And [datelessq, precedingspanq]
|
||||
datelessq = dbg "datelessq" . filterQuery (not . queryIsDateOrDate2) $ query_ ropts
|
||||
datelessq = dbg "datelessq" $ filterQuery (not . queryIsDateOrDate2) query
|
||||
|
||||
precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
|
||||
periodAsDateSpan $ period_ ropts
|
||||
@ -204,11 +206,11 @@ startingBalances ropts j reportspan =
|
||||
a -> a
|
||||
|
||||
-- | Calculate the span of the report to be generated.
|
||||
calculateReportSpan :: ReportOpts -> Journal -> DateSpan
|
||||
calculateReportSpan ropts j = reportspan
|
||||
calculateReportSpan :: ReportSpec -> Journal -> DateSpan
|
||||
calculateReportSpan ReportSpec{rsQuery=query,rsOpts=ropts} j = reportspan
|
||||
where
|
||||
-- The date span specified by -b/-e/-p options and query args if any.
|
||||
requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ ropts) $ query_ ropts
|
||||
requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ ropts) query
|
||||
-- If the requested span is open-ended, close it using the journal's end dates.
|
||||
-- This can still be the null (open) span if the journal is empty.
|
||||
requestedspan' = dbg "requestedspan'" $
|
||||
@ -227,37 +229,37 @@ calculateReportSpan ropts j = reportspan
|
||||
-- The user's query expanded to the report span
|
||||
-- if there is one (otherwise any date queries are left as-is, which
|
||||
-- handles the hledger-ui+future txns case above).
|
||||
makeReportQuery :: ReportOpts -> DateSpan -> ReportOpts
|
||||
makeReportQuery ropts reportspan
|
||||
| reportspan == nulldatespan = ropts
|
||||
| otherwise = ropts{query_=query}
|
||||
makeReportQuery :: ReportSpec -> DateSpan -> ReportSpec
|
||||
makeReportQuery rspec reportspan
|
||||
| reportspan == nulldatespan = rspec
|
||||
| otherwise = rspec{rsQuery=query}
|
||||
where
|
||||
query = simplifyQuery $ And [dateless $ query_ ropts, reportspandatesq]
|
||||
query = simplifyQuery $ And [dateless $ rsQuery rspec, reportspandatesq]
|
||||
reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan
|
||||
dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2)
|
||||
dateqcons = if date2_ ropts then Date2 else Date
|
||||
dateqcons = if date2_ (rsOpts rspec) then Date2 else Date
|
||||
|
||||
-- | Make a valuation function for valuating MixedAmounts and a given Day
|
||||
makeValuation :: ReportOpts -> Journal -> PriceOracle -> Day -> MixedAmount -> MixedAmount
|
||||
makeValuation ropts j priceoracle day = case value_ ropts of
|
||||
makeValuation :: ReportSpec -> Journal -> PriceOracle -> (Day -> MixedAmount -> MixedAmount)
|
||||
makeValuation rspec j priceoracle day = case value_ (rsOpts rspec) of
|
||||
Nothing -> id
|
||||
Just v -> mixedAmountApplyValuation priceoracle styles day mreportlast (today_ ropts) multiperiod v
|
||||
Just v -> mixedAmountApplyValuation priceoracle styles day mreportlast (rsToday rspec) multiperiod v
|
||||
where
|
||||
-- Some things needed if doing valuation.
|
||||
styles = journalCommodityStyles j
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
multiperiod = interval_ ropts /= NoInterval
|
||||
mreportlast = reportPeriodLastDay rspec
|
||||
multiperiod = interval_ (rsOpts rspec) /= NoInterval
|
||||
|
||||
-- | Group postings, grouped by their column
|
||||
getPostingsByColumn :: ReportOpts -> Journal -> DateSpan -> Map DateSpan [Posting]
|
||||
getPostingsByColumn ropts j reportspan = columns
|
||||
getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting]
|
||||
getPostingsByColumn rspec j reportspan = columns
|
||||
where
|
||||
-- Postings matching the query within the report period.
|
||||
ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts j
|
||||
ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings rspec j
|
||||
days = map snd ps
|
||||
|
||||
-- The date spans to be included as report columns.
|
||||
colspans = calculateColSpans ropts reportspan days
|
||||
colspans = calculateColSpans (rsOpts rspec) reportspan days
|
||||
addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d
|
||||
emptyMap = M.fromList . zip colspans $ repeat []
|
||||
|
||||
@ -265,19 +267,18 @@ getPostingsByColumn ropts j reportspan = columns
|
||||
columns = foldr addPosting emptyMap ps
|
||||
|
||||
-- | Gather postings matching the query within the report period.
|
||||
getPostings :: ReportOpts -> Journal -> [(Posting, Day)]
|
||||
getPostings ropts =
|
||||
getPostings :: ReportSpec -> Journal -> [(Posting, Day)]
|
||||
getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
|
||||
map (\p -> (p, date p)) .
|
||||
journalPostings .
|
||||
filterJournalAmounts symq . -- remove amount parts excluded by cur:
|
||||
filterJournalPostings reportq -- remove postings not matched by (adjusted) query
|
||||
where
|
||||
q = query_ ropts
|
||||
symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" q
|
||||
symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" query
|
||||
-- The user's query with no depth limit, and expanded to the report span
|
||||
-- if there is one (otherwise any date queries are left as-is, which
|
||||
-- handles the hledger-ui+future txns case above).
|
||||
reportq = dbg "reportq" $ depthless q
|
||||
reportq = dbg "reportq" $ depthless query
|
||||
depthless = dbg "depthless" . filterQuery (not . queryIsDepth)
|
||||
|
||||
date = case whichDateFromOpts ropts of
|
||||
@ -297,17 +298,17 @@ calculateColSpans ropts reportspan days =
|
||||
|
||||
-- | Gather the account balance changes into a regular matrix
|
||||
-- including the accounts from all columns.
|
||||
calculateAccountChanges :: ReportOpts -> [DateSpan] -> Map DateSpan [Posting]
|
||||
calculateAccountChanges :: ReportSpec -> [DateSpan] -> Map DateSpan [Posting]
|
||||
-> HashMap ClippedAccountName (Map DateSpan Account)
|
||||
calculateAccountChanges ropts colspans colps
|
||||
| queryDepth (query_ ropts) == Just 0 = acctchanges <> elided
|
||||
calculateAccountChanges rspec colspans colps
|
||||
| queryDepth (rsQuery rspec) == Just 0 = acctchanges <> elided
|
||||
| otherwise = acctchanges
|
||||
where
|
||||
-- Transpose to get each account's balance changes across all columns.
|
||||
acctchanges = transposeMap colacctchanges
|
||||
|
||||
colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) =
|
||||
dbg'' "colacctchanges" $ fmap (acctChangesFromPostings ropts) colps
|
||||
dbg'' "colacctchanges" $ fmap (acctChangesFromPostings rspec) colps
|
||||
|
||||
elided = HM.singleton "..." $ M.fromList [(span, nullacct) | span <- colspans]
|
||||
|
||||
@ -315,15 +316,16 @@ calculateAccountChanges ropts colspans colps
|
||||
-- the accounts that have postings and calculate the change amount for
|
||||
-- each. Accounts and amounts will be depth-clipped appropriately if
|
||||
-- a depth limit is in effect.
|
||||
acctChangesFromPostings :: ReportOpts -> [Posting] -> HashMap ClippedAccountName Account
|
||||
acctChangesFromPostings ropts ps = HM.fromList [(aname a, a) | a <- as]
|
||||
acctChangesFromPostings :: ReportSpec -> [Posting] -> HashMap ClippedAccountName Account
|
||||
acctChangesFromPostings ReportSpec{rsQuery=query,rsOpts=ropts} ps =
|
||||
HM.fromList [(aname a, a) | a <- as]
|
||||
where
|
||||
as = filterAccounts . drop 1 $ accountsFromPostings ps
|
||||
filterAccounts = case accountlistmode_ ropts of
|
||||
ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
|
||||
ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
|
||||
filter ((0<) . anumpostings)
|
||||
depthq = dbg "depthq" . filterQuery queryIsDepth $ query_ ropts
|
||||
depthq = dbg "depthq" $ filterQuery queryIsDepth query
|
||||
|
||||
-- | Accumulate and value amounts, as specified by the report options.
|
||||
--
|
||||
@ -366,19 +368,20 @@ accumValueAmounts ropts valuation colspans startbals acctchanges = -- PARTIAL:
|
||||
-- | Lay out a set of postings grouped by date span into a regular matrix with rows
|
||||
-- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
|
||||
-- from the columns.
|
||||
generateMultiBalanceReport :: ReportOpts -> Journal -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan]
|
||||
generateMultiBalanceReport :: ReportSpec -> Journal -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan]
|
||||
-> Map DateSpan [Posting] -> HashMap AccountName Account
|
||||
-> MultiBalanceReport
|
||||
generateMultiBalanceReport ropts j valuation colspans colps startbals = report
|
||||
generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j valuation colspans colps startbals =
|
||||
report
|
||||
where
|
||||
-- Each account's balance changes across all columns.
|
||||
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts colspans colps
|
||||
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges rspec colspans colps
|
||||
|
||||
-- Process changes into normal, cumulative, or historical amounts, plus value them
|
||||
accumvalued = accumValueAmounts ropts valuation colspans startbals acctchanges
|
||||
|
||||
-- All account names that will be displayed, possibly depth-clipped.
|
||||
displaynames = dbg'' "displaynames" $ displayedAccounts ropts accumvalued
|
||||
displaynames = dbg'' "displaynames" $ displayedAccounts rspec accumvalued
|
||||
|
||||
-- All the rows of the report.
|
||||
rows = dbg'' "rows" $ buildReportRows ropts displaynames accumvalued
|
||||
@ -417,9 +420,9 @@ buildReportRows ropts displaynames = toList . HM.mapMaybeWithKey mkRow
|
||||
|
||||
-- | Calculate accounts which are to be displayed in the report, as well as
|
||||
-- their name and depth
|
||||
displayedAccounts :: ReportOpts -> HashMap AccountName (Map DateSpan Account)
|
||||
displayedAccounts :: ReportSpec -> HashMap AccountName (Map DateSpan Account)
|
||||
-> HashMap AccountName DisplayName
|
||||
displayedAccounts ropts valuedaccts
|
||||
displayedAccounts ReportSpec{rsQuery=query,rsOpts=ropts} valuedaccts
|
||||
| depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1
|
||||
| otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
|
||||
where
|
||||
@ -460,7 +463,7 @@ displayedAccounts ropts valuedaccts
|
||||
minSubs = if no_elide_ ropts then 1 else 2
|
||||
|
||||
isZeroRow balance = all (mixedAmountLooksZero . balance)
|
||||
depth = fromMaybe maxBound . queryDepth $ query_ ropts
|
||||
depth = fromMaybe maxBound $ queryDepth query
|
||||
numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts
|
||||
|
||||
-- | Sort the rows by amount or by account declaration order.
|
||||
@ -604,10 +607,10 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
|
||||
let
|
||||
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}
|
||||
(opts,journal) `gives` r = do
|
||||
let opts' = opts{query_=And [queryFromFlags opts, query_ opts]}
|
||||
(rspec,journal) `gives` r = do
|
||||
let rspec' = rspec{rsQuery=And [queryFromFlags $ rsOpts rspec, rsQuery rspec]}
|
||||
(eitems, etotal) = r
|
||||
(PeriodicReport _ aitems atotal) = multiBalanceReport opts' journal
|
||||
(PeriodicReport _ aitems atotal) = multiBalanceReport rspec' journal
|
||||
showw (PeriodicReportRow a lAmt amt amt')
|
||||
= (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
|
||||
(map showw aitems) @?= (map showw eitems)
|
||||
@ -615,10 +618,10 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
in
|
||||
tests "multiBalanceReport" [
|
||||
test "null journal" $
|
||||
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt])
|
||||
(defreportspec, nulljournal) `gives` ([], Mixed [nullamt])
|
||||
|
||||
,test "with -H on a populated period" $
|
||||
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
||||
(defreportspec{rsOpts=defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}}, samplejournal) `gives`
|
||||
(
|
||||
[ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (mamountp' "$1.00") (Mixed [amt0 {aquantity=1}])
|
||||
, PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (mamountp' "$-1.00") (Mixed [amt0 {aquantity=(-1)}])
|
||||
|
@ -65,19 +65,19 @@ type SummaryPosting = (Posting, Day)
|
||||
|
||||
-- | Select postings from the journal and add running balance and other
|
||||
-- information to make a postings report. Used by eg hledger's register command.
|
||||
postingsReport :: ReportOpts -> Journal -> PostingsReport
|
||||
postingsReport ropts@ReportOpts{..} j =
|
||||
postingsReport :: ReportSpec -> Journal -> PostingsReport
|
||||
postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =
|
||||
(totallabel, items)
|
||||
where
|
||||
reportspan = adjustReportDates ropts j
|
||||
reportspan = adjustReportDates rspec j
|
||||
whichdate = whichDateFromOpts ropts
|
||||
mdepth = queryDepth query_
|
||||
mdepth = queryDepth $ rsQuery rspec
|
||||
styles = journalCommodityStyles j
|
||||
priceoracle = journalPriceOracle infer_value_ j
|
||||
multiperiod = interval_ /= NoInterval
|
||||
|
||||
-- postings to be included in the report, and similarly-matched postings before the report start date
|
||||
(precedingps, reportps) = matchedPostingsBeforeAndDuring ropts j reportspan
|
||||
(precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan
|
||||
|
||||
-- Postings, or summary postings with their subperiod's end date, to be displayed.
|
||||
displayps :: [(Posting, Maybe Day)]
|
||||
@ -89,12 +89,12 @@ postingsReport ropts@ReportOpts{..} j =
|
||||
where
|
||||
showempty = empty_ || average_
|
||||
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
|
||||
pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast today_ multiperiod p) value_
|
||||
pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast (rsToday rspec) multiperiod p) value_
|
||||
where
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
mreportlast = reportPeriodLastDay rspec
|
||||
reportorjournallast =
|
||||
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
|
||||
reportPeriodOrJournalLastDay ropts j
|
||||
reportPeriodOrJournalLastDay rspec j
|
||||
|
||||
-- Posting report items ready for display.
|
||||
items =
|
||||
@ -112,13 +112,13 @@ postingsReport ropts@ReportOpts{..} j =
|
||||
precedingsum = sumPostings precedingps
|
||||
precedingavg | null precedingps = 0
|
||||
| otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
|
||||
bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing today_ multiperiod) value_
|
||||
bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing (rsToday rspec) multiperiod) value_
|
||||
-- XXX constrain valuation type to AtDate daybeforereportstart here ?
|
||||
where
|
||||
daybeforereportstart =
|
||||
maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen
|
||||
(addDays (-1))
|
||||
$ reportPeriodOrJournalStart ropts j
|
||||
$ reportPeriodOrJournalStart rspec j
|
||||
|
||||
runningcalc = registerRunningCalculationFn ropts
|
||||
startnum = if historical then length precedingps + 1 else 1
|
||||
@ -139,17 +139,17 @@ totallabel = "Total"
|
||||
-- 1. If the start date is unspecified, use the earliest date in the journal (if any)
|
||||
-- 2. If the end date is unspecified, use the latest date in the journal (if any)
|
||||
-- 3. If a report interval is specified, enlarge the dates to enclose whole intervals
|
||||
adjustReportDates :: ReportOpts -> Journal -> DateSpan
|
||||
adjustReportDates opts j = reportspan
|
||||
adjustReportDates :: ReportSpec -> Journal -> DateSpan
|
||||
adjustReportDates rspec@ReportSpec{rsOpts=ropts} j = reportspan
|
||||
where
|
||||
-- see also multiBalanceReport
|
||||
requestedspan = dbg3 "requestedspan" $ queryDateSpan' $ query_ opts -- span specified by -b/-e/-p options and query args
|
||||
requestedspan = dbg3 "requestedspan" $ queryDateSpan' $ rsQuery rspec -- span specified by -b/-e/-p options and query args
|
||||
journalspan = dbg3 "journalspan" $ dates `spanUnion` date2s -- earliest and latest dates (or date2s) in the journal
|
||||
where
|
||||
dates = journalDateSpan False j
|
||||
date2s = journalDateSpan True j
|
||||
requestedspanclosed = dbg3 "requestedspanclosed" $ requestedspan `spanDefaultsFrom` journalspan -- if open-ended, close it using the journal's dates (if any)
|
||||
intervalspans = dbg3 "intervalspans" $ splitSpan (interval_ opts) requestedspanclosed -- get the whole intervals enclosing that
|
||||
intervalspans = dbg3 "intervalspans" $ splitSpan (interval_ ropts) requestedspanclosed -- get the whole intervals enclosing that
|
||||
mreportstart = dbg3 "reportstart" $ maybe Nothing spanStart $ headMay intervalspans -- start of the first interval, or open ended
|
||||
mreportend = dbg3 "reportend" $ maybe Nothing spanEnd $ lastMay intervalspans -- end of the last interval, or open ended
|
||||
reportspan = dbg3 "reportspan" $ DateSpan mreportstart mreportend -- the requested span enlarged to whole intervals if possible
|
||||
@ -158,30 +158,29 @@ adjustReportDates opts j = reportspan
|
||||
-- and also any similarly-matched postings before that date span.
|
||||
-- Date restrictions and depth restrictions in the query are ignored.
|
||||
-- A helper for the postings report.
|
||||
matchedPostingsBeforeAndDuring :: ReportOpts -> Journal -> DateSpan -> ([Posting],[Posting])
|
||||
matchedPostingsBeforeAndDuring opts j (DateSpan mstart mend) =
|
||||
matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting])
|
||||
matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan mstart mend) =
|
||||
dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
|
||||
where
|
||||
q = query_ opts
|
||||
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart
|
||||
beforeandduringps =
|
||||
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2
|
||||
dbg5 "ps4" $ (if invert_ opts then map negatePostingAmount else id) $ -- with --invert, invert amounts
|
||||
dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts
|
||||
dbg5 "ps3" $ map (filterPostingAmount symq) $ -- remove amount parts which the query's cur: terms would exclude
|
||||
dbg5 "ps2" $ (if related_ opts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
|
||||
dbg5 "ps2" $ (if related_ ropts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
|
||||
dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit
|
||||
journalPostings $
|
||||
journalSelectingAmountFromOpts opts j -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ?
|
||||
journalSelectingAmountFromOpts ropts j -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ?
|
||||
where
|
||||
beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]
|
||||
where
|
||||
depthless = filterQuery (not . queryIsDepth)
|
||||
dateless = filterQuery (not . queryIsDateOrDate2)
|
||||
beforeendq = dateqtype $ DateSpan Nothing mend
|
||||
sortdate = if date2_ opts then postingDate2 else postingDate
|
||||
symq = dbg4 "symq" . filterQuery queryIsSym $ query_ opts
|
||||
sortdate = if date2_ ropts then postingDate2 else postingDate
|
||||
symq = dbg4 "symq" $ filterQuery queryIsSym q
|
||||
dateqtype
|
||||
| queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2
|
||||
| queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) = Date2
|
||||
| otherwise = Date
|
||||
where
|
||||
dateq = dbg4 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg4 "q" q -- XXX confused by multiple date:/date2: ?
|
||||
@ -270,7 +269,7 @@ negatePostingAmount p = p { pamount = negate $ pamount p }
|
||||
tests_PostingsReport = tests "PostingsReport" [
|
||||
|
||||
test "postingsReport" $ do
|
||||
let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts{query_=query} journal) @?= n
|
||||
let (query, journal) `gives` n = (length $ snd $ postingsReport defreportspec{rsQuery=query} journal) @?= n
|
||||
-- with the query specified explicitly
|
||||
(Any, nulljournal) `gives` 0
|
||||
(Any, samplejournal) `gives` 13
|
||||
@ -279,10 +278,10 @@ tests_PostingsReport = tests "PostingsReport" [
|
||||
(And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2
|
||||
(And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2
|
||||
-- with query and/or command-line options
|
||||
(length $ snd $ postingsReport defreportopts samplejournal) @?= 13
|
||||
(length $ snd $ postingsReport defreportopts{interval_=Months 1} samplejournal) @?= 11
|
||||
(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} samplejournal) @?= 20
|
||||
(length $ snd $ postingsReport defreportopts{query_=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
|
||||
(length $ snd $ postingsReport defreportspec samplejournal) @?= 13
|
||||
(length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
|
||||
(length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
|
||||
(length $ snd $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
|
||||
|
||||
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
|
||||
-- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1)
|
||||
|
@ -10,12 +10,15 @@ Options common to most hledger reports.
|
||||
|
||||
module Hledger.Reports.ReportOptions (
|
||||
ReportOpts(..),
|
||||
ReportSpec(..),
|
||||
BalanceType(..),
|
||||
AccountListMode(..),
|
||||
ValuationType(..),
|
||||
defreportopts,
|
||||
rawOptsToReportOpts,
|
||||
regenerateReportOpts,
|
||||
defreportspec,
|
||||
reportOptsToSpec,
|
||||
rawOptsToReportSpec,
|
||||
flat_,
|
||||
tree_,
|
||||
reportOptsToggleStatus,
|
||||
@ -78,10 +81,7 @@ instance Default AccountListMode where def = ALFlat
|
||||
-- commands, as noted below.
|
||||
data ReportOpts = ReportOpts {
|
||||
-- for most reports:
|
||||
today_ :: Day -- ^ The current date. A late addition to ReportOpts.
|
||||
-- Reports use it when picking a -V valuation date.
|
||||
-- This is not great, adds indeterminacy.
|
||||
,period_ :: Period
|
||||
period_ :: Period
|
||||
,interval_ :: Interval
|
||||
,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched
|
||||
,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ?
|
||||
@ -92,8 +92,6 @@ data ReportOpts = ReportOpts {
|
||||
,no_elide_ :: Bool
|
||||
,real_ :: Bool
|
||||
,format_ :: StringFormat
|
||||
,query_ :: Query
|
||||
,queryopts_ :: [QueryOpt]
|
||||
,querystring_ :: T.Text
|
||||
--
|
||||
,average_ :: Bool
|
||||
@ -132,8 +130,7 @@ instance Default ReportOpts where def = defreportopts
|
||||
|
||||
defreportopts :: ReportOpts
|
||||
defreportopts = ReportOpts
|
||||
{ today_ = nulldate
|
||||
, period_ = PeriodAll
|
||||
{ period_ = PeriodAll
|
||||
, interval_ = NoInterval
|
||||
, statuses_ = []
|
||||
, value_ = Nothing
|
||||
@ -144,8 +141,6 @@ defreportopts = ReportOpts
|
||||
, no_elide_ = False
|
||||
, real_ = False
|
||||
, format_ = def
|
||||
, query_ = Any
|
||||
, queryopts_ = []
|
||||
, querystring_ = ""
|
||||
, average_ = False
|
||||
, related_ = False
|
||||
@ -181,11 +176,8 @@ rawOptsToReportOpts rawopts = do
|
||||
Just (Right x) -> return x
|
||||
Just (Left err) -> fail $ "could not parse format option: " ++ err
|
||||
|
||||
(argsquery, queryopts) <- either fail return $ parseQuery d querystring
|
||||
|
||||
let reportopts = defreportopts
|
||||
{today_ = d
|
||||
,period_ = periodFromRawOpts d rawopts
|
||||
{period_ = periodFromRawOpts d rawopts
|
||||
,interval_ = intervalFromRawOpts rawopts
|
||||
,statuses_ = statusesFromRawOpts rawopts
|
||||
,value_ = valuationTypeFromRawOpts rawopts
|
||||
@ -196,8 +188,6 @@ rawOptsToReportOpts rawopts = do
|
||||
,no_elide_ = boolopt "no-elide" rawopts
|
||||
,real_ = boolopt "real" rawopts
|
||||
,format_ = format
|
||||
,query_ = simplifyQuery $ And [queryFromFlags reportopts, argsquery]
|
||||
,queryopts_ = queryopts
|
||||
,querystring_ = querystring
|
||||
,average_ = boolopt "average" rawopts
|
||||
,related_ = boolopt "related" rawopts
|
||||
@ -220,11 +210,40 @@ rawOptsToReportOpts rawopts = do
|
||||
}
|
||||
return reportopts
|
||||
|
||||
-- | Regenerate a ReportOpts on a different day with a different query string.
|
||||
regenerateReportOpts :: Day -> T.Text -> ReportOpts -> Either String ReportOpts
|
||||
regenerateReportOpts d querystring ropts = do
|
||||
(q,o) <- parseQuery d querystring
|
||||
return ropts{today_=d, query_=q, queryopts_=o, querystring_=querystring}
|
||||
data ReportSpec = ReportSpec
|
||||
{ rsOpts :: ReportOpts
|
||||
, rsToday :: Day
|
||||
, rsQuery :: Query
|
||||
, rsQueryOpts :: [QueryOpt]
|
||||
} deriving (Show)
|
||||
|
||||
instance Default ReportSpec where def = defreportspec
|
||||
|
||||
defreportspec :: ReportSpec
|
||||
defreportspec = ReportSpec
|
||||
{ rsOpts = def
|
||||
, rsToday = nulldate
|
||||
, rsQuery = Any
|
||||
, rsQueryOpts = []
|
||||
}
|
||||
|
||||
-- | Generate a ReportSpec from a set of ReportOpts on a given day
|
||||
reportOptsToSpec :: Day -> ReportOpts -> Either String ReportSpec
|
||||
reportOptsToSpec day ropts = do
|
||||
(argsquery, queryopts) <- parseQuery day $ querystring_ ropts
|
||||
return ReportSpec
|
||||
{ rsOpts = ropts
|
||||
, rsToday = day
|
||||
, rsQuery = simplifyQuery $ And [queryFromFlags ropts, argsquery]
|
||||
, rsQueryOpts = queryopts
|
||||
}
|
||||
|
||||
-- | Generate a ReportSpec from RawOpts and the current date.
|
||||
rawOptsToReportSpec :: RawOpts -> IO ReportSpec
|
||||
rawOptsToReportSpec rawopts = do
|
||||
d <- getCurrentDay
|
||||
ropts <- rawOptsToReportOpts rawopts
|
||||
either fail return $ reportOptsToSpec d ropts
|
||||
|
||||
accountlistmodeopt :: RawOpts -> AccountListMode
|
||||
accountlistmodeopt =
|
||||
@ -454,45 +473,45 @@ queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq
|
||||
-- options or queries, or otherwise the earliest and latest transaction or
|
||||
-- posting dates in the journal. If no dates are specified by options/queries
|
||||
-- and the journal is empty, returns the null date span.
|
||||
reportSpan :: Journal -> ReportOpts -> DateSpan
|
||||
reportSpan j ropts = dbg3 "reportspan" $ DateSpan mstartdate menddate
|
||||
reportSpan :: Journal -> ReportSpec -> DateSpan
|
||||
reportSpan j ReportSpec{rsQuery=query} = dbg3 "reportspan" $ DateSpan mstartdate menddate
|
||||
where
|
||||
DateSpan mjournalstartdate mjournalenddate =
|
||||
dbg3 "journalspan" $ journalDateSpan False j -- ignore secondary dates
|
||||
mstartdate = queryStartDate False (query_ ropts) <|> mjournalstartdate
|
||||
menddate = queryEndDate False (query_ ropts) <|> mjournalenddate
|
||||
mstartdate = queryStartDate False query <|> mjournalstartdate
|
||||
menddate = queryEndDate False query <|> mjournalenddate
|
||||
|
||||
reportStartDate :: Journal -> ReportOpts -> Maybe Day
|
||||
reportStartDate j ropts = spanStart $ reportSpan j ropts
|
||||
reportStartDate :: Journal -> ReportSpec -> Maybe Day
|
||||
reportStartDate j = spanStart . reportSpan j
|
||||
|
||||
reportEndDate :: Journal -> ReportOpts -> Maybe Day
|
||||
reportEndDate j ropts = spanEnd $ reportSpan j ropts
|
||||
reportEndDate :: Journal -> ReportSpec -> Maybe Day
|
||||
reportEndDate j = spanEnd . reportSpan j
|
||||
|
||||
-- Some pure alternatives to the above. XXX review/clean up
|
||||
|
||||
-- Get the report's start date.
|
||||
-- If no report period is specified, will be Nothing.
|
||||
reportPeriodStart :: ReportOpts -> Maybe Day
|
||||
reportPeriodStart = queryStartDate False . query_
|
||||
reportPeriodStart :: ReportSpec -> Maybe Day
|
||||
reportPeriodStart = queryStartDate False . rsQuery
|
||||
|
||||
-- Get the report's start date, or if no report period is specified,
|
||||
-- the journal's start date (the earliest posting date). If there's no
|
||||
-- report period and nothing in the journal, will be Nothing.
|
||||
reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day
|
||||
reportPeriodOrJournalStart ropts j =
|
||||
reportPeriodStart ropts <|> journalStartDate False j
|
||||
reportPeriodOrJournalStart :: ReportSpec -> Journal -> Maybe Day
|
||||
reportPeriodOrJournalStart rspec j =
|
||||
reportPeriodStart rspec <|> journalStartDate False j
|
||||
|
||||
-- Get the last day of the overall report period.
|
||||
-- This the inclusive end date (one day before the
|
||||
-- more commonly used, exclusive, report end date).
|
||||
-- If no report period is specified, will be Nothing.
|
||||
reportPeriodLastDay :: ReportOpts -> Maybe Day
|
||||
reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . query_
|
||||
reportPeriodLastDay :: ReportSpec -> Maybe Day
|
||||
reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . rsQuery
|
||||
|
||||
-- Get the last day of the overall report period, or if no report
|
||||
-- period is specified, the last day of the journal (ie the latest
|
||||
-- posting date). If there's no report period and nothing in the
|
||||
-- journal, will be Nothing.
|
||||
reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day
|
||||
reportPeriodOrJournalLastDay ropts j =
|
||||
reportPeriodLastDay ropts <|> journalEndDate False j
|
||||
reportPeriodOrJournalLastDay :: ReportSpec -> Journal -> Maybe Day
|
||||
reportPeriodOrJournalLastDay rspec j =
|
||||
reportPeriodLastDay rspec <|> journalEndDate False j
|
||||
|
@ -53,7 +53,7 @@ accountsScreen = AccountsScreen{
|
||||
|
||||
asInit :: Day -> Bool -> UIState -> UIState
|
||||
asInit d reset ui@UIState{
|
||||
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}},
|
||||
aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}},
|
||||
ajournal=j,
|
||||
aScreen=s@AccountsScreen{}
|
||||
} =
|
||||
@ -80,8 +80,8 @@ asInit d reset ui@UIState{
|
||||
where
|
||||
as = map asItemAccountName displayitems
|
||||
|
||||
uopts' = uopts{cliopts_=copts{reportopts_=ropts'}}
|
||||
ropts' = ropts{query_=simplifyQuery $ And [query_ ropts, excludeforecastq (forecast_ ropts)]}
|
||||
uopts' = uopts{cliopts_=copts{reportspec_=rspec'}}
|
||||
rspec' = rspec{rsQuery=simplifyQuery $ And [rsQuery rspec, excludeforecastq (forecast_ ropts)]}
|
||||
where
|
||||
-- Except in forecast mode, exclude future/forecast transactions.
|
||||
excludeforecastq (Just _) = Any
|
||||
@ -92,13 +92,13 @@ asInit d reset ui@UIState{
|
||||
]
|
||||
|
||||
-- run the report
|
||||
(items,_total) = balanceReport ropts' j
|
||||
(items,_total) = balanceReport rspec' j
|
||||
|
||||
-- pre-render the list items
|
||||
displayitem (fullacct, shortacct, indent, bal) =
|
||||
AccountsScreenItem{asItemIndentLevel = indent
|
||||
,asItemAccountName = fullacct
|
||||
,asItemDisplayAccountName = replaceHiddenAccountsNameWith "All" $ if tree_ ropts' then shortacct else fullacct
|
||||
,asItemDisplayAccountName = replaceHiddenAccountsNameWith "All" $ if tree_ ropts then shortacct else fullacct
|
||||
,asItemRenderedAmounts = map (showAmountWithoutPrice False) amts
|
||||
}
|
||||
where
|
||||
@ -117,7 +117,7 @@ asInit d reset ui@UIState{
|
||||
asInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
asDraw :: UIState -> [Widget Name]
|
||||
asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
|
||||
,ajournal=j
|
||||
,aScreen=s@AccountsScreen{}
|
||||
,aMode=mode
|
||||
@ -165,6 +165,7 @@ asDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (_asList s)
|
||||
|
||||
where
|
||||
ropts = rsOpts rspec
|
||||
ishistorical = balancetype_ ropts == HistoricalBalance
|
||||
|
||||
toplabel =
|
||||
|
@ -51,12 +51,12 @@ writeChan = BC.writeBChan
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
opts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=ropts,rawopts_=rawopts}} <- getHledgerUIOpts
|
||||
opts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rspec@ReportSpec{rsOpts=ropts},rawopts_=rawopts}} <- getHledgerUIOpts
|
||||
-- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
|
||||
|
||||
-- always include forecasted periodic transactions when loading data;
|
||||
-- they will be toggled on and off in the UI.
|
||||
let copts' = copts{reportopts_=ropts{forecast_=Just $ fromMaybe nulldatespan (forecast_ ropts)}}
|
||||
let copts' = copts{reportspec_=rspec{rsOpts=ropts{forecast_=Just $ fromMaybe nulldatespan (forecast_ ropts)}}}
|
||||
|
||||
case True of
|
||||
_ | "help" `inRawOpts` rawopts -> putStr (showModeUsage uimode)
|
||||
@ -65,7 +65,7 @@ main = do
|
||||
_ -> withJournalDo copts' (runBrickUi opts)
|
||||
|
||||
runBrickUi :: UIOpts -> Journal -> IO ()
|
||||
runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=ropts}} j = do
|
||||
runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportspec_=rspec@ReportSpec{rsOpts=ropts}}} j = do
|
||||
d <- getCurrentDay
|
||||
|
||||
let
|
||||
@ -79,12 +79,13 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
|
||||
-- can be displayed independently.
|
||||
uopts' = uopts{
|
||||
cliopts_=copts{
|
||||
reportopts_= ropts{
|
||||
reportspec_=rspec{
|
||||
rsQuery=filteredQuery $ rsQuery rspec, -- as in ReportOptions, with same limitations
|
||||
rsOpts=ropts{
|
||||
-- incorporate any depth: query args into depth_,
|
||||
-- any date: query args into period_
|
||||
depth_ =queryDepth $ query_ ropts,
|
||||
depth_ =queryDepth $ rsQuery rspec,
|
||||
period_=periodfromoptsandargs,
|
||||
query_ =filteredQuery $ query_ ropts, -- as in ReportOptions, with same limitations
|
||||
-- always disable boring account name eliding, unlike the CLI, for a more regular tree
|
||||
no_elide_=True,
|
||||
-- flip the default for items with zero amounts, show them by default
|
||||
@ -94,8 +95,9 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
where
|
||||
datespanfromargs = queryDateSpan (date2_ ropts) $ query_ ropts
|
||||
datespanfromargs = queryDateSpan (date2_ ropts) $ rsQuery rspec
|
||||
periodfromoptsandargs =
|
||||
dateSpanAsPeriod $ spansIntersect [periodAsDateSpan $ period_ ropts, datespanfromargs]
|
||||
filteredQuery q = simplifyQuery $ And [queryFromFlags ropts, filtered q]
|
||||
|
@ -59,17 +59,15 @@ rsSetAccount a forceinclusive scr@RegisterScreen{} =
|
||||
rsSetAccount _ _ scr = scr
|
||||
|
||||
rsInit :: Day -> Bool -> UIState -> UIState
|
||||
rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts}}, ajournal=j, aScreen=s@RegisterScreen{..}} =
|
||||
rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}, ajournal=j, aScreen=s@RegisterScreen{..}} =
|
||||
ui{aScreen=s{rsList=newitems'}}
|
||||
where
|
||||
-- gather arguments and queries
|
||||
-- XXX temp
|
||||
inclusive = tree_ ropts || rsForceInclusive
|
||||
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) rsAccount
|
||||
ropts' = ropts{
|
||||
depth_=Nothing
|
||||
}
|
||||
q = And [query_ ropts', excludeforecastq (forecast_ ropts)]
|
||||
rspec' = rspec{rsOpts=ropts{depth_=Nothing}}
|
||||
q = And [rsQuery rspec, excludeforecastq (forecast_ ropts)]
|
||||
where
|
||||
-- Except in forecast mode, exclude future/forecast transactions.
|
||||
excludeforecastq (Just _) = Any
|
||||
@ -79,8 +77,8 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
|
||||
,Not generatedTransactionTag
|
||||
]
|
||||
|
||||
(_label,items) = accountTransactionsReport ropts' j q thisacctq
|
||||
items' = (if empty_ ropts' then id else filter (not . mixedAmountLooksZero . fifth6)) $ -- without --empty, exclude no-change txns
|
||||
(_label,items) = accountTransactionsReport rspec' j q thisacctq
|
||||
items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $ -- without --empty, exclude no-change txns
|
||||
reverse -- most recent last
|
||||
items
|
||||
|
||||
@ -138,7 +136,7 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
|
||||
rsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
rsDraw :: UIState -> [Widget Name]
|
||||
rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
|
||||
,aScreen=RegisterScreen{..}
|
||||
,aMode=mode
|
||||
} =
|
||||
@ -192,6 +190,7 @@ rsDraw UIState{aopts=_uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
render $ defaultLayout toplabel bottomlabel $ renderList (rsDrawItem colwidths) True rsList
|
||||
|
||||
where
|
||||
ropts = rsOpts rspec
|
||||
ishistorical = balancetype_ ropts == HistoricalBalance
|
||||
-- inclusive = tree_ ropts || rsForceInclusive
|
||||
|
||||
|
@ -43,7 +43,7 @@ transactionScreen = TransactionScreen{
|
||||
}
|
||||
|
||||
tsInit :: Day -> Bool -> UIState -> UIState
|
||||
tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
|
||||
tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportspec_=_rspec}}
|
||||
,ajournal=_j
|
||||
,aScreen=TransactionScreen{}
|
||||
} =
|
||||
@ -58,7 +58,7 @@ tsInit _d _reset ui@UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=_ropts}}
|
||||
tsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
|
||||
|
||||
tsDraw :: UIState -> [Widget Name]
|
||||
tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}
|
||||
,ajournal=j
|
||||
,aScreen=TransactionScreen{tsTransaction=(i,t)
|
||||
,tsTransactions=nts
|
||||
@ -77,14 +77,14 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
styles = journalCommodityStyles j
|
||||
periodlast =
|
||||
fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
|
||||
reportPeriodOrJournalLastDay ropts j
|
||||
mreportlast = reportPeriodLastDay ropts
|
||||
reportPeriodOrJournalLastDay rspec j
|
||||
mreportlast = reportPeriodLastDay rspec
|
||||
multiperiod = interval_ ropts /= NoInterval
|
||||
|
||||
render $ defaultLayout toplabel bottomlabel $ str $
|
||||
showTransactionOneLineAmounts $
|
||||
(if valuationTypeIsCost ropts then transactionToCost (journalCommodityStyles j) else id) $
|
||||
(if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast mreportlast (today_ ropts) multiperiod t (AtDefault Nothing)) else id) $
|
||||
(if valuationTypeIsDefaultValue ropts then (\t -> transactionApplyValuation prices styles periodlast mreportlast (rsToday rspec) multiperiod t (AtDefault Nothing)) else id) $
|
||||
-- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
|
||||
t
|
||||
where
|
||||
@ -132,7 +132,7 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
,tsTransactions=nts
|
||||
,tsAccount=acct
|
||||
}
|
||||
,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
|
||||
,aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
|
||||
,ajournal=j
|
||||
,aMode=mode
|
||||
}
|
||||
@ -172,7 +172,7 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
|
||||
Right j' -> do
|
||||
continue $
|
||||
regenerateScreens j' d $
|
||||
regenerateTransactions ropts j' s acct i $ -- added (inline) 201512 (why ?)
|
||||
regenerateTransactions rspec j' s acct i $ -- added (inline) 201512 (why ?)
|
||||
clearCostValue $
|
||||
ui
|
||||
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions ui)
|
||||
@ -207,15 +207,12 @@ tsHandle _ _ = error "event handler called with wrong screen type, should not ha
|
||||
|
||||
-- Got to redo the register screen's transactions report, to get the latest transactions list for this screen.
|
||||
-- XXX Duplicates rsInit. Why do we have to do this as well as regenerateScreens ?
|
||||
regenerateTransactions :: ReportOpts -> Journal -> Screen -> AccountName -> Integer -> UIState -> UIState
|
||||
regenerateTransactions ropts j s acct i ui =
|
||||
regenerateTransactions :: ReportSpec -> Journal -> Screen -> AccountName -> Integer -> UIState -> UIState
|
||||
regenerateTransactions rspec j s acct i ui =
|
||||
let
|
||||
ropts' = ropts {depth_=Nothing
|
||||
,balancetype_=HistoricalBalance
|
||||
}
|
||||
q = filterQuery (not . queryIsDepth) $ query_ ropts'
|
||||
q = filterQuery (not . queryIsDepth) $ rsQuery rspec
|
||||
thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs
|
||||
items = reverse $ snd $ accountTransactionsReport ropts j q thisacctq
|
||||
items = reverse $ snd $ accountTransactionsReport rspec j q thisacctq
|
||||
ts = map first6 items
|
||||
numberedts = zip [1..] ts
|
||||
-- select the best current transaction from the new list
|
||||
|
@ -21,18 +21,18 @@ import Hledger.UI.UIOptions
|
||||
|
||||
-- | Toggle between showing only unmarked items or all items.
|
||||
toggleUnmarked :: UIState -> UIState
|
||||
toggleUnmarked ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Unmarked copts ropts}}}
|
||||
toggleUnmarked ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatusSomehow Unmarked copts rspec}}}
|
||||
|
||||
-- | Toggle between showing only pending items or all items.
|
||||
togglePending :: UIState -> UIState
|
||||
togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Pending copts ropts}}}
|
||||
togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatusSomehow Pending copts rspec}}}
|
||||
|
||||
-- | Toggle between showing only cleared items or all items.
|
||||
toggleCleared :: UIState -> UIState
|
||||
toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Cleared copts ropts}}}
|
||||
toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatusSomehow Cleared copts rspec}}}
|
||||
|
||||
-- TODO testing different status toggle styles
|
||||
|
||||
@ -52,9 +52,10 @@ uiShowStatus copts ss =
|
||||
showstatus Pending = "pending"
|
||||
showstatus Unmarked = "unmarked"
|
||||
|
||||
reportOptsToggleStatusSomehow :: Status -> CliOpts -> ReportOpts -> ReportOpts
|
||||
reportOptsToggleStatusSomehow s copts ropts =
|
||||
case maybeposintopt "status-toggles" $ rawopts_ copts of
|
||||
reportSpecToggleStatusSomehow :: Status -> CliOpts -> ReportSpec -> ReportSpec
|
||||
reportSpecToggleStatusSomehow s copts rspec = rspec{rsOpts=ropts}
|
||||
where
|
||||
ropts = case maybeposintopt "status-toggles" $ rawopts_ copts of
|
||||
Just 2 -> reportOptsToggleStatus2 s ropts
|
||||
Just 3 -> reportOptsToggleStatus3 s ropts
|
||||
-- Just 4 -> reportOptsToggleStatus4 s ropts
|
||||
@ -102,26 +103,26 @@ complement = ([minBound..maxBound] \\)
|
||||
|
||||
-- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items.
|
||||
toggleEmpty :: UIState -> UIState
|
||||
toggleEmpty ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleEmpty ropts}}}
|
||||
toggleEmpty ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=toggleEmpty ropts}}}}
|
||||
where
|
||||
toggleEmpty ropts = ropts{empty_=not $ empty_ ropts}
|
||||
|
||||
-- | Show primary amounts, not cost or value.
|
||||
clearCostValue :: UIState -> UIState
|
||||
clearCostValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{value_ = plog "clearing value mode" Nothing}}}}
|
||||
clearCostValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{value_ = plog "clearing value mode" Nothing}}}}}
|
||||
|
||||
-- | Toggle between showing the primary amounts or costs.
|
||||
toggleCost :: UIState -> UIState
|
||||
toggleCost ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{value_ = valuationToggleCost $ value_ ropts}}}}
|
||||
toggleCost ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{value_ = valuationToggleCost $ value_ ropts}}}}}
|
||||
|
||||
-- | Toggle between showing primary amounts or default valuation.
|
||||
toggleValue :: UIState -> UIState
|
||||
toggleValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{
|
||||
value_ = plog "toggling value mode to" $ valuationToggleValue $ value_ ropts}}}}
|
||||
toggleValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{
|
||||
value_ = plog "toggling value mode to" $ valuationToggleValue $ value_ ropts}}}}}
|
||||
|
||||
-- | Basic toggling of -B/cost, for hledger-ui.
|
||||
valuationToggleCost :: Maybe ValuationType -> Maybe ValuationType
|
||||
@ -135,18 +136,18 @@ valuationToggleValue _ = Just $ AtDefault Nothing
|
||||
|
||||
-- | Set hierarchic account tree mode.
|
||||
setTree :: UIState -> UIState
|
||||
setTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{accountlistmode_=ALTree}}}}
|
||||
setTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{accountlistmode_=ALTree}}}}}
|
||||
|
||||
-- | Set flat account list mode.
|
||||
setList :: UIState -> UIState
|
||||
setList ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{accountlistmode_=ALFlat}}}}
|
||||
setList ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{accountlistmode_=ALFlat}}}}}
|
||||
|
||||
-- | Toggle between flat and tree mode. If current mode is unspecified/default, assume it's flat.
|
||||
toggleTree :: UIState -> UIState
|
||||
toggleTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleTreeMode ropts}}}
|
||||
toggleTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=toggleTreeMode ropts}}}}
|
||||
where
|
||||
toggleTreeMode ropts
|
||||
| accountlistmode_ ropts == ALTree = ropts{accountlistmode_=ALFlat}
|
||||
@ -154,8 +155,8 @@ toggleTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropt
|
||||
|
||||
-- | Toggle between historical balances and period balances.
|
||||
toggleHistorical :: UIState -> UIState
|
||||
toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{balancetype_=b}}}}
|
||||
toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{balancetype_=b}}}}}
|
||||
where
|
||||
b | balancetype_ ropts == HistoricalBalance = PeriodChange
|
||||
| otherwise = HistoricalBalance
|
||||
@ -174,10 +175,10 @@ toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts
|
||||
-- transactions with a query for their special tag.
|
||||
--
|
||||
toggleForecast :: Day -> UIState -> UIState
|
||||
toggleForecast d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
toggleForecast d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts'}}
|
||||
where
|
||||
copts' = copts{reportopts_=ropts{forecast_=forecast'}}
|
||||
copts' = copts{reportspec_=rspec{rsOpts=ropts{forecast_=forecast'}}}
|
||||
forecast' =
|
||||
case forecast_ ropts of
|
||||
Just _ -> Nothing
|
||||
@ -185,8 +186,8 @@ toggleForecast d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts
|
||||
|
||||
-- | Toggle between showing all and showing only real (non-virtual) items.
|
||||
toggleReal :: UIState -> UIState
|
||||
toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleReal ropts}}}
|
||||
toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=toggleReal ropts}}}}
|
||||
where
|
||||
toggleReal ropts = ropts{real_=not $ real_ ropts}
|
||||
|
||||
@ -197,41 +198,41 @@ toggleIgnoreBalanceAssertions ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOp
|
||||
|
||||
-- | Step through larger report periods, up to all.
|
||||
growReportPeriod :: Day -> UIState -> UIState
|
||||
growReportPeriod _d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodGrow $ period_ ropts}}}}
|
||||
growReportPeriod _d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodGrow $ period_ ropts}}}}}
|
||||
|
||||
-- | Step through smaller report periods, down to a day.
|
||||
shrinkReportPeriod :: Day -> UIState -> UIState
|
||||
shrinkReportPeriod d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodShrink d $ period_ ropts}}}}
|
||||
shrinkReportPeriod d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodShrink d $ period_ ropts}}}}}
|
||||
|
||||
-- | Step the report start/end dates to the next period of same duration,
|
||||
-- remaining inside the given enclosing span.
|
||||
nextReportPeriod :: DateSpan -> UIState -> UIState
|
||||
nextReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodNextIn enclosingspan p}}}}
|
||||
nextReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodNextIn enclosingspan p}}}}}
|
||||
|
||||
-- | Step the report start/end dates to the next period of same duration,
|
||||
-- remaining inside the given enclosing span.
|
||||
previousReportPeriod :: DateSpan -> UIState -> UIState
|
||||
previousReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodPreviousIn enclosingspan p}}}}
|
||||
previousReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodPreviousIn enclosingspan p}}}}}
|
||||
|
||||
-- | If a standard report period is set, step it forward/backward if needed so that
|
||||
-- it encloses the given date.
|
||||
moveReportPeriodToDate :: Day -> UIState -> UIState
|
||||
moveReportPeriodToDate d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodMoveTo d p}}}}
|
||||
moveReportPeriodToDate d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodMoveTo d p}}}}}
|
||||
|
||||
-- | Get the report period.
|
||||
reportPeriod :: UIState -> Period
|
||||
reportPeriod UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ReportOpts{period_=p}}}} =
|
||||
reportPeriod UIState{aopts=UIOpts{cliopts_=CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{period_=p}}}}} =
|
||||
p
|
||||
|
||||
-- | Set the report period.
|
||||
setReportPeriod :: Period -> UIState -> UIState
|
||||
setReportPeriod p ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=p}}}}
|
||||
setReportPeriod p ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=p}}}}}
|
||||
|
||||
-- | Clear any report period limits.
|
||||
resetReportPeriod :: UIState -> UIState
|
||||
@ -239,21 +240,24 @@ resetReportPeriod = setReportPeriod PeriodAll
|
||||
|
||||
-- | Apply a new filter query.
|
||||
setFilter :: String -> UIState -> UIState
|
||||
setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=newRopts}}}
|
||||
setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=newrspec}}}
|
||||
where
|
||||
newRopts = either (const ropts) id $ regenerateReportOpts (today_ ropts) (T.pack s) ropts
|
||||
newrspec = either (const rspec) id $ reportOptsToSpec (rsToday rspec) ropts{querystring_=T.pack s}
|
||||
|
||||
-- | Reset some filters & toggles.
|
||||
resetFilter :: UIState -> UIState
|
||||
resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{
|
||||
resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{
|
||||
rsQuery=Any
|
||||
,rsQueryOpts=[]
|
||||
,rsOpts=ropts{
|
||||
empty_=True
|
||||
,statuses_=[]
|
||||
,real_=False
|
||||
,query_=Any
|
||||
,querystring_=""
|
||||
--,period_=PeriodAll
|
||||
}}}}
|
||||
}}}}}
|
||||
|
||||
-- | Reset all options state to exactly what it was at startup
|
||||
-- (preserving any command-line options/arguments).
|
||||
@ -261,8 +265,8 @@ resetOpts :: UIState -> UIState
|
||||
resetOpts ui@UIState{astartupopts} = ui{aopts=astartupopts}
|
||||
|
||||
resetDepth :: UIState -> UIState
|
||||
resetDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=Nothing}}}}
|
||||
resetDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
|
||||
ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=Nothing}}}}}
|
||||
|
||||
-- | Get the maximum account depth in the current journal.
|
||||
maxDepth :: UIState -> Int
|
||||
@ -271,8 +275,8 @@ maxDepth UIState{ajournal=j} = maximum $ map accountNameLevel $ journalAccountNa
|
||||
-- | Decrement the current depth limit towards 0. If there was no depth limit,
|
||||
-- set it to one less than the maximum account depth.
|
||||
decDepth :: UIState -> UIState
|
||||
decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=dec depth_}}}}
|
||||
decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}}}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=dec depth_}}}}}
|
||||
where
|
||||
dec (Just d) = Just $ max 0 (d-1)
|
||||
dec Nothing = Just $ maxDepth ui - 1
|
||||
@ -280,8 +284,8 @@ decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@
|
||||
-- | Increment the current depth limit. If this makes it equal to the
|
||||
-- the maximum account depth, remove the depth limit.
|
||||
incDepth :: UIState -> UIState
|
||||
incDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=inc depth_}}}}
|
||||
incDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}}}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=inc depth_}}}}}
|
||||
where
|
||||
inc (Just d) | d < (maxDepth ui - 1) = Just $ d+1
|
||||
inc _ = Nothing
|
||||
@ -291,8 +295,8 @@ incDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@
|
||||
-- maximum account depth. If the specified depth is negative, reset the depth limit
|
||||
-- to whatever was specified at uiartup.
|
||||
setDepth :: Maybe Int -> UIState -> UIState
|
||||
setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=mdepth'}}}}
|
||||
setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}}
|
||||
= ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=mdepth'}}}}}
|
||||
where
|
||||
mdepth' = case mdepth of
|
||||
Nothing -> Nothing
|
||||
@ -301,14 +305,14 @@ setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_
|
||||
| otherwise -> mdepth
|
||||
|
||||
getDepth :: UIState -> Maybe Int
|
||||
getDepth UIState{aopts=UIOpts{cliopts_=CliOpts{reportopts_=ropts}}} = depth_ ropts
|
||||
getDepth UIState{aopts=UIOpts{cliopts_=CliOpts{reportspec_=rspec}}} = depth_ $ rsOpts rspec
|
||||
|
||||
-- | Open the minibuffer, setting its content to the current query with the cursor at the end.
|
||||
showMinibuffer :: UIState -> UIState
|
||||
showMinibuffer ui = setMode (Minibuffer e) ui
|
||||
where
|
||||
e = applyEdit gotoEOL $ editor MinibufferEditor (Just 1) oldq
|
||||
oldq = T.unpack . querystring_ . reportopts_ . cliopts_ $ aopts ui
|
||||
oldq = T.unpack . querystring_ . rsOpts . reportspec_ . cliopts_ $ aopts ui
|
||||
|
||||
-- | Close the minibuffer, discarding any edit in progress.
|
||||
closeMinibuffer :: UIState -> UIState
|
||||
|
@ -123,14 +123,16 @@ instance Yesod App where
|
||||
showSidebar <- shouldShowSidebar
|
||||
hideEmptyAccts <- (== Just "1") . lookup "hideemptyaccts" . reqCookies <$> getRequest
|
||||
|
||||
let ropts = reportopts_ (cliopts_ opts)
|
||||
ropts' = ropts
|
||||
let rspec = reportspec_ (cliopts_ opts)
|
||||
ropts = rsOpts rspec
|
||||
ropts' = (rsOpts rspec)
|
||||
{accountlistmode_ = ALTree -- force tree mode for sidebar
|
||||
,empty_ = not (empty_ ropts) -- show zero items by default
|
||||
}
|
||||
rspec' = rspec{rsQuery=m,rsOpts=ropts'}
|
||||
accounts =
|
||||
balanceReportAsHtml (JournalR, RegisterR) here hideEmptyAccts j q qopts $
|
||||
balanceReport ropts'{query_=m} j
|
||||
balanceReport rspec' j
|
||||
|
||||
topShowmd = if showSidebar then "col-md-4" else "col-any-0" :: Text
|
||||
topShowsm = if showSidebar then "col-sm-4" else "" :: Text
|
||||
@ -206,12 +208,14 @@ getViewData = do
|
||||
App {appOpts = opts, appJournal} <- getYesod
|
||||
today <- liftIO getCurrentDay
|
||||
let copts = cliopts_ opts
|
||||
rspec = (reportspec_ copts){rsOpts=ropts}
|
||||
ropts = (rsOpts rspec){no_elide_ = True}
|
||||
|
||||
-- try to read the latest journal content, keeping the old content
|
||||
-- if there's an error
|
||||
(j, mjerr) <- getCurrentJournal
|
||||
appJournal
|
||||
copts {reportopts_ = (reportopts_ copts) {no_elide_ = True}}
|
||||
copts {reportspec_ = rspec}
|
||||
today
|
||||
|
||||
-- try to parse the query param, assuming no query if there's an error
|
||||
@ -265,7 +269,7 @@ getCurrentJournal jref opts d = do
|
||||
j <- liftIO (readIORef jref)
|
||||
(ej, changed) <- liftIO $ journalReloadIfChanged opts d j
|
||||
-- re-apply any initial filter specified at startup
|
||||
let initq = query_ $ reportopts_ opts
|
||||
let initq = rsQuery $ reportspec_ opts
|
||||
case (changed, filterJournalTransactions initq <$> ej) of
|
||||
(False, _) -> return (j, Nothing)
|
||||
(True, Right j') -> do
|
||||
|
@ -27,7 +27,7 @@ getJournalR = do
|
||||
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
|
||||
title' = title <> if m /= Any then ", filtered" else ""
|
||||
acctlink a = (RegisterR, [("q", replaceInacct q $ accountQuery a)])
|
||||
(_, items) = transactionsReport (reportopts_ $ cliopts_ opts) j m
|
||||
(_, items) = transactionsReport (rsOpts . reportspec_ $ cliopts_ opts) j m
|
||||
transactionFrag = transactionFragment j
|
||||
|
||||
defaultLayout $ do
|
||||
|
@ -102,9 +102,9 @@ getAccounttransactionsR a = do
|
||||
VD{caps, j} <- getViewData
|
||||
when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability")
|
||||
let
|
||||
ropts = defreportopts
|
||||
rspec = defreportspec
|
||||
q = Any --filterQuery (not . queryIsDepth) $ queryFromOpts d ropts'
|
||||
thisacctq = Acct $ accountNameToAccountRegex a -- includes subs
|
||||
selectRep $ do
|
||||
provideJson $ accountTransactionsReport ropts j q thisacctq
|
||||
provideJson $ accountTransactionsReport rspec j q thisacctq
|
||||
|
||||
|
@ -33,7 +33,7 @@ getRegisterR = do
|
||||
s2 = if m /= Any then ", filtered" else ""
|
||||
header = a <> s1 <> s2
|
||||
|
||||
let ropts = reportopts_ (cliopts_ opts)
|
||||
let rspec = reportspec_ (cliopts_ opts)
|
||||
acctQuery = fromMaybe Any (inAccountQuery qopts)
|
||||
acctlink acc = (RegisterR, [("q", replaceInacct q $ accountQuery acc)])
|
||||
otherTransAccounts =
|
||||
@ -44,7 +44,7 @@ getRegisterR = do
|
||||
zip xs $
|
||||
zip (map (T.unpack . accountSummarisedName . paccount) xs) $
|
||||
tail $ (", "<$xs) ++ [""]
|
||||
r@(balancelabel,items) = accountTransactionsReport ropts j m acctQuery
|
||||
r@(balancelabel,items) = accountTransactionsReport rspec j m acctQuery
|
||||
balancelabel' = if isJust (inAccount qopts) then balancelabel else "Total"
|
||||
transactionFrag = transactionFragment j
|
||||
defaultLayout $ do
|
||||
|
@ -58,7 +58,7 @@ runWith opts
|
||||
-- | The web command.
|
||||
web :: WebOpts -> Journal -> IO ()
|
||||
web opts j = do
|
||||
let initq = query_ . reportopts_ $ cliopts_ opts
|
||||
let initq = rsQuery . reportspec_ $ cliopts_ opts
|
||||
j' = filterJournalTransactions initq j
|
||||
h = host_ opts
|
||||
p = port_ opts
|
||||
|
@ -399,7 +399,7 @@ data CliOpts = CliOpts {
|
||||
,command_ :: String
|
||||
,file_ :: [FilePath]
|
||||
,inputopts_ :: InputOpts
|
||||
,reportopts_ :: ReportOpts
|
||||
,reportspec_ :: ReportSpec
|
||||
,output_file_ :: Maybe FilePath
|
||||
,output_format_ :: Maybe String
|
||||
,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'.
|
||||
@ -419,7 +419,7 @@ defcliopts = CliOpts
|
||||
, command_ = ""
|
||||
, file_ = []
|
||||
, inputopts_ = def
|
||||
, reportopts_ = def
|
||||
, reportspec_ = def
|
||||
, output_file_ = Nothing
|
||||
, output_format_ = Nothing
|
||||
, debug_ = 0
|
||||
@ -447,7 +447,7 @@ replaceNumericFlags = map replace
|
||||
rawOptsToCliOpts :: RawOpts -> IO CliOpts
|
||||
rawOptsToCliOpts rawopts = do
|
||||
let iopts = rawOptsToInputOpts rawopts
|
||||
ropts <- rawOptsToReportOpts rawopts
|
||||
rspec <- rawOptsToReportSpec rawopts
|
||||
mcolumns <- readMay <$> getEnvSafe "COLUMNS"
|
||||
mtermwidth <-
|
||||
#ifdef mingw32_HOST_OS
|
||||
@ -462,7 +462,7 @@ rawOptsToCliOpts rawopts = do
|
||||
,command_ = stringopt "command" rawopts
|
||||
,file_ = listofstringopt "file" rawopts
|
||||
,inputopts_ = iopts
|
||||
,reportopts_ = ropts
|
||||
,reportspec_ = rspec
|
||||
,output_file_ = maybestringopt "output-file" rawopts
|
||||
,output_format_ = maybestringopt "output-format" rawopts
|
||||
,debug_ = posintopt "debug" rawopts
|
||||
@ -519,7 +519,7 @@ getHledgerCliOpts' mode' args' = do
|
||||
putStrLn $ "running: " ++ progname'
|
||||
putStrLn $ "raw args: " ++ show args'
|
||||
putStrLn $ "processed opts:\n" ++ show opts
|
||||
putStrLn $ "search query: " ++ show (query_ $ reportopts_ opts)
|
||||
putStrLn $ "search query: " ++ show (rsQuery $ reportspec_ opts)
|
||||
|
||||
getHledgerCliOpts :: Mode RawOpts -> IO CliOpts
|
||||
getHledgerCliOpts mode' = do
|
||||
|
@ -48,18 +48,17 @@ accountsmode = hledgerCommandMode
|
||||
|
||||
-- | The accounts command.
|
||||
accounts :: CliOpts -> Journal -> IO ()
|
||||
accounts CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
|
||||
accounts CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{rsQuery=query,rsOpts=ropts}} j = do
|
||||
|
||||
-- 1. identify the accounts we'll show
|
||||
let tree = tree_ ropts
|
||||
declared = boolopt "declared" rawopts
|
||||
used = boolopt "used" rawopts
|
||||
q = query_ ropts
|
||||
-- a depth limit will clip and exclude account names later, but we don't want to exclude accounts at this stage
|
||||
nodepthq = dbg1 "nodepthq" $ filterQuery (not . queryIsDepth) q
|
||||
nodepthq = dbg1 "nodepthq" $ filterQuery (not . queryIsDepth) query
|
||||
-- just the acct: part of the query will be reapplied later, after clipping
|
||||
acctq = dbg1 "acctq" $ filterQuery queryIsAcct q
|
||||
depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth q
|
||||
acctq = dbg1 "acctq" $ filterQuery queryIsAcct query
|
||||
depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth query
|
||||
matcheddeclaredaccts = dbg1 "matcheddeclaredaccts" $ filter (matchesAccount nodepthq) $ map fst $ jdeclaredaccounts j
|
||||
matchedusedaccts = dbg5 "matchedusedaccts" $ map paccount $ journalPostings $ filterJournalPostings nodepthq j
|
||||
accts = dbg5 "accts to show" $ -- no need to nub/sort, accountTree will
|
||||
|
@ -30,10 +30,10 @@ barchar = '*'
|
||||
|
||||
-- | Print a bar chart of number of postings per report interval.
|
||||
activity :: CliOpts -> Journal -> IO ()
|
||||
activity CliOpts{reportopts_=ropts} j = putStr $ showHistogram ropts j
|
||||
activity CliOpts{reportspec_=rspec} j = putStr $ showHistogram rspec j
|
||||
|
||||
showHistogram :: ReportOpts -> Journal -> String
|
||||
showHistogram ReportOpts{query_=q,interval_=i,date2_=date2} j =
|
||||
showHistogram :: ReportSpec -> Journal -> String
|
||||
showHistogram ReportSpec{rsQuery=q,rsOpts=ReportOpts{interval_=i,date2_=date2}} j =
|
||||
concatMap (printDayWith countBar) spanps
|
||||
where
|
||||
interval | i == NoInterval = Days 1
|
||||
|
@ -255,7 +255,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
|
||||
-- Identify the closest recent match for this description in past transactions.
|
||||
similarTransaction :: EntryState -> Text -> Maybe Transaction
|
||||
similarTransaction EntryState{..} desc =
|
||||
let q = queryFromFlags $ reportopts_ esOpts
|
||||
let q = queryFromFlags . rsOpts $ reportspec_ esOpts
|
||||
historymatches = transactionsSimilarTo esJournal q desc
|
||||
bestmatch | null historymatches = Nothing
|
||||
| otherwise = Just $ snd $ head historymatches
|
||||
@ -462,10 +462,11 @@ ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse
|
||||
registerFromString :: String -> IO String
|
||||
registerFromString s = do
|
||||
j <- readJournal' $ T.pack s
|
||||
return . postingsReportAsText opts $ postingsReport ropts j
|
||||
return . postingsReportAsText opts $ postingsReport rspec j
|
||||
where
|
||||
ropts = defreportopts{empty_=True}
|
||||
opts = defcliopts{reportopts_=ropts}
|
||||
rspec = defreportspec{rsOpts=ropts}
|
||||
opts = defcliopts{reportspec_=rspec}
|
||||
|
||||
capitalize :: String -> String
|
||||
capitalize "" = ""
|
||||
|
@ -71,7 +71,7 @@ aregistermode = hledgerCommandMode
|
||||
|
||||
-- | Print an account register report for a specified account.
|
||||
aregister :: CliOpts -> Journal -> IO ()
|
||||
aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||
aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
d <- getCurrentDay
|
||||
-- the first argument specifies the account, any remaining arguments are a filter query
|
||||
(apat,querystring) <- case listofstringopt "args" rawopts of
|
||||
@ -87,14 +87,17 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||
-- gather report options
|
||||
inclusive = True -- tree_ ropts
|
||||
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct
|
||||
ropts' = ropts{
|
||||
query_=simplifyQuery $ And [queryFromFlags ropts, argsquery]
|
||||
-- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX
|
||||
,depth_=Nothing
|
||||
-- always show historical balance
|
||||
,balancetype_= HistoricalBalance
|
||||
rspec' = rspec{ rsQuery=simplifyQuery $ And [queryFromFlags ropts, argsquery]
|
||||
, rsOpts=ropts'
|
||||
}
|
||||
reportq = And [query_ ropts', excludeforecastq (isJust $ forecast_ ropts)]
|
||||
ropts' = ropts
|
||||
{ -- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX
|
||||
depth_=Nothing
|
||||
-- always show historical balance
|
||||
, balancetype_= HistoricalBalance
|
||||
}
|
||||
ropts = rsOpts rspec
|
||||
reportq = And [rsQuery rspec', excludeforecastq (isJust $ forecast_ ropts')]
|
||||
where
|
||||
-- As in RegisterScreen, why ? XXX
|
||||
-- Except in forecast mode, exclude future/forecast transactions.
|
||||
@ -106,7 +109,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||
]
|
||||
-- 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
|
||||
(balancelabel,items) = accountTransactionsReport rspec' j reportq thisacctq
|
||||
items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $
|
||||
reverse items
|
||||
-- select renderer
|
||||
@ -140,7 +143,7 @@ accountTransactionsReportItemAsCsvRecord
|
||||
-- | 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)
|
||||
copts@CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{no_elide_}}} reportq thisacctq (_balancelabel,items)
|
||||
= unlines $ title :
|
||||
map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items
|
||||
where
|
||||
@ -173,7 +176,7 @@ accountTransactionsReportAsText
|
||||
--
|
||||
accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> String
|
||||
accountTransactionsReportItemAsText
|
||||
copts@CliOpts{reportopts_=ReportOpts{color_,no_elide_}}
|
||||
copts@CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{color_,no_elide_}}}
|
||||
reportq thisacctq preferredamtwidth preferredbalwidth
|
||||
(t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance)
|
||||
-- Transaction -- the transaction, unmodified
|
||||
|
@ -304,14 +304,15 @@ balancemode = hledgerCommandMode
|
||||
|
||||
-- | The balance command, prints a balance report.
|
||||
balance :: CliOpts -> Journal -> IO ()
|
||||
balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
|
||||
let budget = boolopt "budget" rawopts
|
||||
balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
let ropts@ReportOpts{..} = rsOpts rspec
|
||||
budget = boolopt "budget" rawopts
|
||||
multiperiod = interval_ /= NoInterval
|
||||
fmt = outputFormatFromOpts opts
|
||||
|
||||
if budget then do -- single or multi period budget report
|
||||
let reportspan = reportSpan j ropts
|
||||
budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan j
|
||||
let reportspan = reportSpan j rspec
|
||||
budgetreport = dbg4 "budgetreport" $ budgetReport rspec assrt reportspan j
|
||||
where
|
||||
assrt = not $ ignore_assertions_ $ inputopts_ opts
|
||||
render = case fmt of
|
||||
@ -322,7 +323,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
|
||||
|
||||
else
|
||||
if multiperiod then do -- multi period balance report
|
||||
let report = multiBalanceReport ropts j
|
||||
let report = multiBalanceReport rspec j
|
||||
render = case fmt of
|
||||
"txt" -> multiBalanceReportAsText ropts
|
||||
"csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts
|
||||
@ -332,7 +333,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
|
||||
writeOutput opts $ render report
|
||||
|
||||
else do -- single period simple balance report
|
||||
let report = balanceReport ropts j -- simple Ledger-style balance report
|
||||
let report = balanceReport rspec j -- simple Ledger-style balance report
|
||||
render = case fmt of
|
||||
"txt" -> balanceReportAsText
|
||||
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
|
||||
@ -620,8 +621,8 @@ tests_Balance = tests "Balance" [
|
||||
tests "balanceReportAsText" [
|
||||
test "unicode in balance layout" $ do
|
||||
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
let opts = defreportopts
|
||||
balanceReportAsText opts (balanceReport opts{today_=fromGregorian 2008 11 26} j)
|
||||
let rspec = defreportspec
|
||||
balanceReportAsText (rsOpts rspec) (balanceReport rspec{rsToday=fromGregorian 2008 11 26} j)
|
||||
@?=
|
||||
unlines
|
||||
[" -100 актив:наличные"
|
||||
|
@ -21,9 +21,9 @@ checkdatesmode = hledgerCommandMode
|
||||
([], Just $ argsFlag "[QUERY]")
|
||||
|
||||
checkdates :: CliOpts -> Journal -> IO ()
|
||||
checkdates CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||
let ropts_ = ropts{accountlistmode_=ALFlat}
|
||||
let ts = filter (query_ ropts_ `matchesTransaction`) $
|
||||
checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
let ropts = (rsOpts rspec){accountlistmode_=ALFlat}
|
||||
let ts = filter (rsQuery rspec `matchesTransaction`) $
|
||||
jtxns $ journalSelectingAmountFromOpts ropts j
|
||||
let strict = boolopt "strict" rawopts
|
||||
let date = transactionDateFn ropts
|
||||
|
@ -47,7 +47,7 @@ closemode = hledgerCommandMode
|
||||
|
||||
-- debugger, beware: close is incredibly devious. simple rules combine to make a horrid maze.
|
||||
-- tests are in tests/close.test.
|
||||
close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
|
||||
close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
|
||||
today <- getCurrentDay
|
||||
let
|
||||
-- show opening entry, closing entry, or (default) both ?
|
||||
@ -72,8 +72,9 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
|
||||
(Nothing, Nothing) -> (T.pack defclosingacct, T.pack defopeningacct)
|
||||
|
||||
-- dates of the closing and opening transactions
|
||||
ropts_ = ropts{balancetype_=HistoricalBalance, accountlistmode_=ALFlat}
|
||||
q = query_ ropts_
|
||||
rspec_ = rspec{rsOpts=ropts}
|
||||
ropts = (rsOpts rspec){balancetype_=HistoricalBalance, accountlistmode_=ALFlat}
|
||||
q = rsQuery rspec
|
||||
openingdate = fromMaybe today $ queryEndDate False q
|
||||
closingdate = addDays (-1) openingdate
|
||||
|
||||
@ -86,7 +87,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
|
||||
False -> normaliseMixedAmount . mixedAmountStripPrices
|
||||
|
||||
-- the balances to close
|
||||
(acctbals,_) = balanceReport ropts_ j
|
||||
(acctbals,_) = balanceReport rspec_ j
|
||||
totalamt = sum $ map (\(_,_,_,b) -> normalise b) acctbals
|
||||
|
||||
-- since balance assertion amounts are required to be exact, the
|
||||
|
@ -32,8 +32,8 @@ codesmode = hledgerCommandMode
|
||||
|
||||
-- | The codes command.
|
||||
codes :: CliOpts -> Journal -> IO ()
|
||||
codes CliOpts{reportopts_=ropts@ReportOpts{empty_}} j = do
|
||||
let ts = entriesReport ropts j
|
||||
codes = (if empty_ then id else filter (not . T.null)) $
|
||||
codes CliOpts{reportspec_=rspec} j = do
|
||||
let ts = entriesReport rspec j
|
||||
codes = (if empty_ (rsOpts rspec) then id else filter (not . T.null)) $
|
||||
map tcode ts
|
||||
mapM_ T.putStrLn codes
|
||||
|
@ -31,8 +31,8 @@ descriptionsmode = hledgerCommandMode
|
||||
|
||||
-- | The descriptions command.
|
||||
descriptions :: CliOpts -> Journal -> IO ()
|
||||
descriptions CliOpts{reportopts_=ropts} j = do
|
||||
let ts = entriesReport ropts j
|
||||
descriptions CliOpts{reportspec_=rspec} j = do
|
||||
let ts = entriesReport rspec j
|
||||
descriptions = nubSort $ map tdescription ts
|
||||
|
||||
mapM_ T.putStrLn descriptions
|
||||
|
@ -102,7 +102,7 @@ unmatchedtxns s pp m =
|
||||
|
||||
-- | The diff command.
|
||||
diff :: CliOpts -> Journal -> IO ()
|
||||
diff CliOpts{file_=[f1, f2], reportopts_=ReportOpts{query_=Acct acctRe}} _ = do
|
||||
diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{rsQuery=Acct acctRe}} _ = do
|
||||
j1 <- readJournalFile' f1
|
||||
j2 <- readJournalFile' f2
|
||||
|
||||
|
@ -32,7 +32,7 @@ notesmode = hledgerCommandMode
|
||||
|
||||
-- | The notes command.
|
||||
notes :: CliOpts -> Journal -> IO ()
|
||||
notes CliOpts{reportopts_=ropts} j = do
|
||||
let ts = entriesReport ropts j
|
||||
notes CliOpts{reportspec_=rspec} j = do
|
||||
let ts = entriesReport rspec j
|
||||
notes = nubSort $ map transactionNote ts
|
||||
mapM_ T.putStrLn notes
|
||||
|
@ -32,7 +32,7 @@ payeesmode = hledgerCommandMode
|
||||
|
||||
-- | The payees command.
|
||||
payees :: CliOpts -> Journal -> IO ()
|
||||
payees CliOpts{reportopts_=ropts} j = do
|
||||
let ts = entriesReport ropts j
|
||||
payees CliOpts{reportspec_=rspec} j = do
|
||||
let ts = entriesReport rspec j
|
||||
payees = nubSort $ map transactionPayee ts
|
||||
mapM_ T.putStrLn payees
|
||||
|
@ -27,7 +27,7 @@ pricesmode = hledgerCommandMode
|
||||
prices opts j = do
|
||||
let
|
||||
styles = journalCommodityStyles j
|
||||
q = query_ $ reportopts_ opts
|
||||
q = rsQuery $ reportspec_ opts
|
||||
ps = filter (matchesPosting q) $ allPostings j
|
||||
mprices = jpricedirectives j
|
||||
cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps
|
||||
|
@ -53,7 +53,7 @@ print' opts j = do
|
||||
Just desc -> printMatch opts j $ T.pack desc
|
||||
|
||||
printEntries :: CliOpts -> Journal -> IO ()
|
||||
printEntries opts@CliOpts{reportopts_=ropts} j = do
|
||||
printEntries opts@CliOpts{reportspec_=rspec} j = do
|
||||
let fmt = outputFormatFromOpts opts
|
||||
render = case fmt of
|
||||
"txt" -> entriesReportAsText opts
|
||||
@ -61,7 +61,7 @@ printEntries opts@CliOpts{reportopts_=ropts} j = do
|
||||
"json" -> (++"\n") . TL.unpack . toJsonText
|
||||
"sql" -> entriesReportAsSql
|
||||
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||
writeOutput opts $ render $ entriesReport ropts j
|
||||
writeOutput opts $ render $ entriesReport rspec j
|
||||
|
||||
entriesReportAsText :: CliOpts -> EntriesReport -> String
|
||||
entriesReportAsText opts = concatMap (showTransaction . whichtxn)
|
||||
@ -73,7 +73,7 @@ entriesReportAsText opts = concatMap (showTransaction . whichtxn)
|
||||
-- Because of #551, and because of print -V valuing only one
|
||||
-- posting when there's an implicit txn price.
|
||||
-- So -B/-V/-X/--value implies -x. Is this ok ?
|
||||
|| (isJust $ value_ $ reportopts_ opts) = id
|
||||
|| (isJust . value_ . rsOpts $ reportspec_ opts) = id
|
||||
-- By default, use the original as-written-in-the-journal txn.
|
||||
| otherwise = originalTransaction
|
||||
|
||||
@ -182,8 +182,8 @@ postingToCSV p =
|
||||
-- | Print the transaction most closely and recently matching a description
|
||||
-- (and the query, if any).
|
||||
printMatch :: CliOpts -> Journal -> Text -> IO ()
|
||||
printMatch CliOpts{reportopts_=ropts} j desc = do
|
||||
case similarTransaction' j (query_ ropts) desc of
|
||||
printMatch CliOpts{reportspec_=rspec} j desc = do
|
||||
case similarTransaction' j (rsQuery rspec) desc of
|
||||
Nothing -> putStrLn "no matches found."
|
||||
Just t -> putStr $ showTransaction t
|
||||
|
||||
|
@ -58,13 +58,13 @@ registermode = hledgerCommandMode
|
||||
|
||||
-- | Print a (posting) register report.
|
||||
register :: CliOpts -> Journal -> IO ()
|
||||
register opts@CliOpts{reportopts_=ropts} j = do
|
||||
register opts@CliOpts{reportspec_=rspec} j = do
|
||||
let fmt = outputFormatFromOpts opts
|
||||
render | fmt=="txt" = postingsReportAsText
|
||||
| fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
|
||||
| fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
|
||||
| otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||
writeOutput opts . render opts $ postingsReport ropts j
|
||||
writeOutput opts . render opts $ postingsReport rspec j
|
||||
|
||||
postingsReportAsCsv :: PostingsReport -> CSV
|
||||
postingsReportAsCsv (_,is) =
|
||||
@ -178,7 +178,7 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
|
||||
BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)
|
||||
VirtualPosting -> (\s -> "("++s++")", acctwidth-2)
|
||||
_ -> (id,acctwidth)
|
||||
showamt = showMixedAmountWithoutPrice (color_ $ reportopts_ opts)
|
||||
showamt = showMixedAmountWithoutPrice (color_ . rsOpts $ reportspec_ opts)
|
||||
amt = showamt $ pamount p
|
||||
bal = showamt b
|
||||
-- alternate behaviour, show null amounts as 0 instead of blank
|
||||
@ -198,8 +198,8 @@ tests_Register = tests "Register" [
|
||||
tests "postingsReportAsText" [
|
||||
test "unicode in register layout" $ do
|
||||
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
|
||||
let opts = defreportopts
|
||||
(postingsReportAsText defcliopts $ postingsReport opts j)
|
||||
let rspec = defreportspec
|
||||
(postingsReportAsText defcliopts $ postingsReport rspec j)
|
||||
@?=
|
||||
unlines
|
||||
["2009-01-01 медвежья шкура расходы:покупки 100 100"
|
||||
|
@ -22,10 +22,10 @@ registermatchmode = hledgerCommandMode
|
||||
([], Just $ argsFlag "DESC")
|
||||
|
||||
registermatch :: CliOpts -> Journal -> IO ()
|
||||
registermatch opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j =
|
||||
registermatch opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j =
|
||||
case listofstringopt "args" rawopts of
|
||||
[desc] -> do
|
||||
let (_,pris) = postingsReport ropts j
|
||||
let (_,pris) = postingsReport rspec j
|
||||
ps = [p | (_,_,_,p,_) <- pris]
|
||||
case similarPosting ps desc of
|
||||
Nothing -> putStrLn "no matches found."
|
||||
|
@ -36,13 +36,13 @@ rewritemode = hledgerCommandMode
|
||||
-- TODO interpolating match groups in replacement
|
||||
-- TODO allow using this on unbalanced entries, eg to rewrite while editing
|
||||
|
||||
rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = do
|
||||
rewrite opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j@Journal{jtxns=ts} = do
|
||||
-- rewrite matched transactions
|
||||
d <- getCurrentDay
|
||||
let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
|
||||
let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts} -- PARTIAL:
|
||||
-- run the print command, showing all transactions, or show diffs
|
||||
printOrDiff rawopts opts{reportopts_=ropts{query_=Any}} j j'
|
||||
printOrDiff rawopts opts{reportspec_=rspec{rsQuery=Any}} j j'
|
||||
|
||||
-- | Build a 'TransactionModifier' from any query arguments and --add-posting flags
|
||||
-- provided on the command line, or throw a parse error.
|
||||
|
@ -52,9 +52,10 @@ data OneSpan = OneSpan
|
||||
|
||||
|
||||
roi :: CliOpts -> Journal -> IO ()
|
||||
roi CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
|
||||
roi CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
|
||||
d <- getCurrentDay
|
||||
let
|
||||
ropts = rsOpts rspec
|
||||
showCashFlow = boolopt "cashflow" rawopts
|
||||
prettyTables = pretty_tables_ ropts
|
||||
makeQuery flag = do
|
||||
|
@ -42,11 +42,12 @@ statsmode = hledgerCommandMode
|
||||
-- like Register.summarisePostings
|
||||
-- | Print various statistics for the journal.
|
||||
stats :: CliOpts -> Journal -> IO ()
|
||||
stats opts@CliOpts{reportopts_=ReportOpts{query_=q, interval_=interval}} j = do
|
||||
stats opts@CliOpts{reportspec_=rspec} j = do
|
||||
d <- getCurrentDay
|
||||
let l = ledgerFromJournal q j
|
||||
let q = rsQuery rspec
|
||||
l = ledgerFromJournal q j
|
||||
reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q)
|
||||
intervalspans = splitSpan interval reportspan
|
||||
intervalspans = splitSpan (interval_ $ rsOpts rspec) reportspan
|
||||
showstats = showLedgerStats l d
|
||||
s = intercalate "\n" $ map showstats intervalspans
|
||||
writeOutput opts s
|
||||
|
@ -26,7 +26,7 @@ tagsmode = hledgerCommandMode
|
||||
([], Just $ argsFlag "[TAGREGEX [QUERY...]]")
|
||||
|
||||
tags :: CliOpts -> Journal -> IO ()
|
||||
tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||
tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
d <- getCurrentDay
|
||||
let args = listofstringopt "args" rawopts
|
||||
mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args
|
||||
@ -34,12 +34,12 @@ tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||
querystring = T.pack . unwords . map quoteIfNeeded $ drop 1 args
|
||||
values = boolopt "values" rawopts
|
||||
parsed = boolopt "parsed" rawopts
|
||||
empty = empty_ ropts
|
||||
empty = empty_ $ rsOpts rspec
|
||||
|
||||
argsquery <- either usageError (return . fst) $ parseQuery d querystring
|
||||
let
|
||||
q = simplifyQuery $ And [queryFromFlags ropts, argsquery]
|
||||
txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts ropts j
|
||||
q = simplifyQuery $ And [queryFromFlags $ rsOpts rspec, argsquery]
|
||||
txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j
|
||||
tagsorvalues =
|
||||
(if parsed then id else nubSort)
|
||||
[ r
|
||||
|
@ -88,8 +88,9 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
|
||||
|
||||
-- | Generate a runnable command from a compound balance command specification.
|
||||
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ())
|
||||
compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=ropts@ReportOpts{..}, rawopts_=rawopts} j = do
|
||||
compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportspec_=rspec, rawopts_=rawopts} j = do
|
||||
let
|
||||
ropts@ReportOpts{..} = rsOpts rspec
|
||||
-- use the default balance type for this report, unless the user overrides
|
||||
mBalanceTypeOverride =
|
||||
choiceopt parse rawopts where
|
||||
@ -120,7 +121,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
|
||||
_ -> showDateSpan requestedspan
|
||||
where
|
||||
enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date
|
||||
requestedspan = queryDateSpan date2_ query_
|
||||
requestedspan = queryDateSpan date2_ (rsQuery rspec)
|
||||
`spanDefaultsFrom` journalDateSpan date2_ j
|
||||
|
||||
-- when user overrides, add an indication to the report title
|
||||
@ -142,7 +143,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
|
||||
where multiperiod = interval_ /= NoInterval
|
||||
|
||||
-- make a CompoundBalanceReport.
|
||||
cbr' = compoundBalanceReport ropts' j cbcqueries
|
||||
cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries
|
||||
cbr = cbr'{cbrTitle=title}
|
||||
|
||||
-- render appropriately
|
||||
|
@ -151,9 +151,9 @@ main = do
|
||||
dbgIO "isInternalCommand" isInternalCommand
|
||||
dbgIO "isExternalCommand" isExternalCommand
|
||||
dbgIO "isBadCommand" isBadCommand
|
||||
dbgIO "period from opts" (period_ $ reportopts_ opts)
|
||||
dbgIO "interval from opts" (interval_ $ reportopts_ opts)
|
||||
dbgIO "query from opts & args" (query_ $ reportopts_ opts)
|
||||
dbgIO "period from opts" (period_ . rsOpts $ reportspec_ opts)
|
||||
dbgIO "interval from opts" (interval_ . rsOpts $ reportspec_ opts)
|
||||
dbgIO "query from opts & args" (rsQuery $ reportspec_ opts)
|
||||
let
|
||||
journallesserror = error "journal-less command tried to use the journal"
|
||||
runHledgerCommand
|
||||
|
@ -30,7 +30,6 @@ module Hledger.Cli.Utils
|
||||
)
|
||||
where
|
||||
import Control.Exception as C
|
||||
import Control.Monad
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
@ -71,9 +70,9 @@ withJournalDo opts cmd = do
|
||||
-- it's stdin, or it doesn't exist and we are adding. We read it strictly
|
||||
-- to let the add command work.
|
||||
journalpaths <- journalFilePathFromOpts opts
|
||||
readJournalFiles (inputopts_ opts) journalpaths
|
||||
>>= mapM (journalTransform opts)
|
||||
>>= either error' cmd -- PARTIAL:
|
||||
files <- readJournalFiles (inputopts_ opts) journalpaths
|
||||
let transformed = journalTransform opts <$> files
|
||||
either error' cmd transformed -- PARTIAL:
|
||||
|
||||
-- | Apply some extra post-parse transformations to the journal, if
|
||||
-- specified by options. These happen after journal validation, but
|
||||
@ -83,13 +82,13 @@ withJournalDo opts cmd = do
|
||||
-- - pivoting account names (--pivot)
|
||||
-- - anonymising (--anonymise).
|
||||
--
|
||||
journalTransform :: CliOpts -> Journal -> IO Journal
|
||||
journalTransform opts@CliOpts{reportopts_=_ropts} =
|
||||
journalAddForecast opts
|
||||
-- - converting amounts to market value (--value)
|
||||
-- >=> journalApplyValue ropts
|
||||
>=> return . pivotByOpts opts
|
||||
>=> return . anonymiseByOpts opts
|
||||
journalTransform :: CliOpts -> Journal -> Journal
|
||||
journalTransform opts =
|
||||
anonymiseByOpts opts
|
||||
-- - converting amounts to market value (--value)
|
||||
-- . journalApplyValue ropts
|
||||
. pivotByOpts opts
|
||||
. journalAddForecast opts
|
||||
|
||||
-- | Apply the pivot transformation on a journal, if option is present.
|
||||
pivotByOpts :: CliOpts -> Journal -> Journal
|
||||
@ -115,20 +114,22 @@ anonymiseByOpts opts =
|
||||
-- The start & end date for generated periodic transactions are determined in
|
||||
-- a somewhat complicated way; see the hledger manual -> Periodic transactions.
|
||||
--
|
||||
journalAddForecast :: CliOpts -> Journal -> IO Journal
|
||||
journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j =
|
||||
journalAddForecast :: CliOpts -> Journal -> Journal
|
||||
journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j =
|
||||
case forecast_ ropts of
|
||||
Nothing -> return j
|
||||
Just _ -> do
|
||||
today <- getCurrentDay
|
||||
Nothing -> j
|
||||
Just _ -> either (error') id . journalApplyCommodityStyles $ -- PARTIAL:
|
||||
journalBalanceTransactions' iopts j{ jtxns = concat [jtxns j, forecasttxns'] }
|
||||
where
|
||||
today = rsToday rspec
|
||||
ropts = rsOpts rspec
|
||||
|
||||
-- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)."
|
||||
let
|
||||
mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates
|
||||
forecastbeginDefault = dbg2 "forecastbeginDefault" $ fromMaybe today mjournalend
|
||||
|
||||
-- "They end on or before the specified report end date, or 180 days from today if unspecified."
|
||||
mspecifiedend = dbg2 "specifieddates" $ reportPeriodLastDay ropts
|
||||
mspecifiedend = dbg2 "specifieddates" $ reportPeriodLastDay rspec
|
||||
forecastendDefault = dbg2 "forecastendDefault" $ fromMaybe (addDays 180 today) mspecifiedend
|
||||
|
||||
forecastspan = dbg2 "forecastspan" $
|
||||
@ -146,14 +147,10 @@ journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j =
|
||||
(if auto_ iopts then either error' id . modifyTransactions today (jtxnmodifiers j) else id) -- PARTIAL:
|
||||
forecasttxns
|
||||
|
||||
j' = either error' id $ journalBalanceTransactions (not . ignore_assertions_ $ iopts) -- PARTIAL:
|
||||
j{jtxns=concat [jtxns j, forecasttxns']}
|
||||
|
||||
-- Display styles were applied early.. apply them again to ensure the forecasted
|
||||
-- transactions are also styled. XXX Possible optimisation: style just the forecasttxns.
|
||||
j'' = either error' id $ journalApplyCommodityStyles j' -- PARTIAL:
|
||||
|
||||
return j''
|
||||
journalBalanceTransactions' iopts j =
|
||||
let assrt = not . ignore_assertions_ $ iopts
|
||||
in
|
||||
either error' id $ journalBalanceTransactions assrt j -- PARTIAL:
|
||||
|
||||
-- | Write some output to stdout or to a file selected by --output-file.
|
||||
-- If the file exists it will be overwritten.
|
||||
@ -172,8 +169,8 @@ writeOutput opts s = do
|
||||
journalReload :: CliOpts -> IO (Either String Journal)
|
||||
journalReload opts = do
|
||||
journalpaths <- journalFilePathFromOpts opts
|
||||
readJournalFiles (inputopts_ opts) journalpaths
|
||||
>>= mapM (journalTransform opts)
|
||||
files <- readJournalFiles (inputopts_ opts) journalpaths
|
||||
return $ journalTransform opts <$> files
|
||||
|
||||
-- | Re-read the option-specified journal file(s), but only if any of
|
||||
-- them has changed since last read. (If the file is standard input,
|
||||
|
Loading…
Reference in New Issue
Block a user