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