ref: consolidate most checks under Hledger.Read.Checks
and error message helpers in Hledger.Read.Error.
This commit is contained in:
Simon Michael
parent
211680da86
commit
810a868c88
@ -42,6 +42,7 @@ module Hledger.Read (
|
||||
findReader,
|
||||
splitReaderPrefix,
|
||||
runJournalParser,
|
||||
module Hledger.Read.Checks,
|
||||
module Hledger.Read.Common,
|
||||
module Hledger.Read.InputOptions,
|
||||
|
||||
@ -75,6 +76,7 @@ import System.IO (hPutStr, stderr)
|
||||
|
||||
import Hledger.Data.Dates (getCurrentDay, parsedateM, showDate)
|
||||
import Hledger.Data.Types
|
||||
import Hledger.Read.Checks
|
||||
import Hledger.Read.Common
|
||||
import Hledger.Read.InputOptions
|
||||
import Hledger.Read.JournalReader as JournalReader
|
||||
|
||||
125
hledger-lib/Hledger/Read/Checks.hs
Normal file
125
hledger-lib/Hledger/Read/Checks.hs
Normal file
@ -0,0 +1,125 @@
|
||||
{-|
|
||||
Various additional validation checks that can be performed on a Journal.
|
||||
Some are called as part of reading a file in strict mode,
|
||||
others can be called only via the check command.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
|
||||
module Hledger.Read.Checks (
|
||||
journalCheckAccountsDeclared,
|
||||
journalCheckCommoditiesDeclared,
|
||||
journalCheckPayeesDeclared,
|
||||
module Hledger.Read.Checks.Uniqueleafnames,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Char (isSpace)
|
||||
import Data.List (find)
|
||||
import Data.Maybe
|
||||
import qualified Data.Map.Strict as M
|
||||
import qualified Data.Text as T
|
||||
import Safe (atMay)
|
||||
import Text.Printf (printf)
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Read.Checks.Uniqueleafnames
|
||||
import Hledger.Read.Error
|
||||
|
||||
-- | Check that all the journal's postings are to accounts declared with
|
||||
-- account directives, returning an error message otherwise.
|
||||
journalCheckAccountsDeclared :: Journal -> Either String ()
|
||||
journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)
|
||||
where
|
||||
checkacct p@Posting{paccount=a}
|
||||
| a `elem` journalAccountNamesDeclared j = Right ()
|
||||
| otherwise = Left $
|
||||
printf "%s:%d:%d-%d:\n%sundeclared account \"%s\"\n" f l col col2 ex a
|
||||
where
|
||||
(f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
|
||||
col = maybe 0 fst mcols
|
||||
col2 = maybe 0 (fromMaybe 0 . snd) mcols
|
||||
finderrcols p _ _ = Just (col, Just col2)
|
||||
where
|
||||
col = 5 + if isVirtual p then 1 else 0
|
||||
col2 = col + T.length a - 1
|
||||
|
||||
-- | Check that all the commodities used in this journal's postings have been declared
|
||||
-- by commodity directives, returning an error message otherwise.
|
||||
journalCheckCommoditiesDeclared :: Journal -> Either String ()
|
||||
journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j)
|
||||
where
|
||||
checkcommodities p =
|
||||
case findundeclaredcomm p of
|
||||
Nothing -> Right ()
|
||||
Just (comm, _) ->
|
||||
Left $ printf "%s:%d:%d-%d:\n%sundeclared commodity \"%s\"\n" f l col col2 ex comm
|
||||
where
|
||||
(f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
|
||||
col = maybe 0 fst mcols
|
||||
col2 = maybe 0 (fromMaybe 0 . snd) mcols
|
||||
where
|
||||
-- Find the first undeclared commodity symbol in this posting's amount
|
||||
-- or balance assertion amount, if any. The boolean will be true if
|
||||
-- the undeclared symbol was in the posting amount.
|
||||
findundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)
|
||||
findundeclaredcomm Posting{pamount=amt,pbalanceassertion} =
|
||||
case (findundeclared postingcomms, findundeclared assertioncomms) of
|
||||
(Just c, _) -> Just (c, True)
|
||||
(_, Just c) -> Just (c, False)
|
||||
_ -> Nothing
|
||||
where
|
||||
postingcomms = map acommodity $ filter (not . isIgnorable) $ amountsRaw amt
|
||||
where
|
||||
-- Ignore missing amounts and zero amounts without commodity (#1767)
|
||||
isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt
|
||||
assertioncomms = [acommodity a | Just a <- [baamount <$> pbalanceassertion]]
|
||||
findundeclared = find (`M.notMember` jcommodities j)
|
||||
|
||||
-- Find the best position for an error column marker when this posting
|
||||
-- is rendered by showTransaction.
|
||||
-- Reliably locating a problem commodity symbol in showTransaction output
|
||||
-- is really tricky. Some examples:
|
||||
--
|
||||
-- assets "C $" -1 @ $ 2
|
||||
-- ^
|
||||
-- assets $1 = $$1
|
||||
-- ^
|
||||
-- assets [ANSI RED]$-1[ANSI RESET]
|
||||
-- ^
|
||||
--
|
||||
-- To simplify, we will mark the whole amount + balance assertion region, like:
|
||||
-- assets "C $" -1 @ $ 2
|
||||
-- ^^^^^^^^^^^^^^
|
||||
-- XXX refine this region when it's easy
|
||||
finderrcols p t txntxt =
|
||||
case transactionFindPostingIndex (==p) t of
|
||||
Nothing -> Nothing
|
||||
Just pindex -> Just (amtstart, Just amtend)
|
||||
where
|
||||
tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)
|
||||
errrelline = 1 + tcommentlines + pindex -- XXX doesn't count posting coment lines
|
||||
errline = fromMaybe "" (T.lines txntxt `atMay` (errrelline-1))
|
||||
acctend = 4 + T.length (paccount p) + if isVirtual p then 2 else 0
|
||||
amtstart = acctend + (T.length $ T.takeWhile isSpace $ T.drop acctend errline) + 1
|
||||
amtend = amtstart + (T.length $ T.stripEnd $ T.takeWhile (/=';') $ T.drop amtstart errline)
|
||||
|
||||
-- | Check that all the journal's transactions have payees declared with
|
||||
-- payee directives, returning an error message otherwise.
|
||||
journalCheckPayeesDeclared :: Journal -> Either String ()
|
||||
journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)
|
||||
where
|
||||
checkpayee t
|
||||
| payee `elem` journalPayeesDeclared j = Right ()
|
||||
| otherwise = Left $
|
||||
printf "%s:%d:%d-%d:\n%sundeclared payee \"%s\"\n" f l col col2 ex payee
|
||||
where
|
||||
payee = transactionPayee t
|
||||
(f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols
|
||||
col = maybe 0 fst mcols
|
||||
col2 = maybe 0 (fromMaybe 0 . snd) mcols
|
||||
finderrcols t = Just (col, Just col2)
|
||||
where
|
||||
col = T.length (showTransactionLineFirstPart t) + 2
|
||||
col2 = col + T.length (transactionPayee t) - 1
|
||||
@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Hledger.Cli.Commands.Check.Uniqueleafnames (
|
||||
module Hledger.Read.Checks.Uniqueleafnames (
|
||||
journalCheckUniqueleafnames
|
||||
)
|
||||
where
|
||||
@ -10,10 +10,12 @@ import Data.Function (on)
|
||||
import Data.List (groupBy, sortBy)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Hledger
|
||||
import Text.Printf (printf)
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Read.Error
|
||||
|
||||
-- | 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.
|
||||
journalCheckUniqueleafnames :: Journal -> Either String ()
|
||||
@ -37,9 +37,6 @@ module Hledger.Read.Common (
|
||||
parseAndFinaliseJournal,
|
||||
initialiseAndParseJournal,
|
||||
journalFinalise,
|
||||
journalCheckAccountsDeclared,
|
||||
journalCheckCommoditiesDeclared,
|
||||
journalCheckPayeesDeclared,
|
||||
journalAddForecast,
|
||||
journalAddAutoPostings,
|
||||
setYear,
|
||||
@ -112,8 +109,6 @@ module Hledger.Read.Common (
|
||||
skipNonNewlineSpaces,
|
||||
skipNonNewlineSpaces1,
|
||||
aliasesFromOpts,
|
||||
makeTransactionErrorExcerpt,
|
||||
makePostingErrorExcerpt,
|
||||
|
||||
-- * tests
|
||||
tests_Common,
|
||||
@ -152,9 +147,8 @@ import Hledger.Data
|
||||
import Hledger.Query (Query(..), filterQuery, parseQueryTerm, queryEndDate, queryStartDate, queryIsDate, simplifyQuery)
|
||||
import Hledger.Reports.ReportOptions (ReportOpts(..), queryFromFlags, rawOptsToReportOpts)
|
||||
import Hledger.Utils
|
||||
import Text.Printf (printf)
|
||||
import Hledger.Read.InputOptions
|
||||
import Safe (atMay)
|
||||
import Hledger.Read.Checks (journalCheckAccountsDeclared, journalCheckCommoditiesDeclared)
|
||||
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
@ -359,180 +353,6 @@ journalAddForecast (Just forecastspan) j = j{jtxns = jtxns j ++ forecasttxns}
|
||||
. concatMap (`runPeriodicTransaction` forecastspan)
|
||||
$ jperiodictxns j
|
||||
|
||||
-- | Check that all the journal's transactions have payees declared with
|
||||
-- payee directives, returning an error message otherwise.
|
||||
journalCheckPayeesDeclared :: Journal -> Either String ()
|
||||
journalCheckPayeesDeclared j = mapM_ checkpayee (jtxns j)
|
||||
where
|
||||
checkpayee t
|
||||
| payee `elem` journalPayeesDeclared j = Right ()
|
||||
| otherwise = Left $
|
||||
printf "%s:%d:%d-%d:\n%sundeclared payee \"%s\"\n" f l col col2 ex payee
|
||||
where
|
||||
payee = transactionPayee t
|
||||
(f,l,mcols,ex) = makeTransactionErrorExcerpt t finderrcols
|
||||
col = maybe 0 fst mcols
|
||||
col2 = maybe 0 (fromMaybe 0 . snd) mcols
|
||||
finderrcols t = Just (col, Just col2)
|
||||
where
|
||||
col = T.length (showTransactionLineFirstPart t) + 2
|
||||
col2 = col + T.length (transactionPayee t) - 1
|
||||
|
||||
-- | Check that all the journal's postings are to accounts declared with
|
||||
-- account directives, returning an error message otherwise.
|
||||
journalCheckAccountsDeclared :: Journal -> Either String ()
|
||||
journalCheckAccountsDeclared j = mapM_ checkacct (journalPostings j)
|
||||
where
|
||||
checkacct p@Posting{paccount=a}
|
||||
| a `elem` journalAccountNamesDeclared j = Right ()
|
||||
| otherwise = Left $
|
||||
printf "%s:%d:%d-%d:\n%sundeclared account \"%s\"\n" f l col col2 ex a
|
||||
where
|
||||
(f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
|
||||
col = maybe 0 fst mcols
|
||||
col2 = maybe 0 (fromMaybe 0 . snd) mcols
|
||||
finderrcols p _ _ = Just (col, Just col2)
|
||||
where
|
||||
col = 5 + if isVirtual p then 1 else 0
|
||||
col2 = col + T.length a - 1
|
||||
|
||||
-- | Check that all the commodities used in this journal's postings have been declared
|
||||
-- by commodity directives, returning an error message otherwise.
|
||||
journalCheckCommoditiesDeclared :: Journal -> Either String ()
|
||||
journalCheckCommoditiesDeclared j = mapM_ checkcommodities (journalPostings j)
|
||||
where
|
||||
checkcommodities p =
|
||||
case findundeclaredcomm p of
|
||||
Nothing -> Right ()
|
||||
Just (comm, _) ->
|
||||
Left $ printf "%s:%d:%d-%d:\n%sundeclared commodity \"%s\"\n" f l col col2 ex comm
|
||||
where
|
||||
(f,l,mcols,ex) = makePostingErrorExcerpt p finderrcols
|
||||
col = maybe 0 fst mcols
|
||||
col2 = maybe 0 (fromMaybe 0 . snd) mcols
|
||||
where
|
||||
-- Find the first undeclared commodity symbol in this posting's amount
|
||||
-- or balance assertion amount, if any. The boolean will be true if
|
||||
-- the undeclared symbol was in the posting amount.
|
||||
findundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)
|
||||
findundeclaredcomm Posting{pamount=amt,pbalanceassertion} =
|
||||
case (findundeclared postingcomms, findundeclared assertioncomms) of
|
||||
(Just c, _) -> Just (c, True)
|
||||
(_, Just c) -> Just (c, False)
|
||||
_ -> Nothing
|
||||
where
|
||||
postingcomms = map acommodity $ filter (not . isIgnorable) $ amountsRaw amt
|
||||
where
|
||||
-- Ignore missing amounts and zero amounts without commodity (#1767)
|
||||
isIgnorable a = (T.null (acommodity a) && amountIsZero a) || a == missingamt
|
||||
assertioncomms = [acommodity a | Just a <- [baamount <$> pbalanceassertion]]
|
||||
findundeclared = find (`M.notMember` jcommodities j)
|
||||
|
||||
-- Find the best position for an error column marker when this posting
|
||||
-- is rendered by showTransaction.
|
||||
-- Reliably locating a problem commodity symbol in showTransaction output
|
||||
-- is really tricky. Some examples:
|
||||
--
|
||||
-- assets "C $" -1 @ $ 2
|
||||
-- ^
|
||||
-- assets $1 = $$1
|
||||
-- ^
|
||||
-- assets [ANSI RED]$-1[ANSI RESET]
|
||||
-- ^
|
||||
--
|
||||
-- To simplify, we will mark the whole amount + balance assertion region, like:
|
||||
-- assets "C $" -1 @ $ 2
|
||||
-- ^^^^^^^^^^^^^^
|
||||
finderrcols p t txntxt =
|
||||
case transactionFindPostingIndex (==p) t of
|
||||
Nothing -> Nothing
|
||||
Just pindex -> Just (amtstart, Just amtend)
|
||||
where
|
||||
tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)
|
||||
errrelline = 1 + tcommentlines + pindex -- XXX doesn't count posting coment lines
|
||||
errline = fromMaybe "" (T.lines txntxt `atMay` (errrelline-1))
|
||||
acctend = 4 + T.length (paccount p) + if isVirtual p then 2 else 0
|
||||
amtstart = acctend + (T.length $ T.takeWhile isSpace $ T.drop acctend errline) + 1
|
||||
amtend = amtstart + (T.length $ T.stripEnd $ T.takeWhile (/=';') $ T.drop amtstart errline)
|
||||
|
||||
-- | Given a problem transaction and a function calculating the best
|
||||
-- column(s) for marking the error region:
|
||||
-- render it as a megaparsec-style excerpt, showing the original line number
|
||||
-- on the transaction line, and a column(s) marker.
|
||||
-- Returns the file path, line number, column(s) if known,
|
||||
-- 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
|
||||
txntxt = showTransaction t & textChomp & (<>"\n")
|
||||
merrcols = findtxnerrorcolumns t
|
||||
ex = decorateTransactionErrorExcerpt tl merrcols txntxt
|
||||
|
||||
-- | Add megaparsec-style left margin, line number, and optional column marker(s).
|
||||
decorateTransactionErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
|
||||
decorateTransactionErrorExcerpt l mcols txt =
|
||||
T.unlines $ ls' <> colmarkerline <> map (lineprefix<>) ms
|
||||
where
|
||||
(ls,ms) = splitAt 1 $ T.lines txt
|
||||
ls' = map ((T.pack (show l) <> " | ") <>) ls
|
||||
colmarkerline =
|
||||
[lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"
|
||||
| Just (col, mendcol) <- [mcols]
|
||||
, let regionw = maybe 1 (subtract col) mendcol + 1
|
||||
]
|
||||
lineprefix = T.replicate marginw " " <> "| "
|
||||
where marginw = length (show l) + 1
|
||||
|
||||
-- | Given a problem posting and a function calculating the best
|
||||
-- column(s) for marking the error region:
|
||||
-- look up error info from the parent transaction, and render the transaction
|
||||
-- as a megaparsec-style excerpt, showing the original line number
|
||||
-- on the problem posting's line, and a column indicator.
|
||||
-- Returns the file path, line number, column(s) if known,
|
||||
-- and the rendered excerpt, or as much of these as is possible.
|
||||
makePostingErrorExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
|
||||
makePostingErrorExcerpt p findpostingerrorcolumns =
|
||||
case ptransaction p of
|
||||
Nothing -> ("-", 0, Nothing, "")
|
||||
Just t -> (f, errabsline, merrcols, ex)
|
||||
where
|
||||
(SourcePos f tl _) = fst $ tsourcepos t
|
||||
tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)
|
||||
mpindex = transactionFindPostingIndex (==p) t
|
||||
errrelline = maybe 0 (tcommentlines+) mpindex -- XXX doesn't count posting coment lines
|
||||
errabsline = unPos tl + errrelline
|
||||
txntxt = showTransaction t & textChomp & (<>"\n")
|
||||
merrcols = findpostingerrorcolumns p t txntxt
|
||||
ex = decoratePostingErrorExcerpt errabsline errrelline merrcols txntxt
|
||||
|
||||
-- | Add megaparsec-style left margin, line number, and optional column marker(s).
|
||||
decoratePostingErrorExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text
|
||||
decoratePostingErrorExcerpt absline relline mcols 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-1) " " <> T.replicate regionw "^"
|
||||
| Just (col, mendcol) <- [mcols]
|
||||
, let regionw = 1 + maybe 0 (subtract col) mendcol
|
||||
]
|
||||
lineprefix = T.replicate marginw " " <> "| "
|
||||
where marginw = length (show absline) + 1
|
||||
|
||||
-- | Find the 1-based index of the first posting in this transaction
|
||||
-- satisfying the given predicate.
|
||||
transactionFindPostingIndex :: (Posting -> Bool) -> Transaction -> Maybe Int
|
||||
transactionFindPostingIndex ppredicate =
|
||||
fmap fst . find (ppredicate.snd) . zip [1..] . tpostings
|
||||
|
||||
setYear :: Year -> JournalParser m ()
|
||||
setYear y = modify' (\j -> j{jparsedefaultyear=Just y})
|
||||
|
||||
|
||||
99
hledger-lib/Hledger/Read/Error.hs
Normal file
99
hledger-lib/Hledger/Read/Error.hs
Normal file
@ -0,0 +1,99 @@
|
||||
{-|
|
||||
Helpers for making error messages.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Hledger.Read.Error (
|
||||
makeTransactionErrorExcerpt,
|
||||
makePostingErrorExcerpt,
|
||||
transactionFindPostingIndex,
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Function ((&))
|
||||
import Data.List (find)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
import Hledger.Data
|
||||
import Hledger.Utils
|
||||
|
||||
-- | Given a problem transaction and a function calculating the best
|
||||
-- column(s) for marking the error region:
|
||||
-- render it as a megaparsec-style excerpt, showing the original line number
|
||||
-- on the transaction line, and a column(s) marker.
|
||||
-- Returns the file path, line number, column(s) if known,
|
||||
-- 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
|
||||
txntxt = showTransaction t & textChomp & (<>"\n")
|
||||
merrcols = findtxnerrorcolumns t
|
||||
ex = decorateTransactionErrorExcerpt tl merrcols txntxt
|
||||
|
||||
-- | Add megaparsec-style left margin, line number, and optional column marker(s).
|
||||
decorateTransactionErrorExcerpt :: Int -> Maybe (Int, Maybe Int) -> Text -> Text
|
||||
decorateTransactionErrorExcerpt l mcols txt =
|
||||
T.unlines $ ls' <> colmarkerline <> map (lineprefix<>) ms
|
||||
where
|
||||
(ls,ms) = splitAt 1 $ T.lines txt
|
||||
ls' = map ((T.pack (show l) <> " | ") <>) ls
|
||||
colmarkerline =
|
||||
[lineprefix <> T.replicate (col-1) " " <> T.replicate regionw "^"
|
||||
| Just (col, mendcol) <- [mcols]
|
||||
, let regionw = maybe 1 (subtract col) mendcol + 1
|
||||
]
|
||||
lineprefix = T.replicate marginw " " <> "| "
|
||||
where marginw = length (show l) + 1
|
||||
|
||||
-- | Given a problem posting and a function calculating the best
|
||||
-- column(s) for marking the error region:
|
||||
-- look up error info from the parent transaction, and render the transaction
|
||||
-- as a megaparsec-style excerpt, showing the original line number
|
||||
-- on the problem posting's line, and a column indicator.
|
||||
-- Returns the file path, line number, column(s) if known,
|
||||
-- and the rendered excerpt, or as much of these as is possible.
|
||||
makePostingErrorExcerpt :: Posting -> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)) -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
|
||||
makePostingErrorExcerpt p findpostingerrorcolumns =
|
||||
case ptransaction p of
|
||||
Nothing -> ("-", 0, Nothing, "")
|
||||
Just t -> (f, errabsline, merrcols, ex)
|
||||
where
|
||||
(SourcePos f tl _) = fst $ tsourcepos t
|
||||
tcommentlines = max 0 (length (T.lines $ tcomment t) - 1)
|
||||
mpindex = transactionFindPostingIndex (==p) t
|
||||
errrelline = maybe 0 (tcommentlines+) mpindex -- XXX doesn't count posting coment lines
|
||||
errabsline = unPos tl + errrelline
|
||||
txntxt = showTransaction t & textChomp & (<>"\n")
|
||||
merrcols = findpostingerrorcolumns p t txntxt
|
||||
ex = decoratePostingErrorExcerpt errabsline errrelline merrcols txntxt
|
||||
|
||||
-- | Add megaparsec-style left margin, line number, and optional column marker(s).
|
||||
decoratePostingErrorExcerpt :: Int -> Int -> Maybe (Int, Maybe Int) -> Text -> Text
|
||||
decoratePostingErrorExcerpt absline relline mcols 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-1) " " <> T.replicate regionw "^"
|
||||
| Just (col, mendcol) <- [mcols]
|
||||
, let regionw = 1 + maybe 0 (subtract col) mendcol
|
||||
]
|
||||
lineprefix = T.replicate marginw " " <> "| "
|
||||
where marginw = length (show absline) + 1
|
||||
|
||||
-- | Find the 1-based index of the first posting in this transaction
|
||||
-- satisfying the given predicate.
|
||||
transactionFindPostingIndex :: (Posting -> Bool) -> Transaction -> Maybe Int
|
||||
transactionFindPostingIndex ppredicate =
|
||||
fmap fst . find (ppredicate.snd) . zip [1..] . tpostings
|
||||
|
||||
@ -63,6 +63,8 @@ library
|
||||
Hledger.Data.Valuation
|
||||
Hledger.Query
|
||||
Hledger.Read
|
||||
Hledger.Read.Checks
|
||||
Hledger.Read.Checks.Uniqueleafnames
|
||||
Hledger.Read.Common
|
||||
Hledger.Read.CsvReader
|
||||
Hledger.Read.JournalReader
|
||||
@ -86,6 +88,7 @@ library
|
||||
Hledger.Utils.Text
|
||||
Text.Tabular.AsciiWide
|
||||
other-modules:
|
||||
Hledger.Read.Error
|
||||
Text.Megaparsec.Custom
|
||||
Text.WideString
|
||||
Paths_hledger_lib
|
||||
|
||||
@ -115,6 +115,8 @@ library:
|
||||
- Hledger.Data.Valuation
|
||||
- Hledger.Query
|
||||
- Hledger.Read
|
||||
- Hledger.Read.Checks
|
||||
- Hledger.Read.Checks.Uniqueleafnames
|
||||
- Hledger.Read.Common
|
||||
- Hledger.Read.CsvReader
|
||||
- Hledger.Read.JournalReader
|
||||
|
||||
@ -18,7 +18,6 @@ import System.Console.CmdArgs.Explicit
|
||||
import Hledger
|
||||
import Hledger.Cli.CliOptions
|
||||
import Hledger.Cli.Commands.Check.Ordereddates (journalCheckOrdereddates)
|
||||
import Hledger.Cli.Commands.Check.Uniqueleafnames (journalCheckUniqueleafnames)
|
||||
|
||||
checkmode :: Mode RawOpts
|
||||
checkmode = hledgerCommandMode
|
||||
|
||||
@ -9,7 +9,9 @@ import Control.Monad (forM)
|
||||
import Data.List (groupBy)
|
||||
import Text.Printf (printf)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Hledger.Read.Error (makeTransactionErrorExcerpt)
|
||||
|
||||
-- XXX does this need CliOpts ? Can it move to Hledger.Read.Checks ?
|
||||
journalCheckOrdereddates :: CliOpts -> Journal -> Either String ()
|
||||
journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
|
||||
let
|
||||
@ -18,7 +20,7 @@ journalCheckOrdereddates CliOpts{reportspec_=rspec} j = do
|
||||
filets =
|
||||
groupBy (\t1 t2 -> transactionFile t1 == transactionFile t2) $
|
||||
filter (_rsQuery rspec `matchesTransaction`) $
|
||||
jtxns $ journalApplyValuationFromOpts rspec j
|
||||
jtxns $ journalApplyValuationFromOpts rspec j -- XXX why apply valuation ?
|
||||
checkunique = False -- boolopt "unique" rawopts XXX was supported by checkdates command
|
||||
compare a b = if checkunique then getdate a < getdate b else getdate a <= getdate b
|
||||
where getdate = transactionDateFn ropts
|
||||
|
||||
@ -111,7 +111,6 @@ library
|
||||
Hledger.Cli.Commands.Cashflow
|
||||
Hledger.Cli.Commands.Check
|
||||
Hledger.Cli.Commands.Check.Ordereddates
|
||||
Hledger.Cli.Commands.Check.Uniqueleafnames
|
||||
Hledger.Cli.Commands.Close
|
||||
Hledger.Cli.Commands.Codes
|
||||
Hledger.Cli.Commands.Commodities
|
||||
|
||||
@ -158,7 +158,6 @@ library:
|
||||
- Hledger.Cli.Commands.Cashflow
|
||||
- Hledger.Cli.Commands.Check
|
||||
- Hledger.Cli.Commands.Check.Ordereddates
|
||||
- Hledger.Cli.Commands.Check.Uniqueleafnames
|
||||
- Hledger.Cli.Commands.Close
|
||||
- Hledger.Cli.Commands.Codes
|
||||
- Hledger.Cli.Commands.Commodities
|
||||
|
||||
Loading…
Reference in New Issue
Block a user