Fix linting hints

This commit is contained in:
Anton Vakhrushev 2017-11-12 11:07:42 +03:00
parent 3244ce81f3
commit a14bdf1f53
7 changed files with 52 additions and 61 deletions

View File

@ -11,16 +11,16 @@ main :: IO ()
main = do main = do
args <- getArgs args <- getArgs
dt <- getCurrentDateTime dt <- getCurrentDateTime
case processArgs args dt of exitWith $ case processArgs args dt of
Just True -> exitWith ExitSuccess Just True -> ExitSuccess
Just False -> exitWith (ExitFailure 1) Just False -> ExitFailure 1
Nothing -> exitWith (ExitFailure 2) Nothing -> ExitFailure 2
processArgs :: [String] -> DateTime -> Maybe Bool processArgs :: [String] -> DateTime -> Maybe Bool
processArgs [pattern] dt = safeMatch pattern dt processArgs [ptn] dt = safeMatch ptn dt
processArgs [pattern, time] dt = matchGivenTime pattern (parseDate dt time) processArgs [ptn, time] dt = matchGivenTime ptn (parseDate dt time)
processArgs _ _ = Nothing processArgs _ _ = Nothing
matchGivenTime :: String -> Either ParseError DateTime -> Maybe Bool matchGivenTime :: String -> Either ParseError DateTime -> Maybe Bool
matchGivenTime _ (Left _) = Nothing matchGivenTime _ (Left _) = Nothing
matchGivenTime pattern (Right dt) = safeMatch pattern dt matchGivenTime ptn (Right dt) = safeMatch ptn dt

View File

@ -12,4 +12,4 @@ inside :: (Int, Int) -> Constraint -> Bool
inside (x, y) (Constraint lower upper) = x >= lower && y <= upper inside (x, y) (Constraint lower upper) = x >= lower && y <= upper
inRange :: Int -> Constraint -> Bool inRange :: Int -> Constraint -> Bool
inRange x cons = inside (x, x) cons inRange x = inside (x, x)

View File

@ -16,7 +16,7 @@ data Field = Field Range Step
deriving (Eq, Show) deriving (Eq, Show)
parseField :: String -> Constraint -> Maybe Field parseField :: String -> Constraint -> Maybe Field
parseField text constraint = parseField' (wordsWhen (== '/') text) constraint parseField text = parseField' (wordsWhen (== '/') text)
parseField' :: [String] -> Constraint -> Maybe Field parseField' :: [String] -> Constraint -> Maybe Field
parseField' [rangeText] constraint parseField' [rangeText] constraint
@ -34,20 +34,15 @@ parseField' _ _ = Nothing
parseFieldRange :: String -> Constraint -> Maybe Range parseFieldRange :: String -> Constraint -> Maybe Range
parseFieldRange text constraint parseFieldRange text constraint
| isAll = Just All | text == "*" = Just All
| isJust number = Just (Range (fromJust number) (fromJust number)) | isJust number = Just (Range (fromJust number) (fromJust number))
| isJust range = Just (Range (fst $ fromJust range) (snd $ fromJust range)) | isJust range = Just (uncurry Range (fromJust range))
| isJust sequence = fmap Sequence sequence | isJust sequence = fmap Sequence sequence
where where
isAll = parseAll text
number = parseNumber text constraint number = parseNumber text constraint
range = parseRange text constraint range = parseRange text constraint
sequence = parseSequence text constraint sequence = parseSequence text constraint
parseAll :: String -> Bool
parseAll "*" = True
parseAll _ = False
isNumber :: String -> Bool isNumber :: String -> Bool
isNumber = all isDigit isNumber = all isDigit
@ -67,7 +62,7 @@ parseRange text constraint
pieces = wordsWhen (== '-') text pieces = wordsWhen (== '-') text
isTwo = length pieces == 2 isTwo = length pieces == 2
isAllNumbers = all isNumber pieces isAllNumbers = all isNumber pieces
start = read (pieces !! 0) :: Int start = read (head pieces) :: Int
end = read (pieces !! 1) :: Int end = read (pieces !! 1) :: Int
isValid = isTwo && isAllNumbers && start <= start && (start, end) `inside` constraint isValid = isTwo && isAllNumbers && start <= start && (start, end) `inside` constraint
@ -79,7 +74,7 @@ parseSequence text constraint
pieces = wordsWhen (== ',') text pieces = wordsWhen (== ',') text
isAllNumbers = all isNumber pieces isAllNumbers = all isNumber pieces
numbers = map read pieces numbers = map read pieces
allInRange = all (\x -> x `inRange` constraint) numbers allInRange = all (`inRange` constraint) numbers
isValid = length pieces >= 2 && isAllNumbers && allInRange isValid = length pieces >= 2 && isAllNumbers && allInRange
parseFieldStep :: String -> Maybe Step parseFieldStep :: String -> Maybe Step

View File

