    {-# 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 ["values"] (CommandDoc -> RawOpts -> RawOpts
    setboolopt "values") "list tag values instead of tag names"
      ,[CommandDoc] -> (RawOpts -> RawOpts) -> CommandDoc -> Flag RawOpts
    forall a. [CommandDoc] -> (a -> a) -> CommandDoc -> Flag a
    flagNone ["parsed"] (CommandDoc -> RawOpts -> RawOpts
    setboolopt "parsed") "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 "[TAGREGEX [QUERY...]]")

    tags :: CliOpts -> Journal -> IO ()
    tags :: CliOpts -> Journal -> IO ()
    tags CliOpts{rawopts_ :: CliOpts -> RawOpts
    rawopts_=RawOpts
    rawopts,reportopts_ :: CliOpts -> ReportOpts
    reportopts_=ReportOpts
    ropts} j :: Journal
    j = do
      Day
    d <- IO Day
    getCurrentDay
      let
        args :: [CommandDoc]
    args      = CommandDoc -> RawOpts -> [CommandDoc]
    listofstringopt "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
    . CommandDoc -> Either CommandDoc Regexp
    toRegexCI) (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
        queryargs :: [CommandDoc]
    queryargs = Int -> [CommandDoc] -> [CommandDoc]
    forall a. Int -> [a] -> [a]
    drop 1 [CommandDoc]
    args
        values :: Bool
    values    = CommandDoc -> RawOpts -> Bool
    boolopt "values" RawOpts
    rawopts
        parsed :: Bool
    parsed    = CommandDoc -> RawOpts -> Bool
    boolopt "parsed" RawOpts
    rawopts
        empty :: Bool
    empty     = ReportOpts -> Bool
    empty_ ReportOpts
    ropts
        q :: Query
    q = Day -> ReportOpts -> Query
    queryFromOpts Day
    d (ReportOpts -> Query) -> ReportOpts -> Query
    forall a b. (a -> b) -> a -> b
    $ ReportOpts
    ropts{query_ :: CommandDoc
    query_ = [CommandDoc] -> CommandDoc
    unwords ([CommandDoc] -> CommandDoc) -> [CommandDoc] -> CommandDoc
    forall a b. (a -> b) -> a -> b
    $ (CommandDoc -> CommandDoc) -> [CommandDoc] -> [CommandDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map CommandDoc -> CommandDoc
    quoteIfNeeded [CommandDoc]
    queryargs}
        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
    $ ReportOpts -> Journal -> Journal
    journalSelectingAmountFromOpts ReportOpts
    ropts Journal
    j
        tagsorvalues :: [TagValue]
    tagsorvalues =
          (if Bool
    parsed then [TagValue] -> [TagValue]
    forall a. a -> a
    id else [TagValue] -> [TagValue]
    forall a. Ord a => [a] -> [a]
    nubSort)
          [ TagValue
    r
          | (t :: TagValue
    t,v :: TagValue
    v) <- (Transaction -> [(TagValue, TagValue)])
    -> [Transaction] -> [(TagValue, TagValue)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Transaction -> [(TagValue, TagValue)]
    transactionAllTags [Transaction]
    txns
          , Bool -> (Regexp -> Bool) -> Maybe Regexp -> Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Bool
    True (Regexp -> CommandDoc -> Bool
    `regexMatch` TagValue -> CommandDoc
    T.unpack TagValue
    t) Maybe Regexp
    mtagpat
          , let r :: TagValue
    r = if Bool
    values then TagValue
    v else TagValue
    t
          , Bool -> Bool
    not (Bool
    values Bool -> Bool -> Bool
    && TagValue -> Bool
    T.null TagValue
    v Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    empty)
          ]
      (TagValue -> IO ()) -> [TagValue] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ TagValue -> IO ()
    T.putStrLn [TagValue]
    tagsorvalues