From 5a3e34cc5512c8252e7a35f17bca1ad81676d473 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 31 Aug 2025 09:16:38 +0100 Subject: [PATCH] imp:timeclock: syntax is more robust and featureful The default timeclock parser (ie when not using --old-timeclock) has the following changes, related to issues such as [#2141], [#2365], [#2400], [#2417]: - semicolon now always starts a comment; timeclock account names can't include semicolons (though journal account names still can) - clock-in and clock-out entries now have different syntax - clock-ins now require an account name - clock-outs now can have a comment and tags - the doc has been rewritten, and now mentions the --old-timeclock flag - lib: accountnamep and modifiedaccountnamep now take a flag to allow semicolons or not --- hledger-lib/Hledger/Data/Timeclock.hs | 14 +- hledger-lib/Hledger/Read/Common.hs | 44 +++--- hledger-lib/Hledger/Read/JournalReader.hs | 4 +- hledger-lib/Hledger/Read/TimeclockReader.hs | 136 ++++++++++++++++-- hledger-lib/Hledger/Read/TimedotReader.hs | 2 +- hledger/hledger.m4.md | 74 +++++++--- hledger/test/errors/tcclockouttime.timeclock | 2 +- hledger/test/errors/tcorderedactions.test | 7 +- .../test/errors/tcorderedactions.timeclock | 4 +- hledger/test/timeclock.test | 99 +++++-------- 10 files changed, 258 insertions(+), 128 deletions(-) diff --git a/hledger-lib/Hledger/Data/Timeclock.hs b/hledger-lib/Hledger/Data/Timeclock.hs index c7f13c67f..3b3ddae5a 100644 --- a/hledger-lib/Hledger/Data/Timeclock.hs +++ b/hledger-lib/Hledger/Data/Timeclock.hs @@ -7,6 +7,7 @@ converted to 'Transactions' and queried like a ledger. -} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} module Hledger.Data.Timeclock ( timeclockEntriesToTransactions @@ -31,6 +32,10 @@ import Hledger.Data.Dates import Hledger.Data.Amount import Hledger.Data.Posting +-- detailed output for debugging +-- deriving instance Show TimeclockEntry + +-- compact output instance Show TimeclockEntry where show t = printf "%s %s %s %s" (show $ tlcode t) (show $ tldatetime t) (tlaccount t) (tldescription t) @@ -122,10 +127,11 @@ pairClockEntries (entry : rest) actives sessions -- When there is no clockout, one is added 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, an error is raised. --- This is the default behaviour. +-- This is the new, default behaviour. timeclockEntriesToTransactions :: LocalTime -> [TimeclockEntry] -> [Transaction] timeclockEntriesToTransactions now entries = transactions where + -- XXX should they be date sorted ? or processed in the order written ? 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 @@ -140,7 +146,7 @@ timeclockEntriesToTransactions now entries = transactions -- When there is no clockout, one is added with the provided current time. -- Sessions crossing midnight are split into days to give accurate per-day totals. -- If entries are not in the expected in/out order, an error is raised. --- This is the legacy behaviour, enabled by --old-timeclock. +-- This is the old, legacy behaviour, enabled by --old-timeclock. timeclockEntriesToTransactionsSingle :: LocalTime -> [TimeclockEntry] -> [Transaction] timeclockEntriesToTransactionsSingle _ [] = [] timeclockEntriesToTransactionsSingle now [i] @@ -213,8 +219,8 @@ entryFromTimeclockInOut i o tstatus = Cleared, tcode = "", tdescription = desc, - tcomment = tlcomment i, - ttags = tltags i, + tcomment = tlcomment i <> tlcomment o, + ttags = tltags i ++ tltags o, tpostings = ps, tprecedingcomment="" } diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 7bddc2ad8..a4e55172b 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -74,6 +74,7 @@ module Hledger.Read.Common ( -- ** account names modifiedaccountnamep, accountnamep, + accountnamenosemicolonp, -- ** account aliases accountaliasp, @@ -691,16 +692,18 @@ yearorintp = do --- *** account names --- | Parse an account name (plus one following space if present), +-- | Parse an account name plus one following space if present (see accountnamep); -- then apply any parent account prefix and/or account aliases currently in effect, --- in that order. (Ie first add the parent account prefix, then rewrite with aliases). +-- in that order. Ie first add the parent account prefix, then rewrite with aliases. -- This calls error if any account alias with an invalid regular expression exists. -modifiedaccountnamep :: JournalParser m AccountName -modifiedaccountnamep = do +-- The flag says whether account names may include semicolons; currently account names +-- in journal format may, but account names in timeclock/timedot formats may not. +modifiedaccountnamep :: Bool -> JournalParser m AccountName +modifiedaccountnamep allowsemicolon = do parent <- getParentAccount als <- getAccountAliases -- off1 <- getOffset - a <- lift accountnamep + a <- lift $ if allowsemicolon then accountnamep else accountnamenosemicolonp -- off2 <- getOffset -- XXX or accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function) case accountNameApplyAliases als $ joinAccountNames parent a of @@ -715,15 +718,17 @@ modifiedaccountnamep = do -- | Parse an account name, plus one following space if present. -- Account names have one or more parts separated by the account separator character, -- and are terminated by two or more spaces (or end of input). --- Each part is at least one character long, may have single spaces inside it, --- and starts with a non-whitespace. --- Note, this means "{account}", "%^!" and ";comment" are all accepted --- (parent parsers usually prevent/consume the last). --- It should have required parts to start with an alphanumeric; --- for now it remains as-is for backwards compatibility. +-- Each part is at least one character long, may have single spaces inside it, and starts with a non-whitespace. +-- (We should have required them to start with an alphanumeric, but didn't.) +-- Note, this means account names can contain all kinds of punctuation, including ; which usually starts a following comment. +-- Parent parsers usually remove the following comment before using this parser. accountnamep :: TextParser m AccountName accountnamep = singlespacedtext1p +-- Like accountnamep, but stops parsing if it reaches a semicolon. +accountnamenosemicolonp :: TextParser m AccountName +accountnamenosemicolonp = singlespacednoncommenttext1p + -- | Parse a single line of possibly empty text enclosed in double quotes. doublequotedtextp :: TextParser m Text doublequotedtextp = between (char '"') (char '"') $ @@ -1374,10 +1379,10 @@ followingcommentp = fst <$> followingcommentpWith (void $ takeWhileP Nothing (/= -- using the provided line parser to parse each line. -- This returns the comment text, and the combined results from the line parser. -- --- Following comments begin with a semicolon and extend to the end of the line. --- They can optionally be continued on the next lines, --- where each next line begins with an indent and another semicolon. --- (This parser expects to see these semicolons and indents.) +-- Following comments are a 1-or-more-lines comment, +-- beginning with a semicolon possibly preceded by whitespace on the current line, +-- or with an indented semicolon on the next line. +-- Additional lines also must begin with an indented semicolon. -- -- Like Ledger, we sometimes allow data to be embedded in comments. -- account directive comments and transaction comments can contain tags, @@ -1441,10 +1446,11 @@ commentlinetagsp = do -- | Parse a transaction comment and extract its tags. -- --- The first line of a transaction may be followed by comments, which --- begin with semicolons and extend to the end of the line. Transaction --- comments may span multiple lines, but comment lines below the --- transaction must be preceded by leading whitespace. +-- The first line of a transaction may be followed a 1-or-more-lines comment, +-- beginning with a semicolon possibly preceded by whitespace on the current line, +-- or with an indented semicolon on the next line. Additional lines also must +-- begin with an indented semicolon. +-- See also followingcommentpWith. -- -- 2000/1/1 ; a transaction comment starting on the same line ... -- ; extending to the next line diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index deed48299..643898ad0 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -517,7 +517,7 @@ accountdirectivep = do -- the account name, possibly modified by preceding alias or apply account directives acct <- (notFollowedBy (char '(' <|> char '[') "account name without brackets") >> - modifiedaccountnamep + modifiedaccountnamep True -- maybe a comment, on this and/or following lines (cmt, tags) <- lift transactioncommentp @@ -959,7 +959,7 @@ postingphelper isPostingRule mTransactionYear = do lift skipNonNewlineSpaces1 status <- lift statusp lift skipNonNewlineSpaces - account <- modifiedaccountnamep + account <- modifiedaccountnamep True return (status, account) let (ptype, account') = (accountNamePostingType account, textUnbracket account) lift skipNonNewlineSpaces diff --git a/hledger-lib/Hledger/Read/TimeclockReader.hs b/hledger-lib/Hledger/Read/TimeclockReader.hs index 750e47a96..88da58f71 100644 --- a/hledger-lib/Hledger/Read/TimeclockReader.hs +++ b/hledger-lib/Hledger/Read/TimeclockReader.hs @@ -1,17 +1,14 @@ --- * -*- outline-regexp:"--- \\*"; -*- --- ** doc -- In Emacs, use TAB on lines beginning with "-- *" to collapse/expand sections. + +-- Keep relevant parts synced with manual: {-| -A reader for the timeclock file format generated by timeclock.el -(). Example: +A reader for the timeclock file format. -@ -i 2007\/03\/10 12:26:00 hledger -o 2007\/03\/10 17:26:02 -@ - -From timeclock.el 2.6: +What exactly is this format ? It was introduced in timeclock.el (). +The old specification in timeclock.el 2.6 was: @ A timeclock contains data in the form of a single entry per line. @@ -41,6 +38,92 @@ i, o or O. The meanings of the codes are: now finished. Useful for creating summary reports. @ +Ledger's timeclock format is different, and hledger's timeclock format is different again. +For example: in a clock-in entry, after the time, + +- timeclock.el's timeclock has 0-1 fields: [COMMENT] +- Ledger's timeclock has 0-2 fields: [ACCOUNT[ PAYEE]] +- hledger's timeclock has 1-3 fields: ACCOUNT[ DESCRIPTION[;COMMENT]] + +hledger's timeclock format is: + +@ +# Comment lines like these, and blank lines, are ignored: +# comment line +; comment line +* comment line + +# Lines beginning with b, h, or capital O are also ignored, for compatibility: +b SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT] +h SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT] +O SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT] + +# Lines beginning with i or o are are clock-in / clock-out entries: +i SIMPLEDATE HH:MM[:SS][+-ZZZZ] ACCOUNT[ DESCRIPTION][;COMMENT]] +o SIMPLEDATE HH:MM[:SS][+-ZZZZ][ ACCOUNT][;COMMENT] +@ + +The date is a hledger [simple date](#simple-dates) (YYYY-MM-DD or similar). +The time parts must use two digits. +The seconds are optional. +A + or - four-digit time zone is accepted for compatibility, but currently ignored; times are always interpreted as a local time. + +In clock-in entries (`i`), the account name is required. +A transaction description, separated from the account name by 2+ spaces, is optional. +A transaction comment, beginning with `;`, is also optional. + +In clock-out entries (`o`) have no description, but can have a comment if you wish. +A clock-in and clock-out pair form a "transaction" posting some number of hours to an account - also known as a session. +Eg: + +```timeclock +i 2015/03/30 09:00:00 session1 +o 2015/03/30 10:00:00 +``` + +```cli +$ hledger -f a.timeclock print +2015-03-30 * 09:00-10:00 + (session1) 1.00h +``` + +Clock-ins and clock-outs are matched by their account/session name. +If a clock-outs does not specify a name, the most recent unclosed clock-in is closed. +Also, sessions spanning more than one day are automatically split at day boundaries. +Eg, the following time log: + +```timeclock +i 2015/03/30 09:00:00 some account optional description after 2 spaces ; optional comment, tags: +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 +``` + +generates these transactions: + +```cli +$ hledger -f t.timeclock print +2015-03-30 * optional description after 2 spaces ; optional comment, tags: + (some account) 0.33h + +2015-03-31 * 22:21-23:59 + (another:account) 1.64h + +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 + +``` + -} --- ** language @@ -68,6 +151,7 @@ import Hledger.Data import Hledger.Read.Common import Hledger.Utils import Data.Text as T (strip) +import Data.Functor ((<&>)) --- ** doctest setup -- $setup @@ -121,17 +205,43 @@ timeclockfilep iopts = do many timeclockitemp -- comment-only) lines, can use choice w/o try timeclockitemp = choice [ void (lift emptyorcommentlinep) - , timeclockentryp >>= \e -> modify' (\j -> j{jparsetimeclockentries = e : jparsetimeclockentries j}) + , entryp >>= \e -> modify' (\j -> j{jparsetimeclockentries = e : jparsetimeclockentries j}) ] "timeclock entry, comment line, or empty line" + where entryp = if _oldtimeclock iopts then oldtimeclockentryp else timeclockentryp --- | Parse a timeclock entry. -timeclockentryp :: JournalParser m TimeclockEntry -timeclockentryp = do +-- | Parse a timeclock entry (loose pre-1.50 format). +oldtimeclockentryp :: JournalParser m TimeclockEntry +oldtimeclockentryp = do pos <- getSourcePos code <- oneOf ("bhioO" :: [Char]) lift skipNonNewlineSpaces1 datetime <- datetimep - account <- fmap (fromMaybe "") $ optional $ lift skipNonNewlineSpaces1 >> modifiedaccountnamep + account <- fmap (fromMaybe "") $ optional $ lift skipNonNewlineSpaces1 >> modifiedaccountnamep True description <- fmap (maybe "" T.strip) $ optional $ lift $ skipNonNewlineSpaces1 >> descriptionp (comment, tags) <- lift transactioncommentp return $ TimeclockEntry pos (read [code]) datetime account description comment tags + +-- | Parse a timeclock entry (more robust post-1.50 format). +timeclockentryp :: JournalParser m TimeclockEntry +timeclockentryp = do + pos <- getSourcePos + code <- oneOf ("iobhO" :: [Char]) + lift skipNonNewlineSpaces1 + datetime <- datetimep + (account, description) <- case code of + 'i' -> do + lift skipNonNewlineSpaces1 + a <- modifiedaccountnamep False + d <- optional (lift $ skipNonNewlineSpaces1 >> descriptionp) <&> maybe "" T.strip + return (a, d) + 'o' -> do + -- Notice the try needed here to avoid a parse error if there's trailing spaces. + -- Unlike descriptionp above, modifiedaccountnamep requires nonempty text. + -- And when a parser in an optional fails after consuming input, optional doesn't backtrack, + -- it propagates the failure. + a <- optional (try $ lift skipNonNewlineSpaces1 >> modifiedaccountnamep False) <&> fromMaybe "" + return (a, "") + _ -> return ("", "") + lift skipNonNewlineSpaces + (comment, tags) <- lift $ optional transactioncommentp <&> fromMaybe ("",[]) + return $ TimeclockEntry pos (read [code]) datetime account description comment tags diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index 66257f33e..a755121f5 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -176,7 +176,7 @@ timedotentryp = do dp "timedotentryp" notFollowedBy datelinep lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1] - a <- modifiedaccountnamep + a <- modifiedaccountnamep False lift skipNonNewlineSpaces taggedhours <- lift durationsp (comment0, tags0) <- diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 1bc3f3e07..6e71502d7 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -4715,18 +4715,62 @@ $ hledger -f paypal-custom.csv print # Timeclock -The time logging format of timeclock.el, as read by hledger. +hledger can read time logs in the timeclock time logging format +of [timeclock.el](http://www.emacswiki.org/emacs/TimeClock). +As with [Ledger](http://ledger-cli.org/3.0/doc/ledger3.html#Time-Keeping), +hledger's timeclock format is a subset/variant of timeclock.el's. -hledger can read time logs in timeclock format. -[As with Ledger](http://ledger-cli.org/3.0/doc/ledger3.html#Time-Keeping), -these are (a subset of) -[timeclock.el](http://www.emacswiki.org/emacs/TimeClock)'s format, -containing clock-in and clock-out entries as in the example below. -The date is a [simple date](#simple-dates). -The time format is HH:MM[:SS][+-ZZZZ]. Seconds and timezone are optional. -The timezone, if present, must be four digits and is ignored -(currently the time is always interpreted as a local time). -Lines beginning with `#` or `;` or `*`, and blank lines, are ignored. +Note, hledger's timeclock format was made more robust in hledger 1.43 and 1.50. +If your old time logs are rejected, you should adapt them to modern hledger; +but for now you can also restore the pre-1.43 behaviour with the `--old-timeclock` flag. + +Here the timeclock format in hledger 1.50+: + +```timeclock +# Comment lines like these, and blank lines, are ignored: +# comment line +; comment line +* comment line + +# Lines beginning with b, h, or capital O are also ignored, for compatibility: +b SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT] +h SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT] +O SIMPLEDATE HH:MM[:SS][+-ZZZZ][ TEXT] + +# Lines beginning with i or o are are clock-in / clock-out entries: +i SIMPLEDATE HH:MM[:SS][+-ZZZZ] ACCOUNT[ DESCRIPTION][;COMMENT]] +o SIMPLEDATE HH:MM[:SS][+-ZZZZ][ ACCOUNT][;COMMENT] +``` + +The date is a hledger [simple date](#simple-dates) (YYYY-MM-DD or similar). +The time parts must use two digits. +The seconds are optional. +A + or - four-digit time zone is accepted for compatibility, but currently ignored; times are always interpreted as a local time. + +In clock-in entries (`i`), the account name is required. +A transaction description, separated from the account name by 2+ spaces, is optional. +A transaction comment, beginning with `;`, is also optional. +(Indented following comment lines are also allowed, as in journal format.) + +In clock-out entries (`o`) have no description, but can have a comment if you wish. +A clock-in and clock-out pair form a "transaction" posting some number of hours to an account - also known as a session. +Eg: + +```timeclock +i 2015/03/30 09:00:00 session1 +o 2015/03/30 10:00:00 +``` + +```cli +$ hledger -f a.timeclock print +2015-03-30 * 09:00-10:00 + (session1) 1.00h +``` + +Clock-ins and clock-outs are matched by their account/session name. +If a clock-outs does not specify a name, the most recent unclosed clock-in is closed. +Also, sessions spanning more than one day are automatically split at day boundaries. +Eg, the following time log: ```timeclock i 2015/03/30 09:00:00 some account optional description after 2 spaces ; optional comment, tags: @@ -4739,13 +4783,7 @@ 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. 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: +generates these transactions: ```cli $ hledger -f t.timeclock print diff --git a/hledger/test/errors/tcclockouttime.timeclock b/hledger/test/errors/tcclockouttime.timeclock index 0aafd29de..54b28d30b 100755 --- a/hledger/test/errors/tcclockouttime.timeclock +++ b/hledger/test/errors/tcclockouttime.timeclock @@ -1,5 +1,5 @@ #!/usr/bin/env -S hledger check -f # Clockout time before previous clockin. -i 2022/01/01 00:01:00 +i 2022/01/01 00:01:00 a o 2022/01/01 00:00:00 diff --git a/hledger/test/errors/tcorderedactions.test b/hledger/test/errors/tcorderedactions.test index 66adac1b0..b6d768539 100644 --- a/hledger/test/errors/tcorderedactions.test +++ b/hledger/test/errors/tcorderedactions.test @@ -1,8 +1,11 @@ $$$ hledger check -f tcorderedactions.timeclock >>>2 /Error: .*tcorderedactions.timeclock:8:1: -8 \| i 2022-01-01 00:01:00 +8 \| i 2022-01-01 00:01:00 a \| \^ -Encountered clockin entry for session "" that is already active. +Encountered clockin entry for session "a" that is already active. / >>>= 1 + + + diff --git a/hledger/test/errors/tcorderedactions.timeclock b/hledger/test/errors/tcorderedactions.timeclock index 7998291ea..ed39a572c 100755 --- a/hledger/test/errors/tcorderedactions.timeclock +++ b/hledger/test/errors/tcorderedactions.timeclock @@ -4,5 +4,5 @@ # two clockouts without intervening clockin, # or an initial clockout with no preceding clockin. -i 2022/01/01 00:00:00 -i 2022/01/01 00:01:00 +i 2022/01/01 00:00:00 a +i 2022/01/01 00:01:00 a diff --git a/hledger/test/timeclock.test b/hledger/test/timeclock.test index 0b40329d4..343b16d70 100644 --- a/hledger/test/timeclock.test +++ b/hledger/test/timeclock.test @@ -1,104 +1,92 @@ # * timeclock input -# ** 1. a timeclock session is parsed as a similarly-named transaction with one virtual posting. +# ** 1. A timeclock session is parsed as a similarly-named transaction with one virtual posting. # "session" is a synonym for "account" here. +# After the account name there can be a description, with 2+ spaces between them. < -i 2009/1/1 08:00:00 -o 2009/1/1 09:00:00 - 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 +i 2009/1/3 08:00:00 some:account name a description o 2009/1/3 09:00:00 $ hledger -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 +2009-01-03 * a description (some:account name) 1.00h >= # ** 2. Command-line account aliases are applied. $ hledger -ftimeclock:- print --alias '/account/=FOO' -2009-01-01 * 08:00-09:00 - () 1.00h - 2009-01-02 * 08:00-09:00 (FOO name) 1.00h -2009-01-03 * and a description +2009-01-03 * a description (some:FOO name) 1.00h >= # ** 3. For session with no clock-out, an implicit clock-out at report time is assumed. < -i 2020/1/1 08:00 +i 2020/1/1 08:00 a + $ hledger -f timeclock:- balance > /./ >= # ** 4. A time log not starting with a clock-in is an error. < -o 2020/1/1 08:00 +o 2020/1/1 08:00 a + $ hledger -f timeclock:- balance >2 /Could not find previous clockin to match this clockout./ >= !0 -# ** 5. Two consecutive anonymous clock-ins is an error. (?) -< -i 2020/1/1 08:00 -i 2020/1/1 09:00 -$ hledger -f timeclock:- balance ->2 /Encountered clockin entry for session "" that is already active./ ->= !0 - -# ** 6. Timeclock amounts are always rounded to two decimal places (#1527). +# ** 5. Timeclock amounts are always rounded to two decimal places (#1527). < i 2020-01-30 08:38:35 acct o 2020-01-30 09:03:35 + $ hledger -f timeclock:- print 2020-01-30 * 08:38-09:03 (acct) 0.42h >= -# ** 7. Comments and tags are supported on the clock-in. Double space is required -# between account name and description or comment, but not between description and comment. +# ** 6. Comments and tags are supported on both clock-in and clock-out. +# Semicolon starts a comment immediately, spaces before it are not required before it. < -i 2023-05-01 08:00:00 acct 1 description ; a comment with tag: -o 2023-05-01 09:00:00 -i 2023-05-02 08:00:00 acct 2 ; another comment +i 2023-05-01 08:00:00 session1 ; clock-in comment with tag: +o 2023-05-01 09:00:00; clock-out comment, foo: +i 2023-05-02 08:00:00 session2 o 2023-05-02 09:00:00 $ hledger -f timeclock:- print tag:tag -2023-05-01 * description ; a comment with tag: - (acct 1) 1.00h +2023-05-01 * 08:00-09:00 ; clock-in comment with tag: + ; clock-out comment, foo: + (session1) 1.00h >= -# ** 8. TODO Comments on clock-outs are ignored / added to posting / added to transaction. -# XXX +# ** 7. Clock-in entries require an account name. < -i 2025-01-01 09:00:00 session1 -o 2025-01-01 10:00:00 ; clock-out comment -$ -#$ hledger -f timeclock:- print +i 2025-01-01 09:00:00 +o 2025-01-01 10:00:00 -# ** 9. Multiple sessions can be simultaneously clocked in. Clockouts can be named and in any order. +$ hledger -f timeclock:- print +>2 /unexpected newline/ +>= !0 + +# ** 8. Multiple sessions can be clocked in simultaneously. Clockouts can specify the session they are closing. < i 2025-01-01 09:00:00 session1 9 to 5 session i 2025-01-01 12:00:00 session2 12 to 2 session, overlapping o 2025-01-01 14:00:00 session2 o 2025-01-01 17:00:00 session1 + $ hledger -f timeclock:- print -> 2025-01-01 * 9 to 5 session (session1) 8.00h @@ -107,7 +95,7 @@ $ hledger -f timeclock:- print >= -# ** 10. Unnamed clockouts apply to the most recently clocked-in session. +# ** 9. Clockouts without a name apply to the most recently clocked-in session. < i 2025-01-01 09:00:00 session1 start 9-12 i 2025-01-01 10:00:00 session2 start 10-5 @@ -115,7 +103,7 @@ i 2025-01-01 11:00:00 session3 start 11-1 o 2025-01-01 13:00:00 o 2025-01-01 12:00:00 session1 o 2025-01-01 17:00:00 -$ + $ hledger -f timeclock:- print 2025-01-01 * start 9-12 (session1) 3.00h @@ -128,14 +116,14 @@ $ hledger -f timeclock:- print >= -# ** 11. Multiple active sessions can span multiple days. +# ** 10. 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 @@ -150,7 +138,7 @@ $ hledger -f timeclock:- print >= -# ** 12. The --old-timeclock flag reverts to the old behavior. +# ** 11. The --old-timeclock flag reverts to the old syntax and behavior. < i 2009/1/1 08:00:00 o 2009/1/1 09:00:00 stuff on checkout record is ignored @@ -161,7 +149,6 @@ i 2009/1/3 08:00:00 some:account name and a description o 2009/1/3 09:00:00 $ hledger --old-timeclock -f timeclock:- print -> 2009-01-01 * 08:00-09:00 () 1.00h @@ -173,26 +160,6 @@ $ hledger --old-timeclock -f timeclock:- print >= -# ** 13. TODO Overlapping sessions can have the same name (#2417). -< -i 2024-04-10 13:00:00 test -o 2024-04-10 14:00:00 -i 2024-04-10 13:00:00 test -o 2024-04-10 15:00:00 -$ -# $ hledger -f timeclock:- print -# >= - -# ** 14. TODO A start time can be the same as another session's end time (#2417). -< -i 2024-04-10 13:00:00 test -o 2024-04-10 14:00:00 -i 2024-04-10 14:00:00 test -o 2024-04-10 15:00:00 -$ -# $ hledger -f timeclock:- print -# >= - # ** OLD: