saturn-0.2.0.0: source/libraries/spec/Saturn/Unstable/MatchSpec.hs
module Saturn.Unstable.MatchSpec where
import qualified Data.Fixed as Fixed
import qualified Data.Time as Time
import qualified Data.Time.Calendar.WeekDate as Time
import qualified Saturn.Unstable.Match as Match
import qualified Saturn.Unstable.Type.ScheduleSpec as ScheduleSpec
import qualified Test.Hspec as Hspec
import qualified Test.QuickCheck as QuickCheck
spec :: Hspec.Spec
spec = Hspec.describe "Saturn.Unstable.Match" $ do
Hspec.describe "isMatch" $ do
Hspec.it "is always true with all wildcards"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch utcTime
Hspec.it "is true when day or weekday matches" $ do
s <- ScheduleSpec.new [] [] [[5]] [] [[5]]
t1 <- newUtcTime 1970 1 5 0 0 0
s `Hspec.shouldSatisfy` Match.isMatch t1
t2 <- newUtcTime 1970 1 2 0 0 0
s `Hspec.shouldSatisfy` Match.isMatch t2
Hspec.describe "minute" $ do
Hspec.it "is always true when a number matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [[5]] [] [] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)
Hspec.it "is always true when a range matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [[4, 5]] [] [] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)
Hspec.it "is always true when a choice matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [[4], [5]] [] [] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withMinute 5 utcTime)
Hspec.it "is true when a number matches" $ do
t <- newUtcTime 1970 1 1 0 5 0
s <- ScheduleSpec.new [[5]] [] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a number does not match" $ do
t <- newUtcTime 1970 1 1 0 6 0
s <- ScheduleSpec.new [[5]] [] [] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a range matches" $ do
t <- newUtcTime 1970 1 1 0 5 0
s <- ScheduleSpec.new [[4, 5]] [] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a range does not match" $ do
t <- newUtcTime 1970 1 1 0 6 0
s <- ScheduleSpec.new [[4, 5]] [] [] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a choice matches" $ do
t <- newUtcTime 1970 1 1 0 5 0
s <- ScheduleSpec.new [[4], [5]] [] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a choice does not match" $ do
t <- newUtcTime 1970 1 1 0 6 0
s <- ScheduleSpec.new [[4], [5]] [] [] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "accepts any second" $ do
t <- newUtcTime 1970 1 1 0 5 6
s <- ScheduleSpec.new [[5]] [] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any hour" $ do
t <- newUtcTime 1970 1 1 6 5 0
s <- ScheduleSpec.new [[5]] [] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any day" $ do
t <- newUtcTime 1970 1 6 0 5 0
s <- ScheduleSpec.new [[5]] [] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any month" $ do
t <- newUtcTime 1970 6 1 0 5 0
s <- ScheduleSpec.new [[5]] [] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.describe "hour" $ do
Hspec.it "is always true when a number matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [[5]] [] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)
Hspec.it "is always true when a range matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [[4, 5]] [] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)
Hspec.it "is always true when a choice matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [[4], [5]] [] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withHour 5 utcTime)
Hspec.it "is true when a number matches" $ do
t <- newUtcTime 1970 1 1 5 0 0
s <- ScheduleSpec.new [] [[5]] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a number does not match" $ do
t <- newUtcTime 1970 1 1 6 0 0
s <- ScheduleSpec.new [] [[5]] [] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a range matches" $ do
t <- newUtcTime 1970 1 1 5 0 0
s <- ScheduleSpec.new [] [[4, 5]] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a range does not match" $ do
t <- newUtcTime 1970 1 1 6 0 0
s <- ScheduleSpec.new [] [[4, 5]] [] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a choice matches" $ do
t <- newUtcTime 1970 1 1 5 0 0
s <- ScheduleSpec.new [] [[4], [5]] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a choice does not match" $ do
t <- newUtcTime 1970 1 1 6 0 0
s <- ScheduleSpec.new [] [[4], [5]] [] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "accepts any second" $ do
t <- newUtcTime 1970 1 1 5 0 6
s <- ScheduleSpec.new [] [[5]] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any minute" $ do
t <- newUtcTime 1970 1 1 5 6 0
s <- ScheduleSpec.new [] [[5]] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any day" $ do
t <- newUtcTime 1970 1 6 5 0 0
s <- ScheduleSpec.new [] [[5]] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any month" $ do
t <- newUtcTime 1970 6 1 5 0 0
s <- ScheduleSpec.new [] [[5]] [] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.describe "day" $ do
Hspec.it "is always true when a number matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [[5]] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)
Hspec.it "is always true when a range matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [[4, 5]] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)
Hspec.it "is always true when a choice matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [[4], [5]] [] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfMonth 5 utcTime)
Hspec.it "is true when a number matches" $ do
t <- newUtcTime 1970 1 5 0 0 0
s <- ScheduleSpec.new [] [] [[5]] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a number does not match" $ do
t <- newUtcTime 1970 1 6 0 0 0
s <- ScheduleSpec.new [] [] [[5]] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a range matches" $ do
t <- newUtcTime 1970 1 5 0 0 0
s <- ScheduleSpec.new [] [] [[4, 5]] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a range does not match" $ do
t <- newUtcTime 1970 1 6 0 0 0
s <- ScheduleSpec.new [] [] [[4, 5]] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a choice matches" $ do
t <- newUtcTime 1970 1 5 0 0 0
s <- ScheduleSpec.new [] [] [[4], [5]] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a choice does not match" $ do
t <- newUtcTime 1970 1 6 0 0 0
s <- ScheduleSpec.new [] [] [[4], [5]] [] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "accepts any second" $ do
t <- newUtcTime 1970 1 5 0 0 6
s <- ScheduleSpec.new [] [] [[5]] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any minute" $ do
t <- newUtcTime 1970 1 5 0 6 0
s <- ScheduleSpec.new [] [] [[5]] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any hour" $ do
t <- newUtcTime 1970 1 5 6 0 0
s <- ScheduleSpec.new [] [] [[5]] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any month" $ do
t <- newUtcTime 1970 6 5 0 0 0
s <- ScheduleSpec.new [] [] [[5]] [] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.describe "month" $ do
Hspec.it "is always true when a number matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [] [[5]] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)
Hspec.it "is always true when a range matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [] [[4, 5]] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)
Hspec.it "is always true when a choice matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [] [[4], [5]] []
schedule `Hspec.shouldSatisfy` Match.isMatch (withMonthOfYear 5 utcTime)
Hspec.it "is true when a number matches" $ do
t <- newUtcTime 1970 5 1 0 0 0
s <- ScheduleSpec.new [] [] [] [[5]] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a number does not match" $ do
t <- newUtcTime 1970 6 1 0 0 0
s <- ScheduleSpec.new [] [] [] [[5]] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a range matches" $ do
t <- newUtcTime 1970 5 1 0 0 0
s <- ScheduleSpec.new [] [] [] [[4, 5]] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a range does not match" $ do
t <- newUtcTime 1970 6 1 0 0 0
s <- ScheduleSpec.new [] [] [] [[4, 5]] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a choice matches" $ do
t <- newUtcTime 1970 5 1 0 0 0
s <- ScheduleSpec.new [] [] [] [[4], [5]] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a choice does not match" $ do
t <- newUtcTime 1970 6 1 0 0 0
s <- ScheduleSpec.new [] [] [] [[4], [5]] []
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "accepts any second" $ do
t <- newUtcTime 1970 5 1 0 0 6
s <- ScheduleSpec.new [] [] [] [[5]] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any minute" $ do
t <- newUtcTime 1970 5 1 0 6 0
s <- ScheduleSpec.new [] [] [] [[5]] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any hour" $ do
t <- newUtcTime 1970 5 1 6 0 0
s <- ScheduleSpec.new [] [] [] [[5]] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any day" $ do
t <- newUtcTime 1970 5 6 0 0 0
s <- ScheduleSpec.new [] [] [] [[5]] []
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.describe "weekday" $ do
Hspec.it "is always true when a number matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [] [] [[5]]
schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)
Hspec.it "is always true when a range matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [] [] [[4, 5]]
schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)
Hspec.it "is always true when a choice matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \utcTime -> do
schedule <- ScheduleSpec.new [] [] [] [] [[4], [5]]
schedule `Hspec.shouldSatisfy` Match.isMatch (withDayOfWeek Time.Friday utcTime)
Hspec.it "is true when a number matches" $ do
t <- newUtcTime 1970 1 2 0 0 0
s <- ScheduleSpec.new [] [] [] [] [[5]]
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a number does not match" $ do
t <- newUtcTime 1970 1 3 0 0 0
s <- ScheduleSpec.new [] [] [] [] [[5]]
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a range matches" $ do
t <- newUtcTime 1970 1 2 0 0 0
s <- ScheduleSpec.new [] [] [] [] [[4, 5]]
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a range does not match" $ do
t <- newUtcTime 1970 1 3 0 0 0
s <- ScheduleSpec.new [] [] [] [] [[4, 5]]
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "is true when a choice matches" $ do
t <- newUtcTime 1970 1 2 0 0 0
s <- ScheduleSpec.new [] [] [] [] [[4], [5]]
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "is false when a choice does not match" $ do
t <- newUtcTime 1970 1 3 0 0 0
s <- ScheduleSpec.new [] [] [] [] [[4], [5]]
s `Hspec.shouldNotSatisfy` Match.isMatch t
Hspec.it "accepts any second" $ do
t <- newUtcTime 1970 1 2 0 0 6
s <- ScheduleSpec.new [] [] [] [] [[5]]
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any minute" $ do
t <- newUtcTime 1970 1 2 0 6 0
s <- ScheduleSpec.new [] [] [] [] [[5]]
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any hour" $ do
t <- newUtcTime 1970 1 2 6 0 0
s <- ScheduleSpec.new [] [] [] [] [[5]]
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.it "accepts any day" $ do
t <- newUtcTime 1970 1 9 0 0 0
s <- ScheduleSpec.new [] [] [] [] [[5]]
s `Hspec.shouldSatisfy` Match.isMatch t
Hspec.describe "nextMatch" $ do
Hspec.it "succeeds with a leap day" $ do
s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []
t1 <- newUtcTime 1970 1 1 0 0 0
t2 <- newUtcTime 1972 2 29 0 0 0
Match.nextMatch t1 s `Hspec.shouldBe` Just t2
Hspec.it "succeeds with the next leap day" $ do
s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []
t1 <- newUtcTime 1972 2 29 0 0 0
t2 <- newUtcTime 1976 2 29 0 0 0
Match.nextMatch t1 s `Hspec.shouldBe` Just t2
Hspec.it "succeeds with the furthest leap day" $ do
s <- ScheduleSpec.new [[0]] [[0]] [[29]] [[2]] []
t1 <- newUtcTime 1896 2 29 0 0 0
t2 <- newUtcTime 1904 2 29 0 0 0
Match.nextMatch t1 s `Hspec.shouldBe` Just t2
Hspec.it "fails with an impossible date" $ do
s <- ScheduleSpec.new [[0]] [[0]] [[30]] [[2]] []
t <- newUtcTime 1970 1 1 0 0 0
Match.nextMatch t s `Hspec.shouldBe` Nothing
Hspec.it "is always in the future"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \t1 -> do
schedule <- ScheduleSpec.new [] [] [] [] []
t2 <- maybe (fail "impossible") pure $ Match.nextMatch t1 schedule
t2 `Hspec.shouldSatisfy` (>= t1)
Hspec.it "always matches"
. QuickCheck.forAllShrink arbitraryUtcTime shrinkUtcTime
$ \t1 -> do
schedule <- ScheduleSpec.new [] [] [] [] []
t2 <- maybe (fail "impossible") pure $ Match.nextMatch t1 schedule
schedule `Hspec.shouldSatisfy` Match.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
)
)