{-|

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 Control.Monad (forM_)
import Data.List
import Data.Text qualified as T
import Data.Text.IO qualified as T
import System.Console.CmdArgs.Explicit as C

import Hledger
import Hledger.Cli.CliOptions


-- | Command line options for this command.
accountsmode :: Mode RawOpts
accountsmode = CommandHelpStr
-> [Flag RawOpts]
-> [(CommandHelpStr, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Accounts.txt")
  (
  [[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"used",CommandHelpStr
"u"]     (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"used")       CommandHelpStr
"list accounts used"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"declared",CommandHelpStr
"d"] (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"declared")   CommandHelpStr
"list accounts declared"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"undeclared"]   (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"undeclared") CommandHelpStr
"list accounts used but not declared"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"unused"]       (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"unused")     CommandHelpStr
"list accounts declared but not used"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"find"]         (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"find")       CommandHelpStr
"list the first account matched by the first argument (a case-insensitive infix regexp)"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"directives"]   (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"directives") CommandHelpStr
"show as account directives, for use in journals"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"locations"]    (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"locations")  CommandHelpStr
"also show where accounts were declared"
  ,[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"types"]        (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"types")      CommandHelpStr
"also show account 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]
++
  [[CommandHelpStr]
-> Update RawOpts
-> CommandHelpStr
-> CommandHelpStr
-> Flag RawOpts
forall a.
[CommandHelpStr]
-> Update a -> CommandHelpStr -> CommandHelpStr -> Flag a
flagReq  [CommandHelpStr
"drop"] (\CommandHelpStr
s RawOpts
opts -> RawOpts -> Either CommandHelpStr RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either CommandHelpStr RawOpts)
-> RawOpts -> Either CommandHelpStr RawOpts
forall a b. (a -> b) -> a -> b
$ CommandHelpStr -> CommandHelpStr -> RawOpts -> RawOpts
setopt CommandHelpStr
"drop" CommandHelpStr
s RawOpts
opts) CommandHelpStr
"N" CommandHelpStr
"flat mode: omit N leading account name parts"]
  )
  [(CommandHelpStr, [Flag RawOpts])]
cligeneralflagsgroups1
  ([Flag RawOpts]
hiddenflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++
  [[CommandHelpStr]
-> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
flagNone [CommandHelpStr
"positions"]    (CommandHelpStr -> RawOpts -> RawOpts
setboolopt CommandHelpStr
"locations") CommandHelpStr
"deprecated, use --locations instead"
  ])
  ([], 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 accounts command.
accounts :: CliOpts -> Journal -> IO ()
accounts :: CliOpts -> Journal -> IO ()
accounts opts :: CliOpts
opts@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
      directives :: Bool
directives = CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"directives" RawOpts
rawopts
      locations :: Bool
locations = CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"locations" RawOpts
rawopts
      types :: Bool
types = CommandHelpStr -> RawOpts -> Bool
boolopt CommandHelpStr
"types" RawOpts
rawopts
      -- Modified queries. These may not work with boolean queries (#2371).
      -- a depth limit will clip and exclude account names later, but we don't want to exclude accounts at this stage
      nodepthq :: Query
nodepthq = CommandHelpStr -> Query -> Query
forall a. Show a => CommandHelpStr -> a -> a
dbg4 CommandHelpStr
"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 = CommandHelpStr -> Query -> Query
forall a. Show a => CommandHelpStr -> a -> a
dbg4 CommandHelpStr
"acctq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsAcct Query
query
      dep :: DepthSpec
dep = CommandHelpStr -> DepthSpec -> DepthSpec
forall a. Show a => CommandHelpStr -> a -> a
dbg4 CommandHelpStr
"depth" (DepthSpec -> DepthSpec) -> DepthSpec -> DepthSpec
forall a b. (a -> b) -> a -> b
$ Query -> DepthSpec
queryDepth (Query -> DepthSpec) -> Query -> DepthSpec
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth Query
query
      -- when finding accounts used by postings, we remove tags that were declared on the posting,
      -- so that a tag: query will match account tags and not posting tags.
      matchedused :: [Text]
matchedused = CommandHelpStr -> [Text] -> [Text]
forall a. Show a => CommandHelpStr -> a -> a
dbg5 CommandHelpStr
"matchedused" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Posting -> Text) -> [Posting] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
paccount ([Posting] -> [Text]) -> [Posting] -> [Text]
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 -> Journal) -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ Journal -> Journal
journalPostingsKeepAccountTagsOnly Journal
j
      matcheddeclared :: [Text]
