{-|

Common cmdargs modes and flags, a command-line options type, and
related utilities used by hledger commands.

-}

{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE PackageImports      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE NamedFieldPuns #-}

module Hledger.Cli.CliOptions (
  progname,
  prognameandversion,
  binaryinfo,

  -- * cmdargs flags & modes
  inputflags,
  reportflags,
  helpflags,
  terminalflags,
  helpflagstitle,
  flattreeflags,
  confflags,
  hiddenflags,
  hiddenflagsformainmode,
  -- outputflags,
  outputFormatFlag,
  outputFileFlag,
  generalflagsgroup1,
  generalflagsgroup2,
  generalflagsgroup3,
  mkgeneralflagsgroups1,
  mkgeneralflagsgroups2,
  mkgeneralflagsgroups3,
  cligeneralflagsgroups1,
  cligeneralflagsgroups2,
  cligeneralflagsgroups3,
  defMode,
  defCommandMode,
  addonCommandMode,
  hledgerCommandMode,
  argsFlag,
  showModeUsage,
  withAliases,
  likelyExecutablesInPath,

  -- * CLI options
  CliOpts(..),
  HasCliOpts(..),
  defcliopts,
  getHledgerCliOpts,
  getHledgerCliOpts',
  rawOptsToCliOpts,
  cliOptsDropArgs,
  argsAddDoubleDash,
  outputFormats,
  defaultOutputFormat,
  CommandHelpStr,
  parseCommandHelp,

  -- possibly these should move into argsToCliOpts
  -- * CLI option accessors
  -- | These do the extra processing required for some options.
  journalFilePathFromOpts,
  journalFilePathFromOptsNoDefault,
  rulesFilePathFromOpts,
  outputFileFromOpts,
  outputFormatFromOpts,
  defaultWidth,
  replaceNumericFlags,
  ensureDebugFlagHasVal,
  -- | For register:
  registerWidthsFromOpts,

  -- * Other utils
  topicForMode,

--  -- * Convenience re-exports
--  module Data.String.Here,
--  module System.Console.CmdArgs.Explicit,
)
where

import qualified Control.Exception as C
import Control.Monad (when)
import Data.Char
import Data.Default
import Data.List.Extra (intercalate, isInfixOf, nubSort)
import qualified Data.List.NonEmpty as NE (NonEmpty, fromList, nonEmpty)
import Data.List.Split (splitOn)
import Data.Maybe
--import Data.String.Here
-- import Data.Text (Text)
import qualified Data.Text as T
import Data.Void (Void)
import GitHash (tGitInfoCwdTry)
import Safe
import String.ANSI
import System.Console.CmdArgs hiding (Default,def)
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Text
import System.Directory
import System.Environment
import System.Exit (exitSuccess)
import System.FilePath
import System.Info (os)
import Text.Megaparsec
import Text.Megaparsec.Char

import Hledger
import Hledger.Cli.DocFiles
import Hledger.Cli.Version
import Data.Time.Clock.POSIX (POSIXTime)
import Data.List (isPrefixOf, isSuffixOf)


-- | The name of this program's executable.
progname :: ProgramName
progname :: String
progname = String
"hledger"

-- | Generate the version string for this program.
-- The template haskell call is here rather than in Hledger.Cli.Version to avoid wasteful recompilation.
prognameandversion :: String
prognameandversion :: String
prognameandversion =
  Either String GitInfo -> Bool -> String -> String -> String
versionStringWith
  $$String
String -> Either String GitInfo
forall a b. a -> Either a b
tGitInfoCwdTry
#ifdef GHCDEBUG
  True
#else
  Bool
False
#endif
  String
progname
  String
packageversion

binaryinfo :: HledgerBinaryInfo
Right HledgerBinaryInfo
binaryinfo = String -> Either String HledgerBinaryInfo
parseHledgerVersion String
prognameandversion
-- ui and web use nullbinaryinfo for a parse failure here to silence an inexhaustive pattern warning.
-- I can't reproduce that warning right now, so here I've stuck with the original approach,
-- which will force a compile error if prognameandversion is ever malformed, eg from unexpected
-- git output.

-- Common options.
-- keep synced: the docs macro in doc/common.m4

-- | Common input-related flags: --file, --rules, --conf, --alias...
inputflags :: [Flag RawOpts]
inputflags :: [Flag RawOpts]
inputflags = [
   [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"file",String
"f"]      (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"file" String
s RawOpts
opts) String
"[FMT:]FILE" String
"Read data from FILE, or from stdin if FILE is -, inferring format from extension or a FMT: prefix. Can be specified more than once. If not specified, reads from $LEDGER_FILE or $HOME/.hledger.journal."
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"rules"]         (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"rules" String
s RawOpts
opts) String
"RULESFILE" String
"Use rules defined in this rules file for converting subsequent CSV/SSV/TSV files. If not specified, uses FILE.csv.rules for each FILE.csv."  -- see also hiddenflags

  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"alias"]         (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"alias" String
s RawOpts
opts)  String
"A=B|/RGX/=RPL" String
"transform account names from A to B, or by replacing regular expression matches"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"auto"]          (String -> RawOpts -> RawOpts
setboolopt String
"auto") String
"generate extra postings by applying auto posting rules (\"=\") to all transactions"
  ,String
-> [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"" [String
"forecast"]    (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"forecast" String
s RawOpts
opts) String
"PERIOD" ([String] -> String
unwords
    [ String
"Generate extra transactions from periodic rules (\"~\"),"
    , String
"from after the latest ordinary transaction until 6 months from now. Or, during the specified PERIOD (the equals is required)."
    , String
"Auto posting rules will also be applied to these transactions."
    , String
"In hledger-ui, also make future-dated transactions visible at startup."
    ])
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"ignore-assertions",String
"I"] (String -> RawOpts -> RawOpts
setboolopt String
"ignore-assertions") String
"don't check balance assertions by default"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"infer-costs"] (String -> RawOpts -> RawOpts
setboolopt String
"infer-costs") String
"infer conversion equity postings from costs"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"infer-equity"] (String -> RawOpts -> RawOpts
setboolopt String
"infer-equity") String
"infer costs from conversion equity postings"
  -- history of this flag so far, lest we be confused:
  --  originally --infer-value
  --  2021-02 --infer-market-price added, --infer-value deprecated
  --  2021-09
  --   --infer-value hidden
  --   --infer-market-price renamed to --infer-market-prices, old spelling still works
  --   ReportOptions{infer_value_} renamed to infer_prices_, BalancingOpts{infer_prices_} renamed to infer_transaction_prices_
  --   some related prices command changes
  --    --costs deprecated and hidden, uses --infer-market-prices instead
  --    --inverted-costs renamed to --infer-reverse-prices
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"infer-market-prices"] (String -> RawOpts -> RawOpts
setboolopt String
"infer-market-prices") String
"infer market prices from costs"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"pivot"]         (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"pivot" String
s RawOpts
opts)  String
"TAGNAME" String
"use a different field or tag as account names"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"strict",String
"s"]    (String -> RawOpts -> RawOpts
setboolopt String
"strict") String
"do extra error checks (and override -I)"

  -- generating transactions/postings
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"verbose-tags"]  (String -> RawOpts -> RawOpts
setboolopt String
"verbose-tags") String
"add tags indicating generated/modified data"
  ]

-- | Common report-related flags: --period, --cost, etc.
reportflags :: [Flag RawOpts]
reportflags :: [Flag RawOpts]
reportflags = [

  -- report period, interval, dates
  [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"begin",String
"b"]     (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"begin" String
s RawOpts
opts) String
"DATE" String
"include postings/transactions on/after this date"
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"end",String
"e"]       (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"end" String
s RawOpts
opts) String
"DATE" String
"include postings/transactions before this date (with a report interval, will be adjusted to following subperiod end)"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"daily",String
"D"]     (String -> RawOpts -> RawOpts
setboolopt String
"daily")     String
"set report interval: 1 day"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"weekly",String
"W"]    (String -> RawOpts -> RawOpts
setboolopt String
"weekly")    String
"set report interval: 1 week"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"monthly",String
"M"]   (String -> RawOpts -> RawOpts
setboolopt String
"monthly")   String
"set report interval: 1 month"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"quarterly",String
"Q"] (String -> RawOpts -> RawOpts
setboolopt String
"quarterly") String
"set report interval: 1 quarter"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"yearly",String
"Y"]    (String -> RawOpts -> RawOpts
setboolopt String
"yearly")    String
"set report interval: 1 year"
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"period",String
"p"]    (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"period" String
s RawOpts
opts) String
"PERIODEXP" String
"set begin date, end date, and/or report interval, with more flexibility"
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"today"]         (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"today" String
s RawOpts
opts) String
"DATE" String
"override today's date (affects relative dates)"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"date2"]         (String -> RawOpts -> RawOpts
setboolopt String
"date2") String
"match/use secondary dates instead (deprecated)"  -- see also hiddenflags

  -- status/realness/zero/depth filters
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"unmarked",String
"U"]  (String -> RawOpts -> RawOpts
setboolopt String
"unmarked") String
"include only unmarked postings/transactions"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"pending",String
"P"]   (String -> RawOpts -> RawOpts
setboolopt String
"pending")  String
"include only pending postings/transactions"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"cleared",String
"C"]   (String -> RawOpts -> RawOpts
setboolopt String
"cleared")  String
"include only cleared postings/transactions\n(-U/-P/-C can be combined)"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"real",String
"R"]      (String -> RawOpts -> RawOpts
setboolopt String
"real")     String
"include only non-virtual postings"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"empty",String
"E"]     (String -> RawOpts -> RawOpts
setboolopt String
"empty") String
"Show zero items, which are normally hidden.\nIn hledger-ui & hledger-web, do the opposite."
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"depth"]         (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"depth" String
s RawOpts
opts) String
"DEPTHEXP" String
"if a number (or -NUM): show only top NUM levels of accounts. If REGEXP=NUM, only apply limiting to accounts matching the regular expression."

  -- valuation
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"B",String
"cost"]      (String -> RawOpts -> RawOpts
setboolopt String
"B") String
"convert amounts to their cost/sale amount (@/@@)"
    -- ^ no "valuation mode:" prefix for this one, it's not mutually exclusive
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"V",String
"market"]    (String -> RawOpts -> RawOpts
setboolopt String
"V")
    ([String] -> String
unwords
      [String
valuationprefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"show amounts converted to market value at period end(s) in their default valuation commodity."
      ,String
"Short for --value=end."
      ])
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"X",String
"exchange"]   (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"X" String
s RawOpts
opts) String
"COMM"
    ([String] -> String
unwords
      [String
valuationprefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"show amounts converted to market value at period end(s) in the specified commodity."
      ,String
"Short for --value=end,COMM."
      ])
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"value"]         (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"value" String
s RawOpts
opts) String
"WHEN[,COMM]"
    ([String] -> String
unlines
      [String
valuationprefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"show amounts converted to market value on the specified date(s) in their default valuation commodity or a specified commodity. WHEN can be:"
      ,String
"'then':     value on transaction dates"
      ,String
"'end':      value at period end(s)"
      ,String
"'now':      value today"
      ,String
"YYYY-MM-DD: value on given date"
      ])

  -- display
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"commodity-style", String
"c"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"commodity-style" String
s RawOpts
opts) String
"S"
    String
"Override a commodity's display style.\nEg: -c '$1000.' or -c '1.000,00 EUR'"
 ,String
-> [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a.
String -> [String] -> Update a -> String -> String -> Flag a
flagOpt String
"yes" [String
"pretty"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"pretty" String
s RawOpts
opts) String
"YN"
    String
"Use box-drawing characters in text output? The optional 'y'/'yes' or 'n'/'no' arg requires =."
 ]
  where
    valuationprefix :: String
valuationprefix = String
"valuation mode: "

helpflags :: [Flag RawOpts]
helpflags :: [Flag RawOpts]
helpflags = [
  [String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"help",String
"h"] (String -> RawOpts -> RawOpts
setboolopt String
"help")    String
"show command line help"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"tldr"]     (String -> RawOpts -> RawOpts
setboolopt String
"tldr")    String
"show command examples with tldr"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"info"]     (String -> RawOpts -> RawOpts
setboolopt String
"info")    String
"show the manual with info"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"man"]      (String -> RawOpts -> RawOpts
setboolopt String
"man")     String
"show the manual with man"
 ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"version"]  (String -> RawOpts -> RawOpts
setboolopt String
"version") String
"show version information"
  -- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL] in help.
  -- But flagReq plus special handling in Cli.hs makes the = optional, removing a source of confusion.
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"debug"]    (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"debug" String
s RawOpts
opts) String
"[1-9]" String
"show this much debug output (default: 1)"
 ] -- XXX why are these duplicated in defCommandMode below ?
 [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Flag RawOpts]
terminalflags

-- Low-level flags affecting terminal output.
-- These are included in helpflags so they appear everywhere.
terminalflags :: [Flag RawOpts]
terminalflags = [
  [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"pager"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"pager" String
s RawOpts
opts) String
"YN"
   String
"use a pager when needed ? y/yes (default) or n/no"

  -- keep synced with hledger-lib:colorOption:
 ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"color",String
"colour"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"color" String
s RawOpts
opts) String
"YNA"
   String
"use ANSI color ? y/yes, n/no, or auto (default)"
 ]

-- | Flags for selecting flat/tree mode, used for reports organised by account.
-- With a True argument, shows some extra help about inclusive/exclusive amounts.
flattreeflags :: Bool -> [Flag RawOpts]
flattreeflags :: Bool -> [Flag RawOpts]
flattreeflags Bool
showamounthelp = [
   [String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"flat",String
"l"] (String -> RawOpts -> RawOpts
setboolopt String
"flat")
     (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"show accounts as a flat list (default)"
      String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
showamounthelp then String
". Amounts exclude subaccount amounts, except where the account is depth-clipped." else String
"")
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"tree",String
"t"] (String -> RawOpts -> RawOpts
setboolopt String
"tree")
    (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"show accounts as a tree" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
showamounthelp then String
". Amounts include subaccount amounts." else String
"")
  ]
  where
    prefix :: String
prefix = String
"list/tree mode: "

-- | hledger CLI's --conf/--no-conf flags.
confflags :: [Flag RawOpts]
confflags = [
   [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq [String
"conf"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"conf" String
s RawOpts
opts) String
"CONFFILE"
      String
"Use extra options defined in this config file. If not specified, searches upward and in XDG config dir for hledger.conf (or .hledger.conf in $HOME)."
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"no-conf",String
"n"] (String -> RawOpts -> RawOpts
setboolopt String
"no-conf") String
"ignore any config file"
  ]

-- | Common legacy flags that are accepted but not shown in --help, when running the main mode.
hiddenflagsformainmode :: [Flag RawOpts]
hiddenflagsformainmode :: [Flag RawOpts]
hiddenflagsformainmode = [
   [String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"effective",String
"aux-date"] (String -> RawOpts -> RawOpts
setboolopt String
"date2") String
"Ledger-compatible aliases for --date2"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"infer-value"]          (String -> RawOpts -> RawOpts
setboolopt String
"infer-market-prices") String
"legacy flag that was renamed"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"pretty-tables"]        (String -> String -> RawOpts -> RawOpts
setopt String
"pretty" String
"always") String
"legacy flag that was renamed"
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"anon"]                 (String -> RawOpts -> RawOpts
setboolopt String
"anon") String
"deprecated, renamed to --obfuscate"  -- #2133, handled by anonymiseByOpts
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"obfuscate"]            (String -> RawOpts -> RawOpts
setboolopt String
"obfuscate") String
"slightly obfuscate hledger's output. Warning, does not give privacy. Formerly --anon."  -- #2133, handled by maybeObfuscate
  ,[String] -> (RawOpts -> RawOpts) -> String -> Flag RawOpts
forall a. [String] -> (a -> a) -> String -> Flag a
flagNone [String
"timeclock-old"]        (String -> RawOpts -> RawOpts
setboolopt String
"oldtimeclock") String
"don't pair timeclock entries by account name"
  ,[String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq  [String
"rules-file"]           (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"rules" String
s RawOpts
opts) String
"RULESFILE" String
"was renamed to --rules"
  ]

