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

lib,cli,ui,web: Introduce ReportSpec, which holds ReportOpts, the day of

Browse Source 
the report, and the parsed Query.
This commit is contained in:
Stephen Morgan 2020-09-16 11:45:52 +10:00 committed by Simon Michael
parent 19ab222599
commit 260283e2f1
41 changed files with 462 additions and 429 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
hledger-lib/Hledger/Reports/AccountTransactionsReport.hs
View File

@ -82,8 +82,8 @@ type AccountTransactionsReportItem =
totallabel = "Period Total" totallabel = "Period Total"
balancelabel = "Historical Total" balancelabel = "Historical Total"
accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport accountTransactionsReport :: ReportSpec -> Journal -> Query -> Query -> AccountTransactionsReport
accountTransactionsReport ropts j reportq thisacctq = (label, items) accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = (label, items)
where where
-- a depth limit should not affect the account transactions report -- a depth limit should not affect the account transactions report
-- seems unnecessary for some reason XXX -- seems unnecessary for some reason XXX
@ -115,11 +115,11 @@ accountTransactionsReport ropts j reportq thisacctq = (label, items)
styles = journalCommodityStyles j styles = journalCommodityStyles j
periodlast = periodlast =
fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay ropts j reportPeriodOrJournalLastDay rspec j
mreportlast = reportPeriodLastDay ropts mreportlast = reportPeriodLastDay rspec
multiperiod = interval_ ropts /= NoInterval multiperiod = interval_ ropts /= NoInterval
tval = case value_ ropts of 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 Nothing -> id
ts4 = ts4 =
ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $ ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $

34
hledger-lib/Hledger/Reports/BalanceReport.hs
View File

