slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix: balance: Correctly handle empty journals (#2452)

Browse Source 
Eliminate several partial functions.
This commit is contained in:
Stephen Morgan 2025-09-08 19:55:44 +02:00 committed by Simon Michael
parent 1d56db0ad8
commit aad61e465d
11 changed files with 131 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
hledger-lib/Hledger/Data/PeriodData.hs
View File

@ -9,13 +9,19 @@ Report periods are assumed to be contiguous, and represented only by start dates
-} -}
module Hledger.Data.PeriodData module Hledger.Data.PeriodData
( periodDataFromList ( periodDataFromList
, periodDataToList
, lookupPeriodData , lookupPeriodData
, lookupPeriodDataOrHistorical
, insertPeriodData , insertPeriodData
, opPeriodData , opPeriodData
, mergePeriodData , mergePeriodData
, padPeriodData , padPeriodData
, periodDataToDateSpans
, maybePeriodDataToDateSpans
, dateSpansToPeriodData
, tests_PeriodData , tests_PeriodData
) where ) where
@ -24,18 +30,17 @@ import Data.Foldable1 (Foldable1(..))
#else #else
import Control.Applicative (liftA2) import Control.Applicative (liftA2)
#endif #endif
import Data.Bifunctor (first)
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
#if !MIN_VERSION_base(4,20,0) #if !MIN_VERSION_base(4,20,0)
import Data.List (foldl') import Data.List (foldl')
#endif #endif
import Data.Time (Day(..), fromGregorian) import Data.Time (Day(..), fromGregorian)
import Test.Tasty (testGroup)
import Test.Tasty.HUnit ((@?=), testCase)
import Hledger.Data.Amount import Hledger.Data.Amount
import Hledger.Data.Dates
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Utils
instance Show a => Show (PeriodData a) where instance Show a => Show (PeriodData a) where
@ -44,7 +49,7 @@ instance Show a => Show (PeriodData a) where
showString "PeriodData" showString "PeriodData"
. showString "{ pdpre = " . shows h . showString "{ pdpre = " . shows h
. showString ", pdperiods = " . 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 '}' . showChar '}'
instance Foldable PeriodData where instance Foldable PeriodData where
@ -73,18 +78,32 @@ instance Monoid a => Monoid (PeriodData a) where
-- | Construct an 'PeriodData' from a list. -- | Construct an 'PeriodData' from a list.
periodDataFromList :: a -> [(Day, a)] -> PeriodData a 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'. -- | Convert 'PeriodData' to a list of pairs.
lookupPeriodData :: Day -> PeriodData a -> a periodDataToList :: PeriodData a -> (a, [(Day, a)])
lookupPeriodData d (PeriodData h as) = periodDataToList (PeriodData h as) = (h, map (\(s, e) -> (intToDay s, e)) $ IM.toList as)
maybe h snd $ IM.lookupLE (fromInteger $ toModifiedJulianDay d) 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'. -- | Add account balance information to the appropriate location in 'PeriodData'.
insertPeriodData :: Semigroup a => Maybe Day -> a -> PeriodData a -> PeriodData a insertPeriodData :: Semigroup a => Maybe Day -> a -> PeriodData a -> PeriodData a
insertPeriodData mday b balances = case mday of insertPeriodData mday b balances = case mday of
Nothing -> balances{pdpre = pdpre balances <> b} 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. -- | 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 where
merge = IM.mergeWithKey (\_ x y -> Just $ f x y) (fmap only1) (fmap only2) 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. -- | Pad out the datemap of a 'PeriodData' so that every key from another 'PeriodData' is present.
padPeriodData :: Monoid a => IS.IntSet -> PeriodData a -> PeriodData a padPeriodData :: a -> PeriodData b -> PeriodData a -> PeriodData a
padPeriodData keys bal = bal{pdperiods = pdperiods bal <> IM.fromSet (const mempty) keys} 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
tests_PeriodData = tests_PeriodData =

13
hledger-lib/Hledger/Data/Posting.hs
View File

