--module Dates (datetime, sixNum, hours, minutes, seconds,
--             yearPart, monthPart, dayPart,
--             hourPart, minutePart, secondPart, dateFromString,
--             dateSub, dateAdd, Date, TimeSpan, fromNum, toNum, hms) where

module Dates where

data Date = Date Int Int
            deriving (Eq, Ord)

data TimeSpan = TimeSpan Int
            deriving (Show, Eq, Ord)

instance Show Date where
    show = toString


instance Enum Date where
    pred (Date d s) = Date (d-1) s
    succ (Date d s) = Date (d+1) s
    toEnum d = Date d 0
    fromEnum (Date d _) = d
    enumFrom d = (d:(enumFrom (succ d)))
    enumFromThen a b = (a:(enumFromThen b (dateAdd b (dateSub b a))))
    enumFromThenTo a b c = takeWhile (<= c) (enumFromThen a b)
        


isLeapYear :: Int -> Bool
isLeapYear x 
 | x `mod` 400 == 0 = True
 | x `mod` 100 == 0 = False
 | x `mod` 4   == 0 = True
 | otherwise        = False



daysInMonth :: Int -> Int -> Int
daysInMonth _ 1 = 31
daysInMonth y 2 
 | isLeapYear y = 29
 | otherwise    = 28

daysInMonth _ 3 = 31
daysInMonth _ 4 = 30
daysInMonth _ 5 = 31
daysInMonth _ 6 = 30
daysInMonth _ 7 = 31
daysInMonth _ 8 = 31
daysInMonth _ 9 = 30
daysInMonth _ 10 = 31
daysInMonth _ 11 = 30
daysInMonth _ 12 = 31
daysInMonth _ x = 0


daysInYear x
 | isLeapYear x = 366
 | otherwise    = 365

normalize :: Date -> Date
normalize (Date days seconds) = (Date (days + sdays) sseconds)
    where sdays = seconds `div` 86400
          sseconds = seconds `mod` 86400

baseYear = 2000

datetime :: Int -> Int -> Int -> Int -> Int -> Int -> Date
datetime y m d h minute s = (Date days seconds)
    where days = yearDays + monthDays + d - 1
          yearDays = sum [daysInYear x | x <- [baseYear..(y-1)]]
          monthDays = sum [(daysInMonth y x) | x <- [1..(m-1)]]
          seconds = h * 3600 + minute * 60 + s

toString d = concat [(p 4 year), "-", (p 2 month), "-", (p 2 day), " ", 
                     (p 2 hour), ":", (p 2 minute), ":", (p 2 second)]
    where (year, month, day, hour, minute, second) = sixNum d
          p x v = pad (show v) x

dateFromString s = datetime (read year) (read month) (read day) (read hour) (read minute) (read second)
    where (dpart:tpart:xs) = split s ' '
          (year:month:day:[]) = split dpart '-'
          (hour:minute:second:[]) = split tpart ':'

toNum d = x
    where (TimeSpan x) = dateSub d  (datetime 2000 1 1 0 0 0)

fromNum d = dateAdd (datetime 2000 1 1 0 0 0) (TimeSpan d)
                                                                       
sixNum d = (year, month, mdaysRemaining, hour, minute, second)
    where (Date days seconds) = normalize d
          (year, ydaysBefore) = yearOf days
          ydaysRemaining = days - ydaysBefore
          (month, mdaysBefore) = monthOf year ydaysRemaining
          mdaysRemaining = ydaysRemaining - mdaysBefore + 1
          hour = seconds `div` 3600
          minute = (seconds `mod` 3600) `div` 60
          second = seconds - (hour * 3600) - (minute * 60)

yearPart d = x
           where (x, _, _, _, _, _) = sixNum d
monthPart d = x
           where (_, x, _, _, _, _) = sixNum d
dayPart d = x
           where (_, _, x, _, _, _) = sixNum d
hourPart d = x
           where (_, _, _, x, _, _) = sixNum d
minutePart d = x
           where (_, _, _, _, x, _) = sixNum d
secondPart d = x
           where (_, _, _, _, _, x) = sixNum d



dateAdd :: Date -> TimeSpan -> Date
dateAdd (Date ds s) (TimeSpan t) = normalize (Date ds (s + t))

dateSub :: Date -> Date -> TimeSpan
dateSub (Date d1 s1) (Date d2 s2) = TimeSpan ((86400 * (d1 - d2)) + (s1 - s2))

days x = TimeSpan (86400 * x)
hours x = TimeSpan (3600 * x)
minutes x = TimeSpan (60 * x)
seconds x = TimeSpan x

hms h m s = TimeSpan (3600 * h + 60 * m + s)


years = [baseYear..]


accFun f  = dy 0 
    where
      dy acc (x:[]) = (acc + (f x)):[]
      dy acc (x:xs) = acc:(dy newtot xs)
          where newtot = (acc + (f x))


accDaysOf af l bv days
 | length listPart > 0 = head $ reverse $ listPart
 | otherwise = bv
    where daysLessThan (y, d) = d <= days
          listPart = takeWhile daysLessThan (zip l (af l))

yearOf = accDaysOf (accFun daysInYear) years (baseYear, 0)
monthOf year = accDaysOf (accFun (daysInMonth year)) [1..13] (1, 0)

pad str width = concat [pre, str]
    where lstr = length str
          pre = if lstr < width then take (width-(lstr)) (repeat '0') else ""


split :: String -> Char -> [String]
split [] delim = [""]
split (c:cs) delim
   | c == delim = "" : rest
   | otherwise = (c : head rest) : tail rest
   where
       rest = split cs delim