dev!: balance: Use DayPartition for multibalance reports.

This allows us to guarantee that the report periods are well-formed and
don't contain errors (e.g. empty spans, spans not contiguous, spans not
a partition).

Note the underlying representation is now for disjoint spans, whereas
previously the end date of a span was equal to the start date of the
next span, and then was adjusted backwards one day when needed.

hledger-lib/Hledger/Data.hs

@@ -10,19 +10,20 @@ functionality.  This package re-exports all the Hledger.Data.* modules
 
 module Hledger.Data (
                module Hledger.Data.Account,
-               module Hledger.Data.BalanceData,
-               module Hledger.Data.PeriodData,
                module Hledger.Data.AccountName,
                module Hledger.Data.Amount,
+               module Hledger.Data.BalanceData,
                module Hledger.Data.Balancing,
                module Hledger.Data.Currency,
                module Hledger.Data.Dates,
+               module Hledger.Data.DayPartition,
                module Hledger.Data.Errors,
                module Hledger.Data.Journal,
                module Hledger.Data.JournalChecks,
                module Hledger.Data.Json,
                module Hledger.Data.Ledger,
                module Hledger.Data.Period,
+               module Hledger.Data.PeriodData,
                module Hledger.Data.PeriodicTransaction,
                module Hledger.Data.Posting,
                module Hledger.Data.RawOptions,
@@ -39,18 +40,19 @@ where
 import Test.Tasty (testGroup)
 import Hledger.Data.Account
 import Hledger.Data.BalanceData
-import Hledger.Data.PeriodData
 import Hledger.Data.AccountName
 import Hledger.Data.Amount
 import Hledger.Data.Balancing
 import Hledger.Data.Currency
 import Hledger.Data.Dates
+import Hledger.Data.DayPartition
 import Hledger.Data.Errors
 import Hledger.Data.Journal
 import Hledger.Data.JournalChecks
 import Hledger.Data.Json
 import Hledger.Data.Ledger
 import Hledger.Data.Period
+import Hledger.Data.PeriodData
 import Hledger.Data.PeriodicTransaction
 import Hledger.Data.Posting
 import Hledger.Data.RawOptions

hledger-lib/Hledger/Data/DayPartition.hs

@@ -0,0 +1,131 @@
+{-|
+A partition of time into contiguous spans, for defining reporting periods.
+-}
+module Hledger.Data.DayPartition
+( DayPartition
+, boundariesToDayPartition
+, boundariesToMaybeDayPartition
+
+, lookupDayPartition
+, unionDayPartitions
+
+, dayPartitionToNonEmpty
+, dayPartitionToList
+, dayPartitionToPeriodData
+, dayPartitionToDateSpans
+, maybeDayPartitionToDateSpans
+, dateSpansToDayPartition
+) where
+
+import qualified Data.IntMap.Strict as IM
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NE
+import Data.Time (Day, addDays)
+
+import Hledger.Data.Dates
+import Hledger.Data.PeriodData
+import Hledger.Data.Types
+import Hledger.Utils
+
+
+-- | A partition of time into contiguous spans, along with a historical period
+-- before any of the spans.
+--
+-- This is a newtype wrapper around 'PeriodData Day', where the start dates are
+-- the keys and the end dates are the values. Spans are stored in inclusive format
+-- [start, end]. Note that this differs from 'DateSpan' which uses [start, end)
+-- format.
+--
+-- The constructor is not exported so that we can ensure the spans are valid
+-- partitions of time.
+newtype DayPartition = DayPartition { dayPartitionToPeriodData :: PeriodData Day } deriving (Eq, Ord, Show)
+
+-- Developer's note. All constructors must guarantee that:
+--   1. The value stored in pdperiods has at least one key.
+--   2. The value stored in pdpre equals one day before the smallest key in pdperiods.
+--   3. The value stored in each entry of pdperiods equals one day before the
+--      next largest key, except for the value associated to the largest key.
+isValidDayPartition :: DayPartition -> Bool
+isValidDayPartition (DayPartition pd) = case ds of
+    [] -> False  -- Must be at least one key in pdperiods
+    xs -> and $ zipWith isContiguous ((nulldate, h) : xs) xs
+  where
+    (h, ds) = periodDataToList pd
+    isContiguous (_, e) (s, _) = addDays 1 e == s
+
+
+-- | Construct a 'DayPartition' from a non-empty list of boundary days.
+boundariesToDayPartition :: NonEmpty Day -> DayPartition
+boundariesToDayPartition xs =
+    DayPartition $ periodDataFromList (addDays (-1) b) $ zip (b:bs) (map (addDays (-1)) bs)
+  where (b:|bs) = NE.nub $ NE.sort xs
+
+-- | Construct a 'DayPartition' from a list of boundary days, returning
+-- 'Nothing' for the empty list.
+boundariesToMaybeDayPartition :: [Day] -> Maybe DayPartition
+boundariesToMaybeDayPartition = fmap boundariesToDayPartition . NE.nonEmpty
+
+
+-- | Find the span of a 'DayPartition' which contains a given day.
+lookupDayPartition :: Day -> DayPartition -> (Maybe Day, Day)
+lookupDayPartition d (DayPartition xs) = lookupPeriodDataOrHistorical d xs
+
+-- | Return the union of two 'DayPartition's if they are consistent, or 'Nothing' otherwise.
+unionDayPartitions :: DayPartition -> DayPartition -> Maybe DayPartition
+unionDayPartitions (DayPartition (PeriodData h as)) (DayPartition (PeriodData h' as')) =
+    if equalIntersection as as' && isValidDayPartition union then Just union else Nothing
+  where
+    union = DayPartition . PeriodData (min h h') $ as <> as'
+    equalIntersection x y = and $ IM.intersectionWith (==) x y
+
+
+-- | Convert 'DayPartition' to a non-empty list of start and end dates for the periods.
+--
+-- Note that the end date of each period will be one day before the start date
+-- of the next period.
+dayPartitionToNonEmpty :: DayPartition -> NonEmpty (Day, Day)
+dayPartitionToNonEmpty (DayPartition xs) = NE.fromList . snd $ periodDataToList xs  -- Constructors guarantee this is non-empty
+
+-- | Convert 'DayPartition' to a list of start and end dates for the periods.
+--
+-- Note that the end date of each period will be one day before the start date
+-- of the next period.
+dayPartitionToList :: DayPartition -> [(Day, Day)]
+dayPartitionToList = NE.toList . dayPartitionToNonEmpty
+
+-- | Convert 'DayPartition' to a list of 'DateSpan's.
+--
+-- Note that the end date of each period will be equal to the start date of
+-- the next period.
+dayPartitionToDateSpans :: DayPartition -> [DateSpan]
+dayPartitionToDateSpans = map toDateSpan . dayPartitionToList
+  where
+    toDateSpan (s, e) = DateSpan (toEFDay s) (toEFDay $ addDays 1 e)
+    toEFDay = Just . Exact
+
+-- Convert a periodic report 'Maybe DayPartition' to a list of 'DateSpans',
+-- replacing the empty case with an appropriate placeholder.
+--
+-- Note that the end date of each period will be equal to the start date of
+-- the next period.
+maybeDayPartitionToDateSpans :: Maybe DayPartition -> [DateSpan]
+maybeDayPartitionToDateSpans = maybe [DateSpan Nothing Nothing] dayPartitionToDateSpans
+
+-- | Convert a list of 'DateSpan's to a 'DayPartition', or 'Nothing' if it is not well-formed.
+--
+-- Warning: This can construct ill-formed 'DayPartitions' and can raise errors.
+-- It will be eliminated later.
+-- PARTIAL:
+dateSpansToDayPartition :: [DateSpan] -> Maybe DayPartition
+-- Handle the cases of partitions which would arise from journals with no transactions
+dateSpansToDayPartition []                           = Nothing
+dateSpansToDayPartition [DateSpan Nothing  Nothing]  = Nothing
+dateSpansToDayPartition [DateSpan Nothing  (Just _)] = Nothing
+dateSpansToDayPartition [DateSpan (Just _) Nothing]  = Nothing
+-- Handle properly defined reports
+dateSpansToDayPartition (x:xs) = Just . DayPartition $
+    periodDataFromList (addDays (-1) . fst $ boundaries x) (map boundaries (x:xs))
+  where
+    boundaries spn = makeJust (spanStart spn, addDays (-1) <$> spanEnd spn)
+    makeJust (Just a, Just b)  = (a, b)
+    makeJust ab = error' $ "dateSpansToDayPartition: expected all spans to have start and end dates, but one has " ++ show ab

hledger-lib/Hledger/Data/PeriodData.hs

@@ -18,10 +18,6 @@ module Hledger.Data.PeriodData
 , mergePeriodData
 , padPeriodData
 
-, periodDataToDateSpans
-, maybePeriodDataToDateSpans
-, dateSpansToPeriodData
-
 , tests_PeriodData
 ) where
 
@@ -38,7 +34,6 @@ import Data.List (foldl')
 import Data.Time (Day(..), fromGregorian)
 
 import Hledger.Data.Amount
-import Hledger.Data.Dates
 import Hledger.Data.Types
 import Hledger.Utils
 
@@ -127,31 +122,6 @@ 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
 

hledger-lib/Hledger/Data/Types.hs

@@ -750,13 +750,16 @@ data Account a = Account {
   ,adata                     :: PeriodData a       -- ^ associated data per report period
   } deriving (Generic, Functor)
 
--- | Data values for zero or more report periods, and for the pre-report period.
+-- | A general container for storing data values associated to zero or more
--- Report periods are assumed to be contiguous, and represented only by start dates
+-- report periods, and for the pre-report period. Report periods are assumed to
--- (as keys of an IntMap). XXX how does that work, again ?
+-- be contiguous, and represented only by start dates.
+--
+-- Data is stored in an 'IntMap' for efficiency, where Days are stored as as
+-- Int representing the underlying modified Julian date.
 data PeriodData a = PeriodData {
    pdpre     :: a            -- ^ data from the pre-report period (e.g. historical balances)
   ,pdperiods :: IM.IntMap a  -- ^ data for the periods
-  } deriving (Eq, Functor, Generic)
+  } deriving (Eq, Ord, Functor, Generic)
 
 -- | Data that's useful in "balance" reports:
 -- subaccount-exclusive and -inclusive amounts,

hledger-lib/Hledger/Reports/BudgetReport.hs

@@ -24,7 +24,6 @@ import Data.Ord (comparing)
 import Data.Set qualified as S
 import Data.Text qualified as T
 import Data.These (These(..), these)
-import Data.Time (Day)
 import Safe (minimumDef)
 
 import Hledger.Data
@@ -84,12 +83,13 @@ budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport
 
     (_, actualspans) = dbg5 "actualspans" $ reportSpan actualj rspec
     (_, budgetspans) = dbg5 "budgetspans" $ reportSpan budgetj rspec
-    allspans = case interval_ ropts of
+    allspans = dbg5 "allspans" $ case (interval_ ropts, budgetspans) of
         -- If no interval is specified:
         -- 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
+        (NoInterval, _) -> actualspans
-        _          -> maybe id (padPeriodData nulldate) budgetspans <$> actualspans
+        (_,    Nothing) -> actualspans
+        (_, Just bspan) -> unionDayPartitions bspan =<< 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 -> Maybe (PeriodData Day) -> Account (These BalanceData BalanceData) -> BudgetReport
+generateBudgetReport :: ReportOpts -> Maybe DayPartition -> Account (These BalanceData BalanceData) -> BudgetReport
 generateBudgetReport = generatePeriodicReport makeBudgetReportRow treeActualBalance flatActualBalance
   where
     treeActualBalance = these bdincludingsubs (const nullmixedamt) (const . bdincludingsubs)

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

@@ -47,7 +47,7 @@ import Data.Maybe (fromMaybe, isJust)
 import Data.Ord (Down(..))
 import Data.Semigroup (sconcat)
 import Data.These (these)
-import Data.Time.Calendar (Day(..), addDays, fromGregorian)
+import Data.Time.Calendar (Day(..), fromGregorian)
 import Data.Traversable (mapAccumL)
 
 import Hledger.Data
@@ -162,7 +162,7 @@ compoundBalanceReportWith rspec' j priceoracle subreportspecs = cbr
         subreportTotal (_, sr, increasestotal) =
             (if increasestotal then id else fmap maNegate) $ prTotals sr
 
-    cbr = CompoundPeriodicReport "" (maybePeriodDataToDateSpans colspans) subreports overalltotals
+    cbr = CompoundPeriodicReport "" (maybeDayPartitionToDateSpans colspans) subreports overalltotals
 
 
 -- | Remove any date queries and insert queries from the report span.
@@ -216,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 -> Maybe (PeriodData Day) -> [Posting] -> Account BalanceData
+generateMultiBalanceAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe DayPartition -> [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)
@@ -262,7 +262,7 @@ 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 -> Maybe (PeriodData Day) -> [Posting] -> Account BalanceData
+calculateReportAccount :: ReportSpec -> Journal -> PriceOracle -> Maybe DayPartition -> [Posting] -> Account BalanceData
 calculateReportAccount _ _ _ Nothing _ =
     accountFromBalances "root" $ periodDataFromList mempty [(nulldate, mempty)]
 calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle (Just colspans) ps =
@@ -292,18 +292,17 @@ calculateReportAccount rspec@ReportSpec{_rsReportOpts=ropts} j priceoracle (Just
         avalue = periodDataValuation ropts j priceoracle colspans
 
     changesAcct = dbg5With (\x -> "calculateReportAccount changesAcct\n" ++ showAccounts x) .
-        mapPeriodData (padPeriodData mempty colspans) $
+        mapPeriodData (padPeriodData mempty (dayPartitionToPeriodData colspans)) $
         accountFromPostings getIntervalStartDate ps
 
-    getIntervalStartDate p = fst <$> lookupPeriodData (getPostingDate p) colspans
+    getIntervalStartDate p = fst $ lookupDayPartition (getPostingDate p) colspans
     getPostingDate = postingDateOrDate2 (whichDate (_rsReportOpts rspec))
 
 -- | The valuation function to use for the chosen report options.
--- This can call error in various situations.
+periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> DayPartition
-periodDataValuation :: ReportOpts -> Journal -> PriceOracle -> PeriodData Day
                     -> PeriodData BalanceData -> PeriodData BalanceData
-periodDataValuation ropts j priceoracle periodEnds =
+periodDataValuation ropts j priceoracle colspans =
-    opPeriodData valueBalanceData balanceDataPeriodEnds
+    opPeriodData valueBalanceData (dayPartitionToPeriodData colspans)
   where
     valueBalanceData :: Day -> BalanceData -> BalanceData
     valueBalanceData d = mapBalanceData (valueMixedAmount d)
@@ -311,10 +310,6 @@ periodDataValuation ropts j priceoracle periodEnds =
     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" $ addDays (-1) <$> periodEnds
-
 -- | Mark which nodes of an 'Account' are boring, and so should be omitted from reports.
 markAccountBoring :: ReportSpec -> Account BalanceData -> Account BalanceData
 markAccountBoring ReportSpec{_rsQuery=query,_rsReportOpts=ropts}
@@ -367,7 +362,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 -> Maybe (PeriodData Day) -> Account BalanceData -> MultiBalanceReport
+generateMultiBalanceReport :: ReportOpts -> Maybe DayPartition -> Account BalanceData -> MultiBalanceReport
 generateMultiBalanceReport ropts colspans =
     reportPercent ropts . generatePeriodicReport makeMultiBalanceReportRow bdincludingsubs id ropts colspans
 
@@ -377,9 +372,9 @@ generateMultiBalanceReport ropts colspans =
 generatePeriodicReport :: Show c =>
     (forall a. ReportOpts -> (BalanceData -> MixedAmount) -> a -> Account b -> PeriodicReportRow a c)
     -> (b -> MixedAmount) -> (c -> MixedAmount)
-    -> ReportOpts -> Maybe (PeriodData Day) -> Account b -> PeriodicReport DisplayName c
+    -> ReportOpts -> Maybe DayPartition -> Account b -> PeriodicReport DisplayName c
 generatePeriodicReport makeRow treeAmt flatAmt ropts colspans acct =
-    PeriodicReport (maybePeriodDataToDateSpans colspans) (buildAndSort acct) totalsrow
+    PeriodicReport (maybeDayPartitionToDateSpans colspans) (buildAndSort acct) totalsrow
   where
     -- Build report rows and sort them
     buildAndSort = dbg5 "generatePeriodicReport buildAndSort" . case accountlistmode_ ropts of

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -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 -> Maybe (PeriodData Day) -> [Posting] -> [SummaryPosting]
+summarisePostingsByInterval :: WhichDate -> Maybe Int -> Bool -> Maybe DayPartition -> [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) (maybePeriodDataToDateSpans colspans)
+    . groupByDateSpan showempty (postingDateOrDate2 wd) (maybeDayPartitionToDateSpans colspans)
 
 -- | Given a date span (representing a report interval) and a list of
 -- postings within it, aggregate the postings into one summary posting per

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -677,7 +677,7 @@ journalApplyValuationFromOptsWith rspec@ReportSpec{_rsReportOpts=ropts} j priceo
           _          -> spanEnd <=< latestSpanContaining (historical : spans)
 
     historical = DateSpan Nothing $ (fmap Exact . spanStart) =<< headMay spans
-    spans = maybePeriodDataToDateSpans . snd $ reportSpanBothDates j rspec
+    spans = maybeDayPartitionToDateSpans . 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, Maybe (PeriodData Day))
+reportSpan :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
 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, Maybe (PeriodData Day))
