From b6a46f637f6d585a77bd4fb6c822015260141e61 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 23 Nov 2023 12:29:08 -1000 Subject: [PATCH] feat:timedot: tagged time logging with letters --- hledger-lib/Hledger/Data/Posting.hs | 10 +++ hledger-lib/Hledger/Read/TimedotReader.hs | 87 ++++++++++++++--------- hledger/hledger.m4.md | 39 +++++++++- hledger/test/timedot.test | 18 ++++- 4 files changed, 118 insertions(+), 36 deletions(-) diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 418250581..76a47d04d 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -52,6 +52,7 @@ module Hledger.Data.Posting ( -- * comment/tag operations commentJoin, commentAddTag, + commentAddTagUnspaced, commentAddTagNextLine, -- * arithmetic sumPostings, @@ -611,6 +612,15 @@ commentAddTag c (t,v) c' = T.stripEnd c tag = t <> ": " <> v +-- | Like commentAddTag, but omits the space after the colon. +commentAddTagUnspaced :: Text -> Tag -> Text +commentAddTagUnspaced c (t,v) + | T.null c' = tag + | otherwise = c' `commentJoin` tag + where + c' = T.stripEnd c + tag = t <> ":" <> v + -- | Add a tag on its own line to a comment, preserving any prior content. -- A space is inserted following the colon, before the value. commentAddTagNextLine :: Text -> Tag -> Text diff --git a/hledger-lib/Hledger/Read/TimedotReader.hs b/hledger-lib/Hledger/Read/TimedotReader.hs index d4d2ac92f..a662006f9 100644 --- a/hledger-lib/Hledger/Read/TimedotReader.hs +++ b/hledger-lib/Hledger/Read/TimedotReader.hs @@ -53,6 +53,10 @@ import Hledger.Data import Hledger.Read.Common hiding (emptyorcommentlinep) import Hledger.Utils import Data.Decimal (roundTo) +import Data.Functor ((<&>)) +import Data.List (sort) +import Data.List (group) +-- import Text.Megaparsec.Debug (dbg) --- ** doctest setup -- $setup @@ -126,9 +130,8 @@ dayp = label "timedot day entry" $ do pos <- getSourcePos (date,desc,comment,tags) <- datelinep commentlinesp - ps <- many $ timedotentryp <* commentlinesp + ps <- (many $ timedotentryp <* commentlinesp) <&> concat endpos <- getSourcePos - -- lift $ traceparse' "dayp end" let t = txnTieKnot $ nulltransaction{ tsourcepos = (pos, endpos), tdate = date, @@ -147,7 +150,6 @@ datelinep = do date <- datep desc <- T.strip <$> lift descriptionp (comment, tags) <- lift transactioncommentp - -- lift $ traceparse' "datelinep end" return (date, desc, comment, tags) -- | Zero or more empty lines or hash/semicolon comment lines @@ -165,51 +167,52 @@ commentlinesp = do -- void $ lift restofline -- lift $ traceparse' "orgnondatelinep" -orgheadingprefixp = do - -- traceparse "orgheadingprefixp" - skipSome (char '*') >> skipNonNewlineSpaces1 +orgheadingprefixp = skipSome (char '*') >> skipNonNewlineSpaces1 -- | Parse a single timedot entry to one (dateless) transaction. -- @ -- fos.haskell .... .. -- @ -timedotentryp :: JournalParser m Posting +timedotentryp :: JournalParser m [Posting] timedotentryp = do lift $ traceparse "timedotentryp" notFollowedBy datelinep lift $ optional $ choice [orgheadingprefixp, skipNonNewlineSpaces1] a <- modifiedaccountnamep lift skipNonNewlineSpaces - (hours, comment, tags) <- - try (do - (c,ts) <- lift transactioncommentp -- or postingp, but let's not bother supporting date:/date2: - return (0, c, ts) - ) - <|> (do - h <- lift durationp - (c,ts) <- try (lift transactioncommentp) <|> (newline >> return ("",[])) - return (h,c,ts) - ) + taggedhours <- lift durationsp + (comment0, tags0) <- + lift transactioncommentp -- not postingp, don't bother with date: tags here + <|> (newline >> return ("",[])) mcs <- getDefaultCommodityAndStyle let (c,s) = case mcs of Just (defc,defs) -> (defc, defs{asprecision=max (asprecision defs) (Precision 2)}) _ -> ("", amountstyle{asprecision=Precision 2}) - -- lift $ traceparse' "timedotentryp end" - return $ nullposting{paccount=a - ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hours, astyle=s} - ,ptype=VirtualPosting - ,pcomment=comment - ,ptags=tags - } + ps = [ + nullposting{paccount=a + ,pamount=mixedAmount $ nullamt{acommodity=c, aquantity=hours, astyle=s} + ,ptype=VirtualPosting + ,pcomment=comment + ,ptags=tags + } + | (hours,tagval) <- taggedhours + , let tag = ("t",tagval) + , let tags = if T.null tagval then tags0 else tags0 ++ [tag] + , let comment = if T.null tagval then comment0 else comment0 `commentAddTagUnspaced` tag + ] + return ps type Hours = Quantity -durationp :: TextParser m Hours -durationp = do - traceparse "durationp" - try numericquantityp <|> dotquantityp - -- <* traceparse' "durationp" +-- | Parse one or more durations in hours, each with an optional tag value +-- (or empty string for none). +durationsp :: TextParser m [(Hours,TagValue)] +durationsp = + (dotquantityp <&> \h -> [(h,"")]) + <|> (numericquantityp <&> \h -> [(h,"")]) + <|> letterquantitiesp + <|> pure [(0,"")] -- | Parse a duration of seconds, minutes, hours, days, weeks, months or years, -- written as a decimal number followed by s, m, h, d, w, mo or y, assuming h @@ -246,15 +249,33 @@ timeUnits = ,("y",61320) ] --- | Parse a quantity written as a line of dots, each representing 0.25. +-- | Parse a quantity written as a line of one or more dots, +-- each representing 0.25, ignoring any interspersed spaces +-- after the first dot. -- @ -- .... .. -- @ -dotquantityp :: TextParser m Quantity +dotquantityp :: TextParser m Hours dotquantityp = do -- lift $ traceparse "dotquantityp" - dots <- filter (not.isSpace) <$> many (oneOf (". " :: [Char])) - return $ fromIntegral (length dots) / 4 + char '.' + dots <- many (oneOf ['.', ' ']) <&> filter (not.isSpace) + return $ fromIntegral (1 + length dots) / 4 + +-- | Parse a quantity written as a line of one or more letters, +-- each representing 0.25 with a tag "t" whose value is the letter, +-- ignoring any interspersed spaces after the first letter. +letterquantitiesp :: TextParser m [(Hours, TagValue)] +letterquantitiesp = + -- dbg "letterquantitiesp" $ + do + letter1 <- letterChar + letters <- many (letterChar <|> spacenonewline) <&> filter (not.isSpace) + let groups = + [ (fromIntegral (length t) / 4, T.singleton c) + | t@(c:_) <- group $ sort $ letter1:letters + ] + return groups -- | XXX new comment line parser, move to Hledger.Read.Common.emptyorcommentlinep -- Parse empty lines, all-blank lines, and lines beginning with any of the provided diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index cc6a703ef..a64d732ca 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -4217,7 +4217,13 @@ After the date line are zero or more time postings, consisting of: - one or more dots (period characters), each representing 0.25. These are the dots in "timedot". Spaces are ignored and can be used for grouping/alignment. - + + - one or more letters. These are like dots but they also generate + a tag `t:` (short for "type") with the letter as its value, + and a separate posting for each of the values. + This provides a second dimension of categorisation, + viewable in reports with `--pivot t`. + - **An optional comment** following a semicolon (a hledger-style [posting comment](#posting-comments)). There is some flexibility to help with keeping time log data and notes in the same file: @@ -4282,6 +4288,37 @@ Balance changes in 2016-02-01-2016-02-03: || 7.75 2.25 8.00 ``` +Letters: + +```timedot +# Activity types: cleanup, enhancement, learning, support + +2023-11-01 +work:adm ccecces +``` +```journal +$ hledger -f a.timedot print +2023-11-01 + (work:adm) 1 ; t:c + (work:adm) 0.5 ; t:e + (work:adm) 0.25 ; t:s + +``` +```shell +$ hledger -f a.timedot bal + 1.75 work:adm +-------------------- + 1.75 +``` +```shell +$ hledger -f a.timedot bal --pivot t + 1.00 c + 0.50 e + 0.25 s +-------------------- + 1.75 +``` + Org: ```timedot diff --git a/hledger/test/timedot.test b/hledger/test/timedot.test index 6e910fb9a..0b9fbb443 100644 --- a/hledger/test/timedot.test +++ b/hledger/test/timedot.test @@ -16,6 +16,10 @@ fos:haskell .... ; a posting comment and posting-tag: ; more posting comment lines ? currently ignored per:admin .... +2023-01-02 +a ; no quantity means zero +b aabbaca ; letter "dots" are tagged with t:LETTER + ** 2023-01-02 ; dates are allowed to be org headings # ** 1. The above timedot is converted to these transactions. @@ -28,19 +32,29 @@ $ hledger -ftimedot:- print (fos:haskell) 1.00 ; a posting comment and posting-tag: (per:admin) 1.00 +2023-01-02 * + (a) 0.00 ; no quantity means zero + (b) 1.00 ; letter "dots" are tagged with t:LETTER, t:a + (b) 0.50 ; letter "dots" are tagged with t:LETTER, t:b + (b) 0.25 ; letter "dots" are tagged with t:LETTER, t:c + 2023-01-02 * ; dates are allowed to be org headings >= # ** 2. And this register. -$ hledger -ftimedot:- reg +$ hledger -ftimedot:- reg -w80 2023-01-01 transaction descr.. (biz:research) 1.00 1.00 (inc:client1) 1.50 2.50 2023-01-01 different transac.. (fos:haskell) 1.00 3.50 (per:admin) 1.00 4.50 +2023-01-02 (a) 0 4.50 + (b) 1.00 5.50 + (b) 0.50 6.00 + (b) 0.25 6.25 # ** 3. Tags are recognised. Account aliases are applied. -$ hledger -ftimedot:- reg tag:posting-tag --alias fos:haskell=λ +$ hledger -ftimedot:- reg -w80 tag:posting-tag --alias fos:haskell=λ 2023-01-01 different transac.. (λ) 1.00 1.00 # ** 4. Each of these formats is printed as exactly a quarter hour.