Time.hs

module Test.LocalTime.Time
    ( testTime
    ) where

import Data.Time
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.WeekDate
import Test.LocalTime.TimeRef
import Test.Tasty
import Test.Tasty.HUnit

showCal :: Integer -> String
showCal mjd = let
    date = ModifiedJulianDay mjd
    (y, m, d) = toGregorian date
    date' = fromGregorian y m d
    in concat
           [ show mjd ++ "=" ++ showGregorian date ++ "=" ++ showOrdinalDate date ++ "=" ++ showWeekDate date ++ "\n"
           , if date == date'
                 then ""
                 else "=" ++ (show $ toModifiedJulianDay date') ++ "!"
           ]

testCal :: String
testCal =
    concat
        -- days around 1 BCE/1 CE
        [ concatMap showCal [-678950 .. -678930]
        -- days around 1000 CE
        , concatMap showCal [-313710 .. -313690]
        -- days around MJD zero
        , concatMap showCal [-30 .. 30]
        , showCal 40000
        , showCal 50000
        -- 1900 not a leap year
        , showCal 15078
        , showCal 15079
        -- 1980 is a leap year
        , showCal 44297
        , showCal 44298
        , showCal 44299
        -- 1990 not a leap year
        , showCal 47950
        , showCal 47951
        -- 2000 is a leap year
        , showCal 51602
        , showCal 51603
        , showCal 51604
        -- years 2000 and 2001, plus some slop
        , concatMap showCal [51540 .. 52280]
        ]

showUTCTime :: UTCTime -> String
showUTCTime (UTCTime d t) = show (toModifiedJulianDay d) ++ "," ++ show t

myzone :: TimeZone
myzone = hoursToTimeZone (-8)

leapSec1998Cal :: LocalTime
leapSec1998Cal = LocalTime (fromGregorian 1998 12 31) (TimeOfDay 23 59 60.5)

leapSec1998 :: UTCTime
leapSec1998 = localTimeToUTC utc leapSec1998Cal

testUTC :: String
testUTC = let
    lsMineCal = utcToLocalTime myzone leapSec1998
    lsMine = localTimeToUTC myzone lsMineCal
    in unlines [showCal 51178, show leapSec1998Cal, showUTCTime leapSec1998, show lsMineCal, showUTCTime lsMine]

neglong :: Rational
neglong = -120

poslong :: Rational
poslong = 120

testUT1 :: String
testUT1 =
    unlines
        [ show $ ut1ToLocalTime 0 $ ModJulianDate 51604.0
        , show $ ut1ToLocalTime 0 $ ModJulianDate 51604.5
        , show $ ut1ToLocalTime neglong $ ModJulianDate 51604.0
        , show $ ut1ToLocalTime neglong $ ModJulianDate 51604.5
        , show $ ut1ToLocalTime poslong $ ModJulianDate 51604.0
        , show $ ut1ToLocalTime poslong $ ModJulianDate 51604.5
        ]

testTimeOfDayToDayFraction :: String
testTimeOfDayToDayFraction = let
    f = dayFractionToTimeOfDay . timeOfDayToDayFraction
    in unlines
           [ show $ f $ TimeOfDay 12 34 56.789
           , show $ f $ TimeOfDay 12 34 56.789123
           , show $ f $ TimeOfDay 12 34 56.789123456
           , show $ f $ TimeOfDay 12 34 56.789123456789
           -- , show $ f $ TimeOfDay minBound 0 0
           ]

testTime :: TestTree
testTime =
    testCase "testTime" $
    assertEqual "times" testTimeRef $ unlines [testCal, testUTC, testUT1, testTimeOfDayToDayFraction]