I've tended to use the attached module.

It is basic, but has covered my needs.

It probably has many issues (bugs, inefficiencies, naming conventions,
etc) but has been sufficient so far.

Developed by myself a few years ago, under no particular licence - happy
for reuse or for someone to take it and package it up under cabal if it is
useful or maybe even better for someone to suggest a simple alternative.

cheers,

Joe


>
> -----BEGIN PGP SIGNED MESSAGE-----
> Hash: SHA1
>
> I recently set out to write a library that required a decent time
> library. Having only had a flirt with Data.Time previously, I assumed
> it would be robust like many other haskell libraries. I don't know
> about consensus, but I have been massively let down. I won't go in to
> the details, since this is not the point -- I don't wish to complain
> - -- I wish to get on with it.
>
> So, assuming the consensus is in agreement, is there a reasonable
> alternative to Data.Time (I looked on hackage and nothing seemed to
> have come close)? Am I wrong in assuming Data.Time is pretty useless?
>
> If I am right, and there is no alternative, I see no option but to
> take an excursion into writing my own. Ultimately, I am just trying to
> avoid this. Tips welcome.
>
> - --
> Tony Morris
> http://tmorris.net/
>
> -----BEGIN PGP SIGNATURE-----
> Version: GnuPG v1.4.10 (GNU/Linux)
> Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/
>
> iEYEARECAAYFAk4Ggx4ACgkQmnpgrYe6r61BRQCfbn+1jqNSjR+lxM+4h3gpvAMM
> VskAoKxqDCETyVAaOdoYDmFJGz1fOGd/
> =IC7O
> -----END PGP SIGNATURE-----
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe@haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>

--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
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Reply via email to