diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 7fa4813dc..d544559a0 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -19,8 +19,10 @@ module Hledger.Data.Journal ( journalConvertAmountsToCost, journalFinalise, -- * Filtering - filterJournalPostings, filterJournalTransactions, + filterJournalPostings, + filterJournalPostingAmounts, + filterPostingAmount, -- * Querying journalAccountNames, journalAccountNamesUsed, @@ -28,6 +30,7 @@ module Hledger.Data.Journal ( journalAmounts, -- journalCanonicalCommodities, journalDateSpan, + journalDescriptions, journalFilePath, journalFilePaths, journalPostings, @@ -153,13 +156,19 @@ addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 } addTimeLogEntry :: TimeLogEntry -> Journal -> Journal addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 } +-- | Unique transaction descriptions used in this journal. +journalDescriptions :: Journal -> [String] +journalDescriptions = nub . sort . map tdescription . jtxns + +-- | All postings from this journal's transactions, in order. journalPostings :: Journal -> [Posting] journalPostings = concatMap tpostings . jtxns --- | All account names used in this journal. +-- | Unique account names posted to in this journal. journalAccountNamesUsed :: Journal -> [AccountName] journalAccountNamesUsed = sort . accountNamesFromPostings . journalPostings +-- | Unique account names in this journal, including parent accounts containing no postings. journalAccountNames :: Journal -> [AccountName] journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed @@ -228,6 +237,17 @@ filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map filtertransactionposti where filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} +-- Within each posting's amount, keep only the parts matching the query. +-- This can leave unbalanced transactions. +filterJournalPostingAmounts :: Query -> Journal -> Journal +filterJournalPostingAmounts q j@Journal{jtxns=ts} = j{jtxns=map filtertransactionpostings ts} + where + filtertransactionpostings t@Transaction{tpostings=ps} = t{tpostings=map (filterPostingAmount q) ps} + +-- | Filter out all parts of this posting's amount which do not match the query. +filterPostingAmount :: Query -> Posting -> Posting +filterPostingAmount q p@Posting{pamount=Mixed as} = p{pamount=Mixed $ filter (q `matchesAmount`) as} + -- | Keep only transactions matching the query expression. filterJournalTransactions :: Query -> Journal -> Journal filterJournalTransactions q j@Journal{jtxns=ts} = j{jtxns=filter (q `matchesTransaction`) ts} diff --git a/hledger-lib/Hledger/Data/Ledger.hs b/hledger-lib/Hledger/Data/Ledger.hs index 24bf175ba..dfd73dd90 100644 --- a/hledger-lib/Hledger/Data/Ledger.hs +++ b/hledger-lib/Hledger/Data/Ledger.hs @@ -19,6 +19,7 @@ import Hledger.Data.Account import Hledger.Data.Journal import Hledger.Data.Posting import Hledger.Query +import Hledger.Utils instance Show Ledger where @@ -35,16 +36,19 @@ nullledger = Ledger { laccounts = [] } --- | Filter a journal's transactions with the given query, then derive a --- ledger containing the chart of accounts and balances. If the query --- includes a depth limit, that will affect the ledger's journal but not --- the account tree. +-- | Filter a journal's transactions with the given query, then derive +-- a ledger containing the chart of accounts and balances. If the +-- query includes a depth limit, that will affect the this ledger's +-- journal but not the ledger's account tree. ledgerFromJournal :: Query -> Journal -> Ledger ledgerFromJournal q j = nullledger{ljournal=j'', laccounts=as} where (q',depthq) = (filterQuery (not . queryIsDepth) q, filterQuery queryIsDepth q) - j' = filterJournalPostings q' j - as = accountsFromPostings $ journalPostings j' + j' = + dbg "ledgerFromJournal1" $ + filterJournalPostingAmounts (filterQuery queryIsSym q) $ -- remove amount parts which the query's sym: terms would exclude + filterJournalPostings q' j + as = accountsFromPostings $ journalPostings j' j'' = filterJournalPostings depthq j' -- | List a ledger's account names. diff --git a/hledger-lib/Hledger/Query.hs b/hledger-lib/Hledger/Query.hs index 2f26806a4..8ed2d0551 100644 --- a/hledger-lib/Hledger/Query.hs +++ b/hledger-lib/Hledger/Query.hs @@ -16,9 +16,11 @@ module Hledger.Query ( filterQuery, -- * accessors queryIsNull, + queryIsAcct, queryIsDepth, queryIsDate, queryIsStartDateOnly, + queryIsSym, queryStartDate, queryDateSpan, queryDepth, @@ -26,9 +28,10 @@ module Hledger.Query ( inAccount, inAccountQuery, -- * matching - matchesAccount, - matchesPosting, matchesTransaction, + matchesPosting, + matchesAccount, + matchesAmount, -- * tests tests_Hledger_Query ) @@ -391,6 +394,10 @@ queryIsAcct :: Query -> Bool queryIsAcct (Acct _) = True queryIsAcct _ = False +queryIsSym :: Query -> Bool +queryIsSym (Sym _) = True +queryIsSym _ = False + -- | Does this query specify a start date and nothing else (that would -- filter postings prior to the date) ? -- When the flag is true, look for a starting secondary date instead. @@ -517,6 +524,25 @@ tests_matchesAccount = [ assertBool "" $ not $ (Tag "a" Nothing) `matchesAccount` "a" ] +-- | Does the match expression match this (simple) amount ? +matchesAmount :: Query -> Amount -> Bool +matchesAmount (Not q) a = not $ q `matchesAmount` a +matchesAmount (Any) _ = True +matchesAmount (None) _ = False +matchesAmount (Or qs) a = any (`matchesAmount` a) qs +matchesAmount (And qs) a = all (`matchesAmount` a) qs +matchesAmount (Amt op n) a = compareMixedAmount op n (Mixed [a]) +matchesAmount (Sym r) a = regexMatchesCI ("^" ++ r ++ "$") $ acommodity a +matchesAmount _ _ = True + +-- | Is this simple mixed amount's quantity less than, equal to, or greater than this number ? +-- For complext mixed amounts (with multiple commodities), this is always true. +compareMixedAmount :: Ordering -> Quantity -> MixedAmount -> Bool +compareMixedAmount op q (Mixed []) = compareMixedAmount op q (Mixed [amount]) +-- compareMixedAmount op q (Mixed [a]) = strace (compare (strace $ aquantity a) (strace q)) == op +compareMixedAmount op q (Mixed [a]) = compare (aquantity a) q == op +compareMixedAmount _ _ _ = True + -- | Does the match expression match this posting ? matchesPosting :: Query -> Posting -> Bool matchesPosting (Not q) p = not $ q `matchesPosting` p @@ -542,14 +568,6 @@ matchesPosting (Tag n Nothing) p = isJust $ lookupTagByName n $ postingAllTags p matchesPosting (Tag n (Just v)) p = isJust $ lookupTagByNameAndValue (n,v) $ postingAllTags p -- matchesPosting _ _ = False --- | Is this simple mixed amount's quantity less than, equal to, or greater than this number ? --- For complext mixed amounts (with multiple commodities), this is always true. -compareMixedAmount :: Ordering -> Quantity -> MixedAmount -> Bool -compareMixedAmount op q (Mixed []) = compareMixedAmount op q (Mixed [amount]) --- compareMixedAmount op q (Mixed [a]) = strace (compare (strace $ aquantity a) (strace q)) == op -compareMixedAmount op q (Mixed [a]) = compare (aquantity a) q == op -compareMixedAmount _ _ _ = True - tests_matchesPosting = [ "matchesPosting" ~: do -- matching posting status.. diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index 85fe18979..d56f0e2d0 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -315,11 +315,19 @@ postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $ wd = whichDateFromOpts opts -- delay depth filtering until the end (depth, q') = (queryDepth q, filterQuery (not . queryIsDepth) q) - (precedingps, displayableps, _) = dbg "ps4" $ postingsMatchingDisplayExpr displayexpr opts - $ dbg "ps3" $ (if related_ opts then concatMap relatedPostings else id) - $ dbg "ps2" $ filter (q' `matchesPosting`) - $ dbg "ps1" $ journalPostings j' - -- enable to debug just this function + (precedingps, displayableps, _) = + dbg "ps5" $ + postingsMatchingDisplayExpr displayexpr opts $ -- filter and group by the -d display expression + dbg "ps4" $ + map (filterPostingAmount (filterQuery queryIsSym q)) $ -- remove amount parts which the query's sym: terms would exclude + dbg "ps3" $ + (if related_ opts then concatMap relatedPostings else id) $ -- with --related, replace each with its sibling postings + dbg "ps2" $ + filter (q' `matchesPosting`) $ -- filter postings by the query, ignoring depth + dbg "ps1" $ + journalPostings j' + + -- to debug just this function without the noise of --debug, uncomment: -- dbg :: Show a => String -> a -> a -- dbg = lstrace @@ -530,6 +538,10 @@ filterTransactionsReportByCommodity c (label,items) = filterMixedAmountByCommodity :: Commodity -> MixedAmount -> MixedAmount filterMixedAmountByCommodity c (Mixed as) = Mixed $ filter ((==c). acommodity) as +-- -- | Filter out all parts of this amount which do not match the query. +-- filterMixedAmount :: Query -> MixedAmount -> MixedAmount +-- filterMixedAmount q (Mixed as) = Mixed $ filter (q `matchesAmount`) as + -- | Select transactions from the whole journal. This is similar to a -- "postingsReport" except with transaction-based report items which -- are ordered most recent first. This is used by eg hledger-web's journal view. @@ -649,7 +661,10 @@ balanceReport :: ReportOpts -> Query -> Journal -> BalanceReport balanceReport opts q j = (items, total) where l = ledgerFromJournal q $ journalSelectingAmountFromOpts opts j - accts = clipAccounts (queryDepth q) $ ledgerRootAccount l + accts = + dbg "accts1" $ + clipAccounts (queryDepth q) $ -- exclude accounts deeper than specified depth + ledgerRootAccount l accts' | flat_ opts = filterzeros $ tail $ flattenAccounts accts | otherwise = filter (not.aboring) $ tail $ flattenAccounts $ markboring $ prunezeros accts @@ -664,6 +679,11 @@ balanceReport opts q j = (items, total) total = sum [amt | (a,_,indent,amt) <- items, if flat_ opts then accountNameLevel a == 1 else indent == 0] -- XXX check account level == 1 is valid when top-level accounts excluded +-- -- | Filter out parts of this accounts balance amounts which do not match the query. +-- filterAccountAmounts :: Query -> Account -> Account +-- filterAccountAmounts q acc@Account{..} = +-- acc{aebalance=filterMixedAmount q aebalance, aibalance=filterMixedAmount q aibalance} + -- | In an account tree with zero-balance leaves removed, mark the -- elidable parent accounts (those with one subaccount and no balance -- of their own).