diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/cron.cabal b/cron.cabal new file mode 100644 --- /dev/null +++ b/cron.cabal @@ -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 +Copyright: Copyright: (c) 2012 Michael Xavier +Maintainer: Michael Xavier +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 diff --git a/src/System/Cron.hs b/src/System/Cron.hs new file mode 100644 --- /dev/null +++ b/src/System/Cron.hs @@ -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 +-- 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 diff --git a/src/System/Cron/Parser.hs b/src/System/Cron/Parser.hs new file mode 100644 --- /dev/null +++ b/src/System/Cron/Parser.hs @@ -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 +-- 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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --nested #-} diff --git a/test/System/Cron/ParserSpec.hs b/test/System/Cron/ParserSpec.hs new file mode 100644 --- /dev/null +++ b/test/System/Cron/ParserSpec.hs @@ -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) diff --git a/test/System/CronSpec.hs b/test/System/CronSpec.hs new file mode 100644 --- /dev/null +++ b/test/System/CronSpec.hs @@ -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)