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
|
module Test.TestTime where
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.WeekDate
import Data.Time
import Test.TestUtil
import Test.TestTimeRef
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 ]
testTime :: Test
testTime = pureTest "testTime" $
diff testTimeRef $ unlines [testCal, testUTC, testUT1, testTimeOfDayToDayFraction]
|
