    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TupleSections #-}

    module Hledger.Cli.Commands.Tags (
      tagsmode
     ,tags
    )
    where

    import Control.Monad.Fail qualified as Fail
    import Data.List.Extra (nubSort)
    import Data.Text qualified as T
    import Data.Text.IO qualified as T
    import Safe
    import System.Console.CmdArgs.Explicit

    import Hledger
    import Hledger.Cli.CliOptions

    tagsmode :: Mode RawOpts
    tagsmode = CommandHelpStr
    -> [Flag RawOpts]
    -> [(CommandHelpStr, [Flag RawOpts])]
    -> [Flag RawOpts]
    -> ([Arg RawOpts], Maybe (Arg RawOpts))
    -> Mode RawOpts
    hledgerCommandMode
      $(embedFileRelative "Hledger/Cli/Commands/Tags.txt")
      [
       [CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "used"]         (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "used")       CommandHelpStr
    "list tags used"
      ,[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "declared"]     (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "declared")   CommandHelpStr
    "list tags declared"
      ,[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "undeclared"]   (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "undeclared") CommandHelpStr
    "list tags used but not declared"
      ,[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "unused"]       (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "unused")     CommandHelpStr
    "list tags declared but not used"
      ,[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "values"]       (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "values")     CommandHelpStr
    "list tag values instead of tag names"
      ,[CommandHelpStr]
    -> (RawOpts -> RawOpts) -> CommandHelpStr -> Flag RawOpts
    forall a. [CommandHelpStr] -> (a -> a) -> CommandHelpStr -> Flag a
    flagNone [CommandHelpStr
    "parsed"]       (CommandHelpStr -> RawOpts -> RawOpts
    setboolopt CommandHelpStr
    "parsed")     CommandHelpStr
    "show them in the order they were parsed (mostly), including duplicates"
      ]
      [(CommandHelpStr, [Flag RawOpts])]
    cligeneralflagsgroups1
      [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
    $ CommandHelpStr -> Arg RawOpts
    argsFlag CommandHelpStr
    "[TAGREGEX [QUERY..]]")

    tags :: CliOpts -> Journal -> IO ()
    tags :: CliOpts -> Journal -> IO ()
    tags opts :: CliOpts
    opts@CliOpts{rawopts_ :: CliOpts -> RawOpts
    rawopts_=RawOpts
    rawopts, reportspec_ :: CliOpts -> ReportSpec
    reportspec_=rspec :: ReportSpec
    rspec@ReportSpec{_rsQuery :: ReportSpec -> Query
    _rsQuery=Query
    _q, _rsReportOpts :: ReportSpec -> ReportOpts
    _rsReportOpts=ReportOpts
    ropts}} Journal
    j = do
      let today :: Day
    today = ReportSpec -> Day
    _rsDay ReportSpec
    rspec
          args :: [CommandHelpStr]
    args = CommandHelpStr -> RawOpts -> [CommandHelpStr]
    listofstringopt CommandHelpStr
    "args" RawOpts
    rawopts
      -- For convenience/power, the first argument is a tag name regex,
      -- separate from the main query arguments: hledger tags [TAGREGEX [QUERYARGS..]]
      -- So we have to re-parse the query here. Overcomplicated ?
      mtagpat <- (CommandHelpStr -> IO Regexp)
    -> Maybe CommandHelpStr -> IO (Maybe Regexp)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    mapM ((CommandHelpStr -> IO Regexp)
    -> (Regexp -> IO Regexp)
    -> Either CommandHelpStr Regexp
    -> IO Regexp
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either CommandHelpStr -> IO Regexp
    forall a. CommandHelpStr -> IO a
    forall (m :: * -> *) a. MonadFail m => CommandHelpStr -> m a
    Fail.fail Regexp -> IO Regexp
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Either CommandHelpStr Regexp -> IO Regexp)
    -> (CommandHelpStr -> Either CommandHelpStr Regexp)
    -> CommandHelpStr
    -> IO Regexp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Either CommandHelpStr Regexp
    toRegexCI (Text -> Either CommandHelpStr Regexp)
    -> (CommandHelpStr -> Text)
    -> CommandHelpStr
    -> Either CommandHelpStr Regexp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CommandHelpStr -> Text
    T.pack) (Maybe CommandHelpStr -> IO (Maybe Regexp))
    -> Maybe CommandHelpStr -> IO (Maybe Regexp)
    forall a b. (a -> b) -> a -> b
    $ [CommandHelpStr] -> Maybe CommandHelpStr
    forall a. [a] -> Maybe a
    headMay [CommandHelpStr]
    args
      let
        values   = CommandHelpStr -> RawOpts -> Bool
    boolopt CommandHelpStr
    "values" RawOpts
    rawopts
        parsed   = CommandHelpStr -> RawOpts -> Bool
    boolopt CommandHelpStr
    "parsed" RawOpts
    rawopts
        empty    = ReportOpts -> Bool
    empty_ ReportOpts
    ropts
        querystr = (CommandHelpStr -> Text) -> [CommandHelpStr] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map CommandHelpStr -> Text
    T.pack ([CommandHelpStr] -> [Text]) -> [CommandHelpStr] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Int -> [CommandHelpStr] -> [CommandHelpStr]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [CommandHelpStr]
    args
      query <- either usageError (return . fst) $ parseQueryList today querystr
      let
        q = Query -> Query
    simplifyQuery (Query -> Query) -> Query -> Query
    forall a b. (a -> b) -> a -> b
    $ [Query] -> Query
    And [ReportOpts -> Query
    queryFromFlags ReportOpts
    ropts, Query
    query]
        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
        accts =
          -- also search for tags in matched account declarations,
          -- unless there is a query for something transaction-specific, like date: or amt:.
          if CommandHelpStr -> Bool -> Bool
    forall a. Show a => CommandHelpStr -> a -> a
    dbg5 CommandHelpStr
    "queryIsTransactionRelated" (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Query -> Bool
    queryIsTransactionRelated (Query -> Bool) -> Query -> Bool
    forall a b. (a -> b) -> a -> b
    $ CommandHelpStr -> Query -> Query
    forall a. Show a => CommandHelpStr -> a -> a
    dbg4 CommandHelpStr
    "q" Query
    q
          then []
          else (Text -> Bool) -> [Text] -> [Text]
    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) ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $
               ((Text, AccountDeclarationInfo) -> Text)
    -> [(Text, AccountDeclarationInfo)] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, AccountDeclarationInfo) -> Text
    forall a b. (a, b) -> a
    fst ([(Text, AccountDeclarationInfo)] -> [Text])
    -> [(Text, AccountDeclarationInfo)] -> [Text]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [(Text, AccountDeclarationInfo)]
    jdeclaredaccounts Journal
    j

        used       = CommandHelpStr -> [Tag] -> [Tag]
    forall a. Show a => CommandHelpStr -> a -> a
    dbg5 CommandHelpStr
    "used"       ([Tag] -> [Tag]) -> [Tag] -> [Tag]
    forall a b. (a -> b) -> a -> b
    $ (Text -> [Tag]) -> [Text] -> [Tag]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Journal -> Text -> [Tag]
    journalAccountTags Journal
    j) [Text]
    accts [Tag] -> [Tag] -> [Tag]
    forall a. [a] -> [a] -> [a]
    ++ (Transaction -> [Tag]) -> [Transaction] -> [Tag]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Transaction -> [Tag]
    transactionAllTags [Transaction]
    txns
        declared'  = CommandHelpStr -> [Tag] -> [Tag]
    forall a. Show a => CommandHelpStr -> a -> a
    dbg5 CommandHelpStr
    "declared"   ([Tag] -> [Tag]) -> [Tag] -> [Tag]
    forall a b. (a -> b) -> a -> b
    $ (Tag -> Bool) -> [Tag] -> [Tag]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Query
    q Query -> Tag -> Bool
    `matchesTag`) ([Tag] -> [Tag]) -> [Tag] -> [Tag]
    forall a b. (a -> b) -> a -> b
    $ (Text -> Tag) -> [Text] -> [Tag]
    forall a b. (a -> b) -> [a] -> [b]
    map (,Text
    "") ([Text] -> [Tag]) -> [Text] -> [Tag]
    forall a b. (a -> b) -> a -> b
    $ Journal -> [Text]
    journalTagsDeclared Journal
    j
        (usednames, declarednames) = (map fst used, map fst declared')
        unused     = CommandHelpStr -> [Tag] -> [Tag]
    forall a. Show a => CommandHelpStr -> a -> a
    dbg5 CommandHelpStr
    "unused"     ([Tag] -> [Tag]) -> [Tag] -> [Tag]
    forall a b. (a -> b) -> a -> b
    $ (Tag -> Bool) -> [Tag] -> [Tag]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Tag -> Bool) -> Tag -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    usednames) (Text -> Bool) -> (Tag -> Text) -> Tag -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tag -> Text
    forall a b. (a, b) -> a
    fst) [Tag]
    declared'
        undeclared = CommandHelpStr -> [Tag] -> [Tag]
    forall a. Show a => CommandHelpStr -> a -> a
    dbg5 CommandHelpStr
    "undeclared" ([Tag] -> [Tag]) -> [Tag] -> [Tag]
    forall a b. (a -> b) -> a -> b
    $ (Tag -> Bool) -> [Tag] -> [Tag]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Tag -> Bool) -> Tag -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> [Text] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Text]
    declarednames) (Text -> Bool) -> (Tag -> Text) -> Tag -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Tag -> Text
    forall a b. (a, b) -> a
    fst) [Tag]
    used
        all'       = CommandHelpStr -> [Tag] -> [Tag]
    forall a. Show a => CommandHelpStr -> a -> a
    dbg5 CommandHelpStr
    "all"        ([Tag] -> [Tag]) -> [Tag] -> [Tag]
    forall a b. (a -> b) -> a -> b
    $ [Tag]
    declared' [Tag] -> [Tag] -> [Tag]
    forall a. Semigroup a => a -> a -> a
    <> [Tag]
    used

        tags' =
          case CliOpts -> Maybe UsedOrDeclared
    usedOrDeclaredFromOpts CliOpts
    opts of
            Maybe UsedOrDeclared
    Nothing         -> [Tag]
    all'
            Just UsedOrDeclared
    Used       -> [Tag]
    used
            Just UsedOrDeclared
    Declared   -> [Tag]
    declared'
            Just UsedOrDeclared
    Undeclared -> [Tag]
    undeclared
            Just UsedOrDeclared
    Unused     -> [Tag]
    unused

        results =
          (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) <- [Tag]
    tags'
          , 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)
          ]

      mapM_ T.putStrLn results