diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -9,6 +9,15 @@ Internal/api/developer-ish changes in the hledger-lib (and hledger) packages. For user-visible changes, see the hledger package changelog. +# 1.22.1 2021-08-02 + +- Allow megaparsec 9.1 + +- journalEndDate's behaviour has been clarified, journalLastDay has + been added. + +- transactionCheckBalanced is now exported. (#1596) + # 1.22 2021-07-03 - GHC 9.0 is now officially supported, and GHC 8.0, 8.2, 8.4 are not; diff --git a/Hledger/Data/Journal.hs b/Hledger/Data/Journal.hs --- a/Hledger/Data/Journal.hs +++ b/Hledger/Data/Journal.hs @@ -31,9 +31,11 @@ -- * Filtering filterJournalTransactions, filterJournalPostings, + filterJournalRelatedPostings, filterJournalAmounts, filterTransactionAmounts, filterTransactionPostings, + filterTransactionRelatedPostings, filterPostingAmount, -- * Mapping journalMapTransactions, @@ -60,6 +62,7 @@ journalDateSpanBothDates, journalStartDate, journalEndDate, + journalLastDay, journalDescriptions, journalFilePath, journalFilePaths, @@ -104,7 +107,7 @@ import Data.Function ((&)) import qualified Data.HashTable.Class as H (toList) import qualified Data.HashTable.ST.Cuckoo as H -import Data.List (find, foldl', sortOn) +import Data.List ((\\), find, foldl', sortOn) import Data.List.Extra (nubSort) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe, maybeToList) @@ -516,6 +519,11 @@ filterJournalPostings :: Query -> Journal -> Journal filterJournalPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionPostings q) ts} +-- | Keep only postings which do not match the query expression, but for which a related posting does. +-- This can leave unbalanced transactions. +filterJournalRelatedPostings :: Query -> Journal -> Journal +filterJournalRelatedPostings q j@Journal{jtxns=ts} = j{jtxns=map (filterTransactionRelatedPostings q) ts} + -- | Within each posting's amount, keep only the parts matching the query. -- This can leave unbalanced transactions. filterJournalAmounts :: Query -> Journal -> Journal @@ -533,6 +541,11 @@ filterTransactionPostings :: Query -> Transaction -> Transaction filterTransactionPostings q t@Transaction{tpostings=ps} = t{tpostings=filter (q `matchesPosting`) ps} +filterTransactionRelatedPostings :: Query -> Transaction -> Transaction +filterTransactionRelatedPostings q t@Transaction{tpostings=ps} = + t{tpostings=if null matches then [] else ps \\ matches} + where matches = filter (matchesPosting q) ps + -- | Apply a transformation to a journal's transactions. journalMapTransactions :: (Transaction -> Transaction) -> Journal -> Journal journalMapTransactions f j@Journal{jtxns=ts} = j{jtxns=map f ts} @@ -1316,10 +1329,15 @@ journalStartDate :: Bool -> Journal -> Maybe Day journalStartDate secondary j = b where DateSpan b _ = journalDateSpan secondary j --- | The latest of this journal's transaction and posting dates, or --- Nothing if there are none. +-- | The "exclusive end date" of this journal: the day following its latest transaction +-- or posting date, or Nothing if there are none. journalEndDate :: Bool -> Journal -> Maybe Day journalEndDate secondary j = e where DateSpan _ e = journalDateSpan secondary j + +-- | The latest of this journal's transaction and posting dates, or +-- Nothing if there are none. +journalLastDay :: Bool -> Journal -> Maybe Day +journalLastDay secondary j = addDays (-1) <$> journalEndDate secondary j -- | Apply the pivot transformation to all postings in a journal, -- replacing their account name by their value for the given field or tag. diff --git a/Hledger/Data/Transaction.hs b/Hledger/Data/Transaction.hs --- a/Hledger/Data/Transaction.hs +++ b/Hledger/Data/Transaction.hs @@ -20,6 +20,7 @@ transaction, txnTieKnot, txnUntieKnot, + transactionCheckBalanced, -- * operations showAccountName, hasRealPostings, diff --git a/Hledger/Read.hs b/Hledger/Read.hs --- a/Hledger/Read.hs +++ b/Hledger/Read.hs @@ -191,7 +191,7 @@ requireJournalFileExists f = do exists <- doesFileExist f when (not exists) $ do -- XXX might not be a journal file - hPutStr stderr $ "The hledger journal file \"" <> show f <> "\" was not found.\n" + hPutStr stderr $ "The hledger journal file \"" <> f <> "\" was not found.\n" hPutStr stderr "Please create it first, eg with \"hledger add\" or a text editor.\n" hPutStr stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n" exitFailure diff --git a/Hledger/Reports/AccountTransactionsReport.hs b/Hledger/Reports/AccountTransactionsReport.hs --- a/Hledger/Reports/AccountTransactionsReport.hs +++ b/Hledger/Reports/AccountTransactionsReport.hs @@ -16,12 +16,12 @@ ) where -import Data.List (mapAccumL, nub, partition, sortBy) -import Data.Ord (comparing) +import Data.List (mapAccumR, nub, partition, sortBy) import Data.Maybe (catMaybes) +import Data.Ord (Down(..), comparing) import Data.Text (Text) import qualified Data.Text as T -import Data.Time.Calendar (Day) +import Data.Time.Calendar (Day, addDays) import Hledger.Data import Hledger.Query @@ -79,92 +79,103 @@ ) accountTransactionsReport :: ReportSpec -> Journal -> Query -> Query -> AccountTransactionsReport -accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = items +accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq' thisacctq = items where - -- a depth limit should not affect the account transactions report - -- seems unnecessary for some reason XXX - reportq' = reportq -- filterQuery (not . queryIsDepth) - symq = filterQuery queryIsSym reportq' - realq = filterQuery queryIsReal reportq' - statusq = filterQuery queryIsStatus reportq' + -- A depth limit should not affect the account transactions report; it should show all transactions in/below this account. + -- Queries on currency or amount are also ignored at this stage; they are handled earlier, before valuation. + reportq = simplifyQuery $ And [aregisterq, periodq, excludeforecastq (forecast_ ropts)] + where + aregisterq = filterQuery (not . queryIsCurOrAmt) $ filterQuery (not . queryIsDepth) reportq' + periodq = Date . periodAsDateSpan $ period_ ropts + -- Except in forecast mode, exclude future/forecast transactions. + excludeforecastq (Just _) = Any + excludeforecastq Nothing = -- not:date:tomorrow- not:tag:generated-transaction + And [ Not . Date $ DateSpan (Just . addDays 1 $ rsToday rspec) Nothing + , Not generatedTransactionTag + ] + amtq = filterQuery queryIsCurOrAmt reportq' + queryIsCurOrAmt q = queryIsSym q || queryIsAmt q - -- sort by the transaction's register date, for accurate starting balance - -- these are not yet filtered by tdate, we want to search them all for priorps - transactions = - ptraceAtWith 5 (("ts5:\n"++).pshowTransactions) - . sortBy (comparing (transactionRegisterDate reportq' thisacctq)) - . jtxns - . ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.jtxns) - -- keep just the transactions affecting this account (via possibly realness or status-filtered postings) - . traceAt 3 ("thisacctq: "++show thisacctq) - . ptraceAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns) - . filterJournalTransactions thisacctq - . filterJournalPostings (And [realq, statusq]) - -- apply any cur:SYM filters in reportq' - . ptraceAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns) - . (if queryIsNull symq then id else filterJournalAmounts symq) - -- maybe convert these transactions to cost or value - $ journalApplyValuationFromOpts rspec j + -- Note that within this functions, we are only allowed limited + -- transformation of the transaction postings: this is due to the need to + -- pass the original transactions into accountTransactionsReportItem. + -- Generally, we either include a transaction in full, or not at all. + -- Do some limited filtering and valuing of the journal's transactions: + -- - filter them by the account query if any, + -- - discard amounts not matched by the currency and amount query if any, + -- - then apply valuation if any. + acctJournal = + ptraceAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns) + -- maybe convert these transactions to cost or value + . journalApplyValuationFromOpts rspec + . ptraceAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns) + -- apply any cur:SYM filters in reportq + . (if queryIsNull amtq then id else filterJournalAmounts amtq) + -- only consider transactions which match thisacctq (possibly excluding postings + -- which are not real or have the wrong status) + . traceAt 3 ("thisacctq: "++show thisacctq) + $ ptraceAtWith 5 (("ts1:\n"++).pshowTransactions.jtxns) + j{jtxns = filter (matchesTransaction thisacctq . relevantPostings) $ jtxns j} + where + relevantPostings + | queryIsNull realq && queryIsNull statusq = id + | otherwise = filterTransactionPostings . simplifyQuery $ And [realq, statusq] + realq = filterQuery queryIsReal reportq + statusq = filterQuery queryIsStatus reportq startbal | balancetype_ ropts == HistoricalBalance = sumPostings priorps | otherwise = nullmixedamt where - priorps = dbg5 "priorps" $ - filter (matchesPosting - (dbg5 "priorq" $ - And [thisacctq, tostartdateq, datelessreportq])) - $ transactionsPostings transactions + priorps = dbg5 "priorps" . journalPostings $ filterJournalPostings priorq acctJournal + priorq = dbg5 "priorq" $ And [thisacctq, tostartdateq, datelessreportq] tostartdateq = case mstartdate of Just _ -> Date (DateSpan Nothing mstartdate) Nothing -> None -- no start date specified, there are no prior postings - mstartdate = queryStartDate (date2_ ropts) reportq' - datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq' - - -- accountTransactionsReportItem will keep transactions of any date which have any posting inside the report period. - -- Should we also require that transaction date is inside the report period ? - -- Should we be filtering by reportq here to apply other query terms (?) - -- Make it an option for now. - filtertxns = txn_dates_ ropts + mstartdate = queryStartDate (date2_ ropts) reportq + datelessreportq = filterQuery (not . queryIsDateOrDate2) reportq - items = reverse $ - accountTransactionsReportItems reportq' thisacctq startbal maNegate $ - (if filtertxns then filter (reportq' `matchesTransaction`) else id) $ - transactions + items = + accountTransactionsReportItems reportq thisacctq startbal maNegate + -- sort by the transaction's register date, for accurate starting balance + . ptraceAtWith 5 (("ts4:\n"++).pshowTransactions.map snd) + . sortBy (comparing $ Down . fst) + . map (\t -> (transactionRegisterDate reportq thisacctq t, t)) + $ jtxns acctJournal pshowTransactions :: [Transaction] -> String pshowTransactions = pshow . map (\t -> unwords [show $ tdate t, T.unpack $ tdescription t]) -- | Generate transactions report items from a list of transactions, -- using the provided user-specified report query, a query specifying --- which account to use as the focus, a starting balance, a sign-setting --- function and a balance-summing function. Or with a None current account --- query, this can also be used for the transactionsReport. -accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [AccountTransactionsReportItem] +-- which account to use as the focus, a starting balance, and a sign-setting +-- function. +-- Each transaction is accompanied by the date that should be shown for it +-- in the report, which is not necessarily the transaction date; it is +-- the earliest of the posting dates which match both thisacctq and reportq, +-- otherwise the transaction's date if there are no matching postings. +accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount) + -> [(Day, Transaction)] -> [AccountTransactionsReportItem] accountTransactionsReportItems reportq thisacctq bal signfn = - catMaybes . snd . - mapAccumL (accountTransactionsReportItem reportq thisacctq signfn) bal + catMaybes . snd . mapAccumR (accountTransactionsReportItem reportq thisacctq signfn) bal -accountTransactionsReportItem :: Query -> Query -> (MixedAmount -> MixedAmount) -> MixedAmount -> Transaction -> (MixedAmount, Maybe AccountTransactionsReportItem) -accountTransactionsReportItem reportq thisacctq signfn bal torig = balItem - -- 201403: This is used for both accountTransactionsReport and transactionsReport, which makes it a bit overcomplicated +accountTransactionsReportItem :: Query -> Query -> (MixedAmount -> MixedAmount) -> MixedAmount + -> (Day, Transaction) -> (MixedAmount, Maybe AccountTransactionsReportItem) +accountTransactionsReportItem reportq thisacctq signfn bal (d, torig) -- 201407: I've lost my grip on this, let's just hope for the best -- 201606: we now calculate change and balance from filtered postings, check this still works well for all callers XXX + | null reportps = (bal, Nothing) -- no matched postings in this transaction, skip it + | otherwise = (b, Just (torig, tacct{tdate=d}, numotheraccts > 1, otheracctstr, a, b)) where - tfiltered@Transaction{tpostings=reportps} = filterTransactionPostings reportq torig - tacct = tfiltered{tdate=transactionRegisterDate reportq thisacctq tfiltered} - balItem = case reportps of - [] -> (bal, Nothing) -- no matched postings in this transaction, skip it - _ -> (b, Just (torig, tacct, numotheraccts > 1, otheracctstr, a, b)) - where - (thisacctps, otheracctps) = partition (matchesPosting thisacctq) reportps - numotheraccts = length $ nub $ map paccount otheracctps - otheracctstr | thisacctq == None = summarisePostingAccounts reportps -- no current account ? summarise all matched postings - | numotheraccts == 0 = summarisePostingAccounts thisacctps -- only postings to current account ? summarise those - | otherwise = summarisePostingAccounts otheracctps -- summarise matched postings to other account(s) - a = signfn . maNegate $ sumPostings thisacctps - b = bal `maPlus` a + tacct@Transaction{tpostings=reportps} = filterTransactionPostings reportq torig + (thisacctps, otheracctps) = partition (matchesPosting thisacctq) reportps + numotheraccts = length $ nub $ map paccount otheracctps + otheracctstr | thisacctq == None = summarisePostingAccounts reportps -- no current account ? summarise all matched postings + | numotheraccts == 0 = summarisePostingAccounts thisacctps -- only postings to current account ? summarise those + | otherwise = summarisePostingAccounts otheracctps -- summarise matched postings to other account(s) + a = signfn . maNegate $ sumPostings thisacctps + b = bal `maPlus` a -- | What is the transaction's date in the context of a particular account -- (specified with a query) and report query, as in an account register ? diff --git a/Hledger/Reports/EntriesReport.hs b/Hledger/Reports/EntriesReport.hs --- a/Hledger/Reports/EntriesReport.hs +++ b/Hledger/Reports/EntriesReport.hs @@ -35,8 +35,9 @@ -- | Select transactions for an entries report. entriesReport :: ReportSpec -> Journal -> EntriesReport entriesReport rspec@ReportSpec{rsOpts=ropts} = - sortBy (comparing $ transactionDateFn ropts) . jtxns . filterJournalTransactions (rsQuery rspec) + sortBy (comparing $ transactionDateFn ropts) . jtxns . journalApplyValuationFromOpts rspec{rsOpts=ropts{show_costs_=True}} + . filterJournalTransactions (rsQuery rspec) tests_EntriesReport = tests "EntriesReport" [ tests "entriesReport" [ diff --git a/Hledger/Reports/MultiBalanceReport.hs b/Hledger/Reports/MultiBalanceReport.hs --- a/Hledger/Reports/MultiBalanceReport.hs +++ b/Hledger/Reports/MultiBalanceReport.hs @@ -244,9 +244,9 @@ getPostings rspec@ReportSpec{rsQuery=query,rsOpts=ropts} j priceoracle = map (\p -> (p, date p)) . journalPostings . - filterJournalAmounts symq . -- remove amount parts excluded by cur: - filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query - valuedJournal + valueJournal . + filterJournalAmounts symq $ -- remove amount parts excluded by cur: + filterJournalPostings reportq j -- remove postings not matched by (adjusted) query where symq = dbg3 "symq" . filterQuery queryIsSym $ dbg3 "requested q" query -- The user's query with no depth limit, and expanded to the report span @@ -254,8 +254,8 @@ -- handles the hledger-ui+future txns case above). reportq = dbg3 "reportq" $ depthless query depthless = dbg3 "depthless" . filterQuery (not . queryIsDepth) - valuedJournal | isJust (valuationAfterSum ropts) = j - | otherwise = journalApplyValuationFromOptsWith rspec j priceoracle + valueJournal j' | isJust (valuationAfterSum ropts) = j' + | otherwise = journalApplyValuationFromOptsWith rspec j' priceoracle date = case whichDateFromOpts ropts of PrimaryDate -> postingDate diff --git a/Hledger/Reports/PostingsReport.hs b/Hledger/Reports/PostingsReport.hs --- a/Hledger/Reports/PostingsReport.hs +++ b/Hledger/Reports/PostingsReport.hs @@ -119,21 +119,22 @@ where beforestartq = dbg3 "beforestartq" $ dateqtype $ DateSpan Nothing $ spanStart reportspan beforeandduringps = - 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 $ - journalApplyValuationFromOpts rspec j -- convert to cost and apply valuation + dbg5 "ps5" $ sortOn sortdate $ -- sort postings by date or date2 + dbg5 "ps4" $ (if invert_ ropts then map negatePostingAmount else id) $ -- with --invert, invert amounts + journalPostings $ + journalApplyValuationFromOpts rspec $ -- convert to cost and apply valuation + dbg5 "ps2" $ filterJournalAmounts symq $ -- remove amount parts which the query's cur: terms would exclude + dbg5 "ps1" $ filterJournal beforeandduringq j -- filter postings by the query, with no start date or depth limit + + beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq] where - beforeandduringq = dbg4 "beforeandduringq" $ And [depthless $ dateless q, beforeendq] - where - depthless = filterQuery (not . queryIsDepth) - dateless = filterQuery (not . queryIsDateOrDate2) - beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan - sortdate = if date2_ ropts then postingDate2 else postingDate - symq = dbg4 "symq" $ filterQuery queryIsSym q + depthless = filterQuery (not . queryIsDepth) + dateless = filterQuery (not . queryIsDateOrDate2) + beforeendq = dateqtype $ DateSpan Nothing $ spanEnd reportspan + + sortdate = if date2_ ropts then postingDate2 else postingDate + filterJournal = if related_ ropts then filterJournalRelatedPostings else filterJournalPostings -- with -r, replace each posting with its sibling postings + symq = dbg4 "symq" $ filterQuery queryIsSym q dateqtype | queryIsDate2 dateq || (queryIsDate dateq && date2_ ropts) = Date2 | otherwise = Date diff --git a/Hledger/Reports/ReportOptions.hs b/Hledger/Reports/ReportOptions.hs --- a/Hledger/Reports/ReportOptions.hs +++ b/Hledger/Reports/ReportOptions.hs @@ -636,8 +636,8 @@ reportPeriodOrJournalLastDay rspec j = reportPeriodLastDay rspec <|> journalOrPriceEnd where journalOrPriceEnd = case value_ $ rsOpts rspec of - Just (AtEnd _) -> max (journalEndDate False j) lastPriceDirective - _ -> journalEndDate False j + Just (AtEnd _) -> max (journalLastDay False j) lastPriceDirective + _ -> journalLastDay False j lastPriceDirective = fmap (addDays 1) . maximumMay . map pddate $ jpricedirectives j -- | Make a name for the given period in a multiperiod report, given diff --git a/Hledger/Reports/TransactionsReport.hs b/Hledger/Reports/TransactionsReport.hs --- a/Hledger/Reports/TransactionsReport.hs +++ b/Hledger/Reports/TransactionsReport.hs @@ -66,7 +66,7 @@ where -- XXX items' first element should be the full transaction with all postings items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts - ts = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j + ts = sortBy (comparing fst) $ map (\t -> (date t, t)) $ filter (q `matchesTransaction`) $ jtxns $ journalApplyValuationFromOpts rspec j date = transactionDateFn $ rsOpts rspec -- | Split a transactions report whose items may involve several commodities, diff --git a/hledger-lib.cabal b/hledger-lib.cabal --- a/hledger-lib.cabal +++ b/hledger-lib.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hledger-lib -version: 1.22 +version: 1.22.1 synopsis: A reusable library providing the core functionality of hledger description: A reusable library containing hledger's core functionality. This is used by most hledger* packages so that they support the same @@ -117,7 +117,7 @@ , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 - , megaparsec >=7.0.0 && <9.1 + , megaparsec >=7.0.0 && <9.2 , mtl >=2.2.1 , old-time , parser-combinators >=0.4.0 @@ -167,7 +167,7 @@ , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 - , megaparsec >=7.0.0 && <9.1 + , megaparsec >=7.0.0 && <9.2 , mtl >=2.2.1 , old-time , parser-combinators >=0.4.0 @@ -219,7 +219,7 @@ , filepath , hashtables >=1.2.3.1 , hledger-lib - , megaparsec >=7.0.0 && <9.1 + , megaparsec >=7.0.0 && <9.2 , mtl >=2.2.1 , old-time , parser-combinators >=0.4.0