hledger/Ledger/Dates.hs
tim 514f015849 Implemented types for dates and datetimes
This patch replaces the strings used in the Entry, TimeLogEntry, and Transaction
records with real types. Rather than use the inbuild system date and time types
directly, two custom types have been implemented that wrap UTCTime: Date and
DateTime. A minimal API for these has been added.
2008-11-11 12:34:05 +00:00

67 lines
1.8 KiB
Haskell

{-|
Types for Dates and DateTimes, implemented in terms of UTCTime
-}
module Ledger.Dates(
Date,
DateTime,
mkDate,
mkDateTime,
parsedatetime,
parsedate,
datetimeToDate,
elapsedSeconds
) where
import Data.Time.Clock
import Data.Time.Format
import Data.Time.Calendar
import Data.Time.LocalTime
import System.Locale (defaultTimeLocale)
import Text.Printf
import Data.Maybe
newtype Date = Date UTCTime
deriving (Ord, Eq)
newtype DateTime = DateTime UTCTime
deriving (Ord, Eq)
instance Show Date where
show (Date t) = formatTime defaultTimeLocale "%Y/%m/%d" t
instance Show DateTime where
show (DateTime t) = formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" t
mkDate :: Day -> Date
mkDate day = Date (localTimeToUTC utc (LocalTime day midnight))
mkDateTime :: Day -> TimeOfDay -> DateTime
mkDateTime day tod = DateTime (localTimeToUTC utc (LocalTime day tod))
-- | Parse a date-time string to a time type, or raise an error.
parsedatetime :: String -> DateTime
parsedatetime s = DateTime $
parsetimewith "%Y/%m/%d %H:%M:%S" s $
error $ printf "could not parse timestamp \"%s\"" s
-- | Parse a date string to a time type, or raise an error.
parsedate :: String -> Date
parsedate s = Date $
parsetimewith "%Y/%m/%d" s $
error $ printf "could not parse date \"%s\"" s
-- | Parse a time string to a time type using the provided pattern, or
-- return the default.
parsetimewith :: ParseTime t => String -> String -> t -> t
parsetimewith pat s def = fromMaybe def $ parseTime defaultTimeLocale pat s
datetimeToDate :: DateTime -> Date
datetimeToDate (DateTime (UTCTime{utctDay=day})) = Date (UTCTime day 0)
elapsedSeconds :: Fractional a => DateTime -> DateTime -> a
elapsedSeconds (DateTime dt1) (DateTime dt2) = realToFrac $ diffUTCTime dt1 dt2