{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Cli.Commands.Tags (
tagsmode
,tags
)
where
import qualified Control.Monad.Fail as Fail
import Data.List.Extra (nubSort)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Safe
import System.Console.CmdArgs.Explicit as C
import Hledger
import Hledger.Cli.CliOptions
tagsmode :: Mode RawOpts
tagsmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
$(embedFileRelative "Hledger/Cli/Commands/Tags.txt")
[forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"values"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"values") CommandDoc
"list tag values instead of tag names"
,forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
flagNone [CommandDoc
"parsed"] (CommandDoc -> RawOpts -> RawOpts
setboolopt CommandDoc
"parsed") CommandDoc
"show tags/values in the order they were parsed, including duplicates"
]
[(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
"[TAGREGEX [QUERY...]]")
tags :: CliOpts -> Journal -> IO ()
tags :: CliOpts -> Journal -> IO ()
tags CliOpts{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts,reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j = do
let today :: Day
today = ReportSpec -> Day
_rsDay ReportSpec
rspec
args :: [CommandDoc]
args = CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"args" RawOpts
rawopts
Maybe Regexp
mtagpat <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => CommandDoc -> m a
Fail.fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CommandDoc Regexp
toRegexCI forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> Text
T.pack) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
headMay [CommandDoc]
args
let
querystr :: [Text]
querystr = forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
1 [CommandDoc]
args
values :: Bool
values = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"values" RawOpts
rawopts
parsed :: Bool
parsed = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"parsed" RawOpts
rawopts
empty :: Bool
empty = ReportOpts -> Bool
empty_ forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec
Query
query <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. CommandDoc -> a
usageError (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ Day -> [Text] -> Either CommandDoc (Query, [QueryOpt])
parseQueryList Day
today [Text]
querystr
let
q :: Query
q = Query -> Query
simplifyQuery forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [ReportOpts -> Query
queryFromFlags forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec, Query
query]
matchedtxns :: [Transaction]
matchedtxns = forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Transaction -> Bool
`matchesTransaction`) forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts ReportSpec
rspec Journal
j
matchedaccts :: [Text]
matchedaccts = forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"accts" forall a b. (a -> b) -> a -> b
$
if forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"queryIsTransactionRelated" forall a b. (a -> b) -> a -> b
$ Query -> Bool
queryIsTransactionRelated forall a b. (a -> b) -> a -> b
$ forall a. Show a => CommandDoc -> a -> a
dbg4 CommandDoc
"q" Query
q
then []
else 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
q) 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
tagsorvalues :: [Text]
tagsorvalues =
(if Bool
parsed then forall a. a -> a
id else forall a. Ord a => [a] -> [a]
nubSort)
[ Text
r
| (Text
t,Text
v) <- forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Journal -> Text -> [Tag]
journalAccountTags Journal
j) [Text]
matchedaccts forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [Tag]
transactionAllTags [Transaction]
matchedtxns
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Regexp -> Text -> Bool
`regexMatchText` Text
t) Maybe Regexp
mtagpat
, let r :: Text
r = if Bool
values then Text
v else Text
t
, Bool -> Bool
not (Bool
values Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
v Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
empty)
]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
T.putStrLn [Text]
tagsorvalues