aws-eventbridge-cron (empty) → 0.1.0.0

raw patch · 24 files changed

+2918/−0 lines, 24 filesdep +QuickCheckdep +aws-eventbridge-crondep +base

Dependencies added: QuickCheck, aws-eventbridge-cron, base, containers, megaparsec, tasty, tasty-hunit, tasty-quickcheck, text, time

Files

• CHANGELOG.md +14/−0
• LICENSE +29/−0
• README.md +107/−0
• aws-eventbridge-cron.cabal +95/−0
• src/AWS/EventBridge/Cron.hs +193/−0
• src/AWS/EventBridge/DayOfMonth.hs +160/−0
• src/AWS/EventBridge/DayOfWeek.hs +144/−0
• src/AWS/EventBridge/Hours.hs +88/−0
• src/AWS/EventBridge/Minutes.hs +88/−0
• src/AWS/EventBridge/Months.hs +104/−0
• src/AWS/EventBridge/OneTime.hs +47/−0
• src/AWS/EventBridge/Rate.hs +69/−0
• src/AWS/EventBridge/Years.hs +88/−0
• test/AWS/EventBridge/CronSpec.hs +262/−0
• test/AWS/EventBridge/DayOfMonthSpec.hs +198/−0
• test/AWS/EventBridge/DayOfWeekSpec.hs +260/−0
• test/AWS/EventBridge/HoursSpec.hs +145/−0
• test/AWS/EventBridge/MinutesSpec.hs +145/−0
• test/AWS/EventBridge/MonthsSpec.hs +230/−0
• test/AWS/EventBridge/OneTimeSpec.hs +78/−0
• test/AWS/EventBridge/RateSpec.hs +112/−0
• test/AWS/EventBridge/YearsSpec.hs +191/−0
• test/Main.hs +27/−0
• test/TestSupport.hs +44/−0

@@ -0,0 +1,14 @@+# Changelog++All notable changes to this project will be documented in this file.++The format is based on Keep a Changelog and this project adheres to+Semantic Versioning.++## [0.1.0.0] - 2025-11-16+### Added+- Initial `AWS.EventBridge.Cron` module for parsing and scheduling AWS Scheduler cron expressions.+- Support for `rate(...)` and `at(...)` expressions with validation, evaluation, and round-trip tests.+- Property-based and unit tests across all cron fields plus helper utilities.+- Project metadata, README, LICENSE, and Haddock documentation suitable for Hackage distribution.+- GitHub Actions workflows for CI and release automation, including Hackage candidate/publish steps.

@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2025, Kushagra Gupta+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,107 @@+# aws-eventbridge-cron++Parse AWS EventBridge cron, rate, and one-time expressions and compute their+future run times.++Status: early preview. Expect small API tweaks before a `1.0.0` release.++## Features++- Single entry point: `AWS.EventBridge.Cron` exports the `CronExprT` type,+  `parseCronText` parser, and `nextRunTimes` scheduler.+- Full support for EventBridge-specific syntax such as `?` wildcards, `L`, `LW`,+  weekday ranges, and nth-weekday modifiers (`2#1`).+- `rate(...)` and `at(...)` expressions share the same API, so callers do not+  need to branch on expression variants.+- Extensive property-based test suite that mirrors the behaviour documented by+  AWS.++## Installation++```+cabal install aws-eventbridge-cron+```++Or add the package to your component:++```cabal+build-depends:+    aws-eventbridge-cron >= 0.1 && < 0.2+```++## Quick Start++```haskell+import AWS.EventBridge.Cron+import Data.Time (UTCTime(..), fromGregorian)+import Data.Time.LocalTime (TimeOfDay(..), timeOfDayToTime)++base :: UTCTime+base = UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 0 0))++example :: Either String [UTCTime]+example = do+  expr <- parseCronText "cron(0/15 9 ? NOV SUN 2025)"+  nextRunTimes expr base 4+-- Right [2025-11-16 09:00:00 UTC, 2025-11-16 09:15:00 UTC, ...]+```++The parser also accepts `rate(...)` and `at(...)` expressions:++```haskell+rateExample :: Either String [UTCTime]+rateExample = do+  expr <- parseCronText "rate(10 minutes)"+  nextRunTimes expr base 3++atExample :: Either String [UTCTime]+atExample = do+  expr <- parseCronText "at(2025-11-16T09:30:00)"+  nextRunTimes expr base 5+```++### Error Reporting++Parser and evaluator failures return `Left String` with human-readable error+messages:++```haskell+Left "day-of-month and day-of-week fields must use '?' in exactly one position"+```++The messages mirror the constraints enforced by EventBridge when you create+scheduled rules.++## Design Notes++- `CronExprT` is intentionally opaque. Construct values with `parseCronText` and+  feed them into `nextRunTimes`.+- Scheduling honours the EventBridge rule that exactly one of day-of-month or+  day-of-week must be `?`.+- Results are monotonic, capped at the requested limit, and never fall before+  the supplied base time.++See `test/AWS/EventBridge/CronSpec.hs` for more examples and edge cases.++## Development++```bash+cabal build+cabal test+cabal haddock --open+```++## Contributing++Bug reports, suggestions, and pull requests are welcome. Please open an issue+before large-scale changes so we can keep the API coherent.++## License++Released under the BSD-3-Clause license. See `LICENSE` for details.++## References++- [AWS EventBridge cron expression documentation][aws-docs]++[aws-docs]: https://docs.aws.amazon.com/scheduler/latest/UserGuide/schedule-types.html#cron-based

