From 4b3644d7803db37d4219e5cc2d00613c0f6647cd Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Thu, 21 Apr 2022 23:56:32 -1000
Subject: [PATCH] imp: check: accounts: print a standardised error message like
 megaparsec's (#1436)

added:
formatExcerptLikeMegaparsec
---
 hledger-lib/Hledger/Read/Common.hs | 41 ++++++++++++++++++++++--------
 1 file changed, 31 insertions(+), 10 deletions(-)

diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs
index bb64c8b6e..56b6e1c54 100644
--- a/hledger-lib/Hledger/Read/Common.hs
+++ b/hledger-lib/Hledger/Read/Common.hs
@@ -377,17 +377,38 @@ journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)
 journalCheckAccountsDeclared :: Journal -> Either String ()
 journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)
   where
-    checkacct Posting{paccount,ptransaction}
-      | paccount `elem` as = Right ()
-      | otherwise = Left $
-          (printf "undeclared account \"%s\"\n" (T.unpack paccount))
-          ++ case ptransaction of
-              Nothing -> ""
-              Just t  -> printf "in transaction at: %s\n\n%s"
-                          (sourcePosPairPretty $ tsourcepos t)
-                          (linesPrepend "  " . (<>"\n") . textChomp $ showTransaction t)
+    checkacct p@Posting{paccount=a,ptransaction=mt}
+      | a `elem` journalAccountNamesDeclared j = Right ()
+      | otherwise = Left msg
       where
-        as = journalAccountNamesDeclared j
+        msg = printf "%s:%d:%d:\n%sundeclared account \"%s\"\n" f l (c+1) excerpt a
+          where
+            (f,l,c,excerpt) = case mt of
+              Nothing -> ("-",0,0,"")
+              Just t  -> (tf,errabsline,errcol,txt)
+                where
+                  (SourcePos tf tl _tc) = fst $ tsourcepos t
+                  mpindex = fmap fst $ find ((a==).paccount.snd) $ zip [1..] $ tpostings t
+                  tcommentlines = max 0 $ length (T.lines $ tcomment t) - 1
+                  errrelline = maybe 0 (tcommentlines+) mpindex
+                  errabsline = unPos tl + errrelline
+                  errcol = 4 + if isVirtual p then 1 else 0
+                  txt = formatExcerptLikeMegaparsec errabsline errrelline errcol
+                          (showTransaction t & textChomp & (<>"\n"))
+
+formatExcerptLikeMegaparsec :: Int -> Int -> Int -> Text -> Text
+formatExcerptLikeMegaparsec absline relline col txt =
+  T.unlines $ js' <> ks' <> [colmarkerline] <> ms'
+  where
+    (ls,ms) = splitAt (relline+1) $ T.lines txt
+    (js,ks) = splitAt (length ls - 1) ls
+    (js',ks') = case ks of
+      [k] -> (map (lineprefix<>) js, [T.pack (show absline) <> " | " <> k])
+      _   -> ([], [])
+    ms' = map (lineprefix<>) ms
+    colmarkerline = lineprefix <> T.replicate col " " <> "^"
+    lineprefix = T.replicate marginw " " <> "| "
+      where  marginw = length (show absline) + 1
 
 -- | Check that all the commodities used in this journal's postings have been declared
 -- by commodity directives, returning an error message otherwise.