1{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-}
2{-|
3
4A transactions report. Like an EntriesReport, but with more
5information such as a running balance.
6
7-}
8
9module Hledger.Reports.TransactionsReport (
10  TransactionsReport,
11  TransactionsReportItem,
12  transactionsReport,
13  transactionsReportByCommodity,
14  triOrigTransaction,
15  triDate,
16  triAmount,
17  triBalance,
18  triCommodityAmount,
19  triCommodityBalance,
20  tests_TransactionsReport
21)
22where
23
24import Data.List
25import Data.List.Extra (nubSort)
26import Data.Ord
27
28import Hledger.Data
29import Hledger.Query
30import Hledger.Reports.ReportOptions
31import Hledger.Reports.AccountTransactionsReport
32import Hledger.Utils
33
34
35-- | A transactions report includes a list of transactions touching multiple accounts
36-- (posting-filtered and unfiltered variants), a running balance, and some
37-- other information helpful for rendering a register view (a flag
38-- indicating multiple other accounts and a display string describing
39-- them) with or without a notion of current account(s).
40-- Two kinds of report use this data structure, see transactionsReport
41-- and accountTransactionsReport below for details.
42type TransactionsReport = (String                   -- label for the balance column, eg "balance" or "total"
43                          ,[TransactionsReportItem] -- line items, one per transaction
44                          )
45type TransactionsReportItem = (Transaction -- the original journal transaction, unmodified
46                              ,Transaction -- the transaction as seen from a particular account, with postings maybe filtered
47                              ,Bool        -- is this a split, ie more than one other account posting
48                              ,String      -- a display string describing the other account(s), if any
49                              ,MixedAmount -- the amount posted to the current account(s) by the filtered postings (or total amount posted)
50                              ,MixedAmount -- the running total of item amounts, starting from zero;
51                                           -- or with --historical, the running total including items
52                                           -- (matched by the report query) preceding the report period
53                              )
54
55triOrigTransaction (torig,_,_,_,_,_) = torig
56triDate (_,tacct,_,_,_,_) = tdate tacct
57triAmount (_,_,_,_,a,_) = a
58triBalance (_,_,_,_,_,a) = a
59triCommodityAmount c = filterMixedAmountByCommodity c  . triAmount
60triCommodityBalance c = filterMixedAmountByCommodity c  . triBalance
61
62totallabel   = "Period Total"
63
64-- | Select transactions from the whole journal. This is similar to a
65-- "postingsReport" except with transaction-based report items which
66-- are ordered most recent first. XXX Or an EntriesReport - use that instead ?
67-- This is used by hledger-web's journal view.
68transactionsReport :: ReportOpts -> Journal -> Query -> TransactionsReport
69transactionsReport opts j q = (totallabel, items)
70   where
71     -- XXX items' first element should be the full transaction with all postings
72     items = reverse $ accountTransactionsReportItems q None nullmixedamt id ts
73     ts    = sortBy (comparing date) $ filter (q `matchesTransaction`) $ jtxns $ journalSelectingAmountFromOpts opts j
74     date  = transactionDateFn opts
75
76-- | Split a transactions report whose items may involve several commodities,
77-- into one or more single-commodity transactions reports.
78transactionsReportByCommodity :: TransactionsReport -> [(CommoditySymbol, TransactionsReport)]
79transactionsReportByCommodity tr =
80  [(c, filterTransactionsReportByCommodity c tr) | c <- transactionsReportCommodities tr]
81  where
82    transactionsReportCommodities (_,items) =
83      nubSort . map acommodity $ concatMap (amounts . triAmount) items
84
85-- Remove transaction report items and item amount (and running
86-- balance amount) components that don't involve the specified
87-- commodity. Other item fields such as the transaction are left unchanged.
88filterTransactionsReportByCommodity :: CommoditySymbol -> TransactionsReport -> TransactionsReport
89filterTransactionsReportByCommodity c (label,items) =
90  (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items])
91  where
92    filterTransactionsReportItemByCommodity c (t,t2,s,o,a,bal)
93      | c `elem` cs = [item']
94      | otherwise   = []
95      where
96        cs = map acommodity $ amounts a
97        item' = (t,t2,s,o,a',bal)
98        a' = filterMixedAmountByCommodity c a
99
100    fixTransactionsReportItemBalances [] = []
101    fixTransactionsReportItemBalances [i] = [i]
102    fixTransactionsReportItemBalances items = reverse $ i:(go startbal is)
103      where
104        i:is = reverse items
105        startbal = filterMixedAmountByCommodity c $ triBalance i
106        go _ [] = []
107        go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is
108          where bal' = bal + amt
109
110-- tests
111
112tests_TransactionsReport = tests "TransactionsReport" [
113 ]
114