From 62071bc4c2f13ee95be7bcd477d1f1e538492b42 Mon Sep 17 00:00:00 2001 From: Michael Rees Date: Thu, 13 Mar 2025 16:02:22 -0500 Subject: [PATCH] feat: timeclock: Add support for multiple clocked in sessions (#2141) We now support having multiple sessions clocked in. These are paired by account name if given on the out entry, and otherwise an out closes the most recent in entry. Note that this breaks some backwards compatibility, in that we previously ignored the description on the clock out entry. To mitigate this, a new hidden flag --timeclock-old has been added, which reverts to the old behavior. --- hledger-lib/Hledger/Data/Timeclock.hs | 106 +++++++++++++++++++- hledger-lib/Hledger/Read/Common.hs | 1 + hledger-lib/Hledger/Read/InputOptions.hs | 2 + hledger-lib/Hledger/Read/TimeclockReader.hs | 39 ++++--- hledger/Hledger/Cli/CliOptions.hs | 1 + hledger/hledger.m4.md | 19 +++- hledger/test/errors/tcclockouttime.test | 6 +- hledger/test/errors/tcorderedactions.test | 4 +- hledger/test/timeclock.test | 92 ++++++++++++++++- 9 files changed, 237 insertions(+), 33 deletions(-) diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index 54895adc2..ad1f76a37 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -10,10 +10,12 @@ converted to 'Transactions' and queried like a ledger. module Hledger.Data.Timeclock ( timeclockEntriesToTransactions + ,timeclockEntriesToTransactionsSingle ,tests_Timeclock ) where +import Data.List (partition, sortBy, uncons) import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Time.Calendar (addDays) @@ -47,12 +49,97 @@ instance Read TimeclockCode where readsPrec _ ('O' : xs) = [(FinalOut, xs)] readsPrec _ _ = [] +data Session = Session + { in' :: TimeclockEntry, + out :: TimeclockEntry + } + +data Sessions = Sessions + { completed :: [Session], + active :: [TimeclockEntry] + } + +-- Find the relevant clockin in the actives list that should be paired with this clockout. +-- If there is a session that has the same account name, then use that. +-- Otherwise, if there is an active anonymous session, use that. +-- Otherwise, raise an error. +findInForOut :: TimeclockEntry -> ([TimeclockEntry], [TimeclockEntry]) -> (TimeclockEntry, [TimeclockEntry]) +findInForOut _ (matchingout : othermatches, rest) = (matchingout, othermatches <> rest) +findInForOut o ([], activeins) = + if emptyname then (first, rest) else error' errmsg + where + l = show $ unPos $ sourceLine $ tlsourcepos o + c = unPos $ sourceColumn $ tlsourcepos o + emptyname = tlaccount o == "" + (first, rest) = case uncons activeins of + Just (hd, tl) -> (hd, tl) + Nothing -> error' errmsg + errmsg = + printf + "%s:\n%s\n%s\n\nCould not find previous clockin to match this clockout." + (sourcePosPretty $ tlsourcepos o) + (l ++ " | " ++ show o) + (replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ "^") + +-- Assuming that entries has been sorted, we go through each time log entry. +-- We collect all of the "i" in the list "actives," and each time we encounter +-- an "o," we look for the corresponding "i" in actives. +-- If we cannot find it, then it is an error (since the list is sorted). +-- If the "o" is recorded on a different day than the "i," then we close the +-- active entry at the end of its day, replace it in the active list +-- with a start at midnight on the next day, and try again. +-- This raises an error if any outs cannot be paired with an in. +pairClockEntries :: [TimeclockEntry] -> [TimeclockEntry] -> [Session] -> Sessions +pairClockEntries [] actives sessions = Sessions {completed = sessions, active = actives} +pairClockEntries (entry : rest) actives sessions + | tlcode entry == In = pairClockEntries rest inentries sessions + | tlcode entry == Out = pairClockEntries rest' actives' sessions' + | otherwise = pairClockEntries rest actives sessions + where + (inentry, newactive) = findInForOut entry (partition (\e -> tlaccount e == tlaccount entry) actives) + (itime, otime) = (tldatetime inentry, tldatetime entry) + (idate, odate) = (localDay itime, localDay otime) + omidnight = entry {tldatetime = itime {localDay = idate, localTimeOfDay = TimeOfDay 23 59 59}} + imidnight = inentry {tldatetime = itime {localDay = addDays 1 idate, localTimeOfDay = midnight}} + (sessions', actives', rest') = if odate > idate then + (Session {in' = inentry, out = omidnight} : sessions, imidnight : newactive, entry : rest) + else + (Session {in' = inentry, out = entry} : sessions, newactive, rest) + l = show $ unPos $ sourceLine $ tlsourcepos entry + c = unPos $ sourceColumn $ tlsourcepos entry + inentries = + if any (\e -> tlaccount e == tlaccount entry) actives + then error' $ + printf + "%s:\n%s\n%s\n\nEncountered clockin entry for session \"%s\" that is already active." + (sourcePosPretty $ tlsourcepos entry) + (l ++ " | " ++ show entry) + (replicate (length l) ' ' ++ " |" ++ replicate c ' ' ++ "^") + (tlaccount entry) + else entry : actives + -- | Convert time log entries to journal transactions. When there is no -- clockout, add one with the provided current time. Sessions crossing -- midnight are split into days to give accurate per-day totals. +-- If any entries cannot be paired as expected, then an error is raised. timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction] -timeclockEntriesToTransactions _ [] = [] -timeclockEntriesToTransactions now [i] +timeclockEntriesToTransactions now entries = transactions + where + sessions = pairClockEntries (sortBy (\e1 e2 -> compare (tldatetime e1) (tldatetime e2)) entries) [] [] + transactionsFromSession s = entryFromTimeclockInOut (in' s) (out s) + -- If any "in" sessions are in the future, then set their out time to the initial time + outtime te = max now (tldatetime te) + createout te = TimeclockEntry (tlsourcepos te) Out (outtime te) (tlaccount te) "" "" [] + outs = map createout (active sessions) + stillopen = pairClockEntries ((active sessions) <> outs) [] [] + transactions = map transactionsFromSession $ sortBy (\s1 s2 -> compare (in' s1) (in' s2)) (completed sessions ++ completed stillopen) + +-- | Convert time log entries to journal transactions, expecting the entries to be +-- a strict in/out cycle. When there is no clockout, add one with the provided current time. +-- Sessions crossing midnight are split into days to give accurate per-day totals. +timeclockEntriesToTransactionsSingle :: LocalTime -> [TimeclockEntry] -> [Transaction] +timeclockEntriesToTransactionsSingle _ [] = [] +timeclockEntriesToTransactionsSingle now [i] | tlcode i /= In = errorExpectedCodeButGot In i | odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now [i',o] | otherwise = [entryFromTimeclockInOut i o] @@ -63,7 +150,7 @@ timeclockEntriesToTransactions now [i] (idate,odate) = (localDay itime,localDay otime) o' = o{tldatetime=itime{localDay=idate, localTimeOfDay=TimeOfDay 23 59 59}} i' = i{tldatetime=itime{localDay=addDays 1 idate, localTimeOfDay=midnight}} -timeclockEntriesToTransactions now (i:o:rest) +timeclockEntriesToTransactionsSingle now (i:o:rest) | tlcode i /= In = errorExpectedCodeButGot In i | tlcode o /= Out = errorExpectedCodeButGot Out o | odate > idate = entryFromTimeclockInOut i o' : timeclockEntriesToTransactions now (i':o:rest) @@ -98,6 +185,8 @@ entryFromTimeclockInOut i o | otherwise = -- Clockout time earlier than clockin is an error. -- (Clockin earlier than preceding clockin/clockout is allowed.) + -- We should never encounter this case now that we sort the entries, + -- but let's leave it in case of error. error' $ printf ("%s:\n%s\nThis clockout time (%s) is earlier than the previous clockin.\n" ++"Please adjust it to be later than %s.") @@ -155,6 +244,7 @@ tests_Timeclock = testGroup "Timeclock" [ nowstr = showtime now yesterday = prevday today clockin = TimeclockEntry (initialPos "") In + clockout = TimeclockEntry (initialPos "") Out mktime d = LocalTime d . fromMaybe midnight . parseTimeM True defaultTimeLocale "%H:%M:%S" showtime = formatTime defaultTimeLocale "%H:%M" @@ -169,4 +259,14 @@ tests_Timeclock = testGroup "Timeclock" [ txndescs [clockin (mktime today "00:00:00") "" "" "" []] @?= ["00:00-"++nowstr] step "use the clockin time for auto-clockout if it's in the future" txndescs [clockin future "" "" "" []] @?= [printf "%s-%s" futurestr futurestr] + step "multiple open sessions" + txndescs + [ clockin (mktime today "00:00:00") "a" "" "" [], + clockin (mktime today "01:00:00") "b" "" "" [], + clockin (mktime today "02:00:00") "c" "" "" [], + clockout (mktime today "03:00:00") "b" "" "" [], + clockout (mktime today "04:00:00") "a" "" "" [], + clockout (mktime today "05:00:00") "c" "" "" [] + ] + @?= ["00:00-04:00", "01:00-03:00", "02:00-05:00"] ] diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index d54776efd..9cb9d2bbe 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -231,6 +231,7 @@ rawOptsToInputOpts day usecoloronstdout postingaccttags rawopts = } ,strict_ = boolopt "strict" rawopts ,_ioDay = day + ,_oldtimeclock = boolopt "oldtimeclock" rawopts } handleReadFnToTextReadFn :: (InputOpts -> FilePath -> Text -> ExceptT String IO Journal) -> InputOpts -> FilePath -> Handle -> ExceptT String IO Journal diff --git a/hledger-lib/Hledger/Read/InputOptions.hs b/hledger-lib/Hledger/Read/InputOptions.hs index 1c57e653d..d06e3c8b6 100644 --- a/hledger-lib/Hledger/Read/InputOptions.hs +++ b/hledger-lib/Hledger/Read/InputOptions.hs @@ -44,6 +44,7 @@ data InputOpts = InputOpts { ,strict_ :: Bool -- ^ do extra correctness checks ? ,_defer :: Bool -- ^ internal flag: postpone checks, because we are processing multiple files ? ,_ioDay :: Day -- ^ today's date, for use with forecast transactions XXX this duplicates _rsDay, and should eventually be removed when it's not needed anymore. + ,_oldtimeclock :: Bool -- ^ parse with the old timeclock pairing rules? } deriving (Eq, Ord, Show) definputopts :: InputOpts @@ -66,6 +67,7 @@ definputopts = InputOpts , strict_ = False , _defer = False , _ioDay = nulldate + , _oldtimeclock = False } -- | Get the Maybe the DateSpan to generate forecast options from. diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 3160e9fd2..ad953219e 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -80,32 +80,41 @@ reader = Reader {rFormat = Timeclock ,rExtensions = ["timeclock"] ,rReadFn = handleReadFnToTextReadFn parse - ,rParser = timeclockfilep + ,rParser = timeclockfilep definputopts } -- | Parse and post-process a "Journal" from timeclock.el's timeclock -- format, saving the provided file path and the current time, or give an -- error. parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal -parse iopts fp t = initialiseAndParseJournal timeclockfilep iopts fp t +parse iopts fp t = initialiseAndParseJournal (timeclockfilep iopts) iopts fp t >>= liftEither . journalApplyAliases (aliasesFromOpts iopts) >>= journalFinalise iopts fp t --- ** parsers -timeclockfilep :: MonadIO m => JournalParser m ParsedJournal -timeclockfilep = do many timeclockitemp - eof - j@Journal{jparsetimeclockentries=es} <- get - -- Convert timeclock entries in this journal to transactions, closing any unfinished sessions. - -- Doing this here rather than in journalFinalise means timeclock sessions can't span file boundaries, - -- but it simplifies code above. - now <- liftIO getCurrentLocalTime - -- entries have been parsed in reverse order. timeclockEntriesToTransactions - -- expects them to be in normal order, then we must reverse again since - -- journalFinalise expects them in reverse order - let j' = j{jtxns = reverse $ timeclockEntriesToTransactions now $ reverse es, jparsetimeclockentries = []} - return j' +-- timeclockfilepspecial :: InputOpts -> JournalParser m ParsedJournal +-- timeclockfilepspecial args = +-- timeclockfilep args + +timeclockfilep :: MonadIO m => InputOpts -> JournalParser m ParsedJournal +timeclockfilep iopts = do many timeclockitemp + eof + j@Journal{jparsetimeclockentries=es} <- get + -- Convert timeclock entries in this journal to transactions, closing any unfinished sessions. + -- Doing this here rather than in journalFinalise means timeclock sessions can't span file boundaries, + -- but it simplifies code above. + now <- liftIO getCurrentLocalTime + -- journalFinalise expects the transactions in reverse order, so reverse the output in either case + let j' = if (_oldtimeclock iopts) then + -- timeclockEntriesToTransactionsSingle expects the entries to be in normal order, + -- but they have been parsed in reverse order, so reverse them before calling + j{jtxns = reverse $ timeclockEntriesToTransactionsSingle now $ reverse es, jparsetimeclockentries = []} + else + -- We don't need to reverse these transactions + -- since they are sorted inside of timeclockEntiresToTransactions + j{jtxns = reverse $ timeclockEntriesToTransactions now es, jparsetimeclockentries = []} + return j' where -- As all ledger line types can be distinguished by the first -- character, excepting transactions versus empty (blank or diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index a11fc8ce4..04c26d98d 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -283,6 +283,7 @@ hiddenflagsformainmode = [ ,flagNone ["pretty-tables"] (setopt "pretty" "always") "legacy flag that was renamed" ,flagNone ["anon"] (setboolopt "anon") "deprecated, renamed to --obfuscate" -- #2133, handled by anonymiseByOpts ,flagNone ["obfuscate"] (setboolopt "obfuscate") "slightly obfuscate hledger's output. Warning, does not give privacy. Formerly --anon." -- #2133, handled by maybeObfuscate + ,flagNone ["timeclock-old"] (setboolopt "oldtimeclock") "don't pair timeclock entries by account name" ,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules" s opts) "RULESFILE" "was renamed to --rules" ] diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 684e76793..6d06aa59b 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -4606,12 +4606,19 @@ i 2015/03/30 09:00:00 some account optional description after 2 spaces ; option o 2015/03/30 09:20:00 i 2015/03/31 22:21:45 another:account o 2015/04/01 02:00:34 +i 2015/04/02 12:00:00 another:account ; this demonstrates multple sessions being clocked in +i 2015/04/02 13:00:00 some account +o 2015/04/02 14:00:00 +o 2015/04/02 15:00:00 another:account ``` hledger treats each clock-in/clock-out pair as a transaction posting -some number of hours to an account. Or if the session spans more than -one day, it is split into several transactions, one for each day. For -the above time log, `hledger print` generates these journal entries: +some number of hours to an account. Entries are paired by the account +name if the same name is given for a clock-in/clock-out pair. If no +name is given for a clock-out, then it is paired with the most recent +clock-in entry. If the session spans more than one day, it is split into +several transactions, one for each day. For the above time log, +`hledger print` generates these journal entries: ```cli $ hledger -f t.timeclock print @@ -4624,6 +4631,12 @@ $ hledger -f t.timeclock print 2015-04-01 * 00:00-02:00 (another:account) 2.01h +2015-04-02 * 12:00-15:00 ; this demonstrates multiple sessions being clocked in + (another:account) 3.00h + +2015-04-02 * 13:00-14:00 + (some account) 1.00h + ``` Here is a diff --git a/hledger/test/errors/tcclockouttime.test b/hledger/test/errors/tcclockouttime.test index 26ec46d00..4f48ad5b3 100644 --- a/hledger/test/errors/tcclockouttime.test +++ b/hledger/test/errors/tcclockouttime.test @@ -1,10 +1,8 @@ $$$ hledger check -f tcclockouttime.timeclock >>>2 /hledger: Error: .*tcclockouttime.timeclock:5:1: - \| i 2022-01-01 00:01:00 5 \| o 2022-01-01 00:00:00 - \| \^\^\^\^\^\^\^\^\^\^\^\^\^\^\^\^\^\^\^ + \| \^ -This clockout time \(2022-01-01 00:00:00\) is earlier than the previous clockin. -Please adjust it to be later than 2022-01-01 00:01:00. +Could not find previous clockin to match this clockout. / >>>= 1 diff --git a/hledger/test/errors/tcorderedactions.test b/hledger/test/errors/tcorderedactions.test index f0ccb62c2..4a3806793 100644 --- a/hledger/test/errors/tcorderedactions.test +++ b/hledger/test/errors/tcorderedactions.test @@ -3,8 +3,6 @@ $$$ hledger check -f tcorderedactions.timeclock 8 \| i 2022-01-01 00:01:00 \| \^ -Expected a timeclock o entry but got i. -Only one session may be clocked in at a time. -Please alternate i and o, beginning with i. +Encountered clockin entry for session "" that is already active. / >>>= 1 diff --git a/hledger/test/timeclock.test b/hledger/test/timeclock.test index a535ea8f8..ec59b9f48 100644 --- a/hledger/test/timeclock.test +++ b/hledger/test/timeclock.test @@ -3,7 +3,7 @@ # ** 1. a timeclock session is parsed as a similarly-named transaction with one virtual posting. < i 2009/1/1 08:00:00 -o 2009/1/1 09:00:00 stuff on checkout record is ignored +o 2009/1/1 09:00:00 i 2009/1/2 08:00:00 account name o 2009/1/2 09:00:00 @@ -43,19 +43,19 @@ $ hledger -f timeclock:- balance > /./ >= -# ** 4. For a log not starting with clock-out, print error +# ** 4. For a log not starting with clock-in, print error < o 2020/1/1 08:00 $ hledger -f timeclock:- balance ->2 /Expected a timeclock i entry/ +>2 /Could not find previous clockin to match this clockout./ >= !0 -# ** 5. For two consecutive clock-ins, print error +# ** 5. For two consecutive anonymous clock-ins, print error < i 2020/1/1 08:00 i 2020/1/1 09:00 $ hledger -f timeclock:- balance ->2 /Expected a timeclock o entry/ +>2 /Encountered clockin entry for session "" that is already active./ >= !0 # ** 6. Timeclock amounts are always rounded to two decimal places, @@ -87,6 +87,88 @@ $ hledger -f timeclock:- accounts acct 1 acct 2 +# ** 9. Support multiple sessions simultaneously clocked in. +< +i 2025-03-10 08:00:00 multi:1 description 1 +i 2025-03-10 09:00:00 multi:2 description 2 ; note that these entries are both active +o 2025-03-10 12:00:00 multi:1 +o 2025-03-10 15:00:00 multi:2 +$ hledger -f timeclock:- print +> +2025-03-10 * description 1 + (multi:1) 4.00h + +2025-03-10 * description 2 ; note that these entries are both active + (multi:2) 6.00h + +>= + +# ** 10. Implicit clockouts apply to the correct session. +# The first 'o' here applies to multi:3, the next explicitly to multi:1, and the third to multi:2. +< +i 2025-03-10 08:00:00 multi:1 description 1 +i 2025-03-10 09:00:00 multi:2 description 2 +i 2025-03-10 10:00:00 multi:3 description 3 +o 2025-03-10 11:00:00 +o 2025-03-10 12:00:00 multi:1 +o 2025-03-10 15:00:00 +$ hledger -f timeclock:- print +> +2025-03-10 * description 1 + (multi:1) 4.00h + +2025-03-10 * description 2 + (multi:2) 6.00h + +2025-03-10 * description 3 + (multi:3) 1.00h + +>= + +# ** 11. Multiple active sessions can span multiple days. +< +i 2025-03-11 19:00:00 multi:1 +i 2025-03-11 20:00:00 multi:2 +o 2025-03-12 08:00:00 +o 2025-03-12 09:00:00 +$ hledger -f timeclock:- print +> +2025-03-11 * 19:00-23:59 + (multi:1) 5.00h + +2025-03-11 * 20:00-23:59 + (multi:2) 4.00h + +2025-03-12 * 00:00-09:00 + (multi:1) 9.00h + +2025-03-12 * 00:00-08:00 + (multi:2) 8.00h + +>= + +# ** 12. The --timeclock-old flag reverts to the old behavior. +< +i 2009/1/1 08:00:00 +o 2009/1/1 09:00:00 stuff on checkout record is ignored + +i 2009/1/2 08:00:00 account name +o 2009/1/2 09:00:00 +i 2009/1/3 08:00:00 some:account name and a description +o 2009/1/3 09:00:00 + +$ hledger --timeclock-old -f timeclock:- print +> +2009-01-01 * 08:00-09:00 + () 1.00h + +2009-01-02 * 08:00-09:00 + (account name) 1.00h + +2009-01-03 * and a description + (some:account name) 1.00h + +>= ## TODO ## multi-day sessions get a new transaction for each day