simonmichael/hledger
1
1
Fork 0
mirror of https://github.com/simonmichael/hledger.git synced 2024-09-19 18:29:36 +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
parent 2ea1cf102c
commit d0d39e6153
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,