mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
;check: accounts, commodities, payees, ordereddates: improve errors
Error messages for these four are now a bit fancier and more consistent. But not yet optimised for machine readability. Cf #1436. Added to hledger-lib: chomp1, linesPrepend[2].
This commit is contained in:
parent
e59603a04a
commit
31ea37a785
@ -14,8 +14,17 @@
|
||||
; salary
|
||||
; liabilities
|
||||
; debts
|
||||
account assets:bank:checking
|
||||
account income:salary
|
||||
account income:gifts
|
||||
account assets:bank:saving
|
||||
account assets:cash
|
||||
account expenses:food
|
||||
account expenses:supplies
|
||||
account liabilities:debts
|
||||
commodity $
|
||||
|
||||
2008/01/01 income
|
||||
2018/01/01 income
|
||||
assets:bank:checking $1
|
||||
income:salary
|
||||
|
||||
|
@ -150,6 +150,7 @@ import Text.Megaparsec.Custom
|
||||
import Hledger.Data
|
||||
import Hledger.Utils
|
||||
import Safe (headMay)
|
||||
import Text.Printf (printf)
|
||||
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
@ -376,9 +377,11 @@ journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j
|
||||
where
|
||||
checkpayee t
|
||||
| p `elem` ps = Right ()
|
||||
| otherwise =
|
||||
Left $ "undeclared payee \""++T.unpack p++"\""
|
||||
++ "\nin transaction at: "++showGenericSourcePos (tsourcepos t)
|
||||
| otherwise = Left $
|
||||
printf "undeclared payee \"%s\"\nat: %s\n\n%s"
|
||||
(T.unpack p)
|
||||
(showGenericSourcePos $ tsourcepos t)
|
||||
(linesPrepend2 "> " " " $ chomp1 $ showTransaction t)
|
||||
where
|
||||
p = transactionPayee t
|
||||
ps = journalPayeesDeclared j
|
||||
@ -390,11 +393,13 @@ journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j
|
||||
where
|
||||
checkacct Posting{paccount,ptransaction}
|
||||
| paccount `elem` as = Right ()
|
||||
| otherwise =
|
||||
Left $ "undeclared account \""++T.unpack paccount++"\""
|
||||
++ case ptransaction of
|
||||
Just Transaction{tsourcepos} -> "\nin transaction at: "++showGenericSourcePos tsourcepos
|
||||
Nothing -> ""
|
||||
| otherwise = Left $
|
||||
(printf "undeclared account \"%s\"\n" (T.unpack paccount))
|
||||
++ case ptransaction of
|
||||
Nothing -> ""
|
||||
Just t -> printf "in transaction at: %s\n\n%s"
|
||||
(showGenericSourcePos $ tsourcepos t)
|
||||
(linesPrepend " " $ chomp1 $ showTransaction t)
|
||||
where
|
||||
as = journalAccountNamesDeclared j
|
||||
|
||||
@ -407,10 +412,13 @@ journalCheckCommoditiesDeclared j =
|
||||
checkcommodities Posting{..} =
|
||||
case mfirstundeclaredcomm of
|
||||
Nothing -> Right ()
|
||||
Just c -> Left $ "undeclared commodity \""++T.unpack c++"\""
|
||||
++ case ptransaction of
|
||||
Just Transaction{tsourcepos} -> "\nin transaction at: "++showGenericSourcePos tsourcepos
|
||||
Nothing -> ""
|
||||
Just c -> Left $
|
||||
(printf "undeclared commodity \"%s\"\n" (T.unpack c))
|
||||
++ case ptransaction of
|
||||
Nothing -> ""
|
||||
Just t -> printf "in transaction at: %s\n\n%s"
|
||||
(showGenericSourcePos $ tsourcepos t)
|
||||
(linesPrepend " " $ chomp1 $ showTransaction t)
|
||||
where
|
||||
mfirstundeclaredcomm =
|
||||
headMay $ filter (not . (`elem` cs)) $ catMaybes $
|
||||
@ -418,6 +426,7 @@ journalCheckCommoditiesDeclared j =
|
||||
(map (Just . acommodity) $ amounts pamount)
|
||||
cs = journalCommoditiesDeclared j
|
||||
|
||||
|
||||
setYear :: Year -> JournalParser m ()
|
||||
setYear y = modify' (\j -> j{jparsedefaultyear=Just y})
|
||||
|
||||
|
@ -21,6 +21,7 @@ module Hledger.Utils.String (
|
||||
lstrip,
|
||||
rstrip,
|
||||
chomp,
|
||||
chomp1,
|
||||
singleline,
|
||||
elideLeft,
|
||||
elideRight,
|
||||
@ -37,6 +38,8 @@ module Hledger.Utils.String (
|
||||
padright,
|
||||
cliptopleft,
|
||||
fitto,
|
||||
linesPrepend,
|
||||
linesPrepend2,
|
||||
-- * wide-character-aware layout
|
||||
charWidth,
|
||||
strWidth,
|
||||
@ -86,10 +89,14 @@ lstrip = dropWhile isSpace
|
||||
rstrip :: String -> String
|
||||
rstrip = reverse . lstrip . reverse
|
||||
|
||||
-- | Remove trailing newlines/carriage returns.
|
||||
-- | Remove all trailing newlines/carriage returns.
|
||||
chomp :: String -> String
|
||||
chomp = reverse . dropWhile (`elem` "\r\n") . reverse
|
||||
|
||||
-- | Remove all trailing newline/carriage returns, leaving just one trailing newline.
|
||||
chomp1 :: String -> String
|
||||
chomp1 = (++"\n") . chomp
|
||||
|
||||
-- | Remove consecutive line breaks, replacing them with single space
|
||||
singleline :: String -> String
|
||||
singleline = unwords . filter (/="") . (map strip) . lines
|
||||
@ -343,3 +350,14 @@ stripAnsi s = either err id $ regexReplace ansire "" s
|
||||
where
|
||||
err = error "stripAnsi: invalid replacement pattern" -- PARTIAL, shouldn't happen
|
||||
ansire = toRegex' "\ESC\\[([0-9]+;)*([0-9]+)?[ABCDHJKfmsu]" -- PARTIAL, should succeed
|
||||
|
||||
-- | Add a prefix to each line of a string.
|
||||
linesPrepend :: String -> String -> String
|
||||
linesPrepend prefix = unlines . map (prefix++) . lines
|
||||
|
||||
-- | Add a prefix to the first line of a string,
|
||||
-- and a different prefix to the remaining lines.
|
||||
linesPrepend2 :: String -> String -> String -> String
|
||||
linesPrepend2 prefix1 prefix2 s =
|
||||
unlines $ (prefix1++l) : map (prefix2++) ls
|
||||
where l:ls = lines s
|
||||
|
@ -79,7 +79,7 @@ runCheck copts@CliOpts{rawopts_} j (check,args) =
|
||||
Payees ->
|
||||
case journalCheckPayeesDeclared j of
|
||||
Right () -> return ()
|
||||
Left err -> hPutStrLn stderr err >> exitFailure
|
||||
Left err -> hPutStrLn stderr ("Error: "++err) >> exitFailure
|
||||
where
|
||||
-- Hack: append the provided args to the raw opts,
|
||||
-- in case the check can use them (like checkdates --unique).
|
||||
|
@ -37,13 +37,15 @@ checkdates CliOpts{rawopts_=rawopts,reportspec_=rspec} j = do
|
||||
FoldAcc{fa_previous=Nothing} -> return ()
|
||||
FoldAcc{fa_error=Nothing} -> return ()
|
||||
FoldAcc{fa_error=Just error, fa_previous=Just previous} -> do
|
||||
putStrLn $ printf
|
||||
("Error: transaction's date is not in date order%s,\n"
|
||||
++ "at %s:\n\n%sPrevious transaction's date was: %s")
|
||||
(if unique then " and/or not unique" else "")
|
||||
(showGenericSourcePos $ tsourcepos error)
|
||||
(showTransaction error)
|
||||
(show $ date previous)
|
||||
let
|
||||
uniquestr = if unique then " and/or not unique" else ""
|
||||
positionstr = showGenericSourcePos $ tsourcepos error
|
||||
txn1str = linesPrepend " " $ showTransaction previous
|
||||
txn2str = linesPrepend2 "> " " " $ showTransaction error
|
||||
printf "Error: transaction date is out of order%s\nat %s:\n\n%s"
|
||||
uniquestr
|
||||
positionstr
|
||||
(txn1str ++ txn2str)
|
||||
exitFailure
|
||||
|
||||
data FoldAcc a b = FoldAcc
|
||||
|
@ -28,6 +28,7 @@ checkdupesmode = hledgerCommandMode
|
||||
checkdupes _opts j = do
|
||||
let dupes = checkdupes' $ accountsNames j
|
||||
when (not $ null dupes) $ do
|
||||
-- XXX make output more like Checkdates.hs, Check.hs etc.
|
||||
mapM_ render dupes
|
||||
exitFailure
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user