@ -46,8 +46,6 @@ module Hledger.Data.Posting (
postingDate, postingDate,
postingDate2, postingDate2,
postingDateOrDate2, postingDateOrDate2,
isPostingInDateSpan,
isPostingInDateSpan',
-- * account name operations -- * account name operations
accountNamesFromPostings, accountNamesFromPostings,
-- * comment/tag operations -- * comment/tag operations
@ -107,7 +105,7 @@ import Hledger.Utils
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.Amount import Hledger.Data.Amount
import Hledger.Data.AccountName import Hledger.Data.AccountName
import Hledger.Data.Dates (nulldate, spanContainsDate) import Hledger.Data.Dates (nulldate)
import Hledger.Data.Valuation import Hledger.Data.Valuation
@ -444,15 +442,6 @@ relatedPostings :: Posting -> [Posting]
relatedPostings p@Posting{ptransaction=Just t} = filter (/= p) $ tpostings t relatedPostings p@Posting{ptransaction=Just t} = filter (/= p) $ tpostings t
relatedPostings _ = [] 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 :: Posting -> Bool
isEmptyPosting = mixedAmountLooksZero . pamount isEmptyPosting = mixedAmountLooksZero . pamount

6
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -19,12 +19,12 @@ import Control.Monad ((>=>))
import Data.Bifunctor (bimap) import Data.Bifunctor (bimap)
import Data.Foldable (toList) import Data.Foldable (toList)
import Data.List (find, maximumBy, intercalate) import Data.List (find, maximumBy, intercalate)
import Data.List.Extra (nubSort)
import Data.Maybe (catMaybes, fromMaybe, isJust) import Data.Maybe (catMaybes, fromMaybe, isJust)
import Data.Ord (comparing) import Data.Ord (comparing)
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.Text as T import qualified Data.Text as T
import Data.These (These(..), these) import Data.These (These(..), these)
import Data.Time (Day)
import Safe (minimumDef) import Safe (minimumDef)
import Hledger.Data 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; -- 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. -- it should be safe to replace it with the latter, so they combine well.
NoInterval -> actualspans NoInterval -> actualspans
_ -> nubSort . filter (/= nulldatespan) $ actualspans ++ budgetspans _ -> maybe id (padPeriodData nulldate) budgetspans <$> actualspans
actualps = dbg5 "actualps" $ getPostings rspec actualj priceoracle reportspan actualps = dbg5 "actualps" $ getPostings rspec actualj priceoracle reportspan
budgetps = dbg5 "budgetps" $ getPostings rspec budgetj 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 -- | 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 -- given by AccountName and columns by DateSpan, then generate a MultiBalanceReport
-- from the columns. -- 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 generateBudgetReport = generatePeriodicReport makeBudgetReportRow treeActualBalance flatActualBalance
where where
treeActualBalance = these bdincludingsubs (const nullmixedamt) (const . bdincludingsubs) treeActualBalance = these bdincludingsubs (const nullmixedamt) (const . bdincludingsubs)

46
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -43,8 +43,7 @@ import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty((:|))) import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.HashSet as HS import qualified Data.HashSet as HS
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS import Data.Maybe (fromMaybe, isJust)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Ord (Down(..)) import Data.Ord (Down(..))
import Data.Semigroup (sconcat) import Data.Semigroup (sconcat)
import Data.These (these) import Data.These (these)
@ -163,7 +162,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
subreportTotal (_, sr, increasestotal) = subreportTotal (_, sr, increasestotal) =
(if increasestotal then id else fmap maNegate) $ prTotals sr (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. -- | 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 -- | Generate the 'Account' for the requested multi-balance report from a list
-- of 'Posting's. -- 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 = generateMultiBalanceAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colspans =
-- Add declared accounts if called with --declared and --empty -- Add declared accounts if called with --declared and --empty
(if (declared_ ropts && empty_ ropts) then addDeclaredAccounts rspec j else id) (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 -- | Gather the account balance changes into a regular matrix, then
-- accumulate and value amounts, as specified by the report options. -- accumulate and value amounts, as specified by the report options.
-- Makes sure all report columns have an entry. -- Makes sure all report columns have an entry.
calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> [DateSpan] -> [Posting] -> Account BalanceData calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe (PeriodData Day) -> [Posting] -> Account BalanceData
calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle colspans ps = -- PARTIAL: calculateReportAccount _ _ _ Nothing _ =
accountFromBalances "root" $ periodDataFromList mempty [(nulldate, mempty)]
calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle (Just colspans) ps =
mapPeriodData rowbals changesAcct mapPeriodData rowbals changesAcct
where where
-- The valued row amounts to be displayed: per-period changes, -- 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 avalue = periodDataValuation ropts j priceoracle colspans
changesAcct = dbg5With (\x -> "calculateReportAccount changesAcct\n" ++ showAccounts x) . changesAcct = dbg5With (\x -> "calculateReportAccount changesAcct\n" ++ showAccounts x) .
mapPeriodData (padPeriodData intervalStarts) $ mapPeriodData (padPeriodData mempty colspans) $
accountFromPostings getIntervalStartDate ps accountFromPostings getIntervalStartDate ps
getIntervalStartDate p = intToDay <$> IS.lookupLE (dayToInt $ getPostingDate p) intervalStarts getIntervalStartDate p = fst <$> lookupPeriodData (getPostingDate p) colspans
getPostingDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec)) 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. -- | The valuation function to use for the chosen report options.
-- This can call error in various situations. -- This can call error in various situations.
periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> [DateSpan] periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> PeriodData Day
-> PeriodData BalanceData -> PeriodData BalanceData -> PeriodData BalanceData -> PeriodData BalanceData
periodDataValuation ropts j priceoracle colspans = periodDataValuation ropts j priceoracle periodEnds =
opPeriodData valueBalanceData balanceDataPeriodEnds opPeriodData valueBalanceData balanceDataPeriodEnds
where where
valueBalanceData :: Day -> BalanceData -> BalanceData valueBalanceData :: Day -> BalanceData -> BalanceData
@ -316,18 +311,9 @@ periodDataValuation ropts j priceoracle colspans =
valueMixedAmount :: Day -> MixedAmount -> MixedAmount valueMixedAmount :: Day -> MixedAmount -> MixedAmount
valueMixedAmount = mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle valueMixedAmount = mixedAmountApplyValuationAfterSumFromOptsWith ropts j priceoracle
-- The end date of a period is one before the beginning of the next period
balanceDataPeriodEnds :: PeriodData Day balanceDataPeriodEnds :: PeriodData Day
balanceDataPeriodEnds = dbg5 "balanceDataPeriodEnds" $ case colspans of -- FIXME: Change colspans to nonempty list balanceDataPeriodEnds = dbg5 "balanceDataPeriodEnds" $ addDays (-1) <$> periodEnds
[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"
-- | Mark which nodes of an 'Account' are boring, and so should be omitted from reports. -- | Mark which nodes of an 'Account' are boring, and so should be omitted from reports.
markAccountBoring :: ReportSpec -> Account BalanceData -> Account BalanceData markAccountBoring :: ReportSpec -> Account BalanceData -> Account BalanceData
@ -381,7 +367,7 @@ markAccountBoring ReportSpec{_rsQuery=query,_rsReportOpts=ropts}
-- | Build a report row. -- | Build a report row.
-- --
-- Calculate the column totals. These are always the sum of column amounts. -- 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 = generateMultiBalanceReport ropts colspans =
reportPercent ropts . generatePeriodicReport makeMultiBalanceReportRow bdincludingsubs id ropts colspans reportPercent ropts . generatePeriodicReport makeMultiBalanceReportRow bdincludingsubs id ropts colspans
@ -391,9 +377,9 @@ generateMultiBalanceReport ropts colspans =
generatePeriodicReport :: Show c => generatePeriodicReport :: Show c =>
(forall a. ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c) (forall a. ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c)
-> (b -> MixedAmount) -> (c -> MixedAmount) -> (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 = generatePeriodicReport makeRow treeAmt flatAmt ropts colspans acct =
PeriodicReport colspans (buildAndSort acct) totalsrow PeriodicReport (maybePeriodDataToDateSpans colspans) (buildAndSort acct) totalsrow
where where
-- Build report rows and sort them -- Build report rows and sort them
buildAndSort = dbg5 "generatePeriodicReport buildAndSort" . case accountlistmode_ ropts of buildAndSort = dbg5 "generatePeriodicReport buildAndSort" . case accountlistmode_ ropts of

6
hledger-lib/Hledger/Reports/PostingsReport.hs
View File

@ -209,12 +209,12 @@ mkpostingsReportItem showdate showdesc wd mperiod p b =
-- | Convert a list of postings into summary postings, one per interval, -- | Convert a list of postings into summary postings, one per interval,
-- aggregated to the specified depth if any. -- aggregated to the specified depth if any.
-- Each summary posting will have a non-Nothing interval end date. -- 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 = summarisePostingsByInterval wd mdepth showempty colspans =
concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps) concatMap (\(s,ps) -> summarisePostingsInDateSpan s wd mdepth showempty ps)
-- Group postings into their columns. We try to be efficient, since -- Group postings into their columns. We try to be efficient, since
-- there can possibly be a very large number of intervals (cf #1683) -- 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 -- | Given a date span (representing a report interval) and a list of
-- postings within it, aggregate the postings into one summary posting per -- postings within it, aggregate the postings into one summary posting per
@ -416,7 +416,7 @@ tests_PostingsReport = testGroup "PostingsReport" [
-} -}
,testCase "summarisePostingsByInterval" $ ,testCase "summarisePostingsByInterval" $
summarisePostingsByInterval PrimaryDate Nothing False [DateSpan Nothing Nothing] [] @?= [] summarisePostingsByInterval PrimaryDate Nothing False Nothing [] @?= []
-- ,tests_summarisePostingsInDateSpan = [ -- ,tests_summarisePostingsInDateSpan = [
-- "summarisePostingsInDateSpan" ~: do -- "summarisePostingsInDateSpan" ~: do

10
hledger-lib/Hledger/Reports/ReportOptions.hs
View File

@ -677,7 +677,7 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo
_ -> spanEnd <=< latestSpanContaining (historical : spans) _ -> spanEnd <=< latestSpanContaining (historical : spans)
historical = DateSpan Nothing $ (fmap Exact . spanStart) =<< headMay spans historical = DateSpan Nothing $ (fmap Exact . spanStart) =<< headMay spans
spans = snd $ reportSpanBothDates j rspec spans = maybePeriodDataToDateSpans . snd $ reportSpanBothDates j rspec
styles = journalCommodityStyles j styles = journalCommodityStyles j
err = error' "journalApplyValuationFromOpts: expected all spans to have an end date" 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. -- (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. -- 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. -- 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 reportSpan = reportSpanHelper False
-- Note: In end value reports, the report end date and valuation date are the same. -- 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. -- 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. -- | 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 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} = 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 where
-- The date span specified by -b/-e/-p options and query args if any. -- The date span specified by -b/-e/-p options and query args if any.
requestedspan = dbg3 "requestedspan" $ requestedspan = dbg3 "requestedspan" $

10
hledger/Hledger/Cli/Commands/Activity.hs
View File

@ -34,16 +34,18 @@ showHistogram :: ReportSpec -> Journal -> String
showHistogram rspec@ReportSpec{_rsQuery=q} j = showHistogram rspec@ReportSpec{_rsQuery=q} j =
concatMap (printDayWith countBar) spanps concatMap (printDayWith countBar) spanps
where 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 NoInterval -> set interval (Days 1) rspec
_ -> 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 -- same as Register
-- should count transactions, not postings ? -- should count transactions, not postings ?
-- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j -- ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
ps = sortOn postingDate $ filter (q `matchesPosting`) $ 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 f ((b, _), ps) = printf "%s %s\n" (show b) (f ps)
printDayWith _ _ = error' "Expected start date for DateSpan" -- PARTIAL:
countBar ps = replicate (length ps) barchar countBar ps = replicate (length ps) barchar

20
hledger/Hledger/Cli/Commands/Roi.hs
View File

@ -94,26 +94,30 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
when (null trans) $ when (null trans) $
error' "No relevant transactions found. Check your investments query" 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" let err = error' "Undefined start or end 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" spans = maybe err (snd . periodDataToList) mspans
processSpan spn@(DateSpan (Just begin) (Just end)) = do 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 -- Spans are [begin,end), and end is 1 day after the actual end date we are interested in
let let
b = fromEFDay begin spn = DateSpan (Just $ Exact b) (Just $ Exact e)
e = fromEFDay end
cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue e d amt)) cashFlowApplyCostValue = map (\(d,amt) -> (d,mixedAmountValue e d amt))
valueBefore = dbg3 "valueBefore" $ valueBefore = dbg3 "valueBefore" $
mixedAmountValue e b $ mixedAmountValue e b $
total trans (And [ investmentsQuery total trans (And [ investmentsQuery
, Date (DateSpan Nothing (Just begin))]) , Date (DateSpan Nothing (Just $ Exact b))])
valueAfter = dbg3 "valueAfter" $ valueAfter = dbg3 "valueAfter" $
mixedAmountValue e e $ mixedAmountValue e e $
total trans (And [investmentsQuery total trans (And [investmentsQuery
, Date (DateSpan Nothing (Just end))]) , Date (DateSpan Nothing (Just $ Exact e))])
cashFlow = dbg3 "cashFlow" $ cashFlow = dbg3 "cashFlow" $
cashFlowApplyCostValue $ cashFlowApplyCostValue $