@@ -0,0 +1,95 @@+cabal-version:      3.0++name:               aws-eventbridge-cron+version:            0.1.0.0+synopsis:           AWS EventBridge cron, rate, and one-time parser with scheduler+description:+  Parse AWS EventBridge cron, rate, and one-time expressions and compute+  the next run times from a base timestamp. The package validates AWS-specific+  extensions such as "?" day wildcards, nth weekdays (#), and last-weekday (L,+  LW) modifiers so you can rely on the same behaviour as AWS Scheduler cron+  schedules.+  .+  The README includes usage examples and notes on the guarantees provided by+  the evaluator.+category:           AWS, Cloud, Scheduling+homepage:           https://github.com/kushagarr/aws-eventbridge-cron#readme+bug-reports:        https://github.com/kushagarr/aws-eventbridge-cron/issues+author:             Kushagra Gupta+maintainer:         Kushagra Gupta <khushiitrans@gmail.com>+license:            BSD-3-Clause+license-file:       LICENSE+build-type:         Simple+tested-with:        GHC == 9.6.* || == 9.8.* || == 9.10.* || == 9.12.*++extra-doc-files:+  README.md+  CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/kushagarr/aws-eventbridge-cron++library+  exposed-modules:+      AWS.EventBridge.Cron+  other-modules:+      AWS.EventBridge.DayOfMonth+    , AWS.EventBridge.DayOfWeek+    , AWS.EventBridge.Hours+    , AWS.EventBridge.Minutes+    , AWS.EventBridge.Months+    , AWS.EventBridge.Years+    , AWS.EventBridge.Rate+    , AWS.EventBridge.OneTime+  hs-source-dirs:+      src+  default-language: GHC2021+  ghc-options:+      -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+  build-depends:+      base >=4.14 && <5+    , containers+    , megaparsec+    , text+    , time++test-suite aws-eventbridge-cron-test+  type: exitcode-stdio-1.0+  hs-source-dirs:+      test+    , src+  main-is: Main.hs+  other-modules:+      AWS.EventBridge.DayOfMonthSpec+    , AWS.EventBridge.DayOfWeekSpec+    , AWS.EventBridge.HoursSpec+    , AWS.EventBridge.MinutesSpec+    , AWS.EventBridge.MonthsSpec+    , AWS.EventBridge.YearsSpec+    , AWS.EventBridge.RateSpec+    , AWS.EventBridge.CronSpec+    , AWS.EventBridge.OneTimeSpec+    , TestSupport+    , AWS.EventBridge.Cron+    , AWS.EventBridge.DayOfMonth+    , AWS.EventBridge.DayOfWeek+    , AWS.EventBridge.Hours+    , AWS.EventBridge.Minutes+    , AWS.EventBridge.Months+    , AWS.EventBridge.Years+    , AWS.EventBridge.Rate+    , AWS.EventBridge.OneTime+  default-language: GHC2021+  ghc-options: -Wall+  build-depends:+      aws-eventbridge-cron+    , base >=4.14 && <5+    , containers+    , megaparsec+    , QuickCheck >=2.14 && <2.16+    , tasty >=1.4 && <1.6+    , tasty-hunit >=0.10 && <0.11+    , tasty-quickcheck >=0.10 && <0.11+    , text+    , time

@@ -0,0 +1,193 @@+{-# LANGUAGE OverloadedStrings  #-}++-- | Parse AWS EventBridge scheduling expressions and evaluate their upcoming run times.+--+-- The entrypoints exposed here mirror the behaviour of EventBridge rules, including+-- support for cron, rate, and one-time ("at") expressions.+module AWS.EventBridge.Cron+  ( CronExprT+  , parseCronText+  , nextRunTimes+  ) where+import AWS.EventBridge.Minutes ( MinutesExprT, parseMinutesText, evaluateMinuteT )+import AWS.EventBridge.Hours ( HoursExprT, parseHoursText, evaluateHourT )+import AWS.EventBridge.DayOfMonth ( DayOfMonthExprT(..), parseDayOfMonthText, evaluateDayOfMonthT )+import AWS.EventBridge.Months ( MonthsExprT, parseMonthsText, evaluateMonthT )+import AWS.EventBridge.DayOfWeek ( DayOfWeekExprT(..), parseDayOfWeekText, evaluateDayOfWeekT )+import AWS.EventBridge.Years ( YearsExprT, parseYearsText, evaluateYearT )+import AWS.EventBridge.Rate ( RateExprT, parseRate, evaluateRateT )+import AWS.EventBridge.OneTime ( OneTimeExprT (..), parseOneTime, evaluateOneTimeT )+import Text.Megaparsec ( Parsec, try, (<|>), parse, errorBundlePretty, takeWhileP )+import Data.Text (Text)+import Data.Void (Void)+import Text.Megaparsec.Char+import qualified Data.Text as T+import Data.Time (UTCTime(..), Day, addUTCTime, utctDay)+import Data.Time.Calendar (fromGregorian, toGregorian)+import Data.Time.LocalTime (TimeOfDay(..), timeOfDayToTime)+++-- | EventBridge scheduling expression.+--+-- Constructors mirror the three families of EventBridge schedules. The structure is+-- exposed to allow pattern matching by advanced users, but most callers should rely on+-- the parser and evaluator helpers provided by this module.+data CronExprT+  = CronExpr+      { minutes    :: MinutesExprT+      , hours      :: HoursExprT+      , dayOfMonth :: DayOfMonthExprT+      , month      :: MonthsExprT+      , dayOfWeek  :: DayOfWeekExprT+      , year       :: YearsExprT+      }+  | RateExpr RateExprT+  | OneTimeExpr OneTimeExprT+  deriving (Eq, Show)++type Parser = Parsec Void Text++-- | Parse an EventBridge scheduling expression.+--+-- Accepts cron, rate, and one-time ("at") expressions. Returns human-readable error+-- messages that match the validations enforced by AWS.+parseCronText :: Text -> Either String CronExprT+parseCronText input =+  case parse parseCron "cron" (T.strip input) of+    Left err  -> Left (errorBundlePretty err)+    Right val -> Right val++parseCron :: Parser CronExprT+parseCron = try parseRateExpr <|> try parseOneTimeExpr <|> parseCronExpr++parseRateExpr :: Parser CronExprT+parseRateExpr = RateExpr <$> parseRate++parseOneTimeExpr :: Parser CronExprT+parseOneTimeExpr = OneTimeExpr <$> parseOneTime++parseCronExpr :: Parser CronExprT+parseCronExpr = do+    _ <- string "cron("+    body <- takeWhileP (Just "cron body") (/= ')')+    _ <- char ')'+    case T.words (T.strip body) of+      [minutesText, hoursText, domText, monthText, dowText, yearText] -> do+        minExpr <- liftEither (parseMinutesText minutesText)+        hourExpr <- liftEither (parseHoursText hoursText)+        domExpr <- liftEither (parseDayOfMonthText domText)+        monthExpr <- liftEither (parseMonthsText monthText)+        dowExpr <- liftEither (parseDayOfWeekText dowText)+        yearExpr <- liftEither (parseYearsText yearText)+        pure (CronExpr minExpr hourExpr domExpr monthExpr dowExpr yearExpr)+      _ -> fail "cron expression must contain six space-delimited fields"+  where+    liftEither :: Either String a -> Parser a+    liftEither = either fail pure++++-- | Evaluate future run times for the supplied expression.+--+-- The list always includes occurrences at or after the base time, limited to the+-- requested count. Errors bubble up if the expression cannot produce valid timestamps+-- (for example conflicting day-of-month/day-of-week fields).+nextRunTimes :: CronExprT -> UTCTime -> Int -> Either String [UTCTime]+nextRunTimes expr base limit =+  case expr of+    RateExpr r -> futureRateTimes r base limit+    OneTimeExpr o  -> futureOneTime o base limit+    CronExpr m h dom mon dow yr -> futureCronTimes m h dom mon dow yr base limit+++futureOneTime :: OneTimeExprT -> UTCTime -> Int -> Either String [UTCTime]+futureOneTime expr base limit+  | t >= base && limit > 0 = Right [t]+  | otherwise              = Right []+  where+    t = evaluateOneTimeT expr+++futureRateTimes :: RateExprT -> UTCTime -> Int -> Either String [UTCTime]+futureRateTimes expr base limit = case evaluateRateT expr of+  Left err -> Left err+  Right delta -> Right $ take limit $ iterate (addUTCTime delta) base++futureCronTimes :: MinutesExprT -> HoursExprT -> DayOfMonthExprT -> MonthsExprT -> DayOfWeekExprT -> YearsExprT -> UTCTime -> Int -> Either String [UTCTime]+futureCronTimes minExpr hourExpr domExpr monExpr dowExpr yrExpr base limit+  | domIsQuestion == dowIsQuestion = Left "day-of-month and day-of-week fields must use '?' in exactly one position"+  | otherwise = do+      minutes <- evaluateMinuteT minExpr+      hours <- evaluateHourT hourExpr+      yearCandidates <- fmap (map fromIntegral) (evaluateYearT yrExpr)+      monthCandidates <- evaluateMonthT monExpr+      let target = max 0 limit+          baseDay = utctDay base+          (baseYear, baseMonth, baseDom) = toGregorian baseDay++          collectYears :: [UTCTime] -> Int -> [Integer] -> Either String ([UTCTime], Int)+          collectYears acc count [] = Right (acc, count)+          collectYears acc count _ | count >= target = Right (acc, count)+          collectYears acc count (y:ys)+            | y < baseYear = collectYears acc count ys+            | otherwise = do+                (acc', count') <- collectMonths acc count y monthCandidates+                collectYears acc' count' ys++          collectMonths :: [UTCTime] -> Int -> Integer -> [Int] -> Either String ([UTCTime], Int)+          collectMonths acc count _ [] = Right (acc, count)+          collectMonths acc count _ _ | count >= target = Right (acc, count)+          collectMonths acc count year (m:ms)+            | year == baseYear && m < baseMonth = collectMonths acc count year ms+            | otherwise = do+                days <- daysFor year m+                (acc', count') <- collectDays acc count year m days+                collectMonths acc' count' year ms++          collectDays :: [UTCTime] -> Int -> Integer -> Int -> [Int] -> Either String ([UTCTime], Int)+          collectDays acc count _ _ [] = Right (acc, count)+          collectDays acc count _ _ _ | count >= target = Right (acc, count)+          collectDays acc count year month (d:ds)+            | year == baseYear && month == baseMonth && d < baseDom = collectDays acc count year month ds+            | otherwise =+                let dayDate = fromGregorian year month d+                    remaining = target - count+                    dayTimes = buildDayTimes dayDate+                    filteredTimes = case compare dayDate baseDay of+                      LT -> []+                      EQ -> dropWhile (< base) dayTimes+                      GT -> dayTimes+                    selected = take remaining filteredTimes+                    acc' = acc ++ selected+                    count' = count + length selected+                 in if count' >= target+                      then Right (acc', count')+                      else collectDays acc' count' year month ds++          buildDayTimes :: Day -> [UTCTime]+          buildDayTimes dayDate =+            [ UTCTime dayDate (timeOfDayToTime (TimeOfDay hour minute 0))+            | hour <- hours+            , minute <- minutes+            ]++          daysFor :: Integer -> Int -> Either String [Int]+          daysFor year month = do+            domDays <- evaluateDayOfMonthT year month domExpr+            dowDays <- evaluateDayOfWeekT year month dowExpr+            pure $ if domIsQuestion then dowDays else domDays++      (results, _) <- collectYears [] 0 yearCandidates+      pure results+  where+    domIsQuestion = isDomQuestion domExpr+    dowIsQuestion = isDowQuestion dowExpr+++isDomQuestion :: DayOfMonthExprT -> Bool+isDomQuestion DomAny = True+isDomQuestion _ = False++isDowQuestion :: DayOfWeekExprT -> Bool+isDowQuestion DowAny = True+isDowQuestion _ = False

@@ -0,0 +1,160 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.DayOfMonth where++import Control.Monad (unless)+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Calendar (Day, fromGregorian, gregorianMonthLength)+import Data.Time.Calendar.WeekDate (toWeekDate)+import Data.Void (Void)+import Text.Megaparsec+import Text.Megaparsec.Char+import Text.Megaparsec.Char.Lexer++type Parser = Parsec Void Text++data DayOfMonthExprT+  = DomAny+  | DomAll+  | DomAt Int+  | DomRange Int Int+  | DomStep Int Int+  | DomUnion DayOfMonthExprT DayOfMonthExprT+  | DomLast+  | DomLastOffset Int+  | DomClosestWeekday Int+  | DomLastWeekday+  deriving (Eq, Show)++isValidDay :: Int -> Bool+isValidDay d = 1 <= d && d <= 31++evaluateDayOfMonthT :: Integer -> Int -> DayOfMonthExprT -> Either String [Int]+evaluateDayOfMonthT y m expr = fmap (S.toAscList . S.fromList . limit) (go expr)+  where+    dim = gregorianMonthLength y m+    limit = filter (\d -> d >= 1 && d <= dim)+    go DomAny = Right []+    go DomAll = Right [1 .. dim]+    go (DomAt d)+      | isValidDay d = Right [d]+      | otherwise    = Left ("invalid day: " ++ show d ++ " (expected 1..31)")+    go (DomRange a b)+      | not (isValidDay a) = Left ("invalid range start: " ++ show a ++ " (expected 1..31)")+      | not (isValidDay b) = Left ("invalid range end: " ++ show b ++ " (expected 1..31)")+      | a <= b             = Right [a .. b]+      | otherwise          = Left ("invalid range: start " ++ show a ++ " > end " ++ show b)+    go (DomStep s k)+      | not (isValidDay s) = Left ("invalid step start: " ++ show s ++ " (expected 1..31)")+      | k >= 1             = Right (takeWhile (<= 31) [s, s + k ..])+      | otherwise          = Left ("invalid step: " ++ show k ++ " (expected >= 1)")+    go (DomUnion a b) = (++) <$> go a <*> go b+    go DomLast = Right [dim]+    go (DomLastOffset off)+      | off < 1   = Left ("invalid L-n offset: " ++ show off ++ " (expected >= 1)")+      | off >= dim =+          Left ("invalid L-n offset: " ++ show off ++ " (expected < " ++ show dim ++ ")")+      | otherwise = Right [dim - off]+    go (DomClosestWeekday d)+      | isValidDay d = Right (maybe [] pure (closestWeekday y m d))+      | otherwise    = Left ("invalid nW day: " ++ show d ++ " (expected 1..31)")+    go DomLastWeekday = Right [lastWeekday y m]++parseDayOfMonth :: Parser DayOfMonthExprT+parseDayOfMonth = do+  terms <- domTerm `sepBy1` char ','+  eof+  case terms of+    [only] -> pure only+    xs -> do+      unless (all isNumeric xs) $ fail "comma-separated day expressions must be numeric"+      pure (foldUnion xs)++parseDayOfMonthText :: Text -> Either String DayOfMonthExprT+parseDayOfMonthText input =+  case parse parseDayOfMonth "day-of-month" (T.strip input) of+    Left err -> Left (errorBundlePretty err)+    Right expr -> Right expr++domTerm :: Parser DayOfMonthExprT+domTerm = choice+  [ DomAny <$ char '?'+  , try parseSpecialTerm+  , try parseStepTerm+  , try parseRangeTerm+  , try (DomAt <$> decimal)+  , DomAll <$ char '*'+  ]++parseRangeTerm :: Parser DayOfMonthExprT+parseRangeTerm = do+  start <- decimal+  _ <- char '-'+  DomRange start <$> decimal++parseStepTerm :: Parser DayOfMonthExprT+parseStepTerm = do+  start <- decimal+  _ <- char '/'+  DomStep start <$> decimal++parseSpecialTerm :: Parser DayOfMonthExprT+parseSpecialTerm = choice+  [ try (string "LW" >> pure DomLastWeekday)+  , try (do+        _ <- char 'L'+        _ <- char '-'+        DomLastOffset <$> decimal)+  , char 'L' >> pure DomLast+  , try (do+        d <- decimal+        _ <- char 'W'+        pure (DomClosestWeekday d))+  ]++isNumeric :: DayOfMonthExprT -> Bool+isNumeric DomAll         = True+isNumeric (DomAt _)      = True+isNumeric (DomRange _ _) = True+isNumeric (DomStep _ _)  = True+isNumeric _              = False++foldUnion :: [DayOfMonthExprT] -> DayOfMonthExprT+foldUnion (x:xs) = go x xs+  where+    go acc []       = acc+    go acc (y : ys) = go (DomUnion acc y) ys+foldUnion [] = DomAny++weekday :: Day -> Int+weekday dayValue = let (_, _, w) = toWeekDate dayValue in w++mkDay :: Integer -> Int -> Int -> Day+mkDay = fromGregorian++closestWeekday :: Integer -> Int -> Int -> Maybe Int+closestWeekday y m d =+  let dim = gregorianMonthLength y m+  in if d < 1 || d > dim+        then Nothing+        else+          case weekday (mkDay y m d) of+            1 -> Just d+            2 -> Just d+            3 -> Just d+            4 -> Just d+            5 -> Just d+            6 -> if d > 1 then Just (d - 1) else Just (d + 2)+            7 -> if d < dim then Just (d + 1) else Just (d - 2)+            _ -> Just d++lastWeekday :: Integer -> Int -> Int+lastWeekday y m =+  let dim = gregorianMonthLength y m+      w = weekday (mkDay y m dim)+  in case w of+      6 -> dim - 1+      7 -> dim - 2+      _ -> dim

@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.DayOfWeek where++import Control.Applicative ((<|>), some)+import Control.Monad (when)+import qualified Data.Map.Strict as M+import qualified Data.Set as S+import Data.Char (toUpper)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Calendar (fromGregorian, gregorianMonthLength)+import Data.Time.Calendar.WeekDate (toWeekDate)+import Data.Void (Void)+import Text.Megaparsec (Parsec, choice, eof, errorBundlePretty, parse, sepBy1, try)+import Text.Megaparsec.Char (char, letterChar)+import Text.Megaparsec.Char.Lexer (decimal)++type Parser = Parsec Void Text++data DayOfWeekExprT+  = DowAny+  | DowAll+  | DowAt Int+  | DowRange Int Int+  | DowNth Int Int+  | DowUnion DayOfWeekExprT DayOfWeekExprT+  deriving (Eq, Show)++isValidDayOfWeek :: Int -> Bool+isValidDayOfWeek d = 1 <= d && d <= 7++evaluateDayOfWeekT :: Integer -> Int -> DayOfWeekExprT -> Either String [Int]+evaluateDayOfWeekT year month expr = fmap S.toAscList (S.fromList <$> go expr)+  where+    dim = gregorianMonthLength year month+    go DowAny = Right []+    go DowAll = Right [1 .. dim]+    go (DowAt day)+      | isValidDayOfWeek day = Right (matchingDays day)+      | otherwise = Left ("invalid day-of-week: " ++ show day ++ " (expected 1..7 or SUN-SAT)")+    go (DowRange start end)+      | not (isValidDayOfWeek start) = Left ("invalid range start: " ++ show start ++ " (expected 1..7)")+      | not (isValidDayOfWeek end) = Left ("invalid range end: " ++ show end ++ " (expected 1..7)")+      | start <= end = Right (concatMap matchingDays [start .. end])+      | otherwise = Left ("invalid range: start " ++ show start ++ " > end " ++ show end)+    go (DowNth day nth)+      | not (isValidDayOfWeek day) = Left ("invalid day-of-week: " ++ show day ++ " (expected 1..7 or SUN-SAT)")+      | nth < 1 || nth > 5 = Left ("invalid # occurrence: " ++ show nth ++ " (expected 1..5)")+      | otherwise =+          let occurrences = matchingDays day+          in case drop (nth - 1) occurrences of+               (d : _) -> Right [d]+               [] -> Right []+    go (DowUnion a b) = (++) <$> go a <*> go b++    -- | Enumerate the day-of-month values that fall on the requested weekday.+    -- Example: in April 2025 (month=4) Mondays (target=2) occur on+    -- days [7,14,21,28].+    matchingDays target =+      [ dayOfMonth+      | dayOfMonth <- [1 .. dim]+      , awsDayOfWeek year month dayOfMonth == target+      ]++parseDayOfWeek :: Parser DayOfWeekExprT+parseDayOfWeek = do+  terms <- dowTerm `sepBy1` char ','+  eof+  when (any isAny terms && length terms > 1) $+    fail "? cannot be combined with other day-of-week terms"+  when (any isNth terms && length terms > 1) $+    fail "# expressions cannot be combined with other day-of-week terms"+  pure (foldUnion terms)++parseDayOfWeekText :: Text -> Either String DayOfWeekExprT+parseDayOfWeekText input =+  case parse parseDayOfWeek "day-of-week" (T.strip input) of+    Left err -> Left (errorBundlePretty err)+    Right expr -> Right expr++dowTerm :: Parser DayOfWeekExprT+dowTerm = choice+  [ DowAny <$ char '?'+  , DowAll <$ char '*'+  , try parseNthTerm+  , try parseRangeTerm+  , DowAt <$> dowValue+  ]++parseRangeTerm :: Parser DayOfWeekExprT+parseRangeTerm = do+  start <- dowValue+  _ <- char '-'+  DowRange start <$> dowValue++parseNthTerm :: Parser DayOfWeekExprT+parseNthTerm = do+  day <- dowValue+  _ <- char '#'+  DowNth day <$> decimal++dowValue :: Parser Int+dowValue = try named <|> decimal+  where+    named = do+      txt <- someLetters+      case M.lookup (T.pack txt) dayOfWeekNames of+        Just value -> pure value+        Nothing -> fail ("unknown day-of-week name: " ++ txt)++-- | Parse one or more alphabetic characters and normalise to uppercase.+-- Example: parsing "tHu" yields "THU" which matches tokens like THU/THUR.+someLetters :: Parser String+someLetters = fmap (map toUpper) (some letterChar)++dayOfWeekNames :: M.Map Text Int+dayOfWeekNames = M.fromList+  [ ("SUN", 1), ("MON", 2), ("TUE", 3), ("TUES", 3)+  , ("WED", 4), ("THU", 5), ("THUR", 5), ("THURS", 5)+  , ("FRI", 6), ("SAT", 7)+  ]++foldUnion :: [DayOfWeekExprT] -> DayOfWeekExprT+-- | Combine a non-empty list of terms into a left-associated union.+-- Example: [DowAt 1, DowRange 2 3, DowNth 5 1] becomes+-- DowUnion (DowUnion (DowAt 1) (DowRange 2 3)) (DowNth 5 1).+foldUnion [] = DowAny+foldUnion (x : xs) = foldl DowUnion x xs++isAny :: DayOfWeekExprT -> Bool+isAny DowAny = True+isAny _ = False++isNth :: DayOfWeekExprT -> Bool+isNth (DowNth _ _) = True+isNth _ = False++-- | Convert a calendar date into the AWS EventBridge weekday index.+-- Example: 2025-04-07 (a Monday) yields 2; 2025-04-13 (a Sunday) yields 1.+awsDayOfWeek :: Integer -> Int -> Int -> Int+awsDayOfWeek year month dayOfMonth =+  let (_, _, iso) = toWeekDate (fromGregorian year month dayOfMonth)+  in (iso `mod` 7) + 1

@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.Hours where++import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import Text.Megaparsec+import Text.Megaparsec.Char+import Text.Megaparsec.Char.Lexer+import Data.Void++type Parser = Parsec Void Text++data HoursExprT+  = AllHours+  | AtHour Int+  | RangeHour Int Int+  | StepHour Int Int+  | UnionHour HoursExprT HoursExprT+  deriving (Eq, Show)++isValidHour :: Int -> Bool+isValidHour h = 0 <= h && h <= 23++evaluateHourT :: HoursExprT -> Either String [Int]+evaluateHourT hExpr = fmap S.toAscList (go hExpr >>= ensureBounds . S.fromList)+  where+    ensureBounds xs =+      if all isValidHour xs+        then Right xs+        else Left "hour out of bounds: expected 0..23"+    go AllHours = Right [0..23]+    go (AtHour h)+      | isValidHour h = Right [h]+      | otherwise     = Left ("invalid hour: " ++ show h ++ " (expected 0..23)")+    go (RangeHour a b)+      | isValidHour a && isValidHour b && a <= b = Right [a..b]+      | not (isValidHour a) = Left ("invalid range start: " ++ show a ++ " (expected 0..23)")+      | not (isValidHour b) = Left ("invalid range end: " ++ show b ++ " (expected 0..23)")+      | otherwise             = Left ("invalid range: start " ++ show a ++ " > end " ++ show b)+    go (StepHour m s)+      | not (isValidHour m) = Left ("invalid step start: " ++ show m ++ " (expected 0..23)")+      | s >= 1               = Right (takeWhile (<= 23) [m, m + s ..])+      | otherwise            = Left ("invalid step: " ++ show s ++ " (expected >= 1)")+    go (UnionHour a b) = (++) <$> go a <*> go b+++parseHours :: Parser HoursExprT+parseHours = choice+  [ try parseUnionHour+  , try parseStepHour+  , try parseRangeHour+  , try parseAtHour+  , parseAllHour+  ]++parseAllHour :: Parser HoursExprT+parseAllHour = char '*' >> pure  AllHours++parseAtHour :: Parser HoursExprT+parseAtHour = AtHour <$> decimal++parseRangeHour :: Parser HoursExprT+parseRangeHour = do+  start <- decimal+  _ <- char '-'+  RangeHour start <$> decimal++parseStepHour :: Parser HoursExprT+parseStepHour = do+  start <- decimal+  _ <- char '/'+  StepHour start <$> decimal++parseUnionHour :: Parser HoursExprT+parseUnionHour = do+  s <- choice [try parseStepHour, try parseRangeHour, try parseAtHour, parseAllHour]+  _ <- char ','+  e <- choice [try parseUnionHour, try parseStepHour, try parseRangeHour, try parseAtHour, parseAllHour]+  eof+  pure $ UnionHour s e++parseHoursText :: Text -> Either String HoursExprT+parseHoursText input =+  case parse parseHours "hours" (T.strip input) of+    Left err -> Left (errorBundlePretty err)+    Right expr -> Right expr

@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.Minutes where++import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import Text.Megaparsec+import Text.Megaparsec.Char+import Text.Megaparsec.Char.Lexer+import Data.Void++type Parser = Parsec Void Text++data MinutesExprT+  = AllMinutes+  | AtMinute Int+  | RangeMinute Int Int+  | StepMinute Int Int+  | UnionMinute MinutesExprT MinutesExprT+  deriving (Eq, Show)++isValidMinute :: Int -> Bool+isValidMinute m = 0 <= m && m <= 59++evaluateMinuteT :: MinutesExprT -> Either String [Int]+evaluateMinuteT mExpr = fmap S.toAscList (go mExpr >>= ensureBounds . S.fromList)+  where+    ensureBounds xs =+      if all isValidMinute xs+        then Right xs+        else Left "minute out of bounds: expected 0..59"+    go AllMinutes = Right [0..59]+    go (AtMinute m)+      | isValidMinute m = Right [m]+      | otherwise       = Left ("invalid minute: " ++ show m ++ " (expected 0..59)")+    go (RangeMinute a b)+      | isValidMinute a && isValidMinute b && a <= b = Right [a..b]+      | not (isValidMinute a) = Left ("invalid range start: " ++ show a ++ " (expected 0..59)")+      | not (isValidMinute b) = Left ("invalid range end: " ++ show b ++ " (expected 0..59)")+      | otherwise             = Left ("invalid range: start " ++ show a ++ " > end " ++ show b)+    go (StepMinute m s)+      | not (isValidMinute m) = Left ("invalid step start: " ++ show m ++ " (expected 0..59)")+      | s >= 1                = Right (takeWhile (<= 59) [m, m + s ..])+      | otherwise             = Left ("invalid step: " ++ show s ++ " (expected >= 1)")+    go (UnionMinute a b) = (++) <$> go a <*> go b+++parseMinutes :: Parser MinutesExprT+parseMinutes = choice+  [ try parseUnionMinute+  , try parseStepMinute+  , try parseRangeMinute+  , try parseAtMinute+  , parseAllMinute+  ]++parseAllMinute :: Parser MinutesExprT+parseAllMinute = char '*' >> pure  AllMinutes++parseAtMinute :: Parser MinutesExprT+parseAtMinute = AtMinute <$> decimal++parseRangeMinute :: Parser MinutesExprT+parseRangeMinute = do+  start <- decimal+  _ <- char '-'+  RangeMinute start <$> decimal++parseStepMinute :: Parser MinutesExprT+parseStepMinute = do+  start <- decimal+  _ <- char '/'+  StepMinute start <$> decimal++parseUnionMinute :: Parser MinutesExprT+parseUnionMinute = do+  s <- choice [try parseStepMinute, try parseRangeMinute, try parseAtMinute, parseAllMinute]+  _ <- char ','+  e <- choice [try parseUnionMinute, try parseStepMinute, try parseRangeMinute, try parseAtMinute, parseAllMinute]+  eof+  pure $ UnionMinute s e++parseMinutesText :: Text -> Either String MinutesExprT+parseMinutesText input =+  case parse parseMinutes "minutes" (T.strip input) of+    Left err -> Left (errorBundlePretty err)+    Right expr -> Right expr

@@ -0,0 +1,104 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.Months where++import qualified Data.Map.Strict as M+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import Text.Megaparsec+import Text.Megaparsec.Char+import Text.Megaparsec.Char.Lexer+import Data.Void++type Parser = Parsec Void Text++data MonthsExprT+  = AllMonths+  | AtMonth Int+  | RangeMonth Int Int+  | StepMonth Int Int+  | UnionMonth MonthsExprT MonthsExprT+  deriving (Eq, Show)++isValidMonth :: Int -> Bool+isValidMonth m = 1 <= m && m <= 12++evaluateMonthT :: MonthsExprT -> Either String [Int]+evaluateMonthT expr = fmap S.toAscList (go expr >>= ensureBounds . S.fromList)+  where+    ensureBounds xs =+      if all isValidMonth xs+        then Right xs+        else Left "month out of bounds: expected 1..12"+    go AllMonths = Right [1..12]+    go (AtMonth m)+      | isValidMonth m = Right [m]+      | otherwise      = Left ("invalid month: " ++ show m ++ " (expected 1..12)")+    go (RangeMonth a b)+      | isValidMonth a && isValidMonth b && a <= b = Right [a..b]+      | not (isValidMonth a) = Left ("invalid range start: " ++ show a ++ " (expected 1..12)")+      | not (isValidMonth b) = Left ("invalid range end: " ++ show b ++ " (expected 1..12)")+      | otherwise            = Left ("invalid range: start " ++ show a ++ " > end " ++ show b)+    go (StepMonth m step)+      | not (isValidMonth m) = Left ("invalid step start: " ++ show m ++ " (expected 1..12)")+      | step >= 1            = Right (takeWhile (<= 12) [m, m + step ..])+      | otherwise            = Left ("invalid step: " ++ show step ++ " (expected >= 1)")+    go (UnionMonth a b) = (++) <$> go a <*> go b++monthNames :: M.Map Text Int+monthNames = M.fromList+  [ ("JAN", 1), ("FEB", 2), ("MAR", 3), ("APR", 4)+  , ("MAY", 5), ("JUN", 6), ("JUL", 7), ("AUG", 8)+  , ("SEP", 9), ("OCT", 10), ("NOV", 11), ("DEC", 12)+  ]++parseMonths :: Parser MonthsExprT+parseMonths = choice+  [ try parseUnionMonth+  , try parseStepMonth+  , try parseRangeMonth+  , try parseAtMonth+  , parseAllMonth+  ]++parseAllMonth :: Parser MonthsExprT+parseAllMonth = char '*' >> pure AllMonths++parseAtMonth :: Parser MonthsExprT+parseAtMonth = AtMonth <$> monthToken++parseRangeMonth :: Parser MonthsExprT+parseRangeMonth = do+  start <- monthToken+  _ <- char '-'+  RangeMonth start <$> monthToken++parseStepMonth :: Parser MonthsExprT+parseStepMonth = do+  start <- monthToken+  _ <- char '/'+  StepMonth start <$> decimal++parseUnionMonth :: Parser MonthsExprT+parseUnionMonth = do+  s <- choice [try parseStepMonth, try parseRangeMonth, try parseAtMonth, parseAllMonth]+  _ <- char ','+  e <- choice [try parseUnionMonth, try parseStepMonth, try parseRangeMonth, try parseAtMonth, parseAllMonth]+  eof+  pure (UnionMonth s e)++monthToken :: Parser Int+monthToken = try named <|> decimal+  where+    named = do+      txt <- some letterChar+      case M.lookup (T.toUpper (T.pack txt)) monthNames of+        Just n  -> pure n+        Nothing -> fail ("unknown month name: " ++ txt)++parseMonthsText :: Text -> Either String MonthsExprT+parseMonthsText input =+  case parse parseMonths "months" (T.strip input) of+    Left err -> Left (errorBundlePretty err)+    Right expr -> Right expr

@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.OneTime where++import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (UTCTime)+import Data.Time.Format (defaultTimeLocale, parseTimeM)+import Data.Time.LocalTime (LocalTime, localTimeToUTC, utc)+import Data.Void (Void)+import Text.Megaparsec+import Text.Megaparsec.Char (char, space, string)++type Parser = Parsec Void Text++newtype OneTimeExprT+  = OneTime UTCTime+  deriving (Eq, Show)++evaluateOneTimeT :: OneTimeExprT -> UTCTime+evaluateOneTimeT (OneTime t) = t++parseOneTimeText :: Text -> Either String OneTimeExprT+parseOneTimeText input =+  case parse parseOneTime "one-time" (T.strip input) of+    Left err -> Left (errorBundlePretty err)+    Right expr -> Right expr++parseOneTime :: Parser OneTimeExprT+parseOneTime = do+  _ <- string "at("+  _ <- space+  raw <- takeWhile1P (Just "timestamp") (/= ')')+  ts <- case timestampFromText (T.strip raw) of+    Just ts' -> pure ts'+    Nothing -> fail "invalid one-time timestamp"+  _ <- space+  _ <- char ')'+  eof+  pure (OneTime ts)++timestampFromText :: Text -> Maybe UTCTime+timestampFromText = parseLocal+  where+    parseLocal t = do+      local <- parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%S" (T.unpack t) :: Maybe LocalTime+      pure (localTimeToUTC utc local)

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.Rate where+import Text.Megaparsec (Parsec, (<|>), try, parse, errorBundlePretty, optional)+import Data.Void (Void)+import Data.Text (Text)+import qualified Data.Text as T+import Text.Megaparsec.Char+import Text.Megaparsec.Char.Lexer (decimal)+import Data.Time (NominalDiffTime, secondsToNominalDiffTime)++data RateExprT+  = RateMinutes Int+  | RateHours Int+  | RateDays Int+  deriving (Eq, Show)+++type Parser = Parsec Void Text++evaluateRateT :: RateExprT -> Either String NominalDiffTime+evaluateRateT (RateMinutes m)+  | m >= 1 && m <= 31536000  = Right (secondsToNominalDiffTime (fromIntegral (m * 60)))+  | otherwise = Left ("invalid rate minutes: " ++ show m ++ " (expected 1..31536000)")+evaluateRateT (RateHours h)+  | h >= 1 && h <= 8760 = Right (secondsToNominalDiffTime (fromIntegral (h * 3600)))+  | otherwise = Left ("invalid rate hours: " ++ show h ++ " (expected 1..8760)")+evaluateRateT (RateDays d)+  | d >= 1 && d <= 365 = Right (secondsToNominalDiffTime (fromIntegral (d * 86400)))+  | otherwise = Left ("invalid rate days: " ++ show d ++ " (expected 1..365)")++parseRate :: Parser RateExprT+parseRate = try parseRateMinutes <|> try parseRateHours <|> parseRateDays++parseRateText :: Text -> Either String RateExprT+parseRateText input =+  case parse parseRate "rate" (T.strip input) of+    Left err  -> Left (errorBundlePretty err)+    Right val -> Right val++parseRateMinutes :: Parser RateExprT+parseRateMinutes = do+  _ <- string "rate("+  m <- decimal+  _ <- space1+  _ <- string "minute"+  _ <- optional (char 's')+  _ <- char ')'+  return (RateMinutes m)++parseRateHours :: Parser RateExprT+parseRateHours = do+  _ <- string "rate("+  h <- decimal+  _ <- space1+  _ <- string "hour"+  _ <- optional (char 's')+  _ <- char ')'+  return (RateHours h)++parseRateDays :: Parser RateExprT+parseRateDays = do+  _ <- string "rate("+  d <- decimal+  _ <- space1+  _ <- string "day"+  _ <- optional (char 's')+  _ <- char ')'+  return (RateDays d)

@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.Years where++import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import Data.Void (Void)+import Text.Megaparsec (Parsec, choice, eof, errorBundlePretty, parse, try)+import Text.Megaparsec.Char (char)+import Text.Megaparsec.Char.Lexer (decimal)++type Parser = Parsec Void Text++data YearsExprT+  = AllYears+  | AtYear Int+  | RangeYear Int Int+  | StepYear Int Int+  | UnionYear YearsExprT YearsExprT+  deriving (Eq, Show)++-- AWS EventBridge supports calendar years 1970..2199 inclusive.+isValidYear :: Int -> Bool+isValidYear y = 1970 <= y && y <= 2199++evaluateYearT :: YearsExprT -> Either String [Int]+evaluateYearT expr = fmap S.toAscList (go expr >>= ensureBounds . S.fromList)+  where+    ensureBounds xs =+      if all isValidYear xs+        then Right xs+        else Left "year out of bounds: expected 1970..2199"+    go AllYears = Right [1970..2199]+    go (AtYear y)+      | isValidYear y = Right [y]+      | otherwise     = Left ("invalid year: " ++ show y ++ " (expected 1970..2199)")+    go (RangeYear a b)+      | isValidYear a && isValidYear b && a <= b = Right [a..b]+      | not (isValidYear a) = Left ("invalid range start: " ++ show a ++ " (expected 1970..2199)")+      | not (isValidYear b) = Left ("invalid range end: " ++ show b ++ " (expected 1970..2199)")+      | otherwise           = Left ("invalid range: start " ++ show a ++ " > end " ++ show b)+    go (StepYear start step)+      | not (isValidYear start) = Left ("invalid step start: " ++ show start ++ " (expected 1970..2199)")+      | step >= 1 = Right (takeWhile (<= 2199) [start, start + step ..])+      | otherwise = Left ("invalid step: " ++ show step ++ " (expected >= 1)")+    go (UnionYear a b) = (++) <$> go a <*> go b++parseYears :: Parser YearsExprT+parseYears = choice+  [ try parseUnionYear+  , try parseStepYear+  , try parseRangeYear+  , try parseAtYear+  , parseAllYear+  ]++parseAllYear :: Parser YearsExprT+parseAllYear = char '*' >> pure AllYears++parseAtYear :: Parser YearsExprT+parseAtYear = AtYear <$> decimal++parseRangeYear :: Parser YearsExprT+parseRangeYear = do+  start <- decimal+  _ <- char '-'+  RangeYear start <$> decimal++parseStepYear :: Parser YearsExprT+parseStepYear = do+  start <- decimal+  _ <- char '/'+  StepYear start <$> decimal++parseUnionYear :: Parser YearsExprT+parseUnionYear = do+  s <- choice [try parseStepYear, try parseRangeYear, try parseAtYear, parseAllYear]+  _ <- char ','+  e <- choice [try parseUnionYear, try parseStepYear, try parseRangeYear, try parseAtYear, parseAllYear]+  eof+  pure (UnionYear s e)++parseYearsText :: Text -> Either String YearsExprT+parseYearsText input =+  case parse parseYears "years" (T.strip input) of+    Left err -> Left (errorBundlePretty err)+    Right expr -> Right expr

@@ -0,0 +1,262 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.CronSpec (tests) where++import AWS.EventBridge.Cron+import AWS.EventBridge.DayOfMonth (DayOfMonthExprT (..), evaluateDayOfMonthT)+import AWS.EventBridge.DayOfWeek (DayOfWeekExprT (..), evaluateDayOfWeekT)+import Data.Time (UTCTime (..), addUTCTime, secondsToNominalDiffTime)+import Data.Time.Calendar (fromGregorian, toGregorian)+import Data.Time.LocalTime (TimeOfDay (..), timeOfDayToTime)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport (assertLeft, expectParseWith)+import qualified Data.Text as T++tests :: TestTree+tests =+  testGroup "cron"+    [ manualTests+    , propertyTests+    ]++manualTests :: TestTree+manualTests = testGroup "manual"+    [ testCase "parse cron expression" $ do+      _ <- expectParseWith "cron" parseCronText "cron(0 0 ? * 2#1 2025)"+      pure ()+  , testCase "next run times rate" $ do+      let base = UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 0 0))+      rateExpr <- expectParseWith "rate" parseCronText "rate(5 minutes)"+      nextRunTimes rateExpr base 3+        @?= Right+          [ base+          , addMinutes base 5+          , addMinutes base 10+          ]+  , testCase "next run times one-time" $ do+      let base = UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 0 0))+      oneTimeExpr <- expectParseWith "one-time" parseCronText "at(2025-11-16T09:30:00)"+      nextRunTimes oneTimeExpr base 1+        @?= Right [UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 30 0))]+  , testCase "next run times cron" $ do+      let base = UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 0 0))+      cronExpr <- expectParseWith "cron" parseCronText "cron(0/15 9 ? NOV SUN 2025)"+      nextRunTimes cronExpr base 4+        @?= Right+          [ UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 0 0))+          , UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 15 0))+          , UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 30 0))+          , UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 45 0))+          ]+  , testCase "cron day-of-month evaluated when day-of-week '?'" $ do+      let base = UTCTime (fromGregorian 2025 11 1) (timeOfDayToTime (TimeOfDay 8 0 0))+      cronExpr <- expectParseWith "cron" parseCronText "cron(0 9 5 NOV ? 2025)"+      nextRunTimes cronExpr base 2+        @?= Right+          [ UTCTime (fromGregorian 2025 11 5) (timeOfDayToTime (TimeOfDay 9 0 0))+          ]+  , testCase "cron skips intraday times earlier than base" $ do+      let base = UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 7 30))+      cronExpr <- expectParseWith "cron" parseCronText "cron(0/15 9 ? NOV SUN 2025)"+      nextRunTimes cronExpr base 3+        @?= Right+          [ UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 15 0))+          , UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 30 0))+          , UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 45 0))+          ]+  , testCase "cron spans multiple allowed years" $ do+      let base = UTCTime (fromGregorian 2026 12 31) (timeOfDayToTime (TimeOfDay 23 0 0))+      cronExpr <- expectParseWith "cron" parseCronText "cron(0 0 1 JAN ? 2027-2028)"+      nextRunTimes cronExpr base 2+        @?= Right+          [ UTCTime (fromGregorian 2027 1 1) (timeOfDayToTime (TimeOfDay 0 0 0))+          , UTCTime (fromGregorian 2028 1 1) (timeOfDayToTime (TimeOfDay 0 0 0))+          ]+  , testCase "invalid day fields combination" $ do+      cronExpr <- expectParseWith "cron" parseCronText "cron(0 0 1 * 2 2025)"+      nextRunTimes cronExpr (UTCTime (fromGregorian 2025 1 1) 0) 1+        @?= Left "day-of-month and day-of-week fields must use '?' in exactly one position"+  , testCase "invalid rate" $ do+      rateExpr <- expectParseWith "rate" parseCronText "rate(0 minutes)"+      let base = UTCTime (fromGregorian 2025 1 1) 0+      nextRunTimes rateExpr base 1+        @?= Left "invalid rate minutes: 0 (expected 1..31536000)"+  , testCase "invalid one-time" $+      assertLeft (parseCronText "at(2025-13-01T00:00:00)")+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "rate schedule monotonic" propRateMonotonic+  , QC.testProperty "cron returns at most requested" propCronLimit+  , QC.testProperty "cron schedule monotonic and >= base" propCronMonotonic+  , QC.testProperty "cron with '?' dom relies on day-of-week" propCronDomQuestionUsesDow+  , QC.testProperty "cron with '?' dow relies on day-of-month" propCronDowQuestionUsesDom+  ]++propRateMonotonic :: QC.Property+propRateMonotonic =+  QC.forAll (QC.chooseInt (1, 60)) $ \minutes ->+    let base = UTCTime (fromGregorian 2025 1 1) (timeOfDayToTime (TimeOfDay 0 0 0))+     in case parseCronText ("rate(" <> T.pack (show minutes) <> " minutes)") of+          Left err -> QC.counterexample ("rate parse failed: " <> err) False+          Right rateExpr ->+            case nextRunTimes rateExpr base 5 of+              Left err -> QC.counterexample ("schedule failed: " <> err) False+              Right ts -> QC.counterexample (show ts) (sorted ts)+  where+    sorted xs = and (zipWith (<=) xs (drop 1 xs))++propCronLimit :: QC.Property+propCronLimit =+  QC.forAll (QC.chooseInt (1, 5)) $ \limit ->+    let base = UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 0 0))+     in case parseCronText "cron(0/30 9 ? NOV SUN 2025)" of+          Left err -> QC.counterexample ("cron parse failed: " <> err) False+          Right cronExpr ->+            case nextRunTimes cronExpr base limit of+              Left err -> QC.counterexample ("cron evaluation failed: " <> err) False+              Right ts -> QC.counterexample (show ts) (length ts <= limit)++propCronMonotonic :: QC.Property+propCronMonotonic =+  QC.forAll (QC.chooseInt (1, 5)) $ \limit ->+    let base = UTCTime (fromGregorian 2025 11 16) (timeOfDayToTime (TimeOfDay 9 5 0))+     in case parseCronText "cron(0/15 9 ? NOV SUN 2025)" of+          Left err -> QC.counterexample ("cron parse failed: " <> err) False+          Right cronExpr ->+            case nextRunTimes cronExpr base limit of+              Left err -> QC.counterexample ("cron evaluation failed: " <> err) False+              Right ts -> QC.counterexample (show ts) (nonDecreasing ts && all (>= base) ts)+  where+    nonDecreasing xs = and (zipWith (<=) xs (drop 1 xs))++propCronDomQuestionUsesDow :: QC.Property+propCronDomQuestionUsesDow =+  QC.forAll genCronDomQuestionCase $ \(exprText, year, month, dowExpr, base, limit) ->+    case parseCronText exprText of+      Left err -> QC.counterexample ("cron parse failed: " <> err) False+      Right cronExpr ->+        case evaluateDayOfWeekT year month dowExpr of+          Left err -> QC.counterexample ("day-of-week evaluation failed: " <> err) False+          Right allowedDays ->+            case nextRunTimes cronExpr base limit of+              Left err -> QC.counterexample ("cron evaluation failed: " <> err) False+              Right ts ->+                let days = map (thirdOf . toGregorian . utctDay) ts+                    monthsOk = all ((== month) . secondOf . toGregorian . utctDay) ts+                    yearsOk = all ((== year) . firstOf . toGregorian . utctDay) ts+                 in QC.counterexample (show ts)+                      (monthsOk && yearsOk && all (`elem` allowedDays) days)++propCronDowQuestionUsesDom :: QC.Property+propCronDowQuestionUsesDom =+  QC.forAll genCronDowQuestionCase $ \(exprText, year, month, domExpr, base, limit) ->+    case parseCronText exprText of+      Left err -> QC.counterexample ("cron parse failed: " <> err) False+      Right cronExpr ->+        case evaluateDayOfMonthT year month domExpr of+          Left err -> QC.counterexample ("day-of-month evaluation failed: " <> err) False+          Right allowedDays ->+            case nextRunTimes cronExpr base limit of+              Left err -> QC.counterexample ("cron evaluation failed: " <> err) False+              Right ts ->+                let days = map (thirdOf . toGregorian . utctDay) ts+                    monthsOk = all ((== month) . secondOf . toGregorian . utctDay) ts+                    yearsOk = all ((== year) . firstOf . toGregorian . utctDay) ts+                 in QC.counterexample (show ts)+                      (monthsOk && yearsOk && all (`elem` allowedDays) days)++addMinutes :: UTCTime -> Integer -> UTCTime+addMinutes t minutes = addUTCTime (secondsToNominalDiffTime (fromIntegral (minutes * 60))) t++genCronDomQuestionCase :: QC.Gen (T.Text, Integer, Int, DayOfWeekExprT, UTCTime, Int)+genCronDomQuestionCase = do+  minute <- QC.chooseInt (0, 59)+  hour <- QC.chooseInt (0, 23)+  month <- QC.chooseInt (1, 12)+  year <- QC.chooseInt (2025, 2030)+  dowExpr <- genDowExpr+  limit <- QC.chooseInt (1, 5)+  let exprText = renderCron minute hour "?" (T.pack (show month)) (renderDowExpr dowExpr) (T.pack (show year))+      base = UTCTime (fromGregorian (toInteger year) month 1) (timeOfDayToTime (TimeOfDay 0 0 0))+  pure (exprText, toInteger year, month, dowExpr, base, limit)++genCronDowQuestionCase :: QC.Gen (T.Text, Integer, Int, DayOfMonthExprT, UTCTime, Int)+genCronDowQuestionCase = do+  minute <- QC.chooseInt (0, 59)+  hour <- QC.chooseInt (0, 23)+  month <- QC.chooseInt (1, 12)+  year <- QC.chooseInt (2025, 2030)+  domExpr <- genDomExpr+  limit <- QC.chooseInt (1, 5)+  let exprText = renderCron minute hour (renderDomExpr domExpr) (T.pack (show month)) "?" (T.pack (show year))+      base = UTCTime (fromGregorian (toInteger year) month 1) (timeOfDayToTime (TimeOfDay 0 0 0))+  pure (exprText, toInteger year, month, domExpr, base, limit)++genDowExpr :: QC.Gen DayOfWeekExprT+genDowExpr = QC.oneof+  [ DowAt <$> QC.chooseInt (1, 7)+  , do+      start <- QC.chooseInt (1, 7)+      end <- QC.chooseInt (start, 7)+      pure (if start == end then DowAt start else DowRange start end)+  ]++genDomExpr :: QC.Gen DayOfMonthExprT+genDomExpr = QC.oneof+  [ DomAt <$> QC.chooseInt (1, 28)+  , do+      start <- QC.chooseInt (1, 28)+      end <- QC.chooseInt (start, 28)+      pure (if start == end then DomAt start else DomRange start end)+  ]++renderCron :: Int -> Int -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text+renderCron minute hour domPart monthPart dowPart yearPart =+  T.concat+    [ "cron("+    , T.pack (show minute)+    , " "+    , T.pack (show hour)+    , " "+    , domPart+    , " "+    , monthPart+    , " "+    , dowPart+    , " "+    , yearPart+    , ")"+    ]++renderDowExpr :: DayOfWeekExprT -> T.Text+renderDowExpr DowAny = "?"+renderDowExpr DowAll = "*"+renderDowExpr (DowAt d) = T.pack (show d)+renderDowExpr (DowRange a b) = if a == b then T.pack (show a) else T.concat [T.pack (show a), "-", T.pack (show b)]+renderDowExpr (DowNth d n) = T.concat [T.pack (show d), "#", T.pack (show n)]+renderDowExpr (DowUnion a b) = T.concat [renderDowExpr a, ",", renderDowExpr b]++renderDomExpr :: DayOfMonthExprT -> T.Text+renderDomExpr DomAny = "?"+renderDomExpr DomAll = "*"+renderDomExpr (DomAt d) = T.pack (show d)+renderDomExpr (DomRange a b) = if a == b then T.pack (show a) else T.concat [T.pack (show a), "-", T.pack (show b)]+renderDomExpr (DomStep a b) = T.concat [T.pack (show a), "/", T.pack (show b)]+renderDomExpr (DomUnion a b) = T.concat [renderDomExpr a, ",", renderDomExpr b]+renderDomExpr DomLast = "L"+renderDomExpr (DomLastOffset n) = T.concat ["L-", T.pack (show n)]+renderDomExpr (DomClosestWeekday d) = T.concat [T.pack (show d), "W"]+renderDomExpr DomLastWeekday = "LW"++firstOf :: (a, b, c) -> a+firstOf (x, _, _) = x++secondOf :: (a, b, c) -> b+secondOf (_, y, _) = y++thirdOf :: (a, b, c) -> c+thirdOf (_, _, z) = z

