Add some modules and tests
This commit is contained in:
parent
e57e75a905
commit
67aa89a27c
11
.editorconfig
Normal file
11
.editorconfig
Normal file
@ -0,0 +1,11 @@
|
||||
root = true
|
||||
|
||||
[*]
|
||||
charset = utf-8
|
||||
insert_final_newline = true
|
||||
end_of_line = "lf"
|
||||
|
||||
[*.hs]
|
||||
indent_style = space
|
||||
indent_size = 2
|
||||
trim_trailing_whitespace = true
|
@ -1,6 +1,6 @@
|
||||
module Main where
|
||||
|
||||
import Lib
|
||||
import Pattern
|
||||
|
||||
main :: IO ()
|
||||
main = return ()
|
||||
|
@ -15,9 +15,10 @@ cabal-version: >=1.10
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
exposed-modules: Lib
|
||||
exposed-modules: Pattern, Field, Constraint, Helper
|
||||
build-depends: base >= 4.7 && < 5
|
||||
, dates == 0.2.2.1
|
||||
, text
|
||||
default-language: Haskell2010
|
||||
|
||||
executable haskell-cron-test-exe
|
||||
@ -32,6 +33,7 @@ test-suite haskell-cron-test-test
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Spec.hs
|
||||
other-modules: PatternSpec, FieldSpec, ConstraintSpec, HelperSpec
|
||||
build-depends: base
|
||||
, dates
|
||||
, hspec
|
||||
|
15
src/Constraint.hs
Normal file
15
src/Constraint.hs
Normal file
@ -0,0 +1,15 @@
|
||||
module Constraint where
|
||||
|
||||
data Constraint = Constraint {
|
||||
lower :: Int,
|
||||
upper :: Int
|
||||
} deriving (Show, Eq)
|
||||
|
||||
makeRangeFromNumber :: Int -> Constraint
|
||||
makeRangeFromNumber x = Constraint x x
|
||||
|
||||
inside :: (Int, Int) -> Constraint -> Bool
|
||||
inside (x, y) (Constraint lower upper) = x >= lower && y <= upper
|
||||
|
||||
inRange :: Int -> Constraint -> Bool
|
||||
inRange x cons = inside (x, x) cons
|
65
src/Field.hs
Normal file
65
src/Field.hs
Normal file
@ -0,0 +1,65 @@
|
||||
module Field where
|
||||
|
||||
import Data.Char (isDigit)
|
||||
import Data.Maybe
|
||||
|
||||
import Constraint
|
||||
import Helper
|
||||
|
||||
data Range = All | Range Int Int | Sequence [Int]
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Step = Every | Step Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Field = Field Range Step
|
||||
deriving (Eq, Show)
|
||||
|
||||
parseField :: String -> Constraint -> Maybe Field
|
||||
parseField text constraint
|
||||
| isAll = Just (Field All Every)
|
||||
| isNumber = Just (Field (Range number number) Every)
|
||||
| isRange = Just (Field (Range leftBound rightBound) Every)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
-- All
|
||||
isAll = parseAll text
|
||||
-- Number
|
||||
numberParseResult = parseNumber text constraint
|
||||
isNumber = isJust $ numberParseResult
|
||||
number = fromJust numberParseResult
|
||||
-- Range
|
||||
rangeParseResult = parseRange text constraint
|
||||
isRange = isJust $ rangeParseResult
|
||||
rangeValues (Just p) = p
|
||||
leftBound = fst (rangeValues rangeParseResult)
|
||||
rightBound = snd (rangeValues rangeParseResult)
|
||||
-- -- Sequence
|
||||
-- matchSequence = matchRegex (mkRegex "(([0-9]+)[, ]?)+") s
|
||||
|
||||
parseAll :: String -> Bool
|
||||
parseAll "*" = True
|
||||
parseAll _ = False
|
||||
|
||||
isNumber :: String -> Bool
|
||||
isNumber = all isDigit
|
||||
|
||||
parseNumber :: String -> Constraint -> Maybe Int
|
||||
parseNumber text constraint
|
||||
| isValid = Just number
|
||||
| otherwise = Nothing
|
||||
where
|
||||
number = read text :: Int
|
||||
isValid = isNumber text && number `inRange` constraint
|
||||
|
||||
parseRange :: String -> Constraint -> Maybe (Int, Int)
|
||||
parseRange text constraint
|
||||
| isValid = Just (start, end)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
pieces = wordsWhen (== '-') text
|
||||
isTwo = length pieces == 2
|
||||
isAllNumbers = all isNumber pieces
|
||||
start = read (pieces !! 0) :: Int
|
||||
end = read (pieces !! 1) :: Int
|
||||
isValid = isTwo && isAllNumbers && start <= start && (start, end) `inside` constraint
|
8
src/Helper.hs
Normal file
8
src/Helper.hs
Normal file
@ -0,0 +1,8 @@
|
||||
module Helper where
|
||||
|
||||
wordsWhen :: (Char -> Bool) -> String -> [String]
|
||||
wordsWhen p s =
|
||||
case dropWhile p s of
|
||||
"" -> []
|
||||
s' -> w : wordsWhen p s''
|
||||
where (w, s'') = break p s'
|
@ -1,20 +1,17 @@
|
||||
module Lib
|
||||
( match,
|
||||
module Pattern
|
||||
( Pattern(..),
|
||||
match,
|
||||
parse,
|
||||
check,
|
||||
createParts
|
||||
createParts,
|
||||
parseField
|
||||
) where
|
||||
|
||||
import Data.Bool
|
||||
import Data.Dates
|
||||
import Data.Char (isDigit)
|
||||
import Data.Maybe (catMaybes, isNothing)
|
||||
import Data.Maybe
|
||||
|
||||
data Range = Any | Pair Int Int | Sequence [Int]
|
||||
|
||||
data Step = All | Value Int
|
||||
|
||||
data Field = Field Range Step
|
||||
import Field
|
||||
import Constraint
|
||||
|
||||
data Pattern = Pattern {
|
||||
cminute :: Field,
|
||||
@ -51,8 +48,6 @@ parse s
|
||||
cyear = xs !! 5
|
||||
}
|
||||
|
||||
parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear]
|
||||
|
||||
createParts s = map f $ zip parsers (words s)
|
||||
where
|
||||
f (g, s) = g s
|
||||
@ -63,21 +58,17 @@ checkParts xs
|
||||
| any isNothing xs = False
|
||||
| otherwise = True
|
||||
|
||||
parseField :: (Int, Int) -> String -> Maybe Field
|
||||
parseField (f, t) s
|
||||
| s == "*" = Just (Field Any All)
|
||||
| validNumber == True = Just (Field (Pair x x) All)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
x = read s :: Int
|
||||
validNumber = all isDigit s && x >= f && x <= t
|
||||
parseFieldAdapter :: Constraint -> String -> Maybe Field
|
||||
parseFieldAdapter c t = parseField t c
|
||||
|
||||
parseMinute = parseField (0, 59)
|
||||
parseHour = parseField (0, 59)
|
||||
parseDay = parseField (1, 31)
|
||||
parseMonth = parseField (1, 12)
|
||||
parseWeek = parseField (1, 7)
|
||||
parseYear = parseField (0, 9999)
|
||||
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]
|
||||
|
||||
check :: Pattern -> DateTime -> Bool
|
||||
check pattern date = all isRight pairs
|
||||
@ -92,5 +83,5 @@ check pattern date = all isRight pairs
|
||||
isRight (pattern, value) = matchField pattern value
|
||||
|
||||
matchField :: Field -> Int -> Bool
|
||||
matchField (Field Any All) _ = True
|
||||
matchField (Field (Pair f t) All) x = x >= f && x <= t
|
||||
matchField (Field All Every) _ = True
|
||||
matchField (Field (Range f t) Every) x = x >= f && x <= t
|
20
test/ConstraintSpec.hs
Normal file
20
test/ConstraintSpec.hs
Normal file
@ -0,0 +1,20 @@
|
||||
module ConstraintSpec (main, spec) where
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
import Constraint
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
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
|
31
test/FieldSpec.hs
Normal file
31
test/FieldSpec.hs
Normal file
@ -0,0 +1,31 @@
|
||||
module FieldSpec (main, spec) where
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
import Constraint
|
||||
import Field
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
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
|
||||
|
||||
describe "Field" $ do
|
||||
it "can be created from asterisk" $
|
||||
parseField "*" (Constraint 0 0) `shouldBe` Just (Field All Every)
|
||||
|
||||
it "can be created from number" $
|
||||
parseField "10" (Constraint 0 10) `shouldBe` Just (Field (Range 10 10) Every)
|
||||
|
||||
it "can be created from range" $
|
||||
parseField "10-20" (Constraint 0 59) `shouldBe` Just (Field (Range 10 20) Every)
|
23
test/HelperSpec.hs
Normal file
23
test/HelperSpec.hs
Normal file
@ -0,0 +1,23 @@
|
||||
module HelperSpec (main, spec) where
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
import Helper
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
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"]
|
45
test/PatternSpec.hs
Normal file
45
test/PatternSpec.hs
Normal file
@ -0,0 +1,45 @@
|
||||
module PatternSpec (main, spec) where
|
||||
|
||||
import Test.Hspec
|
||||
import Data.Dates
|
||||
|
||||
import Pattern
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "Cron pattern" $ do
|
||||
|
||||
it "createParts" $
|
||||
length (createParts "* * * * * *") `shouldBe` 6
|
||||
|
||||
it "matches fixed time" $
|
||||
let
|
||||
pattern = "* * * * * *"
|
||||
date = DateTime 2017 10 11 0 0 0
|
||||
in
|
||||
match pattern date `shouldBe` True
|
||||
|
||||
it "matches all minutes" $
|
||||
let
|
||||
pattern = "* * * * * *"
|
||||
dates = [DateTime 2017 10 11 0 i 0 | i <- [0..59]]
|
||||
in
|
||||
countMatches pattern dates `shouldBe` 60
|
||||
|
||||
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
|
||||
|
||||
|
||||
countMatches :: String -> [DateTime] -> Int
|
||||
countMatches p xs = sum $ map (f p) xs
|
||||
where
|
||||
f p d = case match p d of
|
||||
True -> 1
|
||||
False -> 0
|
43
test/Spec.hs
43
test/Spec.hs
@ -1,42 +1 @@
|
||||
import Test.Hspec
|
||||
import Test.QuickCheck
|
||||
import Control.Exception (evaluate)
|
||||
import Data.Dates
|
||||
|
||||
import Lib
|
||||
|
||||
main :: IO ()
|
||||
main = hspec $ do
|
||||
describe "Cron pattern" $ do
|
||||
|
||||
it "createParts" $
|
||||
length (createParts "* * * * * *") `shouldBe` 6
|
||||
|
||||
it "matches fixed time" $
|
||||
let
|
||||
pattern = "* * * * * *"
|
||||
date = DateTime 2017 10 11 0 0 0
|
||||
in
|
||||
match pattern date `shouldBe` (True :: Bool)
|
||||
|
||||
it "matches all minutes" $
|
||||
let
|
||||
pattern = "* * * * * *"
|
||||
dates = [DateTime 2017 10 11 0 i 0 | i <- [0..59]]
|
||||
in
|
||||
countMatches pattern dates `shouldBe` (60 :: Int)
|
||||
|
||||
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
|
||||
countMatches p xs = sum $ map (f p) xs
|
||||
where
|
||||
f p d = case match p d of
|
||||
True -> 1
|
||||
False -> 0
|
||||
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
|
Loading…
Reference in New Issue
Block a user