diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index fe184d2b5..8f3ebd75f 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -59,6 +59,7 @@ module Hledger.Query ( where import Control.Applicative ((<|>), many, optional) +import Data.Default (Default(..)) import Data.Either (partitionEithers) import Data.List (partition) import Data.Maybe (fromMaybe, isJust, mapMaybe) @@ -105,6 +106,8 @@ data Query = Any -- ^ always match -- matching the regexp if provided, exists deriving (Eq,Show) +instance Default Query where def = Any + -- | Construct a payee tag payeeTag :: Maybe String -> Either RegexError Query payeeTag = fmap (Tag (toRegexCI' "payee")) . maybe (pure Nothing) (fmap Just . toRegexCI) diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index 434da6fda..eccf0a81b 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -41,5 +41,4 @@ tests_Reports = tests "Reports" [ ,tests_EntriesReport ,tests_MultiBalanceReport ,tests_PostingsReport - ,tests_ReportOptions ] diff --git a/hledger-lib/Hledger/Reports/BalanceReport.hs b/hledger-lib/Hledger/Reports/BalanceReport.hs index af56c5824..7205aa0bd 100644 --- a/hledger-lib/Hledger/Reports/BalanceReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceReport.hs @@ -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 -> Query -> Journal -> BalanceReport -balanceReport ropts q j = (rows, total) +balanceReport :: ReportOpts -> Journal -> BalanceReport +balanceReport ropts j = (rows, total) where - report = multiBalanceReportWith ropts q j (journalPriceOracle (infer_value_ ropts) j) + report = multiBalanceReportWith ropts j (journalPriceOracle (infer_value_ ropts) j) rows = [( prrFullName row , prrDisplayName row , prrDepth row - 1 -- BalanceReport uses 0-based account depths @@ -102,8 +102,9 @@ tests_BalanceReport = tests "BalanceReport" [ let (opts,journal) `gives` r = do - let (eitems, etotal) = r - (aitems, atotal) = balanceReport opts (queryFromOpts nulldate opts) journal + let opts' = opts{query_=And [queryFromFlags opts, query_ opts]} + (eitems, etotal) = r + (aitems, atotal) = balanceReport opts' journal showw (acct,acct',indent,amt) = (acct, acct', indent, showMixedAmountDebug amt) (map showw aitems) @?= (map showw eitems) (showMixedAmountDebug atotal) @?= (showMixedAmountDebug etotal) @@ -152,7 +153,7 @@ tests_BalanceReport = tests "BalanceReport" [ Mixed [usd 0]) ,test "with depth:N" $ - (defreportopts{query_="depth:1"}, samplejournal) `gives` + (defreportopts{query_=Depth 1}, samplejournal) `gives` ([ ("expenses", "expenses", 0, mamountp' "$2.00") ,("income", "income", 0, mamountp' "$-2.00") @@ -160,11 +161,11 @@ tests_BalanceReport = tests "BalanceReport" [ Mixed [usd 0]) ,test "with date:" $ - (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives` + (defreportopts{query_=Date $ DateSpan (Just $ fromGregorian 2009 01 01) (Just $ fromGregorian 2010 01 01)}, samplejournal2) `gives` ([], 0) ,test "with date2:" $ - (defreportopts{query_="date2:'in 2009'"}, samplejournal2) `gives` + (defreportopts{query_=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") @@ -172,7 +173,7 @@ tests_BalanceReport = tests "BalanceReport" [ Mixed [usd 0]) ,test "with desc:" $ - (defreportopts{query_="desc:income"}, samplejournal) `gives` + (defreportopts{query_=Desc $ toRegexCI' "income"}, samplejournal) `gives` ([ ("assets:bank:checking","assets:bank:checking",0,mamountp' "$1.00") ,("income:salary","income:salary",0, mamountp' "$-1.00") @@ -180,7 +181,7 @@ tests_BalanceReport = tests "BalanceReport" [ Mixed [usd 0]) ,test "with not:desc:" $ - (defreportopts{query_="not:desc:income"}, samplejournal) `gives` + (defreportopts{query_=Not . Desc $ toRegexCI' "income"}, samplejournal) `gives` ([ ("assets:bank:saving","assets:bank:saving",0, mamountp' "$1.00") ,("assets:cash","assets:cash",0, mamountp' "$-2.00") diff --git a/hledger-lib/Hledger/Reports/BudgetReport.hs b/hledger-lib/Hledger/Reports/BudgetReport.hs index 7f3669ffd..c7d269739 100644 --- a/hledger-lib/Hledger/Reports/BudgetReport.hs +++ b/hledger-lib/Hledger/Reports/BudgetReport.hs @@ -33,7 +33,6 @@ import Data.Maybe #if !(MIN_VERSION_base(4,11,0)) import Data.Monoid ((<>)) #endif -import Data.Time.Calendar import Safe --import Data.List --import Data.Maybe @@ -66,8 +65,8 @@ 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 -> Day -> Journal -> BudgetReport -budgetReport ropts' assrt reportspan d j = dbg1 "sortedbudgetreport" budgetreport +budgetReport :: ReportOpts -> Bool -> DateSpan -> Journal -> BudgetReport +budgetReport ropts' 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 @@ -84,9 +83,9 @@ budgetReport ropts' assrt reportspan d j = dbg1 "sortedbudgetreport" budgetrepor 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 d ropts{empty_=True} actualj + dbg1 "actualreport" $ multiBalanceReport ropts{empty_=True} actualj budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) = - dbg1 "budgetgoalreport" $ multiBalanceReport d ropts{empty_=True} budgetj + dbg1 "budgetgoalreport" $ multiBalanceReport 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 25d86c11b..b4a15f3b8 100644 --- a/hledger-lib/Hledger/Reports/EntriesReport.hs +++ b/hledger-lib/Hledger/Reports/EntriesReport.hs @@ -32,9 +32,9 @@ type EntriesReport = [EntriesReportItem] type EntriesReportItem = Transaction -- | Select transactions for an entries report. -entriesReport :: ReportOpts -> Query -> Journal -> EntriesReport -entriesReport ropts@ReportOpts{..} q j@Journal{..} = - sortBy (comparing getdate) $ filter (q `matchesTransaction`) $ map tvalue jtxns +entriesReport :: ReportOpts -> Journal -> EntriesReport +entriesReport ropts@ReportOpts{..} j@Journal{..} = + sortBy (comparing getdate) $ filter (query_ `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". @@ -50,8 +50,8 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} = tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ - test "not acct" $ (length $ entriesReport defreportopts (Not . Acct $ toRegex' "bank") samplejournal) @?= 1 - ,test "date" $ (length $ entriesReport defreportopts (Date $ DateSpan (Just $ fromGregorian 2008 06 01) (Just $ fromGregorian 2008 07 01)) samplejournal) @?= 3 + 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 ] ] diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index dc3e0b254..709e61a8b 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -91,64 +91,57 @@ 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 :: Day -> ReportOpts -> Journal -> MultiBalanceReport -multiBalanceReport today ropts j = - multiBalanceReportWith ropts q j (journalPriceOracle infer j) - where - q = queryFromOpts today ropts - infer = infer_value_ ropts +multiBalanceReport :: ReportOpts -> Journal -> MultiBalanceReport +multiBalanceReport ropts j = multiBalanceReportWith ropts j (journalPriceOracle infer j) + where infer = infer_value_ ropts --- | A helper for multiBalanceReport. This one takes an explicit Query --- instead of deriving one from ReportOpts, and an extra argument, a --- PriceOracle to be used for looking up market prices. Commands which +-- | 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 -> Query -> Journal -> PriceOracle -> MultiBalanceReport -multiBalanceReportWith ropts q j priceoracle = report +multiBalanceReportWith :: ReportOpts -> Journal -> PriceOracle -> MultiBalanceReport +multiBalanceReportWith ropts' j priceoracle = report where -- Queries, report/column dates. - reportspan = dbg "reportspan" $ calculateReportSpan ropts q j - reportq = dbg "reportq" $ makeReportQuery ropts reportspan q + reportspan = dbg "reportspan" $ calculateReportSpan ropts' j + ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan -- Group postings into their columns. - colps = dbg'' "colps" $ getPostingsByColumn ropts reportq j reportspan + colps = dbg'' "colps" $ getPostingsByColumn ropts 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 reportq j reportspan + startbals = dbg' "startbals" $ startingBalances ropts j reportspan -- Generate and postprocess the report, negating balances and taking percentages if needed report = dbg' "report" $ - generateMultiBalanceReport ropts reportq j priceoracle colspans colps startbals + generateMultiBalanceReport ropts j priceoracle colspans colps startbals -- | Generate a compound balance report from a list of CBCSubreportSpec. This -- shares postings between the subreports. -compoundBalanceReport :: Day -> ReportOpts -> Journal -> [CBCSubreportSpec] +compoundBalanceReport :: ReportOpts -> Journal -> [CBCSubreportSpec] -> CompoundBalanceReport -compoundBalanceReport today ropts j = - compoundBalanceReportWith ropts q j (journalPriceOracle infer j) - where - q = queryFromOpts today ropts - infer = infer_value_ ropts +compoundBalanceReport ropts j = compoundBalanceReportWith ropts j (journalPriceOracle infer j) + where infer = infer_value_ ropts -- | A helper for compoundBalanceReport, similar to multiBalanceReportWith. -compoundBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle +compoundBalanceReportWith :: ReportOpts -> Journal -> PriceOracle -> [CBCSubreportSpec] -> CompoundBalanceReport -compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr +compoundBalanceReportWith ropts' j priceoracle subreportspecs = cbr where -- Queries, report/column dates. - reportspan = dbg "reportspan" $ calculateReportSpan ropts q j - reportq = dbg "reportq" $ makeReportQuery ropts reportspan q + reportspan = dbg "reportspan" $ calculateReportSpan ropts' j + ropts = dbg "reportopts" $ makeReportQuery ropts' reportspan -- Group postings into their columns. - colps = dbg'' "colps" $ getPostingsByColumn ropts{empty_=True} reportq j reportspan + colps = dbg'' "colps" $ getPostingsByColumn ropts{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 reportq j reportspan + startbals = dbg' "startbals" $ startingBalances ropts j reportspan subreports = map generateSubreport subreportspecs where @@ -156,7 +149,7 @@ compoundBalanceReportWith ropts q j priceoracle subreportspecs = cbr ( cbcsubreporttitle -- Postprocess the report, negating balances and taking percentages if needed , prNormaliseSign cbcsubreportnormalsign $ - generateMultiBalanceReport ropts' reportq j priceoracle colspans colps' startbals' + generateMultiBalanceReport ropts' j priceoracle colspans colps' startbals' , cbcsubreportincreasestotal ) where @@ -186,21 +179,19 @@ compoundBalanceReportWith ropts q 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 -> Query -> Journal -> DateSpan -> HashMap AccountName Account -startingBalances ropts q j reportspan = acctchanges +startingBalances :: ReportOpts -> Journal -> DateSpan -> HashMap AccountName Account +startingBalances ropts j reportspan = + acctChangesFromPostings ropts' . map fst $ getPostings ropts' j where - acctchanges = acctChangesFromPostings ropts' startbalq . map fst $ - getPostings ropts' startbalq j + ropts' = case accountlistmode_ ropts of + ALTree -> ropts{query_=startbalq, period_=precedingperiod, no_elide_=True} + ALFlat -> ropts{query_=startbalq, 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) q - - ropts' = case accountlistmode_ ropts of - ALTree -> ropts{no_elide_=True, period_=precedingperiod} - ALFlat -> ropts{period_=precedingperiod} + datelessq = dbg "datelessq" . filterQuery (not . queryIsDateOrDate2) $ query_ ropts precedingperiod = dateSpanAsPeriod . spanIntersect precedingspan . periodAsDateSpan $ period_ ropts @@ -210,11 +201,11 @@ startingBalances ropts q j reportspan = acctchanges a -> a -- | Calculate the span of the report to be generated. -calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan -calculateReportSpan ropts q j = reportspan +calculateReportSpan :: ReportOpts -> Journal -> DateSpan +calculateReportSpan ropts j = reportspan where -- The date span specified by -b/-e/-p options and query args if any. - requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ ropts) q + requestedspan = dbg "requestedspan" $ queryDateSpan (date2_ ropts) $ query_ ropts -- 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'" $ @@ -233,21 +224,22 @@ calculateReportSpan ropts q 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 -> Query -> Query -makeReportQuery ropts reportspan q - | reportspan == nulldatespan = q - | otherwise = And [dateless q, reportspandatesq] +makeReportQuery :: ReportOpts -> DateSpan -> ReportOpts +makeReportQuery ropts reportspan + | reportspan == nulldatespan = ropts + | otherwise = ropts{query_=query} where + query = simplifyQuery $ And [dateless $ query_ ropts, reportspandatesq] reportspandatesq = dbg "reportspandatesq" $ dateqcons reportspan - dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2) - dateqcons = if date2_ ropts then Date2 else Date + dateless = dbg "dateless" . filterQuery (not . queryIsDateOrDate2) + dateqcons = if date2_ ropts then Date2 else Date -- | Group postings, grouped by their column -getPostingsByColumn :: ReportOpts -> Query -> Journal -> DateSpan -> Map DateSpan [Posting] -getPostingsByColumn ropts q j reportspan = columns +getPostingsByColumn :: ReportOpts -> Journal -> DateSpan -> Map DateSpan [Posting] +getPostingsByColumn ropts j reportspan = columns where -- Postings matching the query within the report period. - ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts q j + ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts j days = map snd ps -- The date spans to be included as report columns. @@ -259,13 +251,14 @@ getPostingsByColumn ropts q j reportspan = columns columns = foldr addPosting emptyMap ps -- | Gather postings matching the query within the report period. -getPostings :: ReportOpts -> Query -> Journal -> [(Posting, Day)] -getPostings ropts q = +getPostings :: ReportOpts -> Journal -> [(Posting, Day)] +getPostings 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 -- 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 @@ -290,18 +283,17 @@ calculateColSpans ropts reportspan days = -- | Gather the account balance changes into a regular matrix -- including the accounts from all columns. -calculateAccountChanges :: ReportOpts -> Query -> [DateSpan] - -> Map DateSpan [Posting] +calculateAccountChanges :: ReportOpts -> [DateSpan] -> Map DateSpan [Posting] -> HashMap ClippedAccountName (Map DateSpan Account) -calculateAccountChanges ropts q colspans colps - | queryDepth q == Just 0 = acctchanges <> elided - | otherwise = acctchanges +calculateAccountChanges ropts colspans colps + | queryDepth (query_ ropts) == 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 q) colps + dbg'' "colacctchanges" $ fmap (acctChangesFromPostings ropts) colps elided = HM.singleton "..." $ M.fromList [(span, nullacct) | span <- colspans] @@ -309,15 +301,15 @@ calculateAccountChanges ropts q 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 -> Query -> [Posting] -> HashMap ClippedAccountName Account -acctChangesFromPostings ropts q ps = HM.fromList [(aname a, a) | a <- as] +acctChangesFromPostings :: ReportOpts -> [Posting] -> HashMap ClippedAccountName Account +acctChangesFromPostings 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 q + depthq = dbg "depthq" . filterQuery queryIsDepth $ query_ ropts -- | Accumulate and value amounts, as specified by the report options. -- @@ -370,21 +362,19 @@ accumValueAmounts ropts j priceoracle colspans startbals acctchanges = -- PARTI -- | 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 -> Query -> Journal -> PriceOracle - -> [DateSpan] - -> Map DateSpan [Posting] - -> HashMap AccountName Account +generateMultiBalanceReport :: ReportOpts -> Journal -> PriceOracle -> [DateSpan] + -> Map DateSpan [Posting] -> HashMap AccountName Account -> MultiBalanceReport -generateMultiBalanceReport ropts q j priceoracle colspans colps startbals = report +generateMultiBalanceReport ropts j priceoracle colspans colps startbals = report where -- Each account's balance changes across all columns. - acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts q colspans colps + acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts colspans colps -- Process changes into normal, cumulative, or historical amounts, plus value them accumvalued = accumValueAmounts ropts j priceoracle colspans startbals acctchanges -- All account names that will be displayed, possibly depth-clipped. - displaynames = dbg'' "displaynames" $ displayedAccounts ropts q accumvalued + displaynames = dbg'' "displaynames" $ displayedAccounts ropts accumvalued -- All the rows of the report. rows = dbg'' "rows" $ buildReportRows ropts displaynames accumvalued @@ -423,10 +413,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 -> Query - -> HashMap AccountName (Map DateSpan Account) +displayedAccounts :: ReportOpts -> HashMap AccountName (Map DateSpan Account) -> HashMap AccountName DisplayName -displayedAccounts ropts q valuedaccts +displayedAccounts ropts valuedaccts | depth == 0 = HM.singleton "..." $ DisplayName "..." "..." 1 | otherwise = HM.mapWithKey (\a _ -> displayedName a) displayedAccts where @@ -467,7 +456,7 @@ displayedAccounts ropts q valuedaccts minSubs = if no_elide_ ropts then 1 else 2 isZeroRow balance = all (mixedAmountLooksZero . balance) - depth = fromMaybe maxBound $ queryDepth q + depth = fromMaybe maxBound . queryDepth $ query_ ropts numSubs = subaccountTallies . HM.keys $ HM.filterWithKey isInteresting valuedaccts -- | Sort the rows by amount or by account declaration order. @@ -612,8 +601,9 @@ 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 (eitems, etotal) = r - (PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal + let opts' = opts{query_=And [queryFromFlags opts, query_ opts]} + (eitems, etotal) = r + (PeriodicReport _ aitems atotal) = multiBalanceReport opts' 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) diff --git a/hledger-lib/Hledger/Reports/PostingsReport.hs b/hledger-lib/Hledger/Reports/PostingsReport.hs index b70c6eb4f..49bf7c7de 100644 --- a/hledger-lib/Hledger/Reports/PostingsReport.hs +++ b/hledger-lib/Hledger/Reports/PostingsReport.hs @@ -65,20 +65,20 @@ 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 -> Query -> Journal -> PostingsReport -postingsReport ropts@ReportOpts{..} q j = +postingsReport :: ReportOpts -> Journal -> PostingsReport +postingsReport ropts@ReportOpts{..} j = (totallabel, items) where - reportspan = adjustReportDates ropts q j + reportspan = adjustReportDates ropts j whichdate = whichDateFromOpts ropts - mdepth = queryDepth q + mdepth = queryDepth query_ styles = journalCommodityStyles j priceoracle = journalPriceOracle infer_value_ j multiperiod = interval_ /= NoInterval today = fromMaybe (error' "postingsReport: could not pick a valuation date, ReportOpts today_ is unset") today_ -- PARTIAL: -- postings to be included in the report, and similarly-matched postings before the report start date - (precedingps, reportps) = matchedPostingsBeforeAndDuring ropts q j reportspan + (precedingps, reportps) = matchedPostingsBeforeAndDuring ropts j reportspan -- Postings, or summary postings with their subperiod's end date, to be displayed. displayps :: [(Posting, Maybe Day)] @@ -140,11 +140,11 @@ 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 -> Query -> Journal -> DateSpan -adjustReportDates opts q j = reportspan +adjustReportDates :: ReportOpts -> Journal -> DateSpan +adjustReportDates opts j = reportspan where -- see also multiBalanceReport - requestedspan = dbg3 "requestedspan" $ queryDateSpan' q -- span specified by -b/-e/-p options and query args + requestedspan = dbg3 "requestedspan" $ queryDateSpan' $ query_ opts -- 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 @@ -159,10 +159,11 @@ adjustReportDates opts q 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 -> Query -> Journal -> DateSpan -> ([Posting],[Posting]) -matchedPostingsBeforeAndDuring opts q j (DateSpan mstart mend) = +matchedPostingsBeforeAndDuring :: ReportOpts -> Journal -> DateSpan -> ([Posting],[Posting]) +matchedPostingsBeforeAndDuring opts 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 @@ -179,7 +180,7 @@ matchedPostingsBeforeAndDuring opts q j (DateSpan mstart mend) = dateless = filterQuery (not . queryIsDateOrDate2) beforeendq = dateqtype $ DateSpan Nothing mend sortdate = if date2_ opts then postingDate2 else postingDate - symq = dbg4 "symq" $ filterQuery queryIsSym q + symq = dbg4 "symq" . filterQuery queryIsSym $ query_ opts dateqtype | queryIsDate2 dateq || (queryIsDate dateq && date2_ opts) = Date2 | otherwise = Date @@ -270,7 +271,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 journal) @?= n + let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts{query_=query} journal) @?= n -- with the query specified explicitly (Any, nulljournal) `gives` 0 (Any, samplejournal) `gives` 13 @@ -279,10 +280,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 Any samplejournal) @?= 13 - (length $ snd $ postingsReport defreportopts{interval_=Months 1} Any samplejournal) @?= 11 - (length $ snd $ postingsReport defreportopts{interval_=Months 1, empty_=True} Any samplejournal) @?= 20 - (length $ snd $ postingsReport defreportopts (Acct (toRegex' "assets:bank:checking")) samplejournal) @?= 5 + (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 -- (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 7428aadf4..c0df63c00 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -23,9 +23,7 @@ module Hledger.Reports.ReportOptions ( journalSelectingAmountFromOpts, intervalFromRawOpts, forecastPeriodFromRawOpts, - queryFromOpts, - queryFromOptsOnly, - queryOptsFromOpts, + queryFromFlags, transactionDateFn, postingDateFn, reportSpan, @@ -40,8 +38,6 @@ module Hledger.Reports.ReportOptions ( reportPeriodOrJournalLastDay, valuationTypeIsCost, valuationTypeIsDefaultValue, - - tests_ReportOptions ) where @@ -49,7 +45,7 @@ import Control.Applicative ((<|>)) import Data.List.Extra (nubSort) import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T -import Data.Time.Calendar (Day, addDays, fromGregorian) +import Data.Time.Calendar (Day, addDays) import Data.Default (Default(..)) import Safe (lastDef, lastMay) @@ -99,8 +95,8 @@ data ReportOpts = ReportOpts { ,no_elide_ :: Bool ,real_ :: Bool ,format_ :: StringFormat - ,query_ :: String -- ^ All query arguments space sepeareted - -- and quoted if needed (see 'quoteIfNeeded') + ,query_ :: Query + ,queryopts_ :: [QueryOpt] -- ,average_ :: Bool -- for posting reports (register) @@ -167,52 +163,62 @@ defreportopts = ReportOpts def def def + def rawOptsToReportOpts :: RawOpts -> IO ReportOpts rawOptsToReportOpts rawopts = do d <- getCurrentDay no_color <- isJust <$> lookupEnv "NO_COLOR" supports_color <- hSupportsANSIColor stdout - let colorflag = stringopt "color" rawopts - format <- case parseStringFormat <$> maybestringopt "format" rawopts of - Nothing -> return defaultBalanceLineFormat - Just (Right x) -> return x - Just (Left err) -> usageError $ "could not parse format option: " ++ err + let colorflag = stringopt "color" rawopts + formatstring = maybestringopt "format" rawopts + querystring = T.pack . unwords . map quoteIfNeeded $ + listofstringopt "args" rawopts -- doesn't handle an arg like "" right - return defreportopts{ - today_ = Just d - ,period_ = periodFromRawOpts d rawopts - ,interval_ = intervalFromRawOpts rawopts - ,statuses_ = statusesFromRawOpts rawopts - ,value_ = valuationTypeFromRawOpts rawopts - ,infer_value_ = boolopt "infer-value" rawopts - ,depth_ = maybeposintopt "depth" rawopts - ,date2_ = boolopt "date2" rawopts - ,empty_ = boolopt "empty" rawopts - ,no_elide_ = boolopt "no-elide" rawopts - ,real_ = boolopt "real" rawopts - ,format_ = format - ,query_ = unwords . map quoteIfNeeded $ listofstringopt "args" rawopts -- doesn't handle an arg like "" right - ,average_ = boolopt "average" rawopts - ,related_ = boolopt "related" rawopts - ,txn_dates_ = boolopt "txn-dates" rawopts - ,balancetype_ = balancetypeopt rawopts - ,accountlistmode_ = accountlistmodeopt rawopts - ,drop_ = posintopt "drop" rawopts - ,row_total_ = boolopt "row-total" rawopts - ,no_total_ = boolopt "no-total" rawopts - ,sort_amount_ = boolopt "sort-amount" rawopts - ,percent_ = boolopt "percent" rawopts - ,invert_ = boolopt "invert" rawopts - ,pretty_tables_ = boolopt "pretty-tables" rawopts - ,color_ = and [not no_color - ,not $ colorflag `elem` ["never","no"] - ,colorflag `elem` ["always","yes"] || supports_color - ] - ,forecast_ = forecastPeriodFromRawOpts d rawopts - ,transpose_ = boolopt "transpose" rawopts - } + format <- case parseStringFormat <$> formatstring of + Nothing -> return defaultBalanceLineFormat + 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_ = Just d + ,period_ = periodFromRawOpts d rawopts + ,interval_ = intervalFromRawOpts rawopts + ,statuses_ = statusesFromRawOpts rawopts + ,value_ = valuationTypeFromRawOpts rawopts + ,infer_value_ = boolopt "infer-value" rawopts + ,depth_ = maybeposintopt "depth" rawopts + ,date2_ = boolopt "date2" rawopts + ,empty_ = boolopt "empty" rawopts + ,no_elide_ = boolopt "no-elide" rawopts + ,real_ = boolopt "real" rawopts + ,format_ = format + ,query_ = simplifyQuery $ And [queryFromFlags reportopts, argsquery] + ,queryopts_ = queryopts + ,average_ = boolopt "average" rawopts + ,related_ = boolopt "related" rawopts + ,txn_dates_ = boolopt "txn-dates" rawopts + ,balancetype_ = balancetypeopt rawopts + ,accountlistmode_ = accountlistmodeopt rawopts + ,drop_ = posintopt "drop" rawopts + ,row_total_ = boolopt "row-total" rawopts + ,no_total_ = boolopt "no-total" rawopts + ,sort_amount_ = boolopt "sort-amount" rawopts + ,percent_ = boolopt "percent" rawopts + ,invert_ = boolopt "invert" rawopts + ,pretty_tables_ = boolopt "pretty-tables" rawopts + ,color_ = and [not no_color + ,not $ colorflag `elem` ["never","no"] + ,colorflag `elem` ["always","yes"] || supports_color + ] + ,forecast_ = forecastPeriodFromRawOpts d rawopts + ,transpose_ = boolopt "transpose" rawopts + } + + return reportopts accountlistmodeopt :: RawOpts -> AccountListMode accountlistmodeopt = @@ -423,17 +429,9 @@ journalSelectingAmountFromOpts opts = Just (AtCost _) -> journalToCost _ -> id --- | Convert report options and arguments to a query. --- If there is a parsing problem, this function calls error. -queryFromOpts :: Day -> ReportOpts -> Query -queryFromOpts d ropts = simplifyQuery . And $ [flagsq, argsq] - where - flagsq = queryFromOptsOnly d ropts - argsq = fst $ either error' id $ parseQuery d (T.pack $ query_ ropts) -- PARTIAL: - -- | Convert report options to a query, ignoring any non-flag command line arguments. -queryFromOptsOnly :: Day -> ReportOpts -> Query -queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq +queryFromFlags :: ReportOpts -> Query +queryFromFlags ReportOpts{..} = simplifyQuery $ And flagsq where flagsq = consIf Real real_ . consIf Empty empty_ @@ -444,11 +442,6 @@ queryFromOptsOnly _d ReportOpts{..} = simplifyQuery $ And flagsq consIf f b = if b then (f True:) else id consJust f = maybe id ((:) . f) --- | Convert report options and arguments to query options. --- If there is a parsing problem, this function calls error. -queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt] -queryOptsFromOpts d = snd . either error' id . parseQuery d . T.pack . query_ -- PARTIAL: - -- Report dates. -- | The effective report span is the start and end dates specified by @@ -477,9 +470,8 @@ reportEndDate j ropts = spanEnd <$> reportSpan j ropts -- Needs IO to parse smart dates in options/queries. specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day) specifiedStartEndDates ropts = do - today <- getCurrentDay let - q = queryFromOpts today ropts + q = query_ ropts mspecifiedstartdate = queryStartDate False q mspecifiedenddate = queryEndDate False q return (mspecifiedstartdate, mspecifiedenddate) @@ -498,9 +490,7 @@ specifiedEndDate ropts = snd <$> specifiedStartEndDates ropts -- since we need that to get the report period robustly -- (unlike reportStartDate, which looks up the date with IO.) reportPeriodStart :: ReportOpts -> Maybe Day -reportPeriodStart ropts@ReportOpts{..} = do - t <- today_ - queryStartDate False $ queryFromOpts t ropts +reportPeriodStart = queryStartDate False . query_ -- 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 @@ -517,11 +507,7 @@ reportPeriodOrJournalStart ropts j = -- since we need that to get the report period robustly -- (unlike reportEndDate, which looks up the date with IO.) reportPeriodLastDay :: ReportOpts -> Maybe Day -reportPeriodLastDay ropts@ReportOpts{..} = do - t <- today_ - let q = queryFromOpts t ropts - qend <- queryEndDate False q - return $ addDays (-1) qend +reportPeriodLastDay = fmap (addDays (-1)) . queryEndDate False . query_ -- 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 @@ -530,22 +516,3 @@ reportPeriodLastDay ropts@ReportOpts{..} = do reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day reportPeriodOrJournalLastDay ropts j = reportPeriodLastDay ropts <|> journalEndDate False j - --- tests - -tests_ReportOptions = tests "ReportOptions" [ - test "queryFromOpts" $ do - queryFromOpts nulldate defreportopts @?= Any - queryFromOpts nulldate defreportopts{query_="a"} @?= Acct (toRegexCI' "a") - queryFromOpts nulldate defreportopts{query_="desc:'a a'"} @?= Desc (toRegexCI' "a a") - queryFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01),query_="date:'to 2013'" } - @?= (Date $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)) - queryFromOpts nulldate defreportopts{query_="date2:'in 2012'"} @?= (Date2 $ DateSpan (Just $ fromGregorian 2012 01 01) (Just $ fromGregorian 2013 01 01)) - queryFromOpts nulldate defreportopts{query_="'a a' 'b"} @?= Or [Acct $ toRegexCI' "a a", Acct $ toRegexCI' "'b"] - - ,test "queryOptsFromOpts" $ do - queryOptsFromOpts nulldate defreportopts @?= [] - queryOptsFromOpts nulldate defreportopts{query_="a"} @?= [] - queryOptsFromOpts nulldate defreportopts{period_=PeriodFrom (fromGregorian 2012 01 01) - ,query_="date:'to 2013'"} @?= [] - ] diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 999d8b683..e034ac693 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -518,8 +518,7 @@ getHledgerCliOpts' mode' args' = do putStrLn $ "running: " ++ progname' putStrLn $ "raw args: " ++ show args' putStrLn $ "processed opts:\n" ++ show opts - d <- getCurrentDay - putStrLn $ "search query: " ++ show (queryFromOpts d $ reportopts_ opts) + putStrLn $ "search query: " ++ show (query_ $ reportopts_ opts) getHledgerCliOpts :: Mode RawOpts -> IO CliOpts getHledgerCliOpts mode' = do diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index ff3283872..73d25eadd 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -276,8 +276,8 @@ testmode = hledgerCommandMode -- not be used (and would raise an error). -- testcmd :: CliOpts -> Journal -> IO () -testcmd opts _undefined = do - withArgs (words' $ query_ $ reportopts_ opts) $ +testcmd opts _undefined = do + withArgs (listofstringopt "args" $ rawopts_ opts) $ Test.Tasty.defaultMain $ tests "hledger" [ tests_Hledger ,tests_Hledger_Cli diff --git a/hledger/Hledger/Cli/Commands/Accounts.hs b/hledger/Hledger/Cli/Commands/Accounts.hs index a62d88eb3..1c77e4efa 100644 --- a/hledger/Hledger/Cli/Commands/Accounts.hs +++ b/hledger/Hledger/Cli/Commands/Accounts.hs @@ -51,11 +51,10 @@ accounts :: CliOpts -> Journal -> IO () accounts CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do -- 1. identify the accounts we'll show - d <- getCurrentDay let tree = tree_ ropts declared = boolopt "declared" rawopts used = boolopt "used" rawopts - q = queryFromOpts d ropts + 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 -- just the acct: part of the query will be reapplied later, after clipping diff --git a/hledger/Hledger/Cli/Commands/Activity.hs b/hledger/Hledger/Cli/Commands/Activity.hs index b63f15f1e..1f39ae286 100644 --- a/hledger/Hledger/Cli/Commands/Activity.hs +++ b/hledger/Hledger/Cli/Commands/Activity.hs @@ -30,23 +30,21 @@ barchar = '*' -- | Print a bar chart of number of postings per report interval. activity :: CliOpts -> Journal -> IO () -activity CliOpts{reportopts_=ropts} j = do - d <- getCurrentDay - putStr $ showHistogram ropts (queryFromOpts d ropts) j +activity CliOpts{reportopts_=ropts} j = putStr $ showHistogram ropts j -showHistogram :: ReportOpts -> Query -> Journal -> String -showHistogram opts q j = concatMap (printDayWith countBar) spanps - where - i = interval_ opts - interval | i == NoInterval = Days 1 - | otherwise = i - span' = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j - spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span' - spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans] - -- same as Register - -- should count transactions, not postings ? - -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j - ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j +showHistogram :: ReportOpts -> Journal -> String +showHistogram ReportOpts{query_=q,interval_=i,date2_=date2} j = + concatMap (printDayWith countBar) spanps + where + interval | i == NoInterval = Days 1 + | otherwise = i + span' = queryDateSpan date2 q `spanDefaultsFrom` journalDateSpan date2 j + spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span' + spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans] + -- same as Register + -- should count transactions, not postings ? + -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j + ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j printDayWith f (DateSpan b _, ps) = printf "%s %s\n" (show $ fromJust b) (f ps) diff --git a/hledger/Hledger/Cli/Commands/Add.hs b/hledger/Hledger/Cli/Commands/Add.hs index 36cf89b79..bc54c8bf3 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 = queryFromOptsOnly esToday $ reportopts_ esOpts + let q = queryFromFlags $ reportopts_ esOpts historymatches = transactionsSimilarTo esJournal q desc bestmatch | null historymatches = Nothing | otherwise = Just $ snd $ head historymatches @@ -461,9 +461,8 @@ ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse -- | Convert a string of journal data into a register report. registerFromString :: String -> IO String registerFromString s = do - d <- getCurrentDay j <- readJournal' $ T.pack s - return $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j + return . postingsReportAsText opts $ postingsReport ropts j where ropts = defreportopts{empty_=True} opts = defcliopts{reportopts_=ropts} diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 87230a339..86bb6eefb 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -19,7 +19,6 @@ module Hledger.Cli.Commands.Aregister ( ,tests_Aregister ) where -import Control.Monad (when) import Data.Aeson (toJSON) import Data.Aeson.Text (encodeToLazyText) import Data.List @@ -75,10 +74,11 @@ aregister :: CliOpts -> Journal -> IO () aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do d <- getCurrentDay -- the first argument specifies the account, any remaining arguments are a filter query - let args' = listofstringopt "args" rawopts - when (null args') $ error' "aregister needs an account, please provide an account name or pattern" -- PARTIAL: + (apat,querystring) <- case listofstringopt "args" rawopts of + [] -> fail "aregister needs an account, please provide an account name or pattern" + (a:as) -> return (a, T.pack . unwords $ map quoteIfNeeded as) + argsquery <- either fail (return . fst) $ parseQuery d querystring let - (apat:queryargs) = args' acct = headDef (error' $ show apat++" did not match any account") -- PARTIAL: . filterAccts $ journalAccountNames j filterAccts = case toRegexCI apat of @@ -88,13 +88,13 @@ aregister opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do inclusive = True -- tree_ ropts thisacctq = Acct $ (if inclusive then accountNameToAccountRegex else accountNameToAccountOnlyRegex) acct ropts' = ropts{ - query_=unwords $ map quoteIfNeeded $ queryargs + 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 } - reportq = And [queryFromOpts d ropts', excludeforecastq (isJust $ forecast_ ropts)] + reportq = And [query_ ropts', excludeforecastq (isJust $ forecast_ ropts)] where -- As in RegisterScreen, why ? XXX -- Except in forecast mode, exclude future/forecast transactions. diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 5f196079d..b966cf90c 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -305,14 +305,13 @@ balancemode = hledgerCommandMode -- | The balance command, prints a balance report. balance :: CliOpts -> Journal -> IO () balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do - d <- getCurrentDay let budget = boolopt "budget" rawopts multiperiod = interval_ /= NoInterval fmt = outputFormatFromOpts opts if budget then do -- single or multi period budget report reportspan <- reportSpan j ropts - let budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan d j + let budgetreport = dbg4 "budgetreport" $ budgetReport ropts assrt reportspan j where assrt = not $ ignore_assertions_ $ inputopts_ opts render = case fmt of @@ -323,7 +322,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do else if multiperiod then do -- multi period balance report - let report = multiBalanceReport d ropts j + let report = multiBalanceReport ropts j render = case fmt of "txt" -> multiBalanceReportAsText ropts "csv" -> (++"\n") . printCSV . multiBalanceReportAsCsv ropts @@ -333,7 +332,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 (queryFromOpts d ropts) j -- simple Ledger-style balance report + let report = balanceReport ropts j -- simple Ledger-style balance report render = case fmt of "txt" -> balanceReportAsText "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r @@ -622,7 +621,7 @@ tests_Balance = tests "Balance" [ test "unicode in balance layout" $ do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - balanceReportAsText opts (balanceReport opts (queryFromOpts (fromGregorian 2008 11 26) opts) j) + balanceReportAsText opts (balanceReport opts{today_=Just $ fromGregorian 2008 11 26} j) @?= unlines [" -100 актив:наличные" diff --git a/hledger/Hledger/Cli/Commands/Checkdates.hs b/hledger/Hledger/Cli/Commands/Checkdates.hs index 1441cfa6d..396b38fba 100755 --- a/hledger/Hledger/Cli/Commands/Checkdates.hs +++ b/hledger/Hledger/Cli/Commands/Checkdates.hs @@ -22,10 +22,8 @@ checkdatesmode = hledgerCommandMode checkdates :: CliOpts -> Journal -> IO () checkdates CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do - d <- getCurrentDay let ropts_ = ropts{accountlistmode_=ALFlat} - let q = queryFromOpts d ropts_ - let ts = filter (q `matchesTransaction`) $ + let ts = filter (query_ ropts_ `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 3c56fbb2d..da5b19b8e 100755 --- a/hledger/Hledger/Cli/Commands/Close.hs +++ b/hledger/Hledger/Cli/Commands/Close.hs @@ -73,7 +73,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do -- dates of the closing and opening transactions ropts_ = ropts{balancetype_=HistoricalBalance, accountlistmode_=ALFlat} - q = queryFromOpts today ropts_ + q = query_ ropts_ openingdate = fromMaybe today $ queryEndDate False q closingdate = addDays (-1) openingdate @@ -86,7 +86,7 @@ close CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do False -> normaliseMixedAmount . mixedAmountStripPrices -- the balances to close - (acctbals,_) = balanceReport ropts_ q j + (acctbals,_) = balanceReport ropts_ 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 11b4d6e0c..5c085f666 100644 --- a/hledger/Hledger/Cli/Commands/Codes.hs +++ b/hledger/Hledger/Cli/Commands/Codes.hs @@ -33,10 +33,7 @@ codesmode = hledgerCommandMode -- | The codes command. codes :: CliOpts -> Journal -> IO () codes CliOpts{reportopts_=ropts@ReportOpts{empty_}} j = do - d <- getCurrentDay - let q = queryFromOpts d ropts - ts = entriesReport ropts q j + let ts = entriesReport ropts j codes = (if empty_ 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 b41b53ea7..9e84db5b0 100644 --- a/hledger/Hledger/Cli/Commands/Descriptions.hs +++ b/hledger/Hledger/Cli/Commands/Descriptions.hs @@ -32,9 +32,7 @@ descriptionsmode = hledgerCommandMode -- | The descriptions command. descriptions :: CliOpts -> Journal -> IO () descriptions CliOpts{reportopts_=ropts} j = do - d <- getCurrentDay - let q = queryFromOpts d ropts - ts = entriesReport ropts q j + let ts = entriesReport ropts 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 aa5bfb64f..78a63c40d 100644 --- a/hledger/Hledger/Cli/Commands/Diff.hs +++ b/hledger/Hledger/Cli/Commands/Diff.hs @@ -102,11 +102,11 @@ unmatchedtxns s pp m = -- | The diff command. diff :: CliOpts -> Journal -> IO () -diff CliOpts{file_=[f1, f2], reportopts_=ReportOpts{query_=acctName}} _ = do +diff CliOpts{file_=[f1, f2], reportopts_=ReportOpts{query_=Acct acctRe}} _ = do j1 <- readJournalFile' f1 j2 <- readJournalFile' f2 - let acct = T.pack acctName + let acct = T.pack $ reString acctRe let pp1 = matchingPostings acct j1 let pp2 = matchingPostings acct j2 diff --git a/hledger/Hledger/Cli/Commands/Notes.hs b/hledger/Hledger/Cli/Commands/Notes.hs index eaba24c5b..2214d1c2e 100644 --- a/hledger/Hledger/Cli/Commands/Notes.hs +++ b/hledger/Hledger/Cli/Commands/Notes.hs @@ -33,9 +33,6 @@ notesmode = hledgerCommandMode -- | The notes command. notes :: CliOpts -> Journal -> IO () notes CliOpts{reportopts_=ropts} j = do - d <- getCurrentDay - let q = queryFromOpts d ropts - ts = entriesReport ropts q j + let ts = entriesReport ropts 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 ca6a080f6..fbc1a751c 100644 --- a/hledger/Hledger/Cli/Commands/Payees.hs +++ b/hledger/Hledger/Cli/Commands/Payees.hs @@ -33,9 +33,6 @@ payeesmode = hledgerCommandMode -- | The payees command. payees :: CliOpts -> Journal -> IO () payees CliOpts{reportopts_=ropts} j = do - d <- getCurrentDay - let q = queryFromOpts d ropts - ts = entriesReport ropts q j + let ts = entriesReport ropts 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 584e7b9da..746420a83 100755 --- a/hledger/Hledger/Cli/Commands/Prices.hs +++ b/hledger/Hledger/Cli/Commands/Prices.hs @@ -25,10 +25,9 @@ pricesmode = hledgerCommandMode -- XXX the original hledger-prices script always ignored assertions prices opts j = do - d <- getCurrentDay let styles = journalCommodityStyles j - q = queryFromOpts d (reportopts_ opts) + q = query_ $ reportopts_ 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 aa5272091..da9ffbbd5 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -54,16 +54,14 @@ print' opts j = do printEntries :: CliOpts -> Journal -> IO () printEntries opts@CliOpts{reportopts_=ropts} j = do - d <- getCurrentDay - let q = queryFromOpts d ropts - fmt = outputFormatFromOpts opts + let fmt = outputFormatFromOpts opts render = case fmt of "txt" -> entriesReportAsText opts "csv" -> (++"\n") . printCSV . entriesReportAsCsv "json" -> (++"\n") . TL.unpack . toJsonText "sql" -> entriesReportAsSql _ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: - writeOutput opts $ render $ entriesReport ropts q j + writeOutput opts $ render $ entriesReport ropts j entriesReportAsText :: CliOpts -> EntriesReport -> String entriesReportAsText opts = concatMap (showTransaction . whichtxn) @@ -185,11 +183,9 @@ postingToCSV p = -- (and the query, if any). printMatch :: CliOpts -> Journal -> Text -> IO () printMatch CliOpts{reportopts_=ropts} j desc = do - d <- getCurrentDay - let q = queryFromOpts d ropts - case similarTransaction' j q desc of - Nothing -> putStrLn "no matches found." - Just t -> putStr $ showTransaction t + case similarTransaction' j (query_ ropts) desc of + Nothing -> putStrLn "no matches found." + Just t -> putStr $ showTransaction t where -- Identify the closest recent match for this description in past transactions. diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index 5d9a31e6a..a74b89569 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -23,7 +23,6 @@ import Data.Maybe -- import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL -import Data.Time (fromGregorian) import System.Console.CmdArgs.Explicit import Hledger.Read.CsvReader (CSV, CsvRecord, printCSV) @@ -60,13 +59,12 @@ registermode = hledgerCommandMode -- | Print a (posting) register report. register :: CliOpts -> Journal -> IO () register opts@CliOpts{reportopts_=ropts} j = do - d <- getCurrentDay 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 (queryFromOpts d ropts) j + writeOutput opts . render opts $ postingsReport ropts j postingsReportAsCsv :: PostingsReport -> CSV postingsReportAsCsv (_,is) = @@ -201,7 +199,7 @@ tests_Register = tests "Register" [ test "unicode in register layout" $ do j <- readJournal' "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts - (postingsReportAsText defcliopts $ postingsReport opts (queryFromOpts (fromGregorian 2008 11 26) opts) j) + (postingsReportAsText defcliopts $ postingsReport opts j) @?= unlines ["2009-01-01 медвежья шкура расходы:покупки 100 100" diff --git a/hledger/Hledger/Cli/Commands/Registermatch.hs b/hledger/Hledger/Cli/Commands/Registermatch.hs index 228db6b22..f551d62f5 100755 --- a/hledger/Hledger/Cli/Commands/Registermatch.hs +++ b/hledger/Hledger/Cli/Commands/Registermatch.hs @@ -22,13 +22,10 @@ registermatchmode = hledgerCommandMode ([], Just $ argsFlag "DESC") registermatch :: CliOpts -> Journal -> IO () -registermatch opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do - let args' = listofstringopt "args" rawopts - case args' of +registermatch opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = + case listofstringopt "args" rawopts of [desc] -> do - d <- getCurrentDay - let q = queryFromOptsOnly d ropts - (_,pris) = postingsReport ropts q j + let (_,pris) = postingsReport ropts 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 7c481fb12..c83e25a48 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -9,7 +9,7 @@ module Hledger.Cli.Commands.Rewrite ( where #if !(MIN_VERSION_base(4,11,0)) -import Control.Monad.Writer +import Control.Monad.Writer hiding (Any) #endif import Data.Functor.Identity import Data.List (sortOn, foldl') @@ -42,15 +42,15 @@ rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = d 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_=""}} j j' + printOrDiff rawopts opts{reportopts_=ropts{query_=Any}} j j' -- | Build a 'TransactionModifier' from any query arguments and --add-posting flags -- provided on the command line, or throw a parse error. transactionModifierFromOpts :: CliOpts -> TransactionModifier -transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} = - TransactionModifier{tmquerytxt=q, tmpostingrules=ps} +transactionModifierFromOpts CliOpts{rawopts_=rawopts} = + TransactionModifier{tmquerytxt=q, tmpostingrules=ps} where - q = T.pack $ query_ ropts + q = T.pack . unwords . map quoteIfNeeded $ listofstringopt "args" rawopts ps = map (parseposting . T.pack) $ listofstringopt "add-posting" rawopts parseposting t = either (error' . errorBundlePretty) id ep -- PARTIAL: where diff --git a/hledger/Hledger/Cli/Commands/Roi.hs b/hledger/Hledger/Cli/Commands/Roi.hs index f44b4e3d3..3ede7b97b 100644 --- a/hledger/Hledger/Cli/Commands/Roi.hs +++ b/hledger/Hledger/Cli/Commands/Roi.hs @@ -19,6 +19,7 @@ import Data.Function (on) import Data.List import Numeric.RootFinding import Data.Decimal +import qualified Data.Text as T import System.Console.CmdArgs.Explicit as CmdArgs import Text.Tabular as Tbl @@ -54,11 +55,16 @@ roi :: CliOpts -> Journal -> IO () roi CliOpts{rawopts_=rawopts, reportopts_=ropts} j = do d <- getCurrentDay let - investmentsQuery = queryFromOpts d $ ropts{query_ = stringopt "investment" rawopts,period_=PeriodAll} - pnlQuery = queryFromOpts d $ ropts{query_ = stringopt "pnl" rawopts,period_=PeriodAll} - showCashFlow = boolopt "cashflow" rawopts - prettyTables = pretty_tables_ ropts + showCashFlow = boolopt "cashflow" rawopts + prettyTables = pretty_tables_ ropts + makeQuery flag = do + q <- either usageError (return . fst) . parseQuery d . T.pack $ stringopt flag rawopts + return . simplifyQuery $ And [queryFromFlags ropts{period_=PeriodAll}, q] + investmentsQuery <- makeQuery "investment" + pnlQuery <- makeQuery "pnl" + + let trans = dbg3 "investments" $ jtxns $ filterJournalTransactions investmentsQuery j journalSpan = diff --git a/hledger/Hledger/Cli/Commands/Stats.hs b/hledger/Hledger/Cli/Commands/Stats.hs index 88d7fb333..daf62b545 100644 --- a/hledger/Hledger/Cli/Commands/Stats.hs +++ b/hledger/Hledger/Cli/Commands/Stats.hs @@ -42,12 +42,11 @@ statsmode = hledgerCommandMode -- like Register.summarisePostings -- | Print various statistics for the journal. stats :: CliOpts -> Journal -> IO () -stats opts@CliOpts{reportopts_=reportopts_} j = do +stats opts@CliOpts{reportopts_=ReportOpts{query_=q, interval_=interval}} j = do d <- getCurrentDay - let q = queryFromOpts d reportopts_ - l = ledgerFromJournal q j + let l = ledgerFromJournal q j reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q) - intervalspans = splitSpan (interval_ reportopts_) reportspan + intervalspans = splitSpan interval 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 82410706f..926e94813 100755 --- a/hledger/Hledger/Cli/Commands/Tags.hs +++ b/hledger/Hledger/Cli/Commands/Tags.hs @@ -28,15 +28,17 @@ tagsmode = hledgerCommandMode tags :: CliOpts -> Journal -> IO () tags CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do d <- getCurrentDay - let - args = listofstringopt "args" rawopts + let args = listofstringopt "args" rawopts mtagpat <- mapM (either Fail.fail pure . toRegexCI) $ headMay args let - queryargs = drop 1 args - values = boolopt "values" rawopts - parsed = boolopt "parsed" rawopts - empty = empty_ ropts - q = queryFromOpts d $ ropts{query_ = unwords $ map quoteIfNeeded queryargs} + querystring = T.pack . unwords . map quoteIfNeeded $ drop 1 args + values = boolopt "values" rawopts + parsed = boolopt "parsed" rawopts + empty = empty_ ropts + + argsquery <- either usageError (return . fst) $ parseQuery d querystring + let + q = simplifyQuery $ And [queryFromFlags ropts, argsquery] txns = filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts ropts j tagsorvalues = (if parsed then id else nubSort) diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 2d701a719..516e918e7 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -89,7 +89,6 @@ 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 - today <- getCurrentDay let -- use the default balance type for this report, unless the user overrides mBalanceTypeOverride = @@ -121,7 +120,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_ (queryFromOpts today ropts') + requestedspan = queryDateSpan date2_ query_ `spanDefaultsFrom` journalDateSpan date2_ j -- when user overrides, add an indication to the report title @@ -143,7 +142,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r where multiperiod = interval_ /= NoInterval -- make a CompoundBalanceReport. - cbr' = compoundBalanceReport today ropts' j cbcqueries + cbr' = compoundBalanceReport ropts' j cbcqueries cbr = cbr'{cbrTitle=title} -- render appropriately diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index e9fc21965..8e9ab1c71 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -151,10 +151,9 @@ main = do dbgIO "isInternalCommand" isInternalCommand dbgIO "isExternalCommand" isExternalCommand dbgIO "isBadCommand" isBadCommand - d <- getCurrentDay dbgIO "period from opts" (period_ $ reportopts_ opts) dbgIO "interval from opts" (interval_ $ reportopts_ opts) - dbgIO "query from opts & args" (queryFromOpts d $ reportopts_ opts) + dbgIO "query from opts & args" (query_ $ reportopts_ opts) let journallesserror = error "journal-less command tried to use the journal" runHledgerCommand