ENH remove last two digit year check

This commit is contained in:
Nathan Dwarshuis 2023-01-29 10:51:03 -05:00
parent 69ead7b40d
commit 00a08d0fbe
1 changed files with 7 additions and 12 deletions

View File

@ -57,11 +57,10 @@ cronPatternMatches
yMaybe (y' - 2000) y && mdMaybe m' m && mdMaybe d' d && wdMaybe (dayOfWeek_ x) w yMaybe (y' - 2000) y && mdMaybe m' m && mdMaybe d' d && wdMaybe (dayOfWeek_ x) w
where where
testMaybe = maybe True testMaybe = maybe True
yMaybe z = testMaybe (mdyPatternMatches testYear (fromIntegral z)) yMaybe z = testMaybe (mdyPatternMatches (fromIntegral z))
mdMaybe z = testMaybe (mdyPatternMatches (const Nothing) (fromIntegral z)) mdMaybe z = testMaybe (mdyPatternMatches (fromIntegral z))
wdMaybe z = testMaybe (`weekdayPatternMatches` z) wdMaybe z = testMaybe (`weekdayPatternMatches` z)
(y', m', d') = toGregorian x (y', m', d') = toGregorian x
testYear z = if z > 99 then Just "year must be 2 digits" else Nothing
dayOfWeek_ :: Day -> Weekday dayOfWeek_ :: Day -> Weekday
dayOfWeek_ d = case dayOfWeek d of dayOfWeek_ d = case dayOfWeek d of
@ -77,16 +76,12 @@ weekdayPatternMatches :: WeekdayPat -> Weekday -> Bool
weekdayPatternMatches (OnDay x) = (== x) weekdayPatternMatches (OnDay x) = (== x)
weekdayPatternMatches (OnDays xs) = (`elem` xs) weekdayPatternMatches (OnDays xs) = (`elem` xs)
mdyPatternMatches :: (Natural -> Maybe String) -> Natural -> MDYPat -> Bool mdyPatternMatches :: Natural -> MDYPat -> Bool
mdyPatternMatches check x p = case p of mdyPatternMatches x p = case p of
Single y -> errMaybe (check y) $ x == y Single y -> x == y
Multi xs -> errMaybe (msum $ check <$> xs) $ x `elem` xs Multi xs -> x `elem` xs
Repeat (RepeatPat {rpStart = s, rpBy = b, rpRepeats = r}) -> Repeat (RepeatPat {rpStart = s, rpBy = b, rpRepeats = r}) ->
errMaybe (check s) $
s >= x && mod x b == 0 && maybe True (\y -> x <= s + b * y) r s >= x && mod x b == 0 && maybe True (\y -> x <= s + b * y) r
where
errMaybe test rest = maybe rest err test
err msg = error $ show p ++ ": " ++ msg
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- budget -- budget