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
This commit is contained in:
parent
0d0f2697de
commit
5a3e34cc55
@ -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=""
|
||||
}
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
(<http://www.emacswiki.org/emacs/TimeClock>). 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 (<http://www.emacswiki.org/emacs/TimeClock>).
|
||||
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
|
||||
|
||||
@ -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) <-
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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:
|
||||
|
||||
Loading…
Reference in New Issue
Block a user