{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Hledger.Cli.Commands.Check.Uniqueleafnames (
journalCheckUniqueleafnames
)
where
import Data.Function (on)
import Data.List (groupBy, sortBy)
import Data.Text (Text)
import qualified Data.Text as T
import Hledger
import Text.Printf (printf)
journalCheckUniqueleafnames :: Journal -> Either String ()
journalCheckUniqueleafnames :: Journal -> Either String ()
journalCheckUniqueleafnames Journal
j = do
case [(AccountName, AccountName)] -> [(AccountName, [AccountName])]
forall leaf full.
(Ord leaf, Eq full) =>
[(leaf, full)] -> [(leaf, [full])]
finddupes ([(AccountName, AccountName)] -> [(AccountName, [AccountName])])
-> [(AccountName, AccountName)] -> [(AccountName, [AccountName])]
forall a b. (a -> b) -> a -> b
$ Journal -> [(AccountName, AccountName)]
journalLeafAndFullAccountNames Journal
j of
[] -> () -> Either String ()
forall a b. b -> Either a b
Right ()
[(AccountName, [AccountName])]
dupes ->
(Posting -> Either String ()) -> [Posting] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([(AccountName, [AccountName])] -> Posting -> Either String ()
checkposting [(AccountName, [AccountName])]
dupes) ([Posting] -> Either String ()) -> [Posting] -> Either String ()
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j
finddupes :: (Ord leaf, Eq full) => [(leaf, full)] -> [(leaf, [full])]
finddupes :: forall leaf full.
(Ord leaf, Eq full) =>
[(leaf, full)] -> [(leaf, [full])]
finddupes [(leaf, full)]
leafandfullnames = [leaf] -> [[full]] -> [(leaf, [full])]
forall a b. [a] -> [b] -> [(a, b)]
zip [leaf]
dupLeafs [[full]]
dupAccountNames
where dupLeafs :: [leaf]
dupLeafs = ([(leaf, full)] -> leaf) -> [[(leaf, full)]] -> [leaf]
forall a b. (a -> b) -> [a] -> [b]
map ((leaf, full) -> leaf
forall a b. (a, b) -> a
fst ((leaf, full) -> leaf)
-> ([(leaf, full)] -> (leaf, full)) -> [(leaf, full)] -> leaf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(leaf, full)] -> (leaf, full)
forall a. [a] -> a
head) [[(leaf, full)]]
d
dupAccountNames :: [[full]]
dupAccountNames = ([(leaf, full)] -> [full]) -> [[(leaf, full)]] -> [[full]]
forall a b. (a -> b) -> [a] -> [b]
map (((leaf, full) -> full) -> [(leaf, full)] -> [full]
forall a b. (a -> b) -> [a] -> [b]
map (leaf, full) -> full
forall a b. (a, b) -> b
snd) [[(leaf, full)]]
d
d :: [[(leaf, full)]]
d = [(leaf, full)] -> [[(leaf, full)]]
forall {b}. [(leaf, b)] -> [[(leaf, b)]]
dupes' [(leaf, full)]
leafandfullnames
dupes' :: [(leaf, b)] -> [[(leaf, b)]]
dupes' = ([(leaf, b)] -> Bool) -> [[(leaf, b)]] -> [[(leaf, b)]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ([(leaf, b)] -> Int) -> [(leaf, b)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(leaf, b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
([[(leaf, b)]] -> [[(leaf, b)]])
-> ([(leaf, b)] -> [[(leaf, b)]]) -> [(leaf, b)] -> [[(leaf, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((leaf, b) -> (leaf, b) -> Bool) -> [(leaf, b)] -> [[(leaf, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (leaf -> leaf -> Bool
forall a. Eq a => a -> a -> Bool
(==) (leaf -> leaf -> Bool)
-> ((leaf, b) -> leaf) -> (leaf, b) -> (leaf, b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (leaf, b) -> leaf
forall a b. (a, b) -> a
fst)
([(leaf, b)] -> [[(leaf, b)]])
-> ([(leaf, b)] -> [(leaf, b)]) -> [(leaf, b)] -> [[(leaf, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((leaf, b) -> (leaf, b) -> Ordering) -> [(leaf, b)] -> [(leaf, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (leaf -> leaf -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (leaf -> leaf -> Ordering)
-> ((leaf, b) -> leaf) -> (leaf, b) -> (leaf, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (leaf, b) -> leaf
forall a b. (a, b) -> a
fst)
journalLeafAndFullAccountNames :: Journal -> [(Text, AccountName)]
journalLeafAndFullAccountNames :: Journal -> [(AccountName, AccountName)]
journalLeafAndFullAccountNames = (AccountName -> (AccountName, AccountName))
-> [AccountName] -> [(AccountName, AccountName)]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> (AccountName, AccountName)
leafAndAccountName ([AccountName] -> [(AccountName, AccountName)])
-> (Journal -> [AccountName])
-> Journal
-> [(AccountName, AccountName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [AccountName]
journalAccountNamesUsed
where leafAndAccountName :: AccountName -> (AccountName, AccountName)
leafAndAccountName AccountName
a = (AccountName -> AccountName
accountLeafName AccountName
a, AccountName
a)
checkposting :: [(Text,[AccountName])] -> Posting -> Either String ()
checkposting :: [(AccountName, [AccountName])] -> Posting -> Either String ()
checkposting [(AccountName, [AccountName])]
leafandfullnames Posting{AccountName
paccount :: Posting -> AccountName
paccount :: AccountName
paccount,Maybe Transaction
ptransaction :: Posting -> Maybe Transaction
ptransaction :: Maybe Transaction
ptransaction} =
case [(AccountName, [AccountName])
lf | lf :: (AccountName, [AccountName])
lf@(AccountName
_,[AccountName]
fs) <- [(AccountName, [AccountName])]
leafandfullnames, AccountName
paccount AccountName -> [AccountName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [AccountName]
fs] of
[] -> () -> Either String ()
forall a b. b -> Either a b
Right ()
(AccountName
leaf,[AccountName]
fulls):[(AccountName, [AccountName])]
_ -> String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> AccountName -> AccountName -> String -> String
forall r. PrintfType r => String -> r
printf
String
"account leaf names are not unique\nleaf name \"%s\" appears in account names: %s%s"
AccountName
leaf
(AccountName -> [AccountName] -> AccountName
T.intercalate AccountName
", " ([AccountName] -> AccountName) -> [AccountName] -> AccountName
forall a b. (a -> b) -> a -> b
$ (AccountName -> AccountName) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map ((AccountName
"\""AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<>)(AccountName -> AccountName)
-> (AccountName -> AccountName) -> AccountName -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<>AccountName
"\"")) [AccountName]
fulls)
(case Maybe Transaction
ptransaction of
Maybe Transaction
Nothing -> String
""
Just Transaction
t -> String -> AccountName -> String -> AccountName -> String
forall r. PrintfType r => String -> r
printf String
"\nseen in \"%s\" in transaction at: %s\n\n%s"
AccountName
paccount
((SourcePos, SourcePos) -> String
showSourcePosPair ((SourcePos, SourcePos) -> String)
-> (SourcePos, SourcePos) -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t)
(AccountName -> AccountName -> AccountName
linesPrepend AccountName
"> " (AccountName -> AccountName)
-> (AccountName -> AccountName) -> AccountName -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<>AccountName
"\n") (AccountName -> AccountName)
-> (AccountName -> AccountName) -> AccountName -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> AccountName
textChomp (AccountName -> AccountName) -> AccountName -> AccountName
forall a b. (a -> b) -> a -> b
$ Transaction -> AccountName
showTransaction Transaction
t) :: String)