cron 0.3.1 → 0.3.2

raw patch · 6 files changed

+548/−1 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• changelog +2/−0
• cron.cabal +6/−1
• test/SpecHelper.hs +43/−0
• test/System/Test/Cron.hs +252/−0
• test/System/Test/Cron/Parser.hs +195/−0
• test/System/Test/Cron/Schedule.hs +50/−0

@@ -1,3 +1,5 @@+# 0.3.2+* Add test files to dist # 0.3.1 * Fix bug that caused some range schedules to not fire at the correct time. See https://github.com/MichaelXavier/cron/issues/18 # 0.3.0

@@ -1,5 +1,5 @@ Name:                cron-Version:             0.3.1+Version:             0.3.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@@ -29,6 +29,11 @@   README.md   LICENSE   changelog+  test/Main.hs+  test/SpecHelper.hs+  test/System/Test/Cron.hs+  test/System/Test/Cron/Parser.hs+  test/System/Test/Cron/Schedule.hs Homepage:           http://github.com/michaelxavier/cron Bug-Reports:        http://github.com/michaelxavier/cron/issues 

@@ -0,0 +1,43 @@+{-# LANGUAGE TemplateHaskell #-}+module SpecHelper+    ( module X+    , isLeft+    ) where+++-------------------------------------------------------------------------------+import           Control.Applicative   as X+import           Data.Attoparsec.Text  as X+import           Data.DeriveTH+import           Data.Time.Calendar    as X+import           Data.Time.Clock       as X+import           Data.Time.LocalTime   as X+import           Debug.Trace           as X+import           Test.Tasty            as X+import           Test.Tasty.HUnit      as X+import           Test.Tasty.QuickCheck as X+-------------------------------------------------------------------------------+import           System.Cron           as X+import           System.Cron.Parser    as X+-------------------------------------------------------------------------------+++instance Arbitrary UTCTime where+  arbitrary = do+    d <- ModifiedJulianDay . fromInteger . getPositive <$> arbitrary+    t <- fromInteger . getPositive <$> arbitrary+    return $ UTCTime d t++$(derive makeArbitrary ''CronField)+$(derive makeArbitrary ''MinuteSpec)+$(derive makeArbitrary ''HourSpec)+$(derive makeArbitrary ''DayOfWeekSpec)+$(derive makeArbitrary ''DayOfMonthSpec)+$(derive makeArbitrary ''MonthSpec)+$(derive makeArbitrary ''CronSchedule)+++-------------------------------------------------------------------------------+isLeft :: Either a b -> Bool+isLeft (Left _) = True+isLeft _        = False

@@ -0,0 +1,252 @@+{-# LANGUAGE OverloadedStrings #-}+module System.Test.Cron (tests) where++-------------------------------------------------------------------------------+import           SpecHelper+-------------------------------------------------------------------------------+++tests :: TestTree+tests = testGroup "System.Cron"+  [ describeScheduleMatches+  , describeCronScheduleShow+  , describeCrontabEntryShow+  , describeCrontabShow+  ]++---- Specs+describeScheduleMatches :: TestTree+describeScheduleMatches = testGroup "ScheduleMatches"+  [+      testCase "matches a catch-all" $+      scheduleMatches stars (day 5 25 1 2) @?= True++    , testCase "matches a specific field" $+      scheduleMatches stars { hour = Hours (SpecificField 1)}+                      (day 5 25 1 2) @?= True++    , testCase "matches a range" $+      scheduleMatches stars { dayOfMonth = DaysOfMonth (RangeField 3 5)}+                      (day 5 4 1 2) @?= True++    , testCase "does not match invalid range" $+      scheduleMatches stars { dayOfMonth = DaysOfMonth (RangeField 5 3)}+                      (day 5 4 1 2) @?= False++    , testCase "matches a list" $+      scheduleMatches stars { month = Months (ListField [SpecificField 1,+                                                         SpecificField 2,+                                                         SpecificField 3])}+                      (day 2 3 1 2) @?= True++    , testCase "matches a step field" $+       scheduleMatches stars { dayOfMonth = DaysOfMonth (StepField (RangeField 10 16) 2)}+                       (day 5 12 1 2) @?= True++    , testCase "does not match something missing the step field" $+      scheduleMatches stars { dayOfMonth = DaysOfMonth (StepField (RangeField 10 16) 2)}+                      (day 5 13 1 2) @?= False++    , testCase "matches starred stepped fields" $+      scheduleMatches stars { minute = Minutes (StepField Star 2)}+                            (day 5 13 1 4) @?= True++    , testCase "does not match fields that miss starred stepped fields" $+      scheduleMatches stars { minute = Minutes (StepField Star 2)}+                      (day 5 13 1 5) @?= False++    , testCase "matches multiple fields at once" $+      scheduleMatches stars { minute     = Minutes (StepField Star 2),+                              dayOfMonth = DaysOfMonth (SpecificField 3),+                              hour       = Hours (RangeField 10 14) }+                      (day 5 3 13 2) @?= True++    , testCase "matches a monday as 1" $+      scheduleMatches stars { dayOfWeek  = DaysOfWeek (SpecificField 1) }+                      (UTCTime (fromGregorian 2014 3 17) 0) @?= True++    , testCase "matches a sunday as 0" $+      scheduleMatches stars { dayOfWeek  = DaysOfWeek (SpecificField 0) }+                      (UTCTime (fromGregorian 2014 3 16) 0) @?= True++    , testCase "matches a sunday as 7" $+      scheduleMatches stars { dayOfWeek  = DaysOfWeek (SpecificField 7) }+                      (UTCTime (fromGregorian 2014 3 16) 0) @?= True++    , testCase "matches weekly on a sunday at 0:00" $+      scheduleMatches weekly (UTCTime (fromGregorian 2014 4 6) 0) @?= True++    , testCase "does not match weekly on a sunday at some time past midnight" $+      scheduleMatches weekly (UTCTime (fromGregorian 2014 6 4) 600) @?= False++    , testCase "does not match weekly on another day at midnight" $+      scheduleMatches weekly (UTCTime (fromGregorian 2014 6 5) 600) @?= False++    , testCase "only needs weekday or monthday to match" $+      scheduleMatches stars { dayOfWeek = DaysOfWeek (SpecificField 1),+                              dayOfMonth = DaysOfMonth (SpecificField 1) }+                      (UTCTime (fromGregorian 2014 11 1) 600) @?= True+    -- https://github.com/MichaelXavier/cron/issues/18+    , testCase "correctly schedules steps and ranges" $ do+      let Right oddMinute = parseOnly cronSchedule "1-59/2 * * * *"+      let Right evenMinute = parseOnly cronSchedule "0-59/2 * * * *"+      let t1 = mkTime 2015 7 17 15 17 0+      let t2 = mkTime 2015 7 17 15 18 0+      scheduleMatches oddMinute t1 @?= True+      scheduleMatches oddMinute t2 @?= False+      scheduleMatches evenMinute t1 @?= False+      scheduleMatches evenMinute t2 @?= True++    , testProperty "star matches everything" $ \t ->+            scheduleMatches stars t++    , testProperty "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++    , testProperty "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++    , testProperty "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++    , testProperty "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++    , testProperty "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++    , testProperty "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++    , testProperty "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 :: TestTree+describeCronScheduleShow = testGroup "CronSchedule show"+  [+    testCase "formats stars" $+    show stars @?= "CronSchedule * * * * *"++  , testCase "formats specific numbers" $+    show stars { dayOfWeek = DaysOfWeek (SpecificField 3)} @?=+         "CronSchedule * * * * 3"++  , testCase "formats lists" $+    show stars { minute = Minutes (ListField [SpecificField 1,+                                   SpecificField 2,+                                   SpecificField 3])} @?=+         "CronSchedule 1,2,3 * * * *"++  , testCase "formats ranges" $+    show stars { hour = Hours (RangeField 7 10)} @?=+         "CronSchedule * 7-10 * * *"++  , testCase "formats steps" $+    show stars { dayOfMonth = DaysOfMonth (StepField (ListField [SpecificField 3, SpecificField 5]) 2)} @?=+         "CronSchedule * * 3,5/2 * *"++  , testCase "formats @yearly" $+    show yearly @?= "CronSchedule 0 0 1 1 *"++  , testCase "formats @monthly" $+    show monthly @?= "CronSchedule 0 0 1 * *"++  , testCase "formats @weekly" $+    show weekly @?= "CronSchedule 0 0 * * 0"++  , testCase "formats @daily" $+    show daily @?= "CronSchedule 0 0 * * *"++  , testCase "formats @hourly" $+    show hourly @?= "CronSchedule 0 * * * *"++  , testCase "formats everyMinute" $+    show everyMinute @?= "CronSchedule * * * * *"+  ]++describeCrontabShow :: TestTree+describeCrontabShow = testGroup "Crontab Show"+  [+    testCase "prints nothing for an empty crontab" $+    show (Crontab []) @?= ""+  ]++describeCrontabEntryShow :: TestTree+describeCrontabEntryShow = testGroup "CrontabEntry Show"+  [+   testCase "formats environment variable sets" $+   show envSet @?= "FOO=BAR"++  , testCase "formats command entries" $+    show entry @?= "* * * * * do stuff"+  ]+++envSet :: CrontabEntry+envSet = EnvVariable "FOO" "BAR"++entry :: CrontabEntry+entry = CommandEntry stars "do stuff"++stars :: CronSchedule+stars = CronSchedule (Minutes Star)+                     (Hours Star)+                     (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+++mkTime y m d hr mn s = UTCTime day time+  where day = fromGregorian y m d+        time = s + 60 * mn + 60 * 60 * hr

@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings #-}+module System.Test.Cron.Parser (tests) where+-- TODO: this *should* just work with {-# OPTIONS_GHC -F -pgmF hspec-discover #-}+++-------------------------------------------------------------------------------+import           Data.Attoparsec.Text (Parser, parseOnly)+import           Data.Text            (Text)+-------------------------------------------------------------------------------+import           SpecHelper+import           System.Cron+import           System.Cron.Parser+-------------------------------------------------------------------------------+++tests :: TestTree+tests = testGroup "System.Cron.Parser"+  [ describeCronSchedule+  , describeCronScheduleLoose+  , describeCrontab+  , describeCrontabEntry+  ]++describeCronSchedule :: TestTree+describeCronSchedule = testGroup "cronSchedule"+  [+    testCase "parses all stars" $+    assertSuccessfulParse "* * * * *"+                          stars++  , testCase "parses specific values" $+    assertSuccessfulParse "1 2 3 * *"+                           stars { minute      = Minutes (SpecificField 1),+                                   hour        = Hours (SpecificField 2),+                                   dayOfMonth  = DaysOfMonth (SpecificField 3) }++  , testCase "parses list values" $+    assertSuccessfulParse "* * 3,4 * *"+                           stars { dayOfMonth  = DaysOfMonth (ListField [SpecificField 3,+                                                                         SpecificField 4]) }++  , testCase "parses range values" $+    assertSuccessfulParse "* * 3-4 * *"+                           stars { dayOfMonth  = DaysOfMonth (RangeField 3 4) }++  , testCase "parses step values" $+    assertSuccessfulParse "*/2 * 2-10/4 * *"+                          stars { minute     = Minutes (StepField Star 2),+                                  dayOfMonth  = DaysOfMonth (StepField (RangeField 2 10) 4) }++  , testCase "refuses to parse recursive steps" $+    assertFailedParse "*/2/3 * * * *"++  , testCase "refuses to parse sparse lists" $+    assertFailedParse "1,,2 * * * *"++  , testCase "refuses too few fields" $+    assertFailedParse "* * * *"++  , testCase "refuses too many fields" $+    assertFailedParse "* * * * * *"++  , testCase "refuses extraneous input" $+    assertFailedParse "* * * * *    wat is this"++  , testCase "parses @hourly" $+    assertSuccessfulParse "@hourly" hourly++  , testCase "parses @daily" $+    assertSuccessfulParse "@daily" daily++  , testCase "parses @monthly" $+    assertSuccessfulParse "@monthly" monthly++  , testCase "parses @yearly" $+    assertSuccessfulParse "@yearly" yearly++  , testCase "parses ranges at the last field" $+    assertSuccessfulParse "* * * * 3-4"+                           stars { dayOfWeek  = DaysOfWeek (RangeField 3 4) }+  , testCase "parses lists at the last field" $+    assertSuccessfulParse "* * * * 3,4"+                           stars { dayOfWeek  = DaysOfWeek (ListField [SpecificField 3,+                                                                       SpecificField 4]) }+  , testCase "parses steps at the last field" $+    assertSuccessfulParse "* * * * */4"+                           stars { dayOfWeek  = DaysOfWeek (StepField Star 4) }+  , testCase "parses a sunday as 7" $+    assertSuccessfulParse "* * * * 7"+                           stars { dayOfWeek  = DaysOfWeek (SpecificField 7) }+  , testCase "parses a sunday as 0" $+    assertSuccessfulParse "* * * * 0"+                           stars { dayOfWeek  = DaysOfWeek (SpecificField 0) }+  , testCase "parses another example" $+    assertSuccessfulParse "1-59/2 * * * *"+                          stars { minute     = Minutes (StepField (RangeField 1 59) 2) }++  ]+  where assertSuccessfulParse = assertParse cronSchedule+        assertFailedParse = assertNoParse cronSchedule++describeCronScheduleLoose :: TestTree+describeCronScheduleLoose = testGroup "cronScheduleLoose"+  [+    testCase "is okay with extaneous input" $+    assertSuccessfulParse "* * * * * *"+                          stars+  ]+  where assertSuccessfulParse = assertParse cronScheduleLoose++describeCrontab :: TestTree+describeCrontab = testGroup "crontab"+  [+    testCase "parses an empty input" $+    assertSuccessfulParse ""+                          (Crontab [])++  , testCase "parses whitespace" $+    assertSuccessfulParse "        "+                          (Crontab [])++  , testCase "parses a single line" $+    assertSuccessfulParse "        "+                          (Crontab [])++  , testCase "ignores comments" $+    assertSuccessfulParse "# comment"+                          (Crontab [])++  , testCase "ignores comments with leading whitespace" $+    assertSuccessfulParse "    # comment"+                          (Crontab [])++  , testCase "parses comments interspersed with actual commands" $+    assertSuccessfulParse "#comment here\nFOO=BAR\n  #another\n* * * * * do stuff"+                          (Crontab [envSet, entry])+  ]+  where assertSuccessfulParse = assertParse crontab++describeCrontabEntry :: TestTree+describeCrontabEntry = testGroup "crontabEntry"+  [+    testCase "parses an environment variable assignment" $+    assertSuccessfulParse "FOO=BAR"+                          envSet++  , testCase "parses an environment variable with whitespace at the front" $+    assertSuccessfulParse "  FOO=BAR"+                          envSet++  , testCase "parses an environment variable with whitespace in the middle" $+    assertSuccessfulParse "  FOO =   BAR"+                          envSet++  , testCase "parses a command" $+    assertSuccessfulParse "* * * * * do stuff"+                          entry++  , testCase "parses a command with any amount of whitespace inbetween" $+    assertSuccessfulParse "* * * * *      do stuff"+                          entry++  , testCase "parses a command with whitespace at the front" $+    assertSuccessfulParse "  * * * * *      do stuff"+                          entry+  ]+  where assertSuccessfulParse = assertParse crontabEntry++assertParse :: (Eq a, Show a)+               => Parser a+               -> Text+               -> a+               -> Assertion+assertParse parser txt expected = parsed @?= Right expected+  where parsed = parseOnly parser txt++--assertNoParse :: Parser a -> Text -> b+assertNoParse :: (Eq a, Show a)+                 => Parser a+                 -> Text+                 -> Assertion+assertNoParse parser txt = isLeft (parseOnly parser txt) @?= True++envSet :: CrontabEntry+envSet = EnvVariable "FOO" "BAR"++entry :: CrontabEntry+entry = CommandEntry stars "do stuff"++stars :: CronSchedule+stars = CronSchedule (Minutes Star)+                     (Hours Star)+                     (DaysOfMonth Star)+                     (Months Star)+                     (DaysOfWeek Star)

@@ -0,0 +1,50 @@+module System.Test.Cron.Schedule+    ( tests+    ) where++-------------------------------------------------------------------------------+import           Control.Concurrent+-------------------------------------------------------------------------------+import           SpecHelper+import           System.Cron.Schedule+-------------------------------------------------------------------------------+++tests :: TestTree+tests = testGroup "System.Cron.Schedule"+  [ describeMonadSchedule+  , describeExecSchedule+  ]++flipMVar :: MVar String -> IO ()+flipMVar v = putMVar v "dost thou even hoist"++describeMonadSchedule :: TestTree+describeMonadSchedule = testGroup "MonadSchedule"+  [+    testCase "should place the first job as the last job stated." $+      let (Job x _) = (s !! 0)+       in show x @?= "CronSchedule 0 0 * * *"+  , testCase "should place the last job as the first job stated." $+      let (Job x _) = (s !! 2)+       in show x @?= "CronSchedule * * * * *"+  , testCase "should read all three jobs." $+      length s @?= 3+  ]+  where Right ((), s) = runSchedule $ do addJob empty "* * * * *"+                                         addJob empty "0 * * * *"+                                         addJob empty "0 0 * * *"++describeExecSchedule :: TestTree+describeExecSchedule = testGroup "execSchedule"+  [+     testCase "should set an mvar each minute" $+       fireAndWait >>= (@?= "dost thou even hoist")+  ]+    where fireAndWait = do+            v    <- newEmptyMVar+            tids <- execSchedule $ do+                addJob (flipMVar v) "* * * * *"+            threadDelay (1000000 * 60)+            mapM_ killThread tids+            takeMVar v