check: add "payees" check requiring payee declarations

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

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

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)]         -- ^ Accounts declared by account 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 {

hledger-lib/Hledger/Read/Common.hs

@@ -45,6 +45,7 @@ module Hledger.Read.Common (
   parseAndFinaliseJournal,
   parseAndFinaliseJournal',
   journalFinalise,
+  journalCheckPayeesDeclared,
   setYear,
   getYear,
   setDefaultCommodityAndStyle,
@@ -368,6 +369,20 @@ 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 $ "\nundeclared payee \""++T.unpack p++"\""
+            ++ "\nin transaction at: "++showGenericSourcePos (tsourcepos 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 ()

hledger-lib/Hledger/Read/JournalReader.hs

@@ -397,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)
 
@@ -524,8 +535,9 @@ payeedirectivep :: JournalParser m ()
 payeedirectivep = do
   string "payee" <?> "payee directive"
   lift skipNonNewlineSpaces1
-  _ <- lift $ some nonspace
+  payee <- lift descriptionp  -- all text until ; or \n
-  lift restofline
+  (comment, tags) <- lift transactioncommentp
+  addPayeeDeclaration (payee, comment, tags)
   return ()
 
 defaultyeardirectivep :: JournalParser m ()

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, hPutStr)
+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 -> hPutStr stderr err >> exitFailure
   where
     -- Hack: append the provided args to the raw opts,
     -- in case the check can use them (like checkdates --unique). 

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