{-|

This is the root module of the @hledger@ package,
providing hledger's command-line interface.
The main function,
commands,
command-line options,
and utilities useful to other hledger command-line programs
are exported.
It also re-exports hledger-lib:Hledger
and cmdargs:System.Concole.CmdArgs.Explicit

See also:

- hledger-lib:Hledger
- [The README files](https://github.com/search?q=repo%3Asimonmichael%2Fhledger+path%3A**%2FREADME*&type=code&ref=advsearch)
- [The high-level developer docs](https://hledger.org/dev.html)

== About

hledger - a fast, reliable, user-friendly plain text accounting tool.
Copyright (c) 2007-2024 Simon Michael <simon@joyful.com> and contributors
Released under GPL version 3 or later.

hledger is a Haskell rewrite of John Wiegley's "ledger".  
It generates financial reports from a plain text general journal.
You can use the command line:

> $ hledger

or ghci:

> $ make ghci
> ghci> Right j <- runExceptT $ readJournalFile definputopts "examples/sample.journal"  -- or: j <- defaultJournal
> ghci> :t j
> j :: Journal
> ghci> stats defcliopts j
> Main file                : examples/sample.journal
> Included files           : 
> Transactions span        : 2008-01-01 to 2009-01-01 (366 days)
> Last transaction         : 2008-12-31 (733772 days from now)
> Transactions             : 5 (0.0 per day)
> Transactions last 30 days: 0 (0.0 per day)
> Transactions last 7 days : 0 (0.0 per day)
> Payees/descriptions      : 5
> Accounts                 : 8 (depth 3)
> Commodities              : 1 ($)
> Market prices            : 0 ()
> 
> Run time (throughput)    : 1695276900.00s (0 txns/s)
> ghci> balance defcliopts j
>                   $1  assets:bank:saving
>                  $-2  assets:cash
>                   $1  expenses:food
>                   $1  expenses:supplies
>                  $-1  income:gifts
>                  $-1  income:salary
>                   $1  liabilities:debts
> --------------------
>                    0  
> ghci> 

etc.

-}

{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

module Hledger.Cli (
  main,
  mainmode,
  argsToCliOpts,
  -- * Re-exports
  module Hledger.Cli.CliOptions,
  module Hledger.Cli.Conf,
  module Hledger.Cli.Commands,
  module Hledger.Cli.DocFiles,
  module Hledger.Cli.Utils,
  module Hledger.Cli.Version,
  module Hledger,
  -- ** System.Console.CmdArgs.Explicit
  module CmdArgsWithoutName
)
where

import Control.Monad (when, unless)
import Data.Bifunctor (second)
import Data.Char (isDigit)
import Data.Either (isRight)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.List
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Text (pack, Text)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Safe
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Explicit as CmdArgsWithoutName hiding (Name)
import System.Environment
import System.Exit
import System.FilePath
import System.Process
import Text.Megaparsec (optional, takeWhile1P, eof)
import Text.Megaparsec.Char (char)
import Text.Printf

import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Conf
import Hledger.Cli.Commands
import Hledger.Cli.DocFiles
import Hledger.Cli.Utils
import Hledger.Cli.Version


verboseDebugLevel :: Int
verboseDebugLevel = Int
8

-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
-- The names of known addons are provided so they too can be recognised as commands.
mainmode :: [String] -> Mode RawOpts
mainmode [String]
addons = Mode RawOpts
defMode {
  modeNames = [progname ++ " [COMMAND]"]
 ,modeArgs = ([], Just $ argsFlag "[ARGS]")
 ,modeHelp = unlines ["hledger's main command line interface. Run with no ARGS to list commands."]
 ,modeGroupModes = Group {
    -- subcommands in the unnamed group, shown first:
    groupUnnamed = [
     ]
    -- subcommands in named groups:
   ,groupNamed = [
     ]
    -- subcommands handled but not shown in the help:
   ,groupHidden = map fst builtinCommands ++ map addonCommandMode addons
   }
 ,modeGroupFlags = Group {
     -- flags in named groups: (keep synced with Hledger.Cli.CliOptions.highlightHelp)
     groupNamed = cligeneralflagsgroups1
     -- flags in the unnamed group, shown last: (keep synced with dropUnsupportedOpts)
    ,groupUnnamed = confflags
     -- other flags handled but not shown in help:
    ,groupHidden = hiddenflagsformainmode
    }
 ,modeHelpSuffix = []
    -- "Examples:" :
    -- map (progname ++) [
    --  "                         list commands"
    -- ," CMD [--] [OPTS] [ARGS]  run a command (use -- with addon commands)"
    -- ,"-CMD [OPTS] [ARGS]       or run addon commands directly"
    -- ," -h                      show general usage"
    -- ," CMD -h                  show command usage"
    -- ," help [MANUAL]           show any of the hledger manuals in various formats"
    -- ]
 }
-- A dummy mode just for parsing --conf/--no-conf flags.
confflagsmode :: Mode RawOpts
confflagsmode = Mode RawOpts
defMode{
   modeGroupFlags=Group [] confflags []
  ,modeArgs = ([], Just $ argsFlag "")
  }

------------------------------------------------------------------------------
-- | hledger CLI's main procedure.
--
-- Here we will parse the command line, read any config file,
-- and search for hledger-* addon executables in the user's PATH,
-- then choose the appropriate builtin operation or addon operation to run,
-- then run it in the right way, usually reading input data (eg a journal) first.
--
-- When making a CLI usable and robust with main command, builtin subcommands,
-- various kinds of addon commands, and config files that add general and
-- command-specific options, while balancing circular dependencies, environment,
-- idioms, legacy, and libraries with their own requirements and limitations:
-- things get crazy, and there is a tradeoff against complexity and bug risk.
-- We try to provide the most intuitive, expressive and robust CLI that's feasible
-- while keeping the CLI processing below sufficiently comprehensible, troubleshootable,
-- and tested. It's an ongoing quest.
-- See also: Hledger.Cli.CliOptions, cli.test, addons.test, --debug and --debug=8.
--
-- Probably the biggest source of complexity here is that cmdargs can't parse
-- a command line containing undeclared flags, but this arises often with our
-- addon commands and builtin/custom commands which haven't implemented all options,
-- so we have to work hard to work around this.
-- https://github.com/ndmitchell/cmdargs/issues/36 is the wishlist issue;
-- implementing that would simplify hledger's CLI processing a lot.
--
main :: IO ()
main :: IO ()
main = IO () -> IO ()
forall {a}. a -> a
withGhcDebug' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do

  -- let's go!
  let
    -- Trace helpers. These always trace to stderr, even when running `hledger ui`;
    -- that's ok as conf is a hledger cli feature for now.
    dbgIO, dbgIO1, dbgIO2 :: Show a => String -> a -> IO ()  -- this signature is needed
    dbgIO :: forall a. Show a => String -> a -> IO ()
dbgIO  = Int -> String -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
verboseDebugLevel
    dbgIO1 :: forall a. Show a => String -> a -> IO ()
dbgIO1 = Int -> String -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
1
    dbgIO2 :: forall a. Show a => String -> a -> IO ()
dbgIO2 = Int -> String -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
2

  String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"running" String
prognameandversion

  POSIXTime
starttime <- IO POSIXTime
getPOSIXTime

  -- give ghc-debug a chance to take control
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GhcDebugMode
ghcDebugMode GhcDebugMode -> GhcDebugMode -> Bool
forall a. Eq a => a -> a -> Bool
== GhcDebugMode
GDPauseAtStart) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
ghcDebugPause'

  -- try to encourage user's $PAGER to display ANSI when supported
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useColorOnStdout IO ()
setupPager

  -- Search PATH for addon commands. Exclude any that match builtin command names.
  [String]
addons <- IO [String]
hledgerAddons IO [String] -> ([String] -> [String]) -> IO [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
builtinCommandNames) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropExtension)

  ---------------------------------------------------------------
  -- Preliminary command line parsing.

  -- Do some argument preprocessing to help cmdargs
  [String]
cliargs <- IO [String]
getArgs
    IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
expandArgsAt         -- interpolate @ARGFILEs
    IO [String] -> ([String] -> [String]) -> IO [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [String] -> [String]
replaceNumericFlags  -- convert -NUM to --depth=NUM
  let
    (String
clicmdarg, [String]
cliargswithoutcmd, [String]
cliargswithcmdfirst) = [String] -> (String, [String], [String])
moveFlagsAfterCommand [String]
cliargs
    cliargswithcmdfirstwithoutclispecific :: [String]
cliargswithcmdfirstwithoutclispecific = [String] -> [String]
dropCliSpecificOpts [String]
cliargswithcmdfirst
    ([String]
cliargsbeforecmd, [String]
cliargsaftercmd) = ([String] -> [String])
-> ([String], [String]) -> ([String], [String])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1) (([String], [String]) -> ([String], [String]))
-> ([String], [String]) -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
clicmdarg) [String]
cliargs
  String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args" [String]
