1module Test.Calendar.Duration
2    ( testDuration
3    ) where
4
5import Data.Time.Calendar.Compat
6import Data.Time.Calendar.Julian.Compat
7import Test.Arbitrary ()
8import Test.Tasty
9import Test.Tasty.HUnit
10import Test.Tasty.QuickCheck hiding (reason)
11
12testAddDiff :: TestTree
13testAddDiff =
14    testGroup
15        "add diff"
16        [ testProperty "add diff GregorianDurationClip" $ \day1 day2 ->
17              addGregorianDurationClip (diffGregorianDurationClip day2 day1) day1 == day2
18        , testProperty "add diff GregorianDurationRollOver" $ \day1 day2 ->
19              addGregorianDurationRollOver (diffGregorianDurationRollOver day2 day1) day1 == day2
20        , testProperty "add diff JulianDurationClip" $ \day1 day2 ->
21              addJulianDurationClip (diffJulianDurationClip day2 day1) day1 == day2
22        , testProperty "add diff JulianDurationRollOver" $ \day1 day2 ->
23              addJulianDurationRollOver (diffJulianDurationRollOver day2 day1) day1 == day2
24        ]
25
26testClip :: (Integer, Int, Int) -> (Integer, Int, Int) -> (Integer, Integer) -> TestTree
27testClip (y1, m1, d1) (y2, m2, d2) (em, ed) = let
28    day1 = fromGregorian y1 m1 d1
29    day2 = fromGregorian y2 m2 d2
30    expected = CalendarDiffDays em ed
31    found = diffGregorianDurationClip day1 day2
32    in testCase (show day1 ++ " - " ++ show day2) $ assertEqual "" expected found
33
34testDiffs :: TestTree
35testDiffs =
36    testGroup
37        "diffs"
38        [ testClip (2017, 04, 07) (2017, 04, 07) (0, 0)
39        , testClip (2017, 04, 07) (2017, 04, 01) (0, 6)
40        , testClip (2017, 04, 01) (2017, 04, 07) (0, -6)
41        , testClip (2017, 04, 07) (2017, 02, 01) (2, 6)
42        , testClip (2017, 02, 01) (2017, 04, 07) (-2, -6)
43        ]
44
45testDuration :: TestTree
46testDuration = testGroup "CalendarDiffDays" [testAddDiff, testDiffs]
47