Add some modules and tests

This commit is contained in:
2017-11-11 20:51:58 +03:00
parent e57e75a905
commit 67aa89a27c
13 changed files with 247 additions and 77 deletions

15
src/Constraint.hs Normal file
View 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
View 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
View 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'

View File

@ -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,25 +58,21 @@ 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
where
where
pairs = [ (cminute pattern, minute date),
(chour pattern, hour date),
(cday pattern, day date),
@ -89,8 +80,8 @@ check pattern date = all isRight pairs
(cweek pattern, weekdayNumber $ dateWeekDay date),
(cyear pattern, year date)
]
isRight (pattern, value) = matchField pattern value
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