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

remove DateTime and Date types, use Day and UTCTime directly

Browse Source 
This seems simplest for now, I might bring type synonyms back later.
This commit is contained in:
Simon Michael 2008-11-27 04:01:07 +00:00
parent b7616562d9
commit 630e22312b
8 changed files with 61 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
Ledger/Dates.hs
View File

@ -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. 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. 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",""), We represent these as a triple of strings like ("2008","12",""),
@ -30,82 +27,62 @@ import Ledger.Types
import Ledger.Utils import Ledger.Utils
instance Show Date where showDate :: Day -> String
show (Date t) = formatTime defaultTimeLocale "%Y/%m/%d" t showDate d = formatTime defaultTimeLocale "%Y/%m/%d" d
instance Show DateTime where mkUTCTime :: Day -> TimeOfDay -> UTCTime
show (DateTime t) = formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" t mkUTCTime day tod = localTimeToUTC utc (LocalTime day tod)
mkDate :: Day -> Date today :: IO Day
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 today = do
t <- getZonedTime t <- getZonedTime
return (mkDate (localDay (zonedTimeToLocalTime t))) return $ localDay (zonedTimeToLocalTime t)
now :: IO DateTime now :: IO UTCTime
now = fmap DateTime getCurrentTime now = getCurrentTime
datetimeToDate :: DateTime -> Date elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
datetimeToDate (DateTime (UTCTime{utctDay=day})) = Date (UTCTime day 0) elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2
elapsedSeconds :: Fractional a => DateTime -> DateTime -> a dayToUTC :: Day -> UTCTime
elapsedSeconds (DateTime dt1) (DateTime dt2) = realToFrac $ diffUTCTime dt1 dt2 dayToUTC d = localTimeToUTC utc (LocalTime d midnight)
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
-- | Convert a fuzzy date string to an explicit yyyy/mm/dd string using -- | Convert a fuzzy date string to an explicit yyyy/mm/dd string using
-- the provided date as reference point. -- the provided date as reference point.
fixSmartDateStr :: Date -> String -> String fixSmartDateStr :: Day -> String -> String
fixSmartDateStr t s = printf "%04d/%02d/%02d" y m d fixSmartDateStr t s = printf "%04d/%02d/%02d" y m d
where where
pdate = fromparse $ parsewith smartdate $ map toLower s (y,m,d) = toGregorian $ fixSmartDate t sdate
(y,m,d) = dateComponents $ fixSmartDate t pdate sdate = fromparse $ parsewith smartdate $ map toLower s
-- | Convert a SmartDate to an absolute date using the provided date as -- | Convert a SmartDate to an absolute date using the provided date as
-- reference point. -- reference point.
fixSmartDate :: Date -> SmartDate -> Date fixSmartDate :: Day -> SmartDate -> Day
fixSmartDate refdate sdate = mkDate $ fromGregorian y m d fixSmartDate refdate sdate = fix sdate
where where
(y,m,d) = fix sdate fix :: SmartDate -> Day
callondate f d = dateComponents $ mkDate $ f $ utctDay $ dateToUTC d fix ("","","today") = fromGregorian ry rm rd
fix :: SmartDate -> (Integer,Int,Int) fix ("","this","day") = fromGregorian ry rm rd
fix ("","","today") = (ry, rm, rd) fix ("","","yesterday") = prevday refdate
fix ("","this","day") = (ry, rm, rd) fix ("","last","day") = prevday refdate
fix ("","","yesterday") = callondate prevday refdate fix ("","","tomorrow") = nextday refdate
fix ("","last","day") = callondate prevday refdate fix ("","next","day") = nextday refdate
fix ("","","tomorrow") = callondate nextday refdate fix ("","last","week") = prevweek refdate
fix ("","next","day") = callondate nextday refdate fix ("","this","week") = thisweek refdate
fix ("","last","week") = callondate prevweek refdate fix ("","next","week") = nextweek refdate
fix ("","this","week") = callondate thisweek refdate fix ("","last","month") = prevmonth refdate
fix ("","next","week") = callondate nextweek refdate fix ("","this","month") = thismonth refdate
fix ("","last","month") = callondate prevmonth refdate fix ("","next","month") = nextmonth refdate
fix ("","this","month") = callondate thismonth refdate fix ("","last","quarter") = prevquarter refdate
fix ("","next","month") = callondate nextmonth refdate fix ("","this","quarter") = thisquarter refdate
fix ("","last","quarter") = callondate prevquarter refdate fix ("","next","quarter") = nextquarter refdate
fix ("","this","quarter") = callondate thisquarter refdate fix ("","last","year") = prevyear refdate
fix ("","next","quarter") = callondate nextquarter refdate fix ("","this","year") = thisyear refdate
fix ("","last","year") = callondate prevyear refdate fix ("","next","year") = nextyear refdate
fix ("","this","year") = callondate thisyear refdate fix ("","",d) = fromGregorian ry rm (read d)
fix ("","next","year") = callondate nextyear refdate fix ("",m,d) = fromGregorian ry (read m) (read d)
fix ("","",d) = (ry, rm, read d) fix (y,m,d) = fromGregorian (read y) (read m) (read d)
fix ("",m,d) = (ry, read m, read d) (ry,rm,rd) = toGregorian refdate
fix (y,m,d) = (read y, read m, read d)
(ry,rm,rd) = dateComponents refdate
prevday :: Day -> Day prevday :: Day -> Day
prevday = addDays (-1) prevday = addDays (-1)
@ -141,14 +118,14 @@ startofyear day = fromGregorian y 1 1 where (y,_,_) = toGregorian day
-- parsing -- parsing
-- | 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 -> UTCTime
parsedatetime s = DateTime $ parsedatetime s =
parsetimewith "%Y/%m/%d %H:%M:%S" s $ parsetimewith "%Y/%m/%d %H:%M:%S" s $
error $ printf "could not parse timestamp \"%s\"" s error $ printf "could not parse timestamp \"%s\"" s
-- | Parse a date string to a time type, or raise an error. -- | Parse a date string to a time type, or raise an error.
parsedate :: String -> Date parsedate :: String -> Day
parsedate s = Date $ parsedate s =
parsetimewith "%Y/%m/%d" s $ parsetimewith "%Y/%m/%d" s $
error $ printf "could not parse date \"%s\"" s error $ printf "could not parse date \"%s\"" s

