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

Hledger.Read.Common:
export makeTransactionErrorExcerpt
This commit is contained in:
Simon Michael 2022-04-24 18:08:08 -10:00
parent 1ff0f76524
commit 66d0beea5e
3 changed files with 22 additions and 24 deletions

View File

@ -112,6 +112,7 @@ module Hledger.Read.Common (
skipNonNewlineSpaces, skipNonNewlineSpaces,
skipNonNewlineSpaces1, skipNonNewlineSpaces1,
aliasesFromOpts, aliasesFromOpts,
makeTransactionErrorExcerpt,
-- * tests -- * tests
tests_Common, tests_Common,
@ -454,6 +455,7 @@ journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j)
-- and the rendered excerpt, or as much of these as is possible. -- and the rendered excerpt, or as much of these as is possible.
makeTransactionErrorExcerpt :: Transaction -> (Transaction -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text) makeTransactionErrorExcerpt :: Transaction -> (Transaction -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeTransactionErrorExcerpt t findtxnerrorcolumns = (f, tl, merrcols, ex) makeTransactionErrorExcerpt t findtxnerrorcolumns = (f, tl, merrcols, ex)
-- XXX findtxnerrorcolumns is awkward, I don't think this is the final form
where where
(SourcePos f tpos _) = fst $ tsourcepos t (SourcePos f tpos _) = fst $ tsourcepos t
tl = unPos tpos tl = unPos tpos
@ -469,9 +471,9 @@ decorateTransactionErrorExcerpt l mcols txt =
(ls,ms) = splitAt 1 $ T.lines txt (ls,ms) = splitAt 1 $ T.lines txt
ls' = map ((T.pack (show l) <> " | ") <>) ls ls' = map ((T.pack (show l) <> " | ") <>) ls
colmarkerline = colmarkerline =
[lineprefix <> T.replicate col " " <> T.replicate regionw "^" [lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"
| Just (col, mendcol) <- [mcols] | Just (col, mendcol) <- [mcols]
, let regionw = maybe 1 (subtract col) mendcol , let regionw = maybe 1 (subtract col) mendcol + 1
] ]
lineprefix = T.replicate marginw " " <> "| " lineprefix = T.replicate marginw " " <> "| "
where marginw = length (show l) + 1 where marginw = length (show l) + 1

View File

@ -3,11 +3,12 @@ module Hledger.Cli.Commands.Check.Ordereddates (
) )
where where
import qualified Data.Text as T
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Control.Monad (forM) import Control.Monad (forM)
import Data.List (groupBy) import Data.List (groupBy)
import Text.Printf (printf)
import Data.Maybe (fromMaybe)
journalCheckOrdereddates :: CliOpts -> Journal -> Either String () journalCheckOrdereddates :: CliOpts -> Journal -> Either String ()
journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
@ -26,17 +27,17 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
case checkTransactions compare ts of case checkTransactions compare ts of
FoldAcc{fa_previous=Nothing} -> Right () FoldAcc{fa_previous=Nothing} -> Right ()
FoldAcc{fa_error=Nothing} -> Right () FoldAcc{fa_error=Nothing} -> Right ()
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do FoldAcc{fa_error=Just t, fa_previous=Just tprev} -> Left $ printf
let "%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s%s"
datestr = if date2_ ropts then "2" else "" f l col col2 ex datenum tprevdate oruniquestr
uniquestr = if checkunique then " and/or not unique" else "" where
positionstr = sourcePosPairPretty $ tsourcepos error (f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols
txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous col = maybe 0 fst mcols
txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error col2 = maybe 0 (fromMaybe 0 . snd) mcols
Left $ finderrcols _t = Just (1, Just 10)
"transaction date" <> datestr <> " is out of order" datenum = if date2_ ropts then "2" else ""
<> uniquestr <> "\nat " <> positionstr <> ":\n\n" tprevdate = show $ (if date2_ ropts then transactionDate2 else tdate) tprev
<> txn1str <> txn2str oruniquestr = if checkunique then ", and/or not unique" else "" -- XXX still used ?
data FoldAcc a b = FoldAcc data FoldAcc a b = FoldAcc
{ fa_error :: Maybe a { fa_error :: Maybe a

View File

@ -1,13 +1,8 @@
$$$ hledger check ordereddates -f ordereddates.j $$$ hledger check ordereddates -f ordereddates.j
>>>2 >>>2
hledger: Error: transaction date is out of order hledger: Error: /Users/simon/src/hledger/hledger/test/errors/ordereddates.j:10:1-10:
at /Users/simon/src/hledger/hledger/test/errors/ordereddates.j:10-11: 10 | 2022-01-01 p
| ^^^^^^^^^^
2022-01-02 p | (a) 1
(a) 1 transaction date is out of order with previous transaction date 2022-01-02
> 2022-01-01 p
(a) 1
>>>=1 >>>=1