{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE CPP #-}
module Hledger.Cli.Commands.Accounts (
accountsmode
,accounts
) where
#if !(MIN_VERSION_base(4,11,0))
import Data.Monoid
#endif
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
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 ["declared"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "declared") "show account names declared with account directives"
,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone ["used"] (CommandDoc -> RawOpts -> RawOpts
setboolopt "used") "show account names referenced by transactions"
]
[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 ["drop"] (\s :: CommandDoc
s opts :: 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 "drop" CommandDoc
s RawOpts
opts) "N" "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 "[QUERY]")
accounts :: CliOpts -> Journal -> IO ()
accounts :: CliOpts -> Journal -> IO ()
accounts CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts, reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j = do
Day
d <- IO Day
getCurrentDay
let tree :: Bool
tree = ReportOpts -> Bool
tree_ ReportOpts
ropts
declared :: Bool
declared = CommandDoc -> RawOpts -> Bool
boolopt "declared" RawOpts
rawopts
used :: Bool
used = CommandDoc -> RawOpts -> Bool
boolopt "used" RawOpts
rawopts
q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
d ReportOpts
ropts
nodepthq :: Query
nodepthq = CommandDoc -> Query -> Query
forall a. Show a => CommandDoc -> a -> a
dbg1 "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
q
acctq :: Query
acctq = CommandDoc -> Query -> Query
forall a. Show a => CommandDoc -> a -> a
dbg1 "acctq" (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsAcct Query
q
depth :: Maybe Int
depth = CommandDoc -> Maybe Int -> Maybe Int
forall a. Show a => CommandDoc -> a -> a
dbg1 "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
q
matcheddeclaredaccts :: [AccountName]
matcheddeclaredaccts = CommandDoc -> [AccountName] -> [AccountName]
forall a. Show a => CommandDoc -> a -> a
dbg1 "matcheddeclaredaccts" ([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
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 "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 "accts to show" ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
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
sortedaccts :: [AccountName]
sortedaccts = Journal -> Bool -> [AccountName] -> [AccountName]
sortAccountNamesByDeclaration Journal
j Bool
tree [AccountName]
accts
clippedaccts :: [AccountName]
clippedaccts =
CommandDoc -> [AccountName] -> [AccountName]
forall a. Show a => CommandDoc -> a -> a
dbg1 "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
$
[AccountName] -> [AccountName]
forall a. Eq a => [a] -> [a]
nub ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$
(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
$
(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
$
[AccountName]
sortedaccts
(AccountName -> IO ()) -> [AccountName] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (AccountName -> IO ()
T.putStrLn (AccountName -> IO ())
-> (AccountName -> AccountName) -> AccountName -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccountName -> AccountName
render) [AccountName]
clippedaccts
where
render :: AccountName -> AccountName
render a :: AccountName
a = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
ALTree -> Int -> AccountName -> AccountName
T.replicate Int
indent " " AccountName -> AccountName -> AccountName
forall a. Semigroup a => a -> a -> a
<> AccountName -> AccountName
accountLeafName AccountName
droppedName
ALFlat -> AccountName
droppedName
where
indent :: Int
indent = 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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
- 1)
droppedName :: AccountName
droppedName = Int -> AccountName -> AccountName
accountNameDrop (ReportOpts -> Int
drop_ ReportOpts
ropts) AccountName
a