+reportSpanBothDates :: Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
 reportSpanBothDates = reportSpanHelper True
 
-reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, Maybe (PeriodData Day))
+reportSpanHelper :: Bool -> Journal -> ReportSpec -> (DateSpan, Maybe DayPartition)
 reportSpanHelper bothdates j ReportSpec{_rsQuery=query, _rsReportOpts=ropts, _rsDay=today} =
-  (enlargedreportspan, dateSpansToPeriodData $ if not (null intervalspans) then intervalspans else [enlargedreportspan])
+  (enlargedreportspan, dateSpansToDayPartition $ 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" $

hledger-lib/hledger-lib.cabal

@@ -61,6 +61,7 @@ library
       Hledger.Data.Balancing
       Hledger.Data.Currency
       Hledger.Data.Dates
+      Hledger.Data.DayPartition
       Hledger.Data.Errors
       Hledger.Data.Journal
       Hledger.Data.JournalChecks

hledger/Hledger/Cli/Commands/Activity.hs

@@ -39,8 +39,8 @@ showHistogram rspec@ReportSpec{_rsQuery=q} j =
       _ -> rspec
     spanps = case mspans of
       Nothing -> []
-      Just x  -> map (\spn -> (spn, filter (postingInRange spn) ps)) . snd $ periodDataToList x
+      Just x  -> map (\spn -> (spn, filter (postingInRange spn) ps)) $ dayPartitionToList x
-    postingInRange (b, e) p = postingDate p >= b && postingDate p < e
+    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

hledger/Hledger/Cli/Commands/Roi.hs

@@ -97,7 +97,7 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{_rsReportOpts=ReportO
   let (fullPeriodDateSpan, mspans) = reportSpan filteredj rspec
 
   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
+      spans = maybe err (map (second (addDays 1)) . dayPartitionToList) mspans
       fullPeriod = case fullPeriodDateSpan of
         DateSpan (Just b) (Just e) -> (fromEFDay b, fromEFDay e)
         _ -> err

hledger/Hledger/Cli/Commands/Stats.hs

@@ -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) $ maybePeriodDataToDateSpans intervalspans
+      (ls, txncounts) = unzip . map (showLedgerStats verbose l today) $ maybeDayPartitionToDateSpans intervalspans
       numtxns = sum txncounts
       txt = (if ismultiperiod then id else TL.init) $ TB.toLazyText $ unlinesB ls
   writeOutputLazyText opts txt