{-|

The @commodities@ command lists commodity/currency symbols.

-}

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

module Hledger.Cli.Commands.Commodities (
  commoditiesmode
 ,commodities
) where

import qualified Data.Set as S
import qualified Data.Text.IO as T

import Hledger
import Hledger.Cli.CliOptions


-- | Command line options for this command.
commoditiesmode :: Mode RawOpts
commoditiesmode = CommandDoc
-> [Flag RawOpts]
-> [(CommandDoc, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode
  $(embedFileRelative "Hledger/Cli/Commands/Commodities.txt")
  []
  [(CommandDoc, [Flag RawOpts])
generalflagsgroup2]
  []
  ([], Maybe (Arg RawOpts)
forall a. Maybe a
Nothing)

commodities :: CliOpts -> Journal -> IO ()
commodities :: CliOpts -> Journal -> IO ()
commodities CliOpts
_copts =
  -- TODO support --declared/--used like accounts, payees
  (Text -> IO ()) -> Set Text -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Text -> IO ()
T.putStrLn (Set Text -> IO ()) -> (Journal -> Set Text) -> Journal -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> Set Text -> Set Text
forall a. (a -> Bool) -> Set a -> Set a
S.filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"AUTO") (Set Text -> Set Text)
-> (Journal -> Set Text) -> Journal -> Set Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> Set Text
journalCommodities