@@ -0,0 +1,198 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.DayOfMonthSpec (tests) where++import AWS.EventBridge.DayOfMonth+import Data.Time.Calendar (fromGregorian, gregorianMonthLength)+import Data.Time.Calendar.WeekDate (toWeekDate)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport+  ( assertLeft+  , expectEvalWith+  , expectParseWith+  , strictlyAscending+  , withinBoundsInt+  )++tests :: TestTree+tests =+  testGroup "day-of-month"+    [ unitTests+    , propertyTests+    ]++unitTests :: TestTree+unitTests = testGroup "manual"+  [ testCase "parse L" $ parseDayOfMonthText "L" @?= Right DomLast+  , testCase "parse L-2" $ parseDayOfMonthText "L-2" @?= Right (DomLastOffset 2)+  , testCase "parse 15W" $ parseDayOfMonthText "15W" @?= Right (DomClosestWeekday 15)+    , testCase "parse numeric union" $ do+      expr <- expectParseWith "day-of-month" parseDayOfMonthText "1,5,10-12"+      result <- expectEvalWith "day-of-month" (evaluateDayOfMonthT 2024 2) expr+      result @?= [1,5,10,11,12]+  , testCase "parse ? cannot union" $ assertLeft (parseDayOfMonthText "?,5")+  , testCase "evaluate DomLast" $ do+      let dim = gregorianMonthLength 2025 3+      result <- expectEvalWith "day-of-month" (evaluateDayOfMonthT 2025 3) DomLast+      result @?= [dim]+  , testCase "closestWeekday Saturday at start" $+      closestWeekday 2025 3 1 @?= Just 3+  , testCase "closestWeekday Sunday at end" $+      closestWeekday 2021 1 31 @?= Just 29+  , testCase "lastWeekday handles weekend" $+      lastWeekday 2021 1 @?= 29+  , testCase "DomLastOffset clamps" $ do+      result <- expectEvalWith "day-of-month" (evaluateDayOfMonthT 2024 5) (DomLastOffset 2)+      result @?= [29]+  , testCase "DomLastOffset rejects overshoot" $+      assertLeft (evaluateDayOfMonthT 2024 2 (DomLastOffset 29))+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "closestWeekday stays within bounds and weekdays" propClosestWeekdayWithinBounds+  , QC.testProperty "closestWeekday rejects out-of-range days" propClosestWeekdayRejectsOutOfRange+  , QC.testProperty "lastWeekday produces weekday inside month" propLastWeekdayIsWeekday+  , QC.testProperty "DomLast evaluates to final day" propDomLastMatchesMonthLength+  , QC.testProperty "DomLastOffset yields expected day when within month" propDomLastOffsetWithinMonth+  , QC.testProperty "DomLastOffset rejects offsets >= month length" propDomLastOffsetTooLarge+  , QC.testProperty "Numeric expressions produce in-range ascending days" propNumericExpressionsWithinBounds+  , QC.testProperty "DomAny evaluates to empty set" propDomAnyEmpty+  ]++propClosestWeekdayWithinBounds :: QC.Property+propClosestWeekdayWithinBounds =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll (QC.chooseInt (1, gregorianMonthLength y m)) $ \d ->+      let result = closestWeekday y m d+          dim = gregorianMonthLength y m+      in case result of+          Nothing -> QC.counterexample "expected Just" False+          Just w ->+            let (_, _, dow) = toWeekDate (fromGregorian y m w)+            in QC.counterexample (failureMsg y m d w dow)+                 (w >= 1 && w <= dim && dow >= 1 && dow <= 5 && abs (w - d) <= 2)++propClosestWeekdayRejectsOutOfRange :: QC.Property+propClosestWeekdayRejectsOutOfRange =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll outOfRangeDay $ \d ->+      closestWeekday y m d QC.=== Nothing++propLastWeekdayIsWeekday :: QC.Property+propLastWeekdayIsWeekday =+  QC.forAll genYearMonth $ \(y, m) ->+    let lw = lastWeekday y m+        dim = gregorianMonthLength y m+        (_, _, dow) = toWeekDate (fromGregorian y m lw)+    in QC.counterexample (failureMsg y m dim lw dow)+         (lw >= 1 && lw <= dim && dow >= 1 && dow <= 5)++propDomLastMatchesMonthLength :: QC.Property+propDomLastMatchesMonthLength =+  QC.forAll genYearMonth $ \(y, m) ->+    case evaluateDayOfMonthT y m DomLast of+      Left err -> QC.counterexample err False+      Right xs ->+        let dim = gregorianMonthLength y m+        in QC.counterexample ("expected " <> show [dim] <> ", got " <> show xs)+             (xs == [dim])++propDomLastOffsetWithinMonth :: QC.Property+propDomLastOffsetWithinMonth =+  QC.forAll genDomLastOffsetWithin $ \(y, m, off) ->+    case evaluateDayOfMonthT y m (DomLastOffset off) of+      Left err -> QC.counterexample err False+      Right xs ->+        let dim = gregorianMonthLength y m+            expected = dim - off+        in QC.counterexample ("expected " <> show [expected] <> ", got " <> show xs)+             (xs == [expected])++propDomLastOffsetTooLarge :: QC.Property+propDomLastOffsetTooLarge =+  QC.forAll genDomLastOffsetTooLarge $ \(y, m, off) ->+    case evaluateDayOfMonthT y m (DomLastOffset off) of+      Left _ -> QC.property True+      Right xs ->+        let dim = gregorianMonthLength y m+        in QC.counterexample+             ("unexpected success " <> show xs <> " for month length " <> show dim <> " and offset " <> show off)+             False++propNumericExpressionsWithinBounds :: QC.Property+propNumericExpressionsWithinBounds =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll genNumericExpr $ \expr ->+      case evaluateDayOfMonthT y m expr of+        Left err -> QC.counterexample ("expr=" <> show expr <> ": " <> err) False+        Right xs ->+          let dim = gregorianMonthLength y m+              message = "expr=" <> show expr <> " xs=" <> show xs <> " dim=" <> show dim+          in QC.counterexample message (withinBoundsInt 1 dim xs && strictlyAscending xs)++propDomAnyEmpty :: QC.Property+propDomAnyEmpty =+  QC.forAll genYearMonth $ \(y, m) ->+    case evaluateDayOfMonthT y m DomAny of+      Left err -> QC.counterexample err False+      Right xs -> QC.counterexample ("xs=" <> show xs) (null xs)++genYearMonth :: QC.Gen (Integer, Int)+genYearMonth = do+  year <- QC.chooseInt (1900, 2100)+  month <- QC.chooseInt (1, 12)+  pure (fromIntegral year, month)++outOfRangeDay :: QC.Gen Int+outOfRangeDay = QC.oneof [QC.chooseInt (-5, 0), QC.chooseInt (32, 40)]++genDomLastOffsetWithin :: QC.Gen (Integer, Int, Int)+genDomLastOffsetWithin = do+  (y, m) <- genYearMonth+  let dim = gregorianMonthLength y m+  off <- QC.chooseInt (1, dim - 1)+  pure (y, m, off)++genDomLastOffsetTooLarge :: QC.Gen (Integer, Int, Int)+genDomLastOffsetTooLarge = do+  (y, m) <- genYearMonth+  let dim = gregorianMonthLength y m+  off <- QC.chooseInt (dim, dim + 10)+  pure (y, m, off)++genNumericExpr :: QC.Gen DayOfMonthExprT+genNumericExpr = QC.sized go+  where+    go n+      | n <= 1 = QC.oneof base+      | otherwise = QC.frequency+          [ (3, QC.oneof base)+          , (2, genRange)+          , (2, genStep)+          , (2, genUnion (n - 1))+          ]+    base =+      [ pure DomAll+      , DomAt <$> QC.chooseInt (1, 31)+      ]+    genRange = do+      start <- QC.chooseInt (1, 31)+      end <- QC.chooseInt (start, 31)+      pure (DomRange start end)+    genStep = do+      start <- QC.chooseInt (1, 31)+      step <- QC.chooseInt (1, 10)+      pure (DomStep start step)+    genUnion depth = do+      let sub = max 0 depth+      left <- go sub+      right <- go sub+      pure (DomUnion left right)++failureMsg :: Integer -> Int -> Int -> Int -> Int -> String+failureMsg y m d w dow =+  "y=" <> show y <> " m=" <> show m <> " requested=" <> show d <>+  " resolved=" <> show w <> " weekday=" <> show dow

