diff --git a/app/Main.hs b/app/Main.hs index d2ac942..03e8a9a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,26 +1,27 @@ module Main where -import System.Environment (getArgs) -import Text.Parsec.Error (ParseError) -import System.Exit +import System.Environment (getArgs) +import System.Exit +import Text.Parsec.Error (ParseError) -import Pattern -import Data.Dates +import Data.Dates +import Pattern main :: IO () main = do args <- getArgs dt <- getCurrentDateTime - exitWith $ case processArgs args dt of - Just True -> ExitSuccess - Just False -> ExitFailure 1 - Nothing -> ExitFailure 2 + exitWith $ + case processArgs args dt of + Just True -> ExitSuccess + Just False -> ExitFailure 1 + Nothing -> ExitFailure 2 processArgs :: [String] -> DateTime -> Maybe Bool -processArgs [ptn] dt = safeMatch ptn dt +processArgs [ptn] dt = safeMatch ptn dt processArgs [ptn, time] dt = matchGivenTime ptn (parseDate dt time) -processArgs _ _ = Nothing +processArgs _ _ = Nothing matchGivenTime :: String -> Either ParseError DateTime -> Maybe Bool -matchGivenTime _ (Left _) = Nothing +matchGivenTime _ (Left _) = Nothing matchGivenTime ptn (Right dt) = safeMatch ptn dt diff --git a/src/Constraint.hs b/src/Constraint.hs index d20ac87..9806488 100644 --- a/src/Constraint.hs +++ b/src/Constraint.hs @@ -1,9 +1,9 @@ module Constraint where -data Constraint = Constraint { - lower :: Int, - upper :: Int -} deriving (Show, Eq) +data Constraint = Constraint + { lower :: Int + , upper :: Int + } deriving (Show, Eq) makeRangeFromNumber :: Int -> Constraint makeRangeFromNumber x = Constraint x x diff --git a/src/Field.hs b/src/Field.hs index f54a71f..7c00216 100644 --- a/src/Field.hs +++ b/src/Field.hs @@ -1,18 +1,25 @@ module Field where -import Data.Char (isDigit) -import Data.Maybe +import Constraint +import Data.Char (isDigit) +import Data.Maybe +import Helper -import Constraint -import Helper - -data Range = All | Range Int Int | Sequence [Int] +data Range + = All + | Range Int + Int + | Sequence [Int] deriving (Eq, Show) -data Step = Every | Step Int +data Step + = Every + | Step Int deriving (Eq, Show) -data Field = Field Range Step +data Field = + Field Range + Step deriving (Eq, Show) parseField :: String -> Constraint -> Maybe Field @@ -64,7 +71,9 @@ parseRange text constraint isAllNumbers = all isNumber pieces start = read (head pieces) :: Int end = read (pieces !! 1) :: Int - isValid = isTwo && isAllNumbers && start <= start && (start, end) `inside` constraint + isValid = + isTwo && + isAllNumbers && start <= start && (start, end) `inside` constraint parseSequence :: String -> Constraint -> Maybe [Int] parseSequence text constraint @@ -79,17 +88,19 @@ parseSequence text constraint parseFieldStep :: String -> Maybe Step parseFieldStep "" = Just Every -parseFieldStep text | isNumber text = Just (Step (read text)) +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 +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 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 Every _ = True matchFieldStep (Step x) n = n `mod` x == 0 diff --git a/src/Pattern.hs b/src/Pattern.hs index 509232c..b46f765 100644 --- a/src/Pattern.hs +++ b/src/Pattern.hs @@ -1,53 +1,55 @@ module Pattern - ( Pattern(..), - match, - safeMatch, - parse, - check, - createParts, - parseField - ) where + ( Pattern(..) + , match + , safeMatch + , parse + , check + , createParts + , parseField + ) where -import Data.Dates -import Data.Maybe +import Constraint +import Data.Dates +import Data.Maybe +import Field -import Field -import Constraint - -data Pattern = Pattern { - cminute :: Field, - chour :: Field, - cday :: Field, - cmonth :: Field, - cweek :: Field, - cyear :: Field -} +data Pattern = Pattern + { cminute :: Field + , chour :: Field + , cday :: Field + , cmonth :: Field + , cweek :: Field + , cyear :: Field + } match :: String -> DateTime -> Bool -match s d = case parse s of - Just p -> check p d +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) +safeMatch s d = + case parse s of + Just p -> Just (check p d) Nothing -> Nothing parse :: String -> Maybe Pattern parse s - | isInvalid = Nothing - | otherwise = Just (createPattern $ catMaybes parts) - where - parts = createParts s - isInvalid = not (checkParts parts) - createPattern xs = Pattern { - cminute = head xs, - chour = xs !! 1, - cday = xs !! 2, - cmonth = xs !! 3, - cweek = xs !! 4, - cyear = xs !! 5 - } + | isInvalid = Nothing + | otherwise = Just (createPattern $ catMaybes parts) + where + parts = createParts s + isInvalid = not (checkParts parts) + createPattern xs = + Pattern + { cminute = head xs + , chour = xs !! 1 + , cday = xs !! 2 + , cmonth = xs !! 3 + , cweek = xs !! 4 + , cyear = xs !! 5 + } createParts s = zipWith (curry f) parsers (words s) where @@ -55,18 +57,23 @@ createParts s = zipWith (curry f) parsers (words s) checkParts :: [Maybe Field] -> Bool checkParts xs - | length xs /= 6 = False - | any isNothing xs = False - | otherwise = True + | length xs /= 6 = False + | any isNothing xs = False + | otherwise = True parseFieldAdapter :: Constraint -> String -> Maybe Field parseFieldAdapter c t = parseField t c 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] @@ -74,11 +81,12 @@ parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear] check :: Pattern -> DateTime -> Bool check ptn date = all isRight pairs where - pairs = [ (cminute ptn, minute date), - (chour ptn, hour date), - (cday ptn, day date), - (cmonth ptn, month date), - (cweek ptn, weekdayNumber $ dateWeekDay date), - (cyear ptn, year date) - ] + pairs = + [ (cminute ptn, minute date) + , (chour ptn, hour date) + , (cday ptn, day date) + , (cmonth ptn, month date) + , (cweek ptn, weekdayNumber $ dateWeekDay date) + , (cyear ptn, year date) + ] isRight (p, value) = matchField p value diff --git a/test/ConstraintSpec.hs b/test/ConstraintSpec.hs index 44125db..a292cc1 100644 --- a/test/ConstraintSpec.hs +++ b/test/ConstraintSpec.hs @@ -1,19 +1,18 @@ -module ConstraintSpec (main, spec) where +module ConstraintSpec + ( main + , spec + ) where -import Test.Hspec - -import Constraint +import Constraint +import Test.Hspec main :: IO () 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 +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 68ffa22..0e2cec8 100644 --- a/test/FieldSpec.hs +++ b/test/FieldSpec.hs @@ -1,9 +1,12 @@ -module FieldSpec (main, spec) where +module FieldSpec + ( main + , spec + ) where -import Foreign.Marshal.Utils (fromBool) -import Test.Hspec -import Constraint -import Field +import Constraint +import Field +import Foreign.Marshal.Utils (fromBool) +import Test.Hspec main :: IO () main = hspec spec @@ -13,72 +16,48 @@ 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 - -- Field validation - describe "Field Range can be created from" $ do - it "asterisk" $ - parseFieldRange "*" (Constraint 0 0) `shouldBe` Just All - + it "asterisk" $ parseFieldRange "*" (Constraint 0 0) `shouldBe` Just All it "number" $ parseFieldRange "10" (Constraint 0 10) `shouldBe` Just (Range 10 10) - it "range" $ parseFieldRange "10-20" (Constraint 0 59) `shouldBe` Just (Range 10 20) - it "sequence" $ - parseFieldRange "1,2,3" (Constraint 0 59) `shouldBe` Just (Sequence [1, 2, 3]) - + parseFieldRange "1,2,3" (Constraint 0 59) `shouldBe` + Just (Sequence [1, 2, 3]) -- Field Step validation - describe "Step can be created from" $ do - it "empty string" $ - parseFieldStep "" `shouldBe` Just Every - - it "number" $ - parseFieldStep "5" `shouldBe` Just (Step 5) - + it "empty string" $ parseFieldStep "" `shouldBe` Just Every + it "number" $ parseFieldStep "5" `shouldBe` Just (Step 5) describe "Step cant'b created from" $ do - it "word" $ - parseFieldStep "hello" `shouldBe` Nothing - + 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)) - + 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)) - + 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)) - + 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 - + 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 + where + m = fromBool . matchField field diff --git a/test/HelperSpec.hs b/test/HelperSpec.hs index 7c4e16e..826229c 100644 --- a/test/HelperSpec.hs +++ b/test/HelperSpec.hs @@ -1,21 +1,20 @@ -module HelperSpec (main, spec) where +module HelperSpec + ( main + , spec + ) where -import Test.Hspec -import Helper +import Helper +import Test.Hspec main :: IO () main = hspec spec spec :: Spec -spec = 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"] +spec = + 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 index f80d9e0..bb8d8d4 100644 --- a/test/PatternSpec.hs +++ b/test/PatternSpec.hs @@ -1,9 +1,11 @@ -module PatternSpec (main, spec) where +module PatternSpec + ( main + , spec + ) where -import Test.Hspec -import Data.Dates - -import Pattern +import Data.Dates +import Pattern +import Test.Hspec main :: IO () main = hspec spec @@ -11,33 +13,24 @@ main = hspec spec spec :: Spec spec = do describe "Cron pattern" $ do - - it "createParts" $ - length (createParts "* * * * * *") `shouldBe` 6 - + it "createParts" $ length (createParts "* * * * * *") `shouldBe` 6 it "matches fixed time" $ - let - ptn = "* * * * * *" - date = DateTime 2017 10 11 0 0 0 - in - match ptn date `shouldBe` True - + let ptn = "* * * * * *" + date = DateTime 2017 10 11 0 0 0 + in match ptn date `shouldBe` True it "matches all minutes" $ - let - ptn = "* * * * * *" - dates = [DateTime 2017 10 11 0 i 0 | i <- [0..59]] - in - countMatches ptn dates `shouldBe` 60 - + let ptn = "* * * * * *" + dates = [DateTime 2017 10 11 0 i 0 | i <- [0 .. 59]] + in countMatches ptn dates `shouldBe` 60 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 - + let date = DateTime 2017 10 11 0 0 0 + ptn = "0 0 11 10 * 2017" + in match ptn date `shouldBe` True countMatches :: String -> [DateTime] -> Int countMatches p xs = sum $ map (f p) xs where - f x d = if match x d then 1 else 0 + f x d = + if match x d + then 1 + else 0