feat: check: the tags check checks tag names

hledger-lib/Hledger/Data/Errors.hs

@@ -3,8 +3,10 @@ Helpers for making error messages.
 -}
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Hledger.Data.Errors (
+  makeAccountTagErrorExcerpt,
   makeTransactionErrorExcerpt,
   makePostingErrorExcerpt,
   makePostingAccountErrorExcerpt,
@@ -25,13 +27,57 @@ import Data.Maybe
 import Safe (headMay)
 import Hledger.Data.Posting (isVirtual)
 
+-- | Given an account name and its account directive, and a problem tag within the latter:
+-- render it as a megaparsec-style excerpt, showing the original line number and
+-- marked column or region.
+-- Returns the file path, line number, column(s) if known,
+-- and the rendered excerpt, or as much of these as is possible.
+-- The returned columns will be accurate for the rendered error message but not for the original journal data.
+makeAccountTagErrorExcerpt :: (AccountName, AccountDeclarationInfo) -> TagName -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
+makeAccountTagErrorExcerpt (a, adi) _t = (f, l, merrcols, ex)
+  -- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
+  where
+    (SourcePos f pos _) = adisourcepos adi
+    l = unPos pos
+    txt   = showAccountDirective (a, adi) & textChomp & (<>"\n")
+    ex = decorateTagErrorExcerpt l merrcols txt
+    -- Calculate columns which will help highlight the region in the excerpt
+    -- (but won't exactly match the real data, so won't be shown in the main error line)
+    merrcols = Nothing
+      -- don't bother for now
+      -- Just (col, Just col2)
+      -- where
+      --   col  = undefined -- T.length (showTransactionLineFirstPart t') + 2
+      --   col2 = undefined -- col + T.length tagname - 1      
+
+showAccountDirective (a, AccountDeclarationInfo{..}) =
+  "account " <> a
+  <> (if not $ T.null adicomment then "    ; " <> adicomment else "")
+
+-- | Add megaparsec-style left margin, line number, and optional column marker(s).
+decorateTagErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
+decorateTagErrorExcerpt l mcols txt =
+  T.unlines $ ls' <> colmarkerline <> map (lineprefix<>) ms
+  where
+    (ls,ms) = splitAt 1 $ T.lines txt
+    ls' = map ((T.pack (show l) <> " | ") <>) ls
+    colmarkerline =
+      [lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"
+      | Just (col, mendcol) <- [mcols]
+      , let regionw = maybe 1 (subtract col) mendcol + 1
+      ]
+    lineprefix = T.replicate marginw " " <> "| "
+      where  marginw = length (show l) + 1
+
+_showAccountDirective = undefined
+
 -- | Given a problem transaction and a function calculating the best
 -- column(s) for marking the error region:
 -- render it as a megaparsec-style excerpt, showing the original line number
 -- on the transaction line, and a column(s) marker.
 -- Returns the file path, line number, column(s) if known,
 -- and the rendered excerpt, or as much of these as is possible.
--- A limitation: columns will be accurate for the rendered error message but not for the original journal data.
+-- The returned columns will be accurate for the rendered error message but not for the original journal data.
 makeTransactionErrorExcerpt :: Transaction -> (Transaction -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
 makeTransactionErrorExcerpt t findtxnerrorcolumns = (f, tl, merrcols, ex)
   -- XXX findtxnerrorcolumns is awkward, I don't think this is the final form

hledger-lib/Hledger/Data/JournalChecks.hs

@@ -14,12 +14,14 @@ module Hledger.Data.JournalChecks (
   journalCheckPayees,
   journalCheckPairedConversionPostings,
   journalCheckRecentAssertions,
+  journalCheckTags,
   module Hledger.Data.JournalChecks.Ordereddates,
   module Hledger.Data.JournalChecks.Uniqueleafnames,
 )
 where
 
 import Data.Char (isSpace)
+import Data.List.Extra
 import Data.Maybe
 import qualified Data.Map.Strict as M
 import qualified Data.Text as T
@@ -30,13 +32,12 @@ import Hledger.Data.Errors
 import Hledger.Data.Journal
 import Hledger.Data.JournalChecks.Ordereddates
 import Hledger.Data.JournalChecks.Uniqueleafnames
-import Hledger.Data.Posting (isVirtual, postingDate, postingStatus)
+import Hledger.Data.Posting (isVirtual, postingDate, postingStatus, transactionAllTags)
 import Hledger.Data.Types
 import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt)
 import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart, partitionAndCheckConversionPostings)
 import Data.Time (Day, diffDays)
-import Data.List.Extra
-import Hledger.Utils (chomp, textChomp, sourcePosPretty)
+import Hledger.Utils
 
 -- | Check that all the journal's postings are to accounts  with
 -- account directives, returning an error message otherwise.
@@ -157,6 +158,44 @@ journalCheckPayees j = mapM_ checkpayee (jtxns j)
             col  = T.length (showTransactionLineFirstPart t') + 2
             col2 = col + T.length (transactionPayee t') - 1
 
+-- | Check that all the journal's tags (on accounts, transactions, postings..)
+-- have been declared with tag directives, returning an error message otherwise.
+journalCheckTags :: Journal -> Either String ()
+journalCheckTags j = do
+  mapM_ checkaccttags $ jdeclaredaccounts j
+  mapM_ checktxntags  $ jtxns j
+  where
+    checkaccttags (a, adi) = mapM_ (checkaccttag.fst) $ aditags adi
+      where
+        checkaccttag tagname
+          | tagname `elem` declaredtags = Right ()
+          | otherwise = Left $ printf msg f l ex (show tagname) tagname
+            where (f,l,_mcols,ex) = makeAccountTagErrorExcerpt (a, adi) tagname
+    checktxntags txn = mapM_ (checktxntag . fst) $ transactionAllTags txn
+      where
+        checktxntag tagname
+          | tagname `elem` declaredtags = Right ()
+          | otherwise = Left $ printf msg f l ex (show tagname) tagname
+            where
+              (f,l,_mcols,ex) = makeTransactionErrorExcerpt txn finderrcols
+                where
+                  finderrcols _txn' = Nothing
+                    -- don't bother for now
+                    -- Just (col, Just col2)
+                    -- where
+                    --   col  = T.length (showTransactionLineFirstPart txn') + 2
+                    --   col2 = col + T.length tagname - 1
+    declaredtags = journalTagsDeclared j
+    msg = (unlines [
+      "%s:%d:"
+      ,"%s"
+      ,"Strict tag checking is enabled, and"
+      ,"tag %s has not been declared."
+      ,"Consider adding a tag directive. Examples:"
+      ,""
+      ,"tag %s"
+      ])
+
 -- | In each tranaction, check that any conversion postings occur in adjacent pairs.
 journalCheckPairedConversionPostings :: Journal -> Either String ()
 journalCheckPairedConversionPostings j =

hledger-lib/Hledger/Data/Types.hs

@@ -573,8 +573,8 @@ nullpayeedeclarationinfo = PayeeDeclarationInfo {
 }
 
 -- | Extra information found in a tag directive.
-data TagDeclarationInfo = TagDeclarationInfo {
-   tdicomment :: Text   -- ^ any comment lines following the tag directive
+newtype TagDeclarationInfo = TagDeclarationInfo {
+   tdicomment :: Text   -- ^ any comment lines following the tag directive. No tags allowed here.
 } deriving (Eq,Show,Generic)
 
 nulltagdeclarationinfo = TagDeclarationInfo {

hledger-lib/Hledger/Read/JournalReader.hs

@@ -454,6 +454,13 @@ addPayeeDeclaration (p, cmt, tags) =
                     ,pditags    = tags
                     })
 
+-- Add a tag declaration to the journal.
+addTagDeclaration :: (TagName,Text) -> JournalParser m ()
+addTagDeclaration (t, cmt) =
+  modify' (\j@Journal{jdeclaredtags} -> j{jdeclaredtags=tagandinfo:jdeclaredtags})
+  where
+    tagandinfo = (t, nulltagdeclarationinfo{tdicomment=cmt})
+
 indentedlinep :: JournalParser m String
 indentedlinep = lift skipNonNewlineSpaces1 >> (rstrip <$> lift restofline)
 
@@ -598,9 +605,10 @@ tagdirectivep :: JournalParser m ()
 tagdirectivep = do
   string "tag" <?> "tag directive"
   lift skipNonNewlineSpaces1
-  _ <- lift $ some nonspace
-  lift restofline
+  tagname <- lift $ T.pack <$> some nonspace
+  (comment, _) <- lift transactioncommentp
   skipMany indentedlinep
+  addTagDeclaration (tagname,comment)
   return ()
 
 -- end tag or end apply tag

hledger/Hledger/Cli/Commands/Check.hs

@@ -66,6 +66,7 @@ data Check =
   | Ordereddates
   | Payees
   | Recentassertions
+  | Tags
   | Uniqueleafnames
   deriving (Read,Show,Eq,Enum,Bounded)
 
@@ -105,6 +106,7 @@ runCheck CliOpts{reportspec_=ReportSpec{_rsReportOpts=ropts}} j (chck,_) = do
       Ordereddates    -> journalCheckOrdereddates (whichDate ropts) j
       Payees          -> journalCheckPayees j
       Recentassertions -> journalCheckRecentAssertions d j
+      Tags            -> journalCheckTags j
       Uniqueleafnames -> journalCheckUniqueleafnames j
       -- the other checks have been done earlier during withJournalDo
       _               -> Right ()

hledger/Hledger/Cli/Commands/Check.md

@@ -64,7 +64,7 @@ They are more specialised and not desirable for everyone, therefore optional:
 - **recentassertions** - all accounts with balance assertions have a
   balance assertion no more than 7 days before their latest posting
 
-- **tags** - all tags used by transactions [have been declared](#tags)
+- **tags** - all tags used by transactions [have been declared](#tag-directive)
 
 - **uniqueleafnames** - all account leaf names are unique
 

hledger/hledger.m4.md

@@ -2363,6 +2363,10 @@ tag  item-id
 ```
 Any indented subdirectives are currently ignored.
 
+The ["tags" check](#check) will report an error if any undeclared tag name is used.
+It is quite easy to accidentally create a tag through normal use of colons in [comments](#comments];
+if you want to prevent this, you can declare and check your tags .
+
 ## Periodic transactions
 
 The `~` directive declares recurring transactions.

hledger/test/check-tags.test

@@ -0,0 +1,40 @@
+# 1. tags can be declared
+<
+tag atag  ; this is atag. tags: on tags are not allowed and will be ignored.
+  indented subdirectives are ignored.
+$ hledger -f - check
+
+# 2. check tags succeeds when all tags are declared
+<
+tag atag
+tag ttag
+tag ptag
+
+account a  ; atag:
+
+2023-01-01 ; ttag:
+  (a)  0   ; ptag:
+
+$ hledger -f - check tags
+
+# 3. it detects an undeclared account tag
+<
+account a  ; atag:
+$ hledger -f - check tags
+>2 /tag "atag" has not been declared/
+>=1
+
+# 4. it detects an undeclared transaction tag
+<
+2023-01-01 ; ttag:
+$ hledger -f - check tags
+>2 /tag "ttag" has not been declared/
+>=1
+
+# 5. it detects an undeclared posting tag
+<
+2023-01-01
+  (a)  0   ; ptag:
+$ hledger -f - check tags
+>2 /tag "ptag" has not been declared/
+>=1