diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index ad7392536..9002d9b09 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -112,6 +112,7 @@ module Hledger.Read.Common ( skipNonNewlineSpaces, skipNonNewlineSpaces1, aliasesFromOpts, + makeTransactionErrorExcerpt, -- * tests tests_Common, @@ -454,6 +455,7 @@ journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j) -- 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 t findtxnerrorcolumns = (f, tl, merrcols, ex) + -- XXX findtxnerrorcolumns is awkward, I don't think this is the final form where (SourcePos f tpos _) = fst $ tsourcepos t tl = unPos tpos @@ -469,9 +471,9 @@ decorateTransactionErrorExcerpt l mcols txt = (ls,ms) = splitAt 1 $ T.lines txt ls' = map ((T.pack (show l) <> " | ") <>) ls colmarkerline = - [lineprefix <> T.replicate col " " <> T.replicate regionw "^" + [lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^" | Just (col, mendcol) <- [mcols] - , let regionw = maybe 1 (subtract col) mendcol + , let regionw = maybe 1 (subtract col) mendcol + 1 ] lineprefix = T.replicate marginw " " <> "| " where marginw = length (show l) + 1 diff --git a/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs b/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs index 117fb4780..01d85c525 100755 --- a/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs +++ b/hledger/Hledger/Cli/Commands/Check/Ordereddates.hs @@ -3,11 +3,12 @@ module Hledger.Cli.Commands.Check.Ordereddates ( ) where -import qualified Data.Text as T import Hledger import Hledger.Cli.CliOptions import Control.Monad (forM) import Data.List (groupBy) +import Text.Printf (printf) +import Data.Maybe (fromMaybe) journalCheckOrdereddates :: CliOpts -> Journal -> Either String () journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do @@ -26,17 +27,17 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do case checkTransactions compare ts of FoldAcc{fa_previous=Nothing} -> Right () FoldAcc{fa_error=Nothing} -> Right () - FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do - let - datestr = if date2_ ropts then "2" else "" - uniquestr = if checkunique then " and/or not unique" else "" - positionstr = sourcePosPairPretty $ tsourcepos error - txn1str = T.unpack . linesPrepend (T.pack " ") $ showTransaction previous - txn2str = T.unpack . linesPrepend2 (T.pack "> ") (T.pack " ") $ showTransaction error - Left $ - "transaction date" <> datestr <> " is out of order" - <> uniquestr <> "\nat " <> positionstr <> ":\n\n" - <> txn1str <> txn2str + FoldAcc{fa_error=Just t, fa_previous=Just tprev} -> Left $ printf + "%s:%d:%d-%d:\n%stransaction date%s is out of order with previous transaction date %s%s" + f l col col2 ex datenum tprevdate oruniquestr + where + (f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols + col = maybe 0 fst mcols + col2 = maybe 0 (fromMaybe 0 . snd) mcols + finderrcols _t = Just (1, Just 10) + datenum = if date2_ ropts then "2" else "" + tprevdate = show $ (if date2_ ropts then transactionDate2 else tdate) tprev + oruniquestr = if checkunique then ", and/or not unique" else "" -- XXX still used ? data FoldAcc a b = FoldAcc { fa_error :: Maybe a diff --git a/hledger/test/errors/ordereddates.test b/hledger/test/errors/ordereddates.test index 40d1c2c46..f6c8cf845 100644 --- a/hledger/test/errors/ordereddates.test +++ b/hledger/test/errors/ordereddates.test @@ -1,13 +1,8 @@ $$$ hledger check ordereddates -f ordereddates.j >>>2 -hledger: Error: transaction date is out of order -at /Users/simon/src/hledger/hledger/test/errors/ordereddates.j:10-11: - - 2022-01-02 p - (a) 1 - -> 2022-01-01 p - (a) 1 - - +hledger: Error: /Users/simon/src/hledger/hledger/test/errors/ordereddates.j:10:1-10: +10 | 2022-01-01 p + | ^^^^^^^^^^ + | (a) 1 +transaction date is out of order with previous transaction date 2022-01-02 >>>=1