From 1ea8c6c9ee75cd4f358c0d48d6340386a2968094 Mon Sep 17 00:00:00 2001
From: tim <tim@dockerz.net>
Date: Tue, 25 Nov 2008 21:30:21 +0000
Subject: [PATCH] Added helper functions for current time and date

---
 Ledger/Dates.hs | 13 +++++++++----
 1 file changed, 9 insertions(+), 4 deletions(-)

diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs
index 2bedd0721..33b8814c7 100644
--- a/Ledger/Dates.hs
+++ b/Ledger/Dates.hs
@@ -50,6 +50,14 @@ mkDate day = Date (localTimeToUTC utc (LocalTime day midnight))
 mkDateTime :: Day -> TimeOfDay -> DateTime
 mkDateTime day tod = DateTime (localTimeToUTC utc (LocalTime day tod))
 
+today :: IO Date
+today = do
+    t <- getZonedTime
+    return (mkDate (localDay (zonedTimeToLocalTime t)))
+
+now :: IO DateTime
+now = fmap DateTime getCurrentTime 
+
 -- | Parse a date-time string to a time type, or raise an error.
 parsedatetime :: String -> DateTime
 parsedatetime s = DateTime $
@@ -73,9 +81,6 @@ datetimeToDate (DateTime (UTCTime{utctDay=day})) = Date (UTCTime day 0)
 elapsedSeconds :: Fractional a => DateTime -> DateTime -> a
 elapsedSeconds (DateTime dt1) (DateTime dt2) = realToFrac $ diffUTCTime dt1 dt2
 
-today :: IO Date
-today = getCurrentTime >>= return . Date
-
 dateToUTC :: Date -> UTCTime
 dateToUTC (Date u) = u
 
@@ -86,4 +91,4 @@ dateComponents = toGregorian . utctDay . dateToUTC
 dateDay date = d where (_,_,d) = dateComponents date
 
 -- dateMonth :: Date -> Day
-dateMonth date = m where (_,m,_) = dateComponents date
\ No newline at end of file
+dateMonth date = m where (_,m,_) = dateComponents date