{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Data.JournalChecks (
journalCheckAccounts,
journalCheckCommodities,
journalCheckPayees,
journalCheckRecentAssertions,
module Hledger.Data.JournalChecks.Ordereddates,
module Hledger.Data.JournalChecks.Uniqueleafnames,
)
where
import Data.Char (isSpace)
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)
import Hledger.Data.Types
import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt)
import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart)
import Data.Time (Day, diffDays)
import Data.List.Extra
import Hledger.Utils (chomp, textChomp, sourcePosPretty)
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
-> AccountName
-> String
-> AccountName
-> AccountName
-> a
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 (AccountName -> String
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
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
-> AccountName
-> String
-> AccountName
-> AccountName
-> a
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 (AccountName -> String
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
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
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)
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
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)
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 -> AccountName -> String -> AccountName -> a
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 (AccountName -> String
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
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
data BalanceAssertionInfo = BAI {
BalanceAssertionInfo -> AccountName
baiAccount :: AccountName
, BalanceAssertionInfo -> Posting
baiLatestAssertionPosting :: Posting
, BalanceAssertionInfo -> Day
baiLatestAssertionDate :: Day
, BalanceAssertionInfo -> Status
baiLatestAssertionStatus :: Status
, BalanceAssertionInfo -> Day
baiLatestPostingDate :: Day
}
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) -> BalanceAssertionInfo -> Maybe BalanceAssertionInfo
forall a. a -> Maybe a
Just (BalanceAssertionInfo -> Maybe BalanceAssertionInfo)
-> BalanceAssertionInfo -> Maybe BalanceAssertionInfo
forall a b. (a -> b) -> a -> b
$
BAI :: AccountName
-> Posting -> Day -> Status -> Day -> BalanceAssertionInfo
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)
_ -> Maybe BalanceAssertionInfo
forall a. Maybe a
Nothing
where
ps' :: [Posting]
ps' = (Posting -> Day) -> [Posting] -> [Posting]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Posting -> Day
postingDate [Posting]
ps
mlatestp :: Maybe Posting
mlatestp = [Posting] -> Maybe Posting
forall a. [a] -> Maybe a
lastMay [Posting]
ps'
mlatestassertp :: Maybe Posting
mlatestassertp = [Posting] -> Maybe Posting
forall a. [a] -> Maybe a
lastMay [Posting
p | p :: Posting
p@Posting{pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion=Just BalanceAssertion
_} <- [Posting]
ps']
maxlag :: Integer
maxlag = Integer
7
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
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
maxlag =
(BalanceAssertionInfo, String)
-> Either (BalanceAssertionInfo, String) ()
forall a b. a -> Either a b
Left (BalanceAssertionInfo
bai, String -> String -> Integer -> String -> String
forall r. PrintfType r => String -> r
printf (String -> String
chomp (String -> String) -> String -> String
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)."
])
(Day -> String
forall a. Show a => a -> String
show Day
baiLatestAssertionDate) Integer
lag (Day -> String
forall a. Show a => a -> String
show Day
baiLatestPostingDate)
)
| Bool
otherwise = () -> Either (BalanceAssertionInfo, String) ()
forall a b. b -> Either a b
Right ()
where
lag :: Integer
lag = BalanceAssertionInfo -> Integer
baiLag BalanceAssertionInfo
bai
journalCheckRecentAssertions :: Day -> Journal -> Either String ()
journalCheckRecentAssertions :: Day -> Journal -> Either String ()
journalCheckRecentAssertions Day
today Journal
j =
let
acctps :: [[Posting]]
acctps = (Posting -> AccountName) -> [Posting] -> [[Posting]]
forall b a. Eq b => (a -> b) -> [a] -> [[a]]
groupOn Posting -> AccountName
paccount ([Posting] -> [[Posting]]) -> [Posting] -> [[Posting]]
forall a b. (a -> b) -> a -> b
$ (Posting -> AccountName) -> [Posting] -> [Posting]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Posting -> AccountName
paccount ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
acctassertioninfos :: [BalanceAssertionInfo]
acctassertioninfos = ([Posting] -> Maybe BalanceAssertionInfo)
-> [[Posting]] -> [BalanceAssertionInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Posting] -> Maybe BalanceAssertionInfo
balanceAssertionInfo [[Posting]]
acctps
in
case (BalanceAssertionInfo -> Either (BalanceAssertionInfo, String) ())
-> [BalanceAssertionInfo]
-> Either (BalanceAssertionInfo, String) ()
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 () -> () -> Either String ()
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) -> String -> Either String ()
forall a b. a -> Either a b
Left String
errmsg
where
errmsg :: String
errmsg = String -> String
chomp (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
-> String
-> AccountName
-> Integer
-> AccountName
-> String
-> String
-> String
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"
])
(String
-> (BalanceAssertion -> String) -> Maybe BalanceAssertion -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"(no position)"
(SourcePos -> String
sourcePosPretty (SourcePos -> String)
-> (BalanceAssertion -> SourcePos) -> BalanceAssertion -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BalanceAssertion -> SourcePos
baposition) (Maybe BalanceAssertion -> String)
-> Maybe BalanceAssertion -> String
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
"",
String -> String -> AccountName -> String
forall r. PrintfType r => String -> r
printf String
"%s *\n %s $0 = $0 ; <- adjust" (Day -> String
forall a. Show a => a -> String
show Day
today) AccountName
baiAccount
]