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

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

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, [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{rawopts_ :: CliOpts -> RawOpts
rawopts_=RawOpts
rawopts,reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} Journal
j = do
  Day
d <- IO Day
getCurrentDay
  let
    args :: [CommandDoc]
args      = CommandDoc -> RawOpts -> [CommandDoc]
listofstringopt CommandDoc
"args" RawOpts
rawopts
    mtagpat :: Maybe CommandDoc
mtagpat   = [CommandDoc] -> Maybe CommandDoc
forall a. [a] -> Maybe a
headMay [CommandDoc]
args
    queryargs :: [CommandDoc]
queryargs = Int -> [CommandDoc] -> [CommandDoc]
forall a. Int -> [a] -> [a]
drop Int
1 [CommandDoc]
args
    values :: Bool
values    = CommandDoc -> RawOpts -> Bool
boolopt CommandDoc
"values" RawOpts
rawopts
    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 =
      [TagValue] -> [TagValue]
forall a. Ord a => [a] -> [a]
nubSort ([TagValue] -> [TagValue]) -> [TagValue] -> [TagValue]
forall a b. (a -> b) -> a -> b
$
      [if Bool
values then TagValue
v else TagValue
t
      | (TagValue
t,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 -> (CommandDoc -> Bool) -> Maybe CommandDoc -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (CommandDoc -> CommandDoc -> Bool
`regexMatchesCI` TagValue -> CommandDoc
T.unpack TagValue
t) Maybe CommandDoc
mtagpat
      ]
  (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