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