module SaturnSpec where import qualified Data.Either as Either import qualified Data.Fixed as Fixed import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Maybe as Maybe import qualified Data.Time as Time import qualified Data.Time.Calendar.WeekDate as Time import qualified Data.Word as Word import qualified Saturn import qualified Saturn.Unstable.Extra.Tuple as Tuple import qualified Saturn.Unstable.Type.Day as Day import qualified Saturn.Unstable.Type.Element as Element import qualified Saturn.Unstable.Type.Field as Field import qualified Saturn.Unstable.Type.Hour as Hour import qualified Saturn.Unstable.Type.Minute as Minute import qualified Saturn.Unstable.Type.Month as Month import qualified Saturn.Unstable.Type.Number as Number import qualified Saturn.Unstable.Type.Range as Range import qualified Saturn.Unstable.Type.Schedule as Schedule import qualified Saturn.Unstable.Type.Weekday as Weekday import qualified Saturn.Unstable.Type.Wildcard as Wildcard import qualified Test.Hspec as Hspec import qualified Test.QuickCheck as QuickCheck spec :: Hspec.Spec spec = Hspec.describe "Saturn" $ do Hspec.describe "round trips" $ do Hspec.it "through string" . QuickCheck.forAllShrink arbitrarySchedule shrinkSchedule $ \schedule -> Saturn.fromString (Saturn.toString schedule) `Hspec.shouldBe` Right schedule Hspec.it "through strict text" . QuickCheck.forAllShrink arbitrarySchedule shrinkSchedule $ \schedule -> Saturn.fromText (Saturn.toText schedule) `Hspec.shouldBe` Right schedule Hspec.it "through lazy text" . QuickCheck.forAllShrink arbitrarySchedule shrinkSchedule $ \schedule -> Saturn.fromLazyText (Saturn.toLazyText schedule) `Hspec.shouldBe` Right schedule Hspec.describe "fromString" $ do Hspec.it "accepts wildcards" $ do schedule <- newSchedule [] [] [] [] [] Saturn.fromString "* * * * *" `Hspec.shouldBe` Right schedule Hspec.it "accepts extra spaces" $ do schedule <- newSchedule [] [] [] [] [] Saturn.fromString " * * * * * " `Hspec.shouldBe` Right schedule Hspec.it "accepts numbers" $ do schedule <- newSchedule [[4]] [[3]] [[2]] [[1]] [[0]] Saturn.fromString "4 3 2 1 0" `Hspec.shouldBe` Right schedule Hspec.it "accepts ranges" $ do schedule <- newSchedule [[8, 9]] [[6, 7]] [[4, 5]] [[2, 3]] [[0, 1]] Saturn.fromString "8-9 6-7 4-5 2-3 0-1" `Hspec.shouldBe` Right schedule Hspec.it "accepts choices" $ do schedule <- newSchedule [[8], [9]] [[6], [7]] [[4], [5]] [[2], [3]] [[0], [1]] Saturn.fromString "8,9 6,7 4,5 2,3 0,1" `Hspec.shouldBe` Right schedule Hspec.describe "minute" $ do Hspec.it "accepts a number" $ do schedule <- newSchedule [[0]] [] [] [] [] Saturn.fromString "0 * * * *" `Hspec.shouldBe` Right schedule Hspec.it "accepts a range" $ do schedule <- newSchedule [[0, 1]] [] [] [] [] Saturn.fromString "0-1 * * * *" `Hspec.shouldBe` Right schedule Hspec.it "accepts a choice" $ do schedule <- newSchedule [[0], [1]] [] [] [] [] Saturn.fromString "0,1 * * * *" `Hspec.shouldBe` Right schedule Hspec.it "rejects two wildcards" $ do Saturn.fromString "*,* * * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a number" $ do Saturn.fromString "*,0 * * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a range" $ do Saturn.fromString "*,0-0 * * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number" $ do Saturn.fromString "60 * * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number as part of a choice" $ do Saturn.fromString "0,60 * * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds range" $ do Saturn.fromString "60-61 * * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a half out of bounds range" $ do Saturn.fromString "0-60 * * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a backwards range" $ do Saturn.fromString "1-0 * * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.describe "hour" $ do Hspec.it "accepts a number" $ do schedule <- newSchedule [] [[0]] [] [] [] Saturn.fromString "* 0 * * *" `Hspec.shouldBe` Right schedule Hspec.it "accepts a range" $ do schedule <- newSchedule [] [[0, 1]] [] [] [] Saturn.fromString "* 0-1 * * *" `Hspec.shouldBe` Right schedule Hspec.it "accepts a choice" $ do schedule <- newSchedule [] [[0], [1]] [] [] [] Saturn.fromString "* 0,1 * * *" `Hspec.shouldBe` Right schedule Hspec.it "rejects two wildcards" $ do Saturn.fromString "* *,* * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a number" $ do Saturn.fromString "* *,0 * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a range" $ do Saturn.fromString "* *,0-0 * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number" $ do Saturn.fromString "* 24 * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number as part of a choice" $ do Saturn.fromString "* 0,24 * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds range" $ do Saturn.fromString "* 24-25 * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a half out of bounds range" $ do Saturn.fromString "* 0-24 * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a backwards range" $ do Saturn.fromString "* 1-0 * * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.describe "day" $ do Hspec.it "accepts a number" $ do schedule <- newSchedule [] [] [[1]] [] [] Saturn.fromString "* * 1 * *" `Hspec.shouldBe` Right schedule Hspec.it "accepts a range" $ do schedule <- newSchedule [] [] [[1, 2]] [] [] Saturn.fromString "* * 1-2 * *" `Hspec.shouldBe` Right schedule Hspec.it "accepts a choice" $ do schedule <- newSchedule [] [] [[1], [2]] [] [] Saturn.fromString "* * 1,2 * *" `Hspec.shouldBe` Right schedule Hspec.it "rejects two wildcards" $ do Saturn.fromString "* * *,* * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a number" $ do Saturn.fromString "* * *,1 * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a range" $ do Saturn.fromString "* * *,1-1 * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number" $ do Saturn.fromString "* * 32 * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number as part of a choice" $ do Saturn.fromString "* * 1,32 * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds range" $ do Saturn.fromString "* * 32-33 * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a half out of bounds range" $ do Saturn.fromString "* * 1-32 * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a backwards range" $ do Saturn.fromString "* * 2-1 * *" `Hspec.shouldSatisfy` Either.isLeft Hspec.describe "month" $ do Hspec.it "accepts a number" $ do schedule <- newSchedule [] [] [] [[1]] [] Saturn.fromString "* * * 1 *" `Hspec.shouldBe` Right schedule Hspec.it "accepts a range" $ do schedule <- newSchedule [] [] [] [[1, 2]] [] Saturn.fromString "* * * 1-2 *" `Hspec.shouldBe` Right schedule Hspec.it "accepts a choice" $ do schedule <- newSchedule [] [] [] [[1], [2]] [] Saturn.fromString "* * * 1,2 *" `Hspec.shouldBe` Right schedule Hspec.it "rejects two wildcards" $ do Saturn.fromString "* * * *,* *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a number" $ do Saturn.fromString "* * * *,1 *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a range" $ do Saturn.fromString "* * * *,1-1 *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number" $ do Saturn.fromString "* * * 13 *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number as part of a choice" $ do Saturn.fromString "* * * 1,13 *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds range" $ do Saturn.fromString "* * * 13-14 *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a half out of bounds range" $ do Saturn.fromString "* * * 1-13 *" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a backwards range" $ do Saturn.fromString "* * * 2-1 *" `Hspec.shouldSatisfy` Either.isLeft Hspec.describe "weekday" $ do Hspec.it "accepts a number" $ do schedule <- newSchedule [] [] [] [] [[0]] Saturn.fromString "* * * * 0" `Hspec.shouldBe` Right schedule Hspec.it "accepts a range" $ do schedule <- newSchedule [] [] [] [] [[0, 1]] Saturn.fromString "* * * * 0-1" `Hspec.shouldBe` Right schedule Hspec.it "accepts a choice" $ do schedule <- newSchedule [] [] [] [] [[0], [1]] Saturn.fromString "* * * * 0,1" `Hspec.shouldBe` Right schedule Hspec.it "rejects two wildcards" $ do Saturn.fromString "* * * * *,*" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a number" $ do Saturn.fromString "* * * * *,0" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a wildcard and a range" $ do Saturn.fromString "* * * * *,0-0" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number" $ do Saturn.fromString "* * * * 7" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds number as part of a choice" $ do Saturn.fromString "* * * * 0,7" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects an out of bounds range" $ do Saturn.fromString "* * * * 7-8" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a half out of bounds range" $ do Saturn.fromString "* * * * 0-7" `Hspec.shouldSatisfy` Either.isLeft Hspec.it "rejects a backwards range" $ do Saturn.fromString "* * * * 1-0" `Hspec.shouldSatisfy` Either.isLeft Hspec.describe "toString" $ do Hspec.it "works with wildcards" $ do schedule <- newSchedule [] [] [] [] [] Saturn.toString schedule `Hspec.shouldBe` "* * * * *" Hspec.it "works with numbers" $ do schedule <- newSchedule [[4]] [[3]] [[2]] [[1]] [[0]] Saturn.toString schedule `Hspec.shouldBe` "4 3 2 1 0" Hspec.it "works with ranges" $ do schedule <- newSchedule [[8, 9]] [[6, 7]] [[4, 5]] [[2, 3]] [[0, 1]] Saturn.toString schedule `Hspec.shouldBe` "8-9 6-7 4-5 2-3 0-1" Hspec.it "works with choices" $ do schedule <- newSchedule [[8], [9]] [[6], [7]] [[4], [5]] [[2], [3]] [[0], [1]] Saturn.toString schedule `Hspec.shouldBe` "8,9 6,7 4,5 2,3 0,1" Hspec.describe "isMatch" $ do Hspec.it "is always true with all wildcards" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch utcTime Hspec.it "is true when day or weekday matches" $ do s <- newSchedule [] [] [[5]] [] [[5]] t1 <- newUtcTime 1970 1 5 0 0 0 s `Hspec.shouldSatisfy` Saturn.isMatch t1 t2 <- newUtcTime 1970 1 2 0 0 0 s `Hspec.shouldSatisfy` Saturn.isMatch t2 Hspec.describe "minute" $ do Hspec.it "is always true when a number matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [[5]] [] [] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withMinute 5 utcTime) Hspec.it "is always true when a range matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [[4, 5]] [] [] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withMinute 5 utcTime) Hspec.it "is always true when a choice matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [[4], [5]] [] [] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withMinute 5 utcTime) Hspec.it "is true when a number matches" $ do t <- newUtcTime 1970 1 1 0 5 0 s <- newSchedule [[5]] [] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a number does not match" $ do t <- newUtcTime 1970 1 1 0 6 0 s <- newSchedule [[5]] [] [] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a range matches" $ do t <- newUtcTime 1970 1 1 0 5 0 s <- newSchedule [[4, 5]] [] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a range does not match" $ do t <- newUtcTime 1970 1 1 0 6 0 s <- newSchedule [[4, 5]] [] [] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a choice matches" $ do t <- newUtcTime 1970 1 1 0 5 0 s <- newSchedule [[4], [5]] [] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a choice does not match" $ do t <- newUtcTime 1970 1 1 0 6 0 s <- newSchedule [[4], [5]] [] [] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "accepts any second" $ do t <- newUtcTime 1970 1 1 0 5 6 s <- newSchedule [[5]] [] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any hour" $ do t <- newUtcTime 1970 1 1 6 5 0 s <- newSchedule [[5]] [] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any day" $ do t <- newUtcTime 1970 1 6 0 5 0 s <- newSchedule [[5]] [] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any month" $ do t <- newUtcTime 1970 6 1 0 5 0 s <- newSchedule [[5]] [] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.describe "hour" $ do Hspec.it "is always true when a number matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [[5]] [] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withHour 5 utcTime) Hspec.it "is always true when a range matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [[4, 5]] [] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withHour 5 utcTime) Hspec.it "is always true when a choice matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [[4], [5]] [] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withHour 5 utcTime) Hspec.it "is true when a number matches" $ do t <- newUtcTime 1970 1 1 5 0 0 s <- newSchedule [] [[5]] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a number does not match" $ do t <- newUtcTime 1970 1 1 6 0 0 s <- newSchedule [] [[5]] [] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a range matches" $ do t <- newUtcTime 1970 1 1 5 0 0 s <- newSchedule [] [[4, 5]] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a range does not match" $ do t <- newUtcTime 1970 1 1 6 0 0 s <- newSchedule [] [[4, 5]] [] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a choice matches" $ do t <- newUtcTime 1970 1 1 5 0 0 s <- newSchedule [] [[4], [5]] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a choice does not match" $ do t <- newUtcTime 1970 1 1 6 0 0 s <- newSchedule [] [[4], [5]] [] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "accepts any second" $ do t <- newUtcTime 1970 1 1 5 0 6 s <- newSchedule [] [[5]] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any minute" $ do t <- newUtcTime 1970 1 1 5 6 0 s <- newSchedule [] [[5]] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any day" $ do t <- newUtcTime 1970 1 6 5 0 0 s <- newSchedule [] [[5]] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any month" $ do t <- newUtcTime 1970 6 1 5 0 0 s <- newSchedule [] [[5]] [] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.describe "day" $ do Hspec.it "is always true when a number matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [[5]] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withDayOfMonth 5 utcTime) Hspec.it "is always true when a range matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [[4, 5]] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withDayOfMonth 5 utcTime) Hspec.it "is always true when a choice matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [[4], [5]] [] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withDayOfMonth 5 utcTime) Hspec.it "is true when a number matches" $ do t <- newUtcTime 1970 1 5 0 0 0 s <- newSchedule [] [] [[5]] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a number does not match" $ do t <- newUtcTime 1970 1 6 0 0 0 s <- newSchedule [] [] [[5]] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a range matches" $ do t <- newUtcTime 1970 1 5 0 0 0 s <- newSchedule [] [] [[4, 5]] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a range does not match" $ do t <- newUtcTime 1970 1 6 0 0 0 s <- newSchedule [] [] [[4, 5]] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a choice matches" $ do t <- newUtcTime 1970 1 5 0 0 0 s <- newSchedule [] [] [[4], [5]] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a choice does not match" $ do t <- newUtcTime 1970 1 6 0 0 0 s <- newSchedule [] [] [[4], [5]] [] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "accepts any second" $ do t <- newUtcTime 1970 1 5 0 0 6 s <- newSchedule [] [] [[5]] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any minute" $ do t <- newUtcTime 1970 1 5 0 6 0 s <- newSchedule [] [] [[5]] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any hour" $ do t <- newUtcTime 1970 1 5 6 0 0 s <- newSchedule [] [] [[5]] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any month" $ do t <- newUtcTime 1970 6 5 0 0 0 s <- newSchedule [] [] [[5]] [] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.describe "month" $ do Hspec.it "is always true when a number matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [] [[5]] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withMonthOfYear 5 utcTime) Hspec.it "is always true when a range matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [] [[4, 5]] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withMonthOfYear 5 utcTime) Hspec.it "is always true when a choice matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [] [[4], [5]] [] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withMonthOfYear 5 utcTime) Hspec.it "is true when a number matches" $ do t <- newUtcTime 1970 5 1 0 0 0 s <- newSchedule [] [] [] [[5]] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a number does not match" $ do t <- newUtcTime 1970 6 1 0 0 0 s <- newSchedule [] [] [] [[5]] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a range matches" $ do t <- newUtcTime 1970 5 1 0 0 0 s <- newSchedule [] [] [] [[4, 5]] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a range does not match" $ do t <- newUtcTime 1970 6 1 0 0 0 s <- newSchedule [] [] [] [[4, 5]] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a choice matches" $ do t <- newUtcTime 1970 5 1 0 0 0 s <- newSchedule [] [] [] [[4], [5]] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a choice does not match" $ do t <- newUtcTime 1970 6 1 0 0 0 s <- newSchedule [] [] [] [[4], [5]] [] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "accepts any second" $ do t <- newUtcTime 1970 5 1 0 0 6 s <- newSchedule [] [] [] [[5]] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any minute" $ do t <- newUtcTime 1970 5 1 0 6 0 s <- newSchedule [] [] [] [[5]] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any hour" $ do t <- newUtcTime 1970 5 1 6 0 0 s <- newSchedule [] [] [] [[5]] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any day" $ do t <- newUtcTime 1970 5 6 0 0 0 s <- newSchedule [] [] [] [[5]] [] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.describe "weekday" $ do Hspec.it "is always true when a number matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [] [] [[5]] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withDayOfWeek Time.Friday utcTime) Hspec.it "is always true when a range matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [] [] [[4, 5]] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withDayOfWeek Time.Friday utcTime) Hspec.it "is always true when a choice matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \utcTime -> do schedule <- newSchedule [] [] [] [] [[4], [5]] schedule `Hspec.shouldSatisfy` Saturn.isMatch (withDayOfWeek Time.Friday utcTime) Hspec.it "is true when a number matches" $ do t <- newUtcTime 1970 1 2 0 0 0 s <- newSchedule [] [] [] [] [[5]] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a number does not match" $ do t <- newUtcTime 1970 1 3 0 0 0 s <- newSchedule [] [] [] [] [[5]] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a range matches" $ do t <- newUtcTime 1970 1 2 0 0 0 s <- newSchedule [] [] [] [] [[4, 5]] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a range does not match" $ do t <- newUtcTime 1970 1 3 0 0 0 s <- newSchedule [] [] [] [] [[4, 5]] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "is true when a choice matches" $ do t <- newUtcTime 1970 1 2 0 0 0 s <- newSchedule [] [] [] [] [[4], [5]] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "is false when a choice does not match" $ do t <- newUtcTime 1970 1 3 0 0 0 s <- newSchedule [] [] [] [] [[4], [5]] s `Hspec.shouldNotSatisfy` Saturn.isMatch t Hspec.it "accepts any second" $ do t <- newUtcTime 1970 1 2 0 0 6 s <- newSchedule [] [] [] [] [[5]] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any minute" $ do t <- newUtcTime 1970 1 2 0 6 0 s <- newSchedule [] [] [] [] [[5]] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any hour" $ do t <- newUtcTime 1970 1 2 6 0 0 s <- newSchedule [] [] [] [] [[5]] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.it "accepts any day" $ do t <- newUtcTime 1970 1 9 0 0 0 s <- newSchedule [] [] [] [] [[5]] s `Hspec.shouldSatisfy` Saturn.isMatch t Hspec.describe "nextMatch" $ do Hspec.it "succeeds with a leap day" $ do s <- newSchedule [[0]] [[0]] [[29]] [[2]] [] t1 <- newUtcTime 1970 1 1 0 0 0 t2 <- newUtcTime 1972 2 29 0 0 0 Saturn.nextMatch t1 s `Hspec.shouldBe` Just t2 Hspec.it "succeeds with the next leap day" $ do s <- newSchedule [[0]] [[0]] [[29]] [[2]] [] t1 <- newUtcTime 1972 2 29 0 0 0 t2 <- newUtcTime 1976 2 29 0 0 0 Saturn.nextMatch t1 s `Hspec.shouldBe` Just t2 Hspec.it "succeeds with the furthest leap day" $ do s <- newSchedule [[0]] [[0]] [[29]] [[2]] [] t1 <- newUtcTime 1896 2 29 0 0 0 t2 <- newUtcTime 1904 2 29 0 0 0 Saturn.nextMatch t1 s `Hspec.shouldBe` Just t2 Hspec.it "fails with an impossible date" $ do s <- newSchedule [[0]] [[0]] [[30]] [[2]] [] t <- newUtcTime 1970 1 1 0 0 0 Saturn.nextMatch t s `Hspec.shouldBe` Nothing Hspec.it "is always in the future" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \t1 -> do schedule <- newSchedule [] [] [] [] [] t2 <- maybe (fail "impossible") pure $ Saturn.nextMatch t1 schedule t2 `Hspec.shouldSatisfy` (>= t1) Hspec.it "always matches" . QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime $ \t1 -> do schedule <- newSchedule [] [] [] [] [] t2 <- maybe (fail "impossible") pure $ Saturn.nextMatch t1 schedule schedule `Hspec.shouldSatisfy` Saturn.isMatch t2 withMinute :: Int -> Time.UTCTime -> Time.UTCTime withMinute minute = overTimeOfDay $ \timeOfDay -> timeOfDay {Time.todMin = minute} withHour :: Int -> Time.UTCTime -> Time.UTCTime withHour hour = overTimeOfDay $ \timeOfDay -> timeOfDay {Time.todHour = hour} overTimeOfDay :: (Time.TimeOfDay -> Time.TimeOfDay) -> Time.UTCTime -> Time.UTCTime overTimeOfDay f utcTime = utcTime { Time.utctDayTime = Time.sinceMidnight . f . Time.pastMidnight $ Time.utctDayTime utcTime } withDayOfMonth :: Time.DayOfMonth -> Time.UTCTime -> Time.UTCTime withDayOfMonth dayOfMonth = overDay $ \day -> let (year, monthOfYear, _) = Time.toGregorian day in Time.fromGregorian year monthOfYear dayOfMonth withMonthOfYear :: Time.MonthOfYear -> Time.UTCTime -> Time.UTCTime withMonthOfYear monthOfYear = overDay $ \day -> let (year, _, dayOfMonth) = Time.toGregorian day in Time.fromGregorian year monthOfYear dayOfMonth withDayOfWeek :: Time.DayOfWeek -> Time.UTCTime -> Time.UTCTime withDayOfWeek dayOfWeek = overDay $ \day -> let fwt = Time.FirstWholeWeek dow = Time.Sunday (year, weekOfYear, _) = Time.toWeekCalendar fwt dow day in Time.fromWeekCalendar fwt dow year weekOfYear dayOfWeek overDay :: (Time.Day -> Time.Day) -> Time.UTCTime -> Time.UTCTime overDay f utcTime = utcTime {Time.utctDay = f $ Time.utctDay utcTime} newUtcTime :: (MonadFail m) => Time.Year -> Time.MonthOfYear -> Time.DayOfMonth -> Int -> Int -> Fixed.Pico -> m Time.UTCTime newUtcTime year monthOfYear dayOfMonth hour minute second = do day <- maybe (fail "invalid Day") pure $ Time.fromGregorianValid year monthOfYear dayOfMonth timeOfDay <- maybe (fail "invalid TimeOfDay") pure $ Time.makeTimeOfDayValid hour minute second pure Time.UTCTime { Time.utctDay = day, Time.utctDayTime = Time.sinceMidnight timeOfDay } arbitraryUtcTime :: QuickCheck.Gen Time.UTCTime arbitraryUtcTime = Time.UTCTime <$> fmap Time.ModifiedJulianDay QuickCheck.arbitrary <*> fmap Time.picosecondsToDiffTime (QuickCheck.chooseInteger (0, 86400000000000000 - 1)) shrinkUtcTime :: Time.UTCTime -> [Time.UTCTime] shrinkUtcTime = QuickCheck.shrinkMap ( \(d, t) -> Time.UTCTime { Time.utctDay = Time.ModifiedJulianDay d, Time.utctDayTime = Time.picosecondsToDiffTime t } ) ( \x -> ( Time.toModifiedJulianDay $ Time.utctDay x, Time.diffTimeToPicoseconds $ Time.utctDayTime x ) ) newSchedule :: (MonadFail m) => [[Word.Word8]] -> [[Word.Word8]] -> [[Word.Word8]] -> [[Word.Word8]] -> [[Word.Word8]] -> m Schedule.Schedule newSchedule minutes hours days months weekdays = Schedule.Schedule <$> newFieldWith "Minute" Minute.fromField minutes <*> newFieldWith "Hour" Hour.fromField hours <*> newFieldWith "Day" Day.fromField days <*> newFieldWith "Month" Month.fromField months <*> newFieldWith "Weekday" Weekday.fromField weekdays newFieldWith :: (MonadFail m) => String -> (Field.Field -> Maybe a) -> [[Word.Word8]] -> m a newFieldWith name fromField xs = do field <- newField xs maybe (fail $ "invalid " <> name <> ": " <> show xs) pure $ fromField field newField :: (MonadFail m) => [[Word.Word8]] -> m Field.Field newField = fmap ( Field.fromEither . maybe (Left $ Wildcard.fromUnit ()) Right . NonEmpty.nonEmpty ) . mapM newElement newElement :: (MonadFail m) => [Word.Word8] -> m Element.Element newElement xs = case xs of [x] -> pure . Element.fromEither . Right $ Number.fromWord8 x [x, y] -> Element.fromEither . Left <$> newRange (x, y) _ -> fail $ "invalid Element: " <> show xs newRange :: (MonadFail m) => (Word.Word8, Word.Word8) -> m Range.Range newRange tuple = maybe (fail $ "invalid Range: " <> show tuple) pure . Range.fromTuple $ Tuple.mapBoth Number.fromWord8 tuple arbitrarySchedule :: QuickCheck.Gen Schedule.Schedule arbitrarySchedule = Schedule.Schedule <$> arbitraryMinute <*> arbitraryHour <*> arbitraryDay <*> arbitraryMonth <*> arbitraryWeekday arbitraryMinute :: QuickCheck.Gen Minute.Minute arbitraryMinute = QuickCheck.suchThatMap arbitraryField Minute.fromField arbitraryHour :: QuickCheck.Gen Hour.Hour arbitraryHour = QuickCheck.suchThatMap arbitraryField Hour.fromField arbitraryDay :: QuickCheck.Gen Day.Day arbitraryDay = QuickCheck.suchThatMap arbitraryField Day.fromField arbitraryMonth :: QuickCheck.Gen Month.Month arbitraryMonth = QuickCheck.suchThatMap arbitraryField Month.fromField arbitraryWeekday :: QuickCheck.Gen Weekday.Weekday arbitraryWeekday = QuickCheck.suchThatMap arbitraryField Weekday.fromField arbitraryField :: QuickCheck.Gen Field.Field arbitraryField = Field.fromEither <$> QuickCheck.liftArbitrary2 arbitraryWildcard (arbitraryNonEmpty arbitraryElement) arbitraryWildcard :: QuickCheck.Gen Wildcard.Wildcard arbitraryWildcard = pure $ Wildcard.fromUnit () arbitraryNonEmpty :: QuickCheck.Gen a -> QuickCheck.Gen (NonEmpty.NonEmpty a) arbitraryNonEmpty g = (NonEmpty.:|) <$> g <*> QuickCheck.listOf g arbitraryElement :: QuickCheck.Gen Element.Element arbitraryElement = Element.fromEither <$> QuickCheck.liftArbitrary2 arbitraryRange arbitraryNumber arbitraryRange :: QuickCheck.Gen Range.Range arbitraryRange = QuickCheck.suchThatMap (QuickCheck.liftArbitrary2 arbitraryNumber arbitraryNumber) Range.fromTuple arbitraryNumber :: QuickCheck.Gen Number.Number arbitraryNumber = Number.fromWord8 <$> QuickCheck.arbitrary shrinkSchedule :: Schedule.Schedule -> [Schedule.Schedule] shrinkSchedule schedule = ( \(minute, hour, day, month, weekday) -> Schedule.Schedule { Schedule.minute = minute, Schedule.hour = hour, Schedule.day = day, Schedule.month = month, Schedule.weekday = weekday } ) <$> liftShrink5 shrinkMinute shrinkHour shrinkDay shrinkMonth shrinkWeekday ( Schedule.minute schedule, Schedule.hour schedule, Schedule.day schedule, Schedule.month schedule, Schedule.weekday schedule ) liftShrink5 :: (t1 -> [t1]) -> (t2 -> [t2]) -> (t3 -> [t3]) -> (t4 -> [t4]) -> (t5 -> [t5]) -> (t1, t2, t3, t4, t5) -> [(t1, t2, t3, t4, t5)] liftShrink5 f1 f2 f3 f4 f5 (x1, x2, x3, x4, x5) = (\((y1, y2), (y3, (y4, y5))) -> (y1, y2, y3, y4, y5)) <$> QuickCheck.liftShrink2 (QuickCheck.liftShrink2 f1 f2) (QuickCheck.liftShrink2 f3 (QuickCheck.liftShrink2 f4 f5)) ((x1, x2), (x3, (x4, x5))) shrinkMinute :: Minute.Minute -> [Minute.Minute] shrinkMinute = Maybe.mapMaybe Minute.fromField . shrinkField . Minute.toField shrinkHour :: Hour.Hour -> [Hour.Hour] shrinkHour = Maybe.mapMaybe Hour.fromField . shrinkField . Hour.toField shrinkDay :: Day.Day -> [Day.Day] shrinkDay = Maybe.mapMaybe Day.fromField . shrinkField . Day.toField shrinkMonth :: Month.Month -> [Month.Month] shrinkMonth = Maybe.mapMaybe Month.fromField . shrinkField . Month.toField shrinkWeekday :: Weekday.Weekday -> [Weekday.Weekday] shrinkWeekday = Maybe.mapMaybe Weekday.fromField . shrinkField . Weekday.toField shrinkField :: Field.Field -> [Field.Field] shrinkField field = let xs = case Field.toEither field of Left _ -> [] Right _ -> [Field.fromEither . Left $ Wildcard.fromUnit ()] in mappend xs . fmap Field.fromEither . QuickCheck.liftShrink2 shrinkWildcard (shrinkNonEmpty shrinkElement) $ Field.toEither field shrinkWildcard :: Wildcard.Wildcard -> [Wildcard.Wildcard] shrinkWildcard = fmap Wildcard.fromUnit . QuickCheck.shrink . Wildcard.toUnit shrinkNonEmpty :: (a -> [a]) -> NonEmpty.NonEmpty a -> [NonEmpty.NonEmpty a] shrinkNonEmpty f = Maybe.mapMaybe (NonEmpty.nonEmpty . f) . NonEmpty.toList shrinkElement :: Element.Element -> [Element.Element] shrinkElement element = let xs = case Element.toEither element of Left range -> let (lo, hi) = Range.toTuple range in fmap (Element.fromEither . Right) [lo, hi] Right _ -> [] in mappend xs . fmap Element.fromEither . QuickCheck.liftShrink2 shrinkRange shrinkNumber $ Element.toEither element shrinkRange :: Range.Range -> [Range.Range] shrinkRange = Maybe.mapMaybe Range.fromTuple . QuickCheck.liftShrink2 shrinkNumber shrinkNumber . Range.toTuple shrinkNumber :: Number.Number -> [Number.Number] shrinkNumber = fmap Number.fromWord8 . QuickCheck.shrink . Number.toWord8