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