Fix linting hints
This commit is contained in:
parent
3244ce81f3
commit
a14bdf1f53
14
app/Main.hs
14
app/Main.hs
@ -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
|
||||||
|
@ -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)
|
||||||
|
15
src/Field.hs
15
src/Field.hs
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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"]
|
||||||
|
@ -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
|
|
||||||
|
Loading…
Reference in New Issue
Block a user