CalendarDateTimeTest.hs

module HodaTime.CalendarDateTimeTest
(
  calendarDateTimeTests
)
where

import Test.Tasty
import Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit
import Data.Maybe (fromJust)

import HodaTime.Util (RandomTime(..), CycleYear(..))
import Data.HodaTime.LocalTime (localTime, hour, minute, second)
import Data.HodaTime.CalendarDate (day, next, previous, dayOfWeek)
import Data.HodaTime.Calendar.Gregorian (calendarDate, Month(..))
import Data.HodaTime.CalendarDateTime (on)
import Data.HodaTime.Period (applyPeriod, days, months, hours, minutes, seconds)

calendarDateTimeTests :: TestTree
calendarDateTimeTests = testGroup "CalendarDateTimeTests Tests" [qcProps, unitTests]

qcProps :: TestTree
qcProps = testGroup "(checked by QuickCheck)" [timeAccessorProps, datePeriodProps]

unitTests :: TestTree
unitTests = testGroup "Unit tests" [rolloverUnits]

timeAccessorProps :: TestTree
timeAccessorProps = testGroup "Time accessors"
  [
     QC.testProperty "reads constructed components" $ \(RandomTime h m s) ->
       let value = mkTime h m s in (hour value, minute value, second value) == (h, m, s)
  ]
  where
    mkTime h m s = fromJust $ on <$> localTime h m s 0 <*> calendarDate 1 April 2001

datePeriodProps :: TestTree
datePeriodProps = testGroup "Date periods"
  [
     QC.testProperty "first day not changed by month math" $ testMonthAdd 1
    ,QC.testProperty "mid day not changed by month math" $ testMonthAdd 15
    ,QC.testProperty "dayOfWeek . next n dow $ date == dow" $ testNextDoW
    ,QC.testProperty "next n (dayOfWeek date) date == a positive day period" $ testDirection next id
    ,QC.testProperty "previous n (dayOfWeek date) date == a negative day period" $ testDirection previous negate
  ]
    where
      mkcd d m y = fromJust $ on <$> localTime 10 10 10 0 <*> calendarDate d m y
      testMonthAdd d (CycleYear y) m add = day (applyPeriod (months add) $ mkcd d m (y + 1900)) == d
      testNextDoW dow (Positive n) = (dayOfWeek . next n dow $ epochDay) == dow
      testDirection dir adjust (Positive n) = dir n (dayOfWeek epochDay) epochDay == applyPeriod (days (adjust (n * 7))) epochDay
      epochDay = mkcd 1 March 2000

rolloverUnits :: TestTree
rolloverUnits = testGroup "Rollover"
  [
    testCase "30.Jan.2000 22:57:57 + 2s == 30.Jan.2000 22:57:59" $ applyPeriod (seconds 2) <$> dt @?= mkLT 22 57 59 0
      ,testCase "30.Jan.2000 22:57:57 + 5s == 30.Jan.2000 22:58:02" $ applyPeriod (seconds 5) <$> dt @?= mkLT 22 58 2 0
      ,testCase "30.Jan.2000 22:57:57 + 5m == 30.Jan.2000 23:02:57" $ applyPeriod (minutes 5) <$> dt @?= mkLT 23 02 57 0
      ,testCase "30.Jan.2000 22:57:57 + 3h == 31.Jan.2000 01:57:57" $ applyPeriod (hours 3) <$> dt @?= mkLTWithRolledDate 1 57 57 0
      ,testCase "30.Jan.2000 22:57:57 + 3723s == 31.Jan.2000 00:00:00" $ applyPeriod (seconds 3723) <$> dt @?= mkLTWithRolledDate 0 0 0 0
      ,testCase "30.Jan.2000 22:57:57 + 3725s == 31.Jan.2000 00:00:02" $ applyPeriod (seconds 3725) <$> dt @?= mkLTWithRolledDate 0 0 2 0
      ,testCase "30.Jan.2000 22:57:57 + 48h == 1.Feb.2000 22:57:57" $ applyPeriod (hours 48) <$> dt @?= mkLTWithDate monthRoll 22 57 57 0
  ]
  where
    time = localTime 22 57 57 0
    date = calendarDate 30 January 2000
    rollDate = calendarDate 31 January 2000
    monthRoll = calendarDate 1 February 2000
    dt = on <$> time <*> date
    mkLTWithDate date' h m s n = on <$> localTime h m s n <*> date'
    mkLT = mkLTWithDate date
    mkLTWithRolledDate = mkLTWithDate rollDate