{-# LANGUAGE CPP #-}
{-|


A 'BalanceData is a data type tracking a number of postings, exclusive, and inclusive balance
for given date ranges.

-}
module Hledger.Data.BalanceData
( mapBalanceData
, opBalanceData

, tests_BalanceData
) where


import Test.Tasty (testGroup)
import Test.Tasty.HUnit ((@?=), testCase)

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


instance Show BalanceData where
  showsPrec :: Int -> BalanceData -> ShowS
showsPrec Int
d (BalanceData MixedAmount
e MixedAmount
i Int
n) =
    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
"BalanceData"
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"{ bdexcludingsubs = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (WideBuilder -> String
wbUnpack (AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt MixedAmount
e))
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", bdincludingsubs = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (WideBuilder -> String
wbUnpack (AmountFormat -> MixedAmount -> WideBuilder
showMixedAmountB AmountFormat
defaultFmt MixedAmount
i))
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
", bdnumpostings = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
n
      ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

instance Semigroup BalanceData where
  BalanceData MixedAmount
e MixedAmount
i Int
n <> :: BalanceData -> BalanceData -> BalanceData
<> BalanceData MixedAmount
e' MixedAmount
i' Int
n' = MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData (MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
e MixedAmount
e') (MixedAmount -> MixedAmount -> MixedAmount
maPlus MixedAmount
i MixedAmount
i') (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n')

instance Monoid BalanceData where
  mempty :: BalanceData
mempty = MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData MixedAmount
nullmixedamt MixedAmount
nullmixedamt Int
0

-- | Apply an operation to both 'MixedAmount' in an 'BalanceData'.
mapBalanceData :: (MixedAmount -> MixedAmount) -> BalanceData -> BalanceData
mapBalanceData :: (MixedAmount -> MixedAmount) -> BalanceData -> BalanceData
mapBalanceData MixedAmount -> MixedAmount
f BalanceData
a = BalanceData
a{bdexcludingsubs = f $ bdexcludingsubs a, bdincludingsubs = f $ bdincludingsubs a}

-- | Merge two 'BalanceData', using the given operation to combine their amounts.
opBalanceData :: (MixedAmount -> MixedAmount -> MixedAmount) -> BalanceData -> BalanceData -> BalanceData
opBalanceData :: (MixedAmount -> MixedAmount -> MixedAmount)
-> BalanceData -> BalanceData -> BalanceData
opBalanceData MixedAmount -> MixedAmount -> MixedAmount
f BalanceData
a BalanceData
b = BalanceData
a{bdexcludingsubs = f (bdexcludingsubs a) (bdexcludingsubs b), bdincludingsubs = f (bdincludingsubs a) (bdincludingsubs b)}


-- tests

tests_BalanceData :: TestTree
tests_BalanceData = String -> [TestTree] -> TestTree
testGroup String
"BalanceData" [

  String -> Assertion -> TestTree
testCase String
"opBalanceData maPlus" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    (MixedAmount -> MixedAmount -> MixedAmount)
-> BalanceData -> BalanceData -> BalanceData
opBalanceData MixedAmount -> MixedAmount -> MixedAmount
maPlus (MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1]) ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
2]) Int
5) (MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
3]) ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4]) Int
0)
      BalanceData -> BalanceData -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4]) ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
6]) Int
5,

  String -> Assertion -> TestTree
testCase String
"opBalanceData maMinus" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    (MixedAmount -> MixedAmount -> MixedAmount)
-> BalanceData -> BalanceData -> BalanceData
opBalanceData MixedAmount -> MixedAmount -> MixedAmount
maMinus (MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
1]) ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
2]) Int
5) (MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
3]) ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd DecimalRaw Integer
4]) Int
0)
      BalanceData -> BalanceData -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= MixedAmount -> MixedAmount -> Int -> BalanceData
BalanceData ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
2)]) ([Amount] -> MixedAmount
forall (t :: * -> *). Foldable t => t Amount -> MixedAmount
mixed [DecimalRaw Integer -> Amount
usd (-DecimalRaw Integer
2)]) Int
5
  ]