summaryrefslogtreecommitdiff
path: root/Utility/Scheduled.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-04-12 13:29:35 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-04-12 13:29:35 -0400
commit66b5dc3f36e32407bfcf120efaae67b49a3e5853 (patch)
tree8e75249b5f0d70638b071c8a11be38e15b244f28 /Utility/Scheduled.hs
parentd9a46f25006d0056bcab98861b1261a22e91406d (diff)
wrote test case; found bugs in date math; fixed and simplified using Data.Time.Calendar
Diffstat (limited to 'Utility/Scheduled.hs')
-rw-r--r--Utility/Scheduled.hs53
1 files changed, 32 insertions, 21 deletions
diff --git a/Utility/Scheduled.hs b/Utility/Scheduled.hs
index 8ae1664f6..d3ae06203 100644
--- a/Utility/Scheduled.hs
+++ b/Utility/Scheduled.hs
@@ -1,6 +1,6 @@
{- scheduled activities
-
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -24,6 +24,7 @@ module Utility.Scheduled (
toSchedule,
parseSchedule,
prop_schedule_roundtrips,
+ prop_past_sane,
) where
import Utility.Data
@@ -177,29 +178,15 @@ calcNextTime schedule@(Schedule recurrance scheduledtime) lasttime currenttime
-- Check if the new Day occurs one month or more past the old Day.
oneMonthPast :: Day -> Day -> Bool
-new `oneMonthPast` old
- | mday new >= mday old && (new `newerMonth` old || new `newerYear` old) = True
- | new `skippedAMonth` old || new `skippedAYear` old = True
- | otherwise = False
+new `oneMonthPast` old = fromGregorian y (m+1) d <= new
+ where
+ (y,m,d) = toGregorian old
-- Check if the new Day occurs one year or more past the old Day.
oneYearPast :: Day -> Day -> Bool
-new `oneYearPast` old
- | yday new >= yday old && new `newerYear` old = True
- | new `skippedAYear` old = True
- | otherwise = False
-
-newerMonth :: Day -> Day -> Bool
-new `newerMonth` old = mnum new > mnum old
-
-newerYear :: Day -> Day -> Bool
-new `newerYear` old = ynum new > ynum old
-
-skippedAMonth :: Day -> Day -> Bool
-new `skippedAMonth` old = mnum new > mnum old + 1
-
-skippedAYear :: Day -> Day -> Bool
-new `skippedAYear` old = ynum new > ynum old + 1
+new `oneYearPast` old = fromGregorian (y+1) m d <= new
+ where
+ (y,m,d) = toGregorian old
endOfMonth :: Day -> Day
endOfMonth day =
@@ -383,3 +370,27 @@ instance Arbitrary Recurrance where
prop_schedule_roundtrips :: Schedule -> Bool
prop_schedule_roundtrips s = toSchedule (fromSchedule s) == Just s
+
+prop_past_sane :: Bool
+prop_past_sane = and
+ [ all (checksout oneMonthPast) (mplus1 ++ yplus1)
+ , all (not . (checksout oneMonthPast)) (map swap (mplus1 ++ yplus1))
+ , all (checksout oneYearPast) yplus1
+ , all (not . (checksout oneYearPast)) (map swap yplus1)
+ ]
+ where
+ mplus1 = -- new date old date, 1+ months before it
+ [ (fromGregorian 2014 01 15, fromGregorian 2013 12 15)
+ , (fromGregorian 2014 01 15, fromGregorian 2013 02 15)
+ , (fromGregorian 2014 02 15, fromGregorian 2013 01 15)
+ , (fromGregorian 2014 03 01, fromGregorian 2013 01 15)
+ , (fromGregorian 2014 03 01, fromGregorian 2013 12 15)
+ , (fromGregorian 2015 01 01, fromGregorian 2010 01 01)
+ ]
+ yplus1 = -- new date old date, 1+ years before it
+ [ (fromGregorian 2014 01 15, fromGregorian 2012 01 16)
+ , (fromGregorian 2014 01 15, fromGregorian 2013 01 14)
+ , (fromGregorian 2022 12 31, fromGregorian 2000 01 01)
+ ]
+ checksout cmp (new, old) = new `cmp` old
+ swap (a,b) = (b,a)