cron (empty) → 0.1.0
raw patch · 9 files changed
+807/−0 lines, 9 filesdep +HUnitdep +attoparsecdep +basesetup-changed
Dependencies added: HUnit, attoparsec, base, hspec, hspec-discover, text, time
Files
- LICENSE +25/−0
- README.md +31/−0
- Setup.lhs +3/−0
- cron.cabal +58/−0
- src/System/Cron.hs +238/−0
- src/System/Cron/Parser.hs +160/−0
- test/Spec.hs +1/−0
- test/System/Cron/ParserSpec.hs +177/−0
- test/System/CronSpec.hs +114/−0
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2012, Michael Xavier. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright notice,+ this list of conditions and the following disclaimer in the documentation+ and/or other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS "AS IS" AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO+EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,31 @@+cron+====++Cron data structure and Attoparsec parser for Haskell. The idea is to embed it+in larger systems which want to roll their own scheduled tasks in a format that+people are used to.++`System.Cron` is where all the interesting datatypes live. You will also find+`scheduleMatches`, which you can use to compare a time against a `CronSchedule`+to see if an action needs to be performed. System.Cron.Parser is where you will+find the parsers `cronSchedule`, `crontabEntry` and `cronTab`. To parse+individual schedules up to full crontab files.+++To do anything, you'll need to install cabal-dev with cabal.++To build, run:++ make++To run tests, run:++ make test++If you have inotify-tools, run this to run tests continuously.++ make autotest++To generate docs:++ make docs
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ cron.cabal view
@@ -0,0 +1,58 @@+Name: cron+Version: 0.1.0+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+ are used to.++ 'System.Cron' is where all the interesting datatypes live. You will also find+ 'scheduleMatches', which you can use to compare a time against a+ 'CronSchedule' to see if an action needs to be performed. System.Cron.Parser+ is where you will find the parsers `cronSchedule`, `crontabEntry` and+ `cronTab`. To parse individual schedules up to full crontab files.++Synopsis: Cron datatypes and Attoparsec parser+Category: Text, Parsing, System+License: MIT+License-file: LICENSE+Author: Michael Xavier <michael@michaelxavier.net>+Copyright: Copyright: (c) 2012 Michael Xavier+Maintainer: Michael Xavier <michael@michaelxavier.net>+Build-Type: Simple+Stability: experimental+Tested-With: GHC == 7.4.1+Cabal-Version: >= 1.8+Extra-Source-Files:+ README.md+ LICENSE+ test/Spec.hs+ test/System/Cron/ParserSpec.hs+ test/System/CronSpec.hs+Homepage: http://github.com/michaelxavier/cron+Bug-Reports: http://github.com/michaelxavier/cron/issues++library+ Exposed-modules: System.Cron,+ System.Cron.Parser+ Ghc-Options: -Wall+ Hs-source-dirs: src+ build-depends: base >= 4 && < 5,+ attoparsec == 0.10.*,+ text == 0.11.*,+ time >= 1.4++test-suite spec+ Type: exitcode-stdio-1.0+ Main-Is: Spec.hs+ Hs-Source-Dirs: src, test+ Build-Depends: base >= 4 && < 5,+ hspec == 1.1.*,+ hspec-discover == 0.*,+ HUnit == 1.*,+ attoparsec == 0.10.*,+ text == 0.11.*,+ time >= 1.4++source-repository head+ Type: git+ Location: https://github.com/michaelxavier/cron
+ src/System/Cron.hs view
@@ -0,0 +1,238 @@+--------------------------------------------------------------------+-- |+-- Module : System.Cron+-- Description : Datatype for Cron Schedule and helpful functions+-- Copyright : (c) Michael Xavier 2012+-- License : MIT+--+-- Maintainer: Michael Xavier <michael@michaelxavier.net>+-- Portability: portable+--+-- 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+-- +--------------------------------------------------------------------+module System.Cron (CronSchedule(..),+ Crontab(..),+ CrontabEntry(..),+ MinuteSpec(..),+ HourSpec(..),+ MonthSpec(..),+ DayOfMonthSpec(..),+ DayOfWeekSpec(..),+ CronField(..),+ yearly,+ monthly,+ daily,+ weekly,+ hourly,+ everyMinute,+ scheduleMatches) where++import Data.List (intercalate)++import Data.Text (Text, unpack)+import Data.Time.Calendar (toGregorian)+import Data.Time.Calendar.WeekDate (toWeekDate)+import Data.Time.Clock (UTCTime(..))+import Data.Time.LocalTime (TimeOfDay(..), timeToTimeOfDay)++-- | Specification for a cron expression+data CronSchedule = CronSchedule { minute :: MinuteSpec, -- ^ Which minutes to run. First field in a cron specification.+ hour :: HourSpec, -- ^ Which hours to run. Second field in a cron specification.+ dayOfMonth :: DayOfMonthSpec, -- ^ Which days of the month to run. Third field in a cron specification.+ month :: MonthSpec, -- ^ Which months to run. Fourth field in a cron specification.+ dayOfWeek :: DayOfWeekSpec -- ^ Which days of the week to run. Fifth field in a cron specification.+ }+ deriving (Eq)++instance Show CronSchedule where+ show cs = "CronSchedule " ++ showRaw cs++showRaw :: CronSchedule+ -> String+showRaw cs = unwords [show $ minute cs,+ show $ hour cs,+ show $ dayOfMonth cs,+ show $ month cs,+ show $ dayOfWeek cs]++-- | Crontab file, omitting comments.+newtype Crontab = Crontab [CrontabEntry]+ deriving (Eq)++instance Show Crontab where+ show (Crontab entries) = intercalate "\n" . map show $ entries++-- | Essentially a line in a crontab file. It is either a schedule with a+-- command after it or setting an environment variable (e.g. FOO=BAR)+data CrontabEntry = CommandEntry { schedule :: CronSchedule,+ command :: Text} |+ EnvVariable { varName :: Text,+ varValue :: Text }+ deriving (Eq)++instance Show CrontabEntry where+ show CommandEntry { schedule = s, command = c} = showRaw s ++ " " ++ unpack c+ show EnvVariable { varName = n, varValue = v} = unpack n ++ "=" ++ unpack v++-- | Minutes field of a cron expression+data MinuteSpec = Minutes CronField+ deriving (Eq)++instance Show MinuteSpec where+ show (Minutes cf) = show cf++-- | Hours field of a cron expression+data HourSpec = Hours CronField+ deriving (Eq)++instance Show HourSpec where+ show (Hours cf) = show cf++-- | Day of month field of a cron expression+data DayOfMonthSpec = DaysOfMonth CronField+ deriving (Eq)++instance Show DayOfMonthSpec where+ show (DaysOfMonth cf) = show cf++-- | Month field of a cron expression+data MonthSpec = Months CronField+ deriving (Eq)++instance Show MonthSpec where+ show (Months cf) = show cf++-- | Day of week field of a cron expression+data DayOfWeekSpec = DaysOfWeek CronField+ deriving (Eq)++instance Show DayOfWeekSpec where+ show (DaysOfWeek cf) = show cf++-- | Individual field of a cron expression.+data CronField = Star | -- ^ Matches anything+ SpecificField Int | -- ^ Matches a specific value (e.g. 1)+ RangeField Int Int | -- ^ Matches a range of values (e.g. 1-3)+ ListField [CronField] | -- ^ Matches a list of expressions. Recursive lists are invalid and the parser will never produce them.+ StepField CronField Int -- ^ Matches a stepped expression, e.g. (*/2). Recursive steps or stepped lists are invalid and the parser will never produce them.+ deriving (Eq)++instance Show CronField where+ show Star = "*"+ show (SpecificField i) = show i+ show (RangeField x y) = show x ++ "-" ++ show y+ show (ListField xs) = intercalate "," $ map show xs+ show (StepField f step) = show f ++ "/" ++ show step+++-- | Shorthand for every January 1st at midnight. Parsed with \@yearly+yearly :: CronSchedule+yearly = monthly { month = Months $ SpecificField 1 }++-- | Shorthand for every 1st of the month at midnight. Parsed with \@monthly+monthly :: CronSchedule+monthly = hourly { dayOfMonth = DaysOfMonth $ SpecificField 1 }++-- | Shorthand for every sunday at midnight. Parsed with \@weekly+weekly :: CronSchedule+weekly = daily { dayOfWeek = DaysOfWeek $ SpecificField 0,+ dayOfMonth = DaysOfMonth $ SpecificField 0 }++-- | Shorthand for every day at midnight. Parsed with \@daily+daily :: CronSchedule+daily = hourly { hour = Hours $ SpecificField 0 }++-- | Shorthand for every hour on the hour. Parsed with \@hourly+hourly :: CronSchedule+hourly = everyMinute { minute = Minutes $ SpecificField 0 }++-- | Shorthand for an expression that always matches. Parsed with * * * * *+everyMinute :: CronSchedule+everyMinute = CronSchedule { minute = Minutes Star,+ hour = Hours Star,+ dayOfMonth = DaysOfMonth Star,+ month = Months Star,+ dayOfWeek = DaysOfWeek Star}++-- | Determines if the given time is matched by the given schedule. A+-- periodical task would use this to determine if an action needs to be+-- performed at the current time or not.+scheduleMatches :: CronSchedule+ -> UTCTime+ -> Bool+scheduleMatches CronSchedule { minute = Minutes mins,+ hour = Hours hrs,+ dayOfMonth = DaysOfMonth doms,+ month = Months months,+ dayOfWeek = DaysOfWeek dows }+ UTCTime { utctDay = uDay,+ utctDayTime = uTime } = all id validations+ where (_, mth, dom) = toGregorian 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)]+ validate (x, y, z) = matchField x y z++matchField :: Int+ -> CronUnit+ -> CronField+ -> Bool+matchField _ _ Star = True+matchField x _ (SpecificField y) = x == y+matchField x _ (RangeField y y') = x >= y && x <= y'+matchField x unit (ListField fs) = any (matchField x unit) fs+matchField x unit (StepField f step) = elem x $ expandDivided f step unit++expandDivided :: CronField+ -> Int+ -> CronUnit+ -> [Int]+expandDivided Star step unit = fillTo 0 max' step+ where max' = maxValue unit+expandDivided (RangeField start finish) step unit = fillTo start finish' step+ where finish' = minimum [finish, maxValue unit]+expandDivided _ _ _ = [] -- invalid++fillTo :: Int+ -> Int+ -> Int+ -> [Int]+fillTo start finish step+ | step <= 0 = []+ | finish < start = []+ | otherwise = [ x | x <- [start..finish], x `mod` step == 0]++data CronUnit = CMinute |+ CHour |+ CDayOfMonth |+ CMonth |+ CDayOfWeek++maxValue :: CronUnit -> Int+maxValue CMinute = 59+maxValue CHour = 23+maxValue CDayOfMonth = 31+maxValue CMonth = 12+maxValue CDayOfWeek = 6
+ src/System/Cron/Parser.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}+--------------------------------------------------------------------+-- |+-- Module : System.Cron.Parser+-- Description : Attoparsec parser for cron formatted intervals+-- Copyright : (c) Michael Xavier 2012+-- License : MIT+--+-- Maintainer: Michael Xavier <michael@michaelxavier.net>+-- Portability: portable+--+-- Attoparsec parser combinator for cron schedules. See cron documentation for+-- how those are formatted.+-- +-- > import Data.Attoparsec.Text (parseOnly)+-- > import System.Cron.Parser+-- > +-- > main :: IO ()+-- > main = do+-- > print $ parseOnly cronSchedule "*/2 * 3 * 4,5,6"+-- +--------------------------------------------------------------------+module System.Cron.Parser (cronSchedule,+ cronScheduleLoose,+ crontab,+ crontabEntry) where++import System.Cron++import Control.Applicative (pure, (*>), (<$>), (<*), (<*>), (<|>))+import Data.Char (isSpace)+import Data.Attoparsec.Text (Parser)+import qualified Data.Attoparsec.Text as A+import Data.Text (Text)++-- | Attoparsec Parser for a cron schedule. Complies fully with the standard+-- cron format. Also includes the following shorthand formats which cron also+-- supports: \@yearly, \@monthly, \@weekly, \@daily, \@hourly. Note that this+-- parser will fail if there is extraneous input. This is to prevent things+-- like extra fields. If you want a more lax parser, use 'cronScheduleLoose',+-- which is fine with extra input.+cronSchedule :: Parser CronSchedule+cronSchedule = cronScheduleLoose <* A.endOfInput++-- | Same as 'cronSchedule' but does not fail on extraneous input.+cronScheduleLoose :: Parser CronSchedule+cronScheduleLoose = yearlyP <|>+ monthlyP <|>+ weeklyP <|>+ dailyP <|>+ hourlyP <|>+ classicP++-- | Parses a full crontab file, omitting comments and including environment+-- variable sets (e.g FOO=BAR).+crontab :: Parser Crontab+crontab = Crontab <$> A.sepBy lineP (A.char '\n')+ where lineP = A.skipMany commentP *> crontabEntry+ commentP = A.skipSpace *> A.char '#' *> skipToEOL++-- | Parses an individual crontab line, which is either a scheduled command or+-- an environmental variable set.+crontabEntry :: Parser CrontabEntry+crontabEntry = A.skipSpace *> parser+ where parser = envVariableP <|>+ commandEntryP+ envVariableP = do var <- A.takeWhile1 (A.notInClass " =")+ A.skipSpace+ _ <- A.char '='+ A.skipSpace+ val <- A.takeWhile1 $ not . isSpace+ A.skipWhile (\c -> c == ' ' || c == '\t')+ return $ EnvVariable var val+ commandEntryP = CommandEntry <$> cronScheduleLoose+ <*> (A.skipSpace *> takeToEOL)++---- Internals+takeToEOL :: Parser Text+takeToEOL = A.takeTill (== '\n') -- <* A.skip (== '\n')++skipToEOL :: Parser ()+skipToEOL = A.skipWhile (/= '\n')++classicP :: Parser CronSchedule+classicP = CronSchedule <$> (minutesP <* space)+ <*> (hoursP <* space)+ <*> (dayOfMonthP <* space)+ <*> (monthP <* space)+ <*> dayOfWeekP+ where space = A.char ' '++cronFieldP :: Parser CronField+cronFieldP = steppedP <|>+ rangeP <|>+ listP <|>+ starP <|>+ specificP+ where starP = A.char '*' *> pure Star+ rangeP = do start <- parseInt+ _ <- A.char '-'+ end <- parseInt+ if start <= end+ then return $ RangeField start end+ else rangeInvalid+ rangeInvalid = fail "start of range must be less than or equal to end"+ -- Must avoid infinitely recursive parsers+ listP = reduceList <$> A.sepBy1 listableP (A.char ',')+ listableP = starP <|>+ rangeP <|>+ steppedP <|>+ specificP+ stepListP = ListField <$> A.sepBy1 stepListableP (A.char ',')+ stepListableP = starP <|>+ rangeP+ steppedP = StepField <$> steppableP <*> (A.char '/' *> parseInt)+ steppableP = starP <|>+ rangeP <|>+ stepListP <|>+ specificP+ specificP = SpecificField <$> parseInt++yearlyP :: Parser CronSchedule+yearlyP = A.string "@yearly" *> pure yearly++monthlyP :: Parser CronSchedule+monthlyP = A.string "@monthly" *> pure monthly++weeklyP :: Parser CronSchedule+weeklyP = A.string "@weekly" *> pure weekly++dailyP :: Parser CronSchedule+dailyP = A.string "@daily" *> pure daily++hourlyP :: Parser CronSchedule+hourlyP = A.string "@hourly" *> pure hourly+++--TODO: must handle a combination of many of these. EITHER just *, OR a list of+minutesP :: Parser MinuteSpec+minutesP = Minutes <$> cronFieldP++hoursP :: Parser HourSpec+hoursP = Hours <$> cronFieldP++dayOfMonthP :: Parser DayOfMonthSpec+dayOfMonthP = DaysOfMonth <$> cronFieldP++monthP :: Parser MonthSpec+monthP = Months <$> cronFieldP++dayOfWeekP :: Parser DayOfWeekSpec+dayOfWeekP = DaysOfWeek <$> cronFieldP++parseInt :: Parser Int+parseInt = A.decimal++reduceList :: [CronField] -> CronField+reduceList [] = ListField [] -- this should not happen+reduceList [x] = x+reduceList xs = ListField xs
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --nested #-}
+ test/System/Cron/ParserSpec.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings #-}+module System.Cron.ParserSpec (spec) where+-- TODO: this *should* just work with {-# OPTIONS_GHC -F -pgmF hspec-discover #-}++import Data.Attoparsec.Text (parseOnly, Parser)+import Data.Text (Text)+import Test.Hspec.Monadic+import Test.Hspec.HUnit ()+import Test.HUnit.Base ((~?=), Test)++import System.Cron+import System.Cron.Parser++spec :: Spec+spec = sequence_ [describeCronSchedule,+ describeCronScheduleLoose,+ describeCrontab,+ describeCrontabEntry]++describeCronSchedule :: Spec+describeCronSchedule = describe "cronSchedule" $ do+ it "parses all stars" $+ assertSuccessfulParse "* * * * *"+ stars++ it "parses specific values" $+ assertSuccessfulParse "1 2 3 * *"+ stars { minute = Minutes (SpecificField 1),+ hour = Hours (SpecificField 2),+ dayOfMonth = DaysOfMonth (SpecificField 3) }++ it "parses list values" $+ assertSuccessfulParse "* * 3,4 * *"+ stars { dayOfMonth = DaysOfMonth (ListField [SpecificField 3,+ SpecificField 4]) }++ it "parses range values" $+ assertSuccessfulParse "* * 3-4 * *"+ stars { dayOfMonth = DaysOfMonth (RangeField 3 4) }++ it "parses step values" $+ assertSuccessfulParse "*/2 * 2-10/4 * *"+ stars { minute = Minutes (StepField Star 2),+ dayOfMonth = DaysOfMonth (StepField (RangeField 2 10) 4) }++ it "refuses to parse recursive steps" $+ assertFailedParse "*/2/3 * * * *"++ it "refuses to parse sparse lists" $+ assertFailedParse "1,,2 * * * *"++ it "refuses too few fields" $+ assertFailedParse "* * * *"++ it "refuses too many fields" $+ assertFailedParse "* * * * * *"++ it "refuses extraneous input" $+ assertFailedParse "* * * * * wat is this"++ it "parses @hourly" $+ assertSuccessfulParse "@hourly" hourly++ it "parses @daily" $+ assertSuccessfulParse "@daily" daily++ it "parses @monthly" $+ assertSuccessfulParse "@monthly" monthly++ it "parses @yearly" $+ assertSuccessfulParse "@yearly" yearly++ it "parses ranges at the last field" $+ assertSuccessfulParse "* * * * 3-4"+ stars { dayOfWeek = DaysOfWeek (RangeField 3 4) }+ it "parses lists at the last field" $+ assertSuccessfulParse "* * * * 3,4"+ stars { dayOfWeek = DaysOfWeek (ListField [SpecificField 3,+ SpecificField 4]) }+ it "parses steps at the last field" $+ assertSuccessfulParse "* * * * */4"+ stars { dayOfWeek = DaysOfWeek (StepField Star 4) }+ where assertSuccessfulParse = assertParse cronSchedule+ assertFailedParse = assertNoParse cronSchedule ++describeCronScheduleLoose :: Spec+describeCronScheduleLoose = describe "cronScheduleLoose" $ do+ it "is okay with extaneous input" $+ assertSuccessfulParse "* * * * * *"+ stars+ where assertSuccessfulParse = assertParse cronScheduleLoose++describeCrontab :: Spec+describeCrontab = describe "crontab" $ do+ it "parses an empty input" $+ assertSuccessfulParse ""+ (Crontab [])++ it "parses whitespace" $+ assertSuccessfulParse " "+ (Crontab [])++ it "parses a single line" $+ assertSuccessfulParse " "+ (Crontab [])++ it "ignores comments" $+ assertSuccessfulParse "# comment"+ (Crontab [])++ it "ignores comments with leading whitespace" $+ assertSuccessfulParse " # comment"+ (Crontab [])++ it "parses comments interspersed with actual commands" $+ assertSuccessfulParse "#comment here\nFOO=BAR\n #another\n* * * * * do stuff"+ (Crontab [envSet, entry])++ where assertSuccessfulParse = assertParse crontab++describeCrontabEntry :: Spec+describeCrontabEntry = describe "crontabEntry" $ do+ it "parses an environment variable assignment" $ + assertSuccessfulParse "FOO=BAR"+ envSet++ it "pparses an environment variable with whitespace at the front" $ + assertSuccessfulParse " FOO=BAR"+ envSet++ it "pparses an environment variable with whitespace in the middle" $ + assertSuccessfulParse " FOO = BAR"+ envSet++ it "parses a command" $ + assertSuccessfulParse "* * * * * do stuff"+ entry++ it "parses a command with any amount of whitespace inbetween" $ + assertSuccessfulParse "* * * * * do stuff"+ entry++ it "pparses a command with whitespace at the front" $ + assertSuccessfulParse " * * * * * do stuff"+ entry+ where assertSuccessfulParse = assertParse crontabEntry++assertParse :: (Eq a, Show a)+ => Parser a+ -> Text+ -> a+ -> Test+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+ -> Test+assertNoParse parser txt = isLeft parsed ~?= True+ where isLeft (Left _) = True+ isLeft _ = False+ parsed = parseOnly parser txt++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)
+ test/System/CronSpec.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings #-}+module System.CronSpec (spec) where++import Data.Time.Clock+import Data.Time.Calendar+import Data.Time.LocalTime+import Test.Hspec.Monadic+import Test.Hspec.HUnit ()+import Test.HUnit.Base ((~?=))++import System.Cron++spec :: Spec+spec = sequence_ [describeScheduleMatches,+ describeCronScheduleShow,+ describeCrontabEntryShow,+ describeCrontabShow ]++---- Specs+describeScheduleMatches :: Spec+describeScheduleMatches = describe "ScheduleMatches" $ do+ it "matches a catch-all" $+ scheduleMatches stars (day 5 25 1 2)++ it "matches a specific field" $+ scheduleMatches stars { hour = Hours (SpecificField 1)}+ (day 5 25 1 2)++ it "matches a range" $+ scheduleMatches stars { dayOfMonth = DaysOfMonth (RangeField 3 5)}+ (day 5 4 1 2)++ it "does not match invalid range" $+ not $ scheduleMatches stars { dayOfMonth = DaysOfMonth (RangeField 5 3)}+ (day 5 4 1 2)++ it "matches a list" $+ scheduleMatches stars { month = Months (ListField [SpecificField 1,+ 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)++ it "matches starred stepped fields" $+ scheduleMatches stars { minute = Minutes (StepField Star 2)}+ (day 5 13 1 4)++ it "does not match fields that miss starred stepped fields" $+ not $ scheduleMatches stars { minute = Minutes (StepField Star 2)}+ (day 5 13 1 5)++ it "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)+ where day m d h mn = UTCTime (fromGregorian 2012 m d) (diffTime h mn)+ diffTime h mn = timeOfDayToTime $ TimeOfDay h mn 0++describeCronScheduleShow :: Spec+describeCronScheduleShow = describe "CronSchedule show" $ do+ it "formats stars" $+ show stars ~?=+ "CronSchedule * * * * *"++ it "formats specific numbers" $+ show stars { dayOfWeek = DaysOfWeek (SpecificField 3)} ~?=+ "CronSchedule * * * * 3"++ it "formats lists" $+ show stars { minute = Minutes (ListField [SpecificField 1,+ SpecificField 2,+ SpecificField 3])} ~?=+ "CronSchedule 1,2,3 * * * *"++ it "formats ranges" $+ show stars { hour = Hours (RangeField 7 10)} ~?=+ "CronSchedule * 7-10 * * *"++ it "formats steps" $+ show stars { dayOfMonth = DaysOfMonth (StepField (ListField [SpecificField 3, SpecificField 5]) 2)} ~?=+ "CronSchedule * * 3,5/2 * *"++describeCrontabShow :: Spec+describeCrontabShow = describe "Crontab Show" $ do+ it "prints nothing for an empty crontab" $+ show (Crontab []) ~?= ""++describeCrontabEntryShow :: Spec+describeCrontabEntryShow = describe "CrontabEntry Show" $ do+ it "formats environment variable sets" $+ show envSet ~?= "FOO=BAR"++ it "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)