From 20bc386b802640ae043fc50de331107ec35b57f0 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 23 May 2019 22:12:12 -0700 Subject: [PATCH] restore TransactionsReport hledger-web's register chart uses it, I didn't see it because it's called from a hamlet template. --- hledger-lib/Hledger/Reports.hs | 2 + .../Hledger/Reports/TransactionsReport.hs | 110 ++++++++++++++++++ hledger-lib/hledger-lib.cabal | 5 +- hledger-lib/package.yaml | 1 + hledger-web/Hledger/Web/Handler/RegisterR.hs | 28 ++--- 5 files changed, 131 insertions(+), 15 deletions(-) create mode 100644 hledger-lib/Hledger/Reports/TransactionsReport.hs diff --git a/hledger-lib/Hledger/Reports.hs b/hledger-lib/Hledger/Reports.hs index b51612935..d61fcc242 100644 --- a/hledger-lib/Hledger/Reports.hs +++ b/hledger-lib/Hledger/Reports.hs @@ -13,6 +13,7 @@ module Hledger.Reports ( module Hledger.Reports.ReportTypes, module Hledger.Reports.EntriesReport, module Hledger.Reports.PostingsReport, + module Hledger.Reports.TransactionsReport, module Hledger.Reports.AccountTransactionsReport, module Hledger.Reports.BalanceReport, module Hledger.Reports.MultiBalanceReports, @@ -27,6 +28,7 @@ import Hledger.Reports.ReportTypes import Hledger.Reports.AccountTransactionsReport import Hledger.Reports.EntriesReport import Hledger.Reports.PostingsReport +import Hledger.Reports.TransactionsReport import Hledger.Reports.BalanceReport import Hledger.Reports.MultiBalanceReports import Hledger.Reports.BudgetReport 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 96e3273ec..8bee216d2 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: 953c47a260da3c57cb7ec2aa2a10e868e3986c38241785fec87ffadc3583fadb +-- hash: ffd57f3b3365e927bfb79cb1bfe2ff6081fcd89b12d8a6fda4b6e254817b7ba7 name: hledger-lib version: 1.14.99 @@ -84,6 +84,7 @@ library Hledger.Reports.EntriesReport Hledger.Reports.MultiBalanceReports Hledger.Reports.PostingsReport + Hledger.Reports.TransactionsReport Hledger.Utils Hledger.Utils.Color Hledger.Utils.Debug @@ -184,6 +185,7 @@ test-suite doctests Hledger.Reports.PostingsReport Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes + Hledger.Reports.TransactionsReport Hledger.Utils Hledger.Utils.Color Hledger.Utils.Debug @@ -285,6 +287,7 @@ test-suite easytests Hledger.Reports.PostingsReport Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes + Hledger.Reports.TransactionsReport Hledger.Utils Hledger.Utils.Color Hledger.Utils.Debug diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 2170c9bd9..29861e9b0 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -137,6 +137,7 @@ library: - Hledger.Reports.EntriesReport - Hledger.Reports.MultiBalanceReports - Hledger.Reports.PostingsReport + - Hledger.Reports.TransactionsReport - Hledger.Utils - Hledger.Utils.Color - Hledger.Utils.Debug diff --git a/hledger-web/Hledger/Web/Handler/RegisterR.hs b/hledger-web/Hledger/Web/Handler/RegisterR.hs index a424c4007..5c663f4d5 100644 --- a/hledger-web/Hledger/Web/Handler/RegisterR.hs +++ b/hledger-web/Hledger/Web/Handler/RegisterR.hs @@ -38,20 +38,20 @@ getRegisterR = do setTitle "register - hledger-web" $(widgetFile "register") --- -- | Generate javascript/html for a register balance line chart based on --- -- the provided "TransactionsReportItem"s. --- registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute --- registerChartHtml percommoditytxnreports = $(hamletFile "templates/chart.hamlet") --- -- have to make sure plot is not called when our container (maincontent) --- -- is hidden, eg with add form toggled --- where --- charttitle = case maybe "" (fst . snd) $ listToMaybe percommoditytxnreports of --- "" -> "" --- s -> s <> ":" --- colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex --- commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)] --- simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts --- shownull c = if null c then " " else c +-- | Generate javascript/html for a register balance line chart based on +-- the provided "TransactionsReportItem"s. +registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute +registerChartHtml percommoditytxnreports = $(hamletFile "templates/chart.hamlet") + -- have to make sure plot is not called when our container (maincontent) + -- is hidden, eg with add form toggled + where + charttitle = case maybe "" (fst . snd) $ listToMaybe percommoditytxnreports of + "" -> "" + s -> s <> ":" + colorForCommodity = fromMaybe 0 . flip lookup commoditiesIndex + commoditiesIndex = zip (map fst percommoditytxnreports) [0..] :: [(CommoditySymbol,Int)] + simpleMixedAmountQuantity = maybe 0 aquantity . listToMaybe . amounts + shownull c = if null c then " " else c dayToJsTimestamp :: Day -> Integer dayToJsTimestamp d =