@ -39,9 +39,9 @@ parse s
| otherwise = Just (createPattern $ catMaybes parts) | otherwise = Just (createPattern $ catMaybes parts)
where where
parts = createParts s parts = createParts s
isInvalid = checkParts parts == False isInvalid = not (checkParts parts)
createPattern xs = Pattern { createPattern xs = Pattern {
cminute = xs !! 0, cminute = head xs,
chour = xs !! 1, chour = xs !! 1,
cday = xs !! 2, cday = xs !! 2,
cmonth = xs !! 3, cmonth = xs !! 3,
@ -49,9 +49,9 @@ parse s
cyear = xs !! 5 cyear = xs !! 5
} }
createParts s = map f $ zip parsers (words s) createParts s = zipWith (curry f) parsers (words s)
where where
f (g, s) = g s f (g, s) = g s
checkParts :: [Maybe Field] -> Bool checkParts :: [Maybe Field] -> Bool
checkParts xs checkParts xs
@ -72,13 +72,13 @@ parseYear = parseFieldAdapter (Constraint 0 9999)
parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear] parsers = [parseMinute, parseHour, parseDay, parseMonth, parseWeek, parseYear]
check :: Pattern -> DateTime -> Bool check :: Pattern -> DateTime -> Bool
check pattern date = all isRight pairs check ptn date = all isRight pairs
where where
pairs = [ (cminute pattern, minute date), pairs = [ (cminute ptn, minute date),
(chour pattern, hour date), (chour ptn, hour date),
(cday pattern, day date), (cday ptn, day date),
(cmonth pattern, month date), (cmonth ptn, month date),
(cweek pattern, weekdayNumber $ dateWeekDay date), (cweek ptn, weekdayNumber $ dateWeekDay date),
(cyear pattern, year date) (cyear ptn, year date)
] ]
isRight (pattern, value) = matchField pattern value isRight (p, value) = matchField p value

View File

@ -8,13 +8,12 @@ main :: IO ()
main = hspec spec main = hspec spec
spec :: Spec spec :: Spec
spec = do spec = describe "Constraint" $ do
describe "Constraint" $ do it "can be created from number" $
it "can be created from number" $ makeRangeFromNumber 10 `shouldBe` Constraint 10 10
makeRangeFromNumber 10 `shouldBe` Constraint 10 10
it "validate number" $ it "validate number" $
10 `inRange` (Constraint 0 10) `shouldBe` True 10 `inRange` Constraint 0 10 `shouldBe` True
it "validate number" $ it "validate number" $
10 `inRange` (Constraint 15 20) `shouldBe` False 10 `inRange` Constraint 15 20 `shouldBe` False

View File

@ -7,16 +7,15 @@ main :: IO ()
main = hspec spec main = hspec spec
spec :: Spec spec :: Spec
spec = do spec = describe "Splitting" $ do
describe "Splitting" $ do it "can process empty string" $
it "can process empty string" $ wordsWhen (== '-') "" `shouldBe` []
wordsWhen (== '-') "" `shouldBe` []
it "can process only one word" $ it "can process only one word" $
wordsWhen (== '-') "10" `shouldBe` ["10"] wordsWhen (== '-') "10" `shouldBe` ["10"]
it "can separated by '-'" $ it "can separated by '-'" $
wordsWhen (== '-') "10-20" `shouldBe` ["10", "20"] wordsWhen (== '-') "10-20" `shouldBe` ["10", "20"]
it "can be separated by ','" $ it "can be separated by ','" $
wordsWhen (== ',') "10,20,30" `shouldBe` ["10", "20", "30"] wordsWhen (== ',') "10,20,30" `shouldBe` ["10", "20", "30"]

View File

@ -17,29 +17,27 @@ spec = do
it "matches fixed time" $ it "matches fixed time" $
let let
pattern = "* * * * * *" ptn = "* * * * * *"
date = DateTime 2017 10 11 0 0 0 date = DateTime 2017 10 11 0 0 0
in in
match pattern date `shouldBe` True match ptn date `shouldBe` True
it "matches all minutes" $ it "matches all minutes" $
let let
pattern = "* * * * * *" ptn = "* * * * * *"
dates = [DateTime 2017 10 11 0 i 0 | i <- [0..59]] dates = [DateTime 2017 10 11 0 i 0 | i <- [0..59]]
in in
countMatches pattern dates `shouldBe` 60 countMatches ptn dates `shouldBe` 60
it "matches exactly moment" $ it "matches exactly moment" $
let let
date = (DateTime 2017 10 11 0 0 0) date = DateTime 2017 10 11 0 0 0
pattern = "0 0 11 10 * 2017" ptn = "0 0 11 10 * 2017"
in in
match pattern date `shouldBe` True match ptn date `shouldBe` True
countMatches :: String -> [DateTime] -> Int countMatches :: String -> [DateTime] -> Int
countMatches p xs = sum $ map (f p) xs countMatches p xs = sum $ map (f p) xs
where where
f x d = case match x d of f x d = if match x d then 1 else 0
True -> 1
False -> 0