{-|

The @descriptions@ command lists all unique descriptions seen in transactions, sorted alphabetically.

-}

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Cli.Commands.Descriptions (
  descriptionsmode
 ,descriptions
) where

import Data.List.Extra (nubSort)
import qualified Data.Text.IO as T

import Hledger
import Hledger.Cli.CliOptions


-- | Command line options for this command.
descriptionsmode :: Mode RawOpts
descriptionsmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Descriptions.txt")
  []
  [(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
"[QUERY]")

-- | The descriptions command.
descriptions :: CliOpts -> Journal -> IO ()
descriptions :: CliOpts -> Journal -> IO ()
descriptions CliOpts{reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j = do
  let ts :: EntriesReport
ts = ReportSpec -> Journal -> EntriesReport
entriesReport ReportSpec
rspec Journal
j
      descriptions :: [Text]
descriptions = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubSort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Transaction -> Text) -> EntriesReport -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Text
tdescription EntriesReport
ts

  (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]
descriptions