{-|
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 #-}
{-# LANGUAGE RecordWildCards #-}

module Hledger.Data.JournalChecks (
  journalCheckAccounts,
  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)
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, postingStatus, transactionAllTags)
import Hledger.Data.Types
import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt)
import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart, partitionAndCheckConversionPostings)
import Data.Time (Day, diffDays)
import Hledger.Utils

-- | 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 String ()
journalCheckAccounts Journal
j = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ 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 -> AccountName
paccount=AccountName
a}
      | AccountName
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Journal -> [AccountName]
journalAccountNamesDeclared Journal
j = forall a b. b -> Either a b
Right ()
      | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf ([String] -> String
unlines [
           String
"%s:%d:"
          ,String
"%s"
          ,String
"Strict account checking is enabled, and"
          ,String
"account %s has not been declared."
          ,String
"Consider adding an account directive. Examples:"
          ,String
""
          ,String
"account %s"
          ,String
"account %s    ; type:A  ; (L,E,R,X,C,V)"
          ]) String
f Int
l AccountName
ex (forall a. Show a => a -> String
show AccountName
a) AccountName
a AccountName
a
        where
          (String
f,Int
l,Maybe (Int, Maybe Int)
_mcols,AccountName
ex) = Posting -> (String, Int, Maybe (Int, Maybe Int), AccountName)
makePostingAccountErrorExcerpt Posting
p

-- | Check that all the commodities used in this journal's postings have been declared
-- by commodity directives, returning an error message otherwise.
journalCheckCommodities :: Journal -> Either String ()
journalCheckCommodities :: Journal -> Either String ()
journalCheckCommodities Journal
j = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}. PrintfType a => Posting -> Either a ()
checkcommodities (Journal -> [Posting]
journalPostings Journal
j)
  where
    checkcommodities :: Posting -> Either a ()
checkcommodities Posting
p =
      case Posting -> Maybe (AccountName, Bool)
findundeclaredcomm Posting
p of
        Maybe (AccountName, Bool)
Nothing -> forall a b. b -> Either a b
Right ()
        Just (AccountName
comm, Bool
_) ->
          forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf ([String] -> String
unlines [
           String
"%s:%d:"
          ,String
"%s"
          ,String
"Strict commodity checking is enabled, and"
          ,String
"commodity %s has not been declared."
          ,String
"Consider adding a commodity directive. Examples:"
          ,String
""
          ,String
"commodity %s1000.00"
          ,String
"commodity 1.000,00 %s"
          ]) String
f Int
l AccountName
ex (forall a. Show a => a -> String
show AccountName
comm) AccountName
comm AccountName
comm
          where
            (String
f,Int
l,Maybe (Int, Maybe Int)
_mcols,AccountName
ex) = Posting
-> (Posting
    -> Transaction -> AccountName -> Maybe (Int, Maybe Int))
-> (String, Int, Maybe (Int, Maybe Int), AccountName)
makePostingErrorExcerpt Posting
p Posting -> Transaction -> AccountName -> Maybe (Int, Maybe Int)
finderrcols
      where
        -- Find the first undeclared commodity symbol in this posting's amount
        -- or balance assertion amount, if any. The boolean will be true if
        -- the undeclared symbol was in the posting amount.
        findundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)
        findundeclaredcomm :: Posting -> Maybe (AccountName, Bool)
findundeclaredcomm Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt,Maybe BalanceAssertion
pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion} =
          case ([AccountName] -> Maybe AccountName
findundeclared [AccountName]
postingcomms, [AccountName] -> Maybe AccountName
findundeclared [AccountName]
assertioncomms) of
            (Just AccountName
c, Maybe AccountName
_) -> forall a. a -> Maybe a
Just (AccountName
c, Bool
True)
            (Maybe AccountName
_, Just AccountName
c) -> forall a. a -> Maybe a
Just (AccountName
c, Bool
False)
            (Maybe AccountName, Maybe AccountName)
_           -> forall a. Maybe a
Nothing
          where
            postingcomms :: [AccountName]
postingcomms = forall a b. (a -> b) -> [a] -> [b]
map Amount -> AccountName
acommodity forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Bool
isIgnorable) forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amountsRaw MixedAmount
amt
              where
                -- Ignore missing amounts and zero amounts without commodity (#1767)
                isIgnorable :: Amount -> Bool
isIgnorable Amount
a = (AccountName -> Bool
T.null (Amount -> AccountName
acommodity Amount
a) Bool -> Bool -> Bool
&& Amount -> Bool
amountIsZero Amount
a) Bool -> Bool -> Bool
|| Amount
a forall a. Eq a => a -> a -> Bool
== Amount
missingamt
            assertioncomms :: [AccountName]
assertioncomms = [Amount -> AccountName
acommodity Amount
a | Just Amount
a <- [BalanceAssertion -> Amount
baamount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe BalanceAssertion
pbalanceassertion]]
            findundeclared :: [AccountName] -> Maybe AccountName
findundeclared = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Journal -> Map AccountName Commodity
jcommodities Journal
j)

        -- 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 -> AccountName -> Maybe (Int, Maybe Int)
finderrcols Posting
p' Transaction
t AccountName
txntxt =
          case (Posting -> Bool) -> Transaction -> Maybe Int
transactionFindPostingIndex (forall a. Eq a => a -> a -> Bool
==Posting
p') Transaction
t of
            Maybe Int
Nothing     -> forall a. Maybe a
Nothing
            Just Int
pindex -> forall a. a -> Maybe a
Just (Int
amtstart, forall a. a -> Maybe a
Just Int
amtend)
              where
                tcommentlines :: Int
tcommentlines = forall a. Ord a => a -> a -> a
max Int
0 (forall (t :: * -> *) a. Foldable t => t a -> Int
length (AccountName -> [AccountName]
T.lines forall a b. (a -> b) -> a -> b
$ Transaction -> AccountName
tcomment Transaction
t) forall a. Num a => a -> a -> a
- Int
1)
                errrelline :: Int
errrelline = Int
1 forall a. Num a => a -> a -> a
+ Int
tcommentlines forall a. Num a => a -> a -> a
+ Int
pindex   -- XXX doesn't count posting coment lines
                errline :: AccountName
errline = forall a. a -> Maybe a -> a
fromMaybe AccountName
"" (AccountName -> [AccountName]
T.lines AccountName
txntxt forall a. [a] -> Int -> Maybe a
`atMay` (Int
errrellineforall a. Num a => a -> a -> a
-Int
1))
                acctend :: Int
acctend = Int
4 forall a. Num a => a -> a -> a
+ AccountName -> Int
T.length (Posting -> AccountName
paccount Posting
p') forall a. Num a => a -> a -> a
+ if Posting -> Bool
isVirtual Posting
p' then Int
2 else Int
0
                amtstart :: Int
amtstart = Int
acctend forall a. Num a => a -> a -> a
+ (AccountName -> Int
T.length forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> AccountName -> AccountName
T.takeWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ Int -> AccountName -> AccountName
T.drop Int
acctend AccountName
errline) forall a. Num a => a -> a -> a
+ Int
1
                amtend :: Int
amtend = Int
amtstart forall a. Num a => a -> a -> a
+ (AccountName -> Int
T.length forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName
T.stripEnd forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> AccountName -> AccountName
T.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
';') forall a b. (a -> b) -> a -> b
$ Int -> AccountName -> AccountName
T.drop Int
amtstart AccountName
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 String ()
journalCheckPayees Journal
j = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}. PrintfType a => Transaction -> Either a ()
checkpayee (Journal -> [Transaction]
jtxns Journal
j)
  where
    checkpayee :: Transaction -> Either a ()
checkpayee Transaction
t
      | AccountName
payee forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Journal -> [AccountName]
journalPayeesDeclared Journal
j = forall a b. b -> Either a b
Right ()
      | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
        forall r. PrintfType r => String -> r
printf ([String] -> String
unlines [
           String
"%s:%d:"
          ,String
"%s"
          ,String
"Strict payee checking is enabled, and"
          ,String
"payee %s has not been declared."
          ,String
"Consider adding a payee directive. Examples:"
          ,String
""
          ,String
"payee %s"
          ]) String
f Int
l AccountName
ex (forall a. Show a => a -> String
show AccountName
payee) AccountName
payee
      where
        payee :: AccountName
payee = Transaction -> AccountName
transactionPayee Transaction
t
        (String
f,Int
l,Maybe (Int, Maybe Int)
_mcols,AccountName
ex) = Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (String, Int, Maybe (Int, Maybe Int), AccountName)
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' = forall a. a -> Maybe a
Just (Int
col, forall a. a -> Maybe a
Just Int
col2)
          where
            col :: Int
col  = AccountName -> Int
T.length (Transaction -> AccountName
showTransactionLineFirstPart Transaction
t') forall a. Num a => a -> a -> a
+ Int
2
            col2 :: Int
col2 = Int
col forall a. Num a => a -> a -> a
+ AccountName -> Int
T.length (Transaction -> AccountName
transactionPayee Transaction
t') 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 String ()
journalCheckTags Journal
j = do
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}.
PrintfType a =>
(AccountName, AccountDeclarationInfo) -> Either a ()
checkaccttags forall a b. (a -> b) -> a -> b
$ Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}. PrintfType a => Transaction -> Either a ()
checktxntags  forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
  where
    checkaccttags :: (AccountName, AccountDeclarationInfo) -> Either a ()
checkaccttags (AccountName
a, AccountDeclarationInfo
adi) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {a}. PrintfType a => AccountName -> Either a ()
checkaccttagforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ AccountDeclarationInfo -> [Tag]
aditags AccountDeclarationInfo
adi
      where
        checkaccttag :: AccountName -> Either a ()
checkaccttag AccountName
tagname
          | AccountName
tagname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AccountName]
declaredtags = forall a b. b -> Either a b
Right ()
          | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
msg String
f Int
l AccountName
ex (forall a. Show a => a -> String
show AccountName
tagname) AccountName
tagname
            where (String
f,Int
l,Maybe (Int, Maybe Int)
_mcols,AccountName
ex) = (AccountName, AccountDeclarationInfo)
-> AccountName
-> (String, Int, Maybe (Int, Maybe Int), AccountName)
makeAccountTagErrorExcerpt (AccountName
a, AccountDeclarationInfo
adi) AccountName
tagname
    checktxntags :: Transaction -> Either a ()
checktxntags Transaction
txn = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {a}. PrintfType a => AccountName -> Either a ()
checktxntag forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ Transaction -> [Tag]
transactionAllTags Transaction
txn
      where
        checktxntag :: AccountName -> Either a ()
checktxntag AccountName
tagname
          | AccountName
tagname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AccountName]
declaredtags = forall a b. b -> Either a b
Right ()
          | Bool
otherwise = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
msg String
f Int
l AccountName
ex (forall a. Show a => a -> String
show AccountName
tagname) AccountName
tagname
            where
              (String
f,Int
l,Maybe (Int, Maybe Int)
_mcols,AccountName
ex) = Transaction
-> (Transaction -> Maybe (Int, Maybe Int))
-> (String, Int, Maybe (Int, Maybe Int), AccountName)
makeTransactionErrorExcerpt Transaction
txn forall {p} {a}. p -> Maybe a
finderrcols
                where
                  finderrcols :: p -> Maybe a
finderrcols p
_txn' = 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 :: [AccountName]
declaredtags = Journal -> [AccountName]
journalTagsDeclared Journal
j
    msg :: String
msg = ([String] -> String
unlines [
      String
"%s:%d:"
      ,String
"%s"
      ,String
"Strict tag checking is enabled, and"
      ,String
"tag %s has not been declared."
      ,String
"Consider adding a tag directive. Examples:"
      ,String
""
      ,String
"tag %s"
      ])

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

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

----------

-- | Information useful for checking the age and lag of an account's latest balance assertion.
data BalanceAssertionInfo = BAI {
    BalanceAssertionInfo -> AccountName
baiAccount                :: AccountName -- ^ the account
  , BalanceAssertionInfo -> Posting
baiLatestAssertionPosting :: Posting     -- ^ the account's latest posting with a balance assertion
  , BalanceAssertionInfo -> Day
baiLatestAssertionDate    :: Day         -- ^ the posting date
  , BalanceAssertionInfo -> Status
baiLatestAssertionStatus  :: Status      -- ^ the posting status
  , BalanceAssertionInfo -> Day
baiLatestPostingDate      :: Day         -- ^ the date of this account's latest posting with or without a balance assertion
}

-- | Given a list of postings to the same account,
-- if any of them contain a balance assertion,
-- calculate the last asserted and posted dates.
balanceAssertionInfo :: [Posting] -> Maybe BalanceAssertionInfo
balanceAssertionInfo :: [Posting] -> Maybe BalanceAssertionInfo
balanceAssertionInfo [Posting]
ps =
  case (Maybe Posting
mlatestp, Maybe Posting
mlatestassertp) of
    (Just Posting
latestp, Just Posting
latestassertp) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
      BAI{baiAccount :: AccountName
baiAccount                 = Posting -> AccountName
paccount Posting
latestassertp
          ,baiLatestAssertionDate :: Day
baiLatestAssertionDate    = Posting -> Day
postingDate Posting
latestassertp
          ,baiLatestAssertionPosting :: Posting
baiLatestAssertionPosting = Posting
latestassertp
          ,baiLatestAssertionStatus :: Status
baiLatestAssertionStatus  = Posting -> Status
postingStatus Posting
latestassertp
          ,baiLatestPostingDate :: Day
baiLatestPostingDate      = Posting -> Day
postingDate Posting
latestp
          }
    (Maybe Posting, Maybe Posting)
_ -> forall a. Maybe a
Nothing
  where
    ps' :: [Posting]
ps' = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Posting -> Day
postingDate [Posting]
ps
    mlatestp :: Maybe Posting
mlatestp = forall a. [a] -> Maybe a
lastMay [Posting]
ps'
    mlatestassertp :: Maybe Posting
mlatestassertp = forall a. [a] -> Maybe a
lastMay [Posting
p | p :: Posting
p@Posting{pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Just BalanceAssertion
_} <- [Posting]
ps']

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

-- | The number of days between this balance assertion and the latest posting in its account.
baiLag :: BalanceAssertionInfo -> Integer
baiLag BAI{AccountName
Day
Posting
Status
baiLatestPostingDate :: Day
baiLatestAssertionStatus :: Status
baiLatestAssertionDate :: Day
baiLatestAssertionPosting :: Posting
baiAccount :: AccountName
baiLatestPostingDate :: BalanceAssertionInfo -> Day
baiLatestAssertionStatus :: BalanceAssertionInfo -> Status
baiLatestAssertionDate :: BalanceAssertionInfo -> Day
baiLatestAssertionPosting :: BalanceAssertionInfo -> Posting
baiAccount :: BalanceAssertionInfo -> AccountName
..} = Day -> Day -> Integer
diffDays Day
baiLatestPostingDate Day
baiLatestAssertionDate

-- -- | The earliest balance assertion date which would satisfy the recentassertions check.
-- baiLagOkDate :: BalanceAssertionInfo -> Day
-- baiLagOkDate BAI{..} = addDays (-7) baiLatestPostingDate

-- | Check that this latest assertion is close enough to the account's latest posting.
checkRecentAssertion :: BalanceAssertionInfo -> Either (BalanceAssertionInfo, String) ()
checkRecentAssertion :: BalanceAssertionInfo -> Either (BalanceAssertionInfo, String) ()
checkRecentAssertion bai :: BalanceAssertionInfo
bai@BAI{AccountName
Day
Posting
Status
baiLatestPostingDate :: Day
baiLatestAssertionStatus :: Status
baiLatestAssertionDate :: Day
baiLatestAssertionPosting :: Posting
baiAccount :: AccountName
baiLatestPostingDate :: BalanceAssertionInfo -> Day
baiLatestAssertionStatus :: BalanceAssertionInfo -> Status
baiLatestAssertionDate :: BalanceAssertionInfo -> Day
baiLatestAssertionPosting :: BalanceAssertionInfo -> Posting
baiAccount :: BalanceAssertionInfo -> AccountName
..}
  | Integer
lag forall a. Ord a => a -> a -> Bool
> Integer
maxlag =
    forall a b. a -> Either a b
Left (BalanceAssertionInfo
bai, forall r. PrintfType r => String -> r
printf (String -> String
chomp forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [
       String
"the last balance assertion (%s) was %d days before"
      ,String
"the latest posting (%s)."
      ])
      (forall a. Show a => a -> String
show Day
baiLatestAssertionDate) Integer
lag (forall a. Show a => a -> String
show Day
baiLatestPostingDate)
      )
  | Bool
otherwise = forall a b. b -> Either a b
Right ()
  where 
    lag :: Integer
lag = BalanceAssertionInfo -> Integer
baiLag BalanceAssertionInfo
bai

-- | Check that all the journal's accounts with balance assertions have
-- an assertion no more than 7 days before their latest posting.
-- Today's date is provided for error messages.
journalCheckRecentAssertions :: Day -> Journal -> Either String ()
journalCheckRecentAssertions :: Day -> Journal -> Either String ()
journalCheckRecentAssertions Day
today Journal
j =
  let
    acctps :: [[Posting]]
acctps = forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn Posting -> AccountName
paccount forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Posting -> AccountName
paccount forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
    acctassertioninfos :: [BalanceAssertionInfo]
acctassertioninfos = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Posting] -> Maybe BalanceAssertionInfo
balanceAssertionInfo [[Posting]]
acctps
  in
    case forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BalanceAssertionInfo -> Either (BalanceAssertionInfo, String) ()
checkRecentAssertion [BalanceAssertionInfo]
acctassertioninfos of
      Right () -> forall a b. b -> Either a b
Right ()
      Left (BAI{AccountName
Day
Posting
Status
baiLatestPostingDate :: Day
baiLatestAssertionStatus :: Status
baiLatestAssertionDate :: Day
baiLatestAssertionPosting :: Posting
baiAccount :: AccountName
baiLatestPostingDate :: BalanceAssertionInfo -> Day
baiLatestAssertionStatus :: BalanceAssertionInfo -> Status
baiLatestAssertionDate :: BalanceAssertionInfo -> Day
baiLatestAssertionPosting :: BalanceAssertionInfo -> Posting
baiAccount :: BalanceAssertionInfo -> AccountName
..}, String
msg) -> forall a b. a -> Either a b
Left String
errmsg
        where
          errmsg :: String
errmsg = String -> String
chomp forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf 
            ([String] -> String
unlines [
              String
"%s:",
              String
"%s\n",
              String
"The recentassertions check is enabled, so accounts with balance assertions must",
              String
"have a balance assertion no more than %d days before their latest posting date.",
              String
"In account %s,",
              String
"%s",
              String
"",
              String
"%s"
              ])
            (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"(no position)"  -- shouldn't happen
              (SourcePos -> String
sourcePosPretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalanceAssertion -> SourcePos
baposition) forall a b. (a -> b) -> a -> b
$ Posting -> Maybe BalanceAssertion
pbalanceassertion Posting
baiLatestAssertionPosting)
            (AccountName -> AccountName
textChomp AccountName
excerpt)
            Integer
maxlag
            AccountName
baiAccount
            String
msg
            String
recommendation
            where
              (String
_,Int
_,Maybe (Int, Maybe Int)
_,AccountName
excerpt) = Posting -> (String, Int, Maybe (Int, Maybe Int), AccountName)
makeBalanceAssertionErrorExcerpt Posting
baiLatestAssertionPosting
              recommendation :: String
recommendation = [String] -> String
unlines [
                String
"Consider adding a more recent balance assertion for this account. Eg:",
                String
"",
                forall r. PrintfType r => String -> r
printf String
"%s *\n    %s    $0 = $0  ; <- adjust" (forall a. Show a => a -> String
show Day
today) AccountName
baiAccount
                ]

-- -- | 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)