@@ -0,0 +1,260 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.DayOfWeekSpec (tests) where++import AWS.EventBridge.DayOfWeek+import qualified Data.Set as Set+import qualified Data.Text as T+import Data.Time.Calendar (gregorianMonthLength, fromGregorian)+import Data.Time.Calendar.WeekDate (toWeekDate)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport+  ( assertLeft+  , expectEvalWith+  , expectParseWith+  , strictlyAscending+  , withinBoundsInt+  )++tests :: TestTree+tests =+  testGroup "day-of-week"+    [ manualTests+    , propertyTests+    ]++manualTests :: TestTree+manualTests = testGroup "manual"+  [ testCase "parse *" $ parseDayOfWeekText "*" @?= Right DowAll+  , testCase "parse ?" $ parseDayOfWeekText "?" @?= Right DowAny+  , testCase "parse named literal" $ parseDayOfWeekText "Mon" @?= Right (DowAt 2)+  , testCase "parse numeric literal" $ parseDayOfWeekText "3" @?= Right (DowAt 3)+  , testCase "parse range" $ parseDayOfWeekText "MON-FRI" @?= Right (DowRange 2 6)+    , testCase "parse single-day range" $ parseDayOfWeekText "FRI-FRI" @?= Right (DowRange 6 6)+  , testCase "parse nth" $ parseDayOfWeekText "TUE#2" @?= Right (DowNth 3 2)+    , testCase "parse numeric nth" $ parseDayOfWeekText "5#1" @?= Right (DowNth 5 1)+  , testCase "parse union" $ parseDayOfWeekText "SUN,WED" @?= Right (DowUnion (DowAt 1) (DowAt 4))+    , testCase "parse named alias" $ parseDayOfWeekText "Thur" @?= Right (DowAt 5)+  , testCase "? cannot mix" $+      case parseDayOfWeekText "?,MON" of+        Left _ -> pure ()+        Right val -> fail ("unexpected success: " <> show val)+  , testCase "# cannot mix" $+      case parseDayOfWeekText "MON#1,FRI" of+        Left _ -> pure ()+        Right val -> fail ("unexpected success: " <> show val)+    , testCase "invalid day name fails" $+      case parseDayOfWeekText "FUNDAY" of+      Left _ -> pure ()+      Right val -> fail ("unexpected success: " <> show val)+    , testCase "evaluate MON in April 2025" $ do+      expr <- expectParseWith "dow" parseDayOfWeekText "MON"+      result <- expectEvalWith "dow" (evaluateDayOfWeekT 2025 4) expr+      result @?= [7,14,21,28]+  , testCase "nth occurrence absent yields empty" $ do+      expr <- expectParseWith "dow" parseDayOfWeekText "SUN#5"+      result <- expectEvalWith "dow" (evaluateDayOfWeekT 2025 2) expr+      result @?= []+  , testCase "nth occurrence resolves" $ do+      expr <- expectParseWith "dow" parseDayOfWeekText "THU#3"+      result <- expectEvalWith "dow" (evaluateDayOfWeekT 2025 5) expr+      result @?= [15]+      , testCase "union duplicates collapse" $ do+        expr <- expectParseWith "dow" parseDayOfWeekText "MON,mon"+        result <- expectEvalWith "dow" (evaluateDayOfWeekT 2025 5) expr+        result @?= [5,12,19,26]+  , testCase "invalid occurrence rejected" $+      assertLeft (evaluateDayOfWeekT 2025 5 (DowNth 3 6))+  , testCase "invalid day literal rejected" $+      assertLeft (evaluateDayOfWeekT 2025 5 (DowAt 9))+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "All days cover month" propAllCoversMonth+  , QC.testProperty "Any produces empty" propAnyEmpty+  , QC.testProperty "At day matches weekday" propAtMatchesWeekday+  , QC.testProperty "Range equals union of days" propRangeMatchesUnion+  , QC.testProperty "Range with same endpoints equals literal" propRangeDegenerateAsLiteral+  , QC.testProperty "Union combines unique days" propUnionCombines+  , QC.testProperty "Union with duplicates collapses" propUnionDeduplicates+  , QC.testProperty "Nth occurrence matches calendar" propNthMatchesCalendar+  , QC.testProperty "Generated expressions evaluate within bounds" propExpressionsWithinBounds+  , QC.testProperty "Named tokens parse case-insensitively" propNamedParseCaseInsensitive+  , QC.testProperty "Multiple # expressions rejected" propMultipleHashRejected+  ]++propAllCoversMonth :: QC.Property+propAllCoversMonth =+  QC.forAll genYearMonth $ \(y, m) ->+    case evaluateDayOfWeekT y m DowAll of+      Left err -> QC.counterexample err False+      Right xs -> xs QC.=== [1 .. gregorianMonthLength y m]++propAnyEmpty :: QC.Property+propAnyEmpty =+  QC.forAll genYearMonth $ \(y, m) ->+    case evaluateDayOfWeekT y m DowAny of+      Left err -> QC.counterexample err False+      Right xs -> xs QC.=== []++propAtMatchesWeekday :: QC.Property+propAtMatchesWeekday =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll (QC.chooseInt (1, 7)) $ \dow ->+      case evaluateDayOfWeekT y m (DowAt dow) of+        Left err -> QC.counterexample err False+        Right xs ->+          let msg = "y=" <> show y <> " m=" <> show m <> " dow=" <> show dow <> " xs=" <> show xs+          in QC.counterexample msg (all (\d -> awsDow y m d == dow) xs)++propRangeMatchesUnion :: QC.Property+propRangeMatchesUnion =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll genRangeBounds $ \(start, end) ->+      let expected = Set.toAscList (Set.fromList (concatMap (expectedDays y m) [start .. end]))+      in case evaluateDayOfWeekT y m (DowRange start end) of+          Left err -> QC.counterexample err False+          Right xs -> xs QC.=== expected++propUnionCombines :: QC.Property+propUnionCombines =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll genDayPair $ \(a, b) ->+      let expected = Set.toAscList (Set.fromList (expectedDays y m a ++ expectedDays y m b))+      in case evaluateDayOfWeekT y m (DowUnion (DowAt a) (DowAt b)) of+          Left err -> QC.counterexample err False+          Right xs -> xs QC.=== expected++propRangeDegenerateAsLiteral :: QC.Property+propRangeDegenerateAsLiteral =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll (QC.chooseInt (1, 7)) $ \dow ->+      case evaluateDayOfWeekT y m (DowRange dow dow) of+        Left err -> QC.counterexample err False+        Right xs ->+          case evaluateDayOfWeekT y m (DowAt dow) of+            Left err -> QC.counterexample err False+            Right expected -> xs QC.=== expected++propUnionDeduplicates :: QC.Property+propUnionDeduplicates =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll (QC.chooseInt (1, 7)) $ \dow ->+      let expr = DowUnion (DowAt dow) (DowAt dow)+      in case evaluateDayOfWeekT y m expr of+          Left err -> QC.counterexample err False+          Right xs ->+            case evaluateDayOfWeekT y m (DowAt dow) of+              Left err -> QC.counterexample err False+              Right expected -> xs QC.=== expected++propNthMatchesCalendar :: QC.Property+propNthMatchesCalendar =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll (QC.chooseInt (1, 7)) $ \dow ->+      QC.forAll (QC.chooseInt (1, 5)) $ \nth ->+        let occurrences = expectedDays y m dow+        in case evaluateDayOfWeekT y m (DowNth dow nth) of+            Left err -> QC.counterexample err False+            Right xs ->+              case drop (nth - 1) occurrences of+                (d : _) -> xs QC.=== [d]+                [] -> xs QC.=== []++propExpressionsWithinBounds :: QC.Property+propExpressionsWithinBounds =+  QC.forAll genYearMonth $ \(y, m) ->+    QC.forAll genDayOfWeekExpr $ \expr ->+      case evaluateDayOfWeekT y m expr of+        Left err -> QC.counterexample ("expr=" <> show expr <> ": " <> err) False+        Right xs ->+          let dim = gregorianMonthLength y m+              msg = "expr=" <> show expr <> " xs=" <> show xs+          in QC.counterexample msg (withinBoundsInt 1 dim xs && strictlyAscending xs)++propNamedParseCaseInsensitive :: QC.Property+propNamedParseCaseInsensitive =+  QC.forAll (QC.elements namedTokenCases) $ \(token, expected) ->+    case parseDayOfWeekText token of+      Left err -> QC.counterexample err False+      Right expr -> expr QC.=== expected++propMultipleHashRejected :: QC.Property+propMultipleHashRejected =+  QC.forAll genYearMonth $ \(y, m) ->+    let candidate = "MON#1,TUE#2"+    in case parseDayOfWeekText candidate of+         Left _ -> QC.property True+         Right expr ->+           let eval = evaluateDayOfWeekT y m expr+           in QC.counterexample ("unexpected success: " <> show expr <> ", eval=" <> show eval) False++-- Generators++genYearMonth :: QC.Gen (Integer, Int)+genYearMonth = do+  year <- QC.chooseInteger (1970, 2199)+  month <- QC.chooseInt (1, 12)+  pure (year, month)++genRangeBounds :: QC.Gen (Int, Int)+genRangeBounds = do+  start <- QC.chooseInt (1, 7)+  end <- QC.chooseInt (start, 7)+  pure (start, end)++genDayPair :: QC.Gen (Int, Int)+genDayPair = do+  a <- QC.chooseInt (1, 7)+  b <- QC.chooseInt (1, 7)+  pure (a, b)++genDayOfWeekExpr :: QC.Gen DayOfWeekExprT+genDayOfWeekExpr = QC.sized go+  where+    go n+      | n <= 1 = QC.oneof base+      | otherwise = QC.frequency+          [ (3, QC.oneof base)+          , (2, do+                start <- QC.chooseInt (1, 7)+                end <- QC.chooseInt (start, 7)+                pure (DowRange start end))+          , (2, do+                let sub = max 1 (n `div` 2)+                DowUnion <$> go sub <*> go sub)+          ]+    base =+      [ pure DowAny+      , pure DowAll+      , DowAt <$> QC.chooseInt (1, 7)+      , DowNth <$> QC.chooseInt (1, 7) <*> QC.chooseInt (1, 5)+      ]+    +namedTokenCases :: [(T.Text, DayOfWeekExprT)]+namedTokenCases =+  [ ("sun", DowAt 1)+  , ("MON", DowAt 2)+  , ("tue", DowAt 3)+  , ("Wed", DowAt 4)+  , ("thurs", DowAt 5)+  , ("FRI", DowAt 6)+  , ("Sat", DowAt 7)+  ]++-- Helpers++awsDow :: Integer -> Int -> Int -> Int+awsDow y m d =+  let (_, _, iso) = toWeekDate (fromGregorian y m d)+  in (iso `mod` 7) + 1++expectedDays :: Integer -> Int -> Int -> [Int]+expectedDays y m dow =+  [ dayOfMonth+  | dayOfMonth <- [1 .. gregorianMonthLength y m]+  , awsDow y m dayOfMonth == dow+  ]

