imp: check: ordereddates: use the standard error format (#1436)
Hledger.Read.Common: export makeTransactionErrorExcerpt
This commit is contained in:
		
							parent
							
								
									1ff0f76524
								
							
						
					
					
						commit
						66d0beea5e
					
				| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
| @ -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 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user