{-|

The @accounts@ command lists account names:

- in flat mode (default), it lists the full names of accounts posted to by matched postings,
  clipped to the specified depth, possibly with leading components dropped.

- in tree mode, it shows the indented short names of accounts posted to by matched postings,
  and their parents, to the specified depth.

-}

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

module Hledger.Cli.Commands.Accounts (
  accountsmode
 ,accounts
) where

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

import Hledger
import Hledger.Cli.CliOptions
import Control.Monad (forM_)


-- | Command line options for this command.
accountsmode :: Mode RawOpts
accountsmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Accounts.txt")
  ([[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"declared"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"declared") CommandDoc
"show account names declared with account directives"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"used"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"used") CommandDoc
"show account names referenced by transactions"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"types"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"types") CommandDoc
"also show accounts' types, when known"
  ]
  [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ Bool -> [Flag RawOpts]
flattreeflags Bool
False [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++
  [[CommandDoc]
-> Update RawOpts -> CommandDoc -> CommandDoc -> Flag RawOpts
forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq  [CommandDoc
"drop"] (\CommandDoc
s RawOpts
opts -> RawOpts -> Either CommandDoc RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandDoc RawOpts)
-> RawOpts -> Either CommandDoc RawOpts
forall a b. (a -> b) -> a -> b
$ CommandDoc -> CommandDoc -> RawOpts -> RawOpts
setopt CommandDoc
"drop" CommandDoc
s RawOpts
opts) CommandDoc
"N" CommandDoc
"flat mode: omit N leading account name parts"
  ])
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
  [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
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY]")

-- | The accounts command.
accounts :: CliOpts -> Journal -> IO ()
accounts :: CliOpts -> Journal -> IO ()
accounts CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec{_rsQuery :: ReportSpec -> Query
_rsQuery=Query
query,_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts}} Journal
j = do

  -- 1. identify the accounts we'll show
  let tree :: Bool
tree     = ReportOpts -> Bool
tree_ ReportOpts
ropts
      declared :: Bool
declared = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"declared" RawOpts
rawopts
      used :: Bool
used     = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"used"     RawOpts
rawopts
      types :: Bool
types    = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"types"    RawOpts
rawopts
      -- a depth limit will clip and exclude account names later, but we don't want to exclude accounts at this stage
      nodepthq :: Query
nodepthq = CommandDoc -> Query -> Query
forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"nodepthq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not (Bool -> Bool) -> (Query -> Bool) -> Query -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsDepth) Query
query
      -- just the acct: part of the query will be reapplied later, after clipping
      acctq :: Query
acctq    = CommandDoc -> Query -> Query
forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"acctq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsAcct Query
query
      depth :: Maybe Int
depth    = CommandDoc -> Maybe Int -> Maybe Int
forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"depth" (Maybe Int -> Maybe Int) -> Maybe Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Query -> Maybe Int
queryDepth (Query -> Maybe Int) -> Query -> Maybe Int
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth Query
query
      matcheddeclaredaccts :: [AccountName]
matcheddeclaredaccts =
        CommandDoc -> [AccountName] -> [AccountName]
forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"matcheddeclaredaccts" ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
        (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter ((AccountName -> Maybe AccountType)
-> (AccountName -> [Tag]) -> Query -> AccountName -> Bool
matchesAccountExtra (Journal -> AccountName -> Maybe AccountType
journalAccountType Journal
j) (Journal -> AccountName -> [Tag]
journalInheritedAccountTags Journal
j) Query
nodepthq)
          ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ ((AccountName, AccountDeclarationInfo) -> AccountName)
-> [(AccountName, AccountDeclarationInfo)] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName, AccountDeclarationInfo) -> AccountName
forall a b. (a, b) -> a
fst ([(AccountName, AccountDeclarationInfo)] -> [AccountName])
-> [(AccountName, AccountDeclarationInfo)] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
      matchedusedaccts :: [AccountName]
matchedusedaccts     = CommandDoc -> [AccountName] -> [AccountName]
forall a. Show a => CommandDoc -> a -> a
dbg5 CommandDoc
"matchedusedaccts" ([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] -> [AccountName]) -> [Posting] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings (Journal -> [Posting]) -> Journal -> [Posting]
forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Journal
filterJournalPostings Query
nodepthq Journal
j
      accts :: [AccountName]