@@ -0,0 +1,145 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.HoursSpec (tests) where++import AWS.EventBridge.Hours+import Data.List (nub, sort)+import qualified Data.Text as T+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport+  ( assertLeft+  , expectEvalWith+  , expectParseWith+  , strictlyAscending+  , withinBoundsInt+  )++tests :: TestTree+tests =+  testGroup "hours"+    [ manualTests+    , propertyTests+    ]++manualTests :: TestTree+manualTests = testGroup "manual"+  [ testCase "parse *" $ parseHoursText "*" @?= Right AllHours+  , testCase "parse literal hour" $ parseHoursText "7" @?= Right (AtHour 7)+  , testCase "parse range" $ parseHoursText "8-12" @?= Right (RangeHour 8 12)+  , testCase "parse step" $ parseHoursText "3/4" @?= Right (StepHour 3 4)+  , testCase "parse union" $ do+      expr <- expectParseWith "hours" parseHoursText "1,12,18"+      result <- expectEvalWith "hours" evaluateHourT expr+      result @?= [1,12,18]+  , testCase "evaluate AllHours" $ do+      result <- expectEvalWith "hours" evaluateHourT AllHours+      result @?= [0..23]+  , testCase "invalid step start fails" $+      assertLeft (evaluateHourT (StepHour 25 2))+  , testCase "invalid step increment fails" $+      assertLeft (evaluateHourT (StepHour 3 0))+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "AllHours covers 0..23" propAllHoursRange+  , QC.testProperty "AtHour returns singleton" propAtHourSingleton+  , QC.testProperty "Generated expressions evaluate within bounds" propExpressionsWithinBounds+  , QC.testProperty "Parse of comma list matches sorted unique" propParseCommaSeparated+  , QC.testProperty "Invalid literal hour rejected" propInvalidHourRejected+  , QC.testProperty "Step hour forms arithmetic progression" propStepHourProgression+  ]++propAllHoursRange :: QC.Property+propAllHoursRange =+  case evaluateHourT AllHours of+    Left err -> QC.counterexample err False+    Right xs -> xs QC.=== [0..23]++propAtHourSingleton :: QC.Property+propAtHourSingleton =+  QC.forAll (QC.chooseInt (0, 23)) $ \h ->+    case evaluateHourT (AtHour h) of+      Left err -> QC.counterexample err False+      Right xs -> xs QC.=== [h]++propExpressionsWithinBounds :: QC.Property+propExpressionsWithinBounds =+  QC.forAll genHourExpr $ \expr ->+    case evaluateHourT expr of+      Left err -> QC.counterexample ("expr=" <> show expr <> ": " <> err) False+      Right xs ->+        let message = "expr=" <> show expr <> " xs=" <> show xs+        in QC.counterexample message (withinBoundsInt 0 23 xs && strictlyAscending xs)++propParseCommaSeparated :: QC.Property+propParseCommaSeparated =+  QC.forAll (QC.listOf1 (QC.chooseInt (0, 23))) $ \hoursList ->+    let txt = T.intercalate "," (map (T.pack . show) hoursList)+        expected = sort (nub hoursList)+    in case parseHoursText txt of+        Left err -> QC.counterexample err False+        Right expr ->+          case evaluateHourT expr of+            Left evalErr -> QC.counterexample evalErr False+            Right xs -> xs QC.=== expected++propInvalidHourRejected :: QC.Property+propInvalidHourRejected =+  QC.forAll invalidHour $ \h ->+    case evaluateHourT (AtHour h) of+      Left _ -> QC.property True+      Right xs ->+        QC.counterexample ("unexpected success: " <> show xs) False++propStepHourProgression :: QC.Property+propStepHourProgression =+  QC.forAll (QC.chooseInt (0, 23)) $ \start ->+    QC.forAll (QC.chooseInt (1, 12)) $ \step ->+      case evaluateHourT (StepHour start step) of+        Left err -> QC.counterexample err False+        Right xs ->+          QC.counterexample ("step output=" <> show xs)+            (withinBoundsInt 0 23 xs && isStepProgression start step xs)++genHourExpr :: QC.Gen HoursExprT+genHourExpr = QC.sized go+  where+    go n+      | n <= 1 = QC.oneof base+      | otherwise = QC.frequency+          [ (3, QC.oneof base)+          , (2, genRange)+          , (2, genStep)+          , (2, genUnion (n - 1))+          ]+    base =+      [ pure AllHours+      , AtHour <$> QC.chooseInt (0, 23)+      ]+    genRange = do+      start <- QC.chooseInt (0, 23)+      end <- QC.chooseInt (start, 23)+      pure (RangeHour start end)+    genStep = do+      start <- QC.chooseInt (0, 23)+      step <- QC.chooseInt (1, 12)+      pure (StepHour start step)+    genUnion depth = do+      let sub = max 0 depth+      left <- go sub+      right <- go sub+      pure (UnionHour left right)++invalidHour :: QC.Gen Int+invalidHour = QC.oneof [QC.chooseInt (-24, -1), QC.chooseInt (24, 96)]++isStepProgression :: Int -> Int -> [Int] -> Bool+isStepProgression _ _ [] = True+isStepProgression start step (x0 : rest) =+  x0 == start && all (== step) (consecutiveDiffs x0 rest)+  where+    consecutiveDiffs _ [] = []+    consecutiveDiffs prev (y : ys) = (y - prev) : consecutiveDiffs y ys

