From 3244ce81f30e0a30e39dcb025a69b07ca654d5f4 Mon Sep 17 00:00:00 2001 From: Anton Vakhrushev Date: Sun, 12 Nov 2017 10:00:26 +0300 Subject: [PATCH] Add matching and entry point code --- app/Main.hs | 22 +++++++++++++++++++- haskell-cron-test.cabal | 4 +++- src/Field.hs | 26 +++++++++++++++++++++-- src/Pattern.hs | 7 ++----- test/FieldSpec.hs | 46 ++++++++++++++++++++++++++++++++++++----- test/PatternSpec.hs | 2 +- 6 files changed, 92 insertions(+), 15 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a42e585..a9358b5 100644 --- a/app/Main.hs +++ b/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 diff --git a/haskell-cron-test.cabal b/haskell-cron-test.cabal index 2e98e98..003f1e0 100644 --- a/haskell-cron-test.cabal +++ b/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 diff --git a/src/Field.hs b/src/Field.hs index 2737046..41c3287 100644 --- a/src/Field.hs +++ b/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 diff --git a/src/Pattern.hs b/src/Pattern.hs index 8e7b4f4..d250b64 100644 --- a/src/Pattern.hs +++ b/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 diff --git a/test/FieldSpec.hs b/test/FieldSpec.hs index 3cb1736..68ffa22 100644 --- a/test/FieldSpec.hs +++ b/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 diff --git a/test/PatternSpec.hs b/test/PatternSpec.hs index 3e3b854..c8097c3 100644 --- a/test/PatternSpec.hs +++ b/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