-- Hidden flags accepted but not shown, when running subcommand or addon command modes.
-- Here we add the confflags, so their presence won't cause an error,
hiddenflags :: [Flag RawOpts]
hiddenflags :: [Flag RawOpts]
hiddenflags = [Flag RawOpts]
hiddenflagsformainmode [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
confflags

-- | Common output-related flags: --output-file, --output-format...

-- outputflags = [outputFormatFlag, outputFileFlag]

outputFormatFlag :: [String] -> Flag RawOpts
outputFormatFlag :: [String] -> Flag RawOpts
outputFormatFlag [String]
fmts = [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
  [String
"output-format",String
"O"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"output-format" String
s RawOpts
opts) String
"FMT"
  (String
"select the output format. Supported formats:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
fmts String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".")

-- This has special support in hledger-lib:outputFileOption, keep synced
outputFileFlag :: Flag RawOpts
outputFileFlag :: Flag RawOpts
outputFileFlag = [String] -> Update RawOpts -> String -> String -> Flag RawOpts
forall a. [String] -> Update a -> String -> String -> Flag a
flagReq
  [String
"output-file",String
"o"] (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"output-file" String
s RawOpts
opts) String
"FILE"
  String
"write output to FILE. A file extension matching one of the above formats selects that format."

argsFlag :: FlagHelp -> Arg RawOpts
argsFlag :: String -> Arg RawOpts
argsFlag = Update RawOpts -> String -> Arg RawOpts
forall a. Update a -> String -> Arg a
flagArg (\String
s RawOpts
opts -> RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either String RawOpts)
-> RawOpts -> Either String RawOpts
forall a b. (a -> b) -> a -> b
$ String -> String -> RawOpts -> RawOpts
setopt String
"args" String
s RawOpts
opts)

generalflagstitle :: String
generalflagstitle :: String
generalflagstitle = String
"\nGeneral flags"

-- Several subsets of the standard general flags, as a single list. Old API used by some addons.
generalflagsgroup1, generalflagsgroup2, generalflagsgroup3 :: (String, [Flag RawOpts])
generalflagsgroup1 :: (String, [Flag RawOpts])
generalflagsgroup1 = (String
generalflagstitle, [Flag RawOpts]
inputflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
reportflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
helpflags)
generalflagsgroup2 :: (String, [Flag RawOpts])
generalflagsgroup2 = (String
generalflagstitle, [Flag RawOpts]
inputflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
helpflags)
generalflagsgroup3 :: (String, [Flag RawOpts])
generalflagsgroup3 = (String
generalflagstitle, [Flag RawOpts]
helpflags)

-- Helpers to make several subsets of the standard general flags, in separate groups. The help flags are parameterised. 2024.
mkgeneralflagsgroups1, mkgeneralflagsgroups2, mkgeneralflagsgroups3 :: [Flag RawOpts] -> [(String, [Flag RawOpts])]
mkgeneralflagsgroups1 :: [Flag RawOpts] -> [(String, [Flag RawOpts])]
mkgeneralflagsgroups1 [Flag RawOpts]
helpflags' = [
   (String
inputflagstitle,  [Flag RawOpts]
inputflags)
  ,(String
outputflagstitle, [Flag RawOpts]
reportflags)
  ,(String
helpflagstitle,   [Flag RawOpts]
helpflags')
  ]
mkgeneralflagsgroups2 :: [Flag RawOpts] -> [(String, [Flag RawOpts])]
mkgeneralflagsgroups2 [Flag RawOpts]
helpflags' = [
   (String
inputflagstitle, [Flag RawOpts]
inputflags)
  ,(String
helpflagstitle, [Flag RawOpts]
helpflags')
  ]
mkgeneralflagsgroups3 :: [Flag RawOpts] -> [(String, [Flag RawOpts])]
mkgeneralflagsgroups3 [Flag RawOpts]
helpflags' = [
   (String
helpflagstitle, [Flag RawOpts]
helpflags')
  ]

inputflagstitle :: String
inputflagstitle  = String
"\nGeneral input/data transformation flags"
outputflagstitle :: String
outputflagstitle = String
"\nGeneral output/reporting flags (supported by some commands)"
helpflagstitle :: String
helpflagstitle   = String
"\nGeneral help flags"

-- Several subsets of the standard general flags plus CLI help flags, as separate groups.
cligeneralflagsgroups1, cligeneralflagsgroups2, cligeneralflagsgroups3 :: [(String, [Flag RawOpts])]
cligeneralflagsgroups1 :: [(String, [Flag RawOpts])]
cligeneralflagsgroups1 = [Flag RawOpts] -> [(String, [Flag RawOpts])]
mkgeneralflagsgroups1 [Flag RawOpts]
helpflags
cligeneralflagsgroups2 :: [(String, [Flag RawOpts])]
cligeneralflagsgroups2 = [Flag RawOpts] -> [(String, [Flag RawOpts])]
mkgeneralflagsgroups2 [Flag RawOpts]
helpflags
cligeneralflagsgroups3 :: [(String, [Flag RawOpts])]
cligeneralflagsgroups3 = [Flag RawOpts] -> [(String, [Flag RawOpts])]
mkgeneralflagsgroups3 [Flag RawOpts]
helpflags


-- cmdargs mode constructors

-- | An empty cmdargs mode to use as a template.
-- Modes describe the top-level command, ie the program, or a subcommand,
-- telling cmdargs how to parse a command line and how to
-- generate the command's usage text.
defMode :: Mode RawOpts
defMode :: Mode RawOpts
defMode = Mode {
  modeNames :: [String]
modeNames       = []            -- program/command name(s)
 ,modeHelp :: String
modeHelp        = String
""            -- short help for this command
 ,modeHelpSuffix :: [String]
modeHelpSuffix  = []            -- text displayed after the usage
 ,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags  = Group {       -- description of flags accepted by the command
    groupNamed :: [(String, [Flag RawOpts])]
groupNamed   = []             --  named groups of flags
   ,groupUnnamed :: [Flag RawOpts]
groupUnnamed = []             --  ungrouped flags
   ,groupHidden :: [Flag RawOpts]
groupHidden  = []             --  flags not displayed in the usage
   }
 ,modeArgs :: ([Arg RawOpts], Maybe (Arg RawOpts))
modeArgs        = ([], Maybe (Arg RawOpts)
forall a. Maybe a
Nothing) -- description of arguments accepted by the command
 ,modeValue :: RawOpts
modeValue       = RawOpts
forall a. Default a => a
def           -- value returned when this mode is used to parse a command line
 ,modeCheck :: RawOpts -> Either String RawOpts
modeCheck       = RawOpts -> Either String RawOpts
forall a b. b -> Either a b
Right         -- whether the mode's value is correct
 ,modeReform :: RawOpts -> Maybe [String]
modeReform      = Maybe [String] -> RawOpts -> Maybe [String]
forall a b. a -> b -> a
const Maybe [String]
forall a. Maybe a
Nothing -- function to convert the value back to a command line arguments
 ,modeExpandAt :: Bool
modeExpandAt    = Bool
True          -- expand @ arguments for program ?
 ,modeGroupModes :: Group (Mode RawOpts)
modeGroupModes  = [Mode RawOpts] -> Group (Mode RawOpts)
forall a. [a] -> Group a
toGroup []    -- sub-modes
 }

-- | A cmdargs mode suitable for a hledger built-in command
-- with the given names (primary name + optional aliases).
-- The usage message shows [QUERY] as argument.
defCommandMode :: [Name] -> Mode RawOpts
defCommandMode :: [String] -> Mode RawOpts
defCommandMode [String]
names = Mode RawOpts
defMode {
   modeNames=names
  ,modeGroupFlags  = Group {
     groupNamed   = []
    ,groupUnnamed = [
        flagNone ["help"] (setboolopt "help") "show command-line help"
       ,flagNone ["man"]  (setboolopt "man")  "show this program's user manual with man"
       ,flagNone ["info"] (setboolopt "info") "show this program's user manual with info"
      ]
    ,groupHidden  = []             --  flags not displayed in the usage
    }
  ,modeArgs = ([], Just $ argsFlag "[QUERY]")
  ,modeValue=setopt "command" (headDef "" names) def
  }

-- | A cmdargs mode representing the hledger add-on command with the
-- given name, providing hledger's common input/reporting/help flags.
-- Just used when invoking addons.
addonCommandMode :: Name -> Mode RawOpts
addonCommandMode :: String -> Mode RawOpts
addonCommandMode String
nam = ([String] -> Mode RawOpts
defCommandMode [String
nam]) {
   modeHelp = ""
     -- XXX not needed ?
     -- fromMaybe "" $ lookup (stripAddonExtension name) [
     --   ("addon"        , "dummy add-on command for testing")
     --  ,("addon2"       , "dummy add-on command for testing")
     --  ,("addon3"       , "dummy add-on command for testing")
     --  ,("addon4"       , "dummy add-on command for testing")
     --  ,("addon5"       , "dummy add-on command for testing")
     --  ,("addon6"       , "dummy add-on command for testing")
     --  ,("addon7"       , "dummy add-on command for testing")
     --  ,("addon8"       , "dummy add-on command for testing")
     --  ,("addon9"       , "dummy add-on command for testing")
     --  ]
  ,modeGroupFlags = Group {
      groupUnnamed = []
     ,groupHidden  = hiddenflags
     ,groupNamed   = cligeneralflagsgroups1
     }
  }

-- | A command's name, optional official abbreviation, and help preamble & postamble,
-- as a specially formatted single string. Used to generate the CLI help, and also
-- the command's doc in the hledger manual. See parseCommandHelp for the format.
type CommandHelpStr = String

-- | A command's documentation. Used both as part of CLI help, and as
-- part of the hledger manual. See parseCommandHelpStr.
data CommandHelp = CommandHelp {
   CommandHelp -> String
cmdName           :: Name        -- the official command name
  ,CommandHelp -> Maybe String
mcmdShortName     :: Maybe Name  -- optional official name abbreviation
  ,CommandHelp -> String
cmdHelpPreamble   :: String      -- help preamble, shown before flags help
  ,CommandHelp -> String
cmdHelpPostamble ::  String      -- help postamble, shown after flags help
} deriving (Int -> CommandHelp -> String -> String
[CommandHelp] -> String -> String
CommandHelp -> String
(Int -> CommandHelp -> String -> String)
-> (CommandHelp -> String)
-> ([CommandHelp] -> String -> String)
-> Show CommandHelp
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CommandHelp -> String -> String
showsPrec :: Int -> CommandHelp -> String -> String
$cshow :: CommandHelp -> String
show :: CommandHelp -> String
$cshowList :: [CommandHelp] -> String -> String
showList :: [CommandHelp] -> String -> String
Show)

-- | Build a cmdarg mode for a hledger command,
-- from a help template and flag/argument specifications.
-- Reduces boilerplate a little, though the complicated cmdargs
-- flag and argument specs are still required.
hledgerCommandMode :: CommandHelpStr -> [Flag RawOpts] -> [(String, [Flag RawOpts])]
  -> [Flag RawOpts] -> ([Arg RawOpts], Maybe (Arg RawOpts)) -> Mode RawOpts
hledgerCommandMode :: String
-> [Flag RawOpts]
-> [(String, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode String
helpstr [Flag RawOpts]
unnamedflaggroup [(String, [Flag RawOpts])]
namedflaggroups [Flag RawOpts]
hiddenflaggroup ([Arg RawOpts], Maybe (Arg RawOpts))
argsdescr =
  case String -> Maybe CommandHelp
parseCommandHelp String
helpstr of
    Maybe CommandHelp
Nothing -> String -> Mode RawOpts
forall a. String -> a
error' (String -> Mode RawOpts) -> String -> Mode RawOpts
forall a b. (a -> b) -> a -> b
$ String
"could not parse command doc:\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
helpstrString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"  -- PARTIAL:
    Just CommandHelp{String
cmdName :: CommandHelp -> String
cmdName :: String
cmdName, Maybe String
mcmdShortName :: CommandHelp -> Maybe String
mcmdShortName :: Maybe String
mcmdShortName, String
cmdHelpPreamble :: CommandHelp -> String
cmdHelpPreamble :: String
cmdHelpPreamble, String
cmdHelpPostamble :: CommandHelp -> String
cmdHelpPostamble :: String
cmdHelpPostamble} ->
      ([String] -> Mode RawOpts
defCommandMode ([String] -> Mode RawOpts) -> [String] -> Mode RawOpts
forall a b. (a -> b) -> a -> b
$ String
cmdName String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
mcmdShortName) {
         modeHelp        = cmdHelpPreamble
        ,modeHelpSuffix  = lines cmdHelpPostamble
        ,modeGroupFlags  = Group {
            groupUnnamed = unnamedflaggroup
           ,groupNamed   = namedflaggroups
           ,groupHidden  = hiddenflaggroup
           }
        ,modeArgs        = argsdescr
        }

-- | Parse a command's embedded help text (@Somecommand.txt@).
-- That text is generated by @Shake cmdhelp@ from the command's doc source (@Somecommand.md@).
-- @Somecommand.md@ should be formatted as follows:
--
-- - First line: the command name, as a markdown heading.
--
-- - Optional third line: the command's official abbreviated name, parenthesised.
--
-- - From third or fifth line to a @```flags@ line: the command help preamble.
--   Usually one sentence or paragraph; any blank lines will not be rendered.
--
-- - A fenced code block beginning with @```flags@, containing a @Flags:@ line,
--   followed by a snapshot of the command-specific flags help as generated by cmdargs
--   or "none" if there are no command-specific flags.
--   This should contain no blank lines (no extra newlines in the cmdargs command mode help strings).
--   This is shown as-is in manuals, and regenerated at runtime for --help output.
--
-- - Any remaining lines: the command help postamble.
--
-- (Note the difference between
-- @Somecommand.md@, which is the markdown source file, and
-- @Somecommand.txt@, which is the plain text file generated by @Shake cmdhelp@,
-- which this function parses.)
--
parseCommandHelp :: CommandHelpStr -> Maybe CommandHelp
parseCommandHelp :: String -> Maybe CommandHelp
parseCommandHelp String
t =
  case String -> [String]
lines String
t of
    [] -> Maybe CommandHelp
forall a. Maybe a
Nothing
    (String
l1:String
_:String
l3:[String]
ls) -> CommandHelp -> Maybe CommandHelp
forall a. a -> Maybe a
Just (CommandHelp -> Maybe CommandHelp)
-> CommandHelp -> Maybe CommandHelp
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> String -> String -> CommandHelp
CommandHelp String
cmdname (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmdalias then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
cmdalias) String
preamble String
postamble
      where
        cmdname :: String
cmdname = String
l1
        (String
cmdalias, [String]
rest) =
          if String
"(" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
l3 Bool -> Bool -> Bool
&& String
")" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
l3
          then (Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
1 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. HasCallStack => [a] -> [a]
init String
l3, [String]
ls)
          else ([], String
l3String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ls)
        ([String]
preamblels, [String]
rest2) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Flags:") ([String] -> ([String], [String]))
-> [String] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
rest
        postamblels :: [String]
postamblels = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not(Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
rest2
        preamble :: String
preamble = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse [String]
preamblels
        postamble :: String
postamble = [String] -> String
unlines [String]
postamblels
    [String]
_ -> Maybe CommandHelp
forall a. Maybe a
Nothing  -- error' "misformatted command help text file"

-- | Get a mode's usage message as a nicely wrapped string.
showModeUsage :: Mode a -> String
showModeUsage :: forall a. Mode a -> String
showModeUsage =
  String -> String
highlightHelp (String -> String) -> (Mode a -> String) -> Mode a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (TextFormat -> [Text] -> String
showText TextFormat
defaultWrap :: [Text] -> String) ([Text] -> String) -> (Mode a -> [Text]) -> Mode a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ([String] -> HelpFormat -> Mode a -> [Text]
forall a. [String] -> HelpFormat -> Mode a -> [Text]
helpText [] HelpFormat
HelpFormatDefault :: Mode a -> [Text])

-- | Add some ANSI decoration to cmdargs' help output.
highlightHelp :: String -> String
highlightHelp
  | Bool -> Bool
not Bool
useColorOnStdoutUnsafe = String -> String
forall a. a -> a
id   -- XXX unsafe boldening help headings - seems to work, even respecting config file
  | Bool
otherwise = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> String -> String) -> [Integer] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Integer, String) -> String) -> Integer -> String -> String
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Integer, String) -> String
forall {a}. (Eq a, Num a) => (a, String) -> String
f) [Integer
1..] ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  where
    f :: (a, String) -> String
