remove DateTime and Date types, use Day and UTCTime directly

This seems simplest for now, I might bring type synonyms back later.

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
 

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}) = 

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

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 

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]

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,

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

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)