count time elapsed in open timelog entries, ignore time zone

Any open sessions in a timelog will be considered clocked out as of the
current time, and included in calculations. Also, contrary to the earlier
patch we now ignore timezone everywhere and deal only with local times.
This might need revisiting eg to track time while crossing timezones.

Ledger/Dates.hs

@@ -47,9 +47,6 @@ getCurrentDay = do
 elapsedSeconds :: Fractional a => UTCTime -> UTCTime -> a
 elapsedSeconds t1 t2 = realToFrac $ diffUTCTime t1 t2
 
-dayToUTC :: Day -> UTCTime
-dayToUTC d = localTimeToUTC utc (LocalTime d midnight)
-
 -- | Split a DateSpan into one or more consecutive spans at the specified interval.
 splitSpan :: Interval -> DateSpan -> [DateSpan]
 splitSpan i (DateSpan Nothing Nothing) = [DateSpan Nothing Nothing]
@@ -192,14 +189,14 @@ firstJust ms = case dropWhile (==Nothing) ms of
     [] -> Nothing
     (md:_) -> md
 
-parsedatetimeM :: String -> Maybe UTCTime
+parsedatetimeM :: String -> Maybe LocalTime
 parsedatetimeM s = firstJust [
     parseTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" s,
     parseTime defaultTimeLocale "%Y-%m-%d %H:%M:%S" s
     ]
 
 -- | Parse a date-time string to a time type, or raise an error.
-parsedatetime :: String -> UTCTime
+parsedatetime :: String -> LocalTime
 parsedatetime s = fromMaybe (error $ "could not parse timestamp \"" ++ s ++ "\"")
                             (parsedatetimeM s)
 

Ledger/Parse.hs

@@ -33,14 +33,13 @@ import System.FilePath(takeDirectory,combine)
 
 -- | Some context kept during parsing.
 data LedgerFileCtx = Ctx {
-      ctxTimeZone :: !TimeZone         -- ^ the user's timezone
-    , ctxYear     :: !(Maybe Integer)  -- ^ the default year most recently specified with Y
+      ctxYear     :: !(Maybe Integer)  -- ^ the default year most recently specified with Y
     , ctxCommod   :: !(Maybe String)   -- ^ I don't know
     , ctxAccount  :: ![String]         -- ^ the current stack of "container" accounts specified by !account
     } deriving (Read, Show)
 
 emptyCtx :: LedgerFileCtx
-emptyCtx = Ctx { ctxTimeZone=utc, ctxYear=Nothing, ctxCommod=Nothing, ctxAccount=[] }
+emptyCtx = Ctx { ctxYear = Nothing, ctxCommod = Nothing, ctxAccount = [] }
 
 -- containing accounts "nest" hierarchically
 
@@ -64,25 +63,23 @@ setYear y = updateState (\ctx -> ctx{ctxYear=Just y})
 getYear :: GenParser tok LedgerFileCtx (Maybe Integer)
 getYear = liftM ctxYear getState
 
-setTimeZone :: TimeZone -> GenParser tok LedgerFileCtx ()
-setTimeZone tz = updateState (\ctx -> ctx{ctxTimeZone=tz})
-
-getCtxTimeZone :: GenParser tok LedgerFileCtx TimeZone
-getCtxTimeZone = liftM ctxTimeZone getState
-
--- let's get to it
-
-parseLedgerFile :: FilePath -> ErrorT String IO RawLedger
-parseLedgerFile "-" = liftIO (hGetContents stdin) >>= parseLedger "-"
-parseLedgerFile f   = liftIO (readFile f)         >>= parseLedger f
-
 printParseError :: (Show a) => a -> IO ()
 printParseError e = do putStr "ledger parse error at "; print e
 
