ENH use ranges for MDY patterns

This commit is contained in:
Nathan Dwarshuis 2023-02-09 20:01:43 -05:00
parent 1e5f40d730
commit 88dec70ce6
3 changed files with 23 additions and 11 deletions

View File

@ -25,7 +25,14 @@ let Weekday = < Mon | Tue | Wed | Thu | Fri | Sat | Sun >
let RepeatPat = let RepeatPat =
{ rpStart : Natural, rpBy : Natural, rpRepeats : Optional Natural } { rpStart : Natural, rpBy : Natural, rpRepeats : Optional Natural }
let MDYPat = < Single : Natural | Multi : List Natural | Repeat : RepeatPat > let MDYPat =
< Single : Natural
| Multi : List Natural
| Repeat : RepeatPat
| After : Natural
| Before : Natural
| Between : { _between1 : Natural, _between2 : Natural }
>
let ModPat = let ModPat =
{ Type = { Type =

View File

@ -4,7 +4,7 @@ let List/map =
let T = let T =
./Types.dhall ./Types.dhall
sha256:27c65b31fe1b0dd58ff03ec0a37648f586914c81b81e5f33d3eac5a465475f2b sha256:10af13e592448321c1e298f55a1e924e77b7e64bd35512147e0952de1f3abcfb
let nullSplit = let nullSplit =
\(a : T.SplitAcnt) -> \(a : T.SplitAcnt) ->

View File

@ -53,14 +53,16 @@ expandCronPat b CronPat {..} = concatEither3 yRes mRes dRes $ \ys ms ds ->
yRes = case cronYear of yRes = case cronYear of
Nothing -> return [yb0 .. yb1] Nothing -> return [yb0 .. yb1]
Just pat -> do Just pat -> do
ys <- expandMDYPat (fromIntegral yb1) pat ys <- expandMDYPat (fromIntegral yb0) (fromIntegral yb1) pat
return $ dropWhile (< yb0) $ fromIntegral <$> ys return $ dropWhile (< yb0) $ fromIntegral <$> ys
mRes = expandMD 12 cronMonth mRes = expandMD 12 cronMonth
dRes = expandMD 31 cronDay dRes = expandMD 31 cronDay
(s, e) = expandBounds b (s, e) = expandBounds b
(yb0, mb0, db0) = toGregorian s (yb0, mb0, db0) = toGregorian s
(yb1, mb1, db1) = toGregorian $ addDays (-1) e (yb1, mb1, db1) = toGregorian $ addDays (-1) e
expandMD lim = fmap (fromIntegral <$>) . maybe (return [1 .. lim]) (expandMDYPat lim) expandMD lim =
fmap (fromIntegral <$>)
. maybe (return [1 .. lim]) (expandMDYPat 1 lim)
expandW (OnDay x) = [fromEnum x] expandW (OnDay x) = [fromEnum x]
expandW (OnDays xs) = fromEnum <$> xs expandW (OnDays xs) = fromEnum <$> xs
ws = maybe [] expandW cronWeekly ws = maybe [] expandW cronWeekly
@ -70,21 +72,24 @@ expandCronPat b CronPat {..} = concatEither3 yRes mRes dRes $ \ys ms ds ->
| m `elem` [4, 6, 9, 11] && d > 30 = Nothing | m `elem` [4, 6, 9, 11] && d > 30 = Nothing
| otherwise = Just $ fromGregorian y m d | otherwise = Just $ fromGregorian y m d
expandMDYPat :: Natural -> MDYPat -> EitherErr [Natural] expandMDYPat :: Natural -> Natural -> MDYPat -> EitherErr [Natural]
expandMDYPat _ (Single x) = Right [x] expandMDYPat lower upper (Single x) = Right [x | lower <= x && x <= upper]
expandMDYPat _ (Multi xs) = Right xs expandMDYPat lower upper (Multi xs) = Right $ dropWhile (<= lower) $ takeWhile (<= upper) xs
expandMDYPat lim (Repeat RepeatPat {rpStart = s, rpBy = b, rpRepeats = r}) expandMDYPat lower upper (After x) = Right [max lower x .. upper]
expandMDYPat lower upper (Before x) = Right [lower .. min upper x]
expandMDYPat lower upper (Between x y) = Right [max lower x .. min upper y]
expandMDYPat lower upper (Repeat RepeatPat {rpStart = s, rpBy = b, rpRepeats = r})
| b < 1 = Left $ PatternError s b r ZeroLength | b < 1 = Left $ PatternError s b r ZeroLength
| otherwise = do | otherwise = do
k <- limit r k <- limit r
return $ takeWhile (<= k) [s + i * b | i <- [0 ..]] return $ dropWhile (<= lower) $ takeWhile (<= k) [s + i * b | i <- [0 ..]]
where where
limit Nothing = Right lim limit Nothing = Right upper
limit (Just n) limit (Just n)
-- this guard not only produces the error for the user but also protects -- this guard not only produces the error for the user but also protects
-- from an underflow below it -- from an underflow below it
| n < 1 = Left $ PatternError s b r ZeroRepeats | n < 1 = Left $ PatternError s b r ZeroRepeats
| otherwise = Right $ min (s + b * (n - 1)) lim | otherwise = Right $ min (s + b * (n - 1)) upper
dayToWeekday :: Day -> Int dayToWeekday :: Day -> Int
dayToWeekday (ModifiedJulianDay d) = mod (fromIntegral d + 2) 7 dayToWeekday (ModifiedJulianDay d) = mod (fromIntegral d + 2) 7