accts                = CommandDoc -> [AccountName] -> [AccountName]
forall a. Show a => CommandDoc -> a -> a
dbg5 CommandDoc
"accts to show" ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ -- no need to nub/sort, accountTree will
        if | Bool
declared     Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
used -> [AccountName]
matcheddeclaredaccts
           | Bool -> Bool
not Bool
declared Bool -> Bool -> Bool
&& Bool
used     -> [AccountName]
matchedusedaccts
           | Bool
otherwise                -> [AccountName]
matcheddeclaredaccts [AccountName] -> [AccountName] -> [AccountName]
forall a. [a] -> [a] -> [a]
++ [AccountName]
matchedusedaccts

  -- 2. sort them by declaration order and name, at each level of their tree structure
      sortedaccts :: [AccountName]
sortedaccts = Journal -> Bool -> [AccountName] -> [AccountName]
sortAccountNamesByDeclaration Journal
j Bool
tree [AccountName]
accts

  -- 3. if there's a depth limit, depth-clip and remove any no longer useful items
      clippedaccts :: [AccountName]
clippedaccts =
        CommandDoc -> [AccountName] -> [AccountName]
forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"clippedaccts" ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
        (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> AccountName -> Bool
matchesAccount Query
acctq) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$           -- clipping can leave accounts that no longer match the query, remove such
        [AccountName] -> [AccountName]
forall a. Eq a => [a] -> [a]
nub ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$                                     -- clipping can leave duplicates (adjacent, hopefully)
        (AccountName -> Bool) -> [AccountName] -> [AccountName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (AccountName -> Bool) -> AccountName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> Bool
T.null) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$                   -- depth:0 can leave nulls
        (AccountName -> AccountName) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int -> AccountName -> AccountName
clipAccountName Maybe Int
depth) ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$  -- clip at depth if specified
        [AccountName]
sortedaccts

  -- 4. print what remains as a list or tree, maybe applying --drop in the former case.
  -- With --types, also show the account type.
  let
    -- some contortions here to show types nicely aligned
    showName :: AccountName -> AccountName
showName AccountName
a = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
      AccountListMode
ALTree -> AccountName
indent AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName -> AccountName
accountLeafName AccountName
droppedName
      AccountListMode
ALFlat -> AccountName
droppedName
      where
        indent :: AccountName
indent      = Int -> AccountName -> AccountName
T.replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (AccountName -> Int
accountNameLevel AccountName
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- ReportOpts -> Int
drop_ ReportOpts
ropts) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) AccountName
" "
        droppedName :: AccountName
droppedName = Int -> AccountName -> AccountName
accountNameDrop (ReportOpts -> Int
drop_ ReportOpts
ropts) AccountName
a
    showType :: AccountName -> AccountName
showType AccountName
a 
      | Bool
types     = AccountName
spacer AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
"    ; type: " AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName
-> (AccountType -> AccountName) -> Maybe AccountType -> AccountName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AccountName
"" (CommandDoc -> AccountName
T.pack (CommandDoc -> AccountName)
-> (AccountType -> CommandDoc) -> AccountType -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountType -> CommandDoc
forall a. Show a => a -> CommandDoc
show) (Journal -> AccountName -> Maybe AccountType
journalAccountType Journal
j AccountName
a)
      | Bool
otherwise = AccountName
""
      where
        spacer :: AccountName
spacer = Int -> AccountName -> AccountName
T.replicate (Int
maxwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- AccountName -> Int
T.length (AccountName -> AccountName
showName AccountName
a)) AccountName
" "
    maxwidth :: Int
maxwidth = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (AccountName -> Int) -> [AccountName] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (AccountName -> Int
T.length (AccountName -> Int)
-> (AccountName -> AccountName) -> AccountName -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> AccountName
showName) [AccountName]
clippedaccts
  [AccountName] -> (AccountName -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AccountName]
clippedaccts ((AccountName -> IO ()) -> IO ())
-> (AccountName -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AccountName
a -> AccountName -> IO ()
T.putStrLn (AccountName -> IO ()) -> AccountName -> IO ()
forall a b. (a -> b) -> a -> b
$ AccountName -> AccountName
showName AccountName
a AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName -> AccountName
showType AccountName
a