    {-# 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
      -- first argument is a tag name pattern, others are a hledger query: hledger tags [TAGREGEX [QUERYARGS..]]
      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)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe 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 a. CommandDoc -> IO a
    forall (m :: * -> *) a. MonadFail m => CommandDoc -> m a
    Fail.fail Regexp -> IO Regexp
    forall a. a -> IO a
    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
        querystr :: [Text]
    querystr = (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
    query <- (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 a. a -> IO a
    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]
    querystr
      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
    query]
        matchedtxns :: [Transaction]
    matchedtxns = (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
        -- 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 = CommandDoc -> [Text] -> [Text]
    forall a. Show a => CommandDoc -> a -> a
    dbg4 CommandDoc
    "accts" ([Text] -> [Text]) -> [Text] -> [Text]
    forall a b. (a -> b) -> a -> b
    $
          if CommandDoc -> Bool -> Bool
    forall a. Show a => CommandDoc -> a -> a
    dbg4 CommandDoc
    "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
    $ CommandDoc -> Query -> Query
    forall a. Show a => CommandDoc -> a -> a
    dbg4 CommandDoc
    "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
        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) <- (Text -> [Tag]) -> [Text] -> [Tag]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (Journal -> Text -> [Tag]
    journalAccountTags Journal
    j) [Text]
    matchedaccts [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]
    matchedtxns
          , 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