diff --git a/CHANGES.md b/CHANGES.md --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,8 @@ For user-visible changes, see the hledger package changelog. +# 1.50.1 2025-09-16 + # 1.50 2025-09-03 Breaking changes diff --git a/Hledger/Data/PeriodData.hs b/Hledger/Data/PeriodData.hs --- a/Hledger/Data/PeriodData.hs +++ b/Hledger/Data/PeriodData.hs @@ -9,13 +9,19 @@ -} module Hledger.Data.PeriodData ( periodDataFromList +, periodDataToList , lookupPeriodData +, lookupPeriodDataOrHistorical , insertPeriodData , opPeriodData , mergePeriodData , padPeriodData +, periodDataToDateSpans +, maybePeriodDataToDateSpans +, dateSpansToPeriodData + , tests_PeriodData ) where @@ -24,18 +30,17 @@ #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 @@ 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 @@ -- | 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,10 +122,38 @@ 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 diff --git a/Hledger/Data/Posting.hs b/Hledger/Data/Posting.hs --- a/Hledger/Data/Posting.hs +++ b/Hledger/Data/Posting.hs @@ -46,8 +46,6 @@ postingDate, postingDate2, postingDateOrDate2, - isPostingInDateSpan, - isPostingInDateSpan', -- * account name operations accountNamesFromPostings, -- * comment/tag operations @@ -107,7 +105,7 @@ 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 @@ -443,15 +441,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 diff --git a/Hledger/Read/Common.hs b/Hledger/Read/Common.hs --- a/Hledger/Read/Common.hs +++ b/Hledger/Read/Common.hs @@ -1025,7 +1025,7 @@ } -- Parse a Ledger-style lot cost, --- {UNITCOST} or {{TOTALCOST}} or {=FIXEDUNITCOST} or {{=FIXEDTOTALCOST}}, +-- {UNITCOST} or {{TOTALCOST}} or {=FIXEDUNITCOST} or {{=FIXEDTOTALCOST}} or {}, -- and discard it. lotcostp :: JournalParser m () lotcostp = @@ -1036,7 +1036,7 @@ lift skipNonNewlineSpaces _fixed <- fmap isJust $ optional $ char '=' lift skipNonNewlineSpaces - _a <- simpleamountp False + _a <- option 0 $ simpleamountp False lift skipNonNewlineSpaces char '}' when (doublebrace) $ void $ char '}' diff --git a/Hledger/Reports/BudgetReport.hs b/Hledger/Reports/BudgetReport.hs --- a/Hledger/Reports/BudgetReport.hs +++ b/Hledger/Reports/BudgetReport.hs @@ -19,12 +19,12 @@ 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 @@ -- 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 @@ -- | 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) diff --git a/Hledger/Reports/MultiBalanceReport.hs b/Hledger/Reports/MultiBalanceReport.hs --- a/Hledger/Reports/MultiBalanceReport.hs +++ b/Hledger/Reports/MultiBalanceReport.hs @@ -43,8 +43,7 @@ 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 @@ 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 @@ -- | 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 @@ -- | 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 @@ 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 @@ 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 @@ -- | 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 @@ 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 @@ -431,6 +417,8 @@ -- Build the row for an account at a given depth with some number of boring parents mkRows :: Bool -> Int -> Int -> Account b -> [PeriodicReportRow DisplayName c] mkRows isRoot d boringParents acct + -- Account is boring and has no interesting children at any depth, so we stop + | allBoring acct = [] -- Account is a boring root account, and should be bypassed entirely | aboring acct && isRoot = buildSubrows d 0 -- Account is boring and has been dropped, so should be skipped and move up the hierarchy @@ -444,6 +432,7 @@ buildSubrows i b = concatMap (mkRows False i b) $ asubs acct canOmitParents = flat_ ropts || not (no_elide_ ropts) + allBoring a = aboring a && all allBoring (asubs a) balance = case accountlistmode_ ropts of ALTree -> bdincludingsubs ALFlat -> bdexcludingsubs diff --git a/Hledger/Reports/PostingsReport.hs b/Hledger/Reports/PostingsReport.hs --- a/Hledger/Reports/PostingsReport.hs +++ b/Hledger/Reports/PostingsReport.hs @@ -209,12 +209,12 @@ -- | 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 @@ -} ,testCase "summarisePostingsByInterval" $ - summarisePostingsByInterval PrimaryDate Nothing False [DateSpan Nothing Nothing] [] @?= [] + summarisePostingsByInterval PrimaryDate Nothing False Nothing [] @?= [] -- ,tests_summarisePostingsInDateSpan = [ -- "summarisePostingsInDateSpan" ~: do diff --git a/Hledger/Reports/ReportOptions.hs b/Hledger/Reports/ReportOptions.hs --- a/Hledger/Reports/ReportOptions.hs +++ b/Hledger/Reports/ReportOptions.hs @@ -677,7 +677,7 @@ _ -> 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 @@ -- (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" $ diff --git a/hledger-lib.cabal b/hledger-lib.cabal --- a/hledger-lib.cabal +++ b/hledger-lib.cabal @@ -1,11 +1,11 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.38.2. +-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack name: hledger-lib -version: 1.50 +version: 1.50.1 synopsis: A library providing the core functionality of hledger description: This library contains hledger's core functionality. It is used by most hledger* packages so that they support the same