Add matching and entry point code

app/Main.hs

@@ -1,6 +1,26 @@
 module Main where
 
+import System.Environment (getArgs)
+import Text.Parsec.Error (ParseError)
+import System.Exit
+
 import Pattern
+import Data.Dates
 
 main :: IO ()
-main = return ()
+main = do
+  args <- getArgs
+  dt <- getCurrentDateTime
+  case processArgs args dt of
+    Just True -> exitWith ExitSuccess
+    Just False -> exitWith (ExitFailure 1)
+    Nothing -> exitWith (ExitFailure 2)
+
+processArgs :: [String] -> DateTime -> Maybe Bool
+processArgs [pattern] dt = safeMatch pattern dt
+processArgs [pattern, time] dt = matchGivenTime pattern (parseDate dt time)
+processArgs _ _ = Nothing
+
+matchGivenTime :: String -> Either ParseError DateTime -> Maybe Bool
+matchGivenTime _ (Left _) = Nothing
+matchGivenTime pattern (Right dt) = safeMatch pattern dt

haskell-cron-test.cabal

@@ -26,6 +26,8 @@ executable haskell-cron-test-exe
   main-is:             Main.hs
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall -Werror
   build-depends:       base
+                     , dates == 0.2.2.1
+                     , parsec
                      , haskell-cron-test
   default-language:    Haskell2010
 
@@ -35,7 +37,7 @@ test-suite haskell-cron-test-test
   main-is:             Spec.hs
   other-modules:       PatternSpec, FieldSpec, ConstraintSpec, HelperSpec
   build-depends:       base
-                     , dates
+                     , dates == 0.2.2.1
                      , hspec
                      , QuickCheck
                      , haskell-cron-test

src/Field.hs

@@ -16,11 +16,21 @@ data Field = Field Range Step
   deriving (Eq, Show)
 
 parseField :: String -> Constraint -> Maybe Field
-parseField text constraint
+parseField text constraint = parseField' (wordsWhen (== '/') text) constraint
+
+parseField' :: [String] -> Constraint -> Maybe Field
+parseField' [rangeText] constraint
   | isJust range = Just (Field (fromJust range) Every)
   | otherwise = Nothing
   where
-    range = parseFieldRange text constraint
+    range = parseFieldRange rangeText constraint
+parseField' [rangeText, stepText] constraint
+  | isJust range && isJust step = Just (Field (fromJust range) (fromJust step))
+  | otherwise = Nothing
+  where
+    range = parseFieldRange rangeText constraint
+    step = parseFieldStep stepText
+parseField' _ _ = Nothing
 
 parseFieldRange :: String -> Constraint -> Maybe Range
 parseFieldRange text constraint
@@ -76,3 +86,15 @@ parseFieldStep :: String -> Maybe Step
 parseFieldStep "" = Just Every
 parseFieldStep text | isNumber text = Just (Step (read text))
 parseFieldStep _ = Nothing
+
+matchField :: Field -> Int -> Bool
+matchField (Field range step) n = matchFieldRange range n && matchFieldStep step n
+
+matchFieldRange :: Range -> Int -> Bool
+matchFieldRange All _ = True
+matchFieldRange (Range x y) n = n >= x && n <= y
+matchFieldRange (Sequence xs) n = n `elem` xs
+
+matchFieldStep :: Step -> Int -> Bool
+matchFieldStep Every _ = True
+matchFieldStep (Step x) n = n `mod` x == 0

src/Pattern.hs

@@ -1,6 +1,7 @@
 module Pattern
     ( Pattern(..),
       match,
+      safeMatch,
       parse,
       check,
       createParts,
@@ -25,7 +26,7 @@ data Pattern = Pattern {
 match :: String -> DateTime -> Bool
 match s d =  case parse s of
     Just p -> check p d
-    Nothing -> error ""
+    Nothing -> error "Parse error"
 
 safeMatch :: String -> DateTime -> Maybe Bool
 safeMatch s d = case parse s of
@@ -81,7 +82,3 @@ check pattern date = all isRight pairs
                   (cyear pattern, year date)
                 ]
         isRight (pattern, value) = matchField pattern value
-
-matchField :: Field -> Int -> Bool
-matchField (Field All Every) _ = True
-matchField (Field (Range f t) Every) x = x >= f && x <= t

test/FieldSpec.hs

@@ -1,5 +1,6 @@
 module FieldSpec (main, spec) where
 
+import Foreign.Marshal.Utils (fromBool)
 import Test.Hspec
 import Constraint
 import Field
@@ -21,18 +22,18 @@ spec = do
 
   -- Field validation
 
-  describe "Field can be created from" $ do
+  describe "Field Range can be created from" $ do
     it "asterisk" $
-      parseField "*" (Constraint 0 0) `shouldBe` Just (Field All Every)
+      parseFieldRange "*" (Constraint 0 0) `shouldBe` Just All
 
     it "number" $
-      parseField "10" (Constraint 0 10) `shouldBe` Just (Field (Range 10 10) Every)
+      parseFieldRange "10" (Constraint 0 10) `shouldBe` Just (Range 10 10)
 
     it "range" $
-      parseField "10-20" (Constraint 0 59) `shouldBe` Just (Field (Range 10 20) Every)
+      parseFieldRange "10-20" (Constraint 0 59) `shouldBe` Just (Range 10 20)
 
     it "sequence" $
-      parseField "1,2,3" (Constraint 0 59) `shouldBe` Just (Field (Sequence [1, 2, 3]) Every)
+      parseFieldRange "1,2,3" (Constraint 0 59) `shouldBe` Just (Sequence [1, 2, 3])
 
   -- Field Step validation
 
@@ -46,3 +47,38 @@ spec = do
   describe "Step cant'b created from" $ do
     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
+      parseField "*/5" (Constraint 0 59) `shouldBe` Just (Field All (Step 5))
+
+    it "number with step" $ do
+      parseField "10/5" (Constraint 0 59) `shouldBe` Just (Field (Range 10 10) (Step 5))
+
+    it "range with step" $ do
+      parseField "0-59/5" (Constraint 0 59) `shouldBe` Just (Field (Range 0 59) (Step 5))
+
+    it "sequence with step" $ do
+      parseField "1,3,4/5" (Constraint 0 59) `shouldBe` 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
+
+    it "range" $
+      count (Field (Range 10 20) Every) [0..59] `shouldBe` 11
+
+    it "range" $
+      count (Field All (Step 10)) [0..59] `shouldBe` 6
+
+
+count :: Field -> [Int] -> Int
+count field values = sum $ map m values
+  where m = fromBool . matchField field

test/PatternSpec.hs

@@ -40,6 +40,6 @@ spec = do
 countMatches :: String -> [DateTime] -> Int
 countMatches p xs = sum $ map (f p) xs
   where
-    f p d = case match p d of
+    f x d = case match x d of
       True -> 1
       False -> 0