2
hledger/Hledger/Cli/Commands/Stats.hs
View File

@ -57,7 +57,7 @@ stats opts@CliOpts{rawopts_=rawopts, reportspec_=rspec, progstarttime_} j = do
l = ledgerFromJournal q j l = ledgerFromJournal q j
intervalspans = snd $ reportSpanBothDates j rspec intervalspans = snd $ reportSpanBothDates j rspec
ismultiperiod = length intervalspans > 1 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 numtxns = sum txncounts
txt = (if ismultiperiod then id else TL.init) $ TB.toLazyText $ unlinesB ls txt = (if ismultiperiod then id else TL.init) $ TB.toLazyText $ unlinesB ls
writeOutputLazyText opts txt writeOutputLazyText opts txt

20
hledger/test/balance/balance.test
View File

@ -239,3 +239,23 @@ $ hledger -f sample.journal balance --flat --empty
-------------------- --------------------
0 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

7
hledger/test/close.test
View File

@ -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" # ** 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 10000
$ hledger -f- close -e 100000-01-01 > /9999-12-31 closing balances/
>2 /Error: balanceDataPeriodEnds: expected initial span to have an end date/ >=
>=1
# ** 17. close (and print) should add trailing decimal marks when needed to posting amounts and costs. # ** 17. close (and print) should add trailing decimal marks when needed to posting amounts and costs.
< <