Add some modules and tests
This commit is contained in:
		
							
								
								
									
										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 #-} | ||||
|   | ||||
		Reference in New Issue
	
	Block a user