fix:PeriodData: simplify, use Day keys [#2479]

This is clearer and slightly better-performing than using Integer.
This commit is contained in:
Simon Michael 2025-10-11 10:44:59 -10:00
parent 438c4a0469
commit bd0a45d448
6 changed files with 12 additions and 19 deletions

View File

@ -387,7 +387,7 @@ tests_Account = testGroup "Account" [
testCase "no postings, no days" $
accountFromPostings undefined [] @?= accountTree "root" []
,testCase "no postings, only 2000-01-01" $
allAccounts (all (\d -> (ModifiedJulianDay $ toInteger d) == fromGregorian 2000 01 01) . M.keys . pdperiods . adata)
allAccounts (all (== fromGregorian 2000 01 01) . M.keys . pdperiods . adata)
(accountFromPostings undefined []) @? "Not all adata have exactly 2000-01-01"
]
]

View File

@ -128,7 +128,7 @@ unionDayPartitions (DayPartition (PeriodData h as)) (DayPartition (PeriodData h'
dayPartitionStartEnd :: DayPartition -> (Day, Day)
dayPartitionStartEnd (DayPartition (PeriodData _ ds)) =
-- Guaranteed not to error because the IntMap is non-empty.
(intToDay . fst $ M.findMin ds, snd $ M.findMax ds)
(fst $ M.findMin ds, snd $ M.findMax ds)
-- | Find the start and end dates of the period within a 'DayPartition' which contains a given day.
-- If the day is after the end of the last period, it is assumed to be within the last period.
@ -241,8 +241,6 @@ intervalBoundaryBefore i d =
Just ((start, _) :| _ ) -> start
_ -> d
intToDay = ModifiedJulianDay . toInteger
-- tests:

View File

@ -26,7 +26,6 @@ import Data.Maybe (fromMaybe)
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TB
import Data.Map qualified as M
import Data.Time (Day (..))
import Text.Megaparsec (Pos, SourcePos, mkPos, unPos)
import Hledger.Data.Types
@ -161,7 +160,7 @@ instance ToJSON BalanceData
instance ToJSON a => ToJSON (PeriodData a) where
toJSON a = object
[ "pdpre" .= pdpre a
, "pdperiods" .= map (\(d, x) -> (ModifiedJulianDay (toInteger d), x)) (M.toList $ pdperiods a)
, "pdperiods" .= (M.toList $ pdperiods a)
]
instance ToJSON a => ToJSON (Account a) where
@ -227,7 +226,7 @@ instance FromJSON BalanceData
instance FromJSON a => FromJSON (PeriodData a) where
parseJSON = withObject "PeriodData" $ \v -> PeriodData
<$> v .: "pdpre"
<*> (M.fromList . map (\(d, x) -> (fromInteger $ toModifiedJulianDay d, x)) <$> v .: "pdperiods")
<*> (M.fromList <$> v .: "pdperiods")
-- XXX The ToJSON instance replaces subaccounts with just names.
-- Here we should try to make use of those to reconstruct the

View File

@ -26,7 +26,6 @@ import Data.Foldable1 (Foldable1(..))
#else
import Control.Applicative (liftA2)
#endif
import Data.Bifunctor (first)
#if !MIN_VERSION_base(4,20,0)
import Data.List (foldl')
#endif
@ -44,7 +43,7 @@ instance Show a => Show (PeriodData a) where
showString "PeriodData"
. showString "{ pdpre = " . shows h
. showString ", pdperiods = "
. showString "fromList " . shows (map (\(day, x) -> (intToDay day, x)) $ M.toList ds)
. showString "fromList " . shows (M.toList ds)
. showChar '}'
instance Foldable PeriodData where
@ -73,17 +72,17 @@ instance Monoid a => Monoid (PeriodData a) where
-- | Construct a 'PeriodData' from a historical data value and a list of (period start, period data) pairs.
periodDataFromList :: a -> [(Day, a)] -> PeriodData a
periodDataFromList h = PeriodData h . M.fromList . map (\(d, a) -> (dayToInt d, a))
periodDataFromList h = PeriodData h . M.fromList
-- | Convert 'PeriodData' to a historical data value and a list of (period start, period data) pairs.
periodDataToList :: PeriodData a -> (a, [(Day, a)])
periodDataToList (PeriodData h as) = (h, map (\(s, e) -> (intToDay s, e)) $ M.toList as)
periodDataToList (PeriodData h as) = (h, M.toList as)
-- | Get the data for the period containing the given 'Day', and that period's start date.
-- If the day is after the end of the last period, it is assumed to be within the last period.
-- If the day is before the start of the first period (ie, in the historical period), return Nothing.
lookupPeriodData :: Day -> PeriodData a -> Maybe (Day, a)
lookupPeriodData d (PeriodData _ as) = first intToDay <$> M.lookupLE (dayToInt d) as
lookupPeriodData d (PeriodData _ as) = M.lookupLE d as
-- | Get the data for the period containing the given 'Day', and that period's start date.
-- If the day is after the end of the last period, it is assumed to be within the last period.
@ -98,7 +97,7 @@ lookupPeriodDataOrHistorical d pd@(PeriodData h _) = case lookupPeriodData d pd
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 = M.insertWith (<>) (dayToInt day) b $ pdperiods balances}
Just day -> balances{pdperiods = M.insertWith (<>) day b $ pdperiods balances}
-- | Merge two 'PeriodData', using the given operation to combine their data values.
--
@ -119,8 +118,6 @@ mergePeriodData only1 only2 f = \(PeriodData h1 as1) (PeriodData h2 as2) ->
padPeriodData :: a -> PeriodData b -> PeriodData a -> PeriodData a
padPeriodData x pad bal = bal{pdperiods = pdperiods bal <> (x <$ pdperiods pad)}
intToDay = ModifiedJulianDay . toInteger
dayToInt = fromInteger . toModifiedJulianDay
-- tests

View File

@ -754,10 +754,9 @@ data Account a = Account {
-- The report periods are typically all the same length, but need not be.
--
-- Report periods are represented only by their start dates, used as the keys of a Map.
-- (As integers, like the one inside the Day type, representing days before/after 1858-11-17.)
data PeriodData a = PeriodData {
pdpre :: a -- ^ data for the period before the report
,pdperiods :: M.Map Integer a -- ^ data for each period within the report
pdpre :: a -- ^ data for the period before the report
,pdperiods :: M.Map Day a -- ^ data for each period within the report
} deriving (Eq, Ord, Functor, Generic)
-- | Data that's useful in "balance" reports:

View File

@ -454,7 +454,7 @@ makeMultiBalanceReportRow = makePeriodicReportRow nullmixedamt sumAndAverageMixe
-- | Build a report row.
--
-- Calculate the column totals. These are always the sum of column amounts.
makePeriodicReportRow :: c -> (M.Map Integer c -> (c, c))
makePeriodicReportRow :: c -> (M.Map Day c -> (c, c))
-> ReportOpts -> (b -> c)
-> a -> Account b -> PeriodicReportRow a c
makePeriodicReportRow nullEntry totalAndAverage ropts balance name acct =