diff --git a/app/Main.hs b/app/Main.hs index 03e8a9a..1790c38 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,27 +1,22 @@ -module Main where - -import System.Environment (getArgs) -import System.Exit -import Text.Parsec.Error (ParseError) +module Main + ( main + ) where import Data.Dates -import Pattern +import Pattern (match) +import System.Environment (getArgs) +import System.Exit main :: IO () main = do args <- getArgs - dt <- getCurrentDateTime + currentDateTime <- getCurrentDateTime exitWith $ - case processArgs args dt of + case processArgs args currentDateTime of Just True -> ExitSuccess Just False -> ExitFailure 1 Nothing -> ExitFailure 2 processArgs :: [String] -> DateTime -> Maybe Bool -processArgs [ptn] dt = safeMatch ptn dt -processArgs [ptn, time] dt = matchGivenTime ptn (parseDate dt time) -processArgs _ _ = Nothing - -matchGivenTime :: String -> Either ParseError DateTime -> Maybe Bool -matchGivenTime _ (Left _) = Nothing -matchGivenTime ptn (Right dt) = safeMatch ptn dt +processArgs [ptn] dt = match ptn dt +processArgs _ _ = Nothing diff --git a/src/Constraint.hs b/src/Constraint.hs index 9806488..48d0946 100644 --- a/src/Constraint.hs +++ b/src/Constraint.hs @@ -1,15 +1,16 @@ -module Constraint where +module Constraint + ( Constraint(..) + , inRange + , inside + ) where data Constraint = Constraint { lower :: Int , upper :: Int } deriving (Show, Eq) -makeRangeFromNumber :: Int -> Constraint -makeRangeFromNumber x = Constraint x x - inside :: (Int, Int) -> Constraint -> Bool -inside (x, y) (Constraint lower upper) = x >= lower && y <= upper +inside (x, y) (Constraint lw up) = x >= lw && y <= up inRange :: Int -> Constraint -> Bool inRange x = inside (x, x) diff --git a/src/Field.hs b/src/Field.hs index 7c00216..36087a6 100644 --- a/src/Field.hs +++ b/src/Field.hs @@ -1,4 +1,6 @@ -module Field where +module Field + ( module Field + ) where import Constraint import Data.Char (isDigit) @@ -44,11 +46,12 @@ parseFieldRange text constraint | text == "*" = Just All | isJust number = Just (Range (fromJust number) (fromJust number)) | isJust range = Just (uncurry Range (fromJust range)) - | isJust sequence = fmap Sequence sequence + | isJust valueSequence = fmap Sequence valueSequence + | otherwise = Nothing where number = parseNumber text constraint range = parseRange text constraint - sequence = parseSequence text constraint + valueSequence = parseSequence text constraint isNumber :: String -> Bool isNumber = all isDigit diff --git a/src/Helper.hs b/src/Helper.hs index 0b0c0f4..b3869c1 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -1,4 +1,6 @@ -module Helper where +module Helper + ( wordsWhen + ) where wordsWhen :: (Char -> Bool) -> String -> [String] wordsWhen p s = diff --git a/src/Pattern.hs b/src/Pattern.hs index b46f765..fc83da0 100644 --- a/src/Pattern.hs +++ b/src/Pattern.hs @@ -1,11 +1,9 @@ module Pattern ( Pattern(..) , match - , safeMatch , parse , check - , createParts - , parseField + , createFields ) where import Constraint @@ -20,16 +18,10 @@ data Pattern = Pattern , cmonth :: Field , cweek :: Field , cyear :: Field - } + } deriving (Show) -match :: String -> DateTime -> Bool +match :: String -> DateTime -> Maybe Bool match s d = - case parse s of - Just p -> check p d - Nothing -> error "Parse error" - -safeMatch :: String -> DateTime -> Maybe Bool -safeMatch s d = case parse s of Just p -> Just (check p d) Nothing -> Nothing @@ -39,7 +31,7 @@ parse s | isInvalid = Nothing | otherwise = Just (createPattern $ catMaybes parts) where - parts = createParts s + parts = createFields s isInvalid = not (checkParts parts) createPattern xs = Pattern @@ -51,9 +43,10 @@ parse s , cyear = xs !! 5 } -createParts s = zipWith (curry f) parsers (words s) +createFields :: String -> [Maybe Field] +createFields text = zipWith (curry f) parsers (words text) where - f (g, s) = g s + f (parser, s) = parser s checkParts :: [Maybe Field] -> Bool checkParts xs @@ -64,18 +57,25 @@ checkParts xs parseFieldAdapter :: Constraint -> String -> Maybe Field parseFieldAdapter c t = parseField t c +parseMinute :: String -> Maybe Field parseMinute = parseFieldAdapter (Constraint 0 59) -parseHour = parseFieldAdapter (Constraint 0 59) +parseHour :: String -> Maybe Field +parseHour = parseFieldAdapter (Constraint 0 23) +parseDay :: String -> Maybe Field parseDay = parseFieldAdapter (Constraint 1 31) +parseMonth :: String -> Maybe Field parseMonth = parseFieldAdapter (Constraint 1 12) +parseWeek :: String -> Maybe Field parseWeek = parseFieldAdapter (Constraint 1 7) +parseYear :: String -> Maybe Field parseYear = parseFieldAdapter (Constraint 0 9999) +parsers :: [String -> Maybe Field] parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear] check :: Pattern -> DateTime -> Bool diff --git a/test/ConstraintSpec.hs b/test/ConstraintSpec.hs index a292cc1..d12df90 100644 --- a/test/ConstraintSpec.hs +++ b/test/ConstraintSpec.hs @@ -12,7 +12,5 @@ main = hspec spec spec :: Spec spec = describe "Constraint" $ do - it "can be created from number" $ - makeRangeFromNumber 10 `shouldBe` Constraint 10 10 it "validate number" $ 10 `inRange` Constraint 0 10 `shouldBe` True it "validate number" $ 10 `inRange` Constraint 15 20 `shouldBe` False diff --git a/test/FieldSpec.hs b/test/FieldSpec.hs index 0e2cec8..52f020b 100644 --- a/test/FieldSpec.hs +++ b/test/FieldSpec.hs @@ -34,23 +34,23 @@ spec = do describe "Step can be created from" $ do it "empty string" $ parseFieldStep "" `shouldBe` Just Every it "number" $ parseFieldStep "5" `shouldBe` Just (Step 5) - describe "Step cant'b created from" $ do + describe "Step cant'b created from" $ it "word" $ parseFieldStep "hello" `shouldBe` Nothing -- Field validation describe "Field can be created from" $ do it "asterisk" $ parseField "*" (Constraint 0 59) `shouldBe` Just (Field All Every) - it "asterisk with step" $ do + it "asterisk with step" $ parseField "*/5" (Constraint 0 59) `shouldBe` Just (Field All (Step 5)) - it "number with step" $ do + it "number with step" $ parseField "10/5" (Constraint 0 59) `shouldBe` - Just (Field (Range 10 10) (Step 5)) - it "range with step" $ do + Just (Field (Range 10 10) (Step 5)) + it "range with step" $ parseField "0-59/5" (Constraint 0 59) `shouldBe` - Just (Field (Range 0 59) (Step 5)) - it "sequence with step" $ do + Just (Field (Range 0 59) (Step 5)) + it "sequence with step" $ parseField "1,3,4/5" (Constraint 0 59) `shouldBe` - Just (Field (Sequence [1, 3, 4]) (Step 5)) + Just (Field (Sequence [1, 3, 4]) (Step 5)) -- Field match describe "Field can match" $ do it "number" $ count (Field All Every) [0 .. 59] `shouldBe` 60 diff --git a/test/PatternSpec.hs b/test/PatternSpec.hs index bb8d8d4..6ab58cc 100644 --- a/test/PatternSpec.hs +++ b/test/PatternSpec.hs @@ -4,6 +4,7 @@ module PatternSpec ) where import Data.Dates +import Data.Maybe import Pattern import Test.Hspec @@ -11,13 +12,13 @@ main :: IO () main = hspec spec spec :: Spec -spec = do +spec = describe "Cron pattern" $ do - it "createParts" $ length (createParts "* * * * * *") `shouldBe` 6 + it "createFields" $ length (createFields "* * * * * *") `shouldBe` 6 it "matches fixed time" $ let ptn = "* * * * * *" date = DateTime 2017 10 11 0 0 0 - in match ptn date `shouldBe` True + in match ptn date `shouldBe` Just True it "matches all minutes" $ let ptn = "* * * * * *" dates = [DateTime 2017 10 11 0 i 0 | i <- [0 .. 59]] @@ -25,12 +26,16 @@ spec = do it "matches exactly moment" $ let date = DateTime 2017 10 11 0 0 0 ptn = "0 0 11 10 * 2017" - in match ptn date `shouldBe` True + in match ptn date `shouldBe` Just True + it "matches moment" $ + let date = DateTime 2017 10 10 12 10 0 + ptn = "* 12 * * * *" + in match ptn date `shouldBe` Just True countMatches :: String -> [DateTime] -> Int countMatches p xs = sum $ map (f p) xs where f x d = - if match x d + if isJust $ match x d then 1 else 0