{-|

The @payees@ command lists all unique payees (description part before a |) seen in transactions, sorted alphabetically.

-}

{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}

module Hledger.Cli.Commands.Payees (
  payeesmode
 ,payees
) where

import qualified Data.Set as S
import qualified Data.Text.IO as T
import System.Console.CmdArgs.Explicit as C

import Hledger
import Hledger.Cli.CliOptions


-- | Command line options for this command.
payeesmode :: Mode RawOpts
payeesmode = CommandHelpStr
-> [Flag RawOpts]
-> [(CommandHelpStr, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Payees.txt")
  [[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"declared"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"declared") CommandHelpStr
"show payees declared with payee directives"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"used"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"used") CommandHelpStr
"show payees referenced by transactions"
  ]
  [(CommandHelpStr, [Flag RawOpts])]
cligeneralflagsgroups1
  [Flag RawOpts]
hiddenflags
  ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> Arg RawOpts
argsFlag CommandHelpStr
"[QUERY]")

-- | The payees command.
payees :: CliOpts -> Journal -> IO ()
payees :: CliOpts -> Journal -> IO ()
payees CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
query}} Journal
j = do
  let
    decl :: Bool
decl = CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"declared" RawOpts
rawopts
    used :: Bool
used     = CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"used"     RawOpts
rawopts
    -- XXX matchesPayee is currently an alias for matchesDescription, not sure if it matters
    matcheddeclaredpayees :: Set Payee
matcheddeclaredpayees = [Payee] -> Set Payee
forall a. Ord a => [a] -> Set a
S.fromList ([Payee] -> Set Payee)
-> ([Payee] -> [Payee]) -> [Payee] -> Set Payee
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Payee -> Bool) -> [Payee] -> [Payee]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Payee -> Bool
matchesPayeeWIP Query
query) ([Payee] -> Set Payee) -> [Payee] -> Set Payee
forall a b. (a -> b) -> a -> b
$ Journal -> [Payee]
journalPayeesDeclared Journal
j
    matchedusedpayees :: Set Payee
matchedusedpayees     = [Payee] -> Set Payee
forall a. Ord a => [a] -> Set a
S.fromList ([Payee] -> Set Payee)
-> ([Transaction] -> [Payee]) -> [Transaction] -> Set Payee
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transaction -> Payee) -> [Transaction] -> [Payee]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Payee
transactionPayee ([Transaction] -> Set Payee) -> [Transaction] -> Set Payee
forall a b. (a -> b) -> a -> b
$ (Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Transaction -> Bool
matchesTransaction Query
query) ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns Journal
j
    payees' :: Set Payee
payees' =
      if | Bool
decl     Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
used -> Set Payee
matcheddeclaredpayees
         | Bool -> Bool
not Bool
decl Bool -> Bool -> Bool
&& Bool
used     -> Set Payee
matchedusedpayees
         | Bool
otherwise            -> Set Payee
matcheddeclaredpayees Set Payee -> Set Payee -> Set Payee
forall a. Semigroup a => a -> a -> a
<> Set Payee
matchedusedpayees
  (Payee -> IO ()) -> Set Payee -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Payee -> IO ()
T.putStrLn Set Payee
payees'