{-|
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.Data.JournalChecks (
  journalStrictChecks,
  journalCheckAccounts,
  journalCheckBalanceAssertions,
  journalCheckCommodities,
  journalCheckPayees,
  journalCheckPairedConversionPostings,
  journalCheckRecentAssertions,
  journalCheckTags,
  module Hledger.Data.JournalChecks.Ordereddates,
  module Hledger.Data.JournalChecks.Uniqueleafnames,
)
where

import Data.Char (isSpace)
import Data.List.Extra
import Data.Maybe
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Safe (atMay, lastMay, headMay)
import Text.Printf (printf)

import Hledger.Data.Errors
import Hledger.Data.Journal
import Hledger.Data.JournalChecks.Ordereddates
import Hledger.Data.JournalChecks.Uniqueleafnames
import Hledger.Data.Posting (isVirtual, postingDate, transactionAllTags, conversionPostingTagName, costPostingTagName, postingAsLines, generatedPostingTagName, generatedTransactionTagName, modifiedTransactionTagName)
import Hledger.Data.Types
import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt, oneLineFmt, showMixedAmountWith)
import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart, partitionAndCheckConversionPostings)
import Data.Time (diffDays)
import Hledger.Utils
import Data.Ord
import Hledger.Data.Dates (showDate)
import Hledger.Data.Balancing (journalBalanceTransactions, defbalancingopts)

-- | Run the extra -s/--strict checks on a journal, in order of priority,
-- returning the first error message if any of them fail.
journalStrictChecks :: Journal -> Either String ()
journalStrictChecks :: Journal -> Either FilePath ()
journalStrictChecks Journal
j = do
  -- keep the order of checks here synced with Check.md and Hledger.Cli.Commands.Check.Check.
  -- balanced is checked earlier, in journalFinalise
  Journal -> Either FilePath ()
journalCheckCommodities Journal
j
  Journal -> Either FilePath ()
journalCheckAccounts Journal
j

-- | Check that all the journal's postings are to accounts  with
-- account directives, returning an error message otherwise.
journalCheckAccounts :: Journal -> Either String ()
journalCheckAccounts :: Journal -> Either FilePath ()
journalCheckAccounts Journal
j = (Posting -> Either FilePath ()) -> [Posting] -> Either FilePath ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Either FilePath ()
forall {a}. PrintfType a => Posting -> Either a ()
checkacct (Journal -> [Posting]
journalPostings Journal
j)
  where
    checkacct :: Posting -> Either a ()
checkacct p :: Posting
p@Posting{paccount :: Posting -> Text
paccount=Text
a}
      | Text
a Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Journal -> [Text]
journalAccountNamesDeclared Journal
j = () -> Either a ()
forall a b. b -> Either a b
Right ()
      | Bool
otherwise = a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Int -> Text -> FilePath -> Text -> a
forall r. PrintfType r => FilePath -> r
printf ([FilePath] -> FilePath
unlines [
           FilePath
"%s:%d:"
          ,FilePath
"%s"
          ,FilePath
"Strict account checking is enabled, and"
          ,FilePath
"account %s has not been declared."
          ,FilePath
"Consider adding an account directive. Examples:"
          ,FilePath
""
          ,FilePath
"account %s"
          ]) FilePath
f Int
l Text
ex (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
a) Text
a
        where
          (FilePath
f,Int
l,Maybe (Int, Maybe Int)
_mcols,Text
ex) = Posting -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingAccountErrorExcerpt Posting
p

-- | Check all balance assertions in the journal and return an error message if any of them fail.
-- (Technically, this also tries to balance the journal and can return balancing failure errors;
-- ensure the journal is already balanced (with journalBalanceTransactions) to avoid this.)
journalCheckBalanceAssertions :: Journal -> Either String ()
journalCheckBalanceAssertions :: Journal -> Either FilePath ()
journalCheckBalanceAssertions = (Journal -> ()) -> Either FilePath Journal -> Either FilePath ()
forall a b. (a -> b) -> Either FilePath a -> Either FilePath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> Journal -> ()
forall a b. a -> b -> a
const ()) (Either FilePath Journal -> Either FilePath ())
-> (Journal -> Either FilePath Journal)
-> Journal
-> Either FilePath ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalancingOpts -> Journal -> Either FilePath Journal
journalBalanceTransactions BalancingOpts
defbalancingopts

