slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added helper functions for current time and date

Browse Source
This commit is contained in:
tim 2008-11-25 21:30:21 +00:00
parent e8a0d42906
commit 1ea8c6c9ee
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Ledger/Dates.hs
View File

@ -50,6 +50,14 @@ mkDate day = Date (localTimeToUTC utc (LocalTime day midnight))
mkDateTime :: Day -> TimeOfDay -> DateTime mkDateTime :: Day -> TimeOfDay -> DateTime
mkDateTime day tod = DateTime (localTimeToUTC utc (LocalTime day tod)) 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. -- | Parse a date-time string to a time type, or raise an error.
parsedatetime :: String -> DateTime parsedatetime :: String -> DateTime
parsedatetime s = DateTime $ parsedatetime s = DateTime $
@ -73,9 +81,6 @@ datetimeToDate (DateTime (UTCTime{utctDay=day})) = Date (UTCTime day 0)
elapsedSeconds :: Fractional a => DateTime -> DateTime -> a elapsedSeconds :: Fractional a => DateTime -> DateTime -> a
elapsedSeconds (DateTime dt1) (DateTime dt2) = realToFrac $ diffUTCTime dt1 dt2 elapsedSeconds (DateTime dt1) (DateTime dt2) = realToFrac $ diffUTCTime dt1 dt2
today :: IO Date
today = getCurrentTime >>= return . Date
dateToUTC :: Date -> UTCTime dateToUTC :: Date -> UTCTime
dateToUTC (Date u) = u dateToUTC (Date u) = u
@ -86,4 +91,4 @@ dateComponents = toGregorian . utctDay . dateToUTC
dateDay date = d where (_,_,d) = dateComponents date dateDay date = d where (_,_,d) = dateComponents date
-- dateMonth :: Date -> Day -- dateMonth :: Date -> Day
dateMonth date = m where (_,m,_) = dateComponents date dateMonth date = m where (_,m,_) = dateComponents date