Add ability to match fixed numbers
This commit is contained in:
parent
bb244f47b2
commit
47c65c9b25
87
src/Lib.hs
87
src/Lib.hs
@ -1,9 +1,14 @@
|
||||
module Lib
|
||||
( match
|
||||
( match,
|
||||
parse,
|
||||
check,
|
||||
createParts
|
||||
) where
|
||||
|
||||
import Data.Bool
|
||||
import Data.Dates
|
||||
import Data.Char (isDigit)
|
||||
import Data.Maybe (catMaybes, isNothing)
|
||||
|
||||
data Range = Any | Pair Int Int | Sequence [Int]
|
||||
|
||||
@ -11,19 +16,81 @@ data Step = All | Value Int
|
||||
|
||||
data CronItemPattern = CronItemPattern Range Step
|
||||
|
||||
data CronPattern = CronPattern [CronItemPattern]
|
||||
data CronPattern = CronPattern {
|
||||
cminute :: CronItemPattern,
|
||||
chour :: CronItemPattern,
|
||||
cday :: CronItemPattern,
|
||||
cmonth :: CronItemPattern,
|
||||
cweek :: CronItemPattern,
|
||||
cyear :: CronItemPattern
|
||||
}
|
||||
|
||||
match :: String -> DateTime -> Bool
|
||||
match s d = matchPattern (parseCronPattern s) d
|
||||
match s d = case parse s of
|
||||
Just p -> check p d
|
||||
Nothing -> error ""
|
||||
|
||||
parseCronPattern :: String -> CronPattern
|
||||
parseCronPattern s = CronPattern $ map parseCronItemPattern $ words s
|
||||
safeMatch :: String -> DateTime -> Maybe Bool
|
||||
safeMatch s d = case parse s of
|
||||
Just p -> Just (check p d)
|
||||
Nothing -> Nothing
|
||||
|
||||
parseCronItemPattern :: String -> CronItemPattern
|
||||
parseCronItemPattern "*" = CronItemPattern Any All
|
||||
parse :: String -> Maybe CronPattern
|
||||
parse s
|
||||
| isInvalid = Nothing
|
||||
| otherwise = Just (createPattern $ catMaybes parts)
|
||||
where
|
||||
parts = createParts s
|
||||
isInvalid = checkParts parts == False
|
||||
createPattern xs = CronPattern {
|
||||
cminute = xs !! 0,
|
||||
chour = xs !! 1,
|
||||
cday = xs !! 2,
|
||||
cmonth = xs !! 3,
|
||||
cweek = xs !! 4,
|
||||
cyear = xs !! 5
|
||||
}
|
||||
|
||||
matchPattern :: CronPattern -> DateTime -> Bool
|
||||
matchPattern (CronPattern (x:xs)) d = matchItemPattern x (year d)
|
||||
parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear]
|
||||
|
||||
createParts s = map f $ zip parsers (words s)
|
||||
where
|
||||
f (g, s) = g s
|
||||
|
||||
checkParts :: [Maybe CronItemPattern] -> Bool
|
||||
checkParts xs
|
||||
| length xs /= 6 = False
|
||||
| any isNothing xs = False
|
||||
| otherwise = True
|
||||
|
||||
parseCronItemPattern :: (Int, Int) -> String -> Maybe CronItemPattern
|
||||
parseCronItemPattern (f, t) s
|
||||
| s == "*" = Just (CronItemPattern Any All)
|
||||
| validNumber == True = Just (CronItemPattern (Pair x x) All)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
x = read s :: Int
|
||||
validNumber = all isDigit s && x >= f && x <= t
|
||||
|
||||
parseMinute = parseCronItemPattern (0, 59)
|
||||
parseHour = parseCronItemPattern (0, 59)
|
||||
parseDay = parseCronItemPattern (1, 31)
|
||||
parseMonth = parseCronItemPattern (1, 12)
|
||||
parseWeek = parseCronItemPattern (1, 7)
|
||||
parseYear = parseCronItemPattern (0, 9999)
|
||||
|
||||
check :: CronPattern -> DateTime -> Bool
|
||||
check pattern date = all isRight pairs
|
||||
where
|
||||
pairs = [ (cminute pattern, minute date),
|
||||
(chour pattern, hour date),
|
||||
(cday pattern, day date),
|
||||
(cmonth pattern, month date),
|
||||
(cweek pattern, weekdayNumber $ dateWeekDay date),
|
||||
(cyear pattern, year date)
|
||||
]
|
||||
isRight (pattern, value) = matchItemPattern pattern value
|
||||
|
||||
matchItemPattern :: CronItemPattern -> Int -> Bool
|
||||
matchItemPattern (CronItemPattern Any All) _ = True
|
||||
matchItemPattern (CronItemPattern Any All) _ = True
|
||||
matchItemPattern (CronItemPattern (Pair f t) All) x = x >= f && x <= t
|
13
test/Spec.hs
13
test/Spec.hs
@ -3,12 +3,15 @@ import Test.QuickCheck
|
||||
import Control.Exception (evaluate)
|
||||
import Data.Dates
|
||||
|
||||
import Lib (match)
|
||||
import Lib
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "Cron pattern" $ do
|
||||
|
||||
it "createParts" $
|
||||
length (createParts "* * * * * *") `shouldBe` 6
|
||||
|
||||
it "matches fixed time" $
|
||||
let
|
||||
pattern = "* * * * * *"
|
||||
@ -23,8 +26,12 @@ main = hspec $ do
|
||||
in
|
||||
countMatches pattern dates `shouldBe` (60 :: Int)
|
||||
|
||||
-- it "matches exactly moment" $
|
||||
-- match "0 0 11 10 2017" (DateTime 2017 10 11 0 0 0) `shouldBe` (True :: Bool)
|
||||
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
|
||||
|
Loading…
Reference in New Issue
Block a user