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
------------------------------------------------------------------------------
--- Library for handling date and time information.
---
--- @author Michael Hanus
--- @version January 2018
--- @category general
------------------------------------------------------------------------------

module 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,
            compareDate) where


--- ClockTime represents a clock time in some internal representation.
data ClockTime = CTime Int
 deriving (Eq, Ord, Show, Read)

--- A calendar time is presented in the following form:
--- (CalendarTime year month day hour minute second timezone)
--- where timezone is an integer representing the timezone as a difference
--- to UTC time in seconds.
data CalendarTime = CalendarTime Int Int Int Int Int Int Int
 deriving (Eq, Ord, Show, Read)

--- The year of a calendar time.
ctYear :: CalendarTime -> Int
ctYear (CalendarTime y _ _ _ _ _ _) = y

--- The month of a calendar time.
ctMonth :: CalendarTime -> Int
ctMonth (CalendarTime _ m _ _ _ _ _) = m

--- The day of a calendar time.
ctDay :: CalendarTime -> Int
ctDay (CalendarTime _ _ d _ _ _ _) = d

--- The hour of a calendar time.
ctHour :: CalendarTime -> Int
ctHour (CalendarTime _ _ _ h _ _ _) = h

--- The minute of a calendar time.
ctMin :: CalendarTime -> Int
ctMin (CalendarTime _ _ _ _ m _ _) = m

--- The second of a calendar time.
ctSec :: CalendarTime -> Int
ctSec (CalendarTime _ _ _ _ _ s _) = s

--- The time zone of a calendar time. The value of the
--- time zone is the difference to UTC time in seconds.
ctTZ :: CalendarTime -> Int
ctTZ (CalendarTime _ _ _ _ _ _ tz) = tz


--- Returns the current clock time.
getClockTime :: IO ClockTime
getClockTime external

--- Returns the local calendar time.
getLocalTime :: IO CalendarTime
getLocalTime = do
  ctime <- getClockTime
  toCalendarTime ctime

--- Transforms a clock time into a unique integer.
--- It is ensured that clock times that differs in at least one second
--- are mapped into different integers.
clockTimeToInt :: ClockTime -> Int
clockTimeToInt (CTime i) = i

--- Transforms a clock time into a calendar time according to the local time
--- (if possible). Since the result depends on the local environment,
--- it is an I/O operation.
toCalendarTime :: ClockTime -> IO CalendarTime
toCalendarTime ctime = prim_toCalendarTime $## ctime

prim_toCalendarTime :: ClockTime -> IO CalendarTime
prim_toCalendarTime external

--- Transforms a clock time into a standard UTC calendar time.
--- Thus, this operation is independent on the local time.
toUTCTime :: ClockTime -> CalendarTime
toUTCTime ctime = prim_toUTCTime $## ctime

prim_toUTCTime :: ClockTime -> CalendarTime
prim_toUTCTime external

--- Transforms a calendar time (interpreted as UTC time) into a clock time.
toClockTime :: CalendarTime -> ClockTime
toClockTime d = prim_toClockTime $## d

prim_toClockTime :: CalendarTime -> ClockTime
prim_toClockTime external

--- Transforms a calendar time into a readable form.
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"]

--- Transforms a calendar time into a string containing the day, e.g.,
--- "September 23, 2006".
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"]

--- Transforms a calendar time into a string containing the time.
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

--- Adds seconds to a given time.
addSeconds :: Int -> ClockTime -> ClockTime
addSeconds n (CTime ctime) = CTime (ctime + n)

--- Adds minutes to a given time.
addMinutes :: Int -> ClockTime -> ClockTime
addMinutes n (CTime ctime) = CTime (ctime + (n*60))

--- Adds hours to a given time.
addHours :: Int -> ClockTime -> ClockTime
addHours n (CTime ctime) = CTime (ctime + (n*3600))

--- Adds days to a given time.
addDays :: Int -> ClockTime -> ClockTime
addDays n (CTime ctime) = CTime (ctime + (n*86400))

--- Adds months to a given time.
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))

--- Adds years to a given time.
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)

--- Gets the days of a month in a year.
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

--- Is a date consisting of year/month/day valid?
validDate :: Int -> Int -> Int -> Bool
validDate y m d = m > 0 && m < 13 && d > 0 && d <= daysOfMonth m y

--- Compares two dates (don't use it, just for backward compatibility!).
compareDate :: CalendarTime -> CalendarTime -> Ordering
compareDate = compareCalendarTime

--- Compares two calendar times.
compareCalendarTime :: CalendarTime -> CalendarTime -> Ordering
compareCalendarTime ct1 ct2 =
  compareClockTime (toClockTime ct1) (toClockTime ct2)

--- Compares two clock times.
compareClockTime :: ClockTime -> ClockTime -> Ordering
compareClockTime (CTime time1) (CTime time2)
 | time1<time2 = LT
 | time1>time2 = GT
 | otherwise   = EQ