-- | Check that all the commodities used in this journal's postings and P directives
-- have been declared by commodity directives, returning an error message otherwise.
journalCheckCommodities :: Journal -> Either String ()
journalCheckCommodities :: Journal -> Either FilePath ()
journalCheckCommodities Journal
j = do
  (PriceDirective -> Either FilePath ())
-> [PriceDirective] -> Either FilePath ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ PriceDirective -> Either FilePath ()
forall {a}. PrintfType a => PriceDirective -> Either a ()
checkPriceDirectiveCommodities ([PriceDirective] -> Either FilePath ())
-> [PriceDirective] -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ Journal -> [PriceDirective]
jpricedirectives Journal
j
  (Posting -> Either FilePath ()) -> [Posting] -> Either FilePath ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Either FilePath ()
forall {a}. PrintfType a => Posting -> Either a ()
checkPostingCommodities ([Posting] -> Either FilePath ())
-> [Posting] -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
  where
    firstUndeclaredOf :: t Text -> Maybe Text
firstUndeclaredOf t Text
comms = (Text -> Bool) -> t Text -> Maybe Text
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Map Text Commodity -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Journal -> Map Text Commodity
jdeclaredcommodities Journal
j) t Text
comms

    errmsg :: FilePath
errmsg = [FilePath] -> FilePath
unlines [
        FilePath
"%s:%d:"
      ,FilePath
"%s"
      ,FilePath
"Strict commodity checking is enabled, and"
      ,FilePath
"commodity %s has not been declared."
      ,FilePath
"Consider adding a commodity directive. Examples:"
      ,FilePath
""
      ,FilePath
"commodity %s1000.00"
      ,FilePath
"commodity 1.000,00 %s"
      ]

    checkPriceDirectiveCommodities :: PriceDirective -> Either a ()
checkPriceDirectiveCommodities pd :: PriceDirective
pd@PriceDirective{pdcommodity :: PriceDirective -> Text
pdcommodity=Text
c, pdamount :: PriceDirective -> Amount
pdamount=Amount
amt} =
      case [Text] -> Maybe Text
forall {t :: * -> *}. Foldable t => t Text -> Maybe Text
firstUndeclaredOf [Text
c, Amount -> Text
acommodity Amount
amt] of
        Maybe Text
Nothing   -> () -> Either a ()
forall a b. b -> Either a b
Right ()
        Just Text
comm -> a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> Int -> Text -> FilePath -> Text -> Text -> a
forall r. PrintfType r => FilePath -> r
printf FilePath
errmsg FilePath
f Int
l Text
ex (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
comm) Text
comm Text
comm
          where (FilePath
f,Int
l,Maybe (Int, Maybe Int)
_mcols,Text
ex) = PriceDirective
-> Maybe (PriceDirective -> Text -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePriceDirectiveErrorExcerpt PriceDirective
pd Maybe (PriceDirective -> Text -> Maybe (Int, Maybe Int))
forall a. Maybe a
Nothing

    checkPostingCommodities :: Posting -> Either a ()
checkPostingCommodities Posting
p =
      case Posting -> Maybe (Text, Bool)
firstundeclaredcomm Posting
p of
        Maybe (Text, Bool)
Nothing                    -> () -> Either a ()
forall a b. b -> Either a b
Right ()
        Just (Text
comm, Bool
_inpostingamt) -> a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> Int -> Text -> FilePath -> Text -> Text -> a
forall r. PrintfType r => FilePath -> r
printf FilePath
errmsg FilePath
f Int
l Text
ex (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
comm) Text
comm Text
comm
          where
            (FilePath
f,Int
l,Maybe (Int, Maybe Int)
_mcols,Text
ex) = Posting
-> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingErrorExcerpt Posting
p Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
finderrcols
      where
        -- Find the first undeclared commodity symbol in this posting's amount or balance assertion amount, if any.
        -- and whether it was in the posting amount.
        -- XXX The latter is currently unused, could be used to refine the error highlighting ?
        firstundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)
        firstundeclaredcomm :: Posting -> Maybe (Text, Bool)
firstundeclaredcomm Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt,Maybe BalanceAssertion
pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion} =
          case ([Text] -> Maybe Text
forall {t :: * -> *}. Foldable t => t Text -> Maybe Text
firstUndeclaredOf [Text]
postingcomms, [Text] -> Maybe Text
forall {t :: * -> *}. Foldable t => t Text -> Maybe Text
firstUndeclaredOf [Text]
assertioncomms) of
            (Just Text
c, Maybe Text
_) -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
c, Bool
True)
            (Maybe Text
_, Just Text
c) -> (Text, Bool) -> Maybe (Text, Bool)
forall a. a -> Maybe a
Just (Text
c, Bool
False)
            (Maybe Text, Maybe Text)
_           -> Maybe (Text, Bool)
forall a. Maybe a
Nothing
          where
            assertioncomms :: [Text]
assertioncomms = [Amount -> Text
acommodity Amount
a | Just Amount
a <- [BalanceAssertion -> Amount
baamount (BalanceAssertion -> Amount)
-> Maybe BalanceAssertion -> Maybe Amount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BalanceAssertion
pbalanceassertion]]
            postingcomms :: [Text]
postingcomms = (Amount -> Text) -> [Amount] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> Text
acommodity ([Amount] -> [Text]) -> [Amount] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Amount -> Bool) -> [Amount] -> [Amount]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Amount -> Bool) -> Amount -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Bool
isIgnorable) ([Amount] -> [Amount]) -> [Amount] -> [Amount]
forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amountsRaw MixedAmount
amt
              where
                isIgnorable :: Amount -> Bool
isIgnorable Amount
a = Amount
aAmount -> Amount -> Bool
forall a. Eq a => a -> a -> Bool
==Amount
missingamt Bool -> Bool -> Bool
|| (Amount -> Bool
amountIsZero Amount
a Bool -> Bool -> Bool
&& Text -> Bool
T.null (Amount -> Text
acommodity Amount
a))  -- #1767

        -- Calculate columns suitable for highlighting the excerpt.
        -- We won't show these in the main error line as they aren't
        -- accurate for the actual data.

        -- 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 :: Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
finderrcols Posting
p' Transaction
t Text
txntxt =
          case (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex (Posting -> Posting -> Bool
forall a. Eq a => a -> a -> Bool
==Posting
p') Transaction
t of
            Maybe Int
Nothing     -> Maybe (Int, Maybe Int)
forall a. Maybe a
Nothing
            Just Int
pindex -> (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
amtstart, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
amtend)
              where
                tcommentlines :: Int
tcommentlines = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
tcomment Transaction
t) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                errrelline :: Int
errrelline = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tcommentlines Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pindex   -- XXX doesn't count posting coment lines
                errline :: Text
errline = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> [Text]
T.lines Text
txntxt [Text] -> Int -> Maybe Text
forall a. [a] -> Int -> Maybe a
`atMay` (Int
errrellineInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
                acctend :: Int
acctend = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length (Posting -> Text
paccount Posting
p') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Posting -> Bool
isVirtual Posting
p' then Int
2 else Int
0
                amtstart :: Int
amtstart = Int
acctend Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
acctend Text
errline) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                amtend :: Int
amtend = Int
amtstart Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
';') (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
amtstart Text
errline)

-- | Check that all the journal's transactions have payees declared with
-- payee directives, returning an error message otherwise.
journalCheckPayees :: Journal -> Either String ()
journalCheckPayees :: Journal -> Either FilePath ()
journalCheckPayees Journal
j = (Transaction -> Either FilePath ())
-> [Transaction] -> Either FilePath ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Transaction -> Either FilePath ()
forall {a}. PrintfType a => Transaction -> Either a ()
checkpayee (Journal -> [Transaction]
jtxns Journal
j)
  where
    checkpayee :: Transaction -> Either a ()
checkpayee Transaction
t
      | Text
payee Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Journal -> [Text]
journalPayeesDeclared Journal
j = () -> Either a ()
forall a b. b -> Either a b
Right ()
      | Bool
otherwise = a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> FilePath -> Int -> Text -> FilePath -> Text -> a
forall r. PrintfType r => FilePath -> r
printf ([FilePath] -> FilePath
unlines [
           FilePath
"%s:%d:"
          ,FilePath
"%s"
          ,FilePath
"Strict payee checking is enabled, and"
          ,FilePath
"payee %s has not been declared."
          ,FilePath
"Consider adding a payee directive. Examples:"
          ,FilePath
""
          ,FilePath
"payee %s"
          ]) FilePath
f Int
l Text
ex (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
payee) Text
payee
      where
        payee :: Text
payee = Transaction -> Text
transactionPayee Transaction
t
        (FilePath
f,Int
l,Maybe (Int, Maybe Int)
_mcols,Text
ex) = Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeTransactionErrorExcerpt Transaction
t Transaction -> Maybe (Int, Maybe Int)
finderrcols
        -- Calculate columns suitable for highlighting the excerpt.
        -- We won't show these in the main error line as they aren't
        -- accurate for the actual data.
        finderrcols :: Transaction -> Maybe (Int, Maybe Int)
finderrcols Transaction
t' = (Int, Maybe Int) -> Maybe (Int, Maybe Int)
forall a. a -> Maybe a
Just (Int
col, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
col2)
          where
            col :: Int
col  = Text -> Int
T.length (Transaction -> Text
showTransactionLineFirstPart Transaction
t') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
            col2 :: Int
col2 = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length (Transaction -> Text
transactionPayee Transaction
t') Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Check that all the journal's tags (on accounts, transactions, postings..)
-- have been declared with tag directives, returning an error message otherwise.
journalCheckTags :: Journal -> Either String ()
journalCheckTags :: Journal -> Either FilePath ()
journalCheckTags Journal
j = do
  ((Text, AccountDeclarationInfo) -> Either FilePath ())
-> [(Text, AccountDeclarationInfo)] -> Either FilePath ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, AccountDeclarationInfo) -> Either FilePath ()
forall {a}.
PrintfType a =>
(Text, AccountDeclarationInfo) -> Either a ()
checkaccttags ([(Text, AccountDeclarationInfo)] -> Either FilePath ())
-> [(Text, AccountDeclarationInfo)] -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
  (Transaction -> Either FilePath ())
-> [Transaction] -> Either FilePath ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Transaction -> Either FilePath ()
forall {a}. PrintfType a => Transaction -> Either a ()
checktxntags  ([Transaction] -> Either FilePath ())
-> [Transaction] -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
  where
    checkaccttags :: (Text, AccountDeclarationInfo) -> Either a ()
checkaccttags (Text
a, AccountDeclarationInfo
adi) = (Tag -> Either a ()) -> [Tag] -> Either a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Either a ()
forall {a}. PrintfType a => Text -> Either a ()
checkaccttag(Text -> Either a ()) -> (Tag -> Text) -> Tag -> Either a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Tag -> Text
forall a b. (a, b) -> a
fst) ([Tag] -> Either a ()) -> [Tag] -> Either a ()
forall a b. (a -> b) -> a -> b
$ AccountDeclarationInfo -> [Tag]
aditags AccountDeclarationInfo
adi
      where
        checkaccttag :: Text -> Either a ()
checkaccttag Text
tagname
          | Text
tagname Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
declaredtags = () -> Either a ()
forall a b. b -> Either a b
Right ()
          | Bool
otherwise = a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Int -> Text -> FilePath -> Text -> a
forall r. PrintfType r => FilePath -> r
printf FilePath
msg FilePath
f Int
l Text
ex (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
tagname) Text
tagname
            where (FilePath
f,Int
l,Maybe (Int, Maybe Int)
_mcols,Text
ex) = (Text, AccountDeclarationInfo)
-> Text -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeAccountTagErrorExcerpt (Text
a, AccountDeclarationInfo
adi) Text
tagname
    checktxntags :: Transaction -> Either a ()
checktxntags Transaction
txn = (Tag -> Either a ()) -> [Tag] -> Either a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Either a ()
forall {a}. PrintfType a => Text -> Either a ()
checktxntag (Text -> Either a ()) -> (Tag -> Text) -> Tag -> Either a ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tag -> Text
forall a b. (a, b) -> a
fst) ([Tag] -> Either a ()) -> [Tag] -> Either a ()
forall a b. (a -> b) -> a -> b
$ Transaction -> [Tag]
transactionAllTags Transaction
txn
      where
        checktxntag :: Text -> Either a ()
checktxntag Text
tagname
          | Text
tagname Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
declaredtags = () -> Either a ()
forall a b. b -> Either a b
Right ()
          | Bool
otherwise = a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> Int -> Text -> FilePath -> Text -> a
forall r. PrintfType r => FilePath -> r
printf FilePath
msg FilePath
f Int
l Text
ex (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
tagname) Text
tagname
            where
              (FilePath
f,Int
l,Maybe (Int, Maybe Int)
_mcols,Text
ex) = Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makeTransactionErrorExcerpt Transaction
txn Transaction -> Maybe (Int, Maybe Int)
forall {p} {a}. p -> Maybe a
finderrcols
                where
                  finderrcols :: p -> Maybe a
finderrcols p
_txn' = Maybe a
forall a. Maybe a
Nothing
                    -- don't bother for now
                    -- Just (col, Just col2)
                    -- where
                    --   col  = T.length (showTransactionLineFirstPart txn') + 2
                    --   col2 = col + T.length tagname - 1
    declaredtags :: [Text]
declaredtags = Journal -> [Text]
journalTagsDeclared Journal
j [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
builtinTags
    msg :: FilePath
msg = ([FilePath] -> FilePath
unlines [
      FilePath
"%s:%d:"
      ,FilePath
"%s"
      ,FilePath
"Strict tag checking is enabled, and"
      ,FilePath
"tag %s has not been declared."
      ,FilePath
"Consider adding a tag directive. Examples:"
      ,FilePath
""
      ,FilePath
"tag %s"
      ])

-- | Tag names which have special significance to hledger, and need not be declared for `hledger check tags`.
-- Keep synced with check-tags.test and hledger manual > Special tags.
builtinTags :: [Text]
builtinTags = [
   Text
"date"                   -- overrides a posting's date
  ,Text
"date2"                  -- overrides a posting's secondary date
  ,Text
"type"                   -- declares an account's type
  ,Text
"t"                      -- appears on postings generated by timedot letters
  ,Text
"assert"                 -- appears on txns generated by close --assert
  ,Text
"retain"                 -- appears on txns generated by close --retain
  ,Text
"start"                  -- appears on txns generated by close --migrate/--close/--open/--assign
  ]
  -- these tags are used in both hidden and visible form
  [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
ts [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
toVisibleTagName [Text]
ts
  where
    ts :: [Text]
ts = [
       Text
generatedTransactionTagName -- marks txns generated by periodic rule
      ,Text
modifiedTransactionTagName  -- marks txns which have had auto postings added
      ,Text
generatedPostingTagName     -- marks postings which have been generated
      ,Text
costPostingTagName          -- marks equity conversion postings which have been matched with a nearby costful posting
      ,Text
conversionPostingTagName    -- marks costful postings which have been matched with a nearby pair of equity conversion postings
      ]

-- | In each tranaction, check that any conversion postings occur in adjacent pairs.
journalCheckPairedConversionPostings :: Journal -> Either String ()
journalCheckPairedConversionPostings :: Journal -> Either FilePath ()
journalCheckPairedConversionPostings Journal
j =
  (Transaction -> Either FilePath ())
-> [Transaction] -> Either FilePath ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Text] -> Transaction -> Either FilePath ()
transactionCheckPairedConversionPostings [Text]
conversionaccts) ([Transaction] -> Either FilePath ())
-> [Transaction] -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
  where conversionaccts :: [Text]
conversionaccts = Journal -> [Text]
journalConversionAccounts Journal
j

transactionCheckPairedConversionPostings :: [AccountName] -> Transaction -> Either String ()
transactionCheckPairedConversionPostings :: [Text] -> Transaction -> Either FilePath ()
transactionCheckPairedConversionPostings [Text]
conversionaccts Transaction
t =
  case Bool
-> [Text]
-> [IdxPosting]
-> Either
     Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
True [Text]
conversionaccts ([Int] -> [Posting] -> [IdxPosting]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([Posting] -> [IdxPosting]) -> [Posting] -> [IdxPosting]
forall a b. (a -> b) -> a -> b
$ Transaction -> [Posting]
tpostings Transaction
t) of
    Left Text
err -> FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ()) -> FilePath -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
err
    Right ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
_  -> () -> Either FilePath ()
forall a b. b -> Either a b
Right ()

----------

-- | The number of days allowed between an account's latest balance assertion 
-- and latest posting (7).
maxlag :: Integer
maxlag = Integer
7

-- | Check that accounts with balance assertions have no posting more
-- than maxlag days after their latest balance assertion.
journalCheckRecentAssertions :: Journal -> Either String ()
journalCheckRecentAssertions :: Journal -> Either FilePath ()
journalCheckRecentAssertions Journal
j =
  let acctps :: [[Posting]]
acctps = (Posting -> Text) -> [Posting] -> [[Posting]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn Posting -> Text
paccount ([Posting] -> [[Posting]]) -> [Posting] -> [[Posting]]
forall a b. (a -> b) -> a -> b
$ (Posting -> Text) -> [Posting] -> [Posting]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Posting -> Text
paccount ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
  in case ([Posting] -> Maybe FilePath) -> [[Posting]] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Posting] -> Maybe FilePath
findRecentAssertionError [[Posting]]
acctps of
    []         -> () -> Either FilePath ()
forall a b. b -> Either a b
Right ()
    FilePath
firsterr:[FilePath]
_ -> FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left FilePath
firsterr

-- | Do the recentassertions check for one account: given a list of postings to the account,
-- if any of them contain a balance assertion, identify the latest balance assertion,
-- and if any postings are >maxlag days later than the assertion,
-- return an error message identifying the first of them.
-- Postings on the same date will be handled in parse order (hopefully).
findRecentAssertionError :: [Posting] -> Maybe String
findRecentAssertionError :: [Posting] -> Maybe FilePath
findRecentAssertionError [Posting]
ps = do
  let rps :: [Posting]
rps = (Posting -> Down Day) -> [Posting] -> [Posting]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Day -> Down Day
forall a. a -> Down a
Data.Ord.Down (Day -> Down Day) -> (Posting -> Day) -> Posting -> Down Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Day
postingDate) [Posting]
ps
  let ([Posting]
afterlatestassertrps, [Posting]
untillatestassertrps) = (Posting -> Bool) -> [Posting] -> ([Posting], [Posting])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Maybe BalanceAssertion -> Bool
forall a. Maybe a -> Bool
isNothing(Maybe BalanceAssertion -> Bool)
-> (Posting -> Maybe BalanceAssertion) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> Maybe BalanceAssertion
pbalanceassertion) [Posting]
rps
  Day
latestassertdate <- Posting -> Day
postingDate (Posting -> Day) -> Maybe Posting -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Posting] -> Maybe Posting
forall a. [a] -> Maybe a
headMay [Posting]
untillatestassertrps
  let withinlimit :: Day -> Bool
withinlimit Day
date = Day -> Day -> Integer
diffDays Day
date Day
latestassertdate Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxlag
  Posting
firsterrorp <- [Posting] -> Maybe Posting
forall a. [a] -> Maybe a
lastMay ([Posting] -> Maybe Posting) -> [Posting] -> Maybe Posting
forall a b. (a -> b) -> a -> b
$ (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Day -> Bool
withinlimit(Day -> Bool) -> (Posting -> Day) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> Day
postingDate) [Posting]
afterlatestassertrps
  let lag :: Integer
lag = Day -> Day -> Integer
diffDays (Posting -> Day
postingDate Posting
firsterrorp) Day
latestassertdate
  let acct :: Text
acct = Posting -> Text
paccount Posting
firsterrorp
  let (FilePath
f,Int
l,Maybe (Int, Maybe Int)
_mcols,Text
ex) = Posting -> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingAccountErrorExcerpt Posting
firsterrorp
  -- let comm =
  --       case map acommodity $ amounts $ pamount firsterrorp of
  --         [] -> ""
  --         (t:_) | T.length t == 1 -> t
  --         (t:_) -> t <> " "
  FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
chomp (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath
-> Int
-> Text
-> Integer
-> FilePath
-> Text
-> Integer
-> Text
-> FilePath
forall r. PrintfType r => FilePath -> r
printf
    ([FilePath] -> FilePath
unlines [
      FilePath
"%s:%d:",
      FilePath
"%s\n",
      -- "The recentassertions check is enabled, so accounts with balance assertions must",
      -- "have a balance assertion within %d days of their latest posting.",
      FilePath
"The recentassertions check is enabled, so accounts with balance assertions",
      FilePath
"must have a recent one, not more than %d days older than their latest posting.",
      FilePath
"In account: %s",
      FilePath
"the last assertion was on %s, %d days before this latest posting.",
      FilePath
"Consider adding a new balance assertion to the above posting. Eg:",
      FilePath
"",
      FilePath
"%s = BALANCE"
      ])
    FilePath
f
    Int
l
    (Text -> Text
textChomp Text
ex)
    Integer
maxlag
    (FilePath -> FilePath
bold' (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
acct)
    (Day -> Text
showDate Day
latestassertdate)
    Integer
lag
    (Posting -> Text
showposting Posting
firsterrorp)
    where
      showposting :: Posting -> Text
showposting Posting
p =
        Text -> [Text] -> Text
forall a. a -> [a] -> a
headDef Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([Text], Int, Int) -> [Text]
forall {a} {b} {c}. (a, b, c) -> a
first3 (([Text], Int, Int) -> [Text]) -> ([Text], Int, Int) -> [Text]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Int -> Int -> Posting -> ([Text], Int, Int)
postingAsLines Bool
False Bool
True Int
acctw Int
amtw Posting
p{pcomment=""}
        where
          acctw :: Int
acctw = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Posting -> Text
paccount Posting
p
          amtw :: Int
amtw  = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int) -> FilePath -> Int
forall a b. (a -> b) -> a -> b
$ AmountFormat -> MixedAmount -> FilePath
showMixedAmountWith AmountFormat
oneLineFmt (MixedAmount -> FilePath) -> MixedAmount -> FilePath
forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
p

-- -- | Print the last balance assertion date & status of all accounts with balance assertions.
-- printAccountLastAssertions :: Day -> [BalanceAssertionInfo] -> IO ()
-- printAccountLastAssertions today acctassertioninfos = do
--   forM_ acctassertioninfos $ \BAI{..} -> do
--     putStr $ printf "%-30s  %s %s, %d days ago\n"
--       baiAccount
--       (if baiLatestClearedAssertionStatus==Unmarked then " " else show baiLatestClearedAssertionStatus)
--       (show baiLatestClearedAssertionDate)
--       (diffDays today baiLatestClearedAssertionDate)