f (a
n,String
l)
      | a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
1 = String -> String
bold String
l
      | String -> Bool
isHelpHeading String
l = String -> String
bold String
l
      | Bool
otherwise = String
l
    -- keep synced with Hledger.Cli.mainmode:
    isHelpHeading :: String -> Bool
isHelpHeading String
l = Char -> Bool
isAlphaNum (Char -> String -> Char
forall a. a -> [a] -> a
headDef Char
' ' String
l) Bool -> Bool -> Bool
&& (Char -> String -> Char
forall a. a -> [a] -> a
lastDef Char
' ' String
l Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':')
      -- any s (`isPrefixOf` s) [
      --    "General input flags"
      --   ,"General reporting flags"
      --   ,"General help flags"
      --   ,"Flags"
      --   ,"General flags"
      --   ,"Examples"
      --   ]
-- | Get the most appropriate documentation topic for a mode.
-- Currently, that is either the hledger, hledger-ui or hledger-web
-- manual.
topicForMode :: Mode a -> Topic
topicForMode :: forall a. Mode a -> String
topicForMode Mode a
m
  | String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hledger-ui"  = String
"ui"
  | String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"hledger-web" = String
"web"
  | Bool
otherwise          = String
"cli"
  where n :: String
n = String -> [String] -> String
forall a. a -> [a] -> a
headDef String
"" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Mode a -> [String]
forall a. Mode a -> [String]
modeNames Mode a
m

-- | Add command aliases to the command's help string.
withAliases :: String -> [String] -> String
String
s withAliases :: String -> [String] -> String
`withAliases` []     = String
s
String
s `withAliases` [String]
as = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
-- s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")"
-- s `withAliases` as     = s ++ " (aliases: " ++ intercalate ", " as ++ ")"


-- CliOpts

-- | Command line options, used in the @hledger@ package and above.
-- This is the \"opts\" used throughout hledger CLI code.
-- representing the options and arguments that were provided at
-- startup on the command-line.
data CliOpts = CliOpts {
     CliOpts -> RawOpts
rawopts_         :: RawOpts
    ,CliOpts -> String
command_         :: String
    ,CliOpts -> [String]
file_            :: [FilePath]
    ,CliOpts -> InputOpts
inputopts_       :: InputOpts
    ,CliOpts -> ReportSpec
reportspec_      :: ReportSpec
    ,CliOpts -> Maybe String
output_file_     :: Maybe FilePath
    ,CliOpts -> Maybe String
output_format_   :: Maybe String
    ,CliOpts -> Maybe Bool
pageropt_        :: Maybe Bool     -- ^ --pager
    ,CliOpts -> Maybe YNA
coloropt_        :: Maybe YNA      -- ^ --color. Controls use of ANSI color and ANSI styles.
    ,CliOpts -> Int
debug_           :: Int            -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'.
    ,CliOpts -> Bool
no_new_accounts_ :: Bool           -- add
    ,CliOpts -> Maybe String
width_           :: Maybe String   -- ^ the --width value provided, if any
    ,CliOpts -> Int
available_width_ :: Int            -- ^ estimated usable screen width, based on
                                        -- 1. the width reported by the terminal, if supported
                                        -- 2. the default (80)
    ,CliOpts -> POSIXTime
progstarttime_   :: POSIXTime      -- system POSIX time at start
 } deriving (Int -> CliOpts -> String -> String
[CliOpts] -> String -> String
CliOpts -> String
(Int -> CliOpts -> String -> String)
-> (CliOpts -> String)
-> ([CliOpts] -> String -> String)
-> Show CliOpts
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> CliOpts -> String -> String
showsPrec :: Int -> CliOpts -> String -> String
$cshow :: CliOpts -> String
show :: CliOpts -> String
$cshowList :: [CliOpts] -> String -> String
showList :: [CliOpts] -> String -> String
Show)

instance Default CliOpts where def :: CliOpts
def = CliOpts
defcliopts

defcliopts :: CliOpts
defcliopts :: CliOpts
defcliopts = CliOpts
    { rawopts_ :: RawOpts
rawopts_         = RawOpts
forall a. Default a => a
def
    , command_ :: String
command_         = String
""
    , file_ :: [String]
file_            = []
    , inputopts_ :: InputOpts
inputopts_       = InputOpts
definputopts
    , reportspec_ :: ReportSpec
reportspec_      = ReportSpec
forall a. Default a => a
def
    , output_file_ :: Maybe String
output_file_     = Maybe String
forall a. Maybe a
Nothing
    , output_format_ :: Maybe String
output_format_   = Maybe String
forall a. Maybe a
Nothing
    , pageropt_ :: Maybe Bool
pageropt_        = Maybe Bool
forall a. Maybe a
Nothing
    , coloropt_ :: Maybe YNA
coloropt_        = Maybe YNA
forall a. Maybe a
Nothing
    , debug_ :: Int
debug_           = Int
0
    , no_new_accounts_ :: Bool
no_new_accounts_ = Bool
False
    , width_ :: Maybe String
width_           = Maybe String
forall a. Maybe a
Nothing
    , available_width_ :: Int
available_width_ = Int
defaultWidth
    , progstarttime_ :: POSIXTime
progstarttime_   = POSIXTime
0
    }