@@ -0,0 +1,145 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.MinutesSpec (tests) where++import AWS.EventBridge.Minutes+import Data.List (nub, sort)+import qualified Data.Text as T+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport+  ( assertLeft+  , expectEvalWith+  , expectParseWith+  , strictlyAscending+  , withinBoundsInt+  )++tests :: TestTree+tests =+  testGroup "minutes"+    [ manualTests+    , propertyTests+    ]++manualTests :: TestTree+manualTests = testGroup "manual"+  [ testCase "parse *" $ parseMinutesText "*" @?= Right AllMinutes+  , testCase "parse literal minute" $ parseMinutesText "5" @?= Right (AtMinute 5)+  , testCase "parse range" $ parseMinutesText "10-12" @?= Right (RangeMinute 10 12)+  , testCase "parse step" $ parseMinutesText "5/15" @?= Right (StepMinute 5 15)+    , testCase "parse union" $ do+      expr <- expectParseWith "minutes" parseMinutesText "0,15,30"+      result <- expectEvalWith "minutes" evaluateMinuteT expr+      result @?= [0,15,30]+    , testCase "evaluate AllMinutes" $ do+      result <- expectEvalWith "minutes" evaluateMinuteT AllMinutes+      result @?= [0..59]+  , testCase "invalid step start fails" $+      assertLeft (evaluateMinuteT (StepMinute 75 5))+  , testCase "invalid step increment fails" $+      assertLeft (evaluateMinuteT (StepMinute 10 0))+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "AllMinutes covers 0..59" propAllMinutesRange+  , QC.testProperty "AtMinute returns singleton" propAtMinuteSingleton+  , QC.testProperty "Generated expressions evaluate within bounds" propExpressionsWithinBounds+  , QC.testProperty "Parse of comma list matches sorted unique" propParseCommaSeparated+  , QC.testProperty "Invalid literal minute rejected" propInvalidMinuteRejected+  , QC.testProperty "Step minute forms arithmetic progression" propStepMinuteProgression+  ]++propAllMinutesRange :: QC.Property+propAllMinutesRange =+  case evaluateMinuteT AllMinutes of+    Left err -> QC.counterexample err False+    Right xs -> xs QC.=== [0..59]++propAtMinuteSingleton :: QC.Property+propAtMinuteSingleton =+  QC.forAll (QC.chooseInt (0, 59)) $ \m ->+    case evaluateMinuteT (AtMinute m) of+      Left err -> QC.counterexample err False+      Right xs -> xs QC.=== [m]++propExpressionsWithinBounds :: QC.Property+propExpressionsWithinBounds =+  QC.forAll genMinuteExpr $ \expr ->+    case evaluateMinuteT expr of+      Left err -> QC.counterexample ("expr=" <> show expr <> ": " <> err) False+      Right xs ->+        let message = "expr=" <> show expr <> " xs=" <> show xs+        in QC.counterexample message (withinBoundsInt 0 59 xs && strictlyAscending xs)++propParseCommaSeparated :: QC.Property+propParseCommaSeparated =+  QC.forAll (QC.listOf1 (QC.chooseInt (0, 59))) $ \mins ->+    let txt = T.intercalate "," (map (T.pack . show) mins)+        expected = sort (nub mins)+    in case parseMinutesText txt of+        Left err -> QC.counterexample err False+        Right expr ->+          case evaluateMinuteT expr of+            Left evalErr -> QC.counterexample evalErr False+            Right xs -> xs QC.=== expected++propInvalidMinuteRejected :: QC.Property+propInvalidMinuteRejected =+  QC.forAll invalidMinute $ \m ->+    case evaluateMinuteT (AtMinute m) of+      Left _ -> QC.property True+      Right xs ->+        QC.counterexample ("unexpected success: " <> show xs) False++propStepMinuteProgression :: QC.Property+propStepMinuteProgression =+  QC.forAll (QC.chooseInt (0, 59)) $ \start ->+    QC.forAll (QC.chooseInt (1, 30)) $ \step ->+      case evaluateMinuteT (StepMinute start step) of+        Left err -> QC.counterexample err False+        Right xs ->+          QC.counterexample ("step output=" <> show xs)+            (withinBoundsInt 0 59 xs && isStepProgression start step xs)++genMinuteExpr :: QC.Gen MinutesExprT+genMinuteExpr = QC.sized go+  where+    go n+      | n <= 1 = QC.oneof base+      | otherwise = QC.frequency+          [ (3, QC.oneof base)+          , (2, genRange)+          , (2, genStep)+          , (2, genUnion (n - 1))+          ]+    base =+      [ pure AllMinutes+      , AtMinute <$> QC.chooseInt (0, 59)+      ]+    genRange = do+      start <- QC.chooseInt (0, 59)+      end <- QC.chooseInt (start, 59)+      pure (RangeMinute start end)+    genStep = do+      start <- QC.chooseInt (0, 59)+      step <- QC.chooseInt (1, 30)+      pure (StepMinute start step)+    genUnion depth = do+      let sub = max 0 depth+      left <- go sub+      right <- go sub+      pure (UnionMinute left right)++invalidMinute :: QC.Gen Int+invalidMinute = QC.oneof [QC.chooseInt (-30, -1), QC.chooseInt (60, 120)]++isStepProgression :: Int -> Int -> [Int] -> Bool+isStepProgression _ _ [] = True+isStepProgression start step (x0 : rest) =+  x0 == start && all (== step) (consecutiveDiffs x0 rest)+  where+    consecutiveDiffs _ [] = []+    consecutiveDiffs prev (y : ys) = (y - prev) : consecutiveDiffs y ys

