{-# 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 forall leaf full.
(Ord leaf, Eq full) =>
[(leaf, full)] -> [(leaf, [full])]
finddupes forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, Text)]
journalLeafAndFullAccountNames Journal
j of
    [] -> 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 forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
fulls)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Posting -> Text
paccount) forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings Journal
j of
        ps :: [Posting]
ps@(Posting
p:Posting
p2:[Posting]
_) -> forall a b. a -> Either a b
Left 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
"%s:%d:\n%s\nChecking for unique account leaf names is enabled, and\n"
          forall a. [a] -> [a] -> [a]
++FilePath
"account leaf name %s is not unique.\n"
          forall a. [a] -> [a] -> [a]
++FilePath
"It appears in these account names, which are used in %d places:\n%s"
          forall a. [a] -> [a] -> [a]
++FilePath
"\nConsider changing these account names so their last parts are different."
          )
          FilePath
f Int
l Text
ex (forall a. Show a => a -> FilePath
show Text
leaf) (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
_ -> 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 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
_ = forall a. a -> Maybe a
Just (Int
col, 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 forall a b. (a -> b) -> a -> b
$ Text -> Text
accountLeafName Text
a
                col :: Int
col = Int
5 forall a. Num a => a -> a -> a
+ (if Posting -> Bool
isVirtual Posting
p' then Int
1 else Int
0) forall a. Num a => a -> a -> a
+ Int
alen forall a. Num a => a -> a -> a
- Int
llen
                col2 :: Int
col2 = Int
col forall a. Num a => a -> a -> a
+ Int
llen forall a. Num a => a -> a -> a
- Int
1
            accts :: Text
accts = [Text] -> Text
T.unlines [Text]
fulls

        [Posting]
_ -> 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 = forall a b. [a] -> [b] -> [(a, b)]
zip [leaf]
dupLeafs [[full]]
dupAccountNames
  where dupLeafs :: [leaf]
dupLeafs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) [[(leaf, full)]]
d
        dupAccountNames :: [[full]]
dupAccountNames = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd) [[(leaf, full)]]
d
        d :: [[(leaf, full)]]
d = forall {b}. [(leaf, b)] -> [[(leaf, b)]]
dupes' [(leaf, full)]
leafandfullnames
        dupes' :: [(leaf, b)] -> [[(leaf, b)]]
dupes' = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)

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