{-# 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_)
import Data.Maybe (fromMaybe)
import Safe (headDef)
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")
(Bool -> [Flag RawOpts]
flattreeflags Bool
False forall a. [a] -> [a] -> [a]
++
[forall a.
[CommandDoc] -> Update a -> CommandDoc -> CommandDoc -> Flag a
flagReq [CommandDoc
"drop"] (\CommandDoc
s RawOpts
opts -> forall a b. b -> Either a b
Right 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"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"used",CommandDoc
"u"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"used") CommandDoc
"show accounts used by transactions"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"declared",CommandDoc
"d"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"declared") CommandDoc
"show accounts declared by account directive"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"unused"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"unused") CommandDoc
"show only accounts declared but not used"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"undeclared"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"undeclared") CommandDoc
"show only accounts used but not declared"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"find"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"find") CommandDoc
"find the first account matched by the first command argument (a case-insensitive infix regexp or account name)"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"types"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"types") CommandDoc
"also show account types when known"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"positions"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"positions") CommandDoc
"also show where accounts were declared"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"directives"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"directives") CommandDoc
"show as account directives, for use in journals"
])
[(CommandDoc, [Flag RawOpts])
generalflagsgroup1]
[Flag RawOpts]
hiddenflags
([], forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CommandDoc -> Arg RawOpts
argsFlag CommandDoc
"[QUERY]")
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
let tree :: Bool
tree = ReportOpts -> Bool
tree_ ReportOpts
ropts
used :: Bool
used = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"used" RawOpts
rawopts
decl :: Bool
decl = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"declared" RawOpts
rawopts
unused :: Bool
unused = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"unused" RawOpts
rawopts
undecl :: Bool
undecl = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"undeclared" RawOpts
rawopts
find_ :: Bool
find_ = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"find" RawOpts
rawopts
types :: Bool
types = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"types" RawOpts
rawopts
positions :: Bool
positions = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"positions" RawOpts
rawopts
directives :: Bool
directives = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"directives" RawOpts
rawopts
nodepthq :: Query
nodepthq = forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"nodepthq" forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Bool
queryIsDepth) Query
query
acctq :: Query
acctq = forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"acctq" forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsAcct Query
query
dep :: Maybe Int
dep = forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"depth" forall a b. (a -> b) -> a -> b
$ Query -> Maybe Int
queryDepth forall a b. (a -> b) -> a -> b
$ (Query -> Bool) -> Query -> Query
filterQuery Query -> Bool
queryIsDepth Query
query
matcheddeclaredaccts :: [Text]
matcheddeclaredaccts = forall a. Show a => CommandDoc -> a -> a
dbg5 CommandDoc
"matcheddeclaredaccts" forall a b. (a -> b) -> a -> b
$
forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$
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) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
matchedusedaccts :: [Text]
matchedusedaccts = forall a. Show a => CommandDoc -> a -> a
dbg5 CommandDoc
"matchedusedaccts" forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Posting -> Text
paccount forall a b. (a -> b) -> a -> b
$ Journal -> [Posting]
journalPostings forall a b. (a -> b) -> a -> b
$ Query -> Journal -> Journal
filterJournalPostings Query
nodepthq Journal
j
matchedunusedaccts :: [Text]
matchedunusedaccts = forall a. Show a => CommandDoc -> a -> a
dbg5 CommandDoc
"matchedunusedaccts" forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [Text]
matcheddeclaredaccts forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
matchedusedaccts
matchedundeclaredaccts :: [Text]
matchedundeclaredaccts = forall a. Show a => CommandDoc -> a -> a
dbg5 CommandDoc
"matchedundeclaredaccts" forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ [Text]
matchedusedaccts forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
matcheddeclaredaccts
matchedacct :: Text
matchedacct = forall a. Show a => CommandDoc -> a -> a
dbg5 CommandDoc
"matchedacct" forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a -> a
fromMaybe (forall a. CommandDoc -> a
error' forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> CommandDoc
show CommandDoc
apat forall a. [a] -> [a] -> [a]
++ CommandDoc
" did not match any account.")
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
firstMatch forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
journalAccountNamesDeclaredOrImplied Journal
j
where
firstMatch :: [Text] -> Maybe Text
firstMatch = case Text -> Either CommandDoc Regexp
toRegexCI forall a b. (a -> b) -> a -> b
$ CommandDoc -> Text
T.pack CommandDoc
apat of
Right Regexp
re -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Regexp -> Text -> Bool
regexMatchText Regexp
re)
Left CommandDoc
_ -> forall a b. a -> b -> a
const forall a. Maybe a
Nothing
apat :: CommandDoc
apat = forall a. a -> [a] -> a
headDef
(forall a. CommandDoc -> a
error' CommandDoc
"With --find, please provide an account name or\naccount pattern (case-insensitive, infix, regexp) as first command argument.")
forall a b. (a -> b) -> a -> b
$ CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"args" RawOpts
rawopts
accts :: [Text]
accts = forall a. Show a => CommandDoc -> a -> a
dbg5 CommandDoc
"accts to show" forall a b. (a -> b) -> a -> b
$ if
| Bool -> Bool
not Bool
decl Bool -> Bool -> Bool
&& Bool
used -> [Text]
matchedusedaccts
| Bool
decl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
used -> [Text]
matcheddeclaredaccts
| Bool
unused -> [Text]
matchedunusedaccts
| Bool
undecl -> [Text]
matchedundeclaredaccts
| Bool
find_ -> [Text
matchedacct]
| Bool
otherwise -> [Text]
matcheddeclaredaccts forall a. [a] -> [a] -> [a]
++ [Text]
matchedusedaccts
sortedaccts :: [Text]
sortedaccts = Journal -> Bool -> [Text] -> [Text]
sortAccountNamesByDeclaration Journal
j Bool
tree [Text]
accts
clippedaccts :: [Text]
clippedaccts =
forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"clippedaccts" forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (Query -> Text -> Bool
matchesAccount Query
acctq) forall a b. (a -> b) -> a -> b
$
forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int -> Text -> Text
clipAccountName Maybe Int
dep) forall a b. (a -> b) -> a -> b
$
[Text]
sortedaccts
let
showKeyword :: Text
showKeyword = if Bool
directives then Text
"account " else Text
""
showName :: Text -> Text
showName Text
a = case ReportOpts -> AccountListMode
accountlistmode_ ReportOpts
ropts of
AccountListMode
ALTree -> Text
indent 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 forall a. Num a => a -> a -> a
* (forall a. Ord a => a -> a -> a
max Int
0 (Text -> Int
accountNameLevel Text
a forall a. Num a => a -> a -> a
- ReportOpts -> Int
drop_ ReportOpts
ropts) 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
| Bool
types = Text -> Text
pad Text
a forall a. Semigroup a => a -> a -> a
<> Text
" ; type: " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (CommandDoc -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> CommandDoc
show) (Journal -> Text -> Maybe AccountType
journalAccountType Journal
j Text
a)
| Bool
otherwise = Text
""
showAcctDeclOrder :: Text -> Text
showAcctDeclOrder Text
a
| Bool
positions =
(if Bool
types then Text
"," else Text -> Text
pad Text
a forall a. Semigroup a => a -> a -> a
<> Text
" ;") forall a. Semigroup a => a -> a -> a
<>
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
a forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j of
Just AccountDeclarationInfo
adi ->
Text
" declared at " forall a. Semigroup a => a -> a -> a
<> (CommandDoc -> Text
T.pack forall a b. (a -> b) -> a -> b
$ SourcePos -> CommandDoc
sourcePosPretty forall a b. (a -> b) -> a -> b
$ AccountDeclarationInfo -> SourcePos
adisourcepos AccountDeclarationInfo
adi) forall a. Semigroup a => a -> a -> a
<>
Text
", overall declaration order " forall a. Semigroup a => a -> a -> a
<> (CommandDoc -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> CommandDoc
show 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 forall a. Num a => a -> a -> a
- Text -> Int
T.length (Text -> Text
showName Text
a)) Text
" "
maxwidth :: Int
maxwidth = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
showName) [Text]
clippedaccts
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
clippedaccts forall a b. (a -> b) -> a -> b
$ \Text
a -> Text -> IO ()
T.putStrLn forall a b. (a -> b) -> a -> b
$ Text
showKeyword forall a. Semigroup a => a -> a -> a
<> Text -> Text
showName Text
a forall a. Semigroup a => a -> a -> a
<> Text -> Text
showType Text
a forall a. Semigroup a => a -> a -> a
<> Text -> Text
showAcctDeclOrder Text
a