@ -23,7 +23,7 @@ import Hledger.Data
import Hledger.Read (mamountp') import Hledger.Read (mamountp')
import Hledger.Query import Hledger.Query
import Hledger.Utils import Hledger.Utils
import Hledger.Reports.MultiBalanceReport (multiBalanceReportWith) import Hledger.Reports.MultiBalanceReport (multiBalanceReport)
import Hledger.Reports.ReportOptions import Hledger.Reports.ReportOptions
import Hledger.Reports.ReportTypes import Hledger.Reports.ReportTypes
@ -61,10 +61,10 @@ flatShowsExclusiveBalance = True
-- their balances (change of balance) during the specified period. -- their balances (change of balance) during the specified period.
-- If the normalbalance_ option is set, it adjusts the sorting and sign of -- If the normalbalance_ option is set, it adjusts the sorting and sign of
-- amounts (see ReportOpts and CompoundBalanceCommand). -- amounts (see ReportOpts and CompoundBalanceCommand).
balanceReport :: ReportOpts -> Journal -> BalanceReport balanceReport :: ReportSpec -> Journal -> BalanceReport
balanceReport ropts j = (rows, total) balanceReport rspec j = (rows, total)
where where
report = multiBalanceReportWith ropts j (journalPriceOracle (infer_value_ ropts) j) report = multiBalanceReport rspec j
rows = [( prrFullName row rows = [( prrFullName row
, prrDisplayName row , prrDisplayName row
, prrDepth row - 1 -- BalanceReport uses 0-based account depths , prrDepth row - 1 -- BalanceReport uses 0-based account depths
@ -101,8 +101,8 @@ Right samplejournal2 =
tests_BalanceReport = tests "BalanceReport" [ tests_BalanceReport = tests "BalanceReport" [
let let
(opts,journal) `gives` r = do (rspec,journal) `gives` r = do
let opts' = opts{query_=And [queryFromFlags opts, query_ opts]} let opts' = rspec{rsQuery=And [queryFromFlags $ rsOpts rspec, rsQuery rspec]}
(eitems, etotal) = r (eitems, etotal) = r
(aitems, atotal) = balanceReport opts' journal (aitems, atotal) = balanceReport opts' journal
showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt)
@ -112,10 +112,10 @@ tests_BalanceReport = tests "BalanceReport" [
tests "balanceReport" [ tests "balanceReport" [
test "no args, null journal" $ test "no args, null journal" $
(defreportopts, nulljournal) `gives` ([], 0) (defreportspec, nulljournal) `gives` ([], 0)
,test "no args, sample journal" $ ,test "no args, sample journal" $
(defreportopts, samplejournal) `gives` (defreportspec, samplejournal) `gives`
([ ([
("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00") ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")
,("assets:bank:saving","assets:bank:saving",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]) Mixed [usd 0])
,test "with --tree" $ ,test "with --tree" $
(defreportopts{accountlistmode_=ALTree}, samplejournal) `gives` (defreportspec{rsOpts=defreportopts{accountlistmode_=ALTree}}, samplejournal) `gives`
([ ([
("assets","assets",0, mamountp' "$0.00") ("assets","assets",0, mamountp' "$0.00")
,("assets:bank","bank",1, mamountp' "$2.00") ,("assets:bank","bank",1, mamountp' "$2.00")
@ -145,7 +145,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with --depth=N" $ ,test "with --depth=N" $
(defreportopts{depth_=Just 1}, samplejournal) `gives` (defreportspec{rsOpts=defreportopts{depth_=Just 1}}, samplejournal) `gives`
([ ([
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
,("income", "income", 0, mamountp' "$-2.00") ,("income", "income", 0, mamountp' "$-2.00")
@ -153,7 +153,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with depth:N" $ ,test "with depth:N" $
(defreportopts{query_=Depth 1}, samplejournal) `gives` (defreportspec{rsQuery=Depth 1}, samplejournal) `gives`
([ ([
("expenses", "expenses", 0, mamountp' "$2.00") ("expenses", "expenses", 0, mamountp' "$2.00")
,("income", "income", 0, mamountp' "$-2.00") ,("income", "income", 0, mamountp' "$-2.00")
@ -161,11 +161,11 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with date:" $ ,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) ([], 0)
,test "with date2:" $ ,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") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0,mamountp' "$-1.00") ,("income:salary","income:salary",0,mamountp' "$-1.00")
@ -173,7 +173,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with desc:" $ ,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") ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00")
,("income:salary","income:salary",0, mamountp' "$-1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00")
@ -181,7 +181,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with not:desc:" $ ,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:bank:saving","assets:bank:saving",0, mamountp' "$1.00")
,("assets:cash","assets:cash",0, mamountp' "$-2.00") ,("assets:cash","assets:cash",0, mamountp' "$-2.00")
@ -192,7 +192,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with period on a populated period" $ ,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") ("assets:bank:checking","assets:bank:checking",0, mamountp' "$1.00")
@ -201,7 +201,7 @@ tests_BalanceReport = tests "BalanceReport" [
Mixed [usd 0]) Mixed [usd 0])
,test "with period on an unpopulated period" $ ,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) ([], 0)

10
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -65,12 +65,12 @@ type BudgetReport = PeriodicReport DisplayName BudgetCell
-- actual balance changes from the regular transactions, -- actual balance changes from the regular transactions,
-- and compare these to get a 'BudgetReport'. -- and compare these to get a 'BudgetReport'.
-- Unbudgeted accounts may be hidden or renamed (see budgetRollup). -- Unbudgeted accounts may be hidden or renamed (see budgetRollup).
budgetReport :: ReportOpts -> Bool -> DateSpan -> Journal -> BudgetReport budgetReport :: ReportSpec -> Bool -> DateSpan -> Journal -> BudgetReport
budgetReport ropts' assrt reportspan j = dbg1 "sortedbudgetreport" budgetreport budgetReport rspec assrt reportspan j = dbg1 "sortedbudgetreport" budgetreport
where where
-- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled -- 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 -- 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 showunbudgeted = empty_ ropts
budgetedaccts = budgetedaccts =
dbg2 "budgetedacctsinperiod" $ dbg2 "budgetedacctsinperiod" $
@ -83,9 +83,9 @@ budgetReport ropts' assrt reportspan j = dbg1 "sortedbudgetreport" budgetreport
actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j actualj = dbg1With (("actualj"++).show.jtxns) $ budgetRollUp budgetedaccts showunbudgeted j
budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j budgetj = dbg1With (("budgetj"++).show.jtxns) $ budgetJournal assrt ropts reportspan j
actualreport@(PeriodicReport actualspans _ _) = actualreport@(PeriodicReport actualspans _ _) =
dbg1 "actualreport" $ multiBalanceReport ropts{empty_=True} actualj dbg1 "actualreport" $ multiBalanceReport rspec{rsOpts=ropts{empty_=True}} actualj
budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) = budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =
dbg1 "budgetgoalreport" $ multiBalanceReport ropts{empty_=True} budgetj dbg1 "budgetgoalreport" $ multiBalanceReport rspec{rsOpts=ropts{empty_=True}} budgetj
budgetgoalreport' budgetgoalreport'
-- If no interval is specified: -- If no interval is specified:
-- budgetgoalreport's span might be shorter actualreport's due to periodic txns; -- budgetgoalreport's span might be shorter actualreport's due to periodic txns;

16
hledger-lib/Hledger/Reports/EntriesReport.hs
View File

@ -32,25 +32,25 @@ type EntriesReport = [EntriesReportItem]
type EntriesReportItem = Transaction type EntriesReportItem = Transaction
-- | Select transactions for an entries report. -- | Select transactions for an entries report.
entriesReport :: ReportOpts -> Journal -> EntriesReport entriesReport :: ReportSpec -> Journal -> EntriesReport
entriesReport ropts@ReportOpts{..} j@Journal{..} = entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =
sortBy (comparing getdate) $ filter (query_ `matchesTransaction`) $ map tvalue jtxns sortBy (comparing getdate) $ filter (rsQuery rspec `matchesTransaction`) $ map tvalue jtxns
where where
getdate = transactionDateFn ropts getdate = transactionDateFn ropts
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". -- 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} tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
where where
pvalue p = maybe p 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_ value_
where where
periodlast = fromMaybe today_ $ reportPeriodOrJournalLastDay ropts j periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
mreportlast = reportPeriodLastDay ropts mreportlast = reportPeriodLastDay rspec
tests_EntriesReport = tests "EntriesReport" [ tests_EntriesReport = tests "EntriesReport" [
tests "entriesReport" [ tests "entriesReport" [
test "not acct" $ (length $ entriesReport defreportopts{query_=Not . Acct $ toRegex' "bank"} samplejournal) @?= 1 test "not acct" $ (length $ entriesReport defreportspec{rsQuery=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 "date" $ (length $ entriesReport defreportspec{rsQuery=Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)} samplejournal) @?= 3
] ]
] ]

145
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -90,61 +90,61 @@ type ClippedAccountName = AccountName
-- CompoundBalanceCommand). hledger's most powerful and useful report, used -- CompoundBalanceCommand). hledger's most powerful and useful report, used
-- by the balance command (in multiperiod mode) and (via compoundBalanceReport) -- by the balance command (in multiperiod mode) and (via compoundBalanceReport)
-- by the bs/cf/is commands. -- by the bs/cf/is commands.
multiBalanceReport :: ReportOpts -> Journal -> MultiBalanceReport multiBalanceReport :: ReportSpec -> Journal -> MultiBalanceReport
multiBalanceReport ropts j = multiBalanceReportWith ropts j (journalPriceOracle infer j) multiBalanceReport rspec j = multiBalanceReportWith rspec j (journalPriceOracle infer j)
where infer = infer_value_ ropts where infer = infer_value_ $ rsOpts rspec
-- | A helper for multiBalanceReport. This one takes an extra argument, -- | A helper for multiBalanceReport. This one takes an extra argument,
-- a PriceOracle to be used for looking up market prices. Commands which -- a PriceOracle to be used for looking up market prices. Commands which
-- run multiple reports (bs etc.) can generate the price oracle just -- run multiple reports (bs etc.) can generate the price oracle just
-- once for efficiency, passing it to each report by calling this -- once for efficiency, passing it to each report by calling this
-- function directly. -- function directly.
multiBalanceReportWith :: ReportOpts -> Journal -> PriceOracle -> MultiBalanceReport multiBalanceReportWith :: ReportSpec -> Journal -> PriceOracle -> MultiBalanceReport
multiBalanceReportWith ropts' j priceoracle = report multiBalanceReportWith rspec' j priceoracle = report
where where
-- Queries, report/column dates. -- Queries, report/column dates.
reportspan = dbg "reportspan" $ calculateReportSpan ropts' j reportspan = dbg "reportspan" $ calculateReportSpan rspec' j
ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan rspec = dbg "reportopts" $ makeReportQuery rspec' reportspan
valuation = makeValuation ropts' j priceoracle -- Must use ropts' instead of ropts, valuation = makeValuation rspec' j priceoracle -- Must use rspec' instead of rspec,
-- so the reportspan isn't used for valuation -- so the reportspan isn't used for valuation
-- Group postings into their columns. -- 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 colspans = dbg "colspans" $ M.keys colps
-- The matched accounts with a starting balance. All of these should appear -- 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. -- 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 -- Generate and postprocess the report, negating balances and taking percentages if needed
report = dbg' "report" $ 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 -- | Generate a compound balance report from a list of CBCSubreportSpec. This
-- shares postings between the subreports. -- shares postings between the subreports.
compoundBalanceReport :: ReportOpts -> Journal -> [CBCSubreportSpec] compoundBalanceReport :: ReportSpec -> Journal -> [CBCSubreportSpec]
-> CompoundBalanceReport -> CompoundBalanceReport
compoundBalanceReport ropts j = compoundBalanceReportWith ropts j (journalPriceOracle infer j) compoundBalanceReport rspec j = compoundBalanceReportWith rspec j (journalPriceOracle infer j)
where infer = infer_value_ ropts where infer = infer_value_ $ rsOpts rspec
-- | A helper for compoundBalanceReport, similar to multiBalanceReportWith. -- | A helper for compoundBalanceReport, similar to multiBalanceReportWith.
compoundBalanceReportWith :: ReportOpts -> Journal -> PriceOracle compoundBalanceReportWith :: ReportSpec -> Journal -> PriceOracle
-> [CBCSubreportSpec] -> CompoundBalanceReport -> [CBCSubreportSpec] -> CompoundBalanceReport
compoundBalanceReportWith ropts' j priceoracle subreportspecs = cbr compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
where where
-- Queries, report/column dates. -- Queries, report/column dates.
reportspan = dbg "reportspan" $ calculateReportSpan ropts' j reportspan = dbg "reportspan" $ calculateReportSpan rspec' j
ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan rspec = dbg "reportopts" $ makeReportQuery rspec' reportspan
valuation = makeValuation ropts' j priceoracle -- Must use ropts' instead of ropts, valuation = makeValuation rspec' j priceoracle -- Must use ropts' instead of ropts,
-- so the reportspan isn't used for valuation -- so the reportspan isn't used for valuation
-- Group postings into their columns. -- 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 colspans = dbg "colspans" $ M.keys colps
-- The matched accounts with a starting balance. All of these should appear -- 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. -- 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 subreports = map generateSubreport subreportspecs
where where
@ -152,11 +152,12 @@ compoundBalanceReportWith ropts' j priceoracle subreportspecs = cbr
( cbcsubreporttitle ( cbcsubreporttitle
-- Postprocess the report, negating balances and taking percentages if needed -- Postprocess the report, negating balances and taking percentages if needed
, prNormaliseSign cbcsubreportnormalsign $ , prNormaliseSign cbcsubreportnormalsign $
generateMultiBalanceReport ropts' j valuation colspans colps' startbals' generateMultiBalanceReport rspec' j valuation colspans colps' startbals'
, cbcsubreportincreasestotal , cbcsubreportincreasestotal
) )
where where
ropts' = ropts{normalbalance_=Just cbcsubreportnormalsign} rspec' = rspec{rsOpts=ropts}
ropts = (rsOpts rspec){normalbalance_=Just cbcsubreportnormalsign}
-- Filter the column postings according to each subreport -- Filter the column postings according to each subreport
colps' = filter (matchesPosting $ cbcsubreportquery j) <$> colps colps' = filter (matchesPosting $ cbcsubreportquery j) <$> colps
startbals' = HM.filterWithKey (\k _ -> matchesAccount (cbcsubreportquery j) k) startbals 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 -- TODO: Do we want to check whether to bother calculating these? isHistorical
-- and startDate is not nothing, otherwise mempty? This currently gives a -- and startDate is not nothing, otherwise mempty? This currently gives a
-- failure with some totals which are supposed to be 0 being blank. -- failure with some totals which are supposed to be 0 being blank.
startingBalances :: ReportOpts -> Journal -> DateSpan -> HashMap AccountName Account startingBalances :: ReportSpec -> Journal -> DateSpan -> HashMap AccountName Account
startingBalances ropts j reportspan = startingBalances rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j reportspan =
acctChangesFromPostings ropts' . map fst $ getPostings ropts' j acctChangesFromPostings rspec' . map fst $ getPostings rspec' j
where where
rspec' = rspec{rsQuery=startbalq,rsOpts=ropts'}
ropts' = case accountlistmode_ ropts of ropts' = case accountlistmode_ ropts of
ALTree -> ropts{query_=startbalq, period_=precedingperiod, no_elide_=True} ALTree -> ropts{period_=precedingperiod, no_elide_=True}
ALFlat -> ropts{query_=startbalq, period_=precedingperiod} ALFlat -> ropts{period_=precedingperiod}
-- q projected back before the report start date. -- 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), -- 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. -- we use emptydatespan to make sure they aren't counted as starting balance.
startbalq = dbg'' "startbalq" $ And [datelessq, precedingspanq] 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 . precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan .
periodAsDateSpan $ period_ ropts periodAsDateSpan $ period_ ropts
@ -204,11 +206,11 @@ startingBalances ropts j reportspan =
a -> a a -> a
-- | Calculate the span of the report to be generated. -- | Calculate the span of the report to be generated.
calculateReportSpan :: ReportOpts -> Journal -> DateSpan calculateReportSpan :: ReportSpec -> Journal -> DateSpan
calculateReportSpan ropts j = reportspan calculateReportSpan ReportSpec{rsQuery=query,rsOpts=ropts} j = reportspan
where where
-- The date span specified by -b/-e/-p options and query args if any. -- 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. -- 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. -- This can still be the null (open) span if the journal is empty.
requestedspan' = dbg "requestedspan'" $ requestedspan' = dbg "requestedspan'" $
@ -227,37 +229,37 @@ calculateReportSpan ropts j = reportspan
-- The user's query expanded to the report span -- The user's query expanded to the report span
-- if there is one (otherwise any date queries are left as-is, which -- if there is one (otherwise any date queries are left as-is, which
-- handles the hledger-ui+future txns case above). -- handles the hledger-ui+future txns case above).
makeReportQuery :: ReportOpts -> DateSpan -> ReportOpts makeReportQuery :: ReportSpec -> DateSpan -> ReportSpec
makeReportQuery ropts reportspan makeReportQuery rspec reportspan
| reportspan == nulldatespan = ropts | reportspan == nulldatespan = rspec
| otherwise = ropts{query_=query} | otherwise = rspec{rsQuery=query}
where where
query = simplifyQuery $ And [dateless $ query_ ropts, reportspandatesq] query = simplifyQuery $ And [dateless $ rsQuery rspec, reportspandatesq]
reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan
dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2) 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 -- | Make a valuation function for valuating MixedAmounts and a given Day
makeValuation :: ReportOpts -> Journal -> PriceOracle -> Day -> MixedAmount -> MixedAmount makeValuation :: ReportSpec -> Journal -> PriceOracle -> (Day -> MixedAmount -> MixedAmount)
makeValuation ropts j priceoracle day = case value_ ropts of makeValuation rspec j priceoracle day = case value_ (rsOpts rspec) of
Nothing -> id 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 where
-- Some things needed if doing valuation. -- Some things needed if doing valuation.
styles = journalCommodityStyles j styles = journalCommodityStyles j
mreportlast = reportPeriodLastDay ropts mreportlast = reportPeriodLastDay rspec
multiperiod = interval_ ropts /= NoInterval multiperiod = interval_ (rsOpts rspec) /= NoInterval
-- | Group postings, grouped by their column -- | Group postings, grouped by their column
getPostingsByColumn :: ReportOpts -> Journal -> DateSpan -> Map DateSpan [Posting] getPostingsByColumn :: ReportSpec -> Journal -> DateSpan -> Map DateSpan [Posting]
getPostingsByColumn ropts j reportspan = columns getPostingsByColumn rspec j reportspan = columns
where where
-- Postings matching the query within the report period. -- 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 days = map snd ps
-- The date spans to be included as report columns. -- 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 addPosting (p, d) = maybe id (M.adjust (p:)) $ latestSpanContaining colspans d
emptyMap = M.fromList . zip colspans $ repeat [] emptyMap = M.fromList . zip colspans $ repeat []
@ -265,19 +267,18 @@ getPostingsByColumn ropts j reportspan = columns
columns = foldr addPosting emptyMap ps columns = foldr addPosting emptyMap ps
-- | Gather postings matching the query within the report period. -- | Gather postings matching the query within the report period.
getPostings :: ReportOpts -> Journal -> [(Posting, Day)] getPostings :: ReportSpec -> Journal -> [(Posting, Day)]
getPostings ropts = getPostings ReportSpec{rsQuery=query,rsOpts=ropts} =
map (\p -> (p, date p)) . map (\p -> (p, date p)) .
journalPostings . journalPostings .
filterJournalAmounts symq . -- remove amount parts excluded by cur: filterJournalAmounts symq . -- remove amount parts excluded by cur:
filterJournalPostings reportq -- remove postings not matched by (adjusted) query filterJournalPostings reportq -- remove postings not matched by (adjusted) query
where where
q = query_ ropts symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" query
symq = dbg "symq" . filterQuery queryIsSym $ dbg "requested q" q
-- The user's query with no depth limit, and expanded to the report span -- 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 -- if there is one (otherwise any date queries are left as-is, which
-- handles the hledger-ui+future txns case above). -- handles the hledger-ui+future txns case above).
reportq = dbg "reportq" $ depthless q reportq = dbg "reportq" $ depthless query
depthless = dbg "depthless" . filterQuery (not . queryIsDepth) depthless = dbg "depthless" . filterQuery (not . queryIsDepth)
date = case whichDateFromOpts ropts of date = case whichDateFromOpts ropts of
@ -297,17 +298,17 @@ calculateColSpans ropts reportspan days =
-- | Gather the account balance changes into a regular matrix -- | Gather the account balance changes into a regular matrix
-- including the accounts from all columns. -- including the accounts from all columns.
calculateAccountChanges :: ReportOpts -> [DateSpan] -> Map DateSpan [Posting] calculateAccountChanges :: ReportSpec -> [DateSpan] -> Map DateSpan [Posting]
-> HashMap ClippedAccountName (Map DateSpan Account) -> HashMap ClippedAccountName (Map DateSpan Account)
calculateAccountChanges ropts colspans colps calculateAccountChanges rspec colspans colps
| queryDepth (query_ ropts) == Just 0 = acctchanges <> elided | queryDepth (rsQuery rspec) == Just 0 = acctchanges <> elided
| otherwise = acctchanges | otherwise = acctchanges
where where
-- Transpose to get each account's balance changes across all columns. -- Transpose to get each account's balance changes across all columns.
acctchanges = transposeMap colacctchanges acctchanges = transposeMap colacctchanges
colacctchanges :: Map DateSpan (HashMap ClippedAccountName Account) = 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] 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 -- the accounts that have postings and calculate the change amount for
-- each. Accounts and amounts will be depth-clipped appropriately if -- each. Accounts and amounts will be depth-clipped appropriately if
-- a depth limit is in effect. -- a depth limit is in effect.
acctChangesFromPostings :: ReportOpts -> [Posting] -> HashMap ClippedAccountName Account acctChangesFromPostings :: ReportSpec -> [Posting] -> HashMap ClippedAccountName Account
acctChangesFromPostings ropts ps = HM.fromList [(aname a, a) | a <- as] acctChangesFromPostings ReportSpec{rsQuery=query,rsOpts=ropts} ps =
HM.fromList [(aname a, a) | a <- as]
where where
as = filterAccounts . drop 1 $ accountsFromPostings ps as = filterAccounts . drop 1 $ accountsFromPostings ps
filterAccounts = case accountlistmode_ ropts of filterAccounts = case accountlistmode_ ropts of
ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances ALTree -> filter ((depthq `matchesAccount`) . aname) -- exclude deeper balances
ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit. ALFlat -> clipAccountsAndAggregate (queryDepth depthq) . -- aggregate deeper balances at the depth limit.
filter ((0<) . anumpostings) 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. -- | 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 -- | 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 -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
-- from the columns. -- from the columns.
generateMultiBalanceReport :: ReportOpts -> Journal -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan] generateMultiBalanceReport :: ReportSpec -> Journal -> (Day -> MixedAmount -> MixedAmount) -> [DateSpan]
-> Map DateSpan [Posting] -> HashMap AccountName Account -> Map DateSpan [Posting] -> HashMap AccountName Account
-> MultiBalanceReport -> MultiBalanceReport
generateMultiBalanceReport ropts j valuation colspans colps startbals = report generateMultiBalanceReport rspec@ReportSpec{rsOpts=ropts} j valuation colspans colps startbals =
report
where where
-- Each account's balance changes across all columns. -- 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 -- Process changes into normal, cumulative, or historical amounts, plus value them
accumvalued = accumValueAmounts ropts valuation colspans startbals acctchanges accumvalued = accumValueAmounts ropts valuation colspans startbals acctchanges
-- All account names that will be displayed, possibly depth-clipped. -- 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. -- All the rows of the report.
rows = dbg'' "rows" $ buildReportRows ropts displaynames accumvalued 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 -- | Calculate accounts which are to be displayed in the report, as well as
-- their name and depth -- their name and depth
displayedAccounts :: ReportOpts -> HashMap AccountName (Map DateSpan Account) displayedAccounts :: ReportSpec -> HashMap AccountName (Map DateSpan Account)
-> HashMap AccountName DisplayName -> HashMap AccountName DisplayName
displayedAccounts ropts valuedaccts displayedAccounts ReportSpec{rsQuery=query,rsOpts=ropts} valuedaccts
| depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1 | depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1
| otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts | otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts
where where
@ -460,7 +463,7 @@ displayedAccounts ropts valuedaccts
minSubs = if no_elide_ ropts then 1 else 2 minSubs = if no_elide_ ropts then 1 else 2
isZeroRow balance = all (mixedAmountLooksZero . balance) isZeroRow balance = all (mixedAmountLooksZero . balance)
depth = fromMaybe maxBound . queryDepth $ query_ ropts depth = fromMaybe maxBound $ queryDepth query
numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts
-- | Sort the rows by amount or by account declaration order. -- | Sort the rows by amount or by account declaration order.
@ -604,10 +607,10 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
let let
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False} 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 (rspec,journal) `gives` r = do
let opts' = opts{query_=And [queryFromFlags opts, query_ opts]} let rspec' = rspec{rsQuery=And [queryFromFlags $ rsOpts rspec, rsQuery rspec]}
(eitems, etotal) = r (eitems, etotal) = r
(PeriodicReport _ aitems atotal) = multiBalanceReport opts' journal (PeriodicReport _ aitems atotal) = multiBalanceReport rspec' journal
showw (PeriodicReportRow a lAmt amt amt') showw (PeriodicReportRow a lAmt amt amt')
= (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt') = (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
(map showw aitems) @?= (map showw eitems) (map showw aitems) @?= (map showw eitems)
@ -615,10 +618,10 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
in in
tests "multiBalanceReport" [ tests "multiBalanceReport" [
test "null journal" $ test "null journal" $
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) (defreportspec, nulljournal) `gives` ([], Mixed [nullamt])
,test "with -H on a populated period" $ ,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 "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)}]) , PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (mamountp' "$-1.00") (Mixed [amt0 {aquantity=(-1)}])

55
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -65,19 +65,19 @@ type SummaryPosting = (Posting, Day)
-- | Select postings from the journal and add running balance and other -- | Select postings from the journal and add running balance and other
-- information to make a postings report. Used by eg hledger's register command. -- information to make a postings report. Used by eg hledger's register command.
postingsReport :: ReportOpts -> Journal -> PostingsReport postingsReport :: ReportSpec -> Journal -> PostingsReport
postingsReport ropts@ReportOpts{..} j = postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =
(totallabel, items) (totallabel, items)
where where
reportspan = adjustReportDates ropts j reportspan = adjustReportDates rspec j
whichdate = whichDateFromOpts ropts whichdate = whichDateFromOpts ropts
mdepth = queryDepth query_ mdepth = queryDepth $ rsQuery rspec
styles = journalCommodityStyles j styles = journalCommodityStyles j
priceoracle = journalPriceOracle infer_value_ j priceoracle = journalPriceOracle infer_value_ j
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval
-- postings to be included in the report, and similarly-matched postings before the report start date -- 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. -- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)] displayps :: [(Posting, Maybe Day)]
@ -89,12 +89,12 @@ postingsReport ropts@ReportOpts{..} j =
where where
showempty = empty_ || average_ showempty = empty_ || average_
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports". -- 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 where
mreportlast = reportPeriodLastDay ropts mreportlast = reportPeriodLastDay rspec
reportorjournallast = reportorjournallast =
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
reportPeriodOrJournalLastDay ropts j reportPeriodOrJournalLastDay rspec j
-- Posting report items ready for display. -- Posting report items ready for display.
items = items =
@ -112,13 +112,13 @@ postingsReport ropts@ReportOpts{..} j =
precedingsum = sumPostings precedingps precedingsum = sumPostings precedingps
precedingavg | null precedingps = 0 precedingavg | null precedingps = 0
| otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum | 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 ? -- XXX constrain valuation type to AtDate daybeforereportstart here ?
where where
daybeforereportstart = daybeforereportstart =
maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen
(addDays (-1)) (addDays (-1))
$ reportPeriodOrJournalStart ropts j $ reportPeriodOrJournalStart rspec j
runningcalc = registerRunningCalculationFn ropts runningcalc = registerRunningCalculationFn ropts
startnum = if historical then length precedingps + 1 else 1 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) -- 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) -- 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 -- 3. If a report interval is specified, enlarge the dates to enclose whole intervals
adjustReportDates :: ReportOpts -> Journal -> DateSpan adjustReportDates :: ReportSpec -> Journal -> DateSpan
adjustReportDates opts j = reportspan adjustReportDates rspec@ReportSpec{rsOpts=ropts} j = reportspan
where where
-- see also multiBalanceReport -- 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 journalspan = dbg3 "journalspan" $ dates `spanUnion` date2s -- earliest and latest dates (or date2s) in the journal
where where
dates = journalDateSpan False j dates = journalDateSpan False j
date2s = journalDateSpan True j date2s = journalDateSpan True j
requestedspanclosed = dbg3 "requestedspanclosed" $ requestedspan `spanDefaultsFrom` journalspan -- if open-ended, close it using the journal's dates (if any) 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 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 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 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. -- and also any similarly-matched postings before that date span.
-- Date restrictions and depth restrictions in the query are ignored. -- Date restrictions and depth restrictions in the query are ignored.
-- A helper for the postings report. -- A helper for the postings report.
matchedPostingsBeforeAndDuring :: ReportOpts -> Journal -> DateSpan -> ([Posting],[Posting]) matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting])
matchedPostingsBeforeAndDuring opts j (DateSpan mstart mend) = matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan mstart mend) =
dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
where where
q = query_ opts
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart
beforeandduringps = beforeandduringps =
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2 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 "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 dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit
journalPostings $ 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 where
beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq] beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]
where where
depthless = filterQuery (not . queryIsDepth) depthless = filterQuery (not . queryIsDepth)
dateless = filterQuery (not . queryIsDateOrDate2) dateless = filterQuery (not . queryIsDateOrDate2)
beforeendq = dateqtype $ DateSpan Nothing mend beforeendq = dateqtype $ DateSpan Nothing mend
sortdate = if date2_ opts then postingDate2 else postingDate sortdate = if date2_ ropts then postingDate2 else postingDate
symq = dbg4 "symq" . filterQuery queryIsSym $ query_ opts symq = dbg4 "symq" $ filterQuery queryIsSym q
dateqtype dateqtype
| queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2 | queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) = Date2
| otherwise = Date | otherwise = Date
where where
dateq = dbg4 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg4 "q" q -- XXX confused by multiple date:/date2: ? 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" [ tests_PostingsReport = tests "PostingsReport" [
test "postingsReport" $ do 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 -- with the query specified explicitly
(Any, nulljournal) `gives` 0 (Any, nulljournal) `gives` 0
(Any, samplejournal) `gives` 13 (Any, samplejournal) `gives` 13
@ -279,10 +278,10 @@ tests_PostingsReport = tests "PostingsReport" [
(And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2 (And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2
(And [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 -- with query and/or command-line options
(length $ snd $ postingsReport defreportopts samplejournal) @?= 13 (length $ snd $ postingsReport defreportspec samplejournal) @?= 13
(length $ snd $ postingsReport defreportopts{interval_=Months 1} samplejournal) @?= 11 (length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} samplejournal) @?= 20 (length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
(length $ snd $ postingsReport defreportopts{query_=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5 (length $ snd $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0 -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
-- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1) -- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1)

99
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -10,12 +10,15 @@ Options common to most hledger reports.
module Hledger.Reports.ReportOptions ( module Hledger.Reports.ReportOptions (
ReportOpts(..), ReportOpts(..),
ReportSpec(..),
BalanceType(..), BalanceType(..),
AccountListMode(..), AccountListMode(..),
ValuationType(..), ValuationType(..),
defreportopts, defreportopts,
rawOptsToReportOpts, rawOptsToReportOpts,
regenerateReportOpts, defreportspec,
reportOptsToSpec,
rawOptsToReportSpec,
flat_, flat_,
tree_, tree_,
reportOptsToggleStatus, reportOptsToggleStatus,
@ -78,10 +81,7 @@ instance Default AccountListMode where def = ALFlat
-- commands, as noted below. -- commands, as noted below.
data ReportOpts = ReportOpts { data ReportOpts = ReportOpts {
-- for most reports: -- for most reports:
today_ :: Day -- ^ The current date. A late addition to ReportOpts. period_ :: Period
-- Reports use it when picking a -V valuation date.
-- This is not great, adds indeterminacy.
,period_ :: Period
,interval_ :: Interval ,interval_ :: Interval
,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched ,statuses_ :: [Status] -- ^ Zero, one, or two statuses to be matched
,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ? ,value_ :: Maybe ValuationType -- ^ What value should amounts be converted to ?
@ -92,8 +92,6 @@ data ReportOpts = ReportOpts {
,no_elide_ :: Bool ,no_elide_ :: Bool
,real_ :: Bool ,real_ :: Bool
,format_ :: StringFormat ,format_ :: StringFormat
,query_ :: Query
,queryopts_ :: [QueryOpt]
,querystring_ :: T.Text ,querystring_ :: T.Text
-- --
,average_ :: Bool ,average_ :: Bool
@ -132,8 +130,7 @@ instance Default ReportOpts where def = defreportopts
defreportopts :: ReportOpts defreportopts :: ReportOpts
defreportopts = ReportOpts defreportopts = ReportOpts
{ today_ = nulldate { period_ = PeriodAll
, period_ = PeriodAll
, interval_ = NoInterval , interval_ = NoInterval
, statuses_ = [] , statuses_ = []
, value_ = Nothing , value_ = Nothing
@ -144,8 +141,6 @@ defreportopts = ReportOpts
, no_elide_ = False , no_elide_ = False
, real_ = False , real_ = False
, format_ = def , format_ = def
, query_ = Any
, queryopts_ = []
, querystring_ = "" , querystring_ = ""
, average_ = False , average_ = False
, related_ = False , related_ = False
@ -181,11 +176,8 @@ rawOptsToReportOpts rawopts = do
Just (Right x) -> return x Just (Right x) -> return x
Just (Left err) -> fail $ "could not parse format option: " ++ err Just (Left err) -> fail $ "could not parse format option: " ++ err
(argsquery, queryopts) <- either fail return $ parseQuery d querystring
let reportopts = defreportopts let reportopts = defreportopts
{today_ = d {period_ = periodFromRawOpts d rawopts
,period_ = periodFromRawOpts d rawopts
,interval_ = intervalFromRawOpts rawopts ,interval_ = intervalFromRawOpts rawopts
,statuses_ = statusesFromRawOpts rawopts ,statuses_ = statusesFromRawOpts rawopts
,value_ = valuationTypeFromRawOpts rawopts ,value_ = valuationTypeFromRawOpts rawopts
@ -196,8 +188,6 @@ rawOptsToReportOpts rawopts = do
,no_elide_ = boolopt "no-elide" rawopts ,no_elide_ = boolopt "no-elide" rawopts
,real_ = boolopt "real" rawopts ,real_ = boolopt "real" rawopts
,format_ = format ,format_ = format
,query_ = simplifyQuery $ And [queryFromFlags reportopts, argsquery]
,queryopts_ = queryopts
,querystring_ = querystring ,querystring_ = querystring
,average_ = boolopt "average" rawopts ,average_ = boolopt "average" rawopts
,related_ = boolopt "related" rawopts ,related_ = boolopt "related" rawopts
@ -220,11 +210,40 @@ rawOptsToReportOpts rawopts = do
} }
return reportopts return reportopts
-- | Regenerate a ReportOpts on a different day with a different query string. data ReportSpec = ReportSpec
regenerateReportOpts :: Day -> T.Text -> ReportOpts -> Either String ReportOpts { rsOpts :: ReportOpts
regenerateReportOpts d querystring ropts = do , rsToday :: Day
(q,o) <- parseQuery d querystring , rsQuery :: Query
return ropts{today_=d, query_=q, queryopts_=o, querystring_=querystring} , 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 :: RawOpts -> AccountListMode
accountlistmodeopt = accountlistmodeopt =
@ -454,45 +473,45 @@ queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq
-- options or queries, or otherwise the earliest and latest transaction or -- options or queries, or otherwise the earliest and latest transaction or
-- posting dates in the journal. If no dates are specified by options/queries -- posting dates in the journal. If no dates are specified by options/queries
-- and the journal is empty, returns the null date span. -- and the journal is empty, returns the null date span.
reportSpan :: Journal -> ReportOpts -> DateSpan reportSpan :: Journal -> ReportSpec -> DateSpan
reportSpan j ropts = dbg3 "reportspan" $ DateSpan mstartdate menddate reportSpan j ReportSpec{rsQuery=query} = dbg3 "reportspan" $ DateSpan mstartdate menddate
where where
DateSpan mjournalstartdate mjournalenddate = DateSpan mjournalstartdate mjournalenddate =
dbg3 "journalspan" $ journalDateSpan False j -- ignore secondary dates dbg3 "journalspan" $ journalDateSpan False j -- ignore secondary dates
mstartdate = queryStartDate False (query_ ropts) <|> mjournalstartdate mstartdate = queryStartDate False query <|> mjournalstartdate
menddate = queryEndDate False (query_ ropts) <|> mjournalenddate menddate = queryEndDate False query <|> mjournalenddate
reportStartDate :: Journal -> ReportOpts -> Maybe Day reportStartDate :: Journal -> ReportSpec -> Maybe Day
reportStartDate j ropts = spanStart $ reportSpan j ropts reportStartDate j = spanStart . reportSpan j
reportEndDate :: Journal -> ReportOpts -> Maybe Day reportEndDate :: Journal -> ReportSpec -> Maybe Day
reportEndDate j ropts = spanEnd $ reportSpan j ropts reportEndDate j = spanEnd . reportSpan j
-- Some pure alternatives to the above. XXX review/clean up -- Some pure alternatives to the above. XXX review/clean up
-- Get the report's start date. -- Get the report's start date.
-- If no report period is specified, will be Nothing. -- If no report period is specified, will be Nothing.
reportPeriodStart :: ReportOpts -> Maybe Day reportPeriodStart :: ReportSpec -> Maybe Day
reportPeriodStart = queryStartDate False . query_ reportPeriodStart = queryStartDate False . rsQuery
-- Get the report's start date, or if no report period is specified, -- 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 -- the journal's start date (the earliest posting date). If there's no
-- report period and nothing in the journal, will be Nothing. -- report period and nothing in the journal, will be Nothing.
reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day reportPeriodOrJournalStart :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalStart ropts j = reportPeriodOrJournalStart rspec j =
reportPeriodStart ropts <|> journalStartDate False j reportPeriodStart rspec <|> journalStartDate False j
-- Get the last day of the overall report period. -- Get the last day of the overall report period.
-- This the inclusive end date (one day before the -- This the inclusive end date (one day before the
-- more commonly used, exclusive, report end date). -- more commonly used, exclusive, report end date).
-- If no report period is specified, will be Nothing. -- If no report period is specified, will be Nothing.
reportPeriodLastDay :: ReportOpts -> Maybe Day reportPeriodLastDay :: ReportSpec -> Maybe Day
reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . query_ reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . rsQuery
-- Get the last day of the overall report period, or if no report -- 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 -- period is specified, the last day of the journal (ie the latest
-- posting date). If there's no report period and nothing in the -- posting date). If there's no report period and nothing in the
-- journal, will be Nothing. -- journal, will be Nothing.
reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day reportPeriodOrJournalLastDay :: ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ropts j = reportPeriodOrJournalLastDay rspec j =
reportPeriodLastDay ropts <|> journalEndDate False j reportPeriodLastDay rspec <|> journalEndDate False j

13
hledger-ui/Hledger/UI/AccountsScreen.hs
View File

@ -53,7 +53,7 @@ accountsScreen = AccountsScreen{
asInit :: Day -> Bool -> UIState -> UIState asInit :: Day -> Bool -> UIState -> UIState
asInit d reset ui@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, ajournal=j,
aScreen=s@AccountsScreen{} aScreen=s@AccountsScreen{}
} = } =
@ -80,8 +80,8 @@ asInit d reset ui@UIState{
where where
as = map asItemAccountName displayitems as = map asItemAccountName displayitems
uopts' = uopts{cliopts_=copts{reportopts_=ropts'}} uopts' = uopts{cliopts_=copts{reportspec_=rspec'}}
ropts' = ropts{query_=simplifyQuery $ And [query_ ropts, excludeforecastq (forecast_ ropts)]} rspec' = rspec{rsQuery=simplifyQuery $ And [rsQuery rspec, excludeforecastq (forecast_ ropts)]}
where where
-- Except in forecast mode, exclude future/forecast transactions. -- Except in forecast mode, exclude future/forecast transactions.
excludeforecastq (Just _) = Any excludeforecastq (Just _) = Any
@ -92,13 +92,13 @@ asInit d reset ui@UIState{
] ]
-- run the report -- run the report
(items,_total) = balanceReport ropts' j (items,_total) = balanceReport rspec' j
-- pre-render the list items -- pre-render the list items
displayitem (fullacct, shortacct, indent, bal) = displayitem (fullacct, shortacct, indent, bal) =
AccountsScreenItem{asItemIndentLevel = indent AccountsScreenItem{asItemIndentLevel = indent
,asItemAccountName = fullacct ,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 ,asItemRenderedAmounts = map (showAmountWithoutPrice False) amts
} }
where where
@ -117,7 +117,7 @@ asInit d reset ui@UIState{
asInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL: asInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
asDraw :: UIState -> [Widget Name] 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 ,ajournal=j
,aScreen=s@AccountsScreen{} ,aScreen=s@AccountsScreen{}
,aMode=mode ,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) render $ defaultLayout toplabel bottomlabel $ renderList (asDrawItem colwidths) True (_asList s)
where where
ropts = rsOpts rspec
ishistorical = balancetype_ ropts == HistoricalBalance ishistorical = balancetype_ ropts == HistoricalBalance
toplabel = toplabel =

16
hledger-ui/Hledger/UI/Main.hs
View File

@ -51,12 +51,12 @@ writeChan = BC.writeBChan
main :: IO () main :: IO ()
main = do 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) -- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
-- always include forecasted periodic transactions when loading data; -- always include forecasted periodic transactions when loading data;
-- they will be toggled on and off in the UI. -- 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 case True of
_ | "help" `inRawOpts` rawopts -> putStr (showModeUsage uimode) _ | "help" `inRawOpts` rawopts -> putStr (showModeUsage uimode)
@ -65,7 +65,7 @@ main = do
_ -> withJournalDo copts' (runBrickUi opts) _ -> withJournalDo copts' (runBrickUi opts)
runBrickUi :: UIOpts -> Journal -> IO () 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 d <- getCurrentDay
let let
@ -79,12 +79,13 @@ runBrickUi uopts@UIOpts{cliopts_=copts@CliOpts{inputopts_=_iopts,reportopts_=rop
-- can be displayed independently. -- can be displayed independently.
uopts' = uopts{ uopts' = uopts{
cliopts_=copts{ 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_, -- incorporate any depth: query args into depth_,
-- any date: query args into period_ -- any date: query args into period_
depth_ =queryDepth $ query_ ropts, depth_ =queryDepth $ rsQuery rspec,
period_=periodfromoptsandargs, 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 -- always disable boring account name eliding, unlike the CLI, for a more regular tree
no_elide_=True, no_elide_=True,
-- flip the default for items with zero amounts, show them by default -- 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 where
datespanfromargs = queryDateSpan (date2_ ropts) $ query_ ropts datespanfromargs = queryDateSpan (date2_ ropts) $ rsQuery rspec
periodfromoptsandargs = periodfromoptsandargs =
dateSpanAsPeriod $ spansIntersect [periodAsDateSpan $ period_ ropts, datespanfromargs] dateSpanAsPeriod $ spansIntersect [periodAsDateSpan $ period_ ropts, datespanfromargs]
filteredQuery q = simplifyQuery $ And [queryFromFlags ropts, filtered q] filteredQuery q = simplifyQuery $ And [queryFromFlags ropts, filtered q]

15
hledger-ui/Hledger/UI/RegisterScreen.hs
View File

@ -59,17 +59,15 @@ rsSetAccount a forceinclusive scr@RegisterScreen{} =
rsSetAccount _ _ scr = scr rsSetAccount _ _ scr = scr
rsInit :: Day -> Bool -> UIState -> UIState 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'}} ui{aScreen=s{rsList=newitems'}}
where where
-- gather arguments and queries -- gather arguments and queries
-- XXX temp -- XXX temp
inclusive = tree_ ropts || rsForceInclusive inclusive = tree_ ropts || rsForceInclusive
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) rsAccount thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) rsAccount
ropts' = ropts{ rspec' = rspec{rsOpts=ropts{depth_=Nothing}}
depth_=Nothing q = And [rsQuery rspec, excludeforecastq (forecast_ ropts)]
}
q = And [query_ ropts', excludeforecastq (forecast_ ropts)]
where where
-- Except in forecast mode, exclude future/forecast transactions. -- Except in forecast mode, exclude future/forecast transactions.
excludeforecastq (Just _) = Any excludeforecastq (Just _) = Any
@ -79,8 +77,8 @@ rsInit d reset ui@UIState{aopts=_uopts@UIOpts{cliopts_=CliOpts{reportopts_=ropts
,Not generatedTransactionTag ,Not generatedTransactionTag
] ]
(_label,items) = accountTransactionsReport ropts' j q thisacctq (_label,items) = accountTransactionsReport rspec' j q thisacctq
items' = (if empty_ ropts' then id else filter (not . mixedAmountLooksZero . fifth6)) $ -- without --empty, exclude no-change txns items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $ -- without --empty, exclude no-change txns
reverse -- most recent last reverse -- most recent last
items 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: rsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
rsDraw :: UIState -> [Widget Name] 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{..} ,aScreen=RegisterScreen{..}
,aMode=mode ,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 render $ defaultLayout toplabel bottomlabel $ renderList (rsDrawItem colwidths) True rsList
where where
ropts = rsOpts rspec
ishistorical = balancetype_ ropts == HistoricalBalance ishistorical = balancetype_ ropts == HistoricalBalance
-- inclusive = tree_ ropts || rsForceInclusive -- inclusive = tree_ ropts || rsForceInclusive

25
hledger-ui/Hledger/UI/TransactionScreen.hs
View File

@ -43,7 +43,7 @@ transactionScreen = TransactionScreen{
} }
tsInit :: Day -> Bool -> UIState -> UIState 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 ,ajournal=_j
,aScreen=TransactionScreen{} ,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: tsInit _ _ _ = error "init function called with wrong screen type, should not happen" -- PARTIAL:
tsDraw :: UIState -> [Widget Name] 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 ,ajournal=j
,aScreen=TransactionScreen{tsTransaction=(i,t) ,aScreen=TransactionScreen{tsTransaction=(i,t)
,tsTransactions=nts ,tsTransactions=nts
@ -77,14 +77,14 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}
styles = journalCommodityStyles j styles = journalCommodityStyles j
periodlast = periodlast =
fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- PARTIAL: shouldn't happen fromMaybe (error' "TransactionScreen: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
reportPeriodOrJournalLastDay ropts j reportPeriodOrJournalLastDay rspec j
mreportlast = reportPeriodLastDay ropts mreportlast = reportPeriodLastDay rspec
multiperiod = interval_ ropts /= NoInterval multiperiod = interval_ ropts /= NoInterval
render $ defaultLayout toplabel bottomlabel $ str $ render $ defaultLayout toplabel bottomlabel $ str $
showTransactionOneLineAmounts $ showTransactionOneLineAmounts $
(if valuationTypeIsCost ropts then transactionToCost (journalCommodityStyles j) else id) $ (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 -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
t t
where where
@ -132,7 +132,7 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
,tsTransactions=nts ,tsTransactions=nts
,tsAccount=acct ,tsAccount=acct
} }
,aopts=UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} ,aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}
,ajournal=j ,ajournal=j
,aMode=mode ,aMode=mode
} }
@ -172,7 +172,7 @@ tsHandle ui@UIState{aScreen=s@TransactionScreen{tsTransaction=(i,t)
Right j' -> do Right j' -> do
continue $ continue $
regenerateScreens j' d $ regenerateScreens j' d $
regenerateTransactions ropts j' s acct i $ -- added (inline) 201512 (why ?) regenerateTransactions rspec j' s acct i $ -- added (inline) 201512 (why ?)
clearCostValue $ clearCostValue $
ui ui
VtyEvent (EvKey (KChar 'I') []) -> continue $ uiCheckBalanceAssertions d (toggleIgnoreBalanceAssertions 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. -- 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 ? -- XXX Duplicates rsInit. Why do we have to do this as well as regenerateScreens ?
regenerateTransactions :: ReportOpts -> Journal -> Screen -> AccountName -> Integer -> UIState -> UIState regenerateTransactions :: ReportSpec -> Journal -> Screen -> AccountName -> Integer -> UIState -> UIState
regenerateTransactions ropts j s acct i ui = regenerateTransactions rspec j s acct i ui =
let let
ropts' = ropts {depth_=Nothing q = filterQuery (not . queryIsDepth) $ rsQuery rspec
,balancetype_=HistoricalBalance
}
q = filterQuery (not . queryIsDepth) $ query_ ropts'
thisacctq = Acct $ accountNameToAccountRegex acct -- includes subs 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 ts = map first6 items
numberedts = zip [1..] ts numberedts = zip [1..] ts
-- select the best current transaction from the new list -- select the best current transaction from the new list

124
hledger-ui/Hledger/UI/UIState.hs
View File

@ -21,18 +21,18 @@ import Hledger.UI.UIOptions
-- | Toggle between showing only unmarked items or all items. -- | Toggle between showing only unmarked items or all items.
toggleUnmarked :: UIState -> UIState toggleUnmarked :: UIState -> UIState
toggleUnmarked ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = toggleUnmarked ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Unmarked copts ropts}}} ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatusSomehow Unmarked copts rspec}}}
-- | Toggle between showing only pending items or all items. -- | Toggle between showing only pending items or all items.
togglePending :: UIState -> UIState togglePending :: UIState -> UIState
togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = togglePending ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Pending copts ropts}}} ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatusSomehow Pending copts rspec}}}
-- | Toggle between showing only cleared items or all items. -- | Toggle between showing only cleared items or all items.
toggleCleared :: UIState -> UIState toggleCleared :: UIState -> UIState
toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = toggleCleared ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=reportOptsToggleStatusSomehow Cleared copts ropts}}} ui{aopts=uopts{cliopts_=copts{reportspec_=reportSpecToggleStatusSomehow Cleared copts rspec}}}
-- TODO testing different status toggle styles -- TODO testing different status toggle styles
@ -52,9 +52,10 @@ uiShowStatus copts ss =
showstatus Pending = "pending" showstatus Pending = "pending"
showstatus Unmarked = "unmarked" showstatus Unmarked = "unmarked"
reportOptsToggleStatusSomehow :: Status -> CliOpts -> ReportOpts -> ReportOpts reportSpecToggleStatusSomehow :: Status -> CliOpts -> ReportSpec -> ReportSpec
reportOptsToggleStatusSomehow s copts ropts = reportSpecToggleStatusSomehow s copts rspec = rspec{rsOpts=ropts}
case maybeposintopt "status-toggles" $ rawopts_ copts of where
ropts = case maybeposintopt "status-toggles" $ rawopts_ copts of
Just 2 -> reportOptsToggleStatus2 s ropts Just 2 -> reportOptsToggleStatus2 s ropts
Just 3 -> reportOptsToggleStatus3 s ropts Just 3 -> reportOptsToggleStatus3 s ropts
-- Just 4 -> reportOptsToggleStatus4 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. -- | Toggle between showing all and showing only nonempty (more precisely, nonzero) items.
toggleEmpty :: UIState -> UIState toggleEmpty :: UIState -> UIState
toggleEmpty ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = toggleEmpty ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleEmpty ropts}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=toggleEmpty ropts}}}}
where where
toggleEmpty ropts = ropts{empty_=not $ empty_ ropts} toggleEmpty ropts = ropts{empty_=not $ empty_ ropts}
-- | Show primary amounts, not cost or value. -- | Show primary amounts, not cost or value.
clearCostValue :: UIState -> UIState clearCostValue :: UIState -> UIState
clearCostValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = clearCostValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{value_ = plog "clearing value mode" Nothing}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{value_ = plog "clearing value mode" Nothing}}}}}
-- | Toggle between showing the primary amounts or costs. -- | Toggle between showing the primary amounts or costs.
toggleCost :: UIState -> UIState toggleCost :: UIState -> UIState
toggleCost ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = toggleCost ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{value_ = valuationToggleCost $ value_ ropts}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{value_ = valuationToggleCost $ value_ ropts}}}}}
-- | Toggle between showing primary amounts or default valuation. -- | Toggle between showing primary amounts or default valuation.
toggleValue :: UIState -> UIState toggleValue :: UIState -> UIState
toggleValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = toggleValue ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{ ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{
value_ = plog "toggling value mode to" $ valuationToggleValue $ value_ ropts}}}} value_ = plog "toggling value mode to" $ valuationToggleValue $ value_ ropts}}}}}
-- | Basic toggling of -B/cost, for hledger-ui. -- | Basic toggling of -B/cost, for hledger-ui.
valuationToggleCost :: Maybe ValuationType -> Maybe ValuationType valuationToggleCost :: Maybe ValuationType -> Maybe ValuationType
@ -135,18 +136,18 @@ valuationToggleValue _ = Just $ AtDefault Nothing
-- | Set hierarchic account tree mode. -- | Set hierarchic account tree mode.
setTree :: UIState -> UIState setTree :: UIState -> UIState
setTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = setTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{accountlistmode_=ALTree}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{accountlistmode_=ALTree}}}}}
-- | Set flat account list mode. -- | Set flat account list mode.
setList :: UIState -> UIState setList :: UIState -> UIState
setList ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = setList ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{accountlistmode_=ALFlat}}}} 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. -- | Toggle between flat and tree mode. If current mode is unspecified/default, assume it's flat.
toggleTree :: UIState -> UIState toggleTree :: UIState -> UIState
toggleTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = toggleTree ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleTreeMode ropts}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=toggleTreeMode ropts}}}}
where where
toggleTreeMode ropts toggleTreeMode ropts
| accountlistmode_ ropts == ALTree = ropts{accountlistmode_=ALFlat} | 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. -- | Toggle between historical balances and period balances.
toggleHistorical :: UIState -> UIState toggleHistorical :: UIState -> UIState
toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{balancetype_=b}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{balancetype_=b}}}}}
where where
b | balancetype_ ropts == HistoricalBalance = PeriodChange b | balancetype_ ropts == HistoricalBalance = PeriodChange
| otherwise = HistoricalBalance | otherwise = HistoricalBalance
@ -174,10 +175,10 @@ toggleHistorical ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts
-- transactions with a query for their special tag. -- transactions with a query for their special tag.
-- --
toggleForecast :: Day -> UIState -> UIState 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'}} ui{aopts=uopts{cliopts_=copts'}}
where where
copts' = copts{reportopts_=ropts{forecast_=forecast'}} copts' = copts{reportspec_=rspec{rsOpts=ropts{forecast_=forecast'}}}
forecast' = forecast' =
case forecast_ ropts of case forecast_ ropts of
Just _ -> Nothing 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. -- | Toggle between showing all and showing only real (non-virtual) items.
toggleReal :: UIState -> UIState toggleReal :: UIState -> UIState
toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = toggleReal ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=toggleReal ropts}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=toggleReal ropts}}}}
where where
toggleReal ropts = ropts{real_=not $ real_ ropts} 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. -- | Step through larger report periods, up to all.
growReportPeriod :: Day -> UIState -> UIState growReportPeriod :: Day -> UIState -> UIState
growReportPeriod _d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = growReportPeriod _d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodGrow $ period_ ropts}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodGrow $ period_ ropts}}}}}
-- | Step through smaller report periods, down to a day. -- | Step through smaller report periods, down to a day.
shrinkReportPeriod :: Day -> UIState -> UIState shrinkReportPeriod :: Day -> UIState -> UIState
shrinkReportPeriod d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = shrinkReportPeriod d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodShrink d $ period_ 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, -- | Step the report start/end dates to the next period of same duration,
-- remaining inside the given enclosing span. -- remaining inside the given enclosing span.
nextReportPeriod :: DateSpan -> UIState -> UIState nextReportPeriod :: DateSpan -> UIState -> UIState
nextReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} = nextReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodNextIn enclosingspan 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, -- | Step the report start/end dates to the next period of same duration,
-- remaining inside the given enclosing span. -- remaining inside the given enclosing span.
previousReportPeriod :: DateSpan -> UIState -> UIState previousReportPeriod :: DateSpan -> UIState -> UIState
previousReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} = previousReportPeriod enclosingspan ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodPreviousIn enclosingspan 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 -- | If a standard report period is set, step it forward/backward if needed so that
-- it encloses the given date. -- it encloses the given date.
moveReportPeriodToDate :: Day -> UIState -> UIState moveReportPeriodToDate :: Day -> UIState -> UIState
moveReportPeriodToDate d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{period_=p}}}} = moveReportPeriodToDate d ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{period_=p}}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=periodMoveTo d p}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=periodMoveTo d p}}}}}
-- | Get the report period. -- | Get the report period.
reportPeriod :: UIState -> 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 p
-- | Set the report period. -- | Set the report period.
setReportPeriod :: Period -> UIState -> UIState setReportPeriod :: Period -> UIState -> UIState
setReportPeriod p ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = setReportPeriod p ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{period_=p}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{period_=p}}}}}
-- | Clear any report period limits. -- | Clear any report period limits.
resetReportPeriod :: UIState -> UIState resetReportPeriod :: UIState -> UIState
@ -239,21 +240,24 @@ resetReportPeriod = setReportPeriod PeriodAll
-- | Apply a new filter query. -- | Apply a new filter query.
setFilter :: String -> UIState -> UIState setFilter :: String -> UIState -> UIState
setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = setFilter s ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=newRopts}}} ui{aopts=uopts{cliopts_=copts{reportspec_=newrspec}}}
where 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. -- | Reset some filters & toggles.
resetFilter :: UIState -> UIState resetFilter :: UIState -> UIState
resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = resetFilter ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{ ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{
rsQuery=Any
,rsQueryOpts=[]
,rsOpts=ropts{
empty_=True empty_=True
,statuses_=[] ,statuses_=[]
,real_=False ,real_=False
,query_=Any ,querystring_=""
--,period_=PeriodAll --,period_=PeriodAll
}}}} }}}}}
-- | Reset all options state to exactly what it was at startup -- | Reset all options state to exactly what it was at startup
-- (preserving any command-line options/arguments). -- (preserving any command-line options/arguments).
@ -261,8 +265,8 @@ resetOpts :: UIState -> UIState
resetOpts ui@UIState{astartupopts} = ui{aopts=astartupopts} resetOpts ui@UIState{astartupopts} = ui{aopts=astartupopts}
resetDepth :: UIState -> UIState resetDepth :: UIState -> UIState
resetDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} = resetDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}} =
ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=Nothing}}}} ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=Nothing}}}}}
-- | Get the maximum account depth in the current journal. -- | Get the maximum account depth in the current journal.
maxDepth :: UIState -> Int 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, -- | Decrement the current depth limit towards 0. If there was no depth limit,
-- set it to one less than the maximum account depth. -- set it to one less than the maximum account depth.
decDepth :: UIState -> UIState decDepth :: UIState -> UIState
decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}} decDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}}}}}
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=dec depth_}}}} = ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=dec depth_}}}}}
where where
dec (Just d) = Just $ max 0 (d-1) dec (Just d) = Just $ max 0 (d-1)
dec Nothing = Just $ maxDepth ui - 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 -- | Increment the current depth limit. If this makes it equal to the
-- the maximum account depth, remove the depth limit. -- the maximum account depth, remove the depth limit.
incDepth :: UIState -> UIState incDepth :: UIState -> UIState
incDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts@ReportOpts{..}}}} incDepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}}}}}
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=inc depth_}}}} = ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=inc depth_}}}}}
where where
inc (Just d) | d < (maxDepth ui - 1) = Just $ d+1 inc (Just d) | d < (maxDepth ui - 1) = Just $ d+1
inc _ = Nothing 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 -- maximum account depth. If the specified depth is negative, reset the depth limit
-- to whatever was specified at uiartup. -- to whatever was specified at uiartup.
setDepth :: Maybe Int -> UIState -> UIState setDepth :: Maybe Int -> UIState -> UIState
setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_=ropts}}} setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{rsOpts=ropts}}}}
= ui{aopts=uopts{cliopts_=copts{reportopts_=ropts{depth_=mdepth'}}}} = ui{aopts=uopts{cliopts_=copts{reportspec_=rspec{rsOpts=ropts{depth_=mdepth'}}}}}
where where
mdepth' = case mdepth of mdepth' = case mdepth of
Nothing -> Nothing Nothing -> Nothing
@ -301,14 +305,14 @@ setDepth mdepth ui@UIState{aopts=uopts@UIOpts{cliopts_=copts@CliOpts{reportopts_
| otherwise -> mdepth | otherwise -> mdepth
getDepth :: UIState -> Maybe Int 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. -- | Open the minibuffer, setting its content to the current query with the cursor at the end.
showMinibuffer :: UIState -> UIState showMinibuffer :: UIState -> UIState
showMinibuffer ui = setMode (Minibuffer e) ui showMinibuffer ui = setMode (Minibuffer e) ui
where where
e = applyEdit gotoEOL $ editor MinibufferEditor (Just 1) oldq 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. -- | Close the minibuffer, discarding any edit in progress.
closeMinibuffer :: UIState -> UIState closeMinibuffer :: UIState -> UIState

14
hledger-web/Hledger/Web/Foundation.hs
View File

@ -123,14 +123,16 @@ instance Yesod App where
showSidebar <- shouldShowSidebar showSidebar <- shouldShowSidebar
hideEmptyAccts <- (== Just "1") . lookup "hideemptyaccts" . reqCookies <$> getRequest hideEmptyAccts <- (== Just "1") . lookup "hideemptyaccts" . reqCookies <$> getRequest
let ropts = reportopts_ (cliopts_ opts) let rspec = reportspec_ (cliopts_ opts)
ropts' = ropts ropts = rsOpts rspec
ropts' = (rsOpts rspec)
{accountlistmode_ = ALTree -- force tree mode for sidebar {accountlistmode_ = ALTree -- force tree mode for sidebar
,empty_ = not (empty_ ropts) -- show zero items by default ,empty_ = not (empty_ ropts) -- show zero items by default
} }
rspec' = rspec{rsQuery=m,rsOpts=ropts'}
accounts = accounts =
balanceReportAsHtml (JournalR, RegisterR) here hideEmptyAccts j q qopts $ 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 topShowmd = if showSidebar then "col-md-4" else "col-any-0" :: Text
topShowsm = if showSidebar then "col-sm-4" else "" :: Text topShowsm = if showSidebar then "col-sm-4" else "" :: Text
@ -206,12 +208,14 @@ getViewData = do
App {appOpts = opts, appJournal} <- getYesod App {appOpts = opts, appJournal} <- getYesod
today <- liftIO getCurrentDay today <- liftIO getCurrentDay
let copts = cliopts_ opts 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 -- try to read the latest journal content, keeping the old content
-- if there's an error -- if there's an error
(j, mjerr) <- getCurrentJournal (j, mjerr) <- getCurrentJournal
appJournal appJournal
copts {reportopts_ = (reportopts_ copts) {no_elide_ = True}} copts {reportspec_ = rspec}
today today
-- try to parse the query param, assuming no query if there's an error -- 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) j <- liftIO (readIORef jref)
(ej, changed) <- liftIO $ journalReloadIfChanged opts d j (ej, changed) <- liftIO $ journalReloadIfChanged opts d j
-- re-apply any initial filter specified at startup -- re-apply any initial filter specified at startup
let initq = query_ $ reportopts_ opts let initq = rsQuery $ reportspec_ opts
case (changed, filterJournalTransactions initq <$> ej) of case (changed, filterJournalTransactions initq <$> ej) of
(False, _) -> return (j, Nothing) (False, _) -> return (j, Nothing)
(True, Right j') -> do (True, Right j') -> do

2
hledger-web/Hledger/Web/Handler/JournalR.hs
View File

@ -27,7 +27,7 @@ getJournalR = do
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)" Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
title' = title <> if m /= Any then ", filtered" else "" title' = title <> if m /= Any then ", filtered" else ""
acctlink a = (RegisterR, [("q", replaceInacct q $ accountQuery a)]) 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 transactionFrag = transactionFragment j
defaultLayout $ do defaultLayout $ do

4
hledger-web/Hledger/Web/Handler/MiscR.hs
View File

@ -102,9 +102,9 @@ getAccounttransactionsR a = do
VD{caps, j} <- getViewData VD{caps, j} <- getViewData
when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability") when (CapView `notElem` caps) (permissionDenied "Missing the 'view' capability")
let let
ropts = defreportopts rspec = defreportspec
q = Any --filterQuery (not . queryIsDepth) $ queryFromOpts d ropts' q = Any --filterQuery (not . queryIsDepth) $ queryFromOpts d ropts'
thisacctq = Acct $ accountNameToAccountRegex a -- includes subs thisacctq = Acct $ accountNameToAccountRegex a -- includes subs
selectRep $ do selectRep $ do
provideJson $ accountTransactionsReport ropts j q thisacctq provideJson $ accountTransactionsReport rspec j q thisacctq

4
hledger-web/Hledger/Web/Handler/RegisterR.hs
View File

@ -33,7 +33,7 @@ getRegisterR = do
s2 = if m /= Any then ", filtered" else "" s2 = if m /= Any then ", filtered" else ""
header = a <> s1 <> s2 header = a <> s1 <> s2
let ropts = reportopts_ (cliopts_ opts) let rspec = reportspec_ (cliopts_ opts)
acctQuery = fromMaybe Any (inAccountQuery qopts) acctQuery = fromMaybe Any (inAccountQuery qopts)
acctlink acc = (RegisterR, [("q", replaceInacct q $ accountQuery acc)]) acctlink acc = (RegisterR, [("q", replaceInacct q $ accountQuery acc)])
otherTransAccounts = otherTransAccounts =
@ -44,7 +44,7 @@ getRegisterR = do
zip xs $ zip xs $
zip (map (T.unpack . accountSummarisedName . paccount) xs) $ zip (map (T.unpack . accountSummarisedName . paccount) xs) $
tail $ (", "<$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" balancelabel' = if isJust (inAccount qopts) then balancelabel else "Total"
transactionFrag = transactionFragment j transactionFrag = transactionFragment j
defaultLayout $ do defaultLayout $ do

2
hledger-web/Hledger/Web/Main.hs
View File

@ -58,7 +58,7 @@ runWith opts
-- | The web command. -- | The web command.
web :: WebOpts -> Journal -> IO () web :: WebOpts -> Journal -> IO ()
web opts j = do web opts j = do
let initq = query_ . reportopts_ $ cliopts_ opts let initq = rsQuery . reportspec_ $ cliopts_ opts
j' = filterJournalTransactions initq j j' = filterJournalTransactions initq j
h = host_ opts h = host_ opts
p = port_ opts p = port_ opts

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

@ -399,7 +399,7 @@ data CliOpts = CliOpts {
,command_ :: String ,command_ :: String
,file_ :: [FilePath] ,file_ :: [FilePath]
,inputopts_ :: InputOpts ,inputopts_ :: InputOpts
,reportopts_ :: ReportOpts ,reportspec_ :: ReportSpec
,output_file_ :: Maybe FilePath ,output_file_ :: Maybe FilePath
,output_format_ :: Maybe String ,output_format_ :: Maybe String
,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. ,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'.
@ -419,7 +419,7 @@ defcliopts = CliOpts
, command_ = "" , command_ = ""
, file_ = [] , file_ = []
, inputopts_ = def , inputopts_ = def
, reportopts_ = def , reportspec_ = def
, output_file_ = Nothing , output_file_ = Nothing
, output_format_ = Nothing , output_format_ = Nothing
, debug_ = 0 , debug_ = 0
@ -447,7 +447,7 @@ replaceNumericFlags = map replace
rawOptsToCliOpts :: RawOpts -> IO CliOpts rawOptsToCliOpts :: RawOpts -> IO CliOpts
rawOptsToCliOpts rawopts = do rawOptsToCliOpts rawopts = do
let iopts = rawOptsToInputOpts rawopts let iopts = rawOptsToInputOpts rawopts
ropts <- rawOptsToReportOpts rawopts rspec <- rawOptsToReportSpec rawopts
mcolumns <- readMay <$> getEnvSafe "COLUMNS" mcolumns <- readMay <$> getEnvSafe "COLUMNS"
mtermwidth <- mtermwidth <-
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
@ -462,7 +462,7 @@ rawOptsToCliOpts rawopts = do
,command_ = stringopt "command" rawopts ,command_ = stringopt "command" rawopts
,file_ = listofstringopt "file" rawopts ,file_ = listofstringopt "file" rawopts
,inputopts_ = iopts ,inputopts_ = iopts
,reportopts_ = ropts ,reportspec_ = rspec
,output_file_ = maybestringopt "output-file" rawopts ,output_file_ = maybestringopt "output-file" rawopts
,output_format_ = maybestringopt "output-format" rawopts ,output_format_ = maybestringopt "output-format" rawopts
,debug_ = posintopt "debug" rawopts ,debug_ = posintopt "debug" rawopts
@ -519,7 +519,7 @@ getHledgerCliOpts' mode' args' = do
putStrLn $ "running: " ++ progname' putStrLn $ "running: " ++ progname'
putStrLn $ "raw args: " ++ show args' putStrLn $ "raw args: " ++ show args'
putStrLn $ "processed opts:\n" ++ show opts 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 RawOpts -> IO CliOpts
getHledgerCliOpts mode' = do getHledgerCliOpts mode' = do

9
hledger/Hledger/Cli/Commands/Accounts.hs
View File

@ -48,18 +48,17 @@ accountsmode = hledgerCommandMode
-- | The accounts command. -- | The accounts command.
accounts :: CliOpts -> Journal -> IO () 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 -- 1. identify the accounts we'll show
let tree = tree_ ropts let tree = tree_ ropts
declared = boolopt "declared" rawopts declared = boolopt "declared" rawopts
used = boolopt "used" 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 -- 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 -- just the acct: part of the query will be reapplied later, after clipping
acctq = dbg1 "acctq" $ filterQuery queryIsAcct q acctq = dbg1 "acctq" $ filterQuery queryIsAcct query
depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth q depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth query
matcheddeclaredaccts = dbg1 "matcheddeclaredaccts" $ filter (matchesAccount nodepthq) $ map fst $ jdeclaredaccounts j matcheddeclaredaccts = dbg1 "matcheddeclaredaccts" $ filter (matchesAccount nodepthq) $ map fst $ jdeclaredaccounts j
matchedusedaccts = dbg5 "matchedusedaccts" $ map paccount $ journalPostings $ filterJournalPostings nodepthq j matchedusedaccts = dbg5 "matchedusedaccts" $ map paccount $ journalPostings $ filterJournalPostings nodepthq j
accts = dbg5 "accts to show" $ -- no need to nub/sort, accountTree will accts = dbg5 "accts to show" $ -- no need to nub/sort, accountTree will

6
hledger/Hledger/Cli/Commands/Activity.hs
View File

@ -30,10 +30,10 @@ barchar = '*'
-- | Print a bar chart of number of postings per report interval. -- | Print a bar chart of number of postings per report interval.
activity :: CliOpts -> Journal -> IO () 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 :: ReportSpec -> Journal -> String
showHistogram ReportOpts{query_=q,interval_=i,date2_=date2} j = showHistogram ReportSpec{rsQuery=q,rsOpts=ReportOpts{interval_=i,date2_=date2}} j =
concatMap (printDayWith countBar) spanps concatMap (printDayWith countBar) spanps
where where
interval | i == NoInterval = Days 1 interval | i == NoInterval = Days 1

7
hledger/Hledger/Cli/Commands/Add.hs
View File

@ -255,7 +255,7 @@ confirmedTransactionWizard prevInput es@EntryState{..} stack@(currentStage : _)
-- Identify the closest recent match for this description in past transactions. -- Identify the closest recent match for this description in past transactions.
similarTransaction :: EntryState -> Text -> Maybe Transaction similarTransaction :: EntryState -> Text -> Maybe Transaction
similarTransaction EntryState{..} desc = similarTransaction EntryState{..} desc =
let q = queryFromFlags $ reportopts_ esOpts let q = queryFromFlags . rsOpts $ reportspec_ esOpts
historymatches = transactionsSimilarTo esJournal q desc historymatches = transactionsSimilarTo esJournal q desc
bestmatch | null historymatches = Nothing bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head historymatches | otherwise = Just $ snd $ head historymatches
@ -462,10 +462,11 @@ ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse
registerFromString :: String -> IO String registerFromString :: String -> IO String
registerFromString s = do registerFromString s = do
j <- readJournal' $ T.pack s j <- readJournal' $ T.pack s
return . postingsReportAsText opts $ postingsReport ropts j return . postingsReportAsText opts $ postingsReport rspec j
where where
ropts = defreportopts{empty_=True} ropts = defreportopts{empty_=True}
opts = defcliopts{reportopts_=ropts} rspec = defreportspec{rsOpts=ropts}
opts = defcliopts{reportspec_=rspec}
capitalize :: String -> String capitalize :: String -> String
capitalize "" = "" capitalize "" = ""

21
hledger/Hledger/Cli/Commands/Aregister.hs
View File

@ -71,7 +71,7 @@ aregistermode = hledgerCommandMode
-- | Print an account register report for a specified account. -- | Print an account register report for a specified account.
aregister :: CliOpts -> Journal -> IO () aregister :: CliOpts -> Journal -> IO ()
aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do aregister opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
d <- getCurrentDay d <- getCurrentDay
-- the first argument specifies the account, any remaining arguments are a filter query -- the first argument specifies the account, any remaining arguments are a filter query
(apat,querystring) <- case listofstringopt "args" rawopts of (apat,querystring) <- case listofstringopt "args" rawopts of
@ -87,14 +87,17 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
-- gather report options -- gather report options
inclusive = True -- tree_ ropts inclusive = True -- tree_ ropts
thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct
ropts' = ropts{ rspec' = rspec{ rsQuery=simplifyQuery $ And [queryFromFlags ropts, argsquery]
query_=simplifyQuery $ And [queryFromFlags ropts, argsquery] , rsOpts=ropts'
-- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX }
,depth_=Nothing ropts' = ropts
{ -- remove a depth limit for reportq, as in RegisterScreen, I forget why XXX
depth_=Nothing
-- always show historical balance -- always show historical balance
, balancetype_= HistoricalBalance , balancetype_= HistoricalBalance
} }
reportq = And [query_ ropts', excludeforecastq (isJust $ forecast_ ropts)] ropts = rsOpts rspec
reportq = And [rsQuery rspec', excludeforecastq (isJust $ forecast_ ropts')]
where where
-- As in RegisterScreen, why ? XXX -- As in RegisterScreen, why ? XXX
-- Except in forecast mode, exclude future/forecast transactions. -- Except in forecast mode, exclude future/forecast transactions.
@ -106,7 +109,7 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
] ]
-- run the report -- run the report
-- TODO: need to also pass the queries so we can choose which date to render - move them into 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)) $ items' = (if empty_ ropts then id else filter (not . mixedAmountLooksZero . fifth6)) $
reverse items reverse items
-- select renderer -- select renderer
@ -140,7 +143,7 @@ accountTransactionsReportItemAsCsvRecord
-- | Render a register report as plain text suitable for console output. -- | Render a register report as plain text suitable for console output.
accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> String accountTransactionsReportAsText :: CliOpts -> Query -> Query -> AccountTransactionsReport -> String
accountTransactionsReportAsText 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 : = unlines $ title :
map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items map (accountTransactionsReportItemAsText copts reportq thisacctq amtwidth balwidth) items
where where
@ -173,7 +176,7 @@ accountTransactionsReportAsText
-- --
accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> String accountTransactionsReportItemAsText :: CliOpts -> Query -> Query -> Int -> Int -> AccountTransactionsReportItem -> String
accountTransactionsReportItemAsText accountTransactionsReportItemAsText
copts@CliOpts{reportopts_=ReportOpts{color_,no_elide_}} copts@CliOpts{reportspec_=ReportSpec{rsOpts=ReportOpts{color_,no_elide_}}}
reportq thisacctq preferredamtwidth preferredbalwidth reportq thisacctq preferredamtwidth preferredbalwidth
(t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance) (t@Transaction{tdescription}, _, _issplit, otheracctsstr, change, balance)
-- Transaction -- the transaction, unmodified -- Transaction -- the transaction, unmodified

