av/haskell-cron-matcher
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Format source code

Browse Source
This commit is contained in:
Anton Vakhrushev 2017-11-12 11:25:42 +03:00
parent a14bdf1f53
commit 35025d9359
8 changed files with 170 additions and 180 deletions

25
app/Main.hs
View File

@ -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

8
src/Constraint.hs
View File

@ -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

39
src/Field.hs
View File

@ -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

104
src/Pattern.hs
View File

@ -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

25
test/ConstraintSpec.hs
View File

@ -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

71
test/FieldSpec.hs
View File

@ -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

29
test/HelperSpec.hs
View File

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

49
test/PatternSpec.hs
View File

@ -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