fuzzy-time-gen-0.2.0.1: test/Data/FuzzyTime/ResolveSpec.hs
module Data.FuzzyTime.ResolveSpec
( spec,
)
where
import Data.FuzzyTime.Resolve
import Data.FuzzyTime.Types
import Data.FuzzyTime.Types.Gen ()
import Data.Time
import Test.Hspec
import Test.QuickCheck
import Test.Validity
spec :: Spec
spec = do
describe "resolveLocalTime" $ do
it "produces valid local times" $ producesValid2 resolveLocalTime
it "works the same as resolveLocalTimeOne" $
forAllValid $
\lt ->
forAllValid $ \fd ->
resolveLocalTime lt (FuzzyLocalTime (One fd))
`shouldBe` OnlyDaySpecified (resolveLocalTimeOne lt fd)
it "works the same as resolveLocalTimeOther" $
forAllValid $
\lt ->
forAllValid $ \ftod ->
resolveLocalTime lt (FuzzyLocalTime (Other ftod))
`shouldBe` BothTimeAndDay (resolveLocalTimeOther lt ftod)
it "works the same as resolveLocalTimeBoth" $
forAllValid $
\lt ->
forAllValid $ \fd ->
forAllValid $ \ftod ->
resolveLocalTime lt (FuzzyLocalTime (Both fd ftod))
`shouldBe` BothTimeAndDay (resolveLocalTimeBoth lt fd ftod)
describe "resolveLocalTimeOther" $ do
it "works for unspecified noon, before noon" $
forAllValid $
\ld ->
forAll (genValid `suchThat` (< midday)) $ \tod ->
resolveLocalTimeOther (LocalTime ld tod) Noon `shouldBe` LocalTime ld midday
it "works for unspecified noon, after noon" $
forAllValid $
\ld ->
forAll (genValid `suchThat` (>= midday)) $ \tod ->
resolveLocalTimeOther (LocalTime ld tod) Noon `shouldBe` LocalTime (addDays 1 ld) midday
it "works for unspecified midnight" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeOther (LocalTime ld tod) Midnight
`shouldBe` LocalTime (addDays 1 ld) midnight
it "works for unspecified morning, before morning" $
forAllValid $
\ld ->
forAll (genValid `suchThat` (< morning)) $ \tod ->
resolveLocalTimeOther (LocalTime ld tod) Morning `shouldBe` LocalTime ld morning
it "works for unspecified morning, after morning" $
forAllValid $
\ld ->
forAll (genValid `suchThat` (>= morning)) $ \tod ->
resolveLocalTimeOther (LocalTime ld tod) Morning
`shouldBe` LocalTime (addDays 1 ld) morning
it "works for unspecified evening, before evening" $
forAllValid $
\ld ->
forAll (genValid `suchThat` (< evening)) $ \tod ->
resolveLocalTimeOther (LocalTime ld tod) Evening `shouldBe` LocalTime ld evening
it "works for unspecified evening, after evening" $
forAllValid $
\ld ->
forAll (genValid `suchThat` (>= evening)) $ \tod ->
resolveLocalTimeOther (LocalTime ld tod) Evening
`shouldBe` LocalTime (addDays 1 ld) evening
describe "resolveLocalTimeBoth" $ do
describe "SameTime" $ do
it "works like resolveDay if the fuzzy time of day is SameTime" $
forAllValid $
\lt@(LocalTime ld tod) ->
forAllValid $ \fd ->
resolveLocalTimeBoth lt fd SameTime `shouldBe` LocalTime (resolveDay ld fd) tod
describe "Yesterday" $ do
it "works without diff" $
forAllValid $
\lt@(LocalTime ld ltod) ->
forAllValid $ \ftod ->
resolveLocalTimeBoth lt Yesterday ftod
`shouldBe` LocalTime (resolveDay ld Yesterday) (resolveTimeOfDay ltod ftod)
it "works for noon yesterday" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeBoth (LocalTime ld tod) Yesterday Noon
`shouldBe` LocalTime (addDays (-1) ld) midday
it "works for midnight yesterday" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeBoth (LocalTime ld tod) Yesterday Midnight
`shouldBe` LocalTime (addDays (-1) ld) midnight
it "works for morning yesterday" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeBoth (LocalTime ld tod) Yesterday Morning
`shouldBe` LocalTime (addDays (-1) ld) morning
it "works for evening yesterday" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeBoth (LocalTime ld tod) Yesterday Evening
`shouldBe` LocalTime (addDays (-1) ld) evening
describe "Tomorrow" $ do
it "works without diff" $
forAllValid $
\lt@(LocalTime ld ltod) ->
forAllValid $ \ftod ->
resolveLocalTimeBoth lt Tomorrow ftod
`shouldBe` LocalTime (resolveDay ld Tomorrow) (resolveTimeOfDay ltod ftod)
it "works for noon tomorrow" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeBoth (LocalTime ld tod) Tomorrow Noon
`shouldBe` LocalTime (addDays 1 ld) midday
it "works for midnight tomorrow" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeBoth (LocalTime ld tod) Tomorrow Midnight
`shouldBe` LocalTime (addDays 1 ld) midnight
it "works for morning tomorrow" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeBoth (LocalTime ld tod) Tomorrow Morning
`shouldBe` LocalTime (addDays 1 ld) morning
it "works for evening tomorrow" $
forAllValid $
\ld ->
forAllValid $ \tod ->
resolveLocalTimeBoth (LocalTime ld tod) Tomorrow Evening
`shouldBe` LocalTime (addDays 1 ld) evening
describe "normaliseTimeOfDay" $ do
it "produces valid times of day" $ producesValid3 normaliseTimeOfDay
it "works for this example of tomorrow" $
normaliseTimeOfDay 25 0 0 `shouldBe` (1, TimeOfDay 1 0 0)
it "works for this example of tomorrow" $
normaliseTimeOfDay 23 120 0 `shouldBe` (1, TimeOfDay 1 0 0)
it "works for this example of tomorrow" $
normaliseTimeOfDay 23 0 7200 `shouldBe` (1, TimeOfDay 1 0 0)
it "works for this example of tomorrow" $
normaliseTimeOfDay 23 120 7200 `shouldBe` (1, TimeOfDay 3 0 0)
it "works for this example of yesterday" $
normaliseTimeOfDay (-1) 0 0 `shouldBe` (-1, TimeOfDay 23 0 0)
it "works for this example of yesterday" $
normaliseTimeOfDay 0 (-1) 0 `shouldBe` (-1, TimeOfDay 23 59 0)
it "works for this example of yesterday" $
normaliseTimeOfDay 0 0 (-1) `shouldBe` (-1, TimeOfDay 23 59 59)
it "works for this example of yesterday" $
normaliseTimeOfDay 0 0 (-0.01) `shouldBe` (-1, TimeOfDay 23 59 59.99)
it "works for this example of yesterday" $
normaliseTimeOfDay 0 0 (-0.00001) `shouldBe` (-1, TimeOfDay 23 59 59.99999)
it "works for this example of yesterday" $
normaliseTimeOfDay 0 0 (-0.00000001) `shouldBe` (-1, TimeOfDay 23 59 59.99999999)
it "does something sensible with leap seconds" $
normaliseTimeOfDay 23 59 60 `shouldBe` (1, TimeOfDay 0 0 0)
describe "resolveTimeOfDay" $ do
it "produces valid times of day" $ producesValid2 resolveTimeOfDay
it "works for sametime " $ forAllValid $ \tod -> resolveTimeOfDay tod SameTime `shouldBe` tod
it "works for noon " $
forAllValid $
\tod -> resolveTimeOfDay tod Noon `shouldBe` TimeOfDay 12 0 0
it "works for midnight " $
forAllValid $
\tod -> resolveTimeOfDay tod Midnight `shouldBe` TimeOfDay 0 0 0
it "works for morning " $
forAllValid $
\tod -> resolveTimeOfDay tod Morning `shouldBe` TimeOfDay 6 0 0
it "works for evening" $
forAllValid $
\tod -> resolveTimeOfDay tod Evening `shouldBe` TimeOfDay 18 0 0
it "works for atHour" $
forAllValid $
\tod ->
forAllValid $ \h -> resolveTimeOfDay tod (AtHour h) `shouldBe` TimeOfDay h 0 0
it "works for atMinute" $
forAllValid $
\tod ->
forAllValid $ \h ->
forAllValid $ \m -> resolveTimeOfDay tod (AtMinute h m) `shouldBe` TimeOfDay h m 0
it "works for atExact" $
forAllValid $
\tod1 ->
forAllValid $ \tod2 -> resolveTimeOfDay tod1 (AtExact tod2) `shouldBe` tod2
xdescribe "Don't actually hold" $ do
it "has an inverse with (small) hoursDiff" $
forAllValid $
\tod ->
forAll (choose (-(24 - 1), 24 - 1)) $ \hd ->
resolveTimeOfDay (resolveTimeOfDay tod (HoursDiff hd)) (HoursDiff (-hd)) `shouldBe` tod
it "has an inverse with (small) minutesDiff" $
forAllValid $
\tod ->
forAll (choose (-(24 * 60 - 1), 24 * 60 - 1)) $ \md ->
resolveTimeOfDay (resolveTimeOfDay tod (MinutesDiff md)) (MinutesDiff (-md))
`shouldBe` tod
it "has an inverse with (small) secondsDiff" $
forAllValid $
\tod ->
forAll (max (-1000) . min 1000 <$> genValid) $ \sd ->
resolveTimeOfDay (resolveTimeOfDay tod (SecondsDiff sd)) (SecondsDiff (-sd))
`shouldBe` tod
describe "resolveDay" $ do
it "produces valid days" $ producesValid2 resolveDay
it "works for this example for Yesterday" $
resolveDay (fromGregorian 2000 6 25) Yesterday `shouldBe` fromGregorian 2000 6 24
it "is id for Now" $ forAllValid $ \d -> resolveDay d Now `shouldBe` d
it "is id for Today" $ forAllValid $ \d -> resolveDay d Today `shouldBe` d
it "works for this example for Tomorrow" $
resolveDay (fromGregorian 2001 6 23) Tomorrow `shouldBe` fromGregorian 2001 6 24
it "produces valid values when given 'OnlyDay' values" $
forAllValid $
\d ->
forAllShrink ((OnlyDay <$> genValid) `suchThat` isValid) shrinkValid $ \fd ->
shouldBeValid $ resolveDay d fd
it "works for OnlyDay for this example where the current date is before the given day" $
resolveDay (fromGregorian 2001 6 23) (OnlyDay 24) `shouldBe` fromGregorian 2001 6 24
it "works for OnlyDay for this example where the current date is after the given day" $
resolveDay (fromGregorian 2001 6 23) (OnlyDay 5) `shouldBe` fromGregorian 2001 7 5
it "works for OnlyDay for this example where the following given day is not in this month" $
resolveDay (fromGregorian 2001 2 23) (OnlyDay 29) `shouldBe` fromGregorian 2001 3 29
it "works for OnlyDay for this example where the following given day is not in next month" $
resolveDay (fromGregorian 2001 1 30) (OnlyDay 29) `shouldBe` fromGregorian 2001 3 29
it "works for OnlyDay for this example where the following given day is not in next month" $
resolveDay (fromGregorian 2001 12 30) (OnlyDay 5) `shouldBe` fromGregorian 2002 1 5
it "produces valid values when given 'DayInMonth' values" $
forAllValid $
\d ->
forAllShrink (((\(mi, di) -> DayInMonth (max 0 (min 12 mi)) (max 0 (min 31 di))) <$> genValid) `suchThat` isValid) shrinkValid $ \fd ->
shouldBeValid $ resolveDay d fd
it "works for DayInMonth for this example where the current date is before the given day" $
resolveDay (fromGregorian 2001 6 23) (DayInMonth 6 24) `shouldBe` fromGregorian 2001 6 24
it "works for DayInMonth for this example where the current date is after the given day" $
resolveDay (fromGregorian 2001 6 23) (DayInMonth 6 5) `shouldBe` fromGregorian 2002 6 5
it "works for DayInMonth for this example accross years" $
resolveDay (fromGregorian 2001 1 30) (DayInMonth 1 5) `shouldBe` fromGregorian 2002 1 5
it "works for DayInMonth for this example for february 29th" $
resolveDay (fromGregorian 2001 1 30) (DayInMonth 2 29) `shouldBe` fromGregorian 2004 2 29
it "produces valid values when given 'DayInMonth' values" $
forAllValid $
\d ->
forAllShrink ((NextDayOfTheWeek <$> genValid) `suchThat` isValid) shrinkValid $ \fd ->
shouldBeValid $ resolveDay d fd
it "works for NextDayOfTheWeek with a day of the week after today in the current week" $
resolveDay (fromGregorian 2018 10 9) (NextDayOfTheWeek Thursday)
`shouldBe` fromGregorian 2018 10 11
it "works for NextDayOfTheWeek with a day of the week after today in the next week" $
resolveDay (fromGregorian 2018 10 9) (NextDayOfTheWeek Monday)
`shouldBe` fromGregorian 2018 10 15
it
"works for NextDayOfTheWeek with a day of the week after today in the current week at the end of the year"
$ resolveDay (fromGregorian 2020 12 30) (NextDayOfTheWeek Saturday)
`shouldBe` fromGregorian 2021 01 02
it
"works for NextDayOfTheWeek with a day of the week after today in the next week at the end of the year"
$ resolveDay (fromGregorian 2020 12 30) (NextDayOfTheWeek Tuesday)
`shouldBe` fromGregorian 2021 01 05