{-|

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       #-}

module Hledger.Cli.CliOptions (
  progname,
  prognameandversion,

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

  -- * CLI options
  CliOpts(..),
  HasCliOpts(..),
  defcliopts,
  getHledgerCliOpts,
  getHledgerCliOpts',
  rawOptsToCliOpts,
  outputFormats,
  defaultOutputFormat,
  CommandDoc,

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

  -- * Other utils
  hledgerAddons,
  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.Either (fromRight, isRight)
import Data.List.Extra (groupSortOn, intercalate, isInfixOf, nubSort)
import qualified Data.List.NonEmpty as NE (NonEmpty, fromList, head, 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
#ifndef mingw32_HOST_OS
import System.Console.Terminfo
#endif
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

-- common cmdargs flags
-- keep synced with flag docs in doc/common.m4

-- | Common input-related flags: --file, --rules-file, --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
"FILE" String
"Read data from FILE, or from stdin if -. 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-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-file" String
s RawOpts
opts) String
"RULEFILE" String
"Use conversion rules from this file for converting subsequent CSV/SSV/TSV files. If not specified, uses FILE.rules for each such FILE."

  ,[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
  [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
"multiperiod report with 1 day interval"
 ,[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
"multiperiod report with 1 week interval"
 ,[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
"multiperiod report with 1 month interval"
 ,[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
"multiperiod report with 1 quarter interval"
 ,[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
"multiperiod report with 1 year interval"
 ,[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/depth/zero 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] -> 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
"NUM" String
"or -NUM: show only top NUM levels of accounts"
 ,[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."

  -- 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
"show amounts converted to their cost/sale amount"
 ,[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
unlines
      [String
"Show amounts converted to their value at period end(s) in their default valuation commodity."
      ,String
"Equivalent to --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
unlines
      [String
"Show amounts converted to their value at period end(s) in the specified commodity."
      ,String
"Equivalent to --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
"show amounts converted to their 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"
      ])

  -- general output-related
 ,[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'"  
  -- This has special support in hledger-lib:colorOption, keep synced
 ,[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
"YN"
   ([String] -> String
unlines
     [String
"Use ANSI color codes in text output? Can be"
     ,String
"'y'/'yes'/'always', 'n'/'no'/'never' or 'auto'."
     ])
 ,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? Can be\n'y'/'yes' or 'n'/'no'.\nIf YN is specified, the equals is required."

 -- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL].
 -- But because we handle --debug specially, flagReq also works, and it does not need =, removing a source of confusion.
 -- ,flagOpt "1" ["debug"] (\s opts -> Right $ setopt "debug" s opts) "LVL" "show debug output (levels 1-9, default: 1)"
 ,[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 level of debug output (default: 1)"
 ]

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"
 ]
-- XXX why are these duplicated in defCommandMode below ?

-- | A hidden flag just for the hledger executable.
detailedversionflag :: Flag RawOpts
detailedversionflag :: Flag RawOpts
detailedversionflag = [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 with extra detail"

-- | 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
"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
"show accounts as a tree" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
showamounthelp then String
". Amounts include subaccount amounts." else String
"")
  ]

-- | Common flags that are accepted but not shown in --help,
-- such as --effective, --aux-date.
hiddenflags :: [Flag RawOpts]
hiddenflags :: [Flag RawOpts]
hiddenflags = [
   [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
  ]

-- | 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 documentation. Used both as part of CLI help, and as
-- part of the hledger manual. See parseCommandDoc.
type CommandDoc = String

-- | 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 :: CommandDoc -> [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
doc [Flag RawOpts]
unnamedflaggroup [(String, [Flag RawOpts])]
namedflaggroups [Flag RawOpts]
hiddenflaggroup ([Arg RawOpts], Maybe (Arg RawOpts))
argsdescr =
  case String -> Maybe ([String], String, [String])
parseCommandDoc String
doc of
    Maybe ([String], String, [String])
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
docString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"  -- PARTIAL:
    Just ([String]
names, String
shorthelp, [String]
longhelplines) ->
      ([String] -> Mode RawOpts
defCommandMode [String]
names) {
         modeHelp        = shorthelp
        ,modeHelpSuffix  = longhelplines
        ,modeGroupFlags  = Group {
            groupUnnamed = unnamedflaggroup
           ,groupNamed   = namedflaggroups
           ,groupHidden  = hiddenflaggroup
           }
        ,modeArgs        = argsdescr
        }

-- | Parse a command's help text file (Somecommand.txt).
-- This is generated from the command's doc source file (Somecommand.md)
-- by Shake cmdhelp, and it should be formatted as follows:
--
-- - First line: main command name
--
-- - Third line: command aliases, comma-and-space separated, in parentheses (optional)
--
-- - Fifth or third line to the line containing just _FLAGS (or end of file): short command help
--
-- - Any lines after _FLAGS: long command help
--
-- The CLI --help displays the short help, the flags help generated by cmdargs,
-- then the long help (which some day we might make optional again).
-- The manual displays the short help, then the long help (but not the flags list).
--
parseCommandDoc :: CommandDoc -> Maybe ([Name], String, [String])
parseCommandDoc :: String -> Maybe ([String], String, [String])
parseCommandDoc String
t =
  case String -> [String]
lines String
t of
    [] -> Maybe ([String], String, [String])
forall a. Maybe a
Nothing
    (String
l1:String
_:String
l3:[String]
ls) -> ([String], String, [String]) -> Maybe ([String], String, [String])
forall a. a -> Maybe a
Just (String
cmdnameString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cmdaliases, String
shorthelp, [String]
longhelplines)
      where
        cmdname :: String
cmdname = String -> String
strip String
l1
        ([String]
cmdaliases, [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 (String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
',') (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ 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]
shorthelpls, [String]
longhelpls) = (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 -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"") [String]
rest
        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]
shorthelpls
        longhelplines :: [String]
longhelplines = (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
$ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
longhelpls
    [String]
_ -> Maybe ([String], String, [String])
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
useColorOnStdout = String -> String
forall a. a -> a
id
  | 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 ++ ")"


-- help_postscript = [
--   -- "DATES can be Y/M/D or smart dates like \"last month\"."
--   -- ,"PATTERNS are regular"
--   -- ,"expressions which filter by account name.  Prefix a pattern with desc: to"
--   -- ,"filter by transaction description instead, prefix with not: to negate it."
--   -- ,"When using both, not: comes last."
--  ]


-- 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 -> 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 COLUMNS env var, if set
                                        -- 2. the width reported by the terminal, if supported
                                        -- 3. 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
    , 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

-- | 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  -> Day -> Either HledgerParseErrors Day -> Day
forall b a. b -> Either a b -> b
fromRight (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
"\"") (Either HledgerParseErrors Day -> Day)
-> Either HledgerParseErrors Day -> Day
forall a b. (a -> b) -> a -> b
$ -- PARTIAL:
                         EFDay -> Day
fromEFDay (EFDay -> Day)
-> Either HledgerParseErrors EFDay -> Either HledgerParseErrors Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Day -> Text -> Either HledgerParseErrors EFDay
fixSmartDateStrEither' Day
currentDay (String -> Text
T.pack String
d)
  let iopts :: InputOpts
iopts = Day -> RawOpts -> InputOpts
rawOptsToInputOpts Day
day 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 -> RawOpts -> Either String ReportSpec
rawOptsToReportSpec Day
day RawOpts
rawopts  -- PARTIAL:
  Maybe Int
mcolumns <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay (String -> Maybe Int) -> IO String -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
getEnvSafe String
"COLUMNS"
  Maybe Int
mtermwidth <-
#ifdef mingw32_HOST_OS
    return Nothing
#else
    (Terminal -> Capability Int -> Maybe Int
forall a. Terminal -> Capability a -> Maybe a
`getCapability` Capability Int
termColumns) (Terminal -> Maybe Int) -> IO Terminal -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Terminal
setupTermFromEnv
    -- XXX Throws a SetupTermError if the terminfo database could not be read, should catch
#endif
  let availablewidth :: Int
availablewidth = NonEmpty Int -> Int
forall a. NonEmpty a -> a
NE.head (NonEmpty Int -> Int) -> NonEmpty Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> NonEmpty Int
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList ([Int] -> NonEmpty Int) -> [Int] -> NonEmpty Int
forall a b. (a -> b) -> a -> b
$ [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Int
mcolumns, Maybe Int
mtermwidth, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
defaultWidth]  -- PARTIAL: fromList won't fail because non-null list
  CliOpts -> IO CliOpts
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CliOpts
defcliopts {
              rawopts_         = rawopts
             ,command_         = stringopt "command" rawopts
             ,file_            = listofstringopt "file" rawopts
             ,inputopts_       = iopts
             ,reportspec_      = rspec
             ,output_file_     = maybestringopt "output-file" rawopts
             ,output_format_   = maybestringopt "output-format" rawopts
             ,debug_           = posintopt "debug" rawopts
             ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add
             ,width_           = maybestringopt "width" rawopts
             ,available_width_ = availablewidth
             }

-- | 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
  String
f <- IO String
defaultJournalPath
  String
d <- IO String
getCurrentDirectory
  IO (NonEmpty String)
-> (NonEmpty String -> IO (NonEmpty String))
-> Maybe (NonEmpty String)
-> IO (NonEmpty String)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    (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])
    ((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))
    (Maybe (NonEmpty String) -> IO (NonEmpty String))
-> Maybe (NonEmpty String) -> IO (NonEmpty String)
forall a b. (a -> b) -> a -> b
$ [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

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"]

-- | 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 console output.
-- -- This comes from the --width option, or the COLUMNS environment
-- -- variable, or (on posix platforms) the current terminal width, or 80.
-- -- Will raise a parse error for a malformed --width argument.
-- widthFromOpts :: CliOpts -> Int
-- widthFromOpts CliOpts{width_=Nothing, available_width_=w} = w
-- widthFromOpts CliOpts{width_=Just s}  =
--     case runParser (read `fmap` some digitChar <* eof :: ParsecT Void String Identity Int) "(unknown)" s of
--         Left e   -> usageError $ "could not parse width option: "++errorBundlePretty e
--         Right w  -> w

-- for register:

-- | 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 (COLUMNS, or posix 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

-- | Get the sorted unique canonical names of hledger addon commands
-- found in the current user's PATH. These are used in command line
-- parsing and to display the commands list.
--
-- Canonical addon names are the filenames of hledger-* executables in
-- PATH, without the "hledger-" prefix, and without the file extension
-- except when it's needed for disambiguation (see below).
--
-- When there are exactly two versions of an executable (same base
-- name, different extensions) that look like a source and compiled
-- pair (one has .exe, .com, or no extension), the source version will
-- be excluded (even if it happens to be newer). When there are three
-- or more versions (or two versions that don't look like a
-- source/compiled pair), they are all included, with file extensions
-- intact.
--
hledgerAddons :: IO [String]
hledgerAddons :: IO [String]
hledgerAddons = do
  -- past bug generator
  [String]
as1 <- IO [String]
hledgerExecutablesInPath                     -- ["hledger-check","hledger-check-dates","hledger-check-dates.hs","hledger-check.hs","hledger-check.py"]
  let as2 :: [String]
as2 = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
forall a. [a] -> [a]
stripPrognamePrefix [String]
as1               -- ["check","check-dates","check-dates.hs","check.hs","check.py"]
  let as3 :: [[String]]
as3 = (String -> String) -> [String] -> [[String]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortOn String -> String
takeBaseName [String]
as2              -- [["check","check.hs","check.py"],["check-dates","check-dates.hs"]]
  let as4 :: [String]
as4 = ([String] -> [String]) -> [[String]] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [String] -> [String]
dropRedundantSourceVersion [[String]]
as3  -- ["check","check.hs","check.py","check-dates"]
  [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [String]
as4

stripPrognamePrefix :: [a] -> [a]
stripPrognamePrefix = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
progname Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

dropRedundantSourceVersion :: [String] -> [String]
dropRedundantSourceVersion [String
f,String
g]
  | (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String
takeExtension String
f) String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
compiledExts = [String
f]
  | (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String
takeExtension String
g) String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
compiledExts = [String
g]
dropRedundantSourceVersion [String]
fs = [String]
fs

compiledExts :: [String]
compiledExts = [String
"",String
".com",String
".exe"]

-- | Get the sorted unique filenames of all hledger-* executables in
-- the current user's PATH. These are files in any of the PATH directories,
-- named hledger-*, with either no extension (and no periods in the name)
-- or one of the addonExtensions.
-- We do not currently filter out non-file objects or files without execute permission.
hledgerExecutablesInPath :: IO [String]
hledgerExecutablesInPath :: IO [String]
hledgerExecutablesInPath = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isHledgerExeName ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
likelyExecutablesInPath

-- 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)

isHledgerExeName :: String -> Bool
isHledgerExeName :: String -> Bool
isHledgerExeName = Either HledgerParseErrors () -> Bool
forall a b. Either a b -> Bool
isRight (Either HledgerParseErrors () -> Bool)
-> (String -> Either HledgerParseErrors ()) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec HledgerParseErrorData Text ()
-> Text -> Either HledgerParseErrors ()
forall e a.
Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
parsewith Parsec HledgerParseErrorData Text ()
forall {m :: * -> *}. ParsecT HledgerParseErrorData Text m ()
hledgerexenamep (Text -> Either HledgerParseErrors ())
-> (String -> Text) -> String -> Either HledgerParseErrors ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
    where
      hledgerexenamep :: ParsecT HledgerParseErrorData Text m ()
hledgerexenamep = do
        Tokens Text
_ <- Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text))
-> Tokens Text
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
progname
        Char
_ <- 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
'-'
        [Token Text]
_ <- ParsecT HledgerParseErrorData Text m (Token Text)
-> ParsecT HledgerParseErrorData Text m [Token Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT HledgerParseErrorData Text m (Token Text)
 -> ParsecT HledgerParseErrorData Text m [Token Text])
-> ParsecT HledgerParseErrorData Text m (Token Text)
-> ParsecT HledgerParseErrorData Text m [Token Text]
forall a b. (a -> b) -> a -> b
$ [Token Text] -> ParsecT HledgerParseErrorData Text m (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
'.']
        ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"." ParsecT HledgerParseErrorData Text m (Tokens Text)
-> 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
>> [ParsecT HledgerParseErrorData Text m Text]
-> ParsecT HledgerParseErrorData Text m Text
forall (m :: * -> *) a. [TextParser m a] -> TextParser m a
choice' ((String -> ParsecT HledgerParseErrorData Text m Text)
-> [String] -> [ParsecT HledgerParseErrorData Text m Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ParsecT HledgerParseErrorData Text m Text
Tokens Text -> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT HledgerParseErrorData Text m Text)
-> (String -> Text)
-> String
-> ParsecT HledgerParseErrorData Text m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) [String]
addonExtensions))
        ParsecT HledgerParseErrorData Text m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

-- stripAddonExtension :: String -> String
-- stripAddonExtension = regexReplace re "" where re = "\\.(" ++ intercalate "|" addonExtensions ++ ")$"

addonExtensions :: [String]
addonExtensions :: [String]
addonExtensions =
  [String
"bat"
  ,String
"com"
  ,String
"exe"
  ,String
"hs"
  ,String
"js"
  ,String
"lhs"
  ,String
"lua"
  ,String
"php"
  ,String
"pl"
  ,String
"py"
  ,String
"rb"
  ,String
"rkt"
  ,String
"sh"
  -- ,""
  ]

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 [])

-- not used:
-- -- | Print debug info about arguments and options if --debug is present.
-- debugArgs :: [String] -> CliOpts -> IO ()
-- debugArgs args opts =
--   when ("--debug" `elem` args) $ do
--     progname <- getProgName
--     putStrLn $ "running: " ++ progname
--     putStrLn $ "raw args: " ++ show args
--     putStrLn $ "processed opts:\n" ++ show opts
--     d <- getCurrentDay
--     putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)

-- ** 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

-- | Convert an argument-less --debug flag to --debug=1 in the given arguments list.
-- Used by hledger/ui/web to make their command line parsing easier somehow.
ensureDebugHasArg :: [t Char] -> [t Char]
ensureDebugHasArg [t Char]
as = case (t Char -> Bool) -> [t Char] -> ([t Char], [t Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (t Char -> t Char -> Bool
forall a. Eq a => a -> a -> Bool
==t Char
"--debug") [t Char]
as of
  ([t Char]
bs,t Char
"--debug":t Char
c:[t Char]
cs) | t Char -> Bool
forall a. t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Char
c Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> t Char -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit t Char
c) -> [t Char]
bs[t Char] -> [t Char] -> [t Char]
forall a. [a] -> [a] -> [a]
++t Char
"--debug=1"t Char -> [t Char] -> [t Char]
forall a. a -> [a] -> [a]
:t Char
ct Char -> [t Char] -> [t Char]
forall a. a -> [a] -> [a]
:[t Char]
cs
  ([t Char]
bs,[t Char
"--debug"])                                    -> [t Char]
bs[t Char] -> [t Char] -> [t Char]
forall a. [a] -> [a] -> [a]
++[t Char
"--debug=1"]
  ([t Char], [t Char])
_                                                   -> [t Char]
as