cron 0.2.1 → 0.2.2
raw patch · 5 files changed
+156/−43 lines, 5 filesdep +QuickCheckdep +derive
Dependencies added: QuickCheck, derive
Files
- changelog +4/−0
- cron.cabal +3/−1
- src/System/Cron.hs +32/−27
- test/System/Cron/ParserSpec.hs +7/−7
- test/System/CronSpec.hs +110/−8
changelog view
@@ -1,2 +1,6 @@+# 0.2.2+* Fix edge case when day of month and day of week are both specified. Credit to @joelwilliamson+# 0.2.1+* Fix day of week bug. Credit to @meteogrid # 0.1.2 * Relax dependency on text to allow 1.0
cron.cabal view
@@ -1,5 +1,5 @@ Name: cron-Version: 0.2.1+Version: 0.2.2 Description: Cron data structure and Attoparsec parser. The idea is to embed it in larger systems which want to roll their own scheduled tasks in a format that people@@ -49,6 +49,8 @@ Build-Depends: base >= 4 && < 5, cron, hspec == 1.3.*,+ QuickCheck,+ derive, hspec-expectations, attoparsec >= 0.10, text >= 0.11 && < 2,
src/System/Cron.hs view
@@ -10,22 +10,21 @@ -- -- Toplevel module for Cron specifying a cron schedule and several convenience -- functions for dealing with cron schedules--- +-- -- > import Control.Concurrent -- > import Control.Monad -- > import Data.Time.Clock -- > import System.Cron--- > +-- > -- > main :: IO ()--- > main = do--- > forever do--- > now <- getCurrentTime--- > when (scheduleMatches schedule now) doWork--- > putStrLn "sleeping"--- > threadDelay 100000--- > where doWork = putStrLn "Time to work"--- > schedule = hourly--- +-- > main = forever $ do+-- > now <- getCurrentTime+-- > when (scheduleMatches schedule now) doWork+-- > putStrLn "sleeping"+-- > threadDelay 100000+-- > where doWork = putStrLn "Time to work"+-- > schedule = hourly+-- -------------------------------------------------------------------- module System.Cron (CronSchedule(..), Crontab(..),@@ -142,24 +141,23 @@ show (StepField f step) = show f ++ "/" ++ show step --- | Shorthand for every January 1st at midnight. Parsed with \@yearly+-- | Shorthand for every January 1st at midnight. Parsed with \@yearly, 0 0 1 1 * yearly :: CronSchedule yearly = monthly { month = Months $ SpecificField 1 } --- | Shorthand for every 1st of the month at midnight. Parsed with \@monthly+-- | Shorthand for every 1st of the month at midnight. Parsed with \@monthly, 0 0 1 * * monthly :: CronSchedule-monthly = hourly { dayOfMonth = DaysOfMonth $ SpecificField 1 }+monthly = daily { dayOfMonth = DaysOfMonth $ SpecificField 1 } --- | Shorthand for every sunday at midnight. Parsed with \@weekly+-- | Shorthand for every sunday at midnight. Parsed with \@weekly, 0 0 * * 0 weekly :: CronSchedule-weekly = daily { dayOfWeek = DaysOfWeek $ SpecificField 0,- dayOfMonth = DaysOfMonth $ SpecificField 0 }+weekly = daily { dayOfWeek = DaysOfWeek $ SpecificField 0 } --- | Shorthand for every day at midnight. Parsed with \@daily+-- | Shorthand for every day at midnight. Parsed with \@daily, 0 0 * * * daily :: CronSchedule daily = hourly { hour = Hours $ SpecificField 0 } --- | Shorthand for every hour on the hour. Parsed with \@hourly+-- | Shorthand for every hour on the hour. Parsed with \@hourly, 0 * * * * hourly :: CronSchedule hourly = everyMinute { minute = Minutes $ SpecificField 0 } @@ -183,17 +181,24 @@ month = Months months, dayOfWeek = DaysOfWeek dows } UTCTime { utctDay = uDay,- utctDayTime = uTime } = all id validations+ utctDayTime = uTime } = if restricted doms && restricted dows+ then mnv && hrv && mthv && (domv || dowv)+ else mnv && hrv && mthv && domv && dowv where (_, mth, dom) = toGregorian uDay- (_, _, dow) = toWeekDate uDay+ (_, _, dow) = toWeekDate uDay TimeOfDay { todHour = hr, todMin = mn} = timeToTimeOfDay uTime- validations = map validate [(mn, CMinute, mins),- (hr, CHour, hrs),- (dom, CDayOfMonth, doms),- (mth, CMonth, months),- (dow, CDayOfWeek, dows)]+ [mnv,hrv,domv,mthv,dowv] = map validate [(mn, CMinute, mins),+ (hr, CHour, hrs),+ (dom, CDayOfMonth, doms),+ (mth, CMonth, months),+ (dow, CDayOfWeek, dows)] validate (x, y, z) = matchField x y z+ restricted Star = False+ restricted (SpecificField _) = True+ restricted (RangeField _ _) = True+ restricted (ListField _) = True+ restricted (StepField f _) = restricted f matchField :: Int -> CronUnit@@ -231,7 +236,7 @@ CHour | CDayOfMonth | CMonth |- CDayOfWeek+ CDayOfWeek deriving (Show, Eq) maxValue :: CronUnit -> Int maxValue CMinute = 59
test/System/Cron/ParserSpec.hs view
@@ -86,7 +86,7 @@ assertSuccessfulParse "* * * * 0" stars { dayOfWeek = DaysOfWeek (SpecificField 0) } where assertSuccessfulParse = assertParse cronSchedule- assertFailedParse = assertNoParse cronSchedule + assertFailedParse = assertNoParse cronSchedule describeCronScheduleLoose :: Spec describeCronScheduleLoose = describe "cronScheduleLoose" $ do@@ -125,27 +125,27 @@ describeCrontabEntry :: Spec describeCrontabEntry = describe "crontabEntry" $ do- it "parses an environment variable assignment" $ + it "parses an environment variable assignment" $ assertSuccessfulParse "FOO=BAR" envSet - it "pparses an environment variable with whitespace at the front" $ + it "parses an environment variable with whitespace at the front" $ assertSuccessfulParse " FOO=BAR" envSet - it "pparses an environment variable with whitespace in the middle" $ + it "parses an environment variable with whitespace in the middle" $ assertSuccessfulParse " FOO = BAR" envSet - it "parses a command" $ + it "parses a command" $ assertSuccessfulParse "* * * * * do stuff" entry - it "parses a command with any amount of whitespace inbetween" $ + it "parses a command with any amount of whitespace inbetween" $ assertSuccessfulParse "* * * * * do stuff" entry - it "pparses a command with whitespace at the front" $ + it "parses a command with whitespace at the front" $ assertSuccessfulParse " * * * * * do stuff" entry where assertSuccessfulParse = assertParse crontabEntry
test/System/CronSpec.hs view
@@ -1,12 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module System.CronSpec (spec) where -import Data.Time.Clock-import Data.Time.Calendar-import Data.Time.LocalTime-import Test.Hspec--import System.Cron+import SpecHelper spec :: Spec spec = sequence_ [describeScheduleMatches,@@ -37,9 +32,11 @@ SpecificField 2, SpecificField 3])} (day 2 3 1 2)+ it "matches a step field" $ scheduleMatches stars { dayOfMonth = DaysOfMonth (StepField (RangeField 10 16) 2)} (day 5 12 1 2)+ it "does not match something missing the step field" $ not $ scheduleMatches stars { dayOfMonth = DaysOfMonth (StepField (RangeField 10 16) 2)} (day 5 13 1 2)@@ -57,19 +54,100 @@ dayOfMonth = DaysOfMonth (SpecificField 3), hour = Hours (RangeField 10 14) } (day 5 3 13 2)+ it "matches a monday as 1" $ scheduleMatches stars { dayOfWeek = DaysOfWeek (SpecificField 1) } (UTCTime (fromGregorian 2014 3 17) 0)+ it "matches a sunday as 0" $ scheduleMatches stars { dayOfWeek = DaysOfWeek (SpecificField 0) } (UTCTime (fromGregorian 2014 3 16) 0)+ it "matches a sunday as 7" $ scheduleMatches stars { dayOfWeek = DaysOfWeek (SpecificField 7) } (UTCTime (fromGregorian 2014 3 16) 0) - where day m d h mn = UTCTime (fromGregorian 2012 m d) (diffTime h mn)- diffTime h mn = timeOfDayToTime $ TimeOfDay h mn 0+ it "matches weekly on a sunday at 0:00" $+ scheduleMatches weekly (UTCTime (fromGregorian 2014 4 6) 0) + it "does not match weekly on a sunday at some time past midnight" $+ not $ scheduleMatches weekly (UTCTime (fromGregorian 2014 6 4) 600)++ it "does not match weekly on another day at midnight" $+ not $ scheduleMatches weekly (UTCTime (fromGregorian 2014 6 5) 600)++ it "only needs weekday or monthday to match" $+ scheduleMatches stars { dayOfWeek = DaysOfWeek (SpecificField 1),+ dayOfMonth = DaysOfMonth (SpecificField 1) }+ (UTCTime (fromGregorian 2014 11 1) 600)++ prop "star matches everything" $ \t ->+ scheduleMatches stars t++ prop "exact time matches" $ \t ->+ let (_, m, d, h, mn) = timeComponents t+ sched = CronSchedule (Minutes $ SpecificField mn)+ (Hours $ SpecificField h)+ (DaysOfMonth $ SpecificField d)+ (Months $ SpecificField m)+ (DaysOfWeek Star)+ in scheduleMatches sched t++ prop "any time with the same minute as n * * * * matches" $ arbitraryTimeFields $ \y m d h mn ->+ let sched = stars { minute = Minutes $ SpecificField mn }+ t = day' y m d h mn+ in scheduleMatches sched t++ prop "any time with the diff minute as n * * * * does not match" $ arbitraryTimeFields $ \y m d h mn ->+ let sched = stars { minute = Minutes $ SpecificField $ stepMax 59 mn }+ t = day' y m d h mn+ in not $ scheduleMatches sched t++ prop "any time with the same hour as * n * * * matches" $ arbitraryTimeFields $ \y m d h mn ->+ let sched = stars { hour = Hours $ SpecificField h }+ t = day' y m d h mn+ in scheduleMatches sched t++ prop "any time with the diff hour as * n * * * does not match" $ arbitraryTimeFields $ \y m d h mn ->+ let sched = stars { hour = Hours $ SpecificField $ stepMax 23 h }+ t = day' y m d h mn+ in not $ scheduleMatches sched t++ prop "any time with the same day as * * n * * matches" $ \t ->+ let (_, m, d, h, mn) = timeComponents t+ sched = CronSchedule (Minutes $ SpecificField mn)+ (Hours $ SpecificField h)+ (DaysOfMonth $ SpecificField d)+ (Months $ SpecificField m)+ (DaysOfWeek Star)+ in scheduleMatches sched t++ prop "any time with the diff day as * * n * * does not match" $ arbitraryTimeFields $ \y m d h mn ->+ let sched = stars { dayOfMonth = DaysOfMonth $ SpecificField $ stepMax 31 d }+ t = day' y m d h mn+ in not $ scheduleMatches sched t++ where day = day' 2012+ day' y m d h mn = UTCTime (fromGregorian y m d) (diffTime h mn)+ diffTime h mn = timeOfDayToTime $ TimeOfDay h mn 1++arbitraryTimeFields f y m d h mn = f (getPositive y)+ (min 12 $ getPositive m)+ (min 28 $ getPositive d)+ (min 23 $ getPositive h)+ (min 59 $ getPositive mn)++hoursMins uTime = (hr, mn)+ where+ TimeOfDay { todHour = hr,+ todMin = mn} = timeToTimeOfDay uTime+++stepMax :: (Enum a, Ord a) => a -> a -> a+stepMax mx n | n < mx = succ n+ | otherwise = pred n++ describeCronScheduleShow :: Spec describeCronScheduleShow = describe "CronSchedule show" $ do it "formats stars" $@@ -94,6 +172,24 @@ show stars { dayOfMonth = DaysOfMonth (StepField (ListField [SpecificField 3, SpecificField 5]) 2)} `shouldBe` "CronSchedule * * 3,5/2 * *" + it "formats @yearly" $+ show yearly `shouldBe` "CronSchedule 0 0 1 1 *"++ it "formats @monthly" $+ show monthly `shouldBe` "CronSchedule 0 0 1 * *"++ it "formats @weekly" $+ show weekly `shouldBe` "CronSchedule 0 0 * * 0"++ it "formats @daily" $+ show daily `shouldBe` "CronSchedule 0 0 * * *"++ it "formats @hourly" $+ show hourly `shouldBe` "CronSchedule 0 * * * *"++ it "formats everyMinute" $+ show everyMinute `shouldBe` "CronSchedule * * * * *"+ describeCrontabShow :: Spec describeCrontabShow = describe "Crontab Show" $ do it "prints nothing for an empty crontab" $@@ -120,3 +216,9 @@ (DaysOfMonth Star) (Months Star) (DaysOfWeek Star)++timeComponents :: UTCTime -> (Integer, Int, Int, Int, Int)+timeComponents (UTCTime dy dt) = (y, m, d, h, mn)+ where+ (y, m, d) = toGregorian dy+ (h, mn) = hoursMins dt