diff --git a/dhall/Types.dhall b/dhall/Types.dhall index 4bcada2..c098675 100644 --- a/dhall/Types.dhall +++ b/dhall/Types.dhall @@ -25,7 +25,14 @@ let Weekday = < Mon | Tue | Wed | Thu | Fri | Sat | Sun > let RepeatPat = { 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 = { Type = diff --git a/dhall/common.dhall b/dhall/common.dhall index 79e02ca..f60083a 100644 --- a/dhall/common.dhall +++ b/dhall/common.dhall @@ -4,7 +4,7 @@ let List/map = let T = ./Types.dhall - sha256:27c65b31fe1b0dd58ff03ec0a37648f586914c81b81e5f33d3eac5a465475f2b + sha256:10af13e592448321c1e298f55a1e924e77b7e64bd35512147e0952de1f3abcfb let nullSplit = \(a : T.SplitAcnt) -> diff --git a/lib/Internal/Insert.hs b/lib/Internal/Insert.hs index f904ab2..499e220 100644 --- a/lib/Internal/Insert.hs +++ b/lib/Internal/Insert.hs @@ -53,14 +53,16 @@ expandCronPat b CronPat {..} = concatEither3 yRes mRes dRes $ \ys ms ds -> yRes = case cronYear of Nothing -> return [yb0 .. yb1] Just pat -> do - ys <- expandMDYPat (fromIntegral yb1) pat + ys <- expandMDYPat (fromIntegral yb0) (fromIntegral yb1) pat return $ dropWhile (< yb0) $ fromIntegral <$> ys mRes = expandMD 12 cronMonth dRes = expandMD 31 cronDay (s, e) = expandBounds b (yb0, mb0, db0) = toGregorian s (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 (OnDays xs) = fromEnum <$> xs 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 | otherwise = Just $ fromGregorian y m d -expandMDYPat :: Natural -> MDYPat -> EitherErr [Natural] -expandMDYPat _ (Single x) = Right [x] -expandMDYPat _ (Multi xs) = Right xs -expandMDYPat lim (Repeat RepeatPat {rpStart = s, rpBy = b, rpRepeats = r}) +expandMDYPat :: Natural -> Natural -> MDYPat -> EitherErr [Natural] +expandMDYPat lower upper (Single x) = Right [x | lower <= x && x <= upper] +expandMDYPat lower upper (Multi xs) = Right $ dropWhile (<= lower) $ takeWhile (<= upper) xs +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 | otherwise = do k <- limit r - return $ takeWhile (<= k) [s + i * b | i <- [0 ..]] + return $ dropWhile (<= lower) $ takeWhile (<= k) [s + i * b | i <- [0 ..]] where - limit Nothing = Right lim + limit Nothing = Right upper limit (Just n) -- this guard not only produces the error for the user but also protects -- from an underflow below it | 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 (ModifiedJulianDay d) = mod (fromIntegral d + 2) 7