hledger/hledger-lib/Hledger/Data/DayPartition.hs

{-|
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