{-# LANGUAGE TemplateHaskell #-}

module Hledger.Cli.Commands.Checkdupes (
  checkdupesmode
 ,checkdupes
)
where

import Data.Function
import Data.List
import Data.List.Extra (nubSort)
import qualified Data.Text as T
import Hledger
import Hledger.Cli.CliOptions
import System.Console.CmdArgs.Explicit
import Text.Printf
import System.Exit (exitFailure)
import Control.Monad (when)

checkdupesmode :: Mode RawOpts
checkdupesmode :: Mode RawOpts
checkdupesmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Checkdupes.txt")
  []
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
  [Flag RawOpts]
hiddenflags
  ([], Maybe (Arg RawOpts)
forall a. Maybe a
Nothing)

checkdupes :: p -> Journal -> IO ()
checkdupes p
_opts Journal
j = do
  let dupes :: [(CommandDoc, [AccountName])]
dupes = [(CommandDoc, AccountName)] -> [(CommandDoc, [AccountName])]
forall k v. (Ord k, Eq k) => [(k, v)] -> [(k, [v])]
checkdupes' ([(CommandDoc, AccountName)] -> [(CommandDoc, [AccountName])])
-> [(CommandDoc, AccountName)] -> [(CommandDoc, [AccountName])]
forall a b. (a -> b) -> a -> b
$ Journal -> [(CommandDoc, AccountName)]
accountsNames Journal
j
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(CommandDoc, [AccountName])] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(CommandDoc, [AccountName])]
dupes) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ((CommandDoc, [AccountName]) -> IO ())
-> [(CommandDoc, [AccountName])] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (CommandDoc, [AccountName]) -> IO ()
render [(CommandDoc, [AccountName])]
dupes
    IO ()
forall a. IO a
exitFailure

accountsNames :: Journal -> [(String, AccountName)]
accountsNames :: Journal -> [(CommandDoc, AccountName)]
accountsNames Journal
j = (AccountName -> (CommandDoc, AccountName))
-> [AccountName] -> [(CommandDoc, AccountName)]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> (CommandDoc, AccountName)
leafAndAccountName [AccountName]
as
  where leafAndAccountName :: AccountName -> (CommandDoc, AccountName)
leafAndAccountName AccountName
a = (AccountName -> CommandDoc
T.unpack (AccountName -> CommandDoc) -> AccountName -> CommandDoc
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName
accountLeafName AccountName
a, AccountName
a)
        ps :: [Posting]
ps = Journal -> [Posting]
journalPostings Journal
j
        as :: [AccountName]
as = [AccountName] -> [AccountName]
forall a. Ord a => [a] -> [a]
nubSort ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ (Posting -> AccountName) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> AccountName
paccount [Posting]
ps

checkdupes' :: (Ord k, Eq k) => [(k, v)] -> [(k, [v])]
checkdupes' :: [(k, v)] -> [(k, [v])]
checkdupes' [(k, v)]
l = [k] -> [[v]] -> [(k, [v])]
forall a b. [a] -> [b] -> [(a, b)]
zip [k]
dupLeafs [[v]]
dupAccountNames
  where dupLeafs :: [k]
dupLeafs = ([(k, v)] -> k) -> [[(k, v)]] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map ((k, v) -> k
forall a b. (a, b) -> a
fst ((k, v) -> k) -> ([(k, v)] -> (k, v)) -> [(k, v)] -> k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> (k, v)
forall a. [a] -> a
head) [[(k, v)]]
d
        dupAccountNames :: [[v]]
dupAccountNames = ([(k, v)] -> [v]) -> [[(k, v)]] -> [[v]]
forall a b. (a -> b) -> [a] -> [b]
map (((k, v) -> v) -> [(k, v)] -> [v]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> v
forall a b. (a, b) -> b
snd) [[(k, v)]]
d
        d :: [[(k, v)]]
d = [(k, v)] -> [[(k, v)]]
forall b. [(k, b)] -> [[(k, b)]]
dupes' [(k, v)]
l
        dupes' :: [(k, b)] -> [[(k, b)]]
dupes' = ([(k, b)] -> Bool) -> [[(k, b)]] -> [[(k, b)]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ([(k, b)] -> Int) -> [(k, b)] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, b)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length)
          ([[(k, b)]] -> [[(k, b)]])
-> ([(k, b)] -> [[(k, b)]]) -> [(k, b)] -> [[(k, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, b) -> (k, b) -> Bool) -> [(k, b)] -> [[(k, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==) (k -> k -> Bool) -> ((k, b) -> k) -> (k, b) -> (k, b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, b) -> k
forall a b. (a, b) -> a
fst)
          ([(k, b)] -> [[(k, b)]])
-> ([(k, b)] -> [(k, b)]) -> [(k, b)] -> [[(k, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, b) -> (k, b) -> Ordering) -> [(k, b)] -> [(k, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering)
-> ((k, b) -> k) -> (k, b) -> (k, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, b) -> k
forall a b. (a, b) -> a
fst)

render :: (String, [AccountName]) -> IO ()
render :: (CommandDoc, [AccountName]) -> IO ()
render (CommandDoc
leafName, [AccountName]
accountNameL) = CommandDoc -> CommandDoc -> CommandDoc -> IO ()
forall r. PrintfType r => CommandDoc -> r
printf CommandDoc
"%s as %s\n" CommandDoc
leafName (CommandDoc -> [CommandDoc] -> CommandDoc
forall a. [a] -> [[a]] -> [a]
intercalate CommandDoc
", " ((AccountName -> CommandDoc) -> [AccountName] -> [CommandDoc]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> CommandDoc
T.unpack [AccountName]
accountNameL))