{-# LANGUAGE OverloadedStrings #-}

module Hledger.Data.JournalChecks.Uniqueleafnames (
  journalCheckUniqueleafnames
)
where

import Data.Function (on)
import Data.List (groupBy, sortBy)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Printf (printf)

import Hledger.Data.AccountName (accountLeafName)
import Hledger.Data.Errors (makePostingErrorExcerpt)
import Hledger.Data.Journal (journalPostings, journalAccountNamesUsed)
import Hledger.Data.Posting (isVirtual)
import Hledger.Data.Types
import Hledger.Utils (chomp, textChomp)

-- | Check that all the journal's postings are to accounts with a unique leaf name.
-- Otherwise, return an error message for the first offending posting.
journalCheckUniqueleafnames :: Journal -> Either String ()
journalCheckUniqueleafnames :: Journal -> Either FilePath ()
journalCheckUniqueleafnames Journal
j = do
  -- find all duplicate leafnames, and the full account names they appear in
  case [(Text, Text)] -> [(Text, [Text])]
forall leaf full.
(Ord leaf, Eq full) =>
[(leaf, full)] -> [(leaf, [full])]
finddupes ([(Text, Text)] -> [(Text, [Text])])
-> [(Text, Text)] -> [(Text, [Text])]
forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, Text)]
journalLeafAndFullAccountNames Journal
j of
    [] -> () -> Either FilePath ()
forall a b. b -> Either a b
Right ()
    -- pick the first duplicated leafname and show the transactions of
    -- the first two postings using it, highlighting the second as the error.
    (Text
leaf,[Text]
fulls):[(Text, [Text])]
_ ->
      case (Posting -> Bool) -> [Posting] -> [Posting]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
fulls)(Text -> Bool) -> (Posting -> Text) -> Posting -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> Text
paccount) ([Posting] -> [Posting]) -> [Posting] -> [Posting]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j of
        ps :: [Posting]
ps@(Posting
p:Posting
p2:[Posting]
_) -> FilePath -> Either FilePath ()
forall a b. a -> Either a b
Left (FilePath -> Either FilePath ()) -> FilePath -> Either FilePath ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
chomp (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
-> FilePath -> Int -> Text -> FilePath -> Int -> Text -> FilePath
forall r. PrintfType r => FilePath -> r
printf
          (FilePath
"%s:%d:\n%s\nChecking for unique account leaf names is enabled, and\n"
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"account leaf name %s is not unique.\n"
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"It appears in these account names, which are used in %d places:\n%s"
          FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"\nConsider changing these account names so their last parts are different."
          )
          FilePath
f Int
l Text
ex (Text -> FilePath
forall a. Show a => a -> FilePath
show Text
leaf) ([Posting] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Posting]
ps) Text
accts
          where
            -- t = fromMaybe nulltransaction ptransaction  -- XXX sloppy
            (FilePath
_,Int
_,Maybe (Int, Maybe Int)
_,Text
ex1) = 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)
forall a. Maybe a
Nothing)
            (FilePath
f,Int
l,Maybe (Int, Maybe Int)
_,Text
ex2) = Posting
-> (Posting -> Transaction -> Text -> Maybe (Int, Maybe Int))
-> (FilePath, Int, Maybe (Int, Maybe Int), Text)
makePostingErrorExcerpt Posting
p2 Posting -> Transaction -> Text -> Maybe (Int, Maybe Int)
forall {p} {p}. Posting -> p -> p -> Maybe (Int, Maybe Int)
finderrcols
            -- separate the two excerpts by a space-beginning line to help flycheck-hledger parse them
            ex :: Text
ex = [Text] -> Text
T.unlines [Text -> Text
textChomp Text
ex1, FilePath -> Text
T.pack FilePath
" ...", Text -> Text
textChomp Text
ex2]
            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
                a :: Text
a = Posting -> Text
paccount Posting
p'
                alen :: Int
alen = Text -> Int
T.length Text
a
                llen :: Int
llen = Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ Text -> Text
accountLeafName Text
a
                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) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
llen
                col2 :: Int
col2 = Int
col Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
llen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            accts :: Text
accts = [Text] -> Text
T.unlines [Text]
fulls

        [Posting]
_ -> () -> Either FilePath ()
forall a b. b -> Either a b
Right ()  -- shouldn't happen

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. HasCallStack => [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 a. [a] -> 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 -> [(Text, Text)]
journalLeafAndFullAccountNames = (Text -> (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map Text -> (Text, Text)
leafAndAccountName ([Text] -> [(Text, Text)])
-> (Journal -> [Text]) -> Journal -> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Text]
journalAccountNamesUsed
  where leafAndAccountName :: Text -> (Text, Text)
leafAndAccountName Text
a = (Text -> Text
accountLeafName Text
a, Text
a)