mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
Merge pull request #1435 into master (add "payees" check)
Second attempt, repaired version.
This commit is contained in:
commit
652deb04ee
@ -15,6 +15,19 @@
|
||||
; liabilities
|
||||
; debts
|
||||
|
||||
; declare accounts:
|
||||
; 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
|
||||
|
||||
; declare commodities:
|
||||
; commodity $
|
||||
|
||||
2008/01/01 income
|
||||
assets:bank:checking $1
|
||||
income:salary
|
||||
|
@ -52,6 +52,7 @@ module Hledger.Data.Journal (
|
||||
-- overJournalAmounts,
|
||||
-- traverseJournalAmounts,
|
||||
-- journalCanonicalCommodities,
|
||||
journalPayeesDeclared,
|
||||
journalCommoditiesDeclared,
|
||||
journalDateSpan,
|
||||
journalStartDate,
|
||||
@ -183,6 +184,7 @@ instance Semigroup Journal where
|
||||
-- ,jparsetransactioncount = jparsetransactioncount j1 + jparsetransactioncount j2
|
||||
,jparsetimeclockentries = jparsetimeclockentries j1 <> jparsetimeclockentries j2
|
||||
,jincludefilestack = jincludefilestack j2
|
||||
,jdeclaredpayees = jdeclaredpayees j1 <> jdeclaredpayees j2
|
||||
,jdeclaredaccounts = jdeclaredaccounts j1 <> jdeclaredaccounts j2
|
||||
,jdeclaredaccounttypes = jdeclaredaccounttypes j1 <> jdeclaredaccounttypes j2
|
||||
,jglobalcommoditystyles = jglobalcommoditystyles j1 <> jglobalcommoditystyles j2
|
||||
@ -211,6 +213,7 @@ nulljournal = Journal {
|
||||
-- ,jparsetransactioncount = 0
|
||||
,jparsetimeclockentries = []
|
||||
,jincludefilestack = []
|
||||
,jdeclaredpayees = []
|
||||
,jdeclaredaccounts = []
|
||||
,jdeclaredaccounttypes = M.empty
|
||||
,jglobalcommoditystyles = M.empty
|
||||
@ -273,6 +276,10 @@ journalPostings = concatMap tpostings . jtxns
|
||||
journalCommoditiesDeclared :: Journal -> [AccountName]
|
||||
journalCommoditiesDeclared = nubSort . M.keys . jcommodities
|
||||
|
||||
-- | Sorted unique payees declared by payee directives in this journal.
|
||||
journalPayeesDeclared :: Journal -> [Payee]
|
||||
journalPayeesDeclared = nubSort . map fst . jdeclaredpayees
|
||||
|
||||
-- | Sorted unique account names posted to by this journal's transactions.
|
||||
journalAccountNamesUsed :: Journal -> [AccountName]
|
||||
journalAccountNamesUsed = accountNamesFromPostings . journalPostings
|
||||
|
@ -126,6 +126,7 @@ instance ToJSON AccountAlias
|
||||
instance ToJSON AccountType
|
||||
instance ToJSONKey AccountType
|
||||
instance ToJSON AccountDeclarationInfo
|
||||
instance ToJSON PayeeDeclarationInfo
|
||||
instance ToJSON Commodity
|
||||
instance ToJSON TimeclockCode
|
||||
instance ToJSON TimeclockEntry
|
||||
|
@ -132,6 +132,8 @@ data Interval =
|
||||
|
||||
instance Default Interval where def = NoInterval
|
||||
|
||||
type Payee = Text
|
||||
|
||||
type AccountName = Text
|
||||
|
||||
data AccountType =
|
||||
@ -453,6 +455,7 @@ data Journal = Journal {
|
||||
,jparsetimeclockentries :: [TimeclockEntry] -- ^ timeclock sessions which have not been clocked out
|
||||
,jincludefilestack :: [FilePath]
|
||||
-- principal data
|
||||
,jdeclaredpayees :: [(Payee,PayeeDeclarationInfo)] -- ^ Payees declared by payee directives, in parse order (after journal finalisation)
|
||||
,jdeclaredaccounts :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation)
|
||||
,jdeclaredaccounttypes :: M.Map AccountType [AccountName] -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts)
|
||||
,jglobalcommoditystyles :: M.Map CommoditySymbol AmountStyle -- ^ per-commodity display styles declared globally, eg by command line option or import command
|
||||
@ -482,6 +485,17 @@ type ParsedJournal = Journal
|
||||
-- The --output-format option selects one of these for output.
|
||||
type StorageFormat = String
|
||||
|
||||
-- | Extra information found in a payee directive.
|
||||
data PayeeDeclarationInfo = PayeeDeclarationInfo {
|
||||
pdicomment :: Text -- ^ any comment lines following the payee directive
|
||||
,pditags :: [Tag] -- ^ tags extracted from the comment, if any
|
||||
} deriving (Eq,Show,Generic)
|
||||
|
||||
nullpayeedeclarationinfo = PayeeDeclarationInfo {
|
||||
pdicomment = ""
|
||||
,pditags = []
|
||||
}
|
||||
|
||||
-- | Extra information about an account that can be derived from
|
||||
-- its account directive (and the other account directives).
|
||||
data AccountDeclarationInfo = AccountDeclarationInfo {
|
||||
|
@ -45,6 +45,7 @@ module Hledger.Read.Common (
|
||||
parseAndFinaliseJournal,
|
||||
parseAndFinaliseJournal',
|
||||
journalFinalise,
|
||||
journalCheckPayeesDeclared,
|
||||
setYear,
|
||||
getYear,
|
||||
setDefaultCommodityAndStyle,
|
||||
@ -149,6 +150,7 @@ import Text.Megaparsec.Custom
|
||||
import Hledger.Data
|
||||
import Hledger.Utils
|
||||
import Safe (headMay)
|
||||
import Text.Printf (printf)
|
||||
|
||||
--- ** doctest setup
|
||||
-- $setup
|
||||
@ -368,6 +370,22 @@ journalFinalise InputOpts{auto_,ignore_assertions_,commoditystyles_,strict_} f t
|
||||
)
|
||||
& fmap journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions
|
||||
|
||||
-- | Check that all the journal's transactions have payees declared with
|
||||
-- payee directives, returning an error message otherwise.
|
||||
journalCheckPayeesDeclared :: Journal -> Either String ()
|
||||
journalCheckPayeesDeclared j = sequence_ $ map checkpayee $ jtxns j
|
||||
where
|
||||
checkpayee t
|
||||
| p `elem` ps = Right ()
|
||||
| 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
|
||||
|
||||
-- | Check that all the journal's postings are to accounts declared with
|
||||
-- account directives, returning an error message otherwise.
|
||||
journalCheckAccountsDeclared :: Journal -> Either String ()
|
||||
@ -375,11 +393,13 @@ journalCheckAccountsDeclared j = sequence_ $ map checkacct $ journalPostings j
|
||||
where
|
||||
checkacct Posting{paccount,ptransaction}
|
||||
| paccount `elem` as = Right ()
|
||||
| otherwise =
|
||||
Left $ "\nstrict mode: 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
|
||||
|
||||
@ -392,11 +412,13 @@ journalCheckCommoditiesDeclared j =
|
||||
checkcommodities Posting{..} =
|
||||
case mfirstundeclaredcomm of
|
||||
Nothing -> Right ()
|
||||
Just c -> Left $
|
||||
"\nstrict mode: 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 $
|
||||
@ -404,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})
|
||||
|
||||
|
@ -226,6 +226,7 @@ directivep = (do
|
||||
,applyaccountdirectivep
|
||||
,commoditydirectivep
|
||||
,endapplyaccountdirectivep
|
||||
,payeedirectivep
|
||||
,tagdirectivep
|
||||
,endtagdirectivep
|
||||
,defaultyeardirectivep
|
||||
@ -396,6 +397,17 @@ addAccountDeclaration (a,cmt,tags) =
|
||||
in
|
||||
j{jdeclaredaccounts = d:decls})
|
||||
|
||||
-- Add a payee declaration to the journal.
|
||||
addPayeeDeclaration :: (Payee,Text,[Tag]) -> JournalParser m ()
|
||||
addPayeeDeclaration (p, cmt, tags) =
|
||||
modify' (\j@Journal{jdeclaredpayees} -> j{jdeclaredpayees=d:jdeclaredpayees})
|
||||
where
|
||||
d = (p
|
||||
,nullpayeedeclarationinfo{
|
||||
pdicomment = cmt
|
||||
,pditags = tags
|
||||
})
|
||||
|
||||
indentedlinep :: JournalParser m String
|
||||
indentedlinep = lift skipNonNewlineSpaces1 >> (rstrip <$> lift restofline)
|
||||
|
||||
@ -519,6 +531,15 @@ endtagdirectivep = do
|
||||
lift restofline
|
||||
return ()
|
||||
|
||||
payeedirectivep :: JournalParser m ()
|
||||
payeedirectivep = do
|
||||
string "payee" <?> "payee directive"
|
||||
lift skipNonNewlineSpaces1
|
||||
payee <- lift descriptionp -- all text until ; or \n
|
||||
(comment, tags) <- lift transactioncommentp
|
||||
addPayeeDeclaration (payee, comment, tags)
|
||||
return ()
|
||||
|
||||
defaultyeardirectivep :: JournalParser m ()
|
||||
defaultyeardirectivep = do
|
||||
char 'Y' <?> "default year"
|
||||
@ -985,6 +1006,11 @@ tests_JournalReader = tests "JournalReader" [
|
||||
pdamount = usd 922.83
|
||||
}
|
||||
|
||||
,tests "payeedirectivep" [
|
||||
test "simple" $ assertParse payeedirectivep "payee foo\n"
|
||||
,test "with-comment" $ assertParse payeedirectivep "payee foo ; comment\n"
|
||||
]
|
||||
|
||||
,test "tagdirectivep" $ do
|
||||
assertParse tagdirectivep "tag foo \n"
|
||||
|
||||
|
@ -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
|
||||
|
@ -18,6 +18,8 @@ import Data.Either (partitionEithers)
|
||||
import Data.Char (toUpper)
|
||||
import Safe (readMay)
|
||||
import Control.Monad (forM_)
|
||||
import System.IO (stderr, hPutStrLn)
|
||||
import System.Exit (exitFailure)
|
||||
|
||||
checkmode :: Mode RawOpts
|
||||
checkmode = hledgerCommandMode
|
||||
@ -40,8 +42,11 @@ check copts@CliOpts{rawopts_} j = do
|
||||
([], checks) -> forM_ checks $ runCheck copts' j
|
||||
|
||||
-- | A type of error check that we can perform on the data.
|
||||
-- (Currently, just the optional checks that only the check command
|
||||
-- can do; not the checks done by default or with --strict.)
|
||||
data Check =
|
||||
Ordereddates
|
||||
| Payees
|
||||
| Uniqueleafnames
|
||||
deriving (Read,Show,Eq)
|
||||
|
||||
@ -63,13 +68,18 @@ parseCheckArgument s =
|
||||
where
|
||||
(checkname:checkargs) = words' s
|
||||
|
||||
-- XXX do all of these print on stderr ?
|
||||
-- | Run the named error check, possibly with some arguments,
|
||||
-- on this journal with these options.
|
||||
runCheck :: CliOpts -> Journal -> (Check,[String]) -> IO ()
|
||||
runCheck copts@CliOpts{rawopts_} j (check,args) =
|
||||
case check of
|
||||
Ordereddates -> checkdates copts' j
|
||||
Ordereddates -> checkdates copts' j
|
||||
Uniqueleafnames -> checkdupes copts' j
|
||||
Payees ->
|
||||
case journalCheckPayeesDeclared j of
|
||||
Right () -> return ()
|
||||
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).
|
||||
|
@ -50,6 +50,8 @@ These checks can be run by specifying their names as arguments to the check comm
|
||||
|
||||
- **ordereddates** - transactions are ordered by date (similar to the old `check-dates` command)
|
||||
|
||||
- **payees** - all payees used by transactions have been declared
|
||||
|
||||
- **uniqueleafnames** - all account leaf names are unique (similar to the old `check-dupes` command)
|
||||
|
||||
### Add-on checks
|
||||
|
@ -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
|
||||
|
||||
|
23
hledger/test/check-payees.test
Normal file
23
hledger/test/check-payees.test
Normal file
@ -0,0 +1,23 @@
|
||||
# check payees
|
||||
|
||||
# check payees succeeds when all payees are declared:
|
||||
<
|
||||
payee foo
|
||||
2020-01-01 foo
|
||||
2020-01-02 foo | some description
|
||||
$ hledger -f - check payees
|
||||
|
||||
# and otherwise fails, eg:
|
||||
<
|
||||
2020-01-01 foo
|
||||
$ hledger -f - check payees
|
||||
>2 /undeclared payee "foo"/
|
||||
>=1
|
||||
|
||||
# or:
|
||||
<
|
||||
payee foo
|
||||
2020-01-01 the payee | foo
|
||||
$ hledger -f - check payees
|
||||
>2 /undeclared payee "the payee"/
|
||||
>=1
|
Loading…
Reference in New Issue
Block a user