1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
module Test.LocalTime.Time (
testTime,
) where
import Data.Time.Compat
import Data.Time.Calendar.OrdinalDate.Compat
import Data.Time.Calendar.WeekDate.Compat
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]
|
