From 260283e2f123f687be8eb3a0fa710f99550517a8 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Wed, 16 Sep 2020 11:45:52 +1000 Subject: [PATCH] lib,cli,ui,web: Introduce ReportSpec, which holds ReportOpts, the day of the report, and the parsed Query. --- .../Reports/AccountTransactionsReport.hs | 10 +- hledger-lib/Hledger/Reports/BalanceReport.hs | 34 ++-- hledger-lib/Hledger/Reports/BudgetReport.hs | 10 +- hledger-lib/Hledger/Reports/EntriesReport.hs | 16 +- .../Hledger/Reports/MultiBalanceReport.hs | 145 +++++++++--------- hledger-lib/Hledger/Reports/PostingsReport.hs | 61 ++++---- hledger-lib/Hledger/Reports/ReportOptions.hs | 99 +++++++----- hledger-ui/Hledger/UI/AccountsScreen.hs | 13 +- hledger-ui/Hledger/UI/Main.hs | 34 ++-- hledger-ui/Hledger/UI/RegisterScreen.hs | 15 +- hledger-ui/Hledger/UI/TransactionScreen.hs | 25 ++- hledger-ui/Hledger/UI/UIState.hs | 142 ++++++++--------- hledger-web/Hledger/Web/Foundation.hs | 14 +- hledger-web/Hledger/Web/Handler/JournalR.hs | 2 +- hledger-web/Hledger/Web/Handler/MiscR.hs | 4 +- hledger-web/Hledger/Web/Handler/RegisterR.hs | 4 +- hledger-web/Hledger/Web/Main.hs | 2 +- hledger/Hledger/Cli/CliOptions.hs | 10 +- hledger/Hledger/Cli/Commands/Accounts.hs | 9 +- hledger/Hledger/Cli/Commands/Activity.hs | 6 +- hledger/Hledger/Cli/Commands/Add.hs | 7 +- hledger/Hledger/Cli/Commands/Aregister.hs | 25 +-- hledger/Hledger/Cli/Commands/Balance.hs | 17 +- hledger/Hledger/Cli/Commands/Checkdates.hs | 6 +- hledger/Hledger/Cli/Commands/Close.hs | 9 +- hledger/Hledger/Cli/Commands/Codes.hs | 6 +- hledger/Hledger/Cli/Commands/Descriptions.hs | 4 +- hledger/Hledger/Cli/Commands/Diff.hs | 2 +- hledger/Hledger/Cli/Commands/Notes.hs | 4 +- hledger/Hledger/Cli/Commands/Payees.hs | 4 +- hledger/Hledger/Cli/Commands/Prices.hs | 2 +- hledger/Hledger/Cli/Commands/Print.hs | 10 +- hledger/Hledger/Cli/Commands/Register.hs | 10 +- hledger/Hledger/Cli/Commands/Registermatch.hs | 4 +- hledger/Hledger/Cli/Commands/Rewrite.hs | 4 +- hledger/Hledger/Cli/Commands/Roi.hs | 3 +- hledger/Hledger/Cli/Commands/Stats.hs | 7 +- hledger/Hledger/Cli/Commands/Tags.hs | 8 +- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 7 +- hledger/Hledger/Cli/Main.hs | 6 +- hledger/Hledger/Cli/Utils.hs | 91 ++++++----- 41 files changed, 462 insertions(+), 429 deletions(-) diff --git a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index c98338b14..ba7506fcc 100644 --- a/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -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) $ diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index 7205aa0bd..78f67881a 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -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) diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index c7d269739..4523ea9e2 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -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; diff --git a/hledger-lib/Hledger/Reports/EntriesReport.hs b/hledger-lib/Hledger/Reports/EntriesReport.hs index 753d8a824..3357bee9a 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -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 ] ] diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index 052f7d08c..87b73bf1e 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -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)}]) diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index 37ce3595d..0350d9aa6 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -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) diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index d4f635c6c..acf8f7ab0 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/AccountsScreen.hs b/hledger-ui/Hledger/UI/AccountsScreen.hs index 064832f1d..391ebf953 100644 --- a/hledger-ui/Hledger/UI/AccountsScreen.hs +++ b/hledger-ui/Hledger/UI/AccountsScreen.hs @@ -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 = diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index 30e7e4cff..80394007d 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -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] diff --git a/hledger-ui/Hledger/UI/RegisterScreen.hs b/hledger-ui/Hledger/UI/RegisterScreen.hs index 5126d755d..0130e08c1 100644 --- a/hledger-ui/Hledger/UI/RegisterScreen.hs +++ b/hledger-ui/Hledger/UI/RegisterScreen.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/TransactionScreen.hs b/hledger-ui/Hledger/UI/TransactionScreen.hs index 189d35f41..94215a810 100644 --- a/hledger-ui/Hledger/UI/TransactionScreen.hs +++ b/hledger-ui/Hledger/UI/TransactionScreen.hs @@ -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 diff --git a/hledger-ui/Hledger/UI/UIState.hs b/hledger-ui/Hledger/UI/UIState.hs index a0edaa444..557163de3 100644 --- a/hledger-ui/Hledger/UI/UIState.hs +++ b/hledger-ui/Hledger/UI/UIState.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Foundation.hs b/hledger-web/Hledger/Web/Foundation.hs index b7650bcfd..dfc2c771c 100644 --- a/hledger-web/Hledger/Web/Foundation.hs +++ b/hledger-web/Hledger/Web/Foundation.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Handler/JournalR.hs b/hledger-web/Hledger/Web/Handler/JournalR.hs index ce62aa568..b0713889f 100644 --- a/hledger-web/Hledger/Web/Handler/JournalR.hs +++ b/hledger-web/Hledger/Web/Handler/JournalR.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Handler/MiscR.hs b/hledger-web/Hledger/Web/Handler/MiscR.hs index 57ac44fd8..1cd969acb 100644 --- a/hledger-web/Hledger/Web/Handler/MiscR.hs +++ b/hledger-web/Hledger/Web/Handler/MiscR.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Handler/RegisterR.hs b/hledger-web/Hledger/Web/Handler/RegisterR.hs index d4cca4028..c0a7e9d3d 100644 --- a/hledger-web/Hledger/Web/Handler/RegisterR.hs +++ b/hledger-web/Hledger/Web/Handler/RegisterR.hs @@ -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 diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 6187c11c8..771ad9a53 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -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 diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index a9809f61d..33c45cd82 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Accounts.hs b/hledger/Hledger/Cli/Commands/Accounts.hs index 1c77e4efa..5749241e3 100644 --- a/hledger/Hledger/Cli/Commands/Accounts.hs +++ b/hledger/Hledger/Cli/Commands/Accounts.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Activity.hs b/hledger/Hledger/Cli/Commands/Activity.hs index 1f39ae286..d53dce52a 100644 --- a/hledger/Hledger/Cli/Commands/Activity.hs +++ b/hledger/Hledger/Cli/Commands/Activity.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index bc54c8bf3..36c8e0183 100644 --- a/hledger/Hledger/Cli/Commands/Add.hs +++ b/hledger/Hledger/Cli/Commands/Add.hs @@ -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 "" = "" diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 86bb6eefb..f9830c7bb 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 9fb83d1b3..f03f04e20 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -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 актив:наличные" diff --git a/hledger/Hledger/Cli/Commands/Checkdates.hs b/hledger/Hledger/Cli/Commands/Checkdates.hs index 396b38fba..19ff82128 100755 --- a/hledger/Hledger/Cli/Commands/Checkdates.hs +++ b/hledger/Hledger/Cli/Commands/Checkdates.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Close.hs b/hledger/Hledger/Cli/Commands/Close.hs index da5b19b8e..82edfe84b 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Codes.hs b/hledger/Hledger/Cli/Commands/Codes.hs index 5c085f666..8ad109f1e 100644 --- a/hledger/Hledger/Cli/Commands/Codes.hs +++ b/hledger/Hledger/Cli/Commands/Codes.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Descriptions.hs b/hledger/Hledger/Cli/Commands/Descriptions.hs index 9e84db5b0..448f3d246 100644 --- a/hledger/Hledger/Cli/Commands/Descriptions.hs +++ b/hledger/Hledger/Cli/Commands/Descriptions.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Diff.hs b/hledger/Hledger/Cli/Commands/Diff.hs index 78a63c40d..cd82e02ee 100644 --- a/hledger/Hledger/Cli/Commands/Diff.hs +++ b/hledger/Hledger/Cli/Commands/Diff.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Notes.hs b/hledger/Hledger/Cli/Commands/Notes.hs index 2214d1c2e..26493cbdc 100644 --- a/hledger/Hledger/Cli/Commands/Notes.hs +++ b/hledger/Hledger/Cli/Commands/Notes.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Payees.hs b/hledger/Hledger/Cli/Commands/Payees.hs index fbc1a751c..7b0108c13 100644 --- a/hledger/Hledger/Cli/Commands/Payees.hs +++ b/hledger/Hledger/Cli/Commands/Payees.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Prices.hs b/hledger/Hledger/Cli/Commands/Prices.hs index 746420a83..d3428bcb4 100755 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index da9ffbbd5..961c1a16f 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index a74b89569..7b2295e2b 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -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" diff --git a/hledger/Hledger/Cli/Commands/Registermatch.hs b/hledger/Hledger/Cli/Commands/Registermatch.hs index f551d62f5..b4490be05 100755 --- a/hledger/Hledger/Cli/Commands/Registermatch.hs +++ b/hledger/Hledger/Cli/Commands/Registermatch.hs @@ -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." diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index c83e25a48..159d41440 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -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. diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index 3ede7b97b..32a423ea8 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Stats.hs b/hledger/Hledger/Cli/Commands/Stats.hs index daf62b545..200da0d24 100644 --- a/hledger/Hledger/Cli/Commands/Stats.hs +++ b/hledger/Hledger/Cli/Commands/Stats.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Tags.hs b/hledger/Hledger/Cli/Commands/Tags.hs index 926e94813..5a7158016 100755 --- a/hledger/Hledger/Cli/Commands/Tags.hs +++ b/hledger/Hledger/Cli/Commands/Tags.hs @@ -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 diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 516e918e7..08428b538 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -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 diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 8e9ab1c71..fade998ba 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -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 diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 4a2842d81..464542489 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -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,