ENH use ranges for MDY patterns
This commit is contained in:
parent
1e5f40d730
commit
88dec70ce6
|
@ -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 =
|
||||||
|
|
|
@ -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) ->
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue