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

import Data.Char (isSpace)
import Data.List (find)
import Data.Maybe
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Safe (atMay)
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)
import Hledger.Data.Types
import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt)
import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart)

-- | 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 = (Posting -> Either String ()) -> [Posting] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Either String ()
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 AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Journal -> [AccountName]
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
$ 
        String
-> String -> Int -> Int -> Int -> AccountName -> AccountName -> a
forall r. PrintfType r => String -> r
printf String
"%s:%d:%d-%d:\n%sundeclared account \"%s\"\n" String
f Int
l Int
col Int
col2 AccountName
ex AccountName
a
        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)
forall p p. Posting -> p -> p -> Maybe (Int, Maybe Int)
finderrcols
          col :: Int
col  = Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst Maybe (Int, Maybe Int)
mcols
          col2 :: Int
col2 = Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd) Maybe (Int, Maybe Int)
mcols
          finderrcols :: Posting -> p -> p -> Maybe (Int, Maybe Int)
finderrcols Posting
p p
_ p
_ = (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 = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Posting -> Bool
isVirtual Posting
p then Int
1 else Int
0
              col2 :: Int
col2 = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ AccountName -> Int
T.length AccountName
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | 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 = (Posting -> Either String ()) -> [Posting] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Posting -> Either String ()
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 -> () -> Either a ()
forall a b. b -> Either a b
Right ()
        Just (AccountName
comm, Bool
_) ->
          a -> Either a ()
forall a b. a -> Either a b
Left (a -> Either a ()) -> a -> Either a ()
forall a b. (a -> b) -> a -> b
$ String
-> String -> Int -> Int -> Int -> AccountName -> AccountName -> a
forall r. PrintfType r => String -> r
printf String
"%s:%d:%d-%d:\n%sundeclared commodity \"%s\"\n" String
f Int
l Int
col Int
col2 AccountName
ex 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
            col :: Int
col  = Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst Maybe (Int, Maybe Int)
mcols
            col2 :: Int
col2 = Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd) Maybe (Int, Maybe Int)
mcols
      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
_) -> (AccountName, Bool) -> Maybe (AccountName, Bool)
forall a. a -> Maybe a
Just (AccountName
c, Bool
True)
            (Maybe AccountName
_, Just AccountName
c) -> (AccountName, Bool) -> Maybe (AccountName, Bool)
forall a. a -> Maybe a
Just (AccountName
c, Bool
False)
            (Maybe AccountName, Maybe AccountName)
_           -> Maybe (AccountName, Bool)
forall a. Maybe a
Nothing
          where
            postingcomms :: [AccountName]
postingcomms = (Amount -> AccountName) -> [Amount] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Amount -> AccountName
acommodity ([Amount] -> [AccountName]) -> [Amount] -> [AccountName]
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
                -- 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 Amount -> Amount -> Bool
forall a. Eq a => a -> a -> Bool
== Amount
missingamt
            assertioncomms :: [AccountName]
assertioncomms = [Amount -> AccountName
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]]
            findundeclared :: [AccountName] -> Maybe AccountName
findundeclared = (AccountName -> Bool) -> [AccountName] -> Maybe AccountName
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (AccountName -> Map AccountName Commodity -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.notMember` Journal -> Map AccountName Commodity
jcommodities Journal
j)

        -- 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 (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 ([AccountName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (AccountName -> [AccountName]
T.lines (AccountName -> [AccountName]) -> AccountName -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Transaction -> AccountName
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 :: AccountName
errline = AccountName -> Maybe AccountName -> AccountName
forall a. a -> Maybe a -> a
fromMaybe AccountName
"" (AccountName -> [AccountName]
T.lines AccountName
txntxt [AccountName] -> Int -> Maybe AccountName
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
+ AccountName -> Int
T.length (Posting -> AccountName
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
+ (AccountName -> Int
T.length (AccountName -> Int) -> AccountName -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> AccountName -> AccountName
T.takeWhile Char -> Bool
isSpace (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ Int -> AccountName -> AccountName
T.drop Int
acctend AccountName
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
+ (AccountName -> Int
T.length (AccountName -> Int) -> AccountName -> Int
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName
T.stripEnd (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> AccountName -> AccountName
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
';') (AccountName -> AccountName) -> AccountName -> AccountName
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 = (Transaction -> Either String ())
-> [Transaction] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Transaction -> Either String ()
forall a. PrintfType a => Transaction -> Either a ()
checkpayee (Journal -> [Transaction]
jtxns Journal
j)
  where
    checkpayee :: Transaction -> Either a ()
checkpayee Transaction
t
      | AccountName
payee AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Journal -> [AccountName]
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
$
        String
-> String -> Int -> Int -> Int -> AccountName -> AccountName -> a
forall r. PrintfType r => String -> r
printf String
"%s:%d:%d-%d:\n%sundeclared payee \"%s\"\n" String
f Int
l Int
col Int
col2 AccountName
ex 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
        col :: Int
col  = Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int, Maybe Int) -> Int
forall a b. (a, b) -> a
fst Maybe (Int, Maybe Int)
mcols
        col2 :: Int
col2 = Int -> ((Int, Maybe Int) -> Int) -> Maybe (Int, Maybe Int) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd) Maybe (Int, Maybe Int)
mcols
        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 = AccountName -> Int
T.length (Transaction -> AccountName
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
+ AccountName -> Int
T.length (Transaction -> AccountName
transactionPayee Transaction
t) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1