17
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -304,14 +304,15 @@ balancemode = hledgerCommandMode
-- | The balance command, prints a balance report. -- | The balance command, prints a balance report.
balance :: CliOpts -> Journal -> IO () balance :: CliOpts -> Journal -> IO ()
balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do balance opts@CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
let budget = boolopt "budget" rawopts let ropts@ReportOpts{..} = rsOpts rspec
budget = boolopt "budget" rawopts
multiperiod = interval_ /= NoInterval multiperiod = interval_ /= NoInterval
fmt = outputFormatFromOpts opts fmt = outputFormatFromOpts opts
if budget then do -- single or multi period budget report if budget then do -- single or multi period budget report
let reportspan = reportSpan j ropts let reportspan = reportSpan j rspec
budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan j budgetreport = dbg4 "budgetreport" $ budgetReport rspec assrt reportspan j
where where
assrt = not $ ignore_assertions_ $ inputopts_ opts assrt = not $ ignore_assertions_ $ inputopts_ opts
render = case fmt of render = case fmt of
@ -322,7 +323,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
else else
if multiperiod then do -- multi period balance report if multiperiod then do -- multi period balance report
let report = multiBalanceReport ropts j let report = multiBalanceReport rspec j
render = case fmt of render = case fmt of
"txt" -> multiBalanceReportAsText ropts "txt" -> multiBalanceReportAsText ropts
"csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts "csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts
@ -332,7 +333,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do
writeOutput opts $ render report writeOutput opts $ render report
else do -- single period simple balance 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 render = case fmt of
"txt" -> balanceReportAsText "txt" -> balanceReportAsText
"csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r
@ -620,8 +621,8 @@ tests_Balance = tests "Balance" [
tests "balanceReportAsText" [ tests "balanceReportAsText" [
test "unicode in balance layout" $ do test "unicode in balance layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts let rspec = defreportspec
balanceReportAsText opts (balanceReport opts{today_=fromGregorian 2008 11 26} j) balanceReportAsText (rsOpts rspec) (balanceReport rspec{rsToday=fromGregorian 2008 11 26} j)
@?= @?=
unlines unlines
[" -100 актив:наличные" [" -100 актив:наличные"

6
hledger/Hledger/Cli/Commands/Checkdates.hs
View File

@ -21,9 +21,9 @@ checkdatesmode = hledgerCommandMode
([], Just $ argsFlag "[QUERY]") ([], Just $ argsFlag "[QUERY]")
checkdates :: CliOpts -> Journal -> IO () checkdates :: CliOpts -> Journal -> IO ()
checkdates CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
let ropts_ = ropts{accountlistmode_=ALFlat} let ropts = (rsOpts rspec){accountlistmode_=ALFlat}
let ts = filter (query_ ropts_ `matchesTransaction`) $ let ts = filter (rsQuery rspec `matchesTransaction`) $
jtxns $ journalSelectingAmountFromOpts ropts j jtxns $ journalSelectingAmountFromOpts ropts j
let strict = boolopt "strict" rawopts let strict = boolopt "strict" rawopts
let date = transactionDateFn ropts let date = transactionDateFn ropts

9
hledger/Hledger/Cli/Commands/Close.hs
View File

@ -47,7 +47,7 @@ closemode = hledgerCommandMode
-- debugger, beware: close is incredibly devious. simple rules combine to make a horrid maze. -- debugger, beware: close is incredibly devious. simple rules combine to make a horrid maze.
-- tests are in tests/close.test. -- tests are in tests/close.test.
close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do close CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
today <- getCurrentDay today <- getCurrentDay
let let
-- show opening entry, closing entry, or (default) both ? -- 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) (Nothing, Nothing) -> (T.pack defclosingacct, T.pack defopeningacct)
-- dates of the closing and opening transactions -- dates of the closing and opening transactions
ropts_ = ropts{balancetype_=HistoricalBalance, accountlistmode_=ALFlat} rspec_ = rspec{rsOpts=ropts}
q = query_ ropts_ ropts = (rsOpts rspec){balancetype_=HistoricalBalance, accountlistmode_=ALFlat}
q = rsQuery rspec
openingdate = fromMaybe today $ queryEndDate False q openingdate = fromMaybe today $ queryEndDate False q
closingdate = addDays (-1) openingdate closingdate = addDays (-1) openingdate
@ -86,7 +87,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
False -> normaliseMixedAmount . mixedAmountStripPrices False -> normaliseMixedAmount . mixedAmountStripPrices
-- the balances to close -- the balances to close
(acctbals,_) = balanceReport ropts_ j (acctbals,_) = balanceReport rspec_ j
totalamt = sum $ map (\(_,_,_,b) -> normalise b) acctbals totalamt = sum $ map (\(_,_,_,b) -> normalise b) acctbals
-- since balance assertion amounts are required to be exact, the -- since balance assertion amounts are required to be exact, the

6
hledger/Hledger/Cli/Commands/Codes.hs
View File

@ -32,8 +32,8 @@ codesmode = hledgerCommandMode
-- | The codes command. -- | The codes command.
codes :: CliOpts -> Journal -> IO () codes :: CliOpts -> Journal -> IO ()
codes CliOpts{reportopts_=ropts@ReportOpts{empty_}} j = do codes CliOpts{reportspec_=rspec} j = do
let ts = entriesReport ropts j let ts = entriesReport rspec j
codes = (if empty_ then id else filter (not . T.null)) $ codes = (if empty_ (rsOpts rspec) then id else filter (not . T.null)) $
map tcode ts map tcode ts
mapM_ T.putStrLn codes mapM_ T.putStrLn codes

4
hledger/Hledger/Cli/Commands/Descriptions.hs
View File

@ -31,8 +31,8 @@ descriptionsmode = hledgerCommandMode
-- | The descriptions command. -- | The descriptions command.
descriptions :: CliOpts -> Journal -> IO () descriptions :: CliOpts -> Journal -> IO ()
descriptions CliOpts{reportopts_=ropts} j = do descriptions CliOpts{reportspec_=rspec} j = do
let ts = entriesReport ropts j let ts = entriesReport rspec j
descriptions = nubSort $ map tdescription ts descriptions = nubSort $ map tdescription ts
mapM_ T.putStrLn descriptions mapM_ T.putStrLn descriptions

2
hledger/Hledger/Cli/Commands/Diff.hs
View File

@ -102,7 +102,7 @@ unmatchedtxns s pp m =
-- | The diff command. -- | The diff command.
diff :: CliOpts -> Journal -> IO () 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 j1 <- readJournalFile' f1
j2 <- readJournalFile' f2 j2 <- readJournalFile' f2

4
hledger/Hledger/Cli/Commands/Notes.hs
View File

@ -32,7 +32,7 @@ notesmode = hledgerCommandMode
-- | The notes command. -- | The notes command.
notes :: CliOpts -> Journal -> IO () notes :: CliOpts -> Journal -> IO ()
notes CliOpts{reportopts_=ropts} j = do notes CliOpts{reportspec_=rspec} j = do
let ts = entriesReport ropts j let ts = entriesReport rspec j
notes = nubSort $ map transactionNote ts notes = nubSort $ map transactionNote ts
mapM_ T.putStrLn notes mapM_ T.putStrLn notes

4
hledger/Hledger/Cli/Commands/Payees.hs
View File

@ -32,7 +32,7 @@ payeesmode = hledgerCommandMode
-- | The payees command. -- | The payees command.
payees :: CliOpts -> Journal -> IO () payees :: CliOpts -> Journal -> IO ()
payees CliOpts{reportopts_=ropts} j = do payees CliOpts{reportspec_=rspec} j = do
let ts = entriesReport ropts j let ts = entriesReport rspec j
payees = nubSort $ map transactionPayee ts payees = nubSort $ map transactionPayee ts
mapM_ T.putStrLn payees mapM_ T.putStrLn payees

2
hledger/Hledger/Cli/Commands/Prices.hs
View File

@ -27,7 +27,7 @@ pricesmode = hledgerCommandMode
prices opts j = do prices opts j = do
let let
styles = journalCommodityStyles j styles = journalCommodityStyles j
q = query_ $ reportopts_ opts q = rsQuery $ reportspec_ opts
ps = filter (matchesPosting q) $ allPostings j ps = filter (matchesPosting q) $ allPostings j
mprices = jpricedirectives j mprices = jpricedirectives j
cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps cprices = map (stylePriceDirectiveExceptPrecision styles) $ concatMap postingsPriceDirectivesFromCosts ps

10
hledger/Hledger/Cli/Commands/Print.hs
View File

@ -53,7 +53,7 @@ print' opts j = do
Just desc -> printMatch opts j $ T.pack desc Just desc -> printMatch opts j $ T.pack desc
printEntries :: CliOpts -> Journal -> IO () printEntries :: CliOpts -> Journal -> IO ()
printEntries opts@CliOpts{reportopts_=ropts} j = do printEntries opts@CliOpts{reportspec_=rspec} j = do
let fmt = outputFormatFromOpts opts let fmt = outputFormatFromOpts opts
render = case fmt of render = case fmt of
"txt" -> entriesReportAsText opts "txt" -> entriesReportAsText opts
@ -61,7 +61,7 @@ printEntries opts@CliOpts{reportopts_=ropts} j = do
"json" -> (++"\n") . TL.unpack . toJsonText "json" -> (++"\n") . TL.unpack . toJsonText
"sql" -> entriesReportAsSql "sql" -> entriesReportAsSql
_ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: _ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutput opts $ render $ entriesReport ropts j writeOutput opts $ render $ entriesReport rspec j
entriesReportAsText :: CliOpts -> EntriesReport -> String entriesReportAsText :: CliOpts -> EntriesReport -> String
entriesReportAsText opts = concatMap (showTransaction . whichtxn) 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 -- Because of #551, and because of print -V valuing only one
-- posting when there's an implicit txn price. -- posting when there's an implicit txn price.
-- So -B/-V/-X/--value implies -x. Is this ok ? -- 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. -- By default, use the original as-written-in-the-journal txn.
| otherwise = originalTransaction | otherwise = originalTransaction
@ -182,8 +182,8 @@ postingToCSV p =
-- | Print the transaction most closely and recently matching a description -- | Print the transaction most closely and recently matching a description
-- (and the query, if any). -- (and the query, if any).
printMatch :: CliOpts -> Journal -> Text -> IO () printMatch :: CliOpts -> Journal -> Text -> IO ()
printMatch CliOpts{reportopts_=ropts} j desc = do printMatch CliOpts{reportspec_=rspec} j desc = do
case similarTransaction' j (query_ ropts) desc of case similarTransaction' j (rsQuery rspec) desc of
Nothing -> putStrLn "no matches found." Nothing -> putStrLn "no matches found."
Just t -> putStr $ showTransaction t Just t -> putStr $ showTransaction t

10
hledger/Hledger/Cli/Commands/Register.hs
View File

@ -58,13 +58,13 @@ registermode = hledgerCommandMode
-- | Print a (posting) register report. -- | Print a (posting) register report.
register :: CliOpts -> Journal -> IO () register :: CliOpts -> Journal -> IO ()
register opts@CliOpts{reportopts_=ropts} j = do register opts@CliOpts{reportspec_=rspec} j = do
let fmt = outputFormatFromOpts opts let fmt = outputFormatFromOpts opts
render | fmt=="txt" = postingsReportAsText render | fmt=="txt" = postingsReportAsText
| fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv) | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)
| fmt=="json" = const ((++"\n") . TL.unpack . toJsonText) | fmt=="json" = const ((++"\n") . TL.unpack . toJsonText)
| otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: | otherwise = const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutput opts . render opts $ postingsReport ropts j writeOutput opts . render opts $ postingsReport rspec j
postingsReportAsCsv :: PostingsReport -> CSV postingsReportAsCsv :: PostingsReport -> CSV
postingsReportAsCsv (_,is) = postingsReportAsCsv (_,is) =
@ -178,7 +178,7 @@ postingsReportItemAsText opts preferredamtwidth preferredbalwidth (mdate, mendda
BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2) BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)
VirtualPosting -> (\s -> "("++s++")", acctwidth-2) VirtualPosting -> (\s -> "("++s++")", acctwidth-2)
_ -> (id,acctwidth) _ -> (id,acctwidth)
showamt = showMixedAmountWithoutPrice (color_ $ reportopts_ opts) showamt = showMixedAmountWithoutPrice (color_ . rsOpts $ reportspec_ opts)
amt = showamt $ pamount p amt = showamt $ pamount p
bal = showamt b bal = showamt b
-- alternate behaviour, show null amounts as 0 instead of blank -- alternate behaviour, show null amounts as 0 instead of blank
@ -198,8 +198,8 @@ tests_Register = tests "Register" [
tests "postingsReportAsText" [ tests "postingsReportAsText" [
test "unicode in register layout" $ do test "unicode in register layout" $ do
j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
let opts = defreportopts let rspec = defreportspec
(postingsReportAsText defcliopts $ postingsReport opts j) (postingsReportAsText defcliopts $ postingsReport rspec j)
@?= @?=
unlines unlines
["2009-01-01 медвежья шкура расходы:покупки 100 100" ["2009-01-01 медвежья шкура расходы:покупки 100 100"

4
hledger/Hledger/Cli/Commands/Registermatch.hs
View File

@ -22,10 +22,10 @@ registermatchmode = hledgerCommandMode
([], Just $ argsFlag "DESC") ([], Just $ argsFlag "DESC")
registermatch :: CliOpts -> Journal -> IO () 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 case listofstringopt "args" rawopts of
[desc] -> do [desc] -> do
let (_,pris) = postingsReport ropts j let (_,pris) = postingsReport rspec j
ps = [p | (_,_,_,p,_) <- pris] ps = [p | (_,_,_,p,_) <- pris]
case similarPosting ps desc of case similarPosting ps desc of
Nothing -> putStrLn "no matches found." Nothing -> putStrLn "no matches found."

4
hledger/Hledger/Cli/Commands/Rewrite.hs
View File

@ -36,13 +36,13 @@ rewritemode = hledgerCommandMode
-- TODO interpolating match groups in replacement -- TODO interpolating match groups in replacement
-- TODO allow using this on unbalanced entries, eg to rewrite while editing -- 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 -- rewrite matched transactions
d <- getCurrentDay d <- getCurrentDay
let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j let modifiers = transactionModifierFromOpts opts : jtxnmodifiers j
let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts} -- PARTIAL: let j' = j{jtxns=either error' id $ modifyTransactions d modifiers ts} -- PARTIAL:
-- run the print command, showing all transactions, or show diffs -- 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 -- | Build a 'TransactionModifier' from any query arguments and --add-posting flags
-- provided on the command line, or throw a parse error. -- provided on the command line, or throw a parse error.

3
hledger/Hledger/Cli/Commands/Roi.hs
View File

@ -52,9 +52,10 @@ data OneSpan = OneSpan
roi :: CliOpts -> Journal -> IO () roi :: CliOpts -> Journal -> IO ()
roi CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do roi CliOpts{rawopts_=rawopts, reportspec_=rspec} j = do
d <- getCurrentDay d <- getCurrentDay
let let
ropts = rsOpts rspec
showCashFlow = boolopt "cashflow" rawopts showCashFlow = boolopt "cashflow" rawopts
prettyTables = pretty_tables_ ropts prettyTables = pretty_tables_ ropts
makeQuery flag = do makeQuery flag = do

7
hledger/Hledger/Cli/Commands/Stats.hs
View File

@ -42,11 +42,12 @@ statsmode = hledgerCommandMode
-- like Register.summarisePostings -- like Register.summarisePostings
-- | Print various statistics for the journal. -- | Print various statistics for the journal.
stats :: CliOpts -> Journal -> IO () stats :: CliOpts -> Journal -> IO ()
stats opts@CliOpts{reportopts_=ReportOpts{query_=q, interval_=interval}} j = do stats opts@CliOpts{reportspec_=rspec} j = do
d <- getCurrentDay d <- getCurrentDay
let l = ledgerFromJournal q j let q = rsQuery rspec
l = ledgerFromJournal q j
reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q) reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q)
intervalspans = splitSpan interval reportspan intervalspans = splitSpan (interval_ $ rsOpts rspec) reportspan
showstats = showLedgerStats l d showstats = showLedgerStats l d
s = intercalate "\n" $ map showstats intervalspans s = intercalate "\n" $ map showstats intervalspans
writeOutput opts s writeOutput opts s

8
hledger/Hledger/Cli/Commands/Tags.hs
View File

@ -26,7 +26,7 @@ tagsmode = hledgerCommandMode
([], Just $ argsFlag "[TAGREGEX [QUERY...]]") ([], Just $ argsFlag "[TAGREGEX [QUERY...]]")
tags :: CliOpts -> Journal -> IO () tags :: CliOpts -> Journal -> IO ()
tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do tags CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
d <- getCurrentDay d <- getCurrentDay
let args = listofstringopt "args" rawopts let args = listofstringopt "args" rawopts
mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args 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 querystring = T.pack . unwords . map quoteIfNeeded $ drop 1 args
values = boolopt "values" rawopts values = boolopt "values" rawopts
parsed = boolopt "parsed" rawopts parsed = boolopt "parsed" rawopts
empty = empty_ ropts empty = empty_ $ rsOpts rspec
argsquery <- either usageError (return . fst) $ parseQuery d querystring argsquery <- either usageError (return . fst) $ parseQuery d querystring
let let
q = simplifyQuery $ And [queryFromFlags ropts, argsquery] q = simplifyQuery $ And [queryFromFlags $ rsOpts rspec, argsquery]
txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts ropts j txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts (rsOpts rspec) j
tagsorvalues = tagsorvalues =
(if parsed then id else nubSort) (if parsed then id else nubSort)
[ r [ r

7
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -88,8 +88,9 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
-- | Generate a runnable command from a compound balance command specification. -- | Generate a runnable command from a compound balance command specification.
compoundBalanceCommand :: CompoundBalanceCommandSpec -> (CliOpts -> Journal -> IO ()) 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 let
ropts@ReportOpts{..} = rsOpts rspec
-- use the default balance type for this report, unless the user overrides -- use the default balance type for this report, unless the user overrides
mBalanceTypeOverride = mBalanceTypeOverride =
choiceopt parse rawopts where choiceopt parse rawopts where
@ -120,7 +121,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
_ -> showDateSpan requestedspan _ -> showDateSpan requestedspan
where where
enddates = map (addDays (-1)) . mapMaybe spanEnd $ cbrDates cbr -- these spans will always have a definite end date 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 `spanDefaultsFrom` journalDateSpan date2_ j
-- when user overrides, add an indication to the report title -- when user overrides, add an indication to the report title
@ -142,7 +143,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
where multiperiod = interval_ /= NoInterval where multiperiod = interval_ /= NoInterval
-- make a CompoundBalanceReport. -- make a CompoundBalanceReport.
cbr' = compoundBalanceReport ropts' j cbcqueries cbr' = compoundBalanceReport rspec{rsOpts=ropts'} j cbcqueries
cbr = cbr'{cbrTitle=title} cbr = cbr'{cbrTitle=title}
-- render appropriately -- render appropriately

6
hledger/Hledger/Cli/Main.hs
View File

@ -151,9 +151,9 @@ main = do
dbgIO "isInternalCommand" isInternalCommand dbgIO "isInternalCommand" isInternalCommand
dbgIO "isExternalCommand" isExternalCommand dbgIO "isExternalCommand" isExternalCommand
dbgIO "isBadCommand" isBadCommand dbgIO "isBadCommand" isBadCommand
dbgIO "period from opts" (period_ $ reportopts_ opts) dbgIO "period from opts" (period_ . rsOpts $ reportspec_ opts)
dbgIO "interval from opts" (interval_ $ reportopts_ opts) dbgIO "interval from opts" (interval_ . rsOpts $ reportspec_ opts)
dbgIO "query from opts & args" (query_ $ reportopts_ opts) dbgIO "query from opts & args" (rsQuery $ reportspec_ opts)
let let
journallesserror = error "journal-less command tried to use the journal" journallesserror = error "journal-less command tried to use the journal"
runHledgerCommand runHledgerCommand

51
hledger/Hledger/Cli/Utils.hs
View File

@ -30,7 +30,6 @@ module Hledger.Cli.Utils
) )
where where
import Control.Exception as C import Control.Exception as C
import Control.Monad
import Data.List import Data.List
import Data.Maybe 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 -- it's stdin, or it doesn't exist and we are adding. We read it strictly
-- to let the add command work. -- to let the add command work.
journalpaths <- journalFilePathFromOpts opts journalpaths <- journalFilePathFromOpts opts
readJournalFiles (inputopts_ opts) journalpaths files <- readJournalFiles (inputopts_ opts) journalpaths
>>= mapM (journalTransform opts) let transformed = journalTransform opts <$> files
>>= either error' cmd -- PARTIAL: either error' cmd transformed -- PARTIAL:
-- | Apply some extra post-parse transformations to the journal, if -- | Apply some extra post-parse transformations to the journal, if
-- specified by options. These happen after journal validation, but -- specified by options. These happen after journal validation, but
@ -83,13 +82,13 @@ withJournalDo opts cmd = do
-- - pivoting account names (--pivot) -- - pivoting account names (--pivot)
-- - anonymising (--anonymise). -- - anonymising (--anonymise).
-- --
journalTransform :: CliOpts -> Journal -> IO Journal journalTransform :: CliOpts -> Journal -> Journal
journalTransform opts@CliOpts{reportopts_=_ropts} = journalTransform opts =
journalAddForecast opts anonymiseByOpts opts
-- - converting amounts to market value (--value) -- - converting amounts to market value (--value)
-- >=> journalApplyValue ropts -- . journalApplyValue ropts
>=> return . pivotByOpts opts . pivotByOpts opts
>=> return . anonymiseByOpts opts . journalAddForecast opts
-- | Apply the pivot transformation on a journal, if option is present. -- | Apply the pivot transformation on a journal, if option is present.
pivotByOpts :: CliOpts -> Journal -> Journal pivotByOpts :: CliOpts -> Journal -> Journal
@ -115,20 +114,22 @@ anonymiseByOpts opts =
-- The start & end date for generated periodic transactions are determined in -- The start & end date for generated periodic transactions are determined in
-- a somewhat complicated way; see the hledger manual -> Periodic transactions. -- a somewhat complicated way; see the hledger manual -> Periodic transactions.
-- --
journalAddForecast :: CliOpts -> Journal -> IO Journal journalAddForecast :: CliOpts -> Journal -> Journal
journalAddForecast CliOpts{inputopts_=iopts, reportopts_=ropts} j = journalAddForecast CliOpts{inputopts_=iopts, reportspec_=rspec} j =
case forecast_ ropts of case forecast_ ropts of
Nothing -> return j Nothing -> j
Just _ -> do Just _ -> either (error') id . journalApplyCommodityStyles $ -- PARTIAL:
today <- getCurrentDay 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)." -- "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 mjournalend = dbg2 "journalEndDate" $ journalEndDate False j -- ignore secondary dates
forecastbeginDefault = dbg2 "forecastbeginDefault" $ fromMaybe today mjournalend forecastbeginDefault = dbg2 "forecastbeginDefault" $ fromMaybe today mjournalend
-- "They end on or before the specified report end date, or 180 days from today if unspecified." -- "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 forecastendDefault = dbg2 "forecastendDefault" $ fromMaybe (addDays 180 today) mspecifiedend
forecastspan = dbg2 "forecastspan" $ 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: (if auto_ iopts then either error' id . modifyTransactions today (jtxnmodifiers j) else id) -- PARTIAL:
forecasttxns forecasttxns
j' = either error' id $ journalBalanceTransactions (not . ignore_assertions_ $ iopts) -- PARTIAL: journalBalanceTransactions' iopts j =
j{jtxns=concat [jtxns j, forecasttxns']} let assrt = not . ignore_assertions_ $ iopts
in
-- Display styles were applied early.. apply them again to ensure the forecasted either error' id $ journalBalanceTransactions assrt j -- PARTIAL:
-- transactions are also styled. XXX Possible optimisation: style just the forecasttxns.
j'' = either error' id $ journalApplyCommodityStyles j' -- PARTIAL:
return j''
-- | Write some output to stdout or to a file selected by --output-file. -- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten. -- If the file exists it will be overwritten.
@ -172,8 +169,8 @@ writeOutput opts s = do
journalReload :: CliOpts -> IO (Either String Journal) journalReload :: CliOpts -> IO (Either String Journal)
journalReload opts = do journalReload opts = do
journalpaths <- journalFilePathFromOpts opts journalpaths <- journalFilePathFromOpts opts
readJournalFiles (inputopts_ opts) journalpaths files <- readJournalFiles (inputopts_ opts) journalpaths
>>= mapM (journalTransform opts) return $ journalTransform opts <$> files
-- | Re-read the option-specified journal file(s), but only if any of -- | 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, -- them has changed since last read. (If the file is standard input,