{-|

Postings report, used by the register command.

-}

{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

module Hledger.Reports.PostingsReport (
  PostingsReport,
  PostingsReportItem,
  postingsReport,
  mkpostingsReportItem,

  -- * Tests
  tests_PostingsReport
)
where

import Data.List (nub, sortOn)
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Text (Text)
import Data.Time.Calendar (Day, addDays)
import Safe (headMay, lastMay)

import Hledger.Data
import Hledger.Query
import Hledger.Utils
import Hledger.Reports.ReportOptions


-- | A postings report is a list of postings with a running total, and a little extra
-- transaction info to help with rendering.
-- This is used eg for the register command.
type PostingsReport = [PostingsReportItem] -- line items, one per posting
type PostingsReportItem = (Maybe Day    -- The posting date, if this is the first posting in a
                                        -- transaction or if it's different from the previous
                                        -- posting's date. Or if this a summary posting, the
                                        -- report interval's start date if this is the first
                                        -- summary posting in the interval.
                          ,Maybe Day    -- If this is a summary posting, the report interval's
                                        -- end date if this is the first summary posting in
                                        -- the interval.
                          ,Maybe Text   -- The posting's transaction's description, if this is the first posting in the transaction.
                          ,Posting      -- The posting, possibly with the account name depth-clipped.
                          ,MixedAmount  -- The running total after this posting, or with --average,
                                        -- the running average posting amount. With --historical,
                                        -- postings before the report start date are included in
                                        -- the running total/average.
                          )

-- | A summary posting summarises the activity in one account within a report
-- interval. It is kludgily represented by a regular Posting with no description,
-- the interval's start date stored as the posting date, and the interval's end
-- date attached with a tuple.
type SummaryPosting = (Posting, Day)

-- | Select postings from the journal and add running balance and other
-- information to make a postings report. Used by eg hledger's register command.
postingsReport :: ReportSpec -> Journal -> PostingsReport
postingsReport :: ReportSpec -> Journal -> PostingsReport
postingsReport rspec :: ReportSpec
rspec@ReportSpec{rsOpts :: ReportSpec -> ReportOpts
rsOpts=ropts :: ReportOpts
ropts@ReportOpts{Bool
Int
[Text]
[Status]
Maybe Int
Maybe NormalSign
Maybe DateSpan
Maybe ValuationType
Interval
Period
StringFormat
Costing
AccountListMode
BalanceType
ReportType
transpose_ :: ReportOpts -> Bool
forecast_ :: ReportOpts -> Maybe DateSpan
color_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
pretty_tables_ :: ReportOpts -> Bool
show_costs_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
balancetype_ :: ReportOpts -> BalanceType
reporttype_ :: ReportOpts -> ReportType
txn_dates_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
format_ :: ReportOpts -> StringFormat
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> Maybe Int
infer_value_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
cost_ :: ReportOpts -> Costing
statuses_ :: ReportOpts -> [Status]
interval_ :: ReportOpts -> Interval
period_ :: ReportOpts -> Period
transpose_ :: Bool
forecast_ :: Maybe DateSpan
color_ :: Bool
normalbalance_ :: Maybe NormalSign
invert_ :: Bool
percent_ :: Bool
sort_amount_ :: Bool
pretty_tables_ :: Bool
show_costs_ :: Bool
no_total_ :: Bool
row_total_ :: Bool
drop_ :: Int
accountlistmode_ :: AccountListMode
balancetype_ :: BalanceType
reporttype_ :: ReportType
txn_dates_ :: Bool
related_ :: Bool
average_ :: Bool
querystring_ :: [Text]
format_ :: StringFormat
real_ :: Bool
no_elide_ :: Bool
empty_ :: Bool
date2_ :: Bool
depth_ :: Maybe Int
infer_value_ :: Bool
value_ :: Maybe ValuationType
cost_ :: Costing
statuses_ :: [Status]
interval_ :: Interval
period_ :: Period
..}} Journal
j = PostingsReport
items
    where
      reportspan :: DateSpan
reportspan  = Journal -> ReportSpec -> DateSpan
reportSpanBothDates Journal
j ReportSpec
rspec
      whichdate :: WhichDate
whichdate   = ReportOpts -> WhichDate
whichDateFromOpts ReportOpts
ropts
      mdepth :: Maybe Int
mdepth      = Query -> Maybe Int
queryDepth (Query -> Maybe Int) -> Query -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Query
rsQuery ReportSpec
rspec
      multiperiod :: Bool
multiperiod = Interval
interval_ Interval -> Interval -> Bool
forall a. Eq a => a -> a -> Bool
/= Interval
NoInterval

      -- postings to be included in the report, and similarly-matched postings before the report start date
      ([Posting]
precedingps, [Posting]
reportps) = ReportSpec -> Journal -> DateSpan -> ([Posting], [Posting])
matchedPostingsBeforeAndDuring ReportSpec
rspec Journal
j DateSpan
reportspan

      -- Postings, or summary postings with their subperiod's end date, to be displayed.
      [(Posting, Maybe Day)]
displayps :: [(Posting, Maybe Day)]
        | Bool
multiperiod = [(Posting
p, Day -> Maybe Day
forall a. a -> Maybe a
Just Day
periodend) | (Posting
p, Day
periodend) <- [Posting] -> [(Posting, Day)]
summariseps [Posting]
reportps]
        | Bool
otherwise   = [(Posting
p, Maybe Day
forall a. Maybe a
Nothing) | Posting
p <- [Posting]
reportps]
        where
          summariseps :: [Posting] -> [(Posting, Day)]
summariseps = Interval
-> WhichDate
-> Maybe Int
-> Bool
-> DateSpan
-> [Posting]
-> [(Posting, Day)]
summarisePostingsByInterval Interval
interval_ WhichDate
whichdate Maybe Int
mdepth Bool
showempty DateSpan
reportspan
          showempty :: Bool
showempty = Bool
empty_ Bool -> Bool -> Bool
|| Bool
average_

      -- Posting report items ready for display.
      items :: PostingsReport
items =
        String -> PostingsReport -> PostingsReport
forall a. Show a => String -> a -> a
dbg4 String
"postingsReport items" (PostingsReport -> PostingsReport)
-> PostingsReport -> PostingsReport
forall a b. (a -> b) -> a -> b
$
        [(Posting, Maybe Day)]
-> (Posting, Maybe Day)
-> WhichDate
-> Maybe Int
-> MixedAmount
-> (Int -> MixedAmount -> MixedAmount -> MixedAmount)
-> Int
-> PostingsReport
postingsReportItems [(Posting, Maybe Day)]
displayps (Posting
nullposting,Maybe Day
forall a. Maybe a
Nothing) WhichDate
whichdate Maybe Int
mdepth MixedAmount
startbal Int -> MixedAmount -> MixedAmount -> MixedAmount
runningcalc Int
startnum
        where
          -- In historical mode we'll need a starting balance, which we
          -- may be converting to value per hledger_options.m4.md "Effect
          -- of --value on reports".
          -- XXX balance report doesn't value starting balance.. should this ?
          historical :: Bool
historical = BalanceType
balancetype_ BalanceType -> BalanceType -> Bool
forall a. Eq a => a -> a -> Bool
== BalanceType
HistoricalBalance
          startbal :: MixedAmount
startbal | Bool
average_  = if Bool
historical then MixedAmount
precedingavg else MixedAmount
nullmixedamt
                   | Bool
otherwise = if Bool
historical then MixedAmount
precedingsum else MixedAmount
nullmixedamt
            where
              precedingsum :: MixedAmount
precedingsum = [Posting] -> MixedAmount
sumPostings [Posting]
precedingps
              precedingavg :: MixedAmount
precedingavg = Quantity -> MixedAmount -> MixedAmount
divideMixedAmount (Int -> Quantity
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Quantity) -> Int -> Quantity
forall a b. (a -> b) -> a -> b
$ [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
precedingps) MixedAmount
precedingsum

          runningcalc :: Int -> MixedAmount -> MixedAmount -> MixedAmount
runningcalc = ReportOpts -> Int -> MixedAmount -> MixedAmount -> MixedAmount
registerRunningCalculationFn ReportOpts
ropts
          startnum :: Int
startnum = if Bool
historical then [Posting] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
precedingps Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
1

-- | Based on the given report options, return a function that does the appropriate
-- running calculation for the register report, ie a running average or running total.
-- This function will take the item number, previous average/total, and new posting amount,
-- and return the new average/total.
registerRunningCalculationFn :: ReportOpts -> (Int -> MixedAmount -> MixedAmount -> MixedAmount)
registerRunningCalculationFn :: ReportOpts -> Int -> MixedAmount -> MixedAmount -> MixedAmount
registerRunningCalculationFn ReportOpts
ropts
  | ReportOpts -> Bool
average_ ReportOpts
ropts = \Int
i MixedAmount
avg MixedAmount
amt -> MixedAmount
avg MixedAmount -> MixedAmount -> MixedAmount
`maPlus` Quantity -> MixedAmount -> MixedAmount
divideMixedAmount (Int -> Quantity
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) (MixedAmount
amt MixedAmount -> MixedAmount -> MixedAmount
`maMinus` MixedAmount
avg)
  | Bool
otherwise      = \Int
_ MixedAmount
bal MixedAmount
amt -> MixedAmount
bal MixedAmount -> MixedAmount -> MixedAmount
`maPlus` MixedAmount
amt

-- | Find postings matching a given query, within a given date span,
-- and also any similarly-matched postings before that date span.
-- Date restrictions and depth restrictions in the query are ignored.
-- A helper for the postings report.
matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting],[Posting])
matchedPostingsBeforeAndDuring :: ReportSpec -> Journal -> DateSpan -> ([Posting], [Posting])
matchedPostingsBeforeAndDuring rspec :: ReportSpec
rspec@ReportSpec{rsOpts :: ReportSpec -> ReportOpts
rsOpts=ReportOpts
ropts,rsQuery :: ReportSpec -> Query
rsQuery=Query
q} Journal
j DateSpan
reportspan =
  String -> ([Posting], [Posting]) -> ([Posting], [Posting])