matcheddeclared = CommandHelpStr -> [Text] -> [Text]
forall a. Show a => CommandHelpStr -> a -> a
dbg5 CommandHelpStr
"matcheddeclared" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Maybe AccountType)
-> (Text -> [Tag]) -> Query -> Text -> Bool
matchesAccountExtra (Journal -> Text -> Maybe AccountType
journalAccountType Journal
j) (Journal -> Text -> [Tag]
journalInheritedAccountTags Journal
j) Query
nodepthq) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        ((Text, AccountDeclarationInfo) -> Text)
-> [(Text, AccountDeclarationInfo)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, AccountDeclarationInfo) -> Text
forall a b. (a, b) -> a
fst ([(Text, AccountDeclarationInfo)] -> [Text])
-> [(Text, AccountDeclarationInfo)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
      matchedundeclared :: [Text]
matchedundeclared = CommandHelpStr -> [Text] -> [Text]
forall a. Show a => CommandHelpStr -> a -> a
dbg5 CommandHelpStr
"matchedundeclared" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
matchedused [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
matcheddeclared
      matchedunused :: [Text]
matchedunused = CommandHelpStr -> [Text] -> [Text]
forall a. Show a => CommandHelpStr -> a -> a
dbg5 CommandHelpStr
"matchedunused" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text]
matcheddeclared [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
matchedused
      found :: Text
found = CommandHelpStr -> Text -> Text
forall a. Show a => CommandHelpStr -> a -> a
dbg5 CommandHelpStr
"matchedacct" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ RawOpts -> CommandHelpStr -> [Text] -> Text
findMatchedByArgument RawOpts
rawopts CommandHelpStr
"account" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalAccountNamesDeclaredOrImplied Journal
j
      matchedall :: [Text]
matchedall = [Text]
matcheddeclared [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
matchedused
      accts :: [Text]
accts = CommandHelpStr -> [Text] -> [Text]
forall a. Show a => CommandHelpStr -> a -> a
dbg5 CommandHelpStr
"accts to show" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        case CliOpts -> Maybe DeclarablesSelector
declarablesSelectorFromOpts CliOpts
opts of
          Maybe DeclarablesSelector
Nothing         -> [Text]
matchedall
          Just DeclarablesSelector
Used       -> [Text]
matchedused
          Just DeclarablesSelector
Declared   -> [Text]
matcheddeclared
          Just DeclarablesSelector
Undeclared -> [Text]
matchedundeclared
          Just DeclarablesSelector
Unused     -> [Text]
matchedunused
          Just DeclarablesSelector
Find       -> [Text
found]

  -- 2. sort them by declaration order (then undeclared accounts alphabetically)
  -- within each group of siblings
      sortedaccts :: [Text]
sortedaccts = Journal -> Bool -> [Text] -> [Text]
sortAccountNamesByDeclaration Journal
j Bool
tree [Text]
accts

  -- 2a. in tree mode, add parent accounts for tree structure context
      acctswithparents :: [Text]
acctswithparents =
        if Bool
tree
        then CommandHelpStr -> [Text] -> [Text]
forall a. Show a => CommandHelpStr -> a -> a
dbg4 CommandHelpStr
"acctswithparents" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
             Journal -> Bool -> [Text] -> [Text]
sortAccountNamesByDeclaration Journal
j Bool
tree ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$  -- re-sort after adding parents
             [Text] -> [Text]
expandAccountNames [Text]
sortedaccts          -- add all parent accounts
        else [Text]
sortedaccts

  -- 3. if there's a depth limit, depth-clip and remove any no longer useful items
      clippedaccts :: [Text]
clippedaccts =
        CommandHelpStr -> [Text] -> [Text]
forall a. Show a => CommandHelpStr -> a -> a
dbg4 CommandHelpStr
"clippedaccts" ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$
        (if Bool
tree then [Text] -> [Text]
forall a. a -> a
id else (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Text -> Bool
matchesAccount Query
acctq)) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$  -- in tree mode, keep parent accounts even if they don't match
        [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$                            -- clipping can leave duplicates (adjacent, hopefully)
        (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$          -- depth:0 can leave nulls
        (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DepthSpec -> Text -> Text
clipAccountName DepthSpec
dep) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$      -- clip at depth if specified
        [Text]
acctswithparents                 -- use expanded list instead of sortedaccts

  -- 4. print what remains as a list or tree, maybe applying --drop in the former case.
  -- Add various bits of info if enabled.
  let
    showKeyword :: Text
showKeyword = if Bool
directives then Text
"account " else Text
""
    -- some contortions here to show types nicely aligned
    showName :: Text -> Text
showName Text
a = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
      AccountListMode
ALTree -> Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
accountLeafName Text
droppedName
      AccountListMode
ALFlat -> Text
droppedName
      where
        indent :: Text
indent      = Int -> Text -> Text
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 (Text -> Int
accountNameLevel Text
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)) Text
" "
        droppedName :: Text
droppedName = Int -> Text -> Text
accountNameDrop (ReportOpts -> Int
drop_ ReportOpts
ropts) Text
a
    showType :: Text -> Text
showType Text
a =
      case (Bool
types, Journal -> Text -> Maybe AccountType
journalAccountType Journal
j Text
a) of
        (Bool
True, Just AccountType
t) -> Text -> Text
pad Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    ; type: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CommandHelpStr -> Text
T.pack (AccountType -> CommandHelpStr
forall a. Show a => a -> CommandHelpStr
show AccountType
t)
        (Bool, Maybe AccountType)
_ -> Text
""
    showAcctDeclOrder :: Text -> Text
showAcctDeclOrder Text
a
      | Bool
locations =
        (if Bool
types then Text
"," else Text -> Text
pad Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"    ;") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
        case Text
-> [(Text, AccountDeclarationInfo)] -> Maybe AccountDeclarationInfo
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
a ([(Text, AccountDeclarationInfo)] -> Maybe AccountDeclarationInfo)
-> [(Text, AccountDeclarationInfo)] -> Maybe AccountDeclarationInfo
forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j of
          Just AccountDeclarationInfo
adi ->
            Text
" declared at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (CommandHelpStr -> Text
T.pack (CommandHelpStr -> Text) -> CommandHelpStr -> Text
forall a b. (a -> b) -> a -> b
$ SourcePos -> CommandHelpStr
sourcePosPretty (SourcePos -> CommandHelpStr) -> SourcePos -> CommandHelpStr
forall a b. (a -> b) -> a -> b
$ AccountDeclarationInfo -> SourcePos
adisourcepos AccountDeclarationInfo
adi) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>  -- TODO: hide the column number
            Text
", overall declaration order " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (CommandHelpStr -> Text
T.pack (CommandHelpStr -> Text) -> CommandHelpStr -> Text
forall a b. (a -> b) -> a -> b
$ Int -> CommandHelpStr
forall a. Show a => a -> CommandHelpStr
show (Int -> CommandHelpStr) -> Int -> CommandHelpStr
forall a b. (a -> b) -> a -> b
$ AccountDeclarationInfo -> Int
adideclarationorder AccountDeclarationInfo
adi)
          Maybe AccountDeclarationInfo
Nothing -> Text
" undeclared"
      | Bool
otherwise = Text
""
    pad :: Text -> Text
pad Text
a = Int -> Text -> Text
T.replicate (Int
maxwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length (Text -> Text
showName Text
a)) Text
" "
    maxwidth :: Int
maxwidth = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length (Text -> Int) -> (Text -> Text) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
showName) [Text]
clippedaccts

  [Text] -> (Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
clippedaccts ((Text -> IO ()) -> IO ()) -> (Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Text
a -> Text -> IO ()
T.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
showKeyword Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
showName Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
showType Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
showAcctDeclOrder Text
a