{-# 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
  -- first argument is a tag name pattern, others are a hledger query: hledger tags [TAGREGEX [QUERYARGS..]]
  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
    -- also list tags from matched account declarations, but not if there is
    -- a query for something transaction-related, like date: or amt:.
    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