@@ -0,0 +1,230 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.MonthsSpec (tests) where++import AWS.EventBridge.Months+import Data.List (nub, sort)+import qualified Data.Set as Set+import qualified Data.Text as T+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport+  ( assertLeft+  , expectEvalEquals+  , expectEvalWith+  , expectParseWith+  , strictlyAscending+  , withinBoundsInt+  )++tests :: TestTree+tests =+  testGroup "months"+    [ manualTests+    , propertyTests+    ]++manualTests :: TestTree+manualTests = testGroup "manual"+  [ testCase "parse *" $ parseMonthsText "*" @?= Right AllMonths+  , testCase "parse numeric literal" $ parseMonthsText "3" @?= Right (AtMonth 3)+  , testCase "parse month name" $ parseMonthsText "Feb" @?= Right (AtMonth 2)+  , testCase "parse range" $ parseMonthsText "3-5" @?= Right (RangeMonth 3 5)+  , testCase "parse step" $ parseMonthsText "6/2" @?= Right (StepMonth 6 2)+  , testCase "parse mixed union" $ do+      expr <- expectParseWith "months" parseMonthsText "Jan,4,Aug"+      result <- expectEvalWith "months" evaluateMonthT expr+      result @?= [1,4,8]+  , testCase "parse union with duplicates collapses" $ do+      expr <- expectParseWith "months" parseMonthsText "Jan,jan,1"+      result <- expectEvalWith "months" evaluateMonthT expr+      result @?= [1]+  , testCase "evaluate AllMonths" $ expectEvalEquals [1..12] (evaluateMonthT AllMonths)+  , testCase "invalid month literal fails" $ assertLeft (evaluateMonthT (AtMonth 20))+  , testCase "invalid month name fails" $+      case parseMonthsText "Foo" of+        Left _ -> pure ()+        Right val -> fail ("unexpected success: " <> show val)+  , testCase "descending range rejected" $+      assertLeft (evaluateMonthT (RangeMonth 5 3))+  , testCase "step start out of range fails" $+      assertLeft (evaluateMonthT (StepMonth 0 2))+  , testCase "step increment zero fails" $+      assertLeft (evaluateMonthT (StepMonth 5 0))+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "AllMonths covers 1..12" propAllMonthsRange+  , QC.testProperty "AtMonth returns singleton" propAtMonthSingleton+  , QC.testProperty "Generated expressions evaluate within bounds" propExpressionsWithinBounds+  , QC.testProperty "Parse of comma list matches sorted unique" propParseCommaSeparated+  , QC.testProperty "Named months parse to expected indices" propNamedMonthsParse+  , QC.testProperty "Invalid literal month rejected" propInvalidMonthRejected+  , QC.testProperty "Range month evaluates inclusively" propRangeMonthInclusive+  , QC.testProperty "Descending range rejected" propRangeMonthRejectsDescending+  , QC.testProperty "Step month forms arithmetic progression" propStepMonthProgression+  , QC.testProperty "Union month combines operands" propUnionMonthCombines+  ]++propAllMonthsRange :: QC.Property+propAllMonthsRange =+  case evaluateMonthT AllMonths of+    Left err -> QC.counterexample err False+    Right xs -> xs QC.=== [1..12]++propAtMonthSingleton :: QC.Property+propAtMonthSingleton =+  QC.forAll (QC.chooseInt (1, 12)) $ \m ->+    case evaluateMonthT (AtMonth m) of+      Left err -> QC.counterexample err False+      Right xs -> xs QC.=== [m]++propExpressionsWithinBounds :: QC.Property+propExpressionsWithinBounds =+  QC.forAll genMonthExpr $ \expr ->+    case evaluateMonthT expr of+      Left err -> QC.counterexample ("expr=" <> show expr <> ": " <> err) False+      Right xs ->+        let message = "expr=" <> show expr <> " xs=" <> show xs+        in QC.counterexample message (withinBoundsInt 1 12 xs && strictlyAscending xs)++propParseCommaSeparated :: QC.Property+propParseCommaSeparated =+  QC.forAll (QC.listOf1 genMonthTokenText) $ \monthsTxt ->+    let txt = T.intercalate "," monthsTxt+        expected = sort (nub (map parseTokenUnsafe monthsTxt))+    in case parseMonthsText txt of+        Left err -> QC.counterexample err False+        Right expr ->+          case evaluateMonthT expr of+            Left evalErr -> QC.counterexample evalErr False+            Right xs -> xs QC.=== expected++propNamedMonthsParse :: QC.Property+propNamedMonthsParse =+  QC.forAll genNamedMonthText $ \nameTxt ->+    case parseMonthsText nameTxt of+      Left err -> QC.counterexample err False+      Right expr ->+        case expr of+          AtMonth m ->+            let expected = parseTokenUnsafe nameTxt+            in QC.counterexample ("expected " <> show expected <> ", got " <> show m) (m == expected)+          other -> QC.counterexample ("expected AtMonth, got " <> show other) False++propInvalidMonthRejected :: QC.Property+propInvalidMonthRejected =+  QC.forAll invalidMonth $ \m ->+    case evaluateMonthT (AtMonth m) of+      Left _ -> QC.property True+      Right xs -> QC.counterexample ("unexpected success: " <> show xs) False++propRangeMonthInclusive :: QC.Property+propRangeMonthInclusive =+  QC.forAll (QC.chooseInt (1, 12)) $ \start ->+    QC.forAll (QC.chooseInt (start, 12)) $ \end ->+      case evaluateMonthT (RangeMonth start end) of+        Left err -> QC.counterexample err False+        Right xs -> xs QC.=== [start..end]++propRangeMonthRejectsDescending :: QC.Property+propRangeMonthRejectsDescending =+  QC.forAll (QC.chooseInt (2, 12)) $ \start ->+    QC.forAll (QC.chooseInt (1, start - 1)) $ \end ->+      case evaluateMonthT (RangeMonth start end) of+        Left _ -> QC.property True+        Right xs -> QC.counterexample ("unexpected success: " <> show xs) False++propStepMonthProgression :: QC.Property+propStepMonthProgression =+  QC.forAll (QC.chooseInt (1, 12)) $ \start ->+    QC.forAll (QC.chooseInt (1, 6)) $ \step ->+      case evaluateMonthT (StepMonth start step) of+        Left err -> QC.counterexample err False+        Right xs ->+          QC.counterexample ("step output=" <> show xs)+            (withinBoundsInt 1 12 xs && isStepProgression start step xs)++propUnionMonthCombines :: QC.Property+propUnionMonthCombines =+  QC.forAll genMonthExpr $ \lhs ->+    QC.forAll genMonthExpr $ \rhs ->+      case ( evaluateMonthT lhs+           , evaluateMonthT rhs+           , evaluateMonthT (UnionMonth lhs rhs)+           ) of+        (Right xs, Right ys, Right zs) ->+          let expected = Set.toAscList (Set.fromList (xs ++ ys))+              msg = "lhs=" <> show lhs <> " rhs=" <> show rhs <> " expected=" <> show expected <> " actual=" <> show zs+          in QC.counterexample msg (zs == expected)+        (Left err, _, _) -> QC.counterexample ("lhs failed: " <> err) False+        (_, Left err, _) -> QC.counterexample ("rhs failed: " <> err) False+        (_, _, Left err) -> QC.counterexample ("union failed: " <> err) False++-- Generators++genMonthExpr :: QC.Gen MonthsExprT+genMonthExpr = QC.sized go+  where+    go n+      | n <= 1 = QC.oneof base+      | otherwise = QC.frequency+          [ (3, QC.oneof base)+          , (2, genRange)+          , (2, genStep)+          , (2, genUnion (n - 1))+          ]+    base =+      [ pure AllMonths+      , AtMonth <$> QC.chooseInt (1, 12)+      ]+    genRange = do+      start <- QC.chooseInt (1, 12)+      end <- QC.chooseInt (start, 12)+      pure (RangeMonth start end)+    genStep = do+      start <- QC.chooseInt (1, 12)+      step <- QC.chooseInt (1, 6)+      pure (StepMonth start step)+    genUnion depth = do+      let sub = max 0 depth+      left <- go sub+      right <- go sub+      pure (UnionMonth left right)++genMonthTokenText :: QC.Gen T.Text+genMonthTokenText = QC.oneof+  [ T.pack . show <$> QC.chooseInt (1, 12)+  , QC.elements (map T.pack ["Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"])+  ]++genNamedMonthText :: QC.Gen T.Text+genNamedMonthText =+  QC.elements (map T.pack ["JAN","feb","Mar","apr","may","JUN","jul","AuG","sep","OCT","nov","dec"])++invalidMonth :: QC.Gen Int+invalidMonth = QC.oneof [QC.chooseInt (-12, 0), QC.chooseInt (13, 36)]++-- Helpers++parseTokenUnsafe :: T.Text -> Int+parseTokenUnsafe t =+  case parseAt (T.strip t) of+    Right m -> m+    Left err -> error ("unexpected parse failure: " <> err)+  where+    parseAt txt = do+      expr <- parseMonthsText txt+      case expr of+        AtMonth m -> Right m+        _         -> Left ("expected AtMonth for token " <> show txt)++isStepProgression :: Int -> Int -> [Int] -> Bool+isStepProgression _ _ [] = True+isStepProgression start step (x0 : rest) =+  x0 == start && all (== step) (consecutiveDiffs x0 rest)+  where+    consecutiveDiffs _ [] = []+    consecutiveDiffs prev (y : ys) = (y - prev) : consecutiveDiffs y ys

@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.OneTimeSpec (tests) where++import AWS.EventBridge.OneTime+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (UTCTime (..))+import Data.Time.Calendar (fromGregorian, gregorianMonthLength)+import Data.Time.Format (defaultTimeLocale, formatTime)+import Data.Time.LocalTime (TimeOfDay (..), timeOfDayToTime)+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport (assertLeft)++tests :: TestTree+tests =+  testGroup "one-time"+    [ manualTests+    , propertyTests+    ]++manualTests :: TestTree+manualTests = testGroup "manual"+  [ testCase "parse at expression" $+      parseOneTimeText "at(2025-11-16T09:30:00)"+        @?= Right (OneTime (mkUtc 2025 11 16 9 30 0))+  , testCase "parse allows whitespace" $+      parseOneTimeText "  at(2025-01-01T00:00:00)  "+        @?= Right (OneTime (mkUtc 2025 1 1 0 0 0))+  , testCase "parse rejects Z suffix" $+      assertLeft (parseOneTimeText "at(2025-03-15T12:45:30Z)")+  , testCase "evaluator returns timestamp" $+      evaluateOneTimeT (OneTime (mkUtc 2024 5 20 18 0 0))+        @?= mkUtc 2024 5 20 18 0 0+  , testCase "invalid month rejected" $+      assertLeft (parseOneTimeText "at(2025-13-01T00:00:00)")+  , testCase "invalid day rejected" $+      assertLeft (parseOneTimeText "at(2025-02-30T00:00:00)")+  , testCase "invalid time rejected" $+      assertLeft (parseOneTimeText "at(2025-01-01T25:00:00)")+  , testCase "missing seconds rejected" $+      assertLeft (parseOneTimeText "at(2025-01-01T00:00)")+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "parser round-trips formatted timestamps" propRoundTrip+  ]++propRoundTrip :: QC.Property+propRoundTrip =+  QC.forAll genUtc $ \t ->+    let rendered = renderAt t+     in parseOneTimeText rendered QC.=== Right (OneTime t)++renderAt :: UTCTime -> Text+renderAt t =+  let payload = formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" t+   in T.pack ("at(" <> payload <> ")")++mkUtc :: Integer -> Int -> Int -> Int -> Int -> Int -> UTCTime+mkUtc year month day hour minute second =+  let day' = fromGregorian year month day+      tod = TimeOfDay hour minute (fromIntegral second)+   in UTCTime day' (timeOfDayToTime tod)++genUtc :: QC.Gen UTCTime+genUtc = do+  year <- QC.chooseInteger (1970, 2199)+  month <- QC.chooseInt (1, 12)+  let dim = gregorianMonthLength year month+  day <- QC.chooseInt (1, dim)+  hour <- QC.chooseInt (0, 23)+  minute <- QC.chooseInt (0, 59)+  second <- QC.chooseInt (0, 59)+  pure (mkUtc year month day hour minute second)

