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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
module Data.Time
( ClockTime, CalendarTime(..)
, ctYear, ctMonth, ctDay, ctHour, ctMin, ctSec, ctTZ
, getClockTime, getLocalTime, toUTCTime, toClockTime, toCalendarTime
, clockTimeToInt, calendarTimeToString, toDayString, toTimeString
, addSeconds, addMinutes, addHours, addDays, addMonths, addYears
, daysOfMonth, validDate, compareCalendarTime, compareClockTime
) where
data ClockTime = CTime Int
deriving (Eq, Ord, Show, Read)
data CalendarTime = CalendarTime Int Int Int Int Int Int Int
deriving (Eq, Ord, Show, Read)
ctYear :: CalendarTime -> Int
ctYear (CalendarTime y _ _ _ _ _ _) = y
ctMonth :: CalendarTime -> Int
ctMonth (CalendarTime _ m _ _ _ _ _) = m
ctDay :: CalendarTime -> Int
ctDay (CalendarTime _ _ d _ _ _ _) = d
ctHour :: CalendarTime -> Int
ctHour (CalendarTime _ _ _ h _ _ _) = h
ctMin :: CalendarTime -> Int
ctMin (CalendarTime _ _ _ _ m _ _) = m
ctSec :: CalendarTime -> Int
ctSec (CalendarTime _ _ _ _ _ s _) = s
ctTZ :: CalendarTime -> Int
ctTZ (CalendarTime _ _ _ _ _ _ tz) = tz
getClockTime :: IO ClockTime
getClockTime external
getLocalTime :: IO CalendarTime
getLocalTime = do
ctime <- getClockTime
toCalendarTime ctime
clockTimeToInt :: ClockTime -> Int
clockTimeToInt (CTime i) = i
toCalendarTime :: ClockTime -> IO CalendarTime
toCalendarTime ctime = prim_toCalendarTime $## ctime
prim_toCalendarTime :: ClockTime -> IO CalendarTime
prim_toCalendarTime external
toUTCTime :: ClockTime -> CalendarTime
toUTCTime ctime = prim_toUTCTime $## ctime
prim_toUTCTime :: ClockTime -> CalendarTime
prim_toUTCTime external
toClockTime :: CalendarTime -> ClockTime
toClockTime d = prim_toClockTime $## d
prim_toClockTime :: CalendarTime -> ClockTime
prim_toClockTime external
calendarTimeToString :: CalendarTime -> String
calendarTimeToString ctime@(CalendarTime y mo d _ _ _ _) =
shortMonths!!(mo-1) ++ " " ++ show d ++ " " ++
toTimeString ctime ++ " " ++ show y
where shortMonths = ["Jan","Feb","Mar","Apr","May","Jun",
"Jul","Aug","Sep","Oct","Nov","Dec"]
toDayString :: CalendarTime -> String
toDayString (CalendarTime y mo d _ _ _ _) =
longMonths!!(mo-1) ++ " " ++ show d ++ ", " ++ show y
where longMonths = ["January","February","March","April","May","June","July",
"August","September","October","November","December"]
toTimeString :: CalendarTime -> String
toTimeString (CalendarTime _ _ _ h mi s _) =
digit2 h ++":"++ digit2 mi ++":"++ digit2 s
where digit2 n = if n<10 then ['0',chr(ord '0' + n)]
else show n
addSeconds :: Int -> ClockTime -> ClockTime
addSeconds n (CTime ctime) = CTime (ctime + n)
addMinutes :: Int -> ClockTime -> ClockTime
addMinutes n (CTime ctime) = CTime (ctime + (n*60))
addHours :: Int -> ClockTime -> ClockTime
addHours n (CTime ctime) = CTime (ctime + (n*3600))
addDays :: Int -> ClockTime -> ClockTime
addDays n (CTime ctime) = CTime (ctime + (n*86400))
addMonths :: Int -> ClockTime -> ClockTime
addMonths n ctime =
let CalendarTime y mo d h mi s tz = toUTCTime ctime
nmo = (mo-1+n) `mod` 12 + 1
in
if nmo>0
then addYears ((mo-1+n) `div` 12)
(toClockTime (CalendarTime y nmo d h mi s tz))
else addYears ((mo-1+n) `div` 12 - 1)
(toClockTime (CalendarTime y (nmo+12) d h mi s tz))
addYears :: Int -> ClockTime -> ClockTime
addYears n ctime = if n==0 then ctime else
let CalendarTime y mo d h mi s tz = toUTCTime ctime
in toClockTime (CalendarTime (y+n) mo d h mi s tz)
daysOfMonth :: Int -> Int -> Int
daysOfMonth mo yr =
if mo/=2
then [31,28,31,30,31,30,31,31,30,31,30,31] !! (mo-1)
else if yr `mod` 4 == 0 && (yr `mod` 100 /= 0 || yr `mod` 400 == 0)
then 29
else 28
validDate :: Int -> Int -> Int -> Bool
validDate y m d = m > 0 && m < 13 && d > 0 && d <= daysOfMonth m y
compareDate :: CalendarTime -> CalendarTime -> Ordering
compareDate = compareCalendarTime
compareCalendarTime :: CalendarTime -> CalendarTime -> Ordering
compareCalendarTime ct1 ct2 =
compareClockTime (toClockTime ct1) (toClockTime ct2)
compareClockTime :: ClockTime -> ClockTime -> Ordering
compareClockTime (CTime time1) (CTime time2)
| time1<time2 = LT
| time1>time2 = GT
| otherwise = EQ
|