fix: balance: Correctly handle empty journals (#2452)
Eliminate several partial functions.
This commit is contained in:
Stephen Morgan
Simon Michael
parent
1d56db0ad8
commit
aad61e465d
@ -9,13 +9,19 @@ Report periods are assumed to be contiguous, and represented only by start dates
|
||||
-}
|
||||
module Hledger.Data.PeriodData
|
||||
( periodDataFromList
|
||||
, periodDataToList
|
||||
|
||||
, lookupPeriodData
|
||||
, lookupPeriodDataOrHistorical
|
||||
, insertPeriodData
|
||||
, opPeriodData
|
||||
, mergePeriodData
|
||||
, padPeriodData
|
||||
|
||||
, periodDataToDateSpans
|
||||
, maybePeriodDataToDateSpans
|
||||
, dateSpansToPeriodData
|
||||
|
||||
, tests_PeriodData
|
||||
) where
|
||||
|
||||
@ -24,18 +30,17 @@ import Data.Foldable1 (Foldable1(..))
|
||||
#else
|
||||
import Control.Applicative (liftA2)
|
||||
#endif
|
||||
import Data.Bifunctor (first)
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.IntSet as IS
|
||||
#if !MIN_VERSION_base(4,20,0)
|
||||
import Data.List (foldl')
|
||||
#endif
|
||||
import Data.Time (Day(..), fromGregorian)
|
||||
|
||||
import Test.Tasty (testGroup)
|
||||
import Test.Tasty.HUnit ((@?=), testCase)
|
||||
|
||||
import Hledger.Data.Amount
|
||||
import Hledger.Data.Dates
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Utils
|
||||
|
||||
|
||||
instance Show a => Show (PeriodData a) where
|
||||
@ -44,7 +49,7 @@ instance Show a => Show (PeriodData a) where
|
||||
showString "PeriodData"
|
||||
. showString "{ pdpre = " . shows h
|
||||
. showString ", pdperiods = "
|
||||
. showString "fromList " . shows (map (\(day, x) -> (ModifiedJulianDay $ toInteger day, x)) $ IM.toList ds)
|
||||
. showString "fromList " . shows (map (\(day, x) -> (intToDay day, x)) $ IM.toList ds)
|
||||
. showChar '}'
|
||||
|
||||
instance Foldable PeriodData where
|
||||
@ -73,18 +78,32 @@ instance Monoid a => Monoid (PeriodData a) where
|
||||
|
||||
-- | Construct an 'PeriodData' from a list.
|
||||
periodDataFromList :: a -> [(Day, a)] -> PeriodData a
|
||||
periodDataFromList h = PeriodData h . IM.fromList . map (\(d, a) -> (fromInteger $ toModifiedJulianDay d, a))
|
||||
periodDataFromList h = PeriodData h . IM.fromList . map (\(d, a) -> (dayToInt d, a))
|
||||
|
||||
-- | Get account balance information to the period containing a given 'Day'.
|
||||
lookupPeriodData :: Day -> PeriodData a -> a
|
||||
lookupPeriodData d (PeriodData h as) =
|
||||
maybe h snd $ IM.lookupLE (fromInteger $ toModifiedJulianDay d) as
|
||||
-- | Convert 'PeriodData' to a list of pairs.
|
||||
periodDataToList :: PeriodData a -> (a, [(Day, a)])
|
||||
periodDataToList (PeriodData h as) = (h, map (\(s, e) -> (intToDay s, e)) $ IM.toList as)
|
||||
|
||||
|
||||
-- | Get account balance information for the period containing a given 'Day',
|
||||
-- along with the start of the period, or 'Nothing' if this day lies in the
|
||||
-- historical period.
|
||||
lookupPeriodData :: Day -> PeriodData a -> Maybe (Day, a)
|
||||
lookupPeriodData d (PeriodData _ as) = first intToDay <$> IM.lookupLE (dayToInt d) as
|
||||
|
||||
-- | Get account balance information for the period containing a given 'Day'
|
||||
-- or the historical data if this day lies in the historical period, along with
|
||||
-- the start of the period or 'Nothing' if it lies in the historical period.
|
||||
lookupPeriodDataOrHistorical :: Day -> PeriodData a -> (Maybe Day, a)
|
||||
lookupPeriodDataOrHistorical d pd@(PeriodData h _) = case lookupPeriodData d pd of
|
||||
Nothing -> (Nothing, h)
|
||||
Just (a, b) -> (Just a, b)
|
||||
|
||||
-- | Add account balance information to the appropriate location in 'PeriodData'.
|
||||
insertPeriodData :: Semigroup a => Maybe Day -> a -> PeriodData a -> PeriodData a
|
||||
insertPeriodData mday b balances = case mday of
|
||||
Nothing -> balances{pdpre = pdpre balances <> b}
|
||||
Just day -> balances{pdperiods = IM.insertWith (<>) (fromInteger $ toModifiedJulianDay day) b $ pdperiods balances}
|
||||
Just day -> balances{pdperiods = IM.insertWith (<>) (dayToInt day) b $ pdperiods balances}
|
||||
|
||||
-- | Merges two 'PeriodData', using the given operation to combine their balance information.
|
||||
--
|
||||
@ -103,11 +122,39 @@ mergePeriodData only1 only2 f = \(PeriodData h1 as1) (PeriodData h2 as2) ->
|
||||
where
|
||||
merge = IM.mergeWithKey (\_ x y -> Just $ f x y) (fmap only1) (fmap only2)
|
||||
|
||||
-- | Pad out the datemap of an 'PeriodData' so that every key from a set is present.
|
||||
padPeriodData :: Monoid a => IS.IntSet -> PeriodData a -> PeriodData a
|
||||
padPeriodData keys bal = bal{pdperiods = pdperiods bal <> IM.fromSet (const mempty) keys}
|
||||
-- | Pad out the datemap of a 'PeriodData' so that every key from another 'PeriodData' is present.
|
||||
padPeriodData :: a -> PeriodData b -> PeriodData a -> PeriodData a
|
||||
padPeriodData x pad bal = bal{pdperiods = pdperiods bal <> (x <$ pdperiods pad)}
|
||||
|
||||
|
||||
-- | Convert 'PeriodData Day' to a list of 'DateSpan's.
|
||||
periodDataToDateSpans :: PeriodData Day -> [DateSpan]
|
||||
periodDataToDateSpans = map (\(s, e) -> DateSpan (toEFDay s) (toEFDay e)) . snd . periodDataToList
|
||||
where toEFDay = Just . Exact
|
||||
|
||||
-- Convert a periodic report 'Maybe (PeriodData Day)' to a list of 'DateSpans',
|
||||
-- replacing the empty case with an appropriate placeholder.
|
||||
maybePeriodDataToDateSpans :: Maybe (PeriodData Day) -> [DateSpan]
|
||||
maybePeriodDataToDateSpans = maybe [DateSpan Nothing Nothing] periodDataToDateSpans
|
||||
|
||||
-- | Convert a list of 'DateSpan's to a 'PeriodData Day', or 'Nothing' if it is not well-formed.
|
||||
-- PARTIAL:
|
||||
dateSpansToPeriodData :: [DateSpan] -> Maybe (PeriodData Day)
|
||||
-- Handle the cases of partitions which would arise from journals with no transactions
|
||||
dateSpansToPeriodData [] = Nothing
|
||||
dateSpansToPeriodData [DateSpan Nothing Nothing] = Nothing
|
||||
dateSpansToPeriodData [DateSpan Nothing (Just _)] = Nothing
|
||||
dateSpansToPeriodData [DateSpan (Just _) Nothing] = Nothing
|
||||
-- Handle properly defined reports
|
||||
dateSpansToPeriodData (x:xs) = Just $ periodDataFromList (fst $ boundaries x) (map boundaries (x:xs))
|
||||
where
|
||||
boundaries spn = makeJust (spanStart spn, spanEnd spn)
|
||||
makeJust (Just a, Just b) = (a, b)
|
||||
makeJust ab = error' $ "dateSpansToPeriodData: expected all spans to have start and end dates, but one has " ++ show ab
|
||||
|
||||
intToDay = ModifiedJulianDay . toInteger
|
||||
dayToInt = fromInteger . toModifiedJulianDay
|
||||
|
||||
-- tests
|
||||
|
||||
tests_PeriodData =
|
||||
|
||||
@ -46,8 +46,6 @@ module Hledger.Data.Posting (
|
||||
postingDate,
|
||||
postingDate2,
|
||||
postingDateOrDate2,
|
||||
isPostingInDateSpan,
|
||||
isPostingInDateSpan',
|
||||
-- * account name operations
|
||||
accountNamesFromPostings,
|
||||
-- * comment/tag operations
|
||||
@ -107,7 +105,7 @@ import Hledger.Utils
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Data.Amount
|
||||
import Hledger.Data.AccountName
|
||||
import Hledger.Data.Dates (nulldate, spanContainsDate)
|
||||
import Hledger.Data.Dates (nulldate)
|
||||
import Hledger.Data.Valuation
|
||||
|
||||
|
||||
@ -444,15 +442,6 @@ relatedPostings :: Posting -> [Posting]
|
||||
relatedPostings p@Posting{ptransaction=Just t} = filter (/= p) $ tpostings t
|
||||
relatedPostings _ = []
|
||||
|
||||
-- | Does this posting fall within the given date span ?
|
||||
isPostingInDateSpan :: DateSpan -> Posting -> Bool
|
||||
isPostingInDateSpan = isPostingInDateSpan' PrimaryDate
|
||||
|
||||
-- --date2-sensitive version, separate for now to avoid disturbing multiBalanceReport.
|
||||
isPostingInDateSpan' :: WhichDate -> DateSpan -> Posting -> Bool
|
||||
isPostingInDateSpan' PrimaryDate s = spanContainsDate s . postingDate
|
||||
isPostingInDateSpan' SecondaryDate s = spanContainsDate s . postingDate2
|
||||
|
||||
isEmptyPosting :: Posting -> Bool
|
||||
isEmptyPosting = mixedAmountLooksZero . pamount
|
||||
|
||||
|
||||
@ -19,12 +19,12 @@ import Control.Monad ((>=>))
|
||||
import Data.Bifunctor (bimap)
|
||||
import Data.Foldable (toList)
|
||||
import Data.List (find, maximumBy, intercalate)
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Maybe (catMaybes, fromMaybe, isJust)
|
||||
import Data.Ord (comparing)
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Text as T
|
||||
import Data.These (These(..), these)
|
||||
import Data.Time (Day)
|
||||
import Safe (minimumDef)
|
||||
|
||||
import Hledger.Data
|
||||
@ -89,7 +89,7 @@ budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport
|
||||
-- budgetgoalreport's span might be shorter actualreport's due to periodic txns;
|
||||
-- it should be safe to replace it with the latter, so they combine well.
|
||||
NoInterval -> actualspans
|
||||
_ -> nubSort . filter (/= nulldatespan) $ actualspans ++ budgetspans
|
||||
_ -> maybe id (padPeriodData nulldate) budgetspans <$> actualspans
|
||||
|
||||
actualps = dbg5 "actualps" $ getPostings rspec actualj priceoracle reportspan
|
||||
budgetps = dbg5 "budgetps" $ getPostings rspec budgetj priceoracle reportspan
|
||||
@ -107,7 +107,7 @@ budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport
|
||||
-- | Lay out a set of postings grouped by date span into a regular matrix with rows
|
||||
-- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
|
||||
-- from the columns.
|
||||
generateBudgetReport :: ReportOpts -> [DateSpan] -> Account (These BalanceData BalanceData) -> BudgetReport
|
||||
generateBudgetReport :: ReportOpts -> Maybe (PeriodData Day) -> Account (These BalanceData BalanceData) -> BudgetReport
|
||||
generateBudgetReport = generatePeriodicReport makeBudgetReportRow treeActualBalance flatActualBalance
|
||||
where
|
||||
treeActualBalance = these bdincludingsubs (const nullmixedamt) (const . bdincludingsubs)
|
||||
|
||||
@ -43,8 +43,7 @@ import Data.List (sortOn)
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import qualified Data.HashSet as HS
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified Data.IntSet as IS
|
||||
import Data.Maybe (fromMaybe, isJust, mapMaybe)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Ord (Down(..))
|
||||
import Data.Semigroup (sconcat)
|
||||
import Data.These (these)
|
||||
@ -163,7 +162,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
|
||||
subreportTotal (_, sr, increasestotal) =
|
||||
(if increasestotal then id else fmap maNegate) $ prTotals sr
|
||||
|
||||
cbr = CompoundPeriodicReport "" colspans subreports overalltotals
|
||||
cbr = CompoundPeriodicReport "" (maybePeriodDataToDateSpans colspans) subreports overalltotals
|
||||
|
||||
|
||||
-- | Remove any date queries and insert queries from the report span.
|
||||
@ -217,7 +216,7 @@ getPostings rspec@ReportSpec{_rsQuery=query, _rsReportOpts=ropts} j priceoracle
|
||||
|
||||
-- | Generate the 'Account' for the requested multi-balance report from a list
|
||||
-- of 'Posting's.
|
||||
generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [Posting] -> Account BalanceData
|
||||
generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe (PeriodData Day) -> [Posting] -> Account BalanceData
|
||||
generateMultiBalanceAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colspans =
|
||||
-- Add declared accounts if called with --declared and --empty
|
||||
(if (declared_ ropts && empty_ ropts) then addDeclaredAccounts rspec j else id)
|
||||
@ -263,8 +262,10 @@ addDeclaredAccounts rspec j acct =
|
||||
-- | Gather the account balance changes into a regular matrix, then
|
||||
-- accumulate and value amounts, as specified by the report options.
|
||||
-- Makes sure all report columns have an entry.
|
||||
calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [Posting] -> Account BalanceData
|
||||
calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colspans ps = -- PARTIAL:
|
||||
calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe (PeriodData Day) -> [Posting] -> Account BalanceData
|
||||
calculateReportAccount _ _ _ Nothing _ =
|
||||
accountFromBalances "root" $ periodDataFromList mempty [(nulldate, mempty)]
|
||||
calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle (Just colspans) ps =
|
||||
mapPeriodData rowbals changesAcct
|
||||
where
|
||||
-- The valued row amounts to be displayed: per-period changes,
|
||||
@ -291,23 +292,17 @@ calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colsp
|
||||
avalue = periodDataValuation ropts j priceoracle colspans
|
||||
|
||||
changesAcct = dbg5With (\x -> "calculateReportAccount changesAcct\n" ++ showAccounts x) .
|
||||
mapPeriodData (padPeriodData intervalStarts) $
|
||||
mapPeriodData (padPeriodData mempty colspans) $
|
||||
accountFromPostings getIntervalStartDate ps
|
||||
|
||||
getIntervalStartDate p = intToDay <$> IS.lookupLE (dayToInt $ getPostingDate p) intervalStarts
|
||||
getIntervalStartDate p = fst <$> lookupPeriodData (getPostingDate p) colspans
|
||||
getPostingDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))
|
||||
|
||||
intervalStarts = IS.fromList . map dayToInt $ case mapMaybe spanStart colspans of
|
||||
[] -> [nulldate] -- Deal with the case of the empty journal
|
||||
xs -> xs
|
||||
dayToInt = fromInteger . toModifiedJulianDay
|
||||
intToDay = ModifiedJulianDay . toInteger
|
||||
|
||||
-- | The valuation function to use for the chosen report options.
|
||||
-- This can call error in various situations.
|
||||
periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> [DateSpan]
|
||||
periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> PeriodData Day
|
||||
-> PeriodData BalanceData -> PeriodData BalanceData
|
||||
periodDataValuation ropts j priceoracle colspans =
|
||||
periodDataValuation ropts j priceoracle periodEnds =
|
||||
opPeriodData valueBalanceData balanceDataPeriodEnds
|
||||
where
|
||||
valueBalanceData :: Day -> BalanceData -> BalanceData
|
||||
@ -316,18 +311,9 @@ periodDataValuation ropts j priceoracle colspans =
|
||||
valueMixedAmount :: Day -> MixedAmount -> MixedAmount
|
||||
valueMixedAmount = mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle
|
||||
|
||||
-- The end date of a period is one before the beginning of the next period
|
||||
balanceDataPeriodEnds :: PeriodData Day
|
||||
balanceDataPeriodEnds = dbg5 "balanceDataPeriodEnds" $ case colspans of -- FIXME: Change colspans to nonempty list
|
||||
[DateSpan Nothing Nothing] -> periodDataFromList nulldate [(nulldate, nulldate)] -- Empty journal
|
||||
h:ds -> periodDataFromList (makeJustFst $ boundaries h) $ map (makeJust . boundaries) (h:ds)
|
||||
[] -> error' "balanceDataPeriodEnds: Shouldn't have empty colspans" -- PARTIAL: Shouldn't occur
|
||||
where
|
||||
boundaries spn = (spanStart spn, spanEnd spn)
|
||||
|
||||
makeJust (Just x, Just y) = (x, addDays (-1) y)
|
||||
makeJust _ = error' "balanceDataPeriodEnds: expected all non-initial spans to have start and end dates"
|
||||
makeJustFst (Just x, _) = addDays (-1) x
|
||||
makeJustFst _ = error' "balanceDataPeriodEnds: expected initial span to have an end date"
|
||||
balanceDataPeriodEnds = dbg5 "balanceDataPeriodEnds" $ addDays (-1) <$> periodEnds
|
||||
|
||||
-- | Mark which nodes of an 'Account' are boring, and so should be omitted from reports.
|
||||
markAccountBoring :: ReportSpec -> Account BalanceData -> Account BalanceData
|
||||
@ -381,7 +367,7 @@ markAccountBoring ReportSpec{_rsQuery=query,_rsReportOpts=ropts}
|
||||
-- | Build a report row.
|
||||
--
|
||||
-- Calculate the column totals. These are always the sum of column amounts.
|
||||
generateMultiBalanceReport :: ReportOpts -> [DateSpan] -> Account BalanceData -> MultiBalanceReport
|
||||
generateMultiBalanceReport :: ReportOpts -> Maybe (PeriodData Day) -> Account BalanceData -> MultiBalanceReport
|
||||
generateMultiBalanceReport ropts colspans =
|
||||
reportPercent ropts . generatePeriodicReport makeMultiBalanceReportRow bdincludingsubs id ropts colspans
|
||||
|
||||
@ -391,9 +377,9 @@ generateMultiBalanceReport ropts colspans =
|
||||
generatePeriodicReport :: Show c =>
|
||||
(forall a. ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c)
|
||||
-> (b -> MixedAmount) -> (c -> MixedAmount)
|
||||
-> ReportOpts -> [DateSpan] -> Account b -> PeriodicReport DisplayName c
|
||||
-> ReportOpts -> Maybe (PeriodData Day) -> Account b -> PeriodicReport DisplayName c
|
||||
generatePeriodicReport makeRow treeAmt flatAmt ropts colspans acct =
|
||||
PeriodicReport colspans (buildAndSort acct) totalsrow
|
||||
PeriodicReport (maybePeriodDataToDateSpans colspans) (buildAndSort acct) totalsrow
|
||||
where
|
||||
-- Build report rows and sort them
|
||||
buildAndSort = dbg5 "generatePeriodicReport buildAndSort" . case accountlistmode_ ropts of
|
||||
|
||||
@ -209,12 +209,12 @@ mkpostingsReportItem showdate showdesc wd mperiod p b =
|
||||
-- | 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 :: WhichDate -> Maybe Int -> Bool -> [DateSpan] -> [Posting] -> [SummaryPosting]
|
||||
summarisePostingsByInterval :: WhichDate -> Maybe Int -> Bool -> Maybe (PeriodData Day) -> [Posting] -> [SummaryPosting]
|
||||
summarisePostingsByInterval wd mdepth showempty colspans =
|
||||
concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps)
|
||||
-- Group postings into their columns. We try to be efficient, since
|
||||
-- there can possibly be a very large number of intervals (cf #1683)
|
||||
. groupByDateSpan showempty (postingDateOrDate2 wd) colspans
|
||||
. groupByDateSpan showempty (postingDateOrDate2 wd) (maybePeriodDataToDateSpans colspans)
|
||||
|
||||
-- | Given a date span (representing a report interval) and a list of
|
||||
-- postings within it, aggregate the postings into one summary posting per
|
||||
@ -416,7 +416,7 @@ tests_PostingsReport = testGroup "PostingsReport" [
|
||||
-}
|
||||
|
||||
,testCase "summarisePostingsByInterval" $
|
||||
summarisePostingsByInterval PrimaryDate Nothing False [DateSpan Nothing Nothing] [] @?= []
|
||||
summarisePostingsByInterval PrimaryDate Nothing False Nothing [] @?= []
|
||||
|
||||
-- ,tests_summarisePostingsInDateSpan = [
|
||||
-- "summarisePostingsInDateSpan" ~: do
|
||||
|
||||
@ -677,7 +677,7 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo
|
||||
_ -> spanEnd <=< latestSpanContaining (historical : spans)
|
||||
|
||||
historical = DateSpan Nothing $ (fmap Exact . spanStart) =<< headMay spans
|
||||
spans = snd $ reportSpanBothDates j rspec
|
||||
spans = maybePeriodDataToDateSpans . snd $ reportSpanBothDates j rspec
|
||||
styles = journalCommodityStyles j
|
||||
err = error' "journalApplyValuationFromOpts: expected all spans to have an end date"
|
||||
|
||||
@ -778,18 +778,18 @@ sortKeysDescription = "date, desc, account, amount, absamount" -- 'description'
|
||||
-- (or non-future market price date, when doing an end value report) is used.
|
||||
-- If none of these things are present, the null date span is returned.
|
||||
-- The report sub-periods caused by a report interval, if any, are also returned.
|
||||
reportSpan :: Journal -> ReportSpec -> (DateSpan, [DateSpan])
|
||||
reportSpan :: Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
|
||||
reportSpan = reportSpanHelper False
|
||||
-- Note: In end value reports, the report end date and valuation date are the same.
|
||||
-- If valuation date ever needs to be different, journalApplyValuationFromOptsWith is the place.
|
||||
|
||||
-- | Like reportSpan, but considers both primary and secondary dates, not just one or the other.
|
||||
reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, [DateSpan])
|
||||
reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
|
||||
reportSpanBothDates = reportSpanHelper True
|
||||
|
||||
reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, [DateSpan])
|
||||
reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
|
||||
reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts, _rsDay=today} =
|
||||
(enlargedreportspan, if not (null intervalspans) then intervalspans else [enlargedreportspan])
|
||||
(enlargedreportspan, dateSpansToPeriodData $ if not (null intervalspans) then intervalspans else [enlargedreportspan])
|
||||
where
|
||||
-- The date span specified by -b/-e/-p options and query args if any.
|
||||
requestedspan = dbg3 "requestedspan" $
|
||||
|
||||
@ -34,16 +34,18 @@ showHistogram :: ReportSpec -> Journal -> String
|
||||
showHistogram rspec@ReportSpec{_rsQuery=q} j =
|
||||
concatMap (printDayWith countBar) spanps
|
||||
where
|
||||
spans = filter (DateSpan Nothing Nothing /=) . snd . reportSpan j $ case rspec ^. interval of
|
||||
mspans = snd . reportSpan j $ case rspec ^. interval of
|
||||
NoInterval -> set interval (Days 1) rspec
|
||||
_ -> rspec
|
||||
spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans]
|
||||
spanps = case mspans of
|
||||
Nothing -> []
|
||||
Just x -> map (\spn -> (spn, filter (postingInRange spn) ps)) . snd $ periodDataToList x
|
||||
postingInRange (b, e) p = postingDate p >= b && postingDate p < e
|
||||
-- same as Register
|
||||
-- should count transactions, not postings ?
|
||||
-- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
|
||||
ps = sortOn postingDate $ filter (q `matchesPosting`) $ journalPostings j
|
||||
|
||||
printDayWith f (DateSpan (Just b) _, ps) = printf "%s %s\n" (show $ fromEFDay b) (f ps)
|
||||
printDayWith _ _ = error' "Expected start date for DateSpan" -- PARTIAL:
|
||||
printDayWith f ((b, _), ps) = printf "%s %s\n" (show b) (f ps)
|
||||
|
||||
countBar ps = replicate (length ps) barchar
|
||||
|
||||
@ -94,26 +94,30 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
|
||||
when (null trans) $
|
||||
error' "No relevant transactions found. Check your investments query"
|
||||
|
||||
let (fullPeriod, spans) = reportSpan filteredj rspec
|
||||
let (fullPeriodDateSpan, mspans) = reportSpan filteredj rspec
|
||||
|
||||
let processSpan (DateSpan Nothing _) = error' "Undefined start of the period - will be unable to compute the rates of return"
|
||||
processSpan (DateSpan _ Nothing) = error' "Undefined end of the period - will be unable to compute the rates of return"
|
||||
processSpan spn@(DateSpan (Just begin) (Just end)) = do
|
||||
let err = error' "Undefined start or end of the period - will be unable to compute the rates of return"
|
||||
spans = maybe err (snd . periodDataToList) mspans
|
||||
fullPeriod = case fullPeriodDateSpan of
|
||||
DateSpan (Just b) (Just e) -> (fromEFDay b, fromEFDay e)
|
||||
_ -> err
|
||||
|
||||
let processSpan (b, e) = do
|
||||
-- Spans are [begin,end), and end is 1 day after the actual end date we are interested in
|
||||
let
|
||||
b = fromEFDay begin
|
||||
e = fromEFDay end
|
||||
spn = DateSpan (Just $ Exact b) (Just $ Exact e)
|
||||
|
||||
cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue e d amt))
|
||||
|
||||
valueBefore = dbg3 "valueBefore" $
|
||||
mixedAmountValue e b $
|
||||
total trans (And [ investmentsQuery
|
||||
, Date (DateSpan Nothing (Just begin))])
|
||||
, Date (DateSpan Nothing (Just $ Exact b))])
|
||||
|
||||
valueAfter = dbg3 "valueAfter" $
|
||||
mixedAmountValue e e $
|
||||
total trans (And [investmentsQuery
|
||||
, Date (DateSpan Nothing (Just end))])
|
||||
, Date (DateSpan Nothing (Just $ Exact e))])
|
||||
|
||||
cashFlow = dbg3 "cashFlow" $
|
||||
cashFlowApplyCostValue $
|
||||
|
||||
@ -57,7 +57,7 @@ stats opts@CliOpts{rawopts_=rawopts, reportspec_=rspec, progstarttime_} j = do
|
||||
l = ledgerFromJournal q j
|
||||
intervalspans = snd $ reportSpanBothDates j rspec
|
||||
ismultiperiod = length intervalspans > 1
|
||||
(ls, txncounts) = unzip $ map (showLedgerStats verbose l today) intervalspans
|
||||
(ls, txncounts) = unzip . map (showLedgerStats verbose l today) $ maybePeriodDataToDateSpans intervalspans
|
||||
numtxns = sum txncounts
|
||||
txt = (if ismultiperiod then id else TL.init) $ TB.toLazyText $ unlinesB ls
|
||||
writeOutputLazyText opts txt
|
||||
|
||||
@ -239,3 +239,23 @@ $ hledger -f sample.journal balance --flat --empty
|
||||
--------------------
|
||||
0
|
||||
|
||||
# ** 19. Shows zero if period starts after all transactions
|
||||
$ hledger -f sample.journal balance -b 3000-01-01
|
||||
--------------------
|
||||
0
|
||||
|
||||
# ** 20. Shows zero if period ends before all transactions
|
||||
$ hledger -f sample.journal balance -e 1000-01-01
|
||||
--------------------
|
||||
0
|
||||
|
||||
# ** 20. Shows zero if period starts and ends before all transactions
|
||||
$ hledger -f sample.journal balance -b 1000-01-01 -e 1000-01-02
|
||||
--------------------
|
||||
0
|
||||
|
||||
# ** 19. Shows zero on empty journal
|
||||
<
|
||||
$ hledger -f- balance
|
||||
--------------------
|
||||
0
|
||||
|
||||
@ -235,10 +235,9 @@ $ hledger -f- close
|
||||
>=
|
||||
|
||||
# ** 16. "override the closing date ... by specifying a report period, where last day of the report period will be the closing date"
|
||||
# With no data to close in the period, this is currently giving an error. XXX
|
||||
$ hledger -f- close -e 100000-01-01
|
||||
>2 /Error: balanceDataPeriodEnds: expected initial span to have an end date/
|
||||
>=1
|
||||
$ hledger -f- close -e 10000
|
||||
> /9999-12-31 closing balances/
|
||||
>=
|
||||
|
||||
# ** 17. close (and print) should add trailing decimal marks when needed to posting amounts and costs.
|
||||
<
|
||||
|
||||
Loading…
Reference in New Issue
Block a user