diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..9450121 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,11 @@ +root = true + +[*] +charset = utf-8 +insert_final_newline = true +end_of_line = "lf" + +[*.hs] +indent_style = space +indent_size = 2 +trim_trailing_whitespace = true diff --git a/app/Main.hs b/app/Main.hs index c15ec91..a42e585 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,6 @@ module Main where -import Lib +import Pattern main :: IO () main = return () diff --git a/haskell-cron-test.cabal b/haskell-cron-test.cabal index c081604..442e2f4 100644 --- a/haskell-cron-test.cabal +++ b/haskell-cron-test.cabal @@ -15,9 +15,10 @@ cabal-version: >=1.10 library hs-source-dirs: src - exposed-modules: Lib + exposed-modules: Pattern, Field, Constraint, Helper build-depends: base >= 4.7 && < 5 , dates == 0.2.2.1 + , text default-language: Haskell2010 executable haskell-cron-test-exe @@ -32,6 +33,7 @@ test-suite haskell-cron-test-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Spec.hs + other-modules: PatternSpec, FieldSpec, ConstraintSpec, HelperSpec build-depends: base , dates , hspec diff --git a/src/Constraint.hs b/src/Constraint.hs new file mode 100644 index 0000000..8556617 --- /dev/null +++ b/src/Constraint.hs @@ -0,0 +1,15 @@ +module Constraint 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 + +inRange :: Int -> Constraint -> Bool +inRange x cons = inside (x, x) cons diff --git a/src/Field.hs b/src/Field.hs new file mode 100644 index 0000000..30f7f0f --- /dev/null +++ b/src/Field.hs @@ -0,0 +1,65 @@ +module Field where + +import Data.Char (isDigit) +import Data.Maybe + +import Constraint +import Helper + +data Range = All | Range Int Int | Sequence [Int] + deriving (Eq, Show) + +data Step = Every | Step Int + deriving (Eq, Show) + +data Field = Field Range Step + deriving (Eq, Show) + +parseField :: String -> Constraint -> Maybe Field +parseField text constraint + | isAll = Just (Field All Every) + | isNumber = Just (Field (Range number number) Every) + | isRange = Just (Field (Range leftBound rightBound) Every) + | otherwise = Nothing + where + -- All + isAll = parseAll text + -- Number + numberParseResult = parseNumber text constraint + isNumber = isJust $ numberParseResult + number = fromJust numberParseResult + -- Range + rangeParseResult = parseRange text constraint + isRange = isJust $ rangeParseResult + rangeValues (Just p) = p + leftBound = fst (rangeValues rangeParseResult) + rightBound = snd (rangeValues rangeParseResult) + -- -- Sequence + -- matchSequence = matchRegex (mkRegex "(([0-9]+)[, ]?)+") s + +parseAll :: String -> Bool +parseAll "*" = True +parseAll _ = False + +isNumber :: String -> Bool +isNumber = all isDigit + +parseNumber :: String -> Constraint -> Maybe Int +parseNumber text constraint + | isValid = Just number + | otherwise = Nothing + where + number = read text :: Int + isValid = isNumber text && number `inRange` constraint + +parseRange :: String -> Constraint -> Maybe (Int, Int) +parseRange text constraint + | isValid = Just (start, end) + | otherwise = Nothing + where + pieces = wordsWhen (== '-') text + isTwo = length pieces == 2 + isAllNumbers = all isNumber pieces + start = read (pieces !! 0) :: Int + end = read (pieces !! 1) :: Int + isValid = isTwo && isAllNumbers && start <= start && (start, end) `inside` constraint diff --git a/src/Helper.hs b/src/Helper.hs new file mode 100644 index 0000000..0b0c0f4 --- /dev/null +++ b/src/Helper.hs @@ -0,0 +1,8 @@ +module Helper where + +wordsWhen :: (Char -> Bool) -> String -> [String] +wordsWhen p s = + case dropWhile p s of + "" -> [] + s' -> w : wordsWhen p s'' + where (w, s'') = break p s' diff --git a/src/Lib.hs b/src/Pattern.hs similarity index 65% rename from src/Lib.hs rename to src/Pattern.hs index be6b74e..8e7b4f4 100644 --- a/src/Lib.hs +++ b/src/Pattern.hs @@ -1,20 +1,17 @@ -module Lib - ( match, +module Pattern + ( Pattern(..), + match, parse, check, - createParts + createParts, + parseField ) where -import Data.Bool import Data.Dates -import Data.Char (isDigit) -import Data.Maybe (catMaybes, isNothing) +import Data.Maybe -data Range = Any | Pair Int Int | Sequence [Int] - -data Step = All | Value Int - -data Field = Field Range Step +import Field +import Constraint data Pattern = Pattern { cminute :: Field, @@ -51,8 +48,6 @@ parse s cyear = xs !! 5 } -parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear] - createParts s = map f $ zip parsers (words s) where f (g, s) = g s @@ -63,25 +58,21 @@ checkParts xs | any isNothing xs = False | otherwise = True -parseField :: (Int, Int) -> String -> Maybe Field -parseField (f, t) s - | s == "*" = Just (Field Any All) - | validNumber == True = Just (Field (Pair x x) All) - | otherwise = Nothing - where - x = read s :: Int - validNumber = all isDigit s && x >= f && x <= t +parseFieldAdapter :: Constraint -> String -> Maybe Field +parseFieldAdapter c t = parseField t c -parseMinute = parseField (0, 59) -parseHour = parseField (0, 59) -parseDay = parseField (1, 31) -parseMonth = parseField (1, 12) -parseWeek = parseField (1, 7) -parseYear = parseField (0, 9999) +parseMinute = parseFieldAdapter (Constraint 0 59) +parseHour = parseFieldAdapter (Constraint 0 59) +parseDay = parseFieldAdapter (Constraint 1 31) +parseMonth = parseFieldAdapter (Constraint 1 12) +parseWeek = parseFieldAdapter (Constraint 1 7) +parseYear = parseFieldAdapter (Constraint 0 9999) + +parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear] check :: Pattern -> DateTime -> Bool check pattern date = all isRight pairs - where + where pairs = [ (cminute pattern, minute date), (chour pattern, hour date), (cday pattern, day date), @@ -89,8 +80,8 @@ check pattern date = all isRight pairs (cweek pattern, weekdayNumber $ dateWeekDay date), (cyear pattern, year date) ] - isRight (pattern, value) = matchField pattern value + isRight (pattern, value) = matchField pattern value matchField :: Field -> Int -> Bool -matchField (Field Any All) _ = True -matchField (Field (Pair f t) All) x = x >= f && x <= t \ No newline at end of file +matchField (Field All Every) _ = True +matchField (Field (Range f t) Every) x = x >= f && x <= t diff --git a/stack.yaml b/stack.yaml index e094f6b..3b7c466 100644 --- a/stack.yaml +++ b/stack.yaml @@ -39,7 +39,7 @@ packages: - '.' # Dependency packages to be pulled from upstream that are not in the resolver # (e.g., acme-missiles-0.3) -extra-deps: +extra-deps: - dates-0.2.2.1 # Override default flag values for local packages and extra-deps @@ -64,4 +64,4 @@ extra-package-dbs: [] # extra-lib-dirs: [/path/to/dir] # # Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor \ No newline at end of file +# compiler-check: newer-minor diff --git a/test/ConstraintSpec.hs b/test/ConstraintSpec.hs new file mode 100644 index 0000000..2795624 --- /dev/null +++ b/test/ConstraintSpec.hs @@ -0,0 +1,20 @@ +module ConstraintSpec (main, spec) where + +import Test.Hspec + +import Constraint + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + 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 new file mode 100644 index 0000000..bd257e5 --- /dev/null +++ b/test/FieldSpec.hs @@ -0,0 +1,31 @@ +module FieldSpec (main, spec) where + +import Test.Hspec + +import Constraint +import Field + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "Number" $ do + it "can be parsed from string" $ + parseNumber "10" (Constraint 0 10) `shouldBe` Just 10 + + it "can't be parsed from string" $ + parseNumber "10and10" (Constraint 0 10) `shouldBe` Nothing + + it "fails constraints" $ + parseNumber "10" (Constraint 0 5) `shouldBe` Nothing + + describe "Field" $ do + it "can be created from asterisk" $ + parseField "*" (Constraint 0 0) `shouldBe` Just (Field All Every) + + it "can be created from number" $ + parseField "10" (Constraint 0 10) `shouldBe` Just (Field (Range 10 10) Every) + + it "can be created from range" $ + parseField "10-20" (Constraint 0 59) `shouldBe` Just (Field (Range 10 20) Every) diff --git a/test/HelperSpec.hs b/test/HelperSpec.hs new file mode 100644 index 0000000..5c59034 --- /dev/null +++ b/test/HelperSpec.hs @@ -0,0 +1,23 @@ +module HelperSpec (main, spec) where + +import Test.Hspec + +import Helper + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "Splitting" $ do + it "can process empty string" $ + wordsWhen (== '-') "" `shouldBe` [] + + it "can process only one word" $ + wordsWhen (== '-') "10" `shouldBe` ["10"] + + it "can separated by '-'" $ + wordsWhen (== '-') "10-20" `shouldBe` ["10", "20"] + + it "can be separated by ','" $ + wordsWhen (== ',') "10,20,30" `shouldBe` ["10", "20", "30"] diff --git a/test/PatternSpec.hs b/test/PatternSpec.hs new file mode 100644 index 0000000..3e3b854 --- /dev/null +++ b/test/PatternSpec.hs @@ -0,0 +1,45 @@ +module PatternSpec (main, spec) where + +import Test.Hspec +import Data.Dates + +import Pattern + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "Cron pattern" $ do + + it "createParts" $ + length (createParts "* * * * * *") `shouldBe` 6 + + it "matches fixed time" $ + let + pattern = "* * * * * *" + date = DateTime 2017 10 11 0 0 0 + in + match pattern date `shouldBe` True + + it "matches all minutes" $ + let + pattern = "* * * * * *" + dates = [DateTime 2017 10 11 0 i 0 | i <- [0..59]] + in + countMatches pattern dates `shouldBe` 60 + + it "matches exactly moment" $ + let + date = (DateTime 2017 10 11 0 0 0) + pattern = "0 0 11 10 * 2017" + in + match pattern date `shouldBe` True + + +countMatches :: String -> [DateTime] -> Int +countMatches p xs = sum $ map (f p) xs + where + f p d = case match p d of + True -> 1 + False -> 0 diff --git a/test/Spec.hs b/test/Spec.hs index a1c44a8..a824f8c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,42 +1 @@ -import Test.Hspec -import Test.QuickCheck -import Control.Exception (evaluate) -import Data.Dates - -import Lib - -main :: IO () -main = hspec $ do - describe "Cron pattern" $ do - - it "createParts" $ - length (createParts "* * * * * *") `shouldBe` 6 - - it "matches fixed time" $ - let - pattern = "* * * * * *" - date = DateTime 2017 10 11 0 0 0 - in - match pattern date `shouldBe` (True :: Bool) - - it "matches all minutes" $ - let - pattern = "* * * * * *" - dates = [DateTime 2017 10 11 0 i 0 | i <- [0..59]] - in - countMatches pattern dates `shouldBe` (60 :: Int) - - it "matches exactly moment" $ - let - date = (DateTime 2017 10 11 0 0 0) - pattern = "0 0 11 10 * 2017" - in - match pattern date `shouldBe` (True :: Bool) - - -countMatches :: String -> [DateTime] -> Int -countMatches p xs = sum $ map (f p) xs - where - f p d = case match p d of - True -> 1 - False -> 0 +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}