-- | Default width for hledger console output, when not otherwise specified.
defaultWidth :: Int
defaultWidth :: Int
defaultWidth = Int
80

-- | Replace any numeric flags (eg -2) with their long form (--depth 2),
-- as I'm guessing cmdargs doesn't support this directly.
replaceNumericFlags :: [String] -> [String]
replaceNumericFlags :: [String] -> [String]
replaceNumericFlags = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
replace
  where
    replace :: String -> String
replace (Char
'-':String
ds) | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
ds = String
"--depth="String -> String -> String
forall a. [a] -> [a] -> [a]
++String
ds
    replace String
s = String
s

-- Convert a valueless --debug flag to one with a value.
-- See also the --debug flag definition in CliOptions.hs.
-- This makes an equals sign unnecessary with this optional-value flag.
ensureDebugFlagHasVal :: [String] -> [String]
ensureDebugFlagHasVal :: [String] -> [String]
ensureDebugFlagHasVal [String]
as = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"--debug") [String]
as of
  ([String]
bs,String
"--debug":String
c:[String]
cs) | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
c Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
c) -> [String]
bs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++String
"--debug=1" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
ensureDebugFlagHasVal (String
cString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cs)
  ([String]
bs,[String
"--debug"])                                    -> [String]
bs[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
"--debug=1"]
  ([String], [String])
_                                                   -> [String]
as

-- | Parse raw option string values to the desired final data types.
-- Any relative smart dates will be converted to fixed dates based on
-- today's date. Parsing failures will raise an error.
-- Also records the terminal width, if supported.
rawOptsToCliOpts :: RawOpts -> IO CliOpts
rawOptsToCliOpts :: RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts = do
  Day
currentDay <- IO Day
getCurrentDay
  let
    day :: Day
day = case String -> RawOpts -> Maybe String
maybestringopt String
"today" RawOpts
rawopts of
            Maybe String
Nothing -> Day
currentDay
            Just String
d  -> (HledgerParseErrors -> Day)
-> (EFDay -> Day) -> Either HledgerParseErrors EFDay -> Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Day -> HledgerParseErrors -> Day
forall a b. a -> b -> a
const Day
err) EFDay -> Day
fromEFDay (Either HledgerParseErrors EFDay -> Day)
-> Either HledgerParseErrors EFDay -> Day
forall a b. (a -> b) -> a -> b
$ Day -> Text -> Either HledgerParseErrors EFDay
fixSmartDateStrEither' Day
currentDay (String -> Text
T.pack String
d)
              where err :: Day
err = String -> Day
forall a. String -> a
error' (String -> Day) -> String -> Day
forall a b. (a -> b) -> a -> b
$ String
"Unable to parse date \"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\""
    command :: String
command = String -> RawOpts -> String
stringopt String
"command" RawOpts
rawopts
    moutputformat :: Maybe String
moutputformat = String -> RawOpts -> Maybe String
maybestringopt String
"output-format" RawOpts
rawopts
    postingaccttags :: Bool
postingaccttags = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
command String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"print" Bool -> Bool -> Bool
&& Maybe String
moutputformat Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
"beancount"
  Bool
usecolor <- IO Bool
useColorOnStdout
  let iopts :: InputOpts
iopts = Day -> Bool -> Bool -> RawOpts -> InputOpts
rawOptsToInputOpts Day
day Bool
usecolor Bool
postingaccttags RawOpts
rawopts
  ReportSpec
rspec <- (String -> IO ReportSpec)
-> (ReportSpec -> IO ReportSpec)
-> Either String ReportSpec
-> IO ReportSpec
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO ReportSpec
forall a. String -> a
error' ReportSpec -> IO ReportSpec
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ReportSpec -> IO ReportSpec)
-> Either String ReportSpec -> IO ReportSpec
forall a b. (a -> b) -> a -> b
$ Day -> Bool -> RawOpts -> Either String ReportSpec
rawOptsToReportSpec Day
day Bool
usecolor RawOpts
rawopts  -- PARTIAL:
  Maybe Int
mtermwidth <- IO (Maybe Int)
getTerminalWidth
  let availablewidth :: Int
availablewidth = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
defaultWidth Maybe Int
mtermwidth
  CliOpts -> IO CliOpts
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CliOpts
defcliopts {
              rawopts_         = rawopts
             ,command_         = command
             ,file_            = listofstringopt "file" rawopts
             ,inputopts_       = iopts
             ,reportspec_      = rspec
             ,output_file_     = maybestringopt "output-file" rawopts
             ,output_format_   = moutputformat
             ,pageropt_        = maybeynopt "pager" rawopts
             ,coloropt_        = maybeynaopt "color" rawopts
             ,debug_           = posintopt "debug" rawopts
             ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add
             ,width_           = maybestringopt "width" rawopts
             ,available_width_ = availablewidth
             }

-- | Drop the arguments ("args") from this CliOpts' rawopts field.
cliOptsDropArgs :: CliOpts -> CliOpts
cliOptsDropArgs :: CliOpts -> CliOpts
cliOptsDropArgs copts :: CliOpts
copts@CliOpts{RawOpts
rawopts_ :: CliOpts -> RawOpts
rawopts_ :: RawOpts
rawopts_} = CliOpts
copts{rawopts_ = dropRawOpt "args" rawopts_}

-- | cmdargs eats the first double-dash (--) argument when parsing a command line,
-- which causes problems for the run and repl commands.
-- Sometimes we work around this by duplicating that first -- argument.
-- This doesn't break anything that we know of yet.
argsAddDoubleDash :: [a] -> [a]
argsAddDoubleDash [a]
args'
  | a
"--" a -> [a] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
args' = let ([a]
as,[a]
bs) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
"--") [a]
args' in [a]
as [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
"--"] [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a]
bs
  | Bool
otherwise = [a]
args'

-- | A helper for addon commands: this parses options and arguments from
-- the current command line using the given hledger-style cmdargs mode,
-- and returns a CliOpts. Or, with --help or -h present, it prints
-- long or short help, and exits the program.
-- When --debug is present, also prints some debug output.
-- Note this is not used by the main hledger executable.
--
-- The help texts are generated from the mode.
-- Long help includes the full usage description generated by cmdargs
-- (including all supported options), framed by whatever pre- and postamble
-- text the mode specifies. It's intended that this forms a complete
-- help document or manual.
--
-- Short help is a truncated version of the above: the preamble and
-- the first part of the usage, up to the first line containing "flags:"
-- (normally this marks the start of the common hledger flags);
-- plus a mention of --help and the (presumed supported) common
-- hledger options not displayed.
--
-- Tips:
-- Empty lines in the pre/postamble are removed by cmdargs;
-- add a space character to preserve them.
--
getHledgerCliOpts' :: Mode RawOpts -> [String] -> IO CliOpts
getHledgerCliOpts' :: Mode RawOpts -> [String] -> IO CliOpts
getHledgerCliOpts' Mode RawOpts
mode' [String]
args0 = do
  let rawopts :: RawOpts
rawopts = (String -> RawOpts)
-> (RawOpts -> RawOpts) -> Either String RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> RawOpts
forall a. String -> a
usageError RawOpts -> RawOpts
forall a. a -> a
id (Either String RawOpts -> RawOpts)
-> Either String RawOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [String] -> Either String RawOpts
forall a. Mode a -> [String] -> Either String a
process Mode RawOpts
mode' [String]
args0
  CliOpts
