{-# 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)

-- | 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 String ()
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 String ()
forall a b. b -> Either a b
Right ()
    [(Text, [Text])]
dupes ->
      -- report the first posting that references one of them (and its position), for now
      (Posting -> Either String ()) -> [Posting] -> Either String ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([(Text, [Text])] -> Posting -> Either String ()
checkposting [(Text, [Text])]
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 :: [(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 -> [(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)

checkposting :: [(Text,[AccountName])] -> Posting -> Either String ()
checkposting :: [(Text, [Text])] -> Posting -> Either String ()
checkposting [(Text, [Text])]
leafandfullnames Posting{Text
paccount :: Posting -> Text
paccount :: Text
paccount,Maybe Transaction
ptransaction :: Posting -> Maybe Transaction
ptransaction :: Maybe Transaction
ptransaction} =
  case [(Text, [Text])
lf | lf :: (Text, [Text])
lf@(Text
_,[Text]
fs) <- [(Text, [Text])]
leafandfullnames, Text
paccount Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
fs] of
    []             -> () -> Either String ()
forall a b. b -> Either a b
Right ()
    (Text
leaf,[Text]
fulls):[(Text, [Text])]
_ -> 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 -> Text -> Text -> 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"
      Text
leaf
      (Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"\""Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)(Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\"")) [Text]
fulls)
      (case Maybe Transaction
ptransaction of
        Maybe Transaction
Nothing -> String
""
        Just Transaction
t  -> String -> Text -> String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"\nseen in \"%s\" in transaction at: %s\n\n%s"
                    Text
paccount
                    ((SourcePos, SourcePos) -> String
showSourcePosPair ((SourcePos, SourcePos) -> String)
-> (SourcePos, SourcePos) -> String
forall a b. (a -> b) -> a -> b
$ Transaction -> (SourcePos, SourcePos)
tsourcepos Transaction
t)
                    (Text -> Text -> Text
linesPrepend Text
"> " (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n") (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
textChomp (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Transaction -> Text
showTransaction Transaction
t) :: String)