module Swish.Utils.DateTime where
data DateTime
= DateTime Int Int Int Int Int Int Int Int
instance Eq DateTime where
d1 == d2 = simpleEq ( normTZ d1 ) ( normTZ d2 )
instance Show DateTime where
show = dtShow
instance Ord DateTime where
dt1 < dt2 = simpleLT ( normTZ dt1 ) ( normTZ dt2 )
dt1 > dt2 = dt2 < dt1
dt1 <= dt2 = (dt1 < dt2)||(dt1==dt2)
dt1 >= dt2 = (dt2 < dt1)||(dt1==dt2)
leapYear :: Int -> Bool
leapYear year
| ( year `mod` 4 == 0 ) &&
not ( ( year `mod` 100 == 0 ) &&
( (year `mod` 400) /= 0 ) ) = True
| otherwise = False
daysInMonth :: Int -> Int -> Int
daysInMonth month year
| month==1 = 31 --Jan
| month==2 = if leapYear year then 29 else 28 --Feb
| month==3 = 31 --Mar
| month==4 = 30 --Apr
| month==5 = 31 --May
| month==6 = 30 --Jun
| month==7 = 31 --Jul
| month==8 = 31 --Aug
| month==9 = 30 --Sep
| month==10 = 31 --Oct
| month==11 = 30 --Nov
| month==12 = 31 --Dec
| otherwise = 0
validJulianDate :: Int -> Int -> Int -> Bool
validJulianDate yr mo da
| yr < 1900 = False
| mo > 12 = False
| da > daysInMonth mo yr = False
| otherwise = True
toJulianDate1 :: DateTime -> Int
toJulianDate1 (DateTime y m d _ _ _ _ _) = toJulianDate y m d
toJulianDate :: Int -> Int -> Int -> Int
toJulianDate year month day
| year==1900 && month<=2 = if month==2 then day + 30 else day 1
| month>=3 = toJD1 (year1900) (month3) day
| otherwise = toJD1 (year1901) (month+9) day
where
toJD1 :: Int -> Int -> Int -> Int
toJD1 y m d
= ( (1461*y) `div` 4 )
(y `div` 100) +
((y+300) `div` 400) +
( ( (153*m) + 2 ) `div` 5 ) +
d + 58
fromJulianDate:: Int -> DateTime
fromJulianDate jdate
| jdate <= 58 = fromJD1 jdate
| otherwise = fromJD2 jdate
where
fromJD1 :: Int -> DateTime
fromJD1 j
| j<=30 = DateTime 1900 1 (j+1 ) 0 0 0 0 0
| otherwise = DateTime 1900 2 (j30) 0 0 0 0 0
fromJD2 :: Int -> DateTime
fromJD2 j
= DateTime y2 m2 d1 0 0 0 0 0
where
t1 = (400*
(j
+((4*(j+36465))`div`146097)
((j+109513)`div`146097))) 23638
dc = 146100
t2 = ( ( t1 `mod` dc ) `div` 400 )*5 + 2
d1 = ( t2 `mod` 153 ) `div` 5 + 1
m1 = t2 `div` 153
m2 = if m1 <= 9 then m1+3 else m19
y1 = t1 `div` dc + 1900
y2 = if m1 <= 9 then y1 else y1+1
date :: Int -> Int -> Int -> DateTime
date y m d = DateTime y m d 0 0 0 0 0
time :: Int -> Int -> Int -> Int -> Int -> DateTime
time = DateTime 0 0 0
dtYear :: DateTime -> Int
dtMonth :: DateTime -> Int
dtDay :: DateTime -> Int
dtHour :: DateTime -> Int
dtMinute :: DateTime -> Int
dtSecond :: DateTime -> Int
dtMillisecs :: DateTime -> Int
dtTimezone :: DateTime -> Int
dtYear ( DateTime x _ _ _ _ _ _ _ ) = x
dtMonth ( DateTime _ x _ _ _ _ _ _ ) = x
dtDay ( DateTime _ _ x _ _ _ _ _ ) = x
dtHour ( DateTime _ _ _ x _ _ _ _ ) = x
dtMinute ( DateTime _ _ _ _ x _ _ _ ) = x
dtSecond ( DateTime _ _ _ _ _ x _ _ ) = x
dtMillisecs ( DateTime _ _ _ _ _ _ x _ ) = x
dtTimezone ( DateTime _ _ _ _ _ _ _ x ) = x
lenFix :: String -> Int -> String
lenFix inStr newLen
| length inStr >= newLen = inStr
| otherwise = lenFix ('0':inStr) newLen
showTZ :: Int -> String
showTZ tz
| tz<0 = '-' : showTZabs (tz)
| tz==0 = showTZabs tz
| otherwise = '+' : showTZabs tz
showTZabs :: Int -> String
showTZabs tz
| tz==0 = "Z"
| otherwise = lenFix ( show ( tz `div` 60 ) ) 2 ++ ":" ++
lenFix ( show ( tz `mod` 60 ) ) 2
showTime :: DateTime -> String
showTime ( DateTime _ _ _ hr mi se ms _ )
| ms==0 = lenFix ( show hr ) 2 ++ ":" ++
lenFix ( show mi ) 2 ++ ":" ++
lenFix ( show se ) 2
| otherwise = lenFix ( show hr ) 2 ++ ":" ++
lenFix ( show mi ) 2 ++ ":" ++
lenFix ( show se ) 2 ++ "." ++
lenFix ( show ms ) 3
showDate :: DateTime -> String
showDate ( DateTime yr mo da _ _ _ _ _ )
= lenFix ( show yr ) 4 ++ "-" ++
lenFix ( show mo ) 2 ++ "-" ++
lenFix ( show da ) 2
dtShow :: DateTime -> String
dtShow ( DateTime yr mo da hr mi se ms tz )
= showDate ( DateTime yr mo da hr mi se ms tz ) ++ "T" ++
showTime ( DateTime yr mo da hr mi se ms tz ) ++ showTZ tz
carryMins :: DateTime -> DateTime
carryMins ( DateTime yr mo da hr mi se ms tz )
| newhrs >= 24 = carryHours ( DateTime yr mo da newhrs (mi`mod`60) se ms tz )
| otherwise = DateTime yr mo da newhrs (mi`mod`60) se ms tz
where
newhrs = hr + (mi`div`60)
carryHours :: DateTime -> DateTime
carryHours ( DateTime yr mo da hr mi se ms tz )
= DateTime y m d (hr`mod`24) mi se ms tz
where
(DateTime y m d _ _ _ _ _) = fromJulianDate (toJulianDate yr mo da + (hr`div`24))
normTZ :: DateTime -> DateTime
normTZ ( DateTime yr mo da hr mi se ms tz )
= carryMins ( DateTime yr mo da hr (mitz) se ms 0 )
addMilliSecs :: Int -> DateTime -> DateTime
addMilliSecs addms ( DateTime yr mo da hr mi se ms tz )
| totms < 1000 = DateTime yr mo da hr mi se totms tz
| otherwise = addSeconds addse ( DateTime yr mo da hr mi se newms tz )
where
totms = ms + addms
newms = totms `mod` 1000
addse = totms `div` 1000
addSeconds :: Int -> DateTime -> DateTime
addSeconds addse ( DateTime yr mo da hr mi se ms tz )
| totse < 60 = DateTime yr mo da hr mi totse ms tz
| otherwise = addMinutes addmi ( DateTime yr mo da hr mi newse ms tz )
where
totse = se + addse
newse = totse `mod` 60
addmi = totse `div` 60
addMinutes :: Int -> DateTime -> DateTime
addMinutes addmi ( DateTime yr mo da hr mi se ms tz )
| totmi < 60 = DateTime yr mo da hr totmi se ms tz
| otherwise = addHours addhr ( DateTime yr mo da hr newmi se ms tz )
where
totmi = mi + addmi
newmi = totmi `mod` 60
addhr = totmi `div` 60
addHours :: Int -> DateTime -> DateTime
addHours addhr ( DateTime yr mo da hr mi se ms tz )
| tothr < 24 = DateTime yr mo da tothr mi se ms tz
| otherwise = addDays addda ( DateTime yr mo da newhr mi se ms tz )
where
tothr = hr + addhr
newhr = tothr `mod` 24
addda = tothr `div` 24
addDays :: Int -> DateTime -> DateTime
addDays addda ( DateTime yr mo da hr mi se ms tz )
= DateTime newyr newmo newda hr mi se ms tz
where
DateTime newyr newmo newda _ _ _ _ _ = fromJulianDate ( toJulianDate yr mo da + addda )
simpleEq :: DateTime -> DateTime -> Bool
simpleEq ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 tz1 ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 tz2 ) =
( yr1 == yr2 ) && ( mo1 == mo2 ) && ( da1 == da2 ) && ( hr1 == hr2 ) && ( mi1 == mi2 ) && ( se1 == se2 ) && ( ms1 == ms2 ) && ( tz1 == tz2 )
simpleLT :: DateTime -> DateTime -> Bool
simpleLT ( DateTime yr1 mo1 da1 hr1 mi1 se1 ms1 _ ) ( DateTime yr2 mo2 da2 hr2 mi2 se2 ms2 _ )
| yr1 < yr2 = True
| (yr1==yr2)&&(mo1<mo2) = True
| (yr1==yr2)&&(mo1==mo2)&&(da1<da2) = True
| (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1<hr2) = True
| (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1<mi2) = True
| (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1<se2) = True
| (yr1==yr2)&&(mo1==mo2)&&(da1==da2)&&(hr1==hr2)&&(mi1==mi2)&&(se1==se2)&&(ms1<ms2) = True
| otherwise = False