@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.RateSpec (tests) where++import AWS.EventBridge.Rate+import Data.Time.Clock (secondsToNominalDiffTime)+import qualified Data.Text as T+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport (assertLeft)++tests :: TestTree+tests =+  testGroup "rate"+    [ manualTests+    , propertyTests+    ]++manualTests :: TestTree+manualTests = testGroup "manual"+  [ testCase "parse minutes" $ parseRateText "rate(5 minutes)" @?= Right (RateMinutes 5)+  , testCase "parse minute singular" $ parseRateText "rate(1 minute)" @?= Right (RateMinutes 1)+  , testCase "parse hours plural" $ parseRateText "rate(10 hours)" @?= Right (RateHours 10)+  , testCase "parse hour singular" $ parseRateText "rate(1 hour)" @?= Right (RateHours 1)+  , testCase "parse days" $ parseRateText "rate(3 days)" @?= Right (RateDays 3)+  , testCase "parse day singular" $ parseRateText "rate(1 day)" @?= Right (RateDays 1)+  , testCase "parse trims surrounding whitespace" $ parseRateText "  rate(2 hours)\n" @?= Right (RateHours 2)+  , testCase "parse without separator fails" $ assertLeft (parseRateText "rate(5minutes)")+  , testCase "parse negative rejected" $ assertLeft (parseRateText "rate(-5 minutes)")+  , testCase "evaluate minutes" $+      evaluateRateT (RateMinutes 15) @?= Right (secondsToNominalDiffTime 900)+  , testCase "evaluate hours" $+      evaluateRateT (RateHours 2) @?= Right (secondsToNominalDiffTime 7200)+  , testCase "evaluate days" $+      evaluateRateT (RateDays 1) @?= Right (secondsToNominalDiffTime 86400)+  , testCase "evaluate minutes upper bound" $+    evaluateRateT (RateMinutes 31536000)+        @?= Right (secondsToNominalDiffTime (fromInteger (31536000 * 60)))+  , testCase "evaluate hours upper bound" $+    evaluateRateT (RateHours 8760)+        @?= Right (secondsToNominalDiffTime (fromInteger (8760 * 3600)))+  , testCase "evaluate days upper bound" $+    evaluateRateT (RateDays 365)+        @?= Right (secondsToNominalDiffTime (fromInteger (365 * 86400)))+  , testCase "minutes below range rejected" $+      assertLeft (evaluateRateT (RateMinutes 0))+  , testCase "minutes above range rejected" $+      assertLeft (evaluateRateT (RateMinutes 40000000))+  , testCase "hours below range rejected" $+      assertLeft (evaluateRateT (RateHours 0))+  , testCase "hours above range rejected" $+      assertLeft (evaluateRateT (RateHours 9000))+  , testCase "days below range rejected" $+      assertLeft (evaluateRateT (RateDays 0))+  , testCase "days above range rejected" $+      assertLeft (evaluateRateT (RateDays 400))+  , testCase "invalid unit fails" $+      case parseRateText "rate(5 weeks)" of+        Left _ -> pure ()+        Right val -> fail ("unexpected success: " <> show val)+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "minutes evaluate to consistent seconds" propMinutesEvaluate+  , QC.testProperty "hours evaluate to consistent seconds" propHoursEvaluate+  , QC.testProperty "days evaluate to consistent seconds" propDaysEvaluate+  , QC.testProperty "parser round-trips generated expressions" propParserRoundTrip+  ]++propMinutesEvaluate :: QC.Property+propMinutesEvaluate =+  QC.forAll (QC.chooseInt (1, 31536000)) $ \m ->+    evaluateRateT (RateMinutes m)+      QC.=== Right (secondsToNominalDiffTime (fromIntegral (m * 60)))++propHoursEvaluate :: QC.Property+propHoursEvaluate =+  QC.forAll (QC.chooseInt (1, 8760)) $ \h ->+    evaluateRateT (RateHours h)+      QC.=== Right (secondsToNominalDiffTime (fromIntegral (h * 3600)))++propDaysEvaluate :: QC.Property+propDaysEvaluate =+  QC.forAll (QC.chooseInt (1, 365)) $ \d ->+    evaluateRateT (RateDays d)+      QC.=== Right (secondsToNominalDiffTime (fromIntegral (d * 86400)))++propParserRoundTrip :: QC.Property+propParserRoundTrip =+  QC.forAll genRateExprText $ \(expr, input) ->+    parseRateText input QC.=== Right expr++genRateExprText :: QC.Gen (RateExprT, T.Text)+genRateExprText =+  QC.oneof+    [ genCase RateMinutes 31536000 "minute"+    , genCase RateHours 8760 "hour"+    , genCase RateDays 365 "day"+    ]++genCase :: (Int -> RateExprT) -> Int -> String -> QC.Gen (RateExprT, T.Text)+genCase constructor upperBound unitLabel = do+  n <- QC.chooseInt (1, upperBound)+  plural <- QC.elements [False, True]+  prefix <- QC.elements ["", " ", "\t", "\n"]+  suffix <- QC.elements ["", " ", "\t", "\n"]+  gap <- QC.elements [" ", "  ", "\t"]+  let token = unitLabel <> if plural then "s" else ""+      rendered = prefix <> "rate(" <> show n <> gap <> token <> ")" <> suffix+  pure (constructor n, T.pack rendered)

@@ -0,0 +1,191 @@+{-# LANGUAGE OverloadedStrings #-}++module AWS.EventBridge.YearsSpec (tests) where++import AWS.EventBridge.Years+import Data.List (nub, sort)+import qualified Data.Set as Set+import qualified Data.Text as T+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck as QC+import TestSupport+  ( assertLeft+  , expectEvalEquals+  , expectEvalWith+  , expectParseWith+  , strictlyAscending+  , withinBoundsInt+  )++tests :: TestTree+tests =+  testGroup "years"+    [ manualTests+    , propertyTests+    ]++manualTests :: TestTree+manualTests = testGroup "manual"+  [ testCase "parse *" $ parseYearsText "*" @?= Right AllYears+  , testCase "parse literal year" $ parseYearsText "2025" @?= Right (AtYear 2025)+  , testCase "parse range" $ parseYearsText "1975-1980" @?= Right (RangeYear 1975 1980)+  , testCase "parse step" $ parseYearsText "2000/5" @?= Right (StepYear 2000 5)+  , testCase "parse union" $ do+      expr <- expectParseWith "years" parseYearsText "1970,2020,2199"+      result <- expectEvalWith "years" evaluateYearT expr+      result @?= [1970,2020,2199]+    , testCase "parse union with duplicates collapses" $ do+      expr <- expectParseWith "years" parseYearsText "1970,1970,2199"+      result <- expectEvalWith "years" evaluateYearT expr+      result @?= [1970,2199]+  , testCase "evaluate AllYears" $ expectEvalEquals [1970..2199] (evaluateYearT AllYears)+  , testCase "invalid step start fails" $+      assertLeft (evaluateYearT (StepYear 1969 2))+  , testCase "invalid step increment fails" $+      assertLeft (evaluateYearT (StepYear 1980 0))+  , testCase "literal out of range fails" $+      assertLeft (evaluateYearT (AtYear 2250))+    , testCase "descending range rejected" $+      assertLeft (evaluateYearT (RangeYear 2025 2020))+  ]++propertyTests :: TestTree+propertyTests = testGroup "properties"+  [ QC.testProperty "AllYears covers 1970..2199" propAllYearsRange+  , QC.testProperty "AtYear returns singleton" propAtYearSingleton+  , QC.testProperty "Generated expressions evaluate within bounds" propExpressionsWithinBounds+  , QC.testProperty "Parse of comma list matches sorted unique" propParseCommaSeparated+  , QC.testProperty "Invalid literal year rejected" propInvalidYearRejected+  , QC.testProperty "Step year forms arithmetic progression" propStepYearProgression+    , QC.testProperty "Range year evaluates inclusively" propRangeYearInclusive+    , QC.testProperty "Descending range rejected" propRangeYearRejectsDescending+    , QC.testProperty "Union year combines operands" propUnionYearCombines+  ]++propAllYearsRange :: QC.Property+propAllYearsRange =+  case evaluateYearT AllYears of+    Left err -> QC.counterexample err False+    Right xs -> xs QC.=== [1970..2199]++propAtYearSingleton :: QC.Property+propAtYearSingleton =+  QC.forAll (QC.chooseInt (1970, 2199)) $ \y ->+    case evaluateYearT (AtYear y) of+      Left err -> QC.counterexample err False+      Right xs -> xs QC.=== [y]++propExpressionsWithinBounds :: QC.Property+propExpressionsWithinBounds =+  QC.forAll genYearExpr $ \expr ->+    case evaluateYearT expr of+      Left err -> QC.counterexample ("expr=" <> show expr <> ": " <> err) False+      Right xs ->+        let message = "expr=" <> show expr <> " xs=" <> show xs+        in QC.counterexample message (withinBoundsInt 1970 2199 xs && strictlyAscending xs)++propParseCommaSeparated :: QC.Property+propParseCommaSeparated =+  QC.forAll (QC.listOf1 (QC.chooseInt (1970, 2199))) $ \years ->+    let txt = T.intercalate "," (map (T.pack . show) years)+        expected = sort (nub years)+    in case parseYearsText txt of+        Left err -> QC.counterexample err False+        Right expr ->+          case evaluateYearT expr of+            Left evalErr -> QC.counterexample evalErr False+            Right xs -> xs QC.=== expected++propInvalidYearRejected :: QC.Property+propInvalidYearRejected =+  QC.forAll invalidYear $ \y ->+    case evaluateYearT (AtYear y) of+      Left _ -> QC.property True+      Right xs -> QC.counterexample ("unexpected success: " <> show xs) False++propRangeYearInclusive :: QC.Property+propRangeYearInclusive =+  QC.forAll (QC.chooseInt (1970, 2199)) $ \start ->+    QC.forAll (QC.chooseInt (start, 2199)) $ \end ->+      case evaluateYearT (RangeYear start end) of+        Left err -> QC.counterexample err False+        Right xs -> xs QC.=== [start..end]++propRangeYearRejectsDescending :: QC.Property+propRangeYearRejectsDescending =+  QC.forAll (QC.chooseInt (1971, 2199)) $ \start ->+    QC.forAll (QC.chooseInt (1970, start - 1)) $ \end ->+      case evaluateYearT (RangeYear start end) of+        Left _ -> QC.property True+        Right xs -> QC.counterexample ("unexpected success: " <> show xs) False++propStepYearProgression :: QC.Property+propStepYearProgression =+  QC.forAll (QC.chooseInt (1970, 2199)) $ \start ->+    QC.forAll (QC.chooseInt (1, 40)) $ \step ->+      case evaluateYearT (StepYear start step) of+        Left err -> QC.counterexample err False+        Right xs ->+          QC.counterexample ("step output=" <> show xs)+            (withinBoundsInt 1970 2199 xs && isStepProgression start step xs)++propUnionYearCombines :: QC.Property+propUnionYearCombines =+  QC.forAll genYearExpr $ \lhs ->+    QC.forAll genYearExpr $ \rhs ->+      case ( evaluateYearT lhs+           , evaluateYearT rhs+           , evaluateYearT (UnionYear lhs rhs)+           ) of+        (Right xs, Right ys, Right zs) ->+          let expected = Set.toAscList (Set.fromList (xs ++ ys))+              msg = "lhs=" <> show lhs <> " rhs=" <> show rhs <> " expected=" <> show expected <> " actual=" <> show zs+          in QC.counterexample msg (zs == expected)+        (Left err, _, _) -> QC.counterexample ("lhs failed: " <> err) False+        (_, Left err, _) -> QC.counterexample ("rhs failed: " <> err) False+        (_, _, Left err) -> QC.counterexample ("union failed: " <> err) False++-- Generators++genYearExpr :: QC.Gen YearsExprT+genYearExpr = QC.sized go+  where+    go n+      | n <= 1 = QC.oneof base+      | otherwise = QC.frequency+          [ (3, QC.oneof base)+          , (2, genRange)+          , (2, genStep)+          , (2, genUnion (n - 1))+          ]+    base =+      [ pure AllYears+      , AtYear <$> QC.chooseInt (1970, 2199)+      ]+    genRange = do+      start <- QC.chooseInt (1970, 2199)+      end <- QC.chooseInt (start, 2199)+      pure (RangeYear start end)+    genStep = do+      start <- QC.chooseInt (1970, 2199)+      step <- QC.chooseInt (1, 40)+      pure (StepYear start step)+    genUnion depth = do+      let sub = max 0 depth+      left <- go sub+      right <- go sub+      pure (UnionYear left right)++invalidYear :: QC.Gen Int+invalidYear = QC.oneof [QC.chooseInt (1800, 1969), QC.chooseInt (2200, 2300)]++-- Helpers++isStepProgression :: Int -> Int -> [Int] -> Bool+isStepProgression _ _ [] = True+isStepProgression start step (x0 : rest) =+  x0 == start && all (== step) (consecutiveDiffs x0 rest)+  where+    consecutiveDiffs _ [] = []+    consecutiveDiffs prev (y : ys) = (y - prev) : consecutiveDiffs y ys

@@ -0,0 +1,27 @@+module Main (main) where++import qualified AWS.EventBridge.DayOfMonthSpec as DayOfMonthSpec+import qualified AWS.EventBridge.DayOfWeekSpec as DayOfWeekSpec+import qualified AWS.EventBridge.HoursSpec as HoursSpec+import qualified AWS.EventBridge.MinutesSpec as MinutesSpec+import qualified AWS.EventBridge.MonthsSpec as MonthsSpec+import qualified AWS.EventBridge.YearsSpec as YearsSpec+import qualified AWS.EventBridge.RateSpec as RateSpec+import qualified AWS.EventBridge.OneTimeSpec as OneTimeSpec+import qualified AWS.EventBridge.CronSpec as CronSpec+import Test.Tasty (defaultMain, testGroup)++main :: IO ()+main =+  defaultMain $+    testGroup "aws-eventbridge-cron"+      [ DayOfMonthSpec.tests+      , DayOfWeekSpec.tests+      , HoursSpec.tests+      , MinutesSpec.tests+      , MonthsSpec.tests+      , YearsSpec.tests+      , RateSpec.tests+      , OneTimeSpec.tests+      , CronSpec.tests+      ]

@@ -0,0 +1,44 @@+module TestSupport+  ( assertLeft+  , expectEvalWith+  , expectParseWith+  , expectEvalEquals+  , strictlyAscending+  , withinBoundsInt+  ) where++import Test.Tasty.HUnit (Assertion, assertFailure)++assertLeft :: Either String a -> Assertion+assertLeft e = case e of+  Left _  -> pure ()+  Right _ -> assertFailure "expected Left"++expectParseWith :: String -> (input -> Either String a) -> input -> IO a+expectParseWith label parser input =+  case parser input of+    Left err -> assertFailure (label <> " parse failed: " <> err)+    Right value -> pure value++expectEvalWith :: String -> (expr -> Either String result) -> expr -> IO result+expectEvalWith label evaluator expr =+  case evaluator expr of+    Left err -> assertFailure (label <> " evaluate failed: " <> err)+    Right value -> pure value++expectEvalEquals :: (Eq a, Show a) => [a] -> Either String [a] -> Assertion+expectEvalEquals expected evalResult =+  case evalResult of+    Left err   -> assertFailure err+    Right xs ->+      if xs == expected+        then pure ()+        else assertFailure ("expected " <> show expected <> ", got " <> show xs)++withinBoundsInt :: Int -> Int -> [Int] -> Bool+withinBoundsInt lo hi = all (\x -> x >= lo && x <= hi)++strictlyAscending :: Ord a => [a] -> Bool+strictlyAscending [] = True+strictlyAscending [_] = True+strictlyAscending (x : y : rest) = x < y && strictlyAscending (y : rest)