forall a. Show a => String -> a -> a
dbg5 String
"beforeps, duringps" (([Posting], [Posting]) -> ([Posting], [Posting]))
-> ([Posting], [Posting]) -> ([Posting], [Posting])
forall a b. (a -> b) -> a -> b
$ (Posting -> Bool) -> [Posting] -> ([Posting], [Posting])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Query
beforestartq Query -> Posting -> Bool
`matchesPosting`) [Posting]
beforeandduringps
  where
    beforestartq :: Query
beforestartq = String -> Query -> Query
forall a. Show a => String -> a -> a
dbg3 String
"beforestartq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ DateSpan -> Query
dateqtype (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Maybe Day -> DateSpan) -> Maybe Day -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Day
spanStart DateSpan
reportspan
    beforeandduringps :: [Posting]
beforeandduringps =
      String -> [Posting] -> [Posting]
forall a. Show a => String -> a -> a
dbg5 String
"ps5" ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ (Posting -> Day) -> [Posting] -> [Posting]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Posting -> Day
sortdate ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$                                          -- sort postings by date or date2
      String -> [Posting] -> [Posting]
forall a. Show a => String -> a -> a
dbg5 String
"ps4" ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ (if ReportOpts -> Bool
invert_ ReportOpts
ropts then (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
negatePostingAmount else [Posting] -> [Posting]
forall a. a -> a
id) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$  -- with --invert, invert amounts
                   Journal -> [Posting]
journalPostings (Journal -> [Posting]) -> Journal -> [Posting]
forall a b. (a -> b) -> a -> b
$
                   ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts ReportSpec
rspec (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$                      -- convert to cost and apply valuation
      String -> Journal -> Journal
forall a. Show a => String -> a -> a
dbg5 String
"ps2" (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Journal
filterJournalAmounts Query
symq (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$                                -- remove amount parts which the query's cur: terms would exclude
      String -> Journal -> Journal
forall a. Show a => String -> a -> a
dbg5 String
"ps1" (Journal -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Journal
filterJournal Query
beforeandduringq Journal
j                           -- filter postings by the query, with no start date or depth limit

    beforeandduringq :: Query
beforeandduringq = String -> Query -> Query
forall a. Show a => String -> a -> a
dbg4 String
"beforeandduringq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query -> Query
depthless (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ Query -> Query
dateless Query
q, Query
beforeendq]
      where
        depthless :: Query -> Query
depthless  = (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not (Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsDepth)
        dateless :: Query -> Query
dateless   = (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not (Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsDateOrDate2)
        beforeendq :: Query
beforeendq = DateSpan -> Query
dateqtype (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing (Maybe Day -> DateSpan) -> Maybe Day -> DateSpan
forall a b. (a -> b) -> a -> b
$ DateSpan -> Maybe Day
spanEnd DateSpan
reportspan

    sortdate :: Posting -> Day
sortdate = if ReportOpts -> Bool
date2_ ReportOpts
ropts then Posting -> Day
postingDate2 else Posting -> Day
postingDate
    filterJournal :: Query -> Journal -> Journal
filterJournal = if ReportOpts -> Bool
related_ ReportOpts
ropts then Query -> Journal -> Journal
filterJournalRelatedPostings else Query -> Journal -> Journal
filterJournalPostings  -- with -r, replace each posting with its sibling postings
    symq :: Query
symq = String -> Query -> Query
forall a. Show a => String -> a -> a
dbg4 String
"symq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsSym Query
q
    dateqtype :: DateSpan -> Query
dateqtype
      | Query -> Bool
queryIsDate2 Query
dateq Bool -> Bool -> Bool
|| (Query -> Bool
queryIsDate Query
dateq Bool -> Bool -> Bool
&& ReportOpts -> Bool
date2_ ReportOpts
ropts) = DateSpan -> Query
Date2
      | Bool
otherwise = DateSpan -> Query
Date
      where
        dateq :: Query
dateq = String -> Query -> Query
forall a. Show a => String -> a -> a
dbg4 String
"dateq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDateOrDate2 (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ String -> Query -> Query
forall a. Show a => String -> a -> a
dbg4 String
"q" Query
q  -- XXX confused by multiple date:/date2: ?

-- | Generate postings report line items from a list of postings or (with
-- non-Nothing dates attached) summary postings.
postingsReportItems :: [(Posting,Maybe Day)] -> (Posting,Maybe Day) -> WhichDate -> Maybe Int -> MixedAmount -> (Int -> MixedAmount -> MixedAmount -> MixedAmount) -> Int -> [PostingsReportItem]
postingsReportItems :: [(Posting, Maybe Day)]
-> (Posting, Maybe Day)
-> WhichDate
-> Maybe Int
-> MixedAmount
-> (Int -> MixedAmount -> MixedAmount -> MixedAmount)
-> Int
-> PostingsReport
postingsReportItems [] (Posting, Maybe Day)
_ WhichDate
_ Maybe Int
_ MixedAmount
_ Int -> MixedAmount -> MixedAmount -> MixedAmount
_ Int
_ = []
postingsReportItems ((Posting
p,Maybe Day
menddate):[(Posting, Maybe Day)]
ps) (Posting
pprev,Maybe Day
menddateprev) WhichDate
wd Maybe Int
d MixedAmount
b Int -> MixedAmount -> MixedAmount -> MixedAmount
runningcalcfn Int
itemnum =
    PostingsReportItem
iPostingsReportItem -> PostingsReport -> PostingsReport
forall a. a -> [a] -> [a]
:([(Posting, Maybe Day)]
-> (Posting, Maybe Day)
-> WhichDate
-> Maybe Int
-> MixedAmount
-> (Int -> MixedAmount -> MixedAmount -> MixedAmount)
-> Int
-> PostingsReport
postingsReportItems [(Posting, Maybe Day)]
ps (Posting
p,Maybe Day
menddate) WhichDate
wd Maybe Int
d MixedAmount
b' Int -> MixedAmount -> MixedAmount -> MixedAmount
runningcalcfn (Int
itemnumInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
  where
    i :: PostingsReportItem
i = Bool
-> Bool
-> WhichDate
-> Maybe Day
-> Posting
-> MixedAmount
-> PostingsReportItem
mkpostingsReportItem Bool
showdate Bool
showdesc WhichDate
wd Maybe Day
menddate Posting
p' MixedAmount
b'
    (Bool
showdate, Bool
showdesc) | Maybe Day -> Bool
forall a. Maybe a -> Bool
isJust Maybe Day
menddate = (Maybe Day
menddate Maybe Day -> Maybe Day -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Day
menddateprev,        Bool
False)
                         | Bool
otherwise       = (Bool
isfirstintxn Bool -> Bool -> Bool
|| Bool
isdifferentdate, Bool
isfirstintxn)
    isfirstintxn :: Bool
isfirstintxn = Posting -> Maybe Transaction
ptransaction Posting
p Maybe Transaction -> Maybe Transaction -> Bool
forall a. Eq a => a -> a -> Bool
/= Posting -> Maybe Transaction
ptransaction Posting
pprev
    isdifferentdate :: Bool
isdifferentdate = case WhichDate
wd of WhichDate
PrimaryDate   -> Posting -> Day
postingDate Posting
p  Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
/= Posting -> Day
postingDate Posting
pprev
                                 WhichDate
SecondaryDate -> Posting -> Day
postingDate2 Posting
p Day -> Day -> Bool
forall a. Eq a => a -> a -> Bool
/= Posting -> Day
postingDate2 Posting
pprev
    p' :: Posting
p' = Posting
p{paccount :: Text
paccount= Maybe Int -> Text -> Text
clipOrEllipsifyAccountName Maybe Int
d (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Posting -> Text
paccount Posting
p}
    b' :: MixedAmount
b' = Int -> MixedAmount -> MixedAmount -> MixedAmount
runningcalcfn Int
itemnum MixedAmount
b (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p

-- | Generate one postings report line item, containing the posting,
-- the current running balance, and optionally the posting date and/or
-- the transaction description.
mkpostingsReportItem :: Bool -> Bool -> WhichDate -> Maybe Day -> Posting -> MixedAmount -> PostingsReportItem
mkpostingsReportItem :: Bool
-> Bool
-> WhichDate
-> Maybe Day
-> Posting
-> MixedAmount
-> PostingsReportItem
mkpostingsReportItem Bool
showdate Bool
showdesc WhichDate
wd Maybe Day
menddate Posting
p MixedAmount
b =
  (if Bool
showdate then Day -> Maybe Day
forall a. a -> Maybe a
Just Day
date else Maybe Day
forall a. Maybe a
Nothing
  ,Maybe Day
menddate
  ,if Bool
showdesc then Transaction -> Text
tdescription (Transaction -> Text) -> Maybe Transaction -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Transaction
ptransaction Posting
p else Maybe Text
forall a. Maybe a
Nothing
  ,Posting
p
  ,MixedAmount
b
  )
  where
    date :: Day
date = case WhichDate
wd of WhichDate
PrimaryDate   -> Posting -> Day
postingDate Posting
p
                      WhichDate
SecondaryDate -> Posting -> Day
postingDate2 Posting
p

-- | Convert a list of postings into summary postings, one per interval,
-- aggregated to the specified depth if any.
-- Each summary posting will have a non-Nothing interval end date.
summarisePostingsByInterval :: Interval -> WhichDate -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [SummaryPosting]
summarisePostingsByInterval :: Interval
-> WhichDate
-> Maybe Int
-> Bool
-> DateSpan
-> [Posting]
-> [(Posting, Day)]
summarisePostingsByInterval Interval
interval WhichDate
wd Maybe Int
mdepth Bool
showempty DateSpan
reportspan [Posting]
ps = (DateSpan -> [(Posting, Day)]) -> [DateSpan] -> [(Posting, Day)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DateSpan -> [(Posting, Day)]
summarisespan ([DateSpan] -> [(Posting, Day)]) -> [DateSpan] -> [(Posting, Day)]
forall a b. (a -> b) -> a -> b
$ Interval -> DateSpan -> [DateSpan]
splitSpan Interval
interval DateSpan
reportspan
  where
    summarisespan :: DateSpan -> [(Posting, Day)]
summarisespan DateSpan
s = DateSpan
-> WhichDate -> Maybe Int -> Bool -> [Posting] -> [(Posting, Day)]
summarisePostingsInDateSpan DateSpan
s WhichDate
wd Maybe Int
mdepth Bool
showempty (DateSpan -> [Posting]
postingsinspan DateSpan
s)
    postingsinspan :: DateSpan -> [Posting]
postingsinspan DateSpan
s = (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (WhichDate -> DateSpan -> Posting -> Bool
isPostingInDateSpan' WhichDate
wd DateSpan
s) [Posting]
ps

-- | Given a date span (representing a report interval) and a list of
-- postings within it, aggregate the postings into one summary posting per
-- account. Each summary posting will have a non-Nothing interval end date.
--
-- When a depth argument is present, postings to accounts of greater
-- depth are also aggregated where possible. If the depth is 0, all
-- postings in the span are aggregated into a single posting with
-- account name "...".
--
-- The showempty flag includes spans with no postings and also postings
-- with 0 amount.
--
summarisePostingsInDateSpan :: DateSpan -> WhichDate -> Maybe Int -> Bool -> [Posting] -> [SummaryPosting]
summarisePostingsInDateSpan :: DateSpan
-> WhichDate -> Maybe Int -> Bool -> [Posting] -> [(Posting, Day)]
summarisePostingsInDateSpan (DateSpan Maybe Day
b Maybe Day
e) WhichDate
wd Maybe Int
mdepth Bool
showempty [Posting]
ps
  | [Posting] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posting]
ps Bool -> Bool -> Bool
&& (Maybe Day -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Day
b Bool -> Bool -> Bool
|| Maybe Day -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Day
e) = []
  | [Posting] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posting]
ps Bool -> Bool -> Bool
&& Bool
showempty = [(Posting
summaryp, Day
e')]
  | Bool
otherwise = [(Posting, Day)]
summarypes
  where
    postingdate :: Posting -> Day
postingdate = if WhichDate
wd WhichDate -> WhichDate -> Bool
forall a. Eq a => a -> a -> Bool
== WhichDate
PrimaryDate then Posting -> Day
postingDate else Posting -> Day
postingDate2
    b' :: Day
b' = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Day -> (Posting -> Day) -> Maybe Posting -> Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Day
nulldate Posting -> Day
postingdate (Maybe Posting -> Day) -> Maybe Posting -> Day
forall a b. (a -> b) -> a -> b
$ [Posting] -> Maybe Posting
forall a. [a] -> Maybe a
headMay [Posting]
ps) Maybe Day
b
    e' :: Day
e' = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Day -> (Posting -> Day) -> Maybe Posting -> Day
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer -> Day -> Day
addDays Integer
1 Day
nulldate) Posting -> Day
postingdate (Maybe Posting -> Day) -> Maybe Posting -> Day
forall a b. (a -> b) -> a -> b
$ [Posting] -> Maybe Posting
forall a. [a] -> Maybe a
lastMay [Posting]
ps) Maybe Day
e
    summaryp :: Posting
summaryp = Posting
nullposting{pdate :: Maybe Day
pdate=Day -> Maybe Day
forall a. a -> Maybe a
Just Day
b'}
    clippedanames :: [Text]
clippedanames = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int -> Text -> Text
clipAccountName Maybe Int
mdepth) [Text]
anames
    summaryps :: [Posting]
summaryps | Maybe Int
mdepth Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 = [Posting
summaryp{paccount :: Text
paccount=Text
"...",pamount :: MixedAmount
pamount=[Posting] -> MixedAmount
sumPostings [Posting]
ps}]
              | Bool
otherwise        = [Posting
summaryp{paccount :: Text
paccount=Text
a,pamount :: MixedAmount
pamount=Text -> MixedAmount
balance Text
a} | Text
a <- [Text]
clippedanames]
    summarypes :: [(Posting, Day)]
summarypes = (Posting -> (Posting, Day)) -> [Posting] -> [(Posting, Day)]
forall a b. (a -> b) -> [a] -> [b]
map (, Day
e') ([Posting] -> [(Posting, Day)]) -> [Posting] -> [(Posting, Day)]
forall a b. (a -> b) -> a -> b
$ (if Bool
showempty then [Posting] -> [Posting]
forall a. a -> a
id else (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Posting -> Bool) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MixedAmount -> Bool
mixedAmountLooksZero (MixedAmount -> Bool)
-> (Posting -> MixedAmount) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> MixedAmount
pamount)) [Posting]
summaryps
    anames :: [Text]
anames = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Posting -> Text) -> [Posting] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
paccount [Posting]
ps
    -- aggregate balances by account, like ledgerFromJournal, then do depth-clipping
    accts :: [Account]
accts = [Posting] -> [Account]
accountsFromPostings [Posting]
ps
    balance :: Text -> MixedAmount
balance Text
a = MixedAmount
-> (Account -> MixedAmount) -> Maybe Account -> MixedAmount
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MixedAmount
nullmixedamt Account -> MixedAmount
bal (Maybe Account -> MixedAmount) -> Maybe Account -> MixedAmount
forall a b. (a -> b) -> a -> b
$ Text -> [Account] -> Maybe Account
lookupAccount Text
a [Account]
accts
      where
        bal :: Account -> MixedAmount
bal = if Text -> Bool
isclipped Text
a then Account -> MixedAmount
aibalance else Account -> MixedAmount
aebalance
        isclipped :: Text -> Bool
isclipped Text
a = Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Text -> Int
accountNameLevel Text
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=) Maybe Int
mdepth

negatePostingAmount :: Posting -> Posting
negatePostingAmount :: Posting -> Posting
negatePostingAmount = (MixedAmount -> MixedAmount) -> Posting -> Posting
postingTransformAmount MixedAmount -> MixedAmount
forall a. Num a => a -> a
negate


-- tests

tests_PostingsReport :: TestTree
tests_PostingsReport = String -> [TestTree] -> TestTree
tests String
"PostingsReport" [

   String -> Assertion -> TestTree
test String
"postingsReport" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    let (Query
query, Journal
journal) gives :: (Query, Journal) -> Int -> Assertion
`gives` Int
n = (PostingsReport -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PostingsReport -> Int) -> PostingsReport -> Int
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
defreportspec{rsQuery :: Query
rsQuery=Query
query} Journal
journal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
n
    -- with the query specified explicitly
    (Query
Any, Journal
nulljournal) (Query, Journal) -> Int -> Assertion
`gives` Int
0
    (Query
Any, Journal
samplejournal) (Query, Journal) -> Int -> Assertion
`gives` Int
13
    -- register --depth just clips account names
    (Int -> Query
Depth Int
2, Journal
samplejournal) (Query, Journal) -> Int -> Assertion
`gives` Int
13
    ([Query] -> Query
And [Int -> Query
Depth Int
1, Status -> Query
StatusQ Status
Cleared, Regexp -> Query
Acct (Text -> Regexp
toRegex' Text
"expenses")], Journal
samplejournal) (Query, Journal) -> Int -> Assertion
`gives` Int
2
    ([Query] -> Query
And [[Query] -> Query
And [Int -> Query
Depth Int
1, Status -> Query
StatusQ Status
Cleared], Regexp -> Query
Acct (Text -> Regexp
toRegex' Text
"expenses")], Journal
samplejournal) (Query, Journal) -> Int -> Assertion
`gives` Int
2
    -- with query and/or command-line options
    (PostingsReport -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PostingsReport -> Int) -> PostingsReport -> Int
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
defreportspec Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
13
    (PostingsReport -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PostingsReport -> Int) -> PostingsReport -> Int
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
defreportspec{rsOpts :: ReportOpts
rsOpts=ReportOpts
defreportopts{interval_ :: Interval
interval_=Int -> Interval
Months Int
1}} Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
11
    (PostingsReport -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PostingsReport -> Int) -> PostingsReport -> Int
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
defreportspec{rsOpts :: ReportOpts
rsOpts=ReportOpts
defreportopts{interval_ :: Interval
interval_=Int -> Interval
Months Int
1, empty_ :: Bool
empty_=Bool
True}} Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
20
    (PostingsReport -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (PostingsReport -> Int) -> PostingsReport -> Int
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> PostingsReport
postingsReport ReportSpec
defreportspec{rsQuery :: Query
rsQuery=Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"assets:bank:checking"} Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
5

     -- (defreportopts, And [Acct "a a", Acct "'b"], samplejournal2) `gives` 0
     -- [(Just (fromGregorian 2008 01 01,"income"),assets:bank:checking             $1,$1)
     -- ,(Nothing,income:salary                   $-1,0)
     -- ,(Just (2008-06-01,"gift"),assets:bank:checking             $1,$1)
     -- ,(Nothing,income:gifts                    $-1,0)
     -- ,(Just (2008-06-02,"save"),assets:bank:saving               $1,$1)
     -- ,(Nothing,assets:bank:checking            $-1,0)
     -- ,(Just (2008-06-03,"eat & shop"),expenses:food                    $1,$1)
     -- ,(Nothing,expenses:supplies                $1,$2)
     -- ,(Nothing,assets:cash                     $-2,0)
     -- ,(Just (2008-12-31,"pay off"),liabilities:debts                $1,$1)
     -- ,(Nothing,assets:bank:checking            $-1,0)

    {-
        let opts = defreportopts
        (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
         ["2008/01/01 income               assets:bank:checking             $1           $1"
         ,"                                income:salary                   $-1            0"
         ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
         ,"                                income:gifts                    $-1            0"
         ,"2008/06/02 save                 assets:bank:saving               $1           $1"
         ,"                                assets:bank:checking            $-1            0"
         ,"2008/06/03 eat & shop           expenses:food                    $1           $1"
         ,"                                expenses:supplies                $1           $2"
         ,"                                assets:cash                     $-2            0"
         ,"2008/12/31 pay off              liabilities:debts                $1           $1"
         ,"                                assets:bank:checking            $-1            0"
         ]

      ,"postings report with cleared option" ~:
       do
        let opts = defreportopts{cleared_=True}
        j <- readJournal' sample_journal_str
        (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
         ["2008/06/03 eat & shop           expenses:food                    $1           $1"
         ,"                                expenses:supplies                $1           $2"
         ,"                                assets:cash                     $-2            0"
         ,"2008/12/31 pay off              liabilities:debts                $1           $1"
         ,"                                assets:bank:checking            $-1            0"
         ]

      ,"postings report with uncleared option" ~:
       do
        let opts = defreportopts{uncleared_=True}
        j <- readJournal' sample_journal_str
        (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
         ["2008/01/01 income               assets:bank:checking             $1           $1"
         ,"                                income:salary                   $-1            0"
         ,"2008/06/01 gift                 assets:bank:checking             $1           $1"
         ,"                                income:gifts                    $-1            0"
         ,"2008/06/02 save                 assets:bank:saving               $1           $1"
         ,"                                assets:bank:checking            $-1            0"
         ]

      ,"postings report sorts by date" ~:
       do
        j <- readJournal' $ unlines
            ["2008/02/02 a"
            ,"  b  1"
            ,"  c"
            ,""
            ,"2008/01/01 d"
            ,"  e  1"
            ,"  f"
            ]
        let opts = defreportopts
        registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/02/02"]

      ,"postings report with account pattern" ~:
       do
        j <- samplejournal
        let opts = defreportopts{patterns_=["cash"]}
        (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
         ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
         ]

      ,"postings report with account pattern, case insensitive" ~:
       do
        j <- samplejournal
        let opts = defreportopts{patterns_=["cAsH"]}
        (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
         ["2008/06/03 eat & shop           assets:cash                     $-2          $-2"
         ]

      ,"postings report with display expression" ~:
       do
        j <- samplejournal
        let gives displayexpr =
                (registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is`)
                    where opts = defreportopts
        "d<[2008/6/2]"  `gives` ["2008/01/01","2008/06/01"]
        "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"]
        "d=[2008/6/2]"  `gives` ["2008/06/02"]
        "d>=[2008/6/2]" `gives` ["2008/06/02","2008/06/03","2008/12/31"]
        "d>[2008/6/2]"  `gives` ["2008/06/03","2008/12/31"]

      ,"postings report with period expression" ~:
       do
        j <- samplejournal
        let periodexpr `gives` dates = do
              j' <- samplejournal
              registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j') `is` dates
                  where opts = defreportopts{period_=maybePeriod date1 periodexpr}
        ""     `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
        "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"]
        "2007" `gives` []
        "june" `gives` ["2008/06/01","2008/06/02","2008/06/03"]
        "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"]
        "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"]
        let opts = defreportopts{period_=maybePeriod date1 "yearly"}
        (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
         ["2008/01/01 - 2008/12/31         assets:bank:saving               $1           $1"
         ,"                                assets:cash                     $-2          $-1"
         ,"                                expenses:food                    $1            0"
         ,"                                expenses:supplies                $1           $1"
         ,"                                income:gifts                    $-1            0"
         ,"                                income:salary                   $-1          $-1"
         ,"                                liabilities:debts                $1            0"
         ]
        let opts = defreportopts{period_=maybePeriod date1 "quarterly"}
        registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/10/01"]
        let opts = defreportopts{period_=maybePeriod date1 "quarterly",empty_=True}
        registerdates (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"]

      ]

      , "postings report with depth arg" ~:
       do
        j <- samplejournal
        let opts = defreportopts{depth_=Just 2}
        (postingsReportAsText opts $ postingsReport opts (queryFromOpts date1 opts) j) `is` unlines
         ["2008/01/01 income               assets:bank                      $1           $1"
         ,"                                income:salary                   $-1            0"
         ,"2008/06/01 gift                 assets:bank                      $1           $1"
         ,"                                income:gifts                    $-1            0"
         ,"2008/06/02 save                 assets:bank                      $1           $1"
         ,"                                assets:bank                     $-1            0"
         ,"2008/06/03 eat & shop           expenses:food                    $1           $1"
         ,"                                expenses:supplies                $1           $2"
         ,"                                assets:cash                     $-2            0"
         ,"2008/12/31 pay off              liabilities:debts                $1           $1"
         ,"                                assets:bank                     $-1            0"
         ]

    -}

  ,String -> Assertion -> TestTree
test String
"summarisePostingsByInterval" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
    Interval
-> WhichDate
-> Maybe Int
-> Bool
-> DateSpan
-> [Posting]
-> [(Posting, Day)]
summarisePostingsByInterval (Int -> Interval
Quarters Int
1) WhichDate
PrimaryDate Maybe Int
forall a. Maybe a
Nothing Bool
False (Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
forall a. Maybe a
Nothing Maybe Day
forall a. Maybe a
Nothing) [] [(Posting, Day)] -> [(Posting, Day)] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []

  -- ,tests_summarisePostingsInDateSpan = [
    --  "summarisePostingsInDateSpan" ~: do
    --   let gives (b,e,depth,showempty,ps) =
    --           (summarisePostingsInDateSpan (DateSpan b e) depth showempty ps `is`)
    --   let ps =
    --           [
    --            nullposting{lpdescription="desc",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)}
    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=mixedAmount (usd 2)}
    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food",          lpamount=mixedAmount (usd 4)}
    --           ,nullposting{lpdescription="desc",lpaccount="expenses:food:dining",   lpamount=mixedAmount (usd 8)}
    --           ]
    --   ("2008/01/01","2009/01/01",0,9999,False,[]) `gives`
    --    []
    --   ("2008/01/01","2009/01/01",0,9999,True,[]) `gives`
    --    [
    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31"}
    --    ]
    --   ("2008/01/01","2009/01/01",0,9999,False,ts) `gives`
    --    [
    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",          lpamount=mixedAmount (usd 4)}
    --    ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:dining",   lpamount=mixedAmount (usd 10)}
    --    ,nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food:groceries",lpamount=mixedAmount (usd 1)}
    --    ]
    --   ("2008/01/01","2009/01/01",0,2,False,ts) `gives`
    --    [
    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses:food",lpamount=mixedAmount (usd 15)}
    --    ]
    --   ("2008/01/01","2009/01/01",0,1,False,ts) `gives`
    --    [
    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="expenses",lpamount=mixedAmount (usd 15)}
    --    ]
    --   ("2008/01/01","2009/01/01",0,0,False,ts) `gives`
    --    [
    --     nullposting{lpdate=fromGregorian 2008 01 01,lpdescription="- 2008/12/31",lpaccount="",lpamount=mixedAmount (usd 15)}
    --    ]

 ]