diff --git a/examples/sample.journal b/examples/sample.journal index ec7089075..dc2494759 100644 --- a/examples/sample.journal +++ b/examples/sample.journal @@ -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 diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index bc590d3d4..d883f562c 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Json.hs b/hledger-lib/Hledger/Data/Json.hs index 925b1fd02..82e392098 100644 --- a/hledger-lib/Hledger/Data/Json.hs +++ b/hledger-lib/Hledger/Data/Json.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 020456cf3..c9ec78519 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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 { diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index e3f7ed939..6de103fdd 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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}) diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 0b941e309..3b11b16f5 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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" diff --git a/hledger-lib/Hledger/Utils/String.hs b/hledger-lib/Hledger/Utils/String.hs index c6f887c84..66d0c882e 100644 --- a/hledger-lib/Hledger/Utils/String.hs +++ b/hledger-lib/Hledger/Utils/String.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Check.hs b/hledger/Hledger/Cli/Commands/Check.hs index 3a6a0a461..d1884c57a 100644 --- a/hledger/Hledger/Cli/Commands/Check.hs +++ b/hledger/Hledger/Cli/Commands/Check.hs @@ -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). diff --git a/hledger/Hledger/Cli/Commands/Check.md b/hledger/Hledger/Cli/Commands/Check.md index 757dd9287..2dc7cee6a 100644 --- a/hledger/Hledger/Cli/Commands/Check.md +++ b/hledger/Hledger/Cli/Commands/Check.md @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Checkdates.hs b/hledger/Hledger/Cli/Commands/Checkdates.hs index 3f3033d0c..cf37bcc1c 100755 --- a/hledger/Hledger/Cli/Commands/Checkdates.hs +++ b/hledger/Hledger/Cli/Commands/Checkdates.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Checkdupes.hs b/hledger/Hledger/Cli/Commands/Checkdupes.hs index 128d12cf8..d6c93add0 100755 --- a/hledger/Hledger/Cli/Commands/Checkdupes.hs +++ b/hledger/Hledger/Cli/Commands/Checkdupes.hs @@ -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 diff --git a/hledger/test/check-payees.test b/hledger/test/check-payees.test new file mode 100644 index 000000000..4a4639294 --- /dev/null +++ b/hledger/test/check-payees.test @@ -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