feat:timedot: tagged time logging with letters

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

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

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

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.