imp: check: uniqueleafnames: use the standard error format (#1436)

Hledger.Read.Common:
export makePostingErrorExcerpt
This commit is contained in:
Simon Michael 2022-04-24 18:51:47 -10:00
parent 7e45ab338f
commit a00dc04e0d
4 changed files with 26 additions and 19 deletions

View File

@ -113,6 +113,7 @@ module Hledger.Read.Common (
skipNonNewlineSpaces1, skipNonNewlineSpaces1,
aliasesFromOpts, aliasesFromOpts,
makeTransactionErrorExcerpt, makeTransactionErrorExcerpt,
makePostingErrorExcerpt,
-- * tests -- * tests
tests_Common, tests_Common,

View File

@ -12,6 +12,7 @@ import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Hledger import Hledger
import Text.Printf (printf) import Text.Printf (printf)
import Data.Maybe (fromMaybe)
-- | Check that all the journal's postings are to accounts with a unique leaf name. -- | Check that all the journal's postings are to accounts with a unique leaf name.
-- Otherwise, return an error message for the first offending posting. -- Otherwise, return an error message for the first offending posting.
@ -38,16 +39,22 @@ journalLeafAndFullAccountNames = map leafAndAccountName . journalAccountNamesUse
where leafAndAccountName a = (accountLeafName a, a) where leafAndAccountName a = (accountLeafName a, a)
checkposting :: [(Text,[AccountName])] -> Posting -> Either String () checkposting :: [(Text,[AccountName])] -> Posting -> Either String ()
checkposting leafandfullnames Posting{paccount,ptransaction} = checkposting leafandfullnames p@Posting{paccount=a} =
case [lf | lf@(_,fs) <- leafandfullnames, paccount `elem` fs] of case [lf | lf@(_,fs) <- leafandfullnames, a `elem` fs] of
[] -> Right () [] -> Right ()
(leaf,fulls):_ -> Left $ printf (leaf,fulls):_ -> Left $ printf
"account leaf names are not unique\nleaf name \"%s\" appears in account names: %s%s" "%s:%d:%d-%d:\n%saccount leaf name \"%s\" is not unique\nit is used in account names: %s"
leaf f l col col2 ex leaf accts
(T.intercalate ", " $ map (("\""<>).(<>"\"")) fulls) where
(case ptransaction of -- t = fromMaybe nulltransaction ptransaction -- XXX sloppy
Nothing -> "" col = maybe 0 fst mcols
Just t -> printf "\nseen in \"%s\" in transaction at: %s\n\n%s" col2 = maybe 0 (fromMaybe 0 . snd) mcols
paccount (f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
(sourcePosPairPretty $ tsourcepos t) where
(linesPrepend "> " . (<>"\n") . textChomp $ showTransaction t) :: String) finderrcols p _ _ = Just (col, Just col2)
where
alen = T.length $ paccount p
llen = T.length $ accountLeafName a
col = 5 + (if isVirtual p then 1 else 0) + alen - llen
col2 = col + llen - 1
accts = T.intercalate ", " $ map (("\""<>).(<>"\"")) fulls

View File

@ -11,5 +11,5 @@ $ hledger -f- check uniqueleafnames
(a) 1 (a) 1
(b:a) 1 (b:a) 1
$ hledger -f- check uniqueleafnames $ hledger -f- check uniqueleafnames
>2 /account leaf names are not unique/ >2 /account leaf name .* is not unique/
>=1 >=1

View File

@ -1,10 +1,9 @@
$$$ hledger check uniqueleafnames -f uniqueleafnames.j $$$ hledger check uniqueleafnames -f uniqueleafnames.j
>>>2 >>>2
hledger: Error: account leaf names are not unique hledger: Error: /Users/simon/src/hledger/hledger/test/errors/uniqueleafnames.j:9:8-8:
leaf name "c" appears in account names: "a:c", "b:c" | 2022-01-01 p
seen in "a:c" in transaction at: /Users/simon/src/hledger/hledger/test/errors/uniqueleafnames.j:8-9 9 | (a:c) 1
| ^
> 2022-01-01 p account leaf name "c" is not unique
> (a:c) 1 it is used in account names: "a:c", "b:c"
>>>=1 >>>=1