Add some modules and tests

.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

app/Main.hs

@@ -1,6 +1,6 @@
 module Main where
 
-import Lib
+import Pattern
 
 main :: IO ()
 main = return ()

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

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

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

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'

src/Pattern.hs

@@ -1,20 +1,17 @@
-module Lib
+module Pattern
-    ( match,
+    ( Pattern(..),
+      match,
       parse,
       check,
-      createParts
+      createParts,
+      parseField
     ) where
 
-import Data.Bool
 import Data.Dates
-import Data.Char (isDigit)
+import Data.Maybe
-import Data.Maybe (catMaybes, isNothing)
 
-data Range = Any | Pair Int Int | Sequence [Int]
+import Field
-
+import Constraint
-data Step = All | Value Int
-
-data Field = Field Range Step
 
 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
+parseFieldAdapter :: Constraint -> String -> Maybe Field
-parseField (f, t) s
+parseFieldAdapter c t = parseField t c
-    | 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
 
-parseMinute = parseField (0, 59)
+parseMinute = parseFieldAdapter (Constraint 0 59)
-parseHour = parseField (0, 59)
+parseHour = parseFieldAdapter (Constraint 0 59)
-parseDay = parseField (1, 31)
+parseDay = parseFieldAdapter (Constraint 1 31)
-parseMonth = parseField (1, 12)
+parseMonth = parseFieldAdapter (Constraint 1 12)
-parseWeek = parseField (1, 7)
+parseWeek = parseFieldAdapter (Constraint 1 7)
-parseYear = parseField (0, 9999)
+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 All Every) _ = True
-matchField (Field (Pair f t) All) x = x >= f && x <= t
+matchField (Field (Range f t) Every) x = x >= f && x <= t

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
+# compiler-check: newer-minor

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

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)

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"]

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

test/Spec.hs

@@ -1,42 +1 @@
-import Test.Hspec
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
-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