{-# 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")
  [[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
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"
  ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
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
  ([], 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 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 <- (CommandDoc -> IO Regexp) -> Maybe CommandDoc -> IO (Maybe Regexp)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((CommandDoc -> IO Regexp)
-> (Regexp -> IO Regexp) -> Either CommandDoc Regexp -> IO Regexp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CommandDoc -> IO Regexp
forall (m :: * -> *) a. MonadFail m => CommandDoc -> m a
Fail.fail Regexp -> IO Regexp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CommandDoc Regexp -> IO Regexp)
-> (CommandDoc -> Either CommandDoc Regexp)
-> CommandDoc
-> IO Regexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CommandDoc Regexp
toRegexCI (Text -> Either CommandDoc Regexp)
-> (CommandDoc -> Text) -> CommandDoc -> Either CommandDoc Regexp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommandDoc -> Text
T.pack) (Maybe CommandDoc -> IO (Maybe Regexp))
-> Maybe CommandDoc -> IO (Maybe Regexp)
forall a b. (a -> b) -> a -> b
$ [CommandDoc] -> Maybe CommandDoc
forall a. [a] -> Maybe a
headMay [CommandDoc]
args
  let
    querystring :: [Text]
querystring = (CommandDoc -> Text) -> [CommandDoc] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map CommandDoc -> Text
T.pack ([CommandDoc] -> [Text]) -> [CommandDoc] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [CommandDoc] -> [CommandDoc]
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_ (ReportOpts -> Bool) -> ReportOpts -> Bool
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec

  Query
argsquery <- (CommandDoc -> IO Query)
-> ((Query, [QueryOpt]) -> IO Query)
-> Either CommandDoc (Query, [QueryOpt])
-> IO Query
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either CommandDoc -> IO Query
forall a. CommandDoc -> a
usageError (Query -> IO Query
forall (m :: * -> *) a. Monad m => a -> m a
return (Query -> IO Query)
-> ((Query, [QueryOpt]) -> Query)
-> (Query, [QueryOpt])
-> IO Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query, [QueryOpt]) -> Query
forall a b. (a, b) -> a
fst) (Either CommandDoc (Query, [QueryOpt]) -> IO Query)
-> Either CommandDoc (Query, [QueryOpt]) -> IO Query
forall a b. (a -> b) -> a -> b
$ Day -> [Text] -> Either CommandDoc (Query, [QueryOpt])
parseQueryList Day
today [Text]
querystring
  let
    q :: Query
q = Query -> Query
simplifyQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [ReportOpts -> Query
queryFromFlags (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts ReportSpec
rspec, Query
argsquery]
    txns :: [Transaction]
txns = (Transaction -> Bool) -> [Transaction] -> [Transaction]
forall a. (a -> Bool) -> [a] -> [a]
filter (Query
q Query -> Transaction -> Bool
`matchesTransaction`) ([Transaction] -> [Transaction]) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal -> [Transaction]
jtxns (Journal -> [Transaction]) -> Journal -> [Transaction]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts ReportSpec
rspec Journal
j
    tagsorvalues :: [Text]
tagsorvalues =
      (if Bool
parsed then [Text] -> [Text]
forall a. a -> a
id else [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSort)
      [ Text
r
      | (Text
t,Text
v) <- (Transaction -> [(Text, Text)]) -> [Transaction] -> [(Text, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Transaction -> [(Text, Text)]
transactionAllTags [Transaction]
txns
      , Bool -> (Regexp -> Bool) -> Maybe Regexp -> Bool
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)
      ]
  (Text -> IO ()) -> [Text] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
T.putStrLn [Text]
tagsorvalues