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