simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-12-26 20:02:27 +03:00
Code Issues 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"
balancelabel = "Historical Total"
accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport
accountTransactionsReport ropts j reportq thisacctq = (label, items)
accountTransactionsReport :: ReportSpec -> Journal -> Query -> Query -> AccountTransactionsReport
accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = (label, items)
where
-- a depth limit should not affect the account transactions report
-- seems unnecessary for some reason XXX
@ -115,11 +115,11 @@ accountTransactionsReport ropts j reportq thisacctq = (label, items)
styles = journalCommodityStyles j
periodlast =
fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
reportPeriodOrJournalLastDay ropts j
mreportlast = reportPeriodLastDay ropts
reportPeriodOrJournalLastDay rspec j
mreportlast = reportPeriodLastDay rspec
multiperiod = interval_ ropts /= NoInterval
tval = case value_ ropts of
Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast (today_ ropts) multiperiod t v
Just v -> \t -> transactionApplyValuation prices styles periodlast mreportlast (rsToday rspec) multiperiod t v
Nothing -> id
ts4 =
ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $

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

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

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

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

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

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

61
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
-- information to make a postings report. Used by eg hledger's register command.
postingsReport :: ReportOpts -> Journal -> PostingsReport
postingsReport ropts@ReportOpts{..} j =
postingsReport :: ReportSpec -> Journal -> PostingsReport
postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j =
(totallabel, items)
where
reportspan = adjustReportDates ropts j
reportspan = adjustReportDates rspec j
whichdate = whichDateFromOpts ropts
mdepth = queryDepth query_
mdepth = queryDepth $ rsQuery rspec
styles = journalCommodityStyles j
priceoracle = journalPriceOracle infer_value_ j
multiperiod = interval_ /= NoInterval
-- postings to be included in the report, and similarly-matched postings before the report start date
(precedingps, reportps) = matchedPostingsBeforeAndDuring ropts j reportspan
(precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan
-- Postings, or summary postings with their subperiod's end date, to be displayed.
displayps :: [(Posting, Maybe Day)]
@ -89,12 +89,12 @@ postingsReport ropts@ReportOpts{..} j =
where
showempty = empty_ || average_
-- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast today_ multiperiod p) value_
pvalue p periodlast = maybe p (postingApplyValuation priceoracle styles periodlast mreportlast (rsToday rspec) multiperiod p) value_
where
mreportlast = reportPeriodLastDay ropts
mreportlast = reportPeriodLastDay rspec
reportorjournallast =
fromMaybe (error' "postingsReport: expected a non-empty journal") $ -- PARTIAL: shouldn't happen
reportPeriodOrJournalLastDay ropts j
reportPeriodOrJournalLastDay rspec j
-- Posting report items ready for display.
items =
@ -112,13 +112,13 @@ postingsReport ropts@ReportOpts{..} j =
precedingsum = sumPostings precedingps
precedingavg | null precedingps = 0
| otherwise = divideMixedAmount (fromIntegral $ length precedingps) precedingsum
bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing today_ multiperiod) value_
bvalue = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart Nothing (rsToday rspec) multiperiod) value_
-- XXX constrain valuation type to AtDate daybeforereportstart here ?
where
daybeforereportstart =
maybe (error' "postingsReport: expected a non-empty journal") -- PARTIAL: shouldn't happen
(addDays (-1))
$ reportPeriodOrJournalStart ropts j
$ reportPeriodOrJournalStart rspec j
runningcalc = registerRunningCalculationFn ropts
startnum = if historical then length precedingps + 1 else 1
@ -139,17 +139,17 @@ totallabel = "Total"
-- 1. If the start date is unspecified, use the earliest date in the journal (if any)
-- 2. If the end date is unspecified, use the latest date in the journal (if any)
-- 3. If a report interval is specified, enlarge the dates to enclose whole intervals
adjustReportDates :: ReportOpts -> Journal -> DateSpan
adjustReportDates opts j = reportspan
adjustReportDates :: ReportSpec -> Journal -> DateSpan
adjustReportDates rspec@ReportSpec{rsOpts=ropts} j = reportspan
where
-- see also multiBalanceReport
requestedspan = dbg3 "requestedspan" $ queryDateSpan' $ query_ opts -- span specified by -b/-e/-p options and query args
requestedspan = dbg3 "requestedspan" $ queryDateSpan' $ rsQuery rspec -- span specified by -b/-e/-p options and query args
journalspan = dbg3 "journalspan" $ dates `spanUnion` date2s -- earliest and latest dates (or date2s) in the journal
where
dates = journalDateSpan False j
date2s = journalDateSpan True j
requestedspanclosed = dbg3 "requestedspanclosed" $ requestedspan `spanDefaultsFrom` journalspan -- if open-ended, close it using the journal's dates (if any)
intervalspans = dbg3 "intervalspans" $ splitSpan (interval_ opts) requestedspanclosed -- get the whole intervals enclosing that
intervalspans = dbg3 "intervalspans" $ splitSpan (interval_ ropts) requestedspanclosed -- get the whole intervals enclosing that
mreportstart = dbg3 "reportstart" $ maybe Nothing spanStart $ headMay intervalspans -- start of the first interval, or open ended
mreportend = dbg3 "reportend" $ maybe Nothing spanEnd $ lastMay intervalspans -- end of the last interval, or open ended
reportspan = dbg3 "reportspan" $ DateSpan mreportstart mreportend -- the requested span enlarged to whole intervals if possible
@ -158,30 +158,29 @@ adjustReportDates opts j = reportspan
-- and also any similarly-matched postings before that date span.
-- Date restrictions and depth restrictions in the query are ignored.
-- A helper for the postings report.
matchedPostingsBeforeAndDuring :: ReportOpts -> Journal -> DateSpan -> ([Posting],[Posting])
matchedPostingsBeforeAndDuring opts j (DateSpan mstart mend) =
matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting])
matchedPostingsBeforeAndDuring ReportSpec{rsOpts=ropts,rsQuery=q} j (DateSpan mstart mend) =
dbg5 "beforeps, duringps" $ span (beforestartq `matchesPosting`) beforeandduringps
where
q = query_ opts
beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing mstart
beforeandduringps =
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2
dbg5 "ps4" $ (if invert_ opts then map negatePostingAmount else id) $ -- with --invert, invert amounts
dbg5 "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 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit
dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2
dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts
dbg5 "ps3" $ map (filterPostingAmount symq) $ -- remove amount parts which the query's cur: terms would exclude
dbg5 "ps2" $ (if related_ ropts then concatMap relatedPostings else id) $ -- with -r, replace each with its sibling postings
dbg5 "ps1" $ filter (beforeandduringq `matchesPosting`) $ -- filter postings by the query, with no start date or depth limit
journalPostings $
journalSelectingAmountFromOpts opts j -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ?
journalSelectingAmountFromOpts ropts j -- maybe convert to cost early, will be seen by amt:. XXX what about converting to value ?
where
beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq]
where
depthless = filterQuery (not . queryIsDepth)
dateless = filterQuery (not . queryIsDateOrDate2)
beforeendq = dateqtype $ DateSpan Nothing mend
sortdate = if date2_ opts then postingDate2 else postingDate
symq = dbg4 "symq" . filterQuery queryIsSym $ query_ opts
sortdate = if date2_ ropts then postingDate2 else postingDate
symq = dbg4 "symq" $ filterQuery queryIsSym q
dateqtype
| queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2
| queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) = Date2
| otherwise = Date
where
dateq = dbg4 "dateq" $ filterQuery queryIsDateOrDate2 $ dbg4 "q" q -- XXX confused by multiple date:/date2: ?
@ -270,7 +269,7 @@ negatePostingAmount p = p { pamount = negate $ pamount p }
tests_PostingsReport = tests "PostingsReport" [
test "postingsReport" $ do
let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts{query_=query} journal) @?= n
let (query, journal) `gives` n = (length $ snd $ postingsReport defreportspec{rsQuery=query} journal) @?= n
-- with the query specified explicitly
(Any, nulljournal) `gives` 0
(Any, samplejournal) `gives` 13
@ -279,10 +278,10 @@ tests_PostingsReport = tests "PostingsReport" [
(And [Depth 1, StatusQ Cleared, Acct (toRegex' "expenses")], samplejournal) `gives` 2
(And [And [Depth 1, StatusQ Cleared], Acct (toRegex' "expenses")], samplejournal) `gives` 2
-- with query and/or command-line options
(length $ snd $ postingsReport defreportopts samplejournal) @?= 13
(length $ snd $ postingsReport defreportopts{interval_=Months 1} samplejournal) @?= 11
(length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} samplejournal) @?= 20
(length $ snd $ postingsReport defreportopts{query_=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
(length $ snd $ postingsReport defreportspec samplejournal) @?= 13
(length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1}} samplejournal) @?= 11
(length $ snd $ postingsReport defreportspec{rsOpts=defreportopts{interval_=Months 1, empty_=True}} samplejournal) @?= 20
(length $ snd $ postingsReport defreportspec{rsQuery=Acct $ toRegex' "assets:bank:checking"} samplejournal) @?= 5
-- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
-- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking $1,$1)

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

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

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

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

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

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

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

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

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

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

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

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

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

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)"
title' = title <> if m /= Any then ", filtered" else ""
acctlink a = (RegisterR, [("q", replaceInacct q $ accountQuery a)])
(_, items) = transactionsReport (reportopts_ $ cliopts_ opts) j m
(_, items) = transactionsReport (rsOpts . reportspec_ $ cliopts_ opts) j m
transactionFrag = transactionFragment j
defaultLayout $ do

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

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

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

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

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

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

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

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

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

@ -48,18 +48,17 @@ accountsmode = hledgerCommandMode
-- | The accounts command.
accounts :: CliOpts -> Journal -> IO ()
accounts CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do
accounts CliOpts{rawopts_=rawopts, reportspec_=ReportSpec{rsQuery=query,rsOpts=ropts}} j = do
-- 1. identify the accounts we'll show
let tree = tree_ ropts
declared = boolopt "declared" rawopts
used = boolopt "used" rawopts
q = query_ ropts
-- a depth limit will clip and exclude account names later, but we don't want to exclude accounts at this stage
nodepthq = dbg1 "nodepthq" $ filterQuery (not . queryIsDepth) q
nodepthq = dbg1 "nodepthq" $ filterQuery (not . queryIsDepth) query
-- just the acct: part of the query will be reapplied later, after clipping
acctq = dbg1 "acctq" $ filterQuery queryIsAcct q
depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth q
acctq = dbg1 "acctq" $ filterQuery queryIsAcct query
depth = dbg1 "depth" $ queryDepth $ filterQuery queryIsDepth query
matcheddeclaredaccts = dbg1 "matcheddeclaredaccts" $ filter (matchesAccount nodepthq) $ map fst $ jdeclaredaccounts j
matchedusedaccts = dbg5 "matchedusedaccts" $ map paccount $ journalPostings $ filterJournalPostings nodepthq j
accts = dbg5 "accts to show" $ -- no need to nub/sort, accountTree will

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.
activity :: CliOpts -> Journal -> IO ()
activity CliOpts{reportopts_=ropts} j = putStr $ showHistogram ropts j
activity CliOpts{reportspec_=rspec} j = putStr $ showHistogram rspec j
showHistogram :: ReportOpts -> Journal -> String
showHistogram ReportOpts{query_=q,interval_=i,date2_=date2} j =
showHistogram :: ReportSpec -> Journal -> String
showHistogram ReportSpec{rsQuery=q,rsOpts=ReportOpts{interval_=i,date2_=date2}} j =
concatMap (printDayWith countBar) spanps
where
interval | i == NoInterval = Days 1

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.
similarTransaction :: EntryState -> Text -> Maybe Transaction
similarTransaction EntryState{..} desc =
let q = queryFromFlags $ reportopts_ esOpts
let q = queryFromFlags . rsOpts $ reportspec_ esOpts
historymatches = transactionsSimilarTo esJournal q desc
bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head historymatches
@ -462,10 +462,11 @@ ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse
registerFromString :: String -> IO String
registerFromString s = do
j <- readJournal' $ T.pack s
return . postingsReportAsText opts $ postingsReport ropts j
return . postingsReportAsText opts $ postingsReport rspec j
where
ropts = defreportopts{empty_=True}
opts = defcliopts{reportopts_=ropts}
rspec = defreportspec{rsOpts=ropts}
opts = defcliopts{reportspec_=rspec}
capitalize :: String -> String
capitalize "" = ""

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

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

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

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

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

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

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

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

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

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

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

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

@ -102,7 +102,7 @@ unmatchedtxns s pp m =
-- | The diff command.
diff :: CliOpts -> Journal -> IO ()
diff CliOpts{file_=[f1, f2], reportopts_=ReportOpts{query_=Acct acctRe}} _ = do
diff CliOpts{file_=[f1, f2], reportspec_=ReportSpec{rsQuery=Acct acctRe}} _ = do
j1 <- readJournalFile' f1
j2 <- readJournalFile' f2

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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