diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index d53dd379b..979c034ac 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -13,7 +13,8 @@ module Hledger.Reports ( module Hledger.Reports.ReportTypes, module Hledger.Reports.EntriesReport, module Hledger.Reports.PostingsReport, - module Hledger.Reports.TransactionsReports, + module Hledger.Reports.TransactionsReport, + module Hledger.Reports.AccountTransactionsReport, module Hledger.Reports.BalanceReport, module Hledger.Reports.MultiBalanceReports, module Hledger.Reports.BudgetReport, @@ -27,7 +28,8 @@ import Hledger.Reports.ReportOptions import Hledger.Reports.ReportTypes import Hledger.Reports.EntriesReport import Hledger.Reports.PostingsReport -import Hledger.Reports.TransactionsReports +import Hledger.Reports.TransactionsReport +import Hledger.Reports.AccountTransactionsReport import Hledger.Reports.BalanceReport import Hledger.Reports.MultiBalanceReports import Hledger.Reports.BudgetReport @@ -41,5 +43,6 @@ tests_Reports = tests "Reports" [ ,tests_MultiBalanceReports ,tests_PostingsReport ,tests_ReportOptions - ,tests_TransactionsReports + ,tests_TransactionsReport + ,tests_AccountTransactionsReport ] diff --git a/hledger-lib/Hledger/Reports/TransactionsReports.hs b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs similarity index 61% rename from hledger-lib/Hledger/Reports/TransactionsReports.hs rename to hledger-lib/Hledger/Reports/AccountTransactionsReport.hs index ff8a712ab..7c7849bf8 100644 --- a/hledger-lib/Hledger/Reports/TransactionsReports.hs +++ b/hledger-lib/Hledger/Reports/AccountTransactionsReport.hs @@ -1,35 +1,24 @@ {-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} {-| -Here are several variants of a transactions report. -Transactions reports are like a postings report, but more -transaction-oriented, and (in the account-centric variant) relative to -a some base account. They are used by hledger-web. +An account-centric transactions report. -} -module Hledger.Reports.TransactionsReports ( - TransactionsReport, - TransactionsReportItem, +module Hledger.Reports.AccountTransactionsReport ( AccountTransactionsReport, AccountTransactionsReportItem, - triOrigTransaction, - triDate, - triAmount, - triBalance, - triCommodityAmount, - triCommodityBalance, - journalTransactionsReport, accountTransactionsReport, - transactionsReportByCommodity, + accountTransactionsReportItems, transactionRegisterDate, - tests_TransactionsReports + totallabel, + balancelabel, + tests_AccountTransactionsReport ) where import Data.List import Data.Ord --- import Data.Text (Text) import qualified Data.Text as T import Data.Time.Calendar @@ -39,49 +28,6 @@ import Hledger.Reports.ReportOptions import Hledger.Utils --- | A transactions report includes a list of transactions --- (posting-filtered and unfiltered variants), a running balance, and some --- other information helpful for rendering a register view (a flag --- indicating multiple other accounts and a display string describing --- them) with or without a notion of current account(s). --- Two kinds of report use this data structure, see journalTransactionsReport --- and accountTransactionsReport below for details. -type TransactionsReport = (String -- label for the balance column, eg "balance" or "total" - ,[TransactionsReportItem] -- line items, one per transaction - ) -type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified - ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered - ,Bool -- is this a split, ie more than one other account posting - ,String -- a display string describing the other account(s), if any - ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted) - ,MixedAmount -- the running total of item amounts, starting from zero; - -- or with --historical, the running total including items - -- (matched by the report query) preceding the report period - ) - -triOrigTransaction (torig,_,_,_,_,_) = torig -triDate (_,tacct,_,_,_,_) = tdate tacct -triAmount (_,_,_,_,a,_) = a -triBalance (_,_,_,_,_,a) = a -triCommodityAmount c = filterMixedAmountByCommodity c . triAmount -triCommodityBalance c = filterMixedAmountByCommodity c . triBalance - -------------------------------------------------------------------------------- - --- | Select transactions from the whole journal. This is similar to a --- "postingsReport" except with transaction-based report items which --- are ordered most recent first. XXX Or an EntriesReport - use that instead ? --- This is used by hledger-web's journal view. -journalTransactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport -journalTransactionsReport opts j q = (totallabel, items) - 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 $ journalSelectingAmountFromOpts opts j - date = transactionDateFn opts - -------------------------------------------------------------------------------- - -- | An account transactions report represents transactions affecting -- a particular account (or possibly several accounts, but we don't -- use that). It is used eg by hledger-ui's and hledger-web's account @@ -133,6 +79,9 @@ type AccountTransactionsReportItem = ,MixedAmount -- the register's running total or the current account(s)'s historical balance, after this transaction ) +totallabel = "Period Total" +balancelabel = "Historical Total" + accountTransactionsReport :: ReportOpts -> Journal -> Query -> Query -> AccountTransactionsReport accountTransactionsReport opts j reportq thisacctq = (label, items) where @@ -171,20 +120,17 @@ accountTransactionsReport opts j reportq thisacctq = (label, items) items = reverse $ -- see also registerChartHtml accountTransactionsReportItems reportq' thisacctq startbal negate ts -totallabel = "Period Total" -balancelabel = "Historical Total" - -- | 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 journalTransactionsReport. -accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [TransactionsReportItem] +-- query, this can also be used for the transactionsReport. +accountTransactionsReportItems :: Query -> Query -> MixedAmount -> (MixedAmount -> MixedAmount) -> [Transaction] -> [AccountTransactionsReportItem] accountTransactionsReportItems _ _ _ _ [] = [] accountTransactionsReportItems reportq thisacctq bal signfn (torig:ts) = case i of Just i' -> i':is Nothing -> is - -- 201403: This is used for both accountTransactionsReport and journalTransactionsReport, which makes it a bit overcomplicated + -- 201403: This is used for both accountTransactionsReport and transactionsReport, which makes it a bit overcomplicated -- 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 where @@ -238,45 +184,7 @@ summarisePostingAccounts ps = displayps | null realps = ps | otherwise = realps -------------------------------------------------------------------------------- - --- | Split a transactions report whose items may involve several commodities, --- into one or more single-commodity transactions reports. -transactionsReportByCommodity :: TransactionsReport -> [(CommoditySymbol, TransactionsReport)] -transactionsReportByCommodity tr = - [(c, filterTransactionsReportByCommodity c tr) | c <- transactionsReportCommodities tr] - where - transactionsReportCommodities (_,items) = - nub $ sort $ map acommodity $ concatMap (amounts . triAmount) items - --- Remove transaction report items and item amount (and running --- balance amount) components that don't involve the specified --- commodity. Other item fields such as the transaction are left unchanged. -filterTransactionsReportByCommodity :: CommoditySymbol -> TransactionsReport -> TransactionsReport -filterTransactionsReportByCommodity c (label,items) = - (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items]) - where - filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal) - | c `elem` cs = [item'] - | otherwise = [] - where - cs = map acommodity $ amounts a - item' = (t,t2,s,o,a',bal) - a' = filterMixedAmountByCommodity c a - - fixTransactionsReportItemBalances [] = [] - fixTransactionsReportItemBalances [i] = [i] - fixTransactionsReportItemBalances items = reverse $ i:(go startbal is) - where - i:is = reverse items - startbal = filterMixedAmountByCommodity c $ triBalance i - go _ [] = [] - go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is - where bal' = bal + amt - -------------------------------------------------------------------------------- - -- tests -tests_TransactionsReports = tests "TransactionsReports" [ +tests_AccountTransactionsReport = tests "AccountTransactionsReport" [ ] diff --git a/hledger-lib/Hledger/Reports/BalanceHistoryReport.hs b/hledger-lib/Hledger/Reports/BalanceHistoryReport.hs index 8f3937fb4..a11628763 100644 --- a/hledger-lib/Hledger/Reports/BalanceHistoryReport.hs +++ b/hledger-lib/Hledger/Reports/BalanceHistoryReport.hs @@ -16,7 +16,7 @@ import Data.Time.Calendar import Hledger.Data import Hledger.Query import Hledger.Reports.ReportOptions -import Hledger.Reports.TransactionsReports +import Hledger.Reports.TransactionsReport -- | Get the historical running inclusive balance of a particular account, @@ -24,7 +24,7 @@ import Hledger.Reports.TransactionsReports accountBalanceHistory :: ReportOpts -> Journal -> Account -> [(Day, MixedAmount)] accountBalanceHistory ropts j a = [(getdate t, bal) | (t,_,_,_,_,bal) <- items] where - (_,items) = journalTransactionsReport ropts j acctquery + (_,items) = transactionsReport ropts j acctquery inclusivebal = True acctquery = Acct $ (if inclusivebal then accountNameToAccountRegex else accountNameToAccountOnlyRegex) $ aname a getdate = if date2_ ropts then transactionDate2 else tdate diff --git a/hledger-lib/Hledger/Reports/TransactionsReport.hs b/hledger-lib/Hledger/Reports/TransactionsReport.hs new file mode 100644 index 000000000..2e4da4d3e --- /dev/null +++ b/hledger-lib/Hledger/Reports/TransactionsReport.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, FlexibleInstances #-} +{-| + +A transactions report. Like an EntriesReport, but with more +information such as a running balance. + +-} + +module Hledger.Reports.TransactionsReport ( + TransactionsReport, + TransactionsReportItem, + transactionsReport, + transactionsReportByCommodity, + triOrigTransaction, + triDate, + triAmount, + triBalance, + triCommodityAmount, + triCommodityBalance, + tests_TransactionsReport +) +where + +import Data.List +import Data.Ord + +import Hledger.Data +import Hledger.Query +import Hledger.Reports.ReportOptions +import Hledger.Reports.AccountTransactionsReport +import Hledger.Utils + + +-- | A transactions report includes a list of transactions touching multiple accounts +-- (posting-filtered and unfiltered variants), a running balance, and some +-- other information helpful for rendering a register view (a flag +-- indicating multiple other accounts and a display string describing +-- them) with or without a notion of current account(s). +-- Two kinds of report use this data structure, see transactionsReport +-- and accountTransactionsReport below for details. +type TransactionsReport = (String -- label for the balance column, eg "balance" or "total" + ,[TransactionsReportItem] -- line items, one per transaction + ) +type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified + ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered + ,Bool -- is this a split, ie more than one other account posting + ,String -- a display string describing the other account(s), if any + ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted) + ,MixedAmount -- the running total of item amounts, starting from zero; + -- or with --historical, the running total including items + -- (matched by the report query) preceding the report period + ) + +triOrigTransaction (torig,_,_,_,_,_) = torig +triDate (_,tacct,_,_,_,_) = tdate tacct +triAmount (_,_,_,_,a,_) = a +triBalance (_,_,_,_,_,a) = a +triCommodityAmount c = filterMixedAmountByCommodity c . triAmount +triCommodityBalance c = filterMixedAmountByCommodity c . triBalance + +-- | Select transactions from the whole journal. This is similar to a +-- "postingsReport" except with transaction-based report items which +-- are ordered most recent first. XXX Or an EntriesReport - use that instead ? +-- This is used by hledger-web's journal view. +transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport +transactionsReport opts j q = (totallabel, items) + 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 $ journalSelectingAmountFromOpts opts j + date = transactionDateFn opts + +-- | Split a transactions report whose items may involve several commodities, +-- into one or more single-commodity transactions reports. +transactionsReportByCommodity :: TransactionsReport -> [(CommoditySymbol, TransactionsReport)] +transactionsReportByCommodity tr = + [(c, filterTransactionsReportByCommodity c tr) | c <- transactionsReportCommodities tr] + where + transactionsReportCommodities (_,items) = + nub $ sort $ map acommodity $ concatMap (amounts . triAmount) items + +-- Remove transaction report items and item amount (and running +-- balance amount) components that don't involve the specified +-- commodity. Other item fields such as the transaction are left unchanged. +filterTransactionsReportByCommodity :: CommoditySymbol -> TransactionsReport -> TransactionsReport +filterTransactionsReportByCommodity c (label,items) = + (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items]) + where + filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal) + | c `elem` cs = [item'] + | otherwise = [] + where + cs = map acommodity $ amounts a + item' = (t,t2,s,o,a',bal) + a' = filterMixedAmountByCommodity c a + + fixTransactionsReportItemBalances [] = [] + fixTransactionsReportItemBalances [i] = [i] + fixTransactionsReportItemBalances items = reverse $ i:(go startbal is) + where + i:is = reverse items + startbal = filterMixedAmountByCommodity c $ triBalance i + go _ [] = [] + go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is + where bal' = bal + amt + +-- tests + +tests_TransactionsReport = tests "TransactionsReport" [ + ] diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 5491498a7..c3a927774 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: f1dea3e636e26f58a16c43e3cb9cb21b86dda529b11f5c3580e04ec7bfd20121 +-- hash: f11088bf1233291fabff38353e1bb342fafd2586510fc84418e17a1eebda505d name: hledger-lib version: 1.14.99 @@ -84,7 +84,8 @@ library Hledger.Reports.EntriesReport Hledger.Reports.MultiBalanceReports Hledger.Reports.PostingsReport - Hledger.Reports.TransactionsReports + Hledger.Reports.TransactionsReport + Hledger.Reports.AccountTransactionsReport Hledger.Utils Hledger.Utils.Color Hledger.Utils.Debug @@ -177,6 +178,7 @@ test-suite doctests Hledger.Read.TimeclockReader Hledger.Read.TimedotReader Hledger.Reports + Hledger.Reports.AccountTransactionsReport Hledger.Reports.BalanceHistoryReport Hledger.Reports.BalanceReport Hledger.Reports.BudgetReport @@ -185,7 +187,7 @@ test-suite doctests Hledger.Reports.PostingsReport Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes - Hledger.Reports.TransactionsReports + Hledger.Reports.TransactionsReport Hledger.Utils Hledger.Utils.Color Hledger.Utils.Debug @@ -279,6 +281,7 @@ test-suite easytests Hledger.Read.TimeclockReader Hledger.Read.TimedotReader Hledger.Reports + Hledger.Reports.AccountTransactionsReport Hledger.Reports.BalanceHistoryReport Hledger.Reports.BalanceReport Hledger.Reports.BudgetReport @@ -287,7 +290,7 @@ test-suite easytests Hledger.Reports.PostingsReport Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes - Hledger.Reports.TransactionsReports + Hledger.Reports.TransactionsReport Hledger.Utils Hledger.Utils.Color Hledger.Utils.Debug diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 176d51935..9d343fb50 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -137,7 +137,8 @@ library: - Hledger.Reports.EntriesReport - Hledger.Reports.MultiBalanceReports - Hledger.Reports.PostingsReport - - Hledger.Reports.TransactionsReports + - Hledger.Reports.TransactionsReport + - Hledger.Reports.AccountTransactionsReport - Hledger.Utils - Hledger.Utils.Color - Hledger.Utils.Debug