dev: check: refactor error messages (#1436)

hledger-lib/Hledger/Read/Common.hs

@@ -134,7 +134,6 @@ import Data.List.NonEmpty (NonEmpty(..))
 import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe)
 import qualified Data.Map as M
 import qualified Data.Semigroup as Sem
-import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Calendar (Day, fromGregorianValid, toGregorian)
@@ -379,28 +378,77 @@ journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)
 journalCheckAccountsDeclared :: Journal -> Either String ()
 journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)
   where
-    checkacct p@Posting{paccount=a,ptransaction=mt}
+    checkacct p@Posting{paccount=a}
       | a `elem` journalAccountNamesDeclared j = Right ()
-      | otherwise = Left msg
+      | otherwise = Left $ 
+        printf "%s:%d:%d:\n%sundeclared account \"%s\"\n" f l (maybe 0 (+1) mc) ex a
       where
-        msg = printf "%s:%d:%d:\n%sundeclared account \"%s\"\n" f l (c+1) excerpt a
+        (f,l,mc,ex) = makeExcerpt p finderrcol
+        finderrcol p _ _ = Just $ 4 + if isVirtual p then 1 else 0
+
+-- | Check that all the commodities used in this journal's postings have been declared
+-- by commodity directives, returning an error message otherwise.
+journalCheckCommoditiesDeclared :: Journal -> Either String ()
+journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j)
   where
-            (f,l,c,excerpt) = case mt of
+    checkcommodities p =
-              Nothing -> ("-",0,0,"")
+      case findundeclaredcomm p of
-              Just t  -> (tf,errabsline,errcol,txt)
+        Nothing   -> Right ()
+        Just comm -> Left $ printf "%s:%d:\n%sundeclared commodity \"%s\"\n" f l ex comm
           where
-                  (SourcePos tf tl _tc) = fst $ tsourcepos t
+            -- we don't know the original column of amounts
-                  mpindex = fmap fst $ find ((a==).paccount.snd) $ zip [1..] $ tpostings t
+            (f,l,_,ex) = makeExcerpt p finderrcol
-                  tcommentlines = max 0 $ length (T.lines $ tcomment t) - 1
+      where
+        -- Find the first undeclared commodity symbol in this posting, if any.
+        findundeclaredcomm Posting{pamount=amt,pbalanceassertion} =
+          find (`M.notMember` jcommodities j)
+          . map acommodity
+          . (maybe id ((:) . baamount) pbalanceassertion)
+          . filter (not . isIgnorable)
+          $ amountsRaw amt
+          where
+            -- Ignore missing amounts and zero amounts without commodity (#1767)
+            isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt
+
+        -- Find the best position for an error column marker.
+        finderrcol p t txntxt =
+          case transactionFindPostingIndex (==p) t of
+            Nothing -> Nothing
+            Just pindex -> Just $ 
+              acctend + (T.length $ T.takeWhile isnotsymbol $ T.drop acctend l)
+              where
+                l = fromMaybe "" $ T.lines txntxt `atMay` pindex
+                acctend = 4 + T.length (paccount p) + if isVirtual p then 2 else 0
+                isnotsymbol c = isSpace c || isDigit c || isDigitSeparatorChar c
+
+-- | Given a problem posting and a function calculating the best
+-- position for the error column marker:
+-- look up error info from the parent transaction, and render the transaction
+-- as a megaparsec-style excerpt, showing the original line number
+-- on the problem posting's line, and a column indicator.
+-- Returns the file path, line number, starting column if known,
+-- and the rendered excerpt, or as much of these as is possible.
+makeExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe Int) -> (FilePath, Int, Maybe Int, Text)
+makeExcerpt p findErrorColumn =
+  case ptransaction p of
+    Nothing -> ("-", 0, Nothing, "")
+    Just t  -> (f, errabsline, merrcol, ex)
+      where
+        (SourcePos f tl _) = fst $ tsourcepos t
+        tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)
+        mpindex = transactionFindPostingIndex (==p) t
         errrelline = maybe 0 (tcommentlines+) mpindex
         errabsline = unPos tl + errrelline
-                  errcol = 4 + if isVirtual p then 1 else 0
+        txntxt = showTransaction t & textChomp & (<>"\n")
-                  txt = formatExcerptLikeMegaparsec errabsline errrelline errcol
+        merrcol = findErrorColumn p t txntxt
-                          (showTransaction t & textChomp & (<>"\n"))
+        ex = decorateExcerpt errabsline errrelline merrcol txntxt
 
-formatExcerptLikeMegaparsec :: Int -> Int -> Int -> Text -> Text
+-- | Add megaparsec-style left margin, line number, and 
-formatExcerptLikeMegaparsec absline relline col txt =
+-- optional column marker to an excerpt to be used in an 
-  T.unlines $ js' <> ks' <> [colmarkerline] <> ms'
+-- error message.
+decorateExcerpt :: Int -> Int -> Maybe Int -> Text -> Text
+decorateExcerpt absline relline mcol txt =
+  T.unlines $ js' <> ks' <> colmarkerline <> ms'
   where
     (ls,ms) = splitAt (relline+1) $ T.lines txt
     (js,ks) = splitAt (length ls - 1) ls
@@ -408,52 +456,15 @@ formatExcerptLikeMegaparsec absline relline col txt =
       [k] -> (map (lineprefix<>) js, [T.pack (show absline) <> " | " <> k])
       _   -> ([], [])
     ms' = map (lineprefix<>) ms
-    colmarkerline = lineprefix <> T.replicate col " " <> "^"
+    colmarkerline = [lineprefix <> T.replicate col " " <> "^" | Just col <- [mcol]]
     lineprefix = T.replicate marginw " " <> "| "
       where  marginw = length (show absline) + 1
 
--- | Check that all the commodities used in this journal's postings have been declared
+-- | Find the 1-based index of the first posting in this transaction
--- by commodity directives, returning an error message otherwise.
+-- satisfying the given predicate.
-journalCheckCommoditiesDeclared :: Journal -> Either String ()
+transactionFindPostingIndex :: (Posting -> Bool) -> Transaction -> Maybe Int
-journalCheckCommoditiesDeclared j =
+transactionFindPostingIndex ppredicate = 
-  mapM_ checkcommodities (journalPostings j)
+  fmap fst . find (ppredicate.snd) . zip [1..] . tpostings
-  where
-    checkcommodities p@Posting{ptransaction=mt,paccount=acct,pamount=amt,pbalanceassertion} =
-      case mfirstundeclaredcomm of
-        Nothing   -> Right ()
-        Just comm -> Left $
-          -- we don't save the original column of amounts
-          printf "%s:%d:\n%sundeclared commodity \"%s\"\n" f l excerpt comm
-          where
-            (f,l,excerpt) = case mt of
-              Nothing -> ("-",0,"")
-              Just t  -> (tf,errabsline,ex)
-                where
-                  (SourcePos tf tl _tc) = fst $ tsourcepos t
-                  ppredicate = S.member comm . maCommodities . pamount
-                  mpindex = fmap fst $ find (ppredicate.snd) $ zip [1..] $ tpostings t
-                  tcommentlines = max 0 $ length (T.lines $ tcomment t) - 1
-                  errrelline = maybe 0 (tcommentlines+) mpindex
-                  errabsline = unPos tl + errrelline
-                  txn = showTransaction t & textChomp & (<>"\n")
-                  errcol = case mpindex of
-                    Nothing     -> 0
-                    Just pindex -> acctend + (T.length $ T.takeWhile isnotsymbol $ T.drop acctend l)
-                      where
-                        acctend = 4 + T.length acct + if isVirtual p then 2 else 0
-                        isnotsymbol c = isSpace c || isDigit c || isDigitSeparatorChar c
-                        l = fromMaybe "" $ (T.lines txn `atMay` pindex)
-                  ex = formatExcerptLikeMegaparsec errabsline errrelline errcol txn
-      where
-        mfirstundeclaredcomm =
-          find (`M.notMember` jcommodities j)
-          . map acommodity
-          . (maybe id ((:) . baamount) pbalanceassertion)
-          . filter (not . isIgnorable)
-          $ amountsRaw amt
-
-    -- Ignore missing amounts and zero amounts without commodity (#1767)
-    isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt
 
 setYear :: Year -> JournalParser m ()
 setYear y = modify' (\j -> j{jparsedefaultyear=Just y})