opts <- RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts
  [String] -> CliOpts -> IO ()
debugArgs [String]
args0 CliOpts
opts
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> RawOpts -> Bool
boolopt String
"help" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr String
shorthelp IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
  -- when (boolopt "help" $ rawopts_ opts) $ putStr longhelp  >> exitSuccess
  CliOpts -> IO CliOpts
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CliOpts
opts
  where
    longhelp :: String
longhelp = Mode RawOpts -> String
forall a. Mode a -> String
showModeUsage Mode RawOpts
mode'
    shorthelp :: String
shorthelp =
      [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
        ([String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"flags:" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
longhelp)
        [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [String
""
        ,String
"  See also hledger -h for general hledger options."
        ]
    -- | Print debug info about arguments and options if --debug is present.
    -- XXX use standard dbg helpers
    debugArgs :: [String] -> CliOpts -> IO ()
    debugArgs :: [String] -> CliOpts -> IO ()
debugArgs [String]
args1 CliOpts
opts =
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
"--debug" String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String
progname' <- IO String
getProgName
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"running: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
progname'
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"raw args: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall a. Show a => a -> String
show [String]
args1
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"processed opts:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ CliOpts -> String
forall a. Show a => a -> String
show CliOpts
opts
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"search query: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Query -> String
forall a. Show a => a -> String
show (ReportSpec -> Query
_rsQuery (ReportSpec -> Query) -> ReportSpec -> Query
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)

getHledgerCliOpts :: Mode RawOpts -> IO CliOpts
getHledgerCliOpts :: Mode RawOpts -> IO CliOpts
getHledgerCliOpts Mode RawOpts
mode' = do
  [String]
args' <- 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
  Mode RawOpts -> [String] -> IO CliOpts
getHledgerCliOpts' Mode RawOpts
mode' [String]
args'

-- CliOpts accessors

-- | Get the (tilde-expanded, absolute) journal file path from
-- 1. options, 2. an environment variable, or 3. the default.
-- Actually, returns one or more file paths. There will be more
-- than one if multiple -f options were provided.
-- File paths can have a READER: prefix naming a reader/data format.
journalFilePathFromOpts :: CliOpts -> IO (NE.NonEmpty String)
journalFilePathFromOpts :: CliOpts -> IO (NonEmpty String)
journalFilePathFromOpts CliOpts
opts = do
  Maybe (NonEmpty String)
mbpaths <- CliOpts -> IO (Maybe (NonEmpty String))
journalFilePathFromOptsNoDefault CliOpts
opts
  case Maybe (NonEmpty String)
mbpaths of
    Just NonEmpty String
paths -> NonEmpty String -> IO (NonEmpty String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NonEmpty String
paths
    Maybe (NonEmpty String)
Nothing -> do
      String
f <- IO String
defaultJournalPath
      NonEmpty String -> IO (NonEmpty String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty String -> IO (NonEmpty String))
-> NonEmpty String -> IO (NonEmpty String)
forall a b. (a -> b) -> a -> b
$ [String] -> NonEmpty String
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [String
f]

-- | Like journalFilePathFromOpts, but does not use defaultJournalPath
journalFilePathFromOptsNoDefault :: CliOpts -> IO (Maybe (NE.NonEmpty String))
journalFilePathFromOptsNoDefault :: CliOpts -> IO (Maybe (NonEmpty String))
journalFilePathFromOptsNoDefault CliOpts
opts = do
  String
d <- IO String
getCurrentDirectory
  case [String] -> Maybe (NonEmpty String)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([String] -> Maybe (NonEmpty String))
-> [String] -> Maybe (NonEmpty String)
forall a b. (a -> b) -> a -> b
$ CliOpts -> [String]
file_ CliOpts
opts of
    Maybe (NonEmpty String)
Nothing -> Maybe (NonEmpty String) -> IO (Maybe (NonEmpty String))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (NonEmpty String)
forall a. Maybe a
Nothing
    Just NonEmpty String
paths -> NonEmpty String -> Maybe (NonEmpty String)
forall a. a -> Maybe a
Just (NonEmpty String -> Maybe (NonEmpty String))
-> IO (NonEmpty String) -> IO (Maybe (NonEmpty String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO String) -> NonEmpty String -> IO (NonEmpty String)
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) -> NonEmpty a -> m (NonEmpty b)
mapM (String -> String -> IO String
expandPathPreservingPrefix String
d) NonEmpty String
paths

expandPathPreservingPrefix :: FilePath -> PrefixedFilePath -> IO PrefixedFilePath
expandPathPreservingPrefix :: String -> String -> IO String
expandPathPreservingPrefix String
d String
prefixedf = do
  let (Maybe StorageFormat
p,String
f) = String -> (Maybe StorageFormat, String)
splitReaderPrefix String
prefixedf
  String
f' <- String -> String -> IO String
expandPath String
d String
f
  String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ case Maybe StorageFormat
p of
    Just StorageFormat
p'  -> (StorageFormat -> String
forall a. Show a => a -> String
show StorageFormat
p') String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f'
    Maybe StorageFormat
Nothing -> String
f'

-- | Get the expanded, absolute output file path specified by an
-- -o/--output-file options, or nothing, meaning stdout.
outputFileFromOpts :: CliOpts -> IO (Maybe FilePath)
outputFileFromOpts :: CliOpts -> IO (Maybe String)
outputFileFromOpts CliOpts
opts = do
  String
d <- IO String
getCurrentDirectory
  case CliOpts -> Maybe String
output_file_ CliOpts
opts of
    Maybe String
Nothing -> Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
    Just String
f  -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO String
expandPath String
d String
f

defaultOutputFormat :: String
defaultOutputFormat :: String
defaultOutputFormat = String
"txt"

-- | All the output formats known by any command, for outputFormatFromOpts.
-- To automatically infer it from -o/--output-file, it needs to be listed here.
outputFormats :: [String]
outputFormats :: [String]
outputFormats = [String
defaultOutputFormat, String
"beancount", String
"csv", String
"json", String
"html", String
"sql", String
"tsv", String
"fods"]

-- | Get the output format from the --output-format option,
-- otherwise from a recognised file extension in the --output-file option,
-- otherwise the default (txt).
outputFormatFromOpts :: CliOpts -> String
outputFormatFromOpts :: CliOpts -> String
outputFormatFromOpts CliOpts
opts =
  case CliOpts -> Maybe String
output_format_ CliOpts
opts of
    Just String
f  -> String
f
    Maybe String
Nothing ->
      case String -> String
filePathExtension (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> Maybe String
output_file_ CliOpts
opts of
        Just String
ext | String
ext String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
outputFormats -> String
ext
        Maybe String
_                                   -> String
defaultOutputFormat

-- -- | Get the file name without its last extension, from a file path.
-- filePathBaseFileName :: FilePath -> String
-- filePathBaseFileName = fst . splitExtension . snd . splitFileName

-- | Get the last file extension, without the dot, from a file path.
-- May return the null string.
filePathExtension :: FilePath -> String
filePathExtension :: String -> String
filePathExtension = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
splitExtension (String -> (String, String))
-> (String -> String) -> String -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> b
snd ((String, String) -> String)
-> (String -> (String, String)) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String, String)
splitFileName

-- | Get the (tilde-expanded) rules file path from options, if any.
rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
rulesFilePathFromOpts :: CliOpts -> IO (Maybe String)
rulesFilePathFromOpts CliOpts
opts = do
  String
d <- IO String
getCurrentDirectory
  IO (Maybe String)
-> (String -> IO (Maybe String))
-> Maybe String
-> IO (Maybe String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing) ((String -> Maybe String) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (IO String -> IO (Maybe String))
-> (String -> IO String) -> String -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO String
expandPath String
d) (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ InputOpts -> Maybe String
mrules_file_ (InputOpts -> Maybe String) -> InputOpts -> Maybe String
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
opts

-- | Get the width in characters to use for the register command's console output,
-- and also the description column width if specified (following the main width, comma-separated).
-- The widths will be as follows:
-- @
-- no --width flag - overall width is the available width (or terminal width, or 80); description width is unspecified (auto)
-- --width W       - overall width is W, description width is auto
-- --width W,D     - overall width is W, description width is D
-- @
-- Will raise a parse error for a malformed --width argument.
registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts{width_ :: CliOpts -> Maybe String
width_=Maybe String
Nothing, available_width_ :: CliOpts -> Int
available_width_=Int
w} = (Int
w, Maybe Int
forall a. Maybe a
Nothing)
registerWidthsFromOpts CliOpts{width_ :: CliOpts -> Maybe String
width_=Just String
s}  =
    case Parsec Void String (Int, Maybe Int)
-> String
-> String
-> Either (ParseErrorBundle String Void) (Int, Maybe Int)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void String (Int, Maybe Int)
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT Void s m (Int, Maybe Int)
registerwidthp String
"(unknown)" String
s of
        Left ParseErrorBundle String Void
e   -> String -> (Int, Maybe Int)
forall a. String -> a
usageError (String -> (Int, Maybe Int)) -> String -> (Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ String
"could not parse width option: "String -> String -> String
forall a. [a] -> [a] -> [a]
++ParseErrorBundle String Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
errorBundlePretty ParseErrorBundle String Void
e
        Right (Int, Maybe Int)
ws -> (Int, Maybe Int)
ws
    where
        registerwidthp :: (Stream s, Char ~ Token s) => ParsecT Void s m (Int, Maybe Int)
        registerwidthp :: forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT Void s m (Int, Maybe Int)
registerwidthp = do
          Int
totalwidth <- String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ParsecT Void s m String -> ParsecT Void s m Int
forall a b. (a -> b) -> ParsecT Void s m a -> ParsecT Void s m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT Void s m Char -> ParsecT Void s m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void s m Char
ParsecT Void s m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
          Maybe Int
descwidth <- ParsecT Void s m Int -> ParsecT Void s m (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token s -> ParsecT Void s m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token s
',' ParsecT Void s m Char
-> ParsecT Void s m Int -> ParsecT Void s m Int
forall a b.
ParsecT Void s m a -> ParsecT Void s m b -> ParsecT Void s m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ParsecT Void s m String -> ParsecT Void s m Int
forall a b. (a -> b) -> ParsecT Void s m a -> ParsecT Void s m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT Void s m Char -> ParsecT Void s m String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void s m Char
ParsecT Void s m (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
          ParsecT Void s m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
          (Int, Maybe Int) -> ParsecT Void s m (Int, Maybe Int)
forall a. a -> ParsecT Void s m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
totalwidth, Maybe Int
descwidth)

-- Other utils

-- None of https://hackage.haskell.org/package/directory-1.3.8.1/docs/System-Directory.html#g:5
-- do quite what we need (find all the executables in PATH with a filename prefix).
-- | Get all sorted unique filenames in the current user's PATH.
-- We do not currently filter out non-file objects or files without execute permission.
likelyExecutablesInPath :: IO [String]
likelyExecutablesInPath :: IO [String]
likelyExecutablesInPath = do
  [String]
pathdirs <- String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
pathsep (String -> [String]) -> IO String -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO String
getEnvSafe String
"PATH"
  [String]
pathfiles <- [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> IO [String]) -> [String] -> IO [[String]]
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) -> [a] -> m [b]
mapM String -> IO [String]
getDirectoryContentsSafe [String]
pathdirs
  [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
nubSort [String]
pathfiles
  where pathsep :: String
pathsep = if String
os String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"mingw32" then String
";" else String
":"
--
-- Exclude directories and files without execute permission:
-- this would do a stat for each hledger-* file found, which is probably ok.
-- But it needs file paths, not just file names.
--
-- exes'  <- filterM doesFileExist exe'
-- exes'' <- filterM isExecutable exes'
-- return exes''
-- where isExecutable f = getPermissions f >>= (return . executable)

getEnvSafe :: String -> IO String
getEnvSafe :: String -> IO String
getEnvSafe String
v = String -> IO String
getEnv String
v IO String -> (IOException -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"") -- XXX should catch only isDoesNotExistError e

getDirectoryContentsSafe :: FilePath -> IO [String]
getDirectoryContentsSafe :: String -> IO [String]
getDirectoryContentsSafe String
d =
    ((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
".",String
".."])) ([String] -> [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO [String]
getDirectoryContents String
d) IO [String] -> (IOException -> IO [String]) -> IO [String]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])

-- ** Lenses

makeHledgerClassyLenses ''CliOpts

instance HasInputOpts CliOpts where
    inputOpts :: Lens' CliOpts InputOpts
inputOpts = (InputOpts -> f InputOpts) -> CliOpts -> f CliOpts
forall c. HasCliOpts c => Lens' c InputOpts
Lens' CliOpts InputOpts
inputopts

instance HasBalancingOpts CliOpts where
    balancingOpts :: Lens' CliOpts BalancingOpts
balancingOpts = (InputOpts -> f InputOpts) -> CliOpts -> f CliOpts
forall c. HasInputOpts c => Lens' c InputOpts
Lens' CliOpts InputOpts
inputOpts((InputOpts -> f InputOpts) -> CliOpts -> f CliOpts)
-> ((BalancingOpts -> f BalancingOpts) -> InputOpts -> f InputOpts)
-> (BalancingOpts -> f BalancingOpts)
-> CliOpts
-> f CliOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BalancingOpts -> f BalancingOpts) -> InputOpts -> f InputOpts
forall c. HasBalancingOpts c => Lens' c BalancingOpts
Lens' InputOpts BalancingOpts
balancingOpts

instance HasReportSpec CliOpts where
    reportSpec :: Lens' CliOpts ReportSpec
reportSpec = (ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts
forall c. HasCliOpts c => Lens' c ReportSpec
Lens' CliOpts ReportSpec
reportspec

instance HasReportOptsNoUpdate CliOpts where
    reportOptsNoUpdate :: Lens' CliOpts ReportOpts
reportOptsNoUpdate = (ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts
forall c. HasReportSpec c => Lens' c ReportSpec
Lens' CliOpts ReportSpec
reportSpec((ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts)
-> ((ReportOpts -> f ReportOpts) -> ReportSpec -> f ReportSpec)
-> (ReportOpts -> f ReportOpts)
-> CliOpts
-> f CliOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ReportOpts -> f ReportOpts) -> ReportSpec -> f ReportSpec
forall c. HasReportOptsNoUpdate c => Lens' c ReportOpts
Lens' ReportSpec ReportOpts
reportOptsNoUpdate

instance HasReportOpts CliOpts where
    reportOpts :: ReportableLens' CliOpts ReportOpts
reportOpts = (ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts
forall c. HasReportSpec c => Lens' c ReportSpec
Lens' CliOpts ReportSpec
reportSpec((ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts)
-> ((ReportOpts -> f ReportOpts) -> ReportSpec -> f ReportSpec)
-> (ReportOpts -> f ReportOpts)
-> CliOpts
-> f CliOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ReportOpts -> f ReportOpts) -> ReportSpec -> f ReportSpec
forall a. HasReportOpts a => ReportableLens' a ReportOpts
ReportableLens' ReportSpec ReportOpts
reportOpts