diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs index e517b9561..35198ddf5 100644 --- a/Ledger/Dates.hs +++ b/Ledger/Dates.hs @@ -1,8 +1,5 @@ {-| -'Date' and 'DateTime' are a helper layer on top of the standard UTCTime, -Day etc. - A 'SmartDate' is a date which may be partially-specified or relative. Eg 2008/12/31, but also 2008/12, 12/31, tomorrow, last week, next year. We represent these as a triple of strings like ("2008","12",""), @@ -30,82 +27,62 @@ import Ledger.Types import Ledger.Utils -instance Show Date where - show (Date t) = formatTime defaultTimeLocale "%Y/%m/%d" t +showDate :: Day -> String +showDate d = formatTime defaultTimeLocale "%Y/%m/%d" d -instance Show DateTime where - show (DateTime t) = formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" t +mkUTCTime :: Day -> TimeOfDay -> UTCTime +mkUTCTime day tod = localTimeToUTC utc (LocalTime day tod) -mkDate :: Day -> Date -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 :: IO Day today = do t <- getZonedTime - return (mkDate (localDay (zonedTimeToLocalTime t))) + return $ localDay (zonedTimeToLocalTime t) -now :: IO DateTime -now = fmap DateTime getCurrentTime +now :: IO UTCTime +now = getCurrentTime -datetimeToDate :: DateTime -> Date -datetimeToDate (DateTime (UTCTime{utctDay=day})) = Date (UTCTime day 0) +elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a +elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2 -elapsedSeconds :: Fractional a => DateTime -> DateTime -> a -elapsedSeconds (DateTime dt1) (DateTime dt2) = realToFrac $ diffUTCTime dt1 dt2 - -dateToUTC :: Date -> UTCTime -dateToUTC (Date u) = u - -dateComponents :: Date -> (Integer,Int,Int) -dateComponents = toGregorian . utctDay . dateToUTC - --- dateDay :: Date -> Day -dateDay date = d where (_,_,d) = dateComponents date - --- dateMonth :: Date -> Day -dateMonth date = m where (_,m,_) = dateComponents date +dayToUTC :: Day -> UTCTime +dayToUTC d = localTimeToUTC utc (LocalTime d midnight) -- | Convert a fuzzy date string to an explicit yyyy/mm/dd string using -- the provided date as reference point. -fixSmartDateStr :: Date -> String -> String +fixSmartDateStr :: Day -> String -> String fixSmartDateStr t s = printf "%04d/%02d/%02d" y m d where - pdate = fromparse $ parsewith smartdate $ map toLower s - (y,m,d) = dateComponents $ fixSmartDate t pdate + (y,m,d) = toGregorian $ fixSmartDate t sdate + sdate = fromparse $ parsewith smartdate $ map toLower s -- | Convert a SmartDate to an absolute date using the provided date as -- reference point. -fixSmartDate :: Date -> SmartDate -> Date -fixSmartDate refdate sdate = mkDate $ fromGregorian y m d +fixSmartDate :: Day -> SmartDate -> Day +fixSmartDate refdate sdate = fix sdate where - (y,m,d) = fix sdate - callondate f d = dateComponents $ mkDate $ f $ utctDay $ dateToUTC d - fix :: SmartDate -> (Integer,Int,Int) - fix ("","","today") = (ry, rm, rd) - fix ("","this","day") = (ry, rm, rd) - fix ("","","yesterday") = callondate prevday refdate - fix ("","last","day") = callondate prevday refdate - fix ("","","tomorrow") = callondate nextday refdate - fix ("","next","day") = callondate nextday refdate - fix ("","last","week") = callondate prevweek refdate - fix ("","this","week") = callondate thisweek refdate - fix ("","next","week") = callondate nextweek refdate - fix ("","last","month") = callondate prevmonth refdate - fix ("","this","month") = callondate thismonth refdate - fix ("","next","month") = callondate nextmonth refdate - fix ("","last","quarter") = callondate prevquarter refdate - fix ("","this","quarter") = callondate thisquarter refdate - fix ("","next","quarter") = callondate nextquarter refdate - fix ("","last","year") = callondate prevyear refdate - fix ("","this","year") = callondate thisyear refdate - fix ("","next","year") = callondate nextyear refdate - fix ("","",d) = (ry, rm, read d) - fix ("",m,d) = (ry, read m, read d) - fix (y,m,d) = (read y, read m, read d) - (ry,rm,rd) = dateComponents refdate + fix :: SmartDate -> Day + fix ("","","today") = fromGregorian ry rm rd + fix ("","this","day") = fromGregorian ry rm rd + fix ("","","yesterday") = prevday refdate + fix ("","last","day") = prevday refdate + fix ("","","tomorrow") = nextday refdate + fix ("","next","day") = nextday refdate + fix ("","last","week") = prevweek refdate + fix ("","this","week") = thisweek refdate + fix ("","next","week") = nextweek refdate + fix ("","last","month") = prevmonth refdate + fix ("","this","month") = thismonth refdate + fix ("","next","month") = nextmonth refdate + fix ("","last","quarter") = prevquarter refdate + fix ("","this","quarter") = thisquarter refdate + fix ("","next","quarter") = nextquarter refdate + fix ("","last","year") = prevyear refdate + fix ("","this","year") = thisyear refdate + fix ("","next","year") = nextyear refdate + fix ("","",d) = fromGregorian ry rm (read d) + fix ("",m,d) = fromGregorian ry (read m) (read d) + fix (y,m,d) = fromGregorian (read y) (read m) (read d) + (ry,rm,rd) = toGregorian refdate prevday :: Day -> Day prevday = addDays (-1) @@ -141,14 +118,14 @@ startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day -- parsing -- | Parse a date-time string to a time type, or raise an error. -parsedatetime :: String -> DateTime -parsedatetime s = DateTime $ +parsedatetime :: String -> UTCTime +parsedatetime s = 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 $ +parsedate :: String -> Day +parsedate s = parsetimewith "%Y/%m/%d" s $ error $ printf "could not parse date \"%s\"" s diff --git a/Ledger/Entry.hs b/Ledger/Entry.hs index 1f0832221..149082950 100644 --- a/Ledger/Entry.hs +++ b/Ledger/Entry.hs @@ -54,7 +54,7 @@ showEntry e = where precedingcomment = epreceding_comment_lines e description = concat [date, status, code, desc] -- , comment] - date = showDate $ edate e + date = showdate $ edate e status = if estatus e then " *" else "" code = if (length $ ecode e) > 0 then (printf " (%s)" $ ecode e) else "" desc = " " ++ edescription e @@ -67,8 +67,7 @@ showEntry e = showamount = printf "%12s" . showMixedAmount showaccountname s = printf "%-34s" s showcomment s = if (length s) > 0 then " ; "++s else "" - -showDate d = printf "%-10s" (show d) + showdate d = printf "%-10s" (showDate d) isEntryBalanced :: Entry -> Bool isEntryBalanced (Entry {etransactions=ts}) = diff --git a/Ledger/Parse.hs b/Ledger/Parse.hs index bcb7d4b1d..b4b34ed69 100644 --- a/Ledger/Parse.hs +++ b/Ledger/Parse.hs @@ -237,8 +237,8 @@ ledgerentry = do transactions <- ledgertransactions return $ balanceEntry $ Entry date status code description comment transactions (unlines preceding) -ledgerday :: Parser Day -ledgerday = do +ledgerdate :: Parser Day +ledgerdate = do y <- many1 digit char '/' m <- many1 digit @@ -247,12 +247,9 @@ ledgerday = do many spacenonewline return (fromGregorian (read y) (read m) (read d)) -ledgerdate :: Parser Date -ledgerdate = fmap mkDate ledgerday - -ledgerdatetime :: Parser DateTime +ledgerdatetime :: Parser UTCTime ledgerdatetime = do - day <- ledgerday + day <- ledgerdate h <- many1 digit char ':' m <- many1 digit @@ -260,7 +257,7 @@ ledgerdatetime = do char ':' many1 digit many spacenonewline - return (mkDateTime day (TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s))) + return $ mkUTCTime day (TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)) ledgerstatus :: Parser Bool diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index c5846128f..89003b819 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -43,7 +43,7 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l -- | Remove ledger entries we are not interested in. -- Keep only those which fall between the begin and end dates, and match -- the description pattern, and are cleared or real if those options are active. -filterRawLedger :: Maybe Date -> Maybe Date -> [String] -> Bool -> Bool -> RawLedger -> RawLedger +filterRawLedger :: Maybe Day -> Maybe Day -> [String] -> Bool -> Bool -> RawLedger -> RawLedger filterRawLedger begin end pats clearedonly realonly = filterRawLedgerTransactionsByRealness realonly . filterRawLedgerEntriesByClearedStatus clearedonly . @@ -59,7 +59,7 @@ filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) = -- | Keep only entries which fall between begin and end dates. -- We include entries on the begin date and exclude entries on the end -- date, like ledger. An empty date string means no restriction. -filterRawLedgerEntriesByDate :: Maybe Date -> Maybe Date -> RawLedger -> RawLedger +filterRawLedgerEntriesByDate :: Maybe Day -> Maybe Day -> RawLedger -> RawLedger filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) = RawLedger ms ps (filter matchdate es) f where diff --git a/Ledger/TimeLog.hs b/Ledger/TimeLog.hs index e6cdfb8b1..102d98e16 100644 --- a/Ledger/TimeLog.hs +++ b/Ledger/TimeLog.hs @@ -53,8 +53,8 @@ entryFromTimeLogInOut i o = } where acctname = tlcomment i - indate = datetimeToDate intime - outdate = datetimeToDate outtime + indate = utctDay intime + outdate = utctDay outtime intime = tldatetime i outtime = tldatetime o amount = Mixed [hours $ elapsedSeconds outtime intime / 3600] diff --git a/Ledger/Types.hs b/Ledger/Types.hs index fe4aa15a4..311aa5c3b 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -12,8 +12,6 @@ import Ledger.Utils import qualified Data.Map as Map -newtype Date = Date UTCTime deriving (Ord, Eq) -newtype DateTime = DateTime UTCTime deriving (Ord, Eq) type SmartDate = (String,String,String) type AccountName = String @@ -61,7 +59,7 @@ data PeriodicEntry = PeriodicEntry { } deriving (Eq) data Entry = Entry { - edate :: Date, + edate :: Day, estatus :: Bool, ecode :: String, edescription :: String, @@ -79,7 +77,7 @@ data RawLedger = RawLedger { data TimeLogEntry = TimeLogEntry { tlcode :: Char, - tldatetime :: DateTime, + tldatetime :: UTCTime, tlcomment :: String } deriving (Eq,Ord) @@ -89,7 +87,7 @@ data TimeLog = TimeLog { data Transaction = Transaction { entryno :: Int, - date :: Date, + date :: Day, description :: String, account :: AccountName, amount :: MixedAmount, diff --git a/Options.hs b/Options.hs index 31bab4f21..4dc1bb35b 100644 --- a/Options.hs +++ b/Options.hs @@ -125,7 +125,7 @@ tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs)) tildeExpand xs = return xs -- | Get the value of the begin date option, if any. -beginDateFromOpts :: [Opt] -> Maybe Date +beginDateFromOpts :: [Opt] -> Maybe Day beginDateFromOpts opts = if null beginopts then Nothing @@ -138,7 +138,7 @@ beginDateFromOpts opts = (y,m,d) = fromparse $ parsewith smartdate $ last beginopts -- | Get the value of the end date option, if any. -endDateFromOpts :: [Opt] -> Maybe Date +endDateFromOpts :: [Opt] -> Maybe Day endDateFromOpts opts = if null endopts then Nothing diff --git a/RegisterCommand.hs b/RegisterCommand.hs index 3c8d21a17..188177f61 100644 --- a/RegisterCommand.hs +++ b/RegisterCommand.hs @@ -49,7 +49,7 @@ showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt showtxn omitdesc t b = concatBottomPadded [entrydesc ++ txn ++ " ", bal] ++ "\n" where entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc - date = show $ da + date = showDate $ da desc = printf "%-20s" $ elideRight 20 de :: String txn = showRawTransaction $ RawTransaction a amt "" tt bal = padleft 12 (showMixedAmountOrZero b)