-parseLedger :: FilePath -> String -> ErrorT String IO RawLedger
-parseLedger inname intxt = case runParser ledgerFile emptyCtx inname intxt of
-                             Right m  -> liftM rawLedgerConvertTimeLog $ m `ap` (return rawLedgerEmpty)
-                             Left err -> throwError $ show err
+-- let's get to it
+
+parseLedgerFile :: LocalTime -> FilePath -> ErrorT String IO RawLedger
+parseLedgerFile t "-" = liftIO (hGetContents stdin) >>= parseLedger t "-"
+parseLedgerFile t f   = liftIO (readFile f)         >>= parseLedger t f
+
+-- | Parses the contents of a ledger file, or gives an error.  Requires
+-- the current (local) time to calculate any unfinished timelog sessions,
+-- we pass it in for repeatability.
+parseLedger :: LocalTime -> FilePath -> String -> ErrorT String IO RawLedger
+parseLedger reftime inname intxt = do
+  case runParser ledgerFile emptyCtx inname intxt of
+    Right m  -> liftM (rawLedgerConvertTimeLog reftime) $ m `ap` (return rawLedgerEmpty)
+    Left err -> throwError $ show err
 
 -- As all ledger line types can be distinguished by the first
 -- character, excepting transactions versus empty (blank or
@@ -337,7 +334,7 @@ ledgerpartialdate = do
   when (y==Nothing) $ error "partial date found, but no default year specified"
   return $ fromGregorian (fromJust y) (read m) (read d)
 
-ledgerdatetime :: GenParser Char LedgerFileCtx UTCTime
+ledgerdatetime :: GenParser Char LedgerFileCtx LocalTime
 ledgerdatetime = do 
   day <- ledgerdate
   h <- many1 digit
@@ -348,8 +345,7 @@ ledgerdatetime = do
       many1 digit
   many spacenonewline
   let tod = TimeOfDay (read h) (read m) (maybe 0 (fromIntegral.read) s)
-  tz <- getCtxTimeZone
-  return $ localTimeToUTC tz (LocalTime day tod)
+  return $ LocalTime day tod
 
 ledgerstatus :: GenParser Char st Bool
 ledgerstatus = try (do { char '*'; many1 spacenonewline; return True } ) <|> return False

Ledger/RawLedger.hs

@@ -147,9 +147,10 @@ rawLedgerCommodities = map commodity . concatMap amounts . rawLedgerAmounts
 rawLedgerPrecisions :: RawLedger -> [Int]
 rawLedgerPrecisions = map precision . rawLedgerCommodities
 
-rawLedgerConvertTimeLog :: RawLedger -> RawLedger
-rawLedgerConvertTimeLog l0 = l0 { entries = convertedTimeLog ++ entries l0
-                                , open_timelog_entries = []
-                                }
-    where convertedTimeLog = entriesFromTimeLogEntries $ open_timelog_entries l0
+-- | Close any open timelog sessions using the provided current time.
+rawLedgerConvertTimeLog :: LocalTime -> RawLedger -> RawLedger
+rawLedgerConvertTimeLog t l0 = l0 { entries = convertedTimeLog ++ entries l0
+                                  , open_timelog_entries = []
+                                  }
+    where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0
 

Ledger/TimeLog.hs

@@ -21,43 +21,41 @@ instance Show TimeLogEntry where
 instance Show TimeLog where
     show tl = printf "TimeLog with %d entries" $ length $ timelog_entries tl
 
--- | Convert time log entries to ledger entries.
-entriesFromTimeLogEntries :: [TimeLogEntry] -> [Entry]
-entriesFromTimeLogEntries [] = []
-entriesFromTimeLogEntries [i] = entriesFromTimeLogEntries [i, clockoutFor i]
-entriesFromTimeLogEntries (i:o:rest) = [entryFromTimeLogInOut i o] ++ entriesFromTimeLogEntries rest
-
--- | When there is a trailing clockin entry, provide the missing clockout.
--- An entry for now is what we want but this requires IO so for now use
--- the clockin time, ie don't count the current clocked-in period.
-clockoutFor :: TimeLogEntry -> TimeLogEntry
-clockoutFor (TimeLogEntry _ t _) = TimeLogEntry 'o' t ""
+-- | Convert time log entries to ledger entries. When there is no clockout,
+-- add one with the provided current time.
+entriesFromTimeLogEntries :: LocalTime -> [TimeLogEntry] -> [Entry]
+entriesFromTimeLogEntries _ [] = []
+entriesFromTimeLogEntries t [i] = [entryFromTimeLogInOut i (TimeLogEntry 'o' t "")]
+entriesFromTimeLogEntries t (i:o:rest) = [entryFromTimeLogInOut i o] ++ entriesFromTimeLogEntries t rest
 
 -- | Convert a timelog clockin and clockout entry to an equivalent ledger
 -- entry, representing the time expenditure. Note this entry is  not balanced,
 -- since we omit the \"assets:time\" transaction for simpler output.
 entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Entry
 entryFromTimeLogInOut i o
-    | outtime >= intime = e
+    | otime >= itime = e
     | otherwise = 
         error $ "clock-out time less than clock-in time in:\n" ++ showEntry e
     where
       e = Entry {
-            edate         = outdate, -- like ledger
+            edate         = odate, -- like ledger
             estatus       = True,
             ecode         = "",
-            edescription  = showtime intime ++ " - " ++ showtime outtime,
+            edescription  = showtime itod ++ "-" ++ showtime otod,
             ecomment      = "",
             etransactions = txns,
             epreceding_comment_lines=""
           }
-      showtime = show . timeToTimeOfDay . utctDayTime
+      showtime = take 5 . show
       acctname = tlcomment i
-      indate   = utctDay intime
-      outdate  = utctDay outtime
-      intime   = tldatetime i
-      outtime  = tldatetime o
-      amount   = Mixed [hours $ elapsedSeconds outtime intime / 3600]
+      itime    = tldatetime i
+      otime    = tldatetime o
+      itod     = localTimeOfDay itime
+      otod     = localTimeOfDay otime
+      idate    = localDay itime
+      odate    = localDay otime
+      hrs      = elapsedSeconds (toutc otime) (toutc itime) / 3600 where toutc = localTimeToUTC utc
+      amount   = Mixed [hours hrs]
       txns     = [RawTransaction acctname amount "" RegularTransaction
                  --,RawTransaction "assets:time" (-amount) "" RegularTransaction
                  ]

Ledger/Types.hs

@@ -91,7 +91,7 @@ data RawLedger = RawLedger {
 
 data TimeLogEntry = TimeLogEntry {
       tlcode :: Char,
-      tldatetime :: UTCTime,
+      tldatetime :: LocalTime,
       tlcomment :: String
     } deriving (Eq,Ord)
 

Utils.hs

@@ -17,22 +17,26 @@ import Ledger
 
 -- | Convert a RawLedger to a canonicalised, cached and filtered Ledger
 -- based on the command-line options/arguments and the current date/time.
-prepareLedger ::  [Opt] -> [String] -> UTCTime -> String -> RawLedger -> Ledger
+prepareLedger ::  [Opt] -> [String] -> LocalTime -> String -> RawLedger -> Ledger
 prepareLedger opts args reftime rawtext rl = l{rawledgertext=rawtext}
     where
       l = cacheLedger apats $ filterRawLedger span dpats c r $ canonicaliseAmounts cb rl
       (apats,dpats) = parseAccountDescriptionArgs [] args
-      span = dateSpanFromOpts (utctDay reftime) opts
+      span = dateSpanFromOpts (localDay reftime) opts
       c = Cleared `elem` opts
       r = Real `elem` opts
       cb = CostBasis `elem` opts
 
 -- | Get a RawLedger from the given string, or raise an error.
+-- This uses the current local time as the reference time (for closing
+-- open timelog entries).
 rawledgerfromstring :: String -> IO RawLedger
-rawledgerfromstring = liftM (either error id) . runErrorT . parseLedger "(string)"
+rawledgerfromstring s = do
+  t <- getCurrentLocalTime
+  liftM (either error id) $ runErrorT $ parseLedger t "(string)" s
 
 -- | Get a Ledger from the given string and options, or raise an error.
-ledgerfromstringwithopts :: [Opt] -> [String] -> UTCTime -> String -> IO Ledger
+ledgerfromstringwithopts :: [Opt] -> [String] -> LocalTime -> String -> IO Ledger
 ledgerfromstringwithopts opts args reftime s =
     liftM (prepareLedger opts args reftime s) $ rawledgerfromstring s
 
@@ -41,7 +45,7 @@ ledgerfromfilewithopts :: [Opt] -> [String] -> FilePath -> IO Ledger
 ledgerfromfilewithopts opts args f = do
   s <- readFile f 
   rl <- rawledgerfromstring s
-  reftime <- getCurrentTime
+  reftime <- getCurrentLocalTime
   return $ prepareLedger opts args reftime s rl
            
 -- | Get a Ledger from your default ledger file, or raise an error.

hledger.hs

@@ -50,6 +50,7 @@ import Version (versionmsg)
 import Ledger
 import Utils
 import Options
+import Tests
 import BalanceCommand
 import PrintCommand
 import RegisterCommand
@@ -62,7 +63,6 @@ import qualified ANSICommand
 #ifdef HAPPS
 import qualified WebCommand
 #endif
-import Tests
 
 
 main :: IO ()
@@ -97,6 +97,6 @@ parseLedgerAndDo opts args cmd = do
   -- and, doesn't work with stdin. kludge it, stdin won't work with ui command
   let f' = if f == "-" then "/dev/null" else f
   rawtext <- readFile f'
-  reftime <- getCurrentTime
-  let runcmd = cmd opts args . prepareLedger opts args reftime rawtext
-  return f >>= runErrorT . parseLedgerFile >>= either (hPutStrLn stderr) runcmd
+  t <- getCurrentLocalTime
+  let runcmd = cmd opts args . prepareLedger opts args t rawtext
+  return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) runcmd