5
Ledger/Entry.hs
View File

@ -54,7 +54,7 @@ showEntry e =
where where
precedingcomment = epreceding_comment_lines e precedingcomment = epreceding_comment_lines e
description = concat [date, status, code, desc] -- , comment] description = concat [date, status, code, desc] -- , comment]
date = showDate $ edate e date = showdate $ edate e
status = if estatus e then " *" else "" status = if estatus e then " *" else ""
code = if (length $ ecode e) > 0 then (printf " (%s)" $ ecode e) else "" code = if (length $ ecode e) > 0 then (printf " (%s)" $ ecode e) else ""
desc = " " ++ edescription e desc = " " ++ edescription e
@ -67,8 +67,7 @@ showEntry e =
showamount = printf "%12s" . showMixedAmount showamount = printf "%12s" . showMixedAmount
showaccountname s = printf "%-34s" s showaccountname s = printf "%-34s" s
showcomment s = if (length s) > 0 then " ; "++s else "" showcomment s = if (length s) > 0 then " ; "++s else ""
showdate d = printf "%-10s" (showDate d)
showDate d = printf "%-10s" (show d)
isEntryBalanced :: Entry -> Bool isEntryBalanced :: Entry -> Bool
isEntryBalanced (Entry {etransactions=ts}) = isEntryBalanced (Entry {etransactions=ts}) =

13
Ledger/Parse.hs
View File

@ -237,8 +237,8 @@ ledgerentry = do
transactions <- ledgertransactions transactions <- ledgertransactions
return $ balanceEntry $ Entry date status code description comment transactions (unlines preceding) return $ balanceEntry $ Entry date status code description comment transactions (unlines preceding)
ledgerday :: Parser Day ledgerdate :: Parser Day
ledgerday = do ledgerdate = do
y <- many1 digit y <- many1 digit
char '/' char '/'
m <- many1 digit m <- many1 digit
@ -247,12 +247,9 @@ ledgerday = do
many spacenonewline many spacenonewline
return (fromGregorian (read y) (read m) (read d)) return (fromGregorian (read y) (read m) (read d))
ledgerdate :: Parser Date ledgerdatetime :: Parser UTCTime
ledgerdate = fmap mkDate ledgerday
ledgerdatetime :: Parser DateTime
ledgerdatetime = do ledgerdatetime = do
day <- ledgerday day <- ledgerdate
h <- many1 digit h <- many1 digit
char ':' char ':'
m <- many1 digit m <- many1 digit
@ -260,7 +257,7 @@ ledgerdatetime = do
char ':' char ':'
many1 digit many1 digit
many spacenonewline 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 ledgerstatus :: Parser Bool

4
Ledger/RawLedger.hs
View File

@ -43,7 +43,7 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l
-- | Remove ledger entries we are not interested in. -- | Remove ledger entries we are not interested in.
-- Keep only those which fall between the begin and end dates, and match -- 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. -- 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 = filterRawLedger begin end pats clearedonly realonly =
filterRawLedgerTransactionsByRealness realonly . filterRawLedgerTransactionsByRealness realonly .
filterRawLedgerEntriesByClearedStatus clearedonly . filterRawLedgerEntriesByClearedStatus clearedonly .
@ -59,7 +59,7 @@ filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) =
-- | Keep only entries which fall between begin and end dates. -- | Keep only entries which fall between begin and end dates.
-- We include entries on the begin date and exclude entries on the end -- We include entries on the begin date and exclude entries on the end
-- date, like ledger. An empty date string means no restriction. -- 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) = filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) =
RawLedger ms ps (filter matchdate es) f RawLedger ms ps (filter matchdate es) f
where where

4
Ledger/TimeLog.hs
View File

@ -53,8 +53,8 @@ entryFromTimeLogInOut i o =
} }
where where
acctname = tlcomment i acctname = tlcomment i
indate = datetimeToDate intime indate = utctDay intime
outdate = datetimeToDate outtime outdate = utctDay outtime
intime = tldatetime i intime = tldatetime i
outtime = tldatetime o outtime = tldatetime o
amount = Mixed [hours $ elapsedSeconds outtime intime / 3600] amount = Mixed [hours $ elapsedSeconds outtime intime / 3600]

8
Ledger/Types.hs
View File

@ -12,8 +12,6 @@ import Ledger.Utils
import qualified Data.Map as Map 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 SmartDate = (String,String,String)
type AccountName = String type AccountName = String
@ -61,7 +59,7 @@ data PeriodicEntry = PeriodicEntry {
} deriving (Eq) } deriving (Eq)
data Entry = Entry { data Entry = Entry {
edate :: Date, edate :: Day,
estatus :: Bool, estatus :: Bool,
ecode :: String, ecode :: String,
edescription :: String, edescription :: String,
@ -79,7 +77,7 @@ data RawLedger = RawLedger {
data TimeLogEntry = TimeLogEntry { data TimeLogEntry = TimeLogEntry {
tlcode :: Char, tlcode :: Char,
tldatetime :: DateTime, tldatetime :: UTCTime,
tlcomment :: String tlcomment :: String
} deriving (Eq,Ord) } deriving (Eq,Ord)
@ -89,7 +87,7 @@ data TimeLog = TimeLog {
data Transaction = Transaction { data Transaction = Transaction {
entryno :: Int, entryno :: Int,
date :: Date, date :: Day,
description :: String, description :: String,
account :: AccountName, account :: AccountName,
amount :: MixedAmount, amount :: MixedAmount,

4
Options.hs
View File

@ -125,7 +125,7 @@ tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs))
tildeExpand xs = return xs tildeExpand xs = return xs
-- | Get the value of the begin date option, if any. -- | Get the value of the begin date option, if any.
beginDateFromOpts :: [Opt] -> Maybe Date beginDateFromOpts :: [Opt] -> Maybe Day
beginDateFromOpts opts = beginDateFromOpts opts =
if null beginopts if null beginopts
then Nothing then Nothing
@ -138,7 +138,7 @@ beginDateFromOpts opts =
(y,m,d) = fromparse $ parsewith smartdate $ last beginopts (y,m,d) = fromparse $ parsewith smartdate $ last beginopts
-- | Get the value of the end date option, if any. -- | Get the value of the end date option, if any.
endDateFromOpts :: [Opt] -> Maybe Date endDateFromOpts :: [Opt] -> Maybe Day
endDateFromOpts opts = endDateFromOpts opts =
if null endopts if null endopts
then Nothing then Nothing

2
RegisterCommand.hs
View File

@ -49,7 +49,7 @@ showRegisterReport opts args l = showtxns ts nulltxn nullmixedamt
showtxn omitdesc t b = concatBottomPadded [entrydesc ++ txn ++ " ", bal] ++ "\n" showtxn omitdesc t b = concatBottomPadded [entrydesc ++ txn ++ " ", bal] ++ "\n"
where where
entrydesc = if omitdesc then replicate 32 ' ' else printf "%s %s " date desc 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 desc = printf "%-20s" $ elideRight 20 de :: String
txn = showRawTransaction $ RawTransaction a amt "" tt txn = showRawTransaction $ RawTransaction a amt "" tt
bal = padleft 12 (showMixedAmountOrZero b) bal = padleft 12 (showMixedAmountOrZero b)