{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
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, 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)
import Hledger.Data.Types
import Hledger.Data.Amount (amountIsZero, amountsRaw, missingamt, amounts)
import Hledger.Data.Transaction (transactionPayee, showTransactionLineFirstPart, partitionAndCheckConversionPostings)
import Data.Time (Day, diffDays)
import Hledger.Utils
import Data.Ord
import Hledger.Data.Dates (showDate)
journalCheckAccounts :: Journal -> Either String ()
journalCheckAccounts :: Journal -> Either FilePath ()
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 -> Text
paccount=Text
a}
| Text
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Journal -> [Text]
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 => 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
"account %s ; type:A ; (L,E,R,X,C,V)"
]) FilePath
f Int
l Text
ex (forall a. Show a => a -> FilePath
show Text
a) 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
journalCheckCommodities :: Journal -> Either String ()
journalCheckCommodities :: Journal -> Either FilePath ()
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 (Text, Bool)
findundeclaredcomm Posting
p of
Maybe (Text, Bool)
Nothing -> forall a b. b -> Either a b
Right ()
Just (Text
comm, Bool
_) ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => FilePath -> r
printf ([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"
]) FilePath
f Int
l Text
ex (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
findundeclaredcomm :: Posting -> Maybe (CommoditySymbol, Bool)
findundeclaredcomm :: Posting -> Maybe (Text, Bool)
findundeclaredcomm Posting{pamount :: Posting -> MixedAmount
pamount=MixedAmount
amt,Maybe BalanceAssertion
pbalanceassertion :: Posting -> Maybe BalanceAssertion
pbalanceassertion :: Maybe BalanceAssertion
pbalanceassertion} =
case ([Text] -> Maybe Text
findundeclared [Text]
postingcomms, [Text] -> Maybe Text
findundeclared [Text]
assertioncomms) of
(Just Text
c, Maybe Text
_) -> forall a. a -> Maybe a
Just (Text
c, Bool
True)
(Maybe Text
_, Just Text
c) -> forall a. a -> Maybe a
Just (Text
c, Bool
False)
(Maybe Text, Maybe Text)
_ -> forall a. Maybe a
Nothing
where
postingcomms :: [Text]
postingcomms = forall a b. (a -> b) -> [a] -> [b]
map Amount -> Text
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
isIgnorable :: Amount -> Bool
isIgnorable Amount
a = (Text -> Bool
T.null (Amount -> Text
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 :: [Text]
assertioncomms = [Amount -> Text
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 :: [Text] -> Maybe Text
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 Text Commodity
jcommodities Journal
j)
finderrcols :: Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
finderrcols Posting
p' Transaction
t Text
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 (Text -> [Text]
T.lines forall a b. (a -> b) -> a -> b
$ Transaction -> Text
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
errline :: Text
errline = forall a. a -> Maybe a -> a
fromMaybe Text
"" (Text -> [Text]
T.lines Text
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
+ Text -> Int
T.length (Posting -> Text
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
+ (Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
acctend Text
errline) forall a. Num a => a -> a -> a
+ Int
1
amtend :: Int
amtend = Int
amtstart forall a. Num a => a -> a -> a
+ (Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ Text -> Text
T.stripEnd forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
';') forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
amtstart Text
errline)
journalCheckPayees :: Journal -> Either String ()
journalCheckPayees :: Journal -> Either FilePath ()
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
| Text
payee forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Journal -> [Text]
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 => 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 (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
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 = Text -> Int
T.length (Transaction -> Text
showTransactionLineFirstPart Transaction
t') forall a. Num a => a -> a -> a
+ Int
2
col2 :: Int
col2 = Int
col forall a. Num a => a -> a -> a
+ Text -> Int
T.length (Transaction -> Text
transactionPayee Transaction
t') forall a. Num a => a -> a -> a
- Int
1
journalCheckTags :: Journal -> Either String ()
journalCheckTags :: Journal -> Either FilePath ()
journalCheckTags Journal
j = do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a}.
PrintfType a =>
(Text, AccountDeclarationInfo) -> Either a ()
checkaccttags forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, 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 :: (Text, AccountDeclarationInfo) -> Either a ()
checkaccttags (Text
a, AccountDeclarationInfo
adi) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {a}. PrintfType a => Text -> 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 :: Text -> Either a ()
checkaccttag Text
tagname
| Text
tagname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
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 => FilePath -> r
printf FilePath
msg FilePath
f Int
l Text
ex (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 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {a}. PrintfType a => Text -> 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 :: Text -> Either a ()
checktxntag Text
tagname
| Text
tagname forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
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 => FilePath -> r
printf FilePath
msg FilePath
f Int
l Text
ex (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 forall {p} {a}. p -> Maybe a
finderrcols
where
finderrcols :: p -> Maybe a
finderrcols p
_txn' = forall a. Maybe a
Nothing
declaredtags :: [Text]
declaredtags = Journal -> [Text]
journalTagsDeclared Journal
j
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"
])
journalCheckPairedConversionPostings :: Journal -> Either String ()
journalCheckPairedConversionPostings :: Journal -> Either FilePath ()
journalCheckPairedConversionPostings Journal
j =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Map Text AccountType -> Transaction -> Either FilePath ()
transactionCheckPairedConversionPostings (Journal -> Map Text 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 Text AccountType -> Transaction -> Either FilePath ()
transactionCheckPairedConversionPostings Map Text AccountType
accttypes Transaction
t =
case Bool
-> Map Text AccountType
-> [IdxPosting]
-> Either
Text ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
partitionAndCheckConversionPostings Bool
True Map Text 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 Text
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
err
Right ([(IdxPosting, IdxPosting)], ([IdxPosting], [IdxPosting]))
_ -> forall a b. b -> Either a b
Right ()
maxlag :: Integer
maxlag = Integer
7
journalCheckRecentAssertions :: Day -> Journal -> Either String ()
journalCheckRecentAssertions :: Day -> Journal -> Either FilePath ()
journalCheckRecentAssertions Day
today Journal
j =
let acctps :: [[Posting]]
acctps = forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn Posting -> Text
paccount forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Posting -> Text
paccount forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
in case forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Day -> [Posting] -> Maybe FilePath
findRecentAssertionError Day
today) [[Posting]]
acctps of
[] -> forall a b. b -> Either a b
Right ()
FilePath
firsterr:[FilePath]
_ -> forall a b. a -> Either a b
Left FilePath
firsterr
findRecentAssertionError :: Day -> [Posting] -> Maybe String
findRecentAssertionError :: Day -> [Posting] -> Maybe FilePath
findRecentAssertionError Day
today [Posting]
ps = do
let rps :: [Posting]
rps = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a. a -> Down a
Data.Ord.Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Day
postingDate) [Posting]
ps
let ([Posting]
afterlatestassertrps, [Posting]
untillatestassertrps) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Maybe a -> Bool
isNothingforall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> Maybe BalanceAssertion
pbalanceassertion) [Posting]
rps
Day
latestassertdate <- Posting -> Day
postingDate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe a
headMay [Posting]
untillatestassertrps
let withinlimit :: Day -> Bool
withinlimit Day
date = Day -> Day -> Integer
diffDays Day
date Day
latestassertdate forall a. Ord a => a -> a -> Bool
<= Integer
maxlag
Posting
firsterrorp <- forall a. [a] -> Maybe a
lastMay forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Day -> Bool
withinlimitforall 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 :: Text
comm =
case forall a b. (a -> b) -> [a] -> [b]
map Amount -> Text
acommodity forall a b. (a -> b) -> a -> b
$ MixedAmount -> [Amount]
amounts forall a b. (a -> b) -> a -> b
$ Posting -> MixedAmount
pamount Posting
firsterrorp of
[] -> Text
""
(Text
t:[Text]
_) | Text -> Int
T.length Text
t forall a. Eq a => a -> a -> Bool
== Int
1 -> Text
t
(Text
t:[Text]
_) -> Text
t forall a. Semigroup a => a -> a -> a
<> Text
" "
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
chomp forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => FilePath -> r
printf
([FilePath] -> FilePath
unlines [
FilePath
"%s:%d:",
FilePath
"%s\n",
FilePath
"The recentassertions check is enabled, so accounts with balance assertions must",
FilePath
"have a balance assertion within %d days of their latest posting.",
FilePath
"In account \"%s\", this posting is %d days later",
FilePath
"than the last balance assertion, which was on %s.",
FilePath
"",
FilePath
"Consider adding a more recent balance assertion for this account. Eg:",
FilePath
"",
FilePath
"%s\n %s %s0 = %s0 ; (adjust asserted amount)"
])
FilePath
f
Int
l
(Text -> Text
textChomp Text
ex)
Integer
maxlag
Text
acct
Integer
lag
(Day -> Text
showDate Day
latestassertdate)
(forall a. Show a => a -> FilePath
show Day
today)
Text
acct
Text
comm
Text
comm