cliargs
  String -> [String] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg1IO String
"cli args with command first, if any" [String]
cliargswithcmdfirst
  String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"command argument found"   String
clicmdarg
  String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args before command"  [String]
cliargsbeforecmd
  String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args after command"   [String]
cliargsaftercmd

  -- Now try to identify the full subcommand name, so we can look for
  -- command-specific options in config files (clicmdarg may be only an abbreviation).
  -- For this do a preliminary cmdargs parse of the arguments with cli-specific options removed.
  -- If no command was provided, or if the command line contains a bad flag
  -- or a wrongly present/missing flag argument, cmd will be "".
  let
    rawopts0 :: RawOpts
rawopts0 = String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse
      String
"to get command name"
      ([String] -> Mode RawOpts
mainmode [String]
addons)
      [String]
cliargswithcmdfirstwithoutclispecific
    cmd :: String
cmd = String -> RawOpts -> String
stringopt String
"command" RawOpts
rawopts0
      -- XXX better error message when cmdargs fails (eg spaced/quoted/malformed flag values) ?
    nocmdprovided :: Bool
nocmdprovided  = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
clicmdarg
    badcmdprovided :: Bool
badcmdprovided = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
nocmdprovided
    isaddoncmd :: Bool
isaddoncmd = Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd) Bool -> Bool -> Bool
&& String
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
addons
    -- isbuiltincmd = cmd `elem` builtinCommandNames
    mcmdmodeaction :: Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
mcmdmodeaction = String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand String
cmd
    effectivemode :: Mode RawOpts
effectivemode = Mode RawOpts
-> ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts)
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
-> Mode RawOpts
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Mode RawOpts
mainmode []) (Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts
forall a b. (a, b) -> a
fst Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
mcmdmodeaction
  String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args with command first and no cli-specific opts" [String]
cliargswithcmdfirstwithoutclispecific
  String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"command found" String
cmd
  String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"no command provided" Bool
nocmdprovided
  String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"bad command provided" Bool
badcmdprovided
  String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"is addon command" Bool
isaddoncmd

  ---------------------------------------------------------------
  -- Read extra options from a config file.

  -- Identify any --conf/--no-conf options.
  -- For this parse with cmdargs again, this time with just the args that look conf-related.
  let cliconfargs :: [String]
cliconfargs = Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
confflagsmode [String]
cliargswithoutcmd
  String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args without command" [String]
cliargswithoutcmd
  -- dbgIO "cli conf args" cliconfargs
  let rawopts1 :: RawOpts
rawopts1 = String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse String
"to get conf file" Mode RawOpts
confflagsmode [String]
cliconfargs

  -- Read extra general and command-specific args/opts from the config file if found.
  -- Ignore any general opts or cli-specific opts not known to be supported by the command.
  (Conf
conf, Maybe String
mconffile) <- RawOpts -> IO (Conf, Maybe String)
getConf RawOpts
rawopts1
  let
    genargsfromconf :: [String]
genargsfromconf = String -> Conf -> [String]
confLookup String
"general" Conf
conf
    addoncmdssupportinggenopts :: [String]
addoncmdssupportinggenopts = [String
"ui", String
"web"]  -- addons known to support hledger general options
    supportedgenargsfromconf :: [String]
supportedgenargsfromconf
      | String
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
addoncmdssupportinggenopts =
          [String
a | String
a <- [String]
genargsfromconf, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a) [String]
addoncmdssupportinggenopts]
      | Bool
isaddoncmd = []
      | Bool
otherwise  = Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
effectivemode [String]
genargsfromconf
    excludedgenargsfromconf :: [String]
excludedgenargsfromconf = [String]
genargsfromconf [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
supportedgenargsfromconf
    cmdargsfromconf :: [String]
cmdargsfromconf
      | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd  = []
      | Bool
otherwise = String -> Conf -> [String]
confLookup String
cmd Conf
conf [String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& if Bool
isaddoncmd then (String
"--"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall {a}. a -> a
id
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
mconffile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"using extra general args from config file" [String]
genargsfromconf
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
excludedgenargsfromconf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"excluded general args from config file, not supported by this command" [String]
excludedgenargsfromconf
    String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"using extra command args from config file" [String]
cmdargsfromconf

  ---------------------------------------------------------------
  -- Combine cli and config file args and parse with cmdargs.
  -- A bad flag or flag argument will cause the program to exit with an error here.

  let
    finalargs :: [String]
finalargs =  -- (avoid breaking vs code haskell highlighting..)
      (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
clicmdarg then [] else [String
clicmdarg]) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
supportedgenargsfromconf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cmdargsfromconf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cliargswithoutcmd
      [String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& [String] -> [String]
replaceNumericFlags                -- convert any -NUM opts from the config file
  -- finalargs' <- expandArgsAt finalargs  -- expand @ARGFILEs in the config file ? don't bother
  let rawopts :: RawOpts
rawopts = String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse String
"to get options" ([String] -> Mode RawOpts
mainmode [String]
addons) [String]
finalargs

  ---------------------------------------------------------------
  -- Finally, select an action and run it.

  -- We check for the help/doc/version flags first, since they are a high priority.
  -- (A perfectionist might think they should be so high priority that adding -h
  -- to an invalid command line would show help. But cmdargs tends to fail first,
  -- preventing this, and trying to detect them without cmdargs, and always do the
  -- right thing with builtin commands and addon commands, gets much too complicated.)
  let
    helpFlag :: Bool
helpFlag    = String -> RawOpts -> Bool
boolopt String
"help"    RawOpts
rawopts
    tldrFlag :: Bool
tldrFlag    = String -> RawOpts -> Bool
boolopt String
"tldr"    RawOpts
rawopts
    infoFlag :: Bool
infoFlag    = String -> RawOpts -> Bool
boolopt String
"info"    RawOpts
rawopts
    manFlag :: Bool
manFlag     = String -> RawOpts -> Bool
boolopt String
"man"     RawOpts
rawopts
    versionFlag :: Bool
versionFlag = String -> RawOpts -> Bool
boolopt String
"version" RawOpts
rawopts

  if
    -- no command and a help/doc flag found - show general help/docs
    | Bool
nocmdprovided Bool -> Bool -> Bool
&& Bool
helpFlag -> String -> IO ()
pager (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> String
forall a. Mode a -> String
showModeUsage ([String] -> Mode RawOpts
mainmode []) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    | Bool
nocmdprovided Bool -> Bool -> Bool
&& Bool
tldrFlag -> String -> IO ()
runTldrForPage  String
"hledger"
    | Bool
nocmdprovided Bool -> Bool -> Bool
&& Bool
infoFlag -> String -> Maybe String -> IO ()
runInfoForTopic String
"hledger" Maybe String
forall a. Maybe a
Nothing
    | Bool
nocmdprovided Bool -> Bool -> Bool
&& Bool
manFlag  -> String -> Maybe String -> IO ()
runManForTopic  String
"hledger" Maybe String
forall a. Maybe a
Nothing

    -- --version flag found and none of these other conditions - show version
    | Bool
versionFlag Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
isaddoncmd Bool -> Bool -> Bool
|| Bool
helpFlag Bool -> Bool -> Bool
|| Bool
tldrFlag Bool -> Bool -> Bool
|| Bool
infoFlag Bool -> Bool -> Bool
|| Bool
manFlag) -> String -> IO ()
putStrLn String
prognameandversion

    -- there's a command argument, but it's bad - show error
    | Bool
badcmdprovided -> String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"command "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
clicmdargString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" is not recognized, run with no command to see a list"

    -- no command found, nothing else to do - show the commands list
    | Bool
nocmdprovided -> String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"" String
"no command, showing commands list" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> [String] -> IO ()
printCommandsList String
prognameandversion [String]
addons

    -- builtin command found
    | Just (Mode RawOpts
cmdmode, CliOpts -> Journal -> IO ()
cmdaction) <- Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
mcmdmodeaction -> do

      -- validate opts/args more and convert to CliOpts
      CliOpts
opts <- RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts IO CliOpts -> (CliOpts -> IO CliOpts) -> IO CliOpts
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CliOpts
opts0 -> CliOpts -> IO CliOpts
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CliOpts
opts0{progstarttime_=starttime}
      String -> CliOpts -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO2 String
"processed opts" CliOpts
opts
      String -> Period -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"period from opts" (ReportOpts -> Period
period_ (ReportOpts -> Period)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Period
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> Period) -> ReportSpec -> Period
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
      String -> Interval -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"interval from opts" (ReportOpts -> Interval
interval_ (ReportOpts -> Interval)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> Interval) -> ReportSpec -> Interval
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
      String -> Query -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"query from opts & args" (ReportSpec -> Query
_rsQuery (ReportSpec -> Query) -> ReportSpec -> Query
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
      let
        mcmdname :: Maybe String
mcmdname = [String] -> Maybe String
forall a. [a] -> Maybe a
headMay ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [String]
forall a. Mode a -> [String]
modeNames Mode RawOpts
cmdmode
        tldrpagename :: String
tldrpagename = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"hledger" ((String
"hledger-"String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)) Maybe String
mcmdname

      -- run the builtin command according to its type
      if
        -- help/doc flag - show command help/docs
        | Bool
helpFlag  -> String -> IO ()
pager (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> String
forall a. Mode a -> String
showModeUsage Mode RawOpts
cmdmode String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
        | Bool
tldrFlag  -> String -> IO ()
runTldrForPage String
tldrpagename
        | Bool
infoFlag  -> String -> Maybe String -> IO ()
runInfoForTopic String
"hledger" Maybe String
mcmdname
        | Bool
manFlag   -> String -> Maybe String -> IO ()
runManForTopic String
"hledger"  Maybe String
mcmdname

        -- builtin command which should not require or read the journal - run it
        | String
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"demo",String
"help",String
"test"] ->
          CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts (Journal -> IO ()) -> Journal -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Journal
forall a. String -> a
error' (String -> Journal) -> String -> Journal
forall a b. (a -> b) -> a -> b
$ String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" tried to read the journal but is not supposed to"

        -- builtin command which should create the journal if missing - do that and run it
        | String
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"add",String
"import"] -> do
          String -> IO ()
ensureJournalFileExists (String -> IO ())
-> (NonEmpty String -> String) -> NonEmpty String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> String
forall a. NonEmpty a -> a
NE.head (NonEmpty String -> IO ()) -> IO (NonEmpty String) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CliOpts -> IO (NonEmpty String)
journalFilePathFromOpts CliOpts
opts
          CliOpts -> (Journal -> IO ()) -> IO ()
forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts (CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts)

        -- all other builtin commands - read the journal and if successful run the command with it
        | Bool
otherwise -> CliOpts -> (Journal -> IO ()) -> IO ()
forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts ((Journal -> IO ()) -> IO ()) -> (Journal -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts

    -- external addon command found - run it,
    -- passing any cli arguments written after the command name
    -- and any command-specific opts from the config file.
    -- Any "--" arguments, which sometimes must be used in the command line
    -- to hide addon-specific opts from hledger's cmdargs parsing,
    -- (and are also accepted in the config file, though not required there),
    -- will be removed.
    -- (hledger does not preserve -- arguments)
    -- Arguments written before the command name, and general opts from the config file,
    -- are not passed since we can't be sure they're supported.
    | Bool
isaddoncmd -> do
        let
          addonargs0 :: [String]
addonargs0 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"--") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
supportedgenargsfromconf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cmdargsfromconf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cliargswithoutcmd
          addonargs :: [String]
addonargs = [String] -> [String]
dropCliSpecificOpts [String]
addonargs0
          shellcmd :: String
shellcmd = String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s %s" String
progname String
cmd ([String] -> String
unwords' [String]
addonargs) :: String
        String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"addon command selected" String
cmd
        String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"addon command arguments after removing cli-specific opts" ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
quoteIfNeeded [String]
addonargs)
        String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"running addon" String
shellcmd
        String -> IO ExitCode
system String
shellcmd IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith

    -- deprecated command found
    -- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure

    -- something else (shouldn't happen) - show an error 
    | Bool
otherwise -> String -> IO ()
forall a. String -> a
usageError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"could not understand the arguments "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
finalargs
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
genargsfromconf then String
"" else String
"\ngeneral arguments added from config file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
genargsfromconf
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdargsfromconf then String
"" else String
"\ncommand arguments added from config file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
cmdargsfromconf

  -- And we're done.
  -- Give ghc-debug a final chance to take control.
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GhcDebugMode
ghcDebugMode GhcDebugMode -> GhcDebugMode -> Bool
forall a. Eq a => a -> a -> Bool
== GhcDebugMode
GDPauseAtEnd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
ghcDebugPause'

------------------------------------------------------------------------------


-- | A helper for addons/scripts: this parses hledger CliOpts from these
-- command line arguments and add-on command names, roughly how hledger main does.
-- If option parsing/validating fails, it exits the program with usageError.
-- Unlike main, this does not read extra args from a config file
-- or search for addons; to do those things, mimic the code in main for now.
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts [String]
args [String]
addons = do
  let
    (String
_, [String]
_, [String]
args0) = [String] -> (String, [String], [String])
moveFlagsAfterCommand [String]
args
    args1 :: [String]
args1 = [String] -> [String]
replaceNumericFlags [String]
args0
    rawopts :: RawOpts
rawopts = String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse String
"to get options" ([String] -> Mode RawOpts
mainmode [String]
addons) [String]
args1
  RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts

-- | Parse the given command line arguments/options with the given cmdargs mode,
-- after adding values to any valueless --debug flags,
-- with debug logging showing the given description of this parsing pass
-- (useful when cmdargsParse is called more than once).
-- If parsing fails, exit the program with an informative error message.
cmdargsParse :: String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse :: String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse String
desc Mode RawOpts
m [String]
args0 = Mode RawOpts -> [String] -> Either String RawOpts
forall a. Mode a -> [String] -> Either String a
process Mode RawOpts
m ([String] -> [String]
ensureDebugFlagHasVal [String]
args0)
  Either String RawOpts
-> (Either String RawOpts -> RawOpts) -> RawOpts
forall a b. a -> (a -> b) -> b
& (String -> RawOpts)
-> (RawOpts -> RawOpts) -> Either String RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\String
e -> String -> RawOpts
forall a. String -> a
error' (String -> RawOpts) -> String -> RawOpts
forall a b. (a -> b) -> a -> b
$ String
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" while parsing these args " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
quoteIfNeeded [String]
args0))
    (Int -> String -> RawOpts -> RawOpts
forall a. Int -> String -> a -> a
traceOrLogAt Int
verboseDebugLevel (String
"cmdargs: parsing " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
args0))

-- | cmdargs does not allow flags (options) to appear before the subcommand argument.
-- We prefer to hide this restriction from the user, making the CLI more forgiving.
-- So this tries to move flags, and their values if any, after the command argument.
-- It also returns the (possibly empty) command argument and the other arguments,
-- separately for convenience.
--
-- Detecting the command argument is tricky because of the flexibility of traditional flag syntax.
-- Short flags can be joined together, some flags can have a value or no value,
-- flags and values can be separated by =, a space, or nothing, etc.
--
-- We make a best-effort attempt like so:
-- whether a flag argument (- or -- followed by a non-space character and zero or more others),
-- and its following argument, are movable, falls into these cases, to be checked in this order:
--
-- - it exactly matches a known short or long no-value flag; move it
-- - it exactly matches a short or long requires-value flag; move it and the following argument
-- - it exactly matches a short optional-value flag; assume these don't exist or we don't have any
-- - it exactly matches a long optional-value flag; assume there's no value, move it
-- - it begins with a short requires-value flag; the value is joined to it, move it
-- - it begins with a long requires-value flag followed by =; likewise
-- - it begins with a long optional-value flag followed by =; likewise
--
-- Notes:
--
-- - This hackery increases the risk of misleading errors, bugs, and confusion.
--   But it should be fairly robust now, being aware of all builtin flags.
--
-- - All general and builtin command flags (and their values) will be moved. It's clearer to
--   write command flags after the command, but if not we'll handle it (for greater robustness).
--
-- - Long flags should be spelled in full; abbreviated long flags may not be moved.
--
-- - Unknown flags (from addons) are assumed to be valueless or have a joined value,
--   and will be moved - but later rejected by cmdargs.
--   Instead these should be written to the right of a "--" argument, which hides them.
--
moveFlagsAfterCommand :: [String] -> (String, [String], [String])
moveFlagsAfterCommand :: [String] -> (String, [String], [String])
moveFlagsAfterCommand [String]
args =
  case ([String], [String]) -> ([String], [String])
moveFlagArgs ([String]
args, []) of
    ([],[String]
as)                      -> (String
"", [String]
as, [String]
as)
    (unmoved :: [String]
unmoved@((Char
'-':String
_):[String]
_), [String]
moved) -> (String
"", [String]
as, [String]
as) where as :: [String]
as = [String]
unmoved[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
moved
    (String
cmdarg:[String]
unmoved, [String]
moved)      -> (String
cmdarg, [String]
as, String
cmdargString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as) where as :: [String]
as = [String]
unmoved[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
moved
  where
    moveFlagArgs :: ([String], [String]) -> ([String], [String])
    moveFlagArgs :: ([String], [String]) -> ([String], [String])
moveFlagArgs ((String
a:String
b:[String]
cs), [String]
moved)
      | String -> String -> Int
isMovableFlagArg String
a String
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = ([String], [String]) -> ([String], [String])
moveFlagArgs ([String]
cs, [String]
moved[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
a,String
b])
      | String -> String -> Int
isMovableFlagArg String
a String
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = ([String], [String]) -> ([String], [String])
moveFlagArgs (String
bString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cs, [String]
moved[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
a])
      | Bool
otherwise                 = (String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
bString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cs, [String]
moved)
      where
        -- Is this a short or long flag argument that should be moved,
        -- and is its following argument a value that also should be moved ?
        -- Returns:
        -- 0 (not a flag; don't move this argument)
        -- 1 (a valueless flag, or a long flag with joined argument, or multiple joined valueless short flags; move this argument)
        -- 2 (a short or long flag with a value in the next argument; move this and next argument).
        isMovableFlagArg :: String -> String -> Int
        isMovableFlagArg :: String -> String -> Int
isMovableFlagArg String
a1 String
a2
          | String
a1 String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
noValFlagArgs  = Int
1  -- short or long no-val flag
          | String
a1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--debug" Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
isDebugValue String
a2) = Int
1  --debug without a value
          | String
a1 String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reqValFlagArgs = Int
2  -- short or long req-val flag (or --debug) with a separate value
          | String
a1 String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
optValFlagArgs = Int
1  -- long (or short ?) opt-val flag, assume no value
          | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a1) [String]
shortReqValFlagArgs = Int
1  -- short req-val flag with a joined value
               -- or possibly multiple joined valueless short flags, we won't move those correctly
          | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a1) [String]
longReqValFlagArgs_ = Int
1  -- long req-val flag (or --debug) with a joined value
          | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a1) [String]
longOptValFlagArgs_ = Int
1  -- long opt-val flag with a joined value
          -- | isLongFlagArg a1 && any (takeWhile (/='=') `isPrefixOf`) longReqValFlagArgs_ ... -- try to move abbreviated long flags ?
          | String -> Bool
isFlagArg String
a1 = Int
1    -- an addon flag (or mistyped flag) we don't know, assume no value or value is joined
          | Bool
otherwise = Int
0    -- not a flag
    moveFlagArgs ([String]
as, [String]
moved)       = ([String]
as, [String]
moved)

-- Is this string a valid --debug value ?
isDebugValue :: String -> Bool
isDebugValue String
s = Either (ParseErrorBundle Text HledgerParseErrorData) Text -> Bool
forall a b. Either a b -> Bool
isRight (Either (ParseErrorBundle Text HledgerParseErrorData) Text -> Bool)
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
-> Bool
forall a b. (a -> b) -> a -> b
$ Parsec HledgerParseErrorData Text Text
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
forall e a.
Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
parsewith Parsec HledgerParseErrorData Text Text
forall {m :: * -> *}. TextParser m Text
isdebugvalp (Text -> Either (ParseErrorBundle Text HledgerParseErrorData) Text)
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s
  where isdebugvalp :: TextParser m Text
isdebugvalp = ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-') ParsecT HledgerParseErrorData Text m (Maybe Char)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isDigit ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m Text
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT HledgerParseErrorData Text m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof :: TextParser m Text

-- Flag arguments are command line arguments beginning with - or --
-- (followed by a short of long flag name, and possibly joined short flags or a joined value).
isFlagArg, isShortFlagArg, isLongFlagArg :: String -> Bool
isFlagArg :: String -> Bool
isFlagArg String
a = String -> Bool
isShortFlagArg String
a Bool -> Bool -> Bool
|| String -> Bool
isLongFlagArg String
a

isShortFlagArg :: String -> Bool
isShortFlagArg (Char
'-':Char
c:String
_) = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-'
isShortFlagArg String
_         = Bool
False

isLongFlagArg :: String -> Bool
isLongFlagArg (Char
'-':Char
'-':Char
_:String
_) = Bool
True
isLongFlagArg String
_             = Bool
False

-- | Add the leading hyphen(s) to a short or long flag name.
toFlagArg :: Name -> String
toFlagArg :: String -> String
toFlagArg String
f = if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
f else String
"--"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
f

-- | Flatten a possibly multi-named Flag to (name, FlagInfo) pairs.
toFlagInfos :: Flag RawOpts -> [(Name, FlagInfo)]
toFlagInfos :: Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos Flag RawOpts
f = [(String
n,FlagInfo
i) | let i :: FlagInfo
i = Flag RawOpts -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo Flag RawOpts
f, String
n <- Flag RawOpts -> [String]
forall a. Flag a -> [String]
flagNames Flag RawOpts
f]

-- | Is this flag's value optional ?
isOptVal :: FlagInfo -> Bool
isOptVal :: FlagInfo -> Bool
isOptVal = \case
  FlagOpt String
_     -> Bool
True
  FlagOptRare String
_ -> Bool
True
  FlagInfo
_             -> Bool
False

-- | All the general flags defined in hledger's main mode.
generalFlags :: [Flag RawOpts]
generalFlags :: [Flag RawOpts]
generalFlags = ((String, [Flag RawOpts]) -> [Flag RawOpts])
-> [(String, [Flag RawOpts])] -> [Flag RawOpts]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Flag RawOpts]) -> [Flag RawOpts]
forall a b. (a, b) -> b
snd [(String, [Flag RawOpts])]
groupNamed [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Flag RawOpts]
groupHidden [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Flag RawOpts]
groupUnnamed
  where Group{[(String, [Flag RawOpts])]
[Flag RawOpts]
groupUnnamed :: forall a. Group a -> [a]
groupNamed :: forall a. Group a -> [(String, [a])]
groupHidden :: forall a. Group a -> [a]
groupNamed :: [(String, [Flag RawOpts])]
groupHidden :: [Flag RawOpts]
groupUnnamed :: [Flag RawOpts]
..} = Mode RawOpts -> Group (Flag RawOpts)
forall a. Mode a -> Group (Flag a)
modeGroupFlags (Mode RawOpts -> Group (Flag RawOpts))
-> Mode RawOpts -> Group (Flag RawOpts)
forall a b. (a -> b) -> a -> b
$ [String] -> Mode RawOpts
mainmode []  

-- | All the general flag names.
generalFlagNames :: [Name]
generalFlagNames :: [String]
generalFlagNames = (Flag RawOpts -> [String]) -> [Flag RawOpts] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [String]
forall a. Flag a -> [String]
flagNames [Flag RawOpts]
generalFlags

-- | All hledger's builtin subcommand-specific flags.
commandFlags :: [Flag RawOpts]
commandFlags :: [Flag RawOpts]
commandFlags = (Mode RawOpts -> [Flag RawOpts])
-> [Mode RawOpts] -> [Flag RawOpts]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Group (Flag RawOpts) -> [Flag RawOpts]
forall a. Group a -> [a]
groupUnnamed(Group (Flag RawOpts) -> [Flag RawOpts])
-> (Mode RawOpts -> Group (Flag RawOpts))
-> Mode RawOpts
-> [Flag RawOpts]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Mode RawOpts -> Group (Flag RawOpts)
forall a. Mode a -> Group (Flag a)
modeGroupFlags) [Mode RawOpts]
commandModes
  where
    commandModes :: [Mode RawOpts]
commandModes = ((String, [Mode RawOpts]) -> [Mode RawOpts])
-> [(String, [Mode RawOpts])] -> [Mode RawOpts]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Mode RawOpts]) -> [Mode RawOpts]
forall a b. (a, b) -> b
snd [(String, [Mode RawOpts])]
groupNamed [Mode RawOpts] -> [Mode RawOpts] -> [Mode RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Mode RawOpts]
groupUnnamed [Mode RawOpts] -> [Mode RawOpts] -> [Mode RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Mode RawOpts]
groupHidden
      where Group{[(String, [Mode RawOpts])]
[Mode RawOpts]
groupUnnamed :: forall a. Group a -> [a]
groupNamed :: forall a. Group a -> [(String, [a])]
groupHidden :: forall a. Group a -> [a]
groupNamed :: [(String, [Mode RawOpts])]
groupUnnamed :: [Mode RawOpts]
groupHidden :: [Mode RawOpts]
..} = Mode RawOpts -> Group (Mode RawOpts)
forall a. Mode a -> Group (Mode a)
modeGroupModes (Mode RawOpts -> Group (Mode RawOpts))
-> Mode RawOpts -> Group (Mode RawOpts)
forall a b. (a -> b) -> a -> b
$ [String] -> Mode RawOpts
mainmode []

-- | The names of general options flags, grouped by whether they expect a value.
-- There may be some overlaps with command flag names.
noValGeneralFlagNames, reqValGeneralFlagNames, optValGeneralFlagNames :: [Name]
noValGeneralFlagNames :: [String]
noValGeneralFlagNames  = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
generalFlags, FlagInfo
i FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagNone]
reqValGeneralFlagNames :: [String]
reqValGeneralFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
generalFlags, FlagInfo
i FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagReq]
optValGeneralFlagNames :: [String]
optValGeneralFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
generalFlags, FlagInfo -> Bool
isOptVal FlagInfo
i]

-- | The names of builtin subcommand flags, grouped by whether they expect a value.
-- There may be some overlaps with general flag names.
noValCommandFlagNames, reqValCommandFlagNames, optValCommandFlagNames :: [Name]
noValCommandFlagNames :: [String]
noValCommandFlagNames  = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
commandFlags, FlagInfo
i FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagNone]
reqValCommandFlagNames :: [String]
reqValCommandFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
commandFlags, FlagInfo
i FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagReq]
optValCommandFlagNames :: [String]
optValCommandFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
commandFlags, FlagInfo -> Bool
isOptVal FlagInfo
i]

-- All flag arguments understood by hledger cli and builtin commands, grouped by whether they expect a value.
-- Any command flags which have the same name as a general flag are excluded.
noValFlagArgs :: [String]
noValFlagArgs  = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toFlagArg ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
noValGeneralFlagNames  [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([String]
noValCommandFlagNames  [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
generalFlagNames)
reqValFlagArgs :: [String]
reqValFlagArgs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toFlagArg ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
reqValGeneralFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([String]
reqValCommandFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
generalFlagNames)
optValFlagArgs :: [String]
optValFlagArgs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toFlagArg ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
optValGeneralFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([String]
optValCommandFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
generalFlagNames)

-- Short flag args that expect a required value.
shortReqValFlagArgs :: [String]
shortReqValFlagArgs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isShortFlagArg [String]
reqValFlagArgs

-- Long flag args that expect a required value, with = appended.
longReqValFlagArgs_ :: [String]
longReqValFlagArgs_ = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"=") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isLongFlagArg [String]
reqValFlagArgs

-- Long flag args that expect an optional value, with = appended.
longOptValFlagArgs_ :: [String]
longOptValFlagArgs_ = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"=") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isLongFlagArg [String]
optValFlagArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--debug"]

-- Drop any arguments which look like cli-specific options (--no-conf, --conf CONFFILE, etc.)
-- Keep synced with mainmode's groupUnnamed.
dropCliSpecificOpts :: [String] -> [String]
dropCliSpecificOpts :: [String] -> [String]
dropCliSpecificOpts = \case
  String
"--conf":String
_:[String]
as                   -> [String] -> [String]
dropCliSpecificOpts [String]
as
  String
a:[String]
as | String
"--conf=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a -> [String] -> [String]
dropCliSpecificOpts [String]
as
  String
"--no-conf":[String]
as                  -> [String] -> [String]
dropCliSpecificOpts [String]
as
  String
"-n":[String]
as                         -> [String] -> [String]
dropCliSpecificOpts [String]
as
  String
a:[String]
as                            -> String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String] -> [String]
dropCliSpecificOpts [String]
as
  []                              -> []

-- | Given a hledger cmdargs mode and a list of command line arguments, try to drop any of the
-- arguments which seem to be flags not supported by this mode. Also drop their values if any.
--
-- >>> dropUnsupportedOpts confflagsmode ["--debug","1","-f","file"]
-- []
-- >>> dropUnsupportedOpts confflagsmode ["--debug","-f","file"]
-- []
dropUnsupportedOpts :: Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts :: Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
m = \case
  []   -> []
  String
"--debug":String
a:[String]
as | Bool -> Bool
not (Mode RawOpts
m Mode RawOpts -> String -> Bool
forall {a}. Mode a -> String -> Bool
`supportsFlag` String
"debug") ->
    [String] -> [String]
go ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ if String -> Bool
isDebugValue String
a then [String]
as else String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as
  String
a:[String]
as -> if
    | String -> Bool
isLongFlagArg String
a,
      let f :: String
f = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'=') String
a,
      let as' :: [String]
as' = if String -> Bool
isReqValFlagArg String
f Bool -> Bool -> Bool
&& Char
'=' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
a then Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
as else [String]
as
      -> if Mode RawOpts
m Mode RawOpts -> String -> Bool
forall {a}. Mode a -> String -> Bool
`supportsFlag` String
f then String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
go [String]
as else [String] -> [String]
go [String]
as'
    | String -> Bool
isShortFlagArg String
a,
      let f :: String
f = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
a,
      let as' :: [String]
as' = if String -> Bool
isReqValFlagArg String
f Bool -> Bool -> Bool
&& String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
as else [String]
as
      -> if Mode RawOpts
m Mode RawOpts -> String -> Bool
forall {a}. Mode a -> String -> Bool
`supportsFlag` String
f then String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
go [String]
as else [String] -> [String]
go [String]
as'
    | Bool
otherwise -> String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
m [String]
as
  where
    go :: [String] -> [String]
go = Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
m
    isReqValFlagArg :: String -> Bool
isReqValFlagArg = (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reqValFlagArgs)
    supportsFlag :: Mode a -> String -> Bool
supportsFlag Mode a
m1 String
flagarg = String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
flagarg ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toFlagArg ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Flag a -> [String]) -> [Flag a] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag a -> [String]
forall a. Flag a -> [String]
flagNames ([Flag a] -> [String]) -> [Flag a] -> [String]
forall a b. (a -> b) -> a -> b
$ Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeAndSubmodeFlags Mode a
m1

-- | Get all the flags defined in a mode or its immediate subcommands,
-- whether in named, unnamed or hidden groups.
-- Does not recurse into subsubcommands,
-- and does not deduplicate (general flags are repeated on all hledger subcommands).
modeAndSubmodeFlags :: Mode a -> [Flag a]
modeAndSubmodeFlags :: forall a. Mode a -> [Flag a]
modeAndSubmodeFlags m :: Mode a
m@Mode{modeGroupModes :: forall a. Mode a -> Group (Mode a)
modeGroupModes=Group{[(String, [Mode a])]
[Mode a]
groupUnnamed :: forall a. Group a -> [a]
groupNamed :: forall a. Group a -> [(String, [a])]
groupHidden :: forall a. Group a -> [a]
groupUnnamed :: [Mode a]
groupHidden :: [Mode a]
groupNamed :: [(String, [Mode a])]
..}} =
  Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags Mode a
m [Flag a] -> [Flag a] -> [Flag a]
forall a. Semigroup a => a -> a -> a
<> (Mode a -> [Flag a]) -> [Mode a] -> [Flag a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags (((String, [Mode a]) -> [Mode a])
-> [(String, [Mode a])] -> [Mode a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Mode a]) -> [Mode a]
forall a b. (a, b) -> b
snd [(String, [Mode a])]
groupNamed [Mode a] -> [Mode a] -> [Mode a]
forall a. Semigroup a => a -> a -> a
<> [Mode a]
groupUnnamed [Mode a] -> [Mode a] -> [Mode a]
forall a. Semigroup a => a -> a -> a
<> [Mode a]
groupHidden)

-- unit tests (tests_Hledger_Cli) are defined in Hledger.Cli.Commands