    {-# LANGUAGE CPP #-}
    {-|

    Data values for zero or more report periods, and for the pre-report period.
    Report periods are assumed to be contiguous, and represented only by start dates
    (as keys of an IntMap).

    -}
    module Hledger.Data.PeriodData
    ( periodDataFromList
    , periodDataToList

    , lookupPeriodData
    , lookupPeriodDataOrHistorical
    , insertPeriodData
    , opPeriodData
    , mergePeriodData
    , padPeriodData

    , tests_PeriodData
    ) where

    #if MIN_VERSION_base(4,18,0)
    import Data.Foldable1 (Foldable1(..))
    #else
    import Control.Applicative (liftA2)
    #endif
    #if !MIN_VERSION_base(4,20,0)
    import Data.List (foldl')
    #endif
    import Data.Map qualified as M
    import Data.Time (Day (..), fromGregorian)

    import Hledger.Data.Amount
    import Hledger.Data.Types
    import Hledger.Utils

    instance Show a => Show (PeriodData a) where
      showsPrec :: Int -> PeriodData a -> ShowS
    showsPrec Int
    d (PeriodData a
    h Map Day a
    ds) =
        Bool -> ShowS -> ShowS
    showParen (Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10) (ShowS -> ShowS) -> ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
            String -> ShowS
    showString String
    "PeriodData"
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "{ pdpre = " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> ShowS
    forall a. Show a => a -> ShowS
    shows a
    h
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    ", pdperiods = "
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    "fromList " ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Day, a)] -> ShowS
    forall a. Show a => a -> ShowS
    shows (Map Day a -> [(Day, a)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Day a
    ds)
          ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> ShowS
    showChar Char
    '}'

    instance Foldable PeriodData where
      foldr :: forall a b. (a -> b -> b) -> b -> PeriodData a -> b
    foldr a -> b -> b
    f b
    z (PeriodData a
    h Map Day a
    as) = (a -> b -> b) -> b -> Map Day a -> b
    forall a b. (a -> b -> b) -> b -> Map Day a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> b -> b
    f (a -> b -> b
    f a
    h b
    z) Map Day a
    as
      foldl :: forall b a. (b -> a -> b) -> b -> PeriodData a -> b
    foldl b -> a -> b
    f b
    z (PeriodData a
    h Map Day a
    as) = (b -> a -> b) -> b -> Map Day a -> b
    forall b a. (b -> a -> b) -> b -> Map Day a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl b -> a -> b
    f (b -> a -> b
    f b
    z a
    h) Map Day a
    as
      foldl' :: forall b a. (b -> a -> b) -> b -> PeriodData a -> b
    foldl' b -> a -> b
    f b
    z (PeriodData a
    h Map Day a
    as) = let fzh :: b
    fzh = b -> a -> b
    f b
    z a
    h in b
    fzh b -> b -> b
    forall a b. a -> b -> b
    `seq` (b -> a -> b) -> b -> Map Day a -> b
    forall b a. (b -> a -> b) -> b -> Map Day a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' b -> a -> b
    f b
    fzh Map Day a
    as

    #if MIN_VERSION_base(4,18,0)
    instance Foldable1 PeriodData where
      foldrMap1 :: forall a b. (a -> b) -> (a -> b -> b) -> PeriodData a -> b
    foldrMap1 a -> b
    f a -> b -> b
    g (PeriodData a
    h Map Day a
    as) = (a -> b -> b) -> b -> Map Day a -> b
    forall a b. (a -> b -> b) -> b -> Map Day a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> b -> b
    g (a -> b
    f a
    h) Map Day a
    as
      foldlMap1 :: forall a b. (a -> b) -> (b -> a -> b) -> PeriodData a -> b
    foldlMap1 a -> b
    f b -> a -> b
    g (PeriodData a
    h Map Day a
    as) = (b -> a -> b) -> b -> Map Day a -> b
    forall b a. (b -> a -> b) -> b -> Map Day a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl b -> a -> b
    g (a -> b
    f a
    h) Map Day a
    as
      foldlMap1' :: forall a b. (a -> b) -> (b -> a -> b) -> PeriodData a -> b
    foldlMap1' a -> b
    f b -> a -> b
    g (PeriodData a
    h Map Day a
    as) = let fh :: b
    fh = a -> b
    f a
    h in b
    fh b -> b -> b
    forall a b. a -> b -> b
    `seq` (b -> a -> b) -> b -> Map Day a -> b
    forall b a. (b -> a -> b) -> b -> Map Day a -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' b -> a -> b
    g b
    fh Map Day a
    as
    #endif

    instance Traversable PeriodData where
      traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PeriodData a -> f (PeriodData b)
    traverse a -> f b
    f (PeriodData a
    h Map Day a
    as) = (b -> Map Day b -> PeriodData b)
    -> f b -> f (Map Day b) -> f (PeriodData b)
    forall a b c. (a -> b -> c) -> f a -> f b -> f c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 b -> Map Day b -> PeriodData b
    forall a. a -> Map Day a -> PeriodData a
    PeriodData (a -> f b
    f a
    h) (f (Map Day b) -> f (PeriodData b))
    -> f (Map Day b) -> f (PeriodData b)
    forall a b. (a -> b) -> a -> b
    $ (a -> f b) -> Map Day a -> f (Map Day b)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Map Day a -> f (Map Day b)
    traverse a -> f b
    f Map Day a
    as

    -- | The Semigroup instance for 'PeriodData' simply takes the union of
    -- keys in the date map section. This may not be the result you want if the
    -- keys are not identical.
    instance Semigroup a => Semigroup (PeriodData a) where
      PeriodData a
    h1 Map Day a
    as1 <> :: PeriodData a -> PeriodData a -> PeriodData a
    <> PeriodData a
    h2 Map Day a
    as2 = a -> Map Day a -> PeriodData a
    forall a. a -> Map Day a -> PeriodData a
    PeriodData (a
    h1 a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    h2) (Map Day a -> PeriodData a) -> Map Day a -> PeriodData a
    forall a b. (a -> b) -> a -> b
    $ (a -> a -> a) -> Map Day a -> Map Day a -> Map Day a
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    M.unionWith a -> a -> a
    forall a. Semigroup a => a -> a -> a
    (<>) Map Day a
    as1 Map Day a
    as2

    instance Monoid a => Monoid (PeriodData a) where
      mempty :: PeriodData a
    mempty = a -> Map Day a -> PeriodData a
    forall a. a -> Map Day a -> PeriodData a
    PeriodData a
    forall a. Monoid a => a
    mempty Map Day a
    forall a. Monoid a => a
    mempty

    -- | Construct a 'PeriodData' from a historical data value and a list of (period start, period data) pairs.
    periodDataFromList :: a -> [(Day, a)] -> PeriodData a
    periodDataFromList :: forall a. a -> [(Day, a)] -> PeriodData a
    periodDataFromList a
    h = a -> Map Day a -> PeriodData a
    forall a. a -> Map Day a -> PeriodData a
    PeriodData a
    h (Map Day a -> PeriodData a)
    -> ([(Day, a)] -> Map Day a) -> [(Day, a)] -> PeriodData a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Day, a)] -> Map Day a
    forall k a. Ord k => [(k, a)] -> Map k a
    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 :: forall a. PeriodData a -> (a, [(Day, a)])
    periodDataToList (PeriodData a
    h Map Day a
    as) = (a
    h, Map Day a -> [(Day, a)]
    forall k a. Map k a -> [(k, a)]
    M.toList Map Day a
    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 :: forall a. Day -> PeriodData a -> Maybe (Day, a)
    lookupPeriodData Day
    d (PeriodData a
    _ Map Day a
    as) = Day -> Map Day a -> Maybe (Day, a)
    forall k v. Ord k => k -> Map k v -> Maybe (k, v)
    M.lookupLE Day
    d Map Day a
    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 the data for the historical period and no start date.
    lookupPeriodDataOrHistorical :: Day -> PeriodData a -> (Maybe Day, a)
    lookupPeriodDataOrHistorical :: forall a. Day -> PeriodData a -> (Maybe Day, a)
    lookupPeriodDataOrHistorical Day
    d pd :: PeriodData a
    pd@(PeriodData a
    h Map Day a
    _) = case Day -> PeriodData a -> Maybe (Day, a)
    forall a. Day -> PeriodData a -> Maybe (Day, a)
    lookupPeriodData Day
    d PeriodData a
    pd of
      Maybe (Day, a)
    Nothing     -> (Maybe Day
    forall a. Maybe a
    Nothing, a
    h)
      Just (Day
    a, a
    b) -> (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    a, a
    b)

    -- | Set historical or period data in the appropriate location in a 'PeriodData'.
    insertPeriodData :: Semigroup a => Maybe Day -> a -> PeriodData a -> PeriodData a
    insertPeriodData :: forall a.
    Semigroup a =>
    Maybe Day -> a -> PeriodData a -> PeriodData a
    insertPeriodData Maybe Day
    mday a
    b PeriodData a
    balances = case Maybe Day
    mday of
        Maybe Day
    Nothing  -> PeriodData a
    balances{pdpre = pdpre balances <> b}
        Just Day
    day -> PeriodData a
    balances{pdperiods = M.insertWith (<>) day b $ pdperiods balances}

    -- | Merge two 'PeriodData', using the given operation to combine their data values.
    --
    -- This will drop keys if they are not present in both 'PeriodData'.
    opPeriodData :: (a -> b -> c) -> PeriodData a -> PeriodData b -> PeriodData c
    opPeriodData :: forall a b c.
    (a -> b -> c) -> PeriodData a -> PeriodData b -> PeriodData c
    opPeriodData a -> b -> c
    f (PeriodData a
    h1 Map Day a
    as1) (PeriodData b
    h2 Map Day b
    as2) =
      c -> Map Day c -> PeriodData c
    forall a. a -> Map Day a -> PeriodData a
    PeriodData (a -> b -> c
    f a
    h1 b
    h2) (Map Day c -> PeriodData c) -> Map Day c -> PeriodData c
    forall a b. (a -> b) -> a -> b
    $ (a -> b -> c) -> Map Day a -> Map Day b -> Map Day c
    forall k a b c.
    Ord k =>
    (a -> b -> c) -> Map k a -> Map k b -> Map k c
    M.intersectionWith a -> b -> c
    f Map Day a
    as1 Map Day b
    as2

    -- | Merge two 'PeriodData', using the given operations for combining data
    -- that's only in the first, only in the second, or in both, respectively.
    mergePeriodData :: (a -> c) -> (b -> c) -> (a -> b -> c) -> PeriodData a -> PeriodData b -> PeriodData c
    mergePeriodData :: forall a c b.
    (a -> c)
    -> (b -> c)
    -> (a -> b -> c)
    -> PeriodData a
    -> PeriodData b
    -> PeriodData c
    mergePeriodData a -> c
    only1 b -> c
    only2 a -> b -> c
    f = \(PeriodData a
    h1 Map Day a
    as1) (PeriodData b
    h2 Map Day b
    as2) ->
      c -> Map Day c -> PeriodData c
    forall a. a -> Map Day a -> PeriodData a
    PeriodData (a -> b -> c
    f a
    h1 b
    h2) (Map Day c -> PeriodData c) -> Map Day c -> PeriodData c
    forall a b. (a -> b) -> a -> b
    $ Map Day a -> Map Day b -> Map Day c
    merge Map Day a
    as1 Map Day b
    as2
      where
        merge :: Map Day a -> Map Day b -> Map Day c
    merge = (Day -> a -> b -> Maybe c)
    -> (Map Day a -> Map Day c)
    -> (Map Day b -> Map Day c)
    -> Map Day a
    -> Map Day b
    -> Map Day c
    forall k a b c.
    Ord k =>
    (k -> a -> b -> Maybe c)
    -> (Map k a -> Map k c)
    -> (Map k b -> Map k c)
    -> Map k a
    -> Map k b
    -> Map k c
    M.mergeWithKey (\Day
    _ a
    x b
    y -> c -> Maybe c
    forall a. a -> Maybe a
    Just (c -> Maybe c) -> c -> Maybe c
    forall a b. (a -> b) -> a -> b
    $ a -> b -> c
    f a
    x b
    y) ((a -> c) -> Map Day a -> Map Day c
    forall a b. (a -> b) -> Map Day a -> Map Day b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> c
    only1) ((b -> c) -> Map Day b -> Map Day c
    forall a b. (a -> b) -> Map Day a -> Map Day b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap b -> c
    only2)

    -- | Pad out the date map of a 'PeriodData' so that every key from another 'PeriodData' is present.
    padPeriodData :: a -> PeriodData b -> PeriodData a -> PeriodData a
    padPeriodData :: forall a b. a -> PeriodData b -> PeriodData a -> PeriodData a
    padPeriodData a
    x PeriodData b
    pad PeriodData a
    bal = PeriodData a
    bal{pdperiods = pdperiods bal <> (x <$ pdperiods pad)}

    -- tests

    tests_PeriodData :: TestTree
    tests_PeriodData =
      let
        dayMap :: PeriodData MixedAmount
    dayMap  = MixedAmount -> [(Day, MixedAmount)] -> PeriodData MixedAmount
    forall a. a -> [(Day, a)] -> PeriodData a
    periodDataFromList ([Amount] -> MixedAmount
    forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
    mixed [DecimalRaw Integer -> Amount
    usd DecimalRaw Integer
    1]) [(Integer -> Int -> Int -> Day
    fromGregorian Integer
    2000 Int
    01 Int
    01, [Amount] -> MixedAmount
    forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
    mixed [DecimalRaw Integer -> Amount
    usd DecimalRaw Integer
    2]), (Integer -> Int -> Int -> Day
    fromGregorian Integer
    2004 Int
    02 Int
    28, [Amount] -> MixedAmount
    forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
    mixed [DecimalRaw Integer -> Amount
    usd DecimalRaw Integer
    3])]
        dayMap2 :: PeriodData MixedAmount
    dayMap2 = MixedAmount -> [(Day, MixedAmount)] -> PeriodData MixedAmount
    forall a. a -> [(Day, a)] -> PeriodData a
    periodDataFromList ([Amount] -> MixedAmount
    forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
    mixed [DecimalRaw Integer -> Amount
    usd DecimalRaw Integer
    2]) [(Integer -> Int -> Int -> Day
    fromGregorian Integer
    2000 Int
    01 Int
    01, [Amount] -> MixedAmount
    forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
    mixed [DecimalRaw Integer -> Amount
    usd DecimalRaw Integer
    4]), (Integer -> Int -> Int -> Day
    fromGregorian Integer
    2004 Int
    02 Int
    28, [Amount] -> MixedAmount
    forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
    mixed [DecimalRaw Integer -> Amount
    usd DecimalRaw Integer
    6])]
      in String -> [TestTree] -> TestTree
    testGroup String
    "PeriodData" [

           String -> Assertion -> TestTree
    testCase String
    "periodDataFromList" (Assertion -> TestTree) -> Assertion -> TestTree
    forall a b. (a -> b) -> a -> b
    $ do
             PeriodData MixedAmount -> Int
    forall a. PeriodData a -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length PeriodData MixedAmount
    dayMap Int -> Int -> Assertion
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
    @?= Int
    3,

           String -> Assertion -> TestTree
    testCase String
    "Semigroup instance" (Assertion -> TestTree) -> Assertion -> TestTree
    forall a b. (a -> b) -> a -> b
    $ do
             PeriodData MixedAmount
    dayMap PeriodData MixedAmount
    -> PeriodData MixedAmount -> PeriodData MixedAmount
    forall a. Semigroup a => a -> a -> a
    <> PeriodData MixedAmount
    dayMap PeriodData MixedAmount -> PeriodData MixedAmount -> Assertion
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
    @?= PeriodData MixedAmount
    dayMap2,

           String -> Assertion -> TestTree
    testCase String
    "Monoid instance" (Assertion -> TestTree) -> Assertion -> TestTree
    forall a b. (a -> b) -> a -> b
    $ do
             PeriodData MixedAmount
    dayMap PeriodData MixedAmount
    -> PeriodData MixedAmount -> PeriodData MixedAmount
    forall a. Semigroup a => a -> a -> a
    <> PeriodData MixedAmount
    forall a. Monoid a => a
    mempty PeriodData MixedAmount -> PeriodData MixedAmount -> Assertion
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
    @?= PeriodData MixedAmount
    dayMap
         ]