{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Hledger.Cli.CliOptions (
helpflags,
detailedversionflag,
flattreeflags,
hiddenflags,
inputflags,
reportflags,
outputFormatFlag,
outputFileFlag,
generalflagsgroup1,
generalflagsgroup2,
generalflagsgroup3,
defMode,
defCommandMode,
addonCommandMode,
hledgerCommandMode,
argsFlag,
showModeUsage,
withAliases,
likelyExecutablesInPath,
hledgerExecutablesInPath,
ensureDebugHasArg,
CliOpts(..),
HasCliOpts(..),
defcliopts,
getHledgerCliOpts,
getHledgerCliOpts',
rawOptsToCliOpts,
outputFormats,
defaultOutputFormat,
CommandDoc,
journalFilePathFromOpts,
rulesFilePathFromOpts,
outputFileFromOpts,
outputFormatFromOpts,
defaultWidth,
replaceNumericFlags,
registerWidthsFromOpts,
hledgerAddons,
topicForMode,
)
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 Data.List.Split (splitOn)
import Data.Maybe
import qualified Data.Text as T
import Data.Void (Void)
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)
helpflags :: [Flag RawOpts]
helpflags :: [Flag RawOpts]
helpflags = [
[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"help",Name
"h"] (Name -> RawOpts -> RawOpts
setboolopt Name
"help") Name
"show general help (or after CMD, command help)"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"man"] (Name -> RawOpts -> RawOpts
setboolopt Name
"man") Name
"show user manual with man"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"info"] (Name -> RawOpts -> RawOpts
setboolopt Name
"info") Name
"show info manual with info"
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"debug"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"debug" Name
s RawOpts
opts) Name
"[N]" Name
"show debug output (levels 1-9, default: 1)"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"version"] (Name -> RawOpts -> RawOpts
setboolopt Name
"version") Name
"show version information"
]
detailedversionflag :: Flag RawOpts
detailedversionflag :: Flag RawOpts
detailedversionflag = [Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"version+"] (Name -> RawOpts -> RawOpts
setboolopt Name
"version+") Name
"show version information with extra detail"
inputflags :: [Flag RawOpts]
inputflags :: [Flag RawOpts]
inputflags = [
[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"file",Name
"f"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"file" Name
s RawOpts
opts) Name
"FILE" Name
"use a different input file. For stdin, use - (default: $LEDGER_FILE or $HOME/.hledger.journal)"
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"rules-file"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"rules-file" Name
s RawOpts
opts) Name
"RFILE" Name
"CSV conversion rules file (default: FILE.rules)"
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"alias"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"alias" Name
s RawOpts
opts) Name
"OLD=NEW" Name
"rename accounts named OLD to NEW"
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"pivot"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"pivot" Name
s RawOpts
opts) Name
"TAGNAME" Name
"use some other field/tag for account names"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"ignore-assertions",Name
"I"] (Name -> RawOpts -> RawOpts
setboolopt Name
"ignore-assertions") Name
"ignore any balance assertions"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"strict",Name
"s"] (Name -> RawOpts -> RawOpts
setboolopt Name
"strict") Name
"do extra error checking (check that all posted accounts are declared)"
]
reportflags :: [Flag RawOpts]
reportflags :: [Flag RawOpts]
reportflags = [
[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"begin",Name
"b"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"begin" Name
s RawOpts
opts) Name
"DATE" Name
"include postings/txns on or after this date (will be adjusted to preceding subperiod start when using a report interval)"
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"end",Name
"e"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"end" Name
s RawOpts
opts) Name
"DATE" Name
"include postings/txns before this date (will be adjusted to following subperiod end when using a report interval)"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"daily",Name
"D"] (Name -> RawOpts -> RawOpts
setboolopt Name
"daily") Name
"multiperiod/multicolumn report by day"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"weekly",Name
"W"] (Name -> RawOpts -> RawOpts
setboolopt Name
"weekly") Name
"multiperiod/multicolumn report by week"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"monthly",Name
"M"] (Name -> RawOpts -> RawOpts
setboolopt Name
"monthly") Name
"multiperiod/multicolumn report by month"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"quarterly",Name
"Q"] (Name -> RawOpts -> RawOpts
setboolopt Name
"quarterly") Name
"multiperiod/multicolumn report by quarter"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"yearly",Name
"Y"] (Name -> RawOpts -> RawOpts
setboolopt Name
"yearly") Name
"multiperiod/multicolumn report by year"
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"period",Name
"p"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"period" Name
s RawOpts
opts) Name
"PERIODEXP" Name
"set start date, end date, and/or report interval all at once"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"date2"] (Name -> RawOpts -> RawOpts
setboolopt Name
"date2") Name
"match the secondary date instead. See command help for other effects. (--effective, --aux-date also accepted)"
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"today"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"today" Name
s RawOpts
opts) Name
"DATE" Name
"override today's date (affects relative smart dates, for tests/examples)"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"unmarked",Name
"U"] (Name -> RawOpts -> RawOpts
setboolopt Name
"unmarked") Name
"include only unmarked postings/txns (can combine with -P or -C)"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"pending",Name
"P"] (Name -> RawOpts -> RawOpts
setboolopt Name
"pending") Name
"include only pending postings/txns"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"cleared",Name
"C"] (Name -> RawOpts -> RawOpts
setboolopt Name
"cleared") Name
"include only cleared postings/txns"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"real",Name
"R"] (Name -> RawOpts -> RawOpts
setboolopt Name
"real") Name
"include only non-virtual postings"
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"depth"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"depth" Name
s RawOpts
opts) Name
"NUM" Name
"(or -NUM): hide accounts/postings deeper than this"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"empty",Name
"E"] (Name -> RawOpts -> RawOpts
setboolopt Name
"empty") Name
"show items with zero amount, normally hidden (and vice-versa in hledger-ui/hledger-web)"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"B",Name
"cost"] (Name -> RawOpts -> RawOpts
setboolopt Name
"B")
Name
"show amounts converted to their cost/selling amount, using the transaction price."
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"V",Name
"market"] (Name -> RawOpts -> RawOpts
setboolopt Name
"V")
([Name] -> Name
unwords
[Name
"show amounts converted to period-end market value in their default valuation commodity."
,Name
"Equivalent to --value=end."
])
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"X",Name
"exchange"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"X" Name
s RawOpts
opts) Name
"COMM"
([Name] -> Name
unwords
[Name
"show amounts converted to current (single period reports)"
,Name
"or period-end (multiperiod reports) market value in the specified commodity."
,Name
"Equivalent to --value=end,COMM."
])
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"value"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"value" Name
s RawOpts
opts) Name
"TYPE[,COMM]"
([Name] -> Name
unlines
[Name
"show amounts converted with valuation TYPE, and optionally to specified commodity COMM. TYPE can be:"
,Name
"'then': convert to contemporaneous market value, in default valuation commodity or COMM (print & register commands only)"
,Name
"'end': convert to period-end market value, in default valuation commodity or COMM"
,Name
"'now': convert to current market value, in default valuation commodity or COMM"
,Name
"YYYY-MM-DD: convert to market value on the given date, in default valuation commodity or COMM"
])
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"infer-equity"] (Name -> RawOpts -> RawOpts
setboolopt Name
"infer-equity")
Name
"infer conversion equity postings from costs"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"infer-costs"] (Name -> RawOpts -> RawOpts
setboolopt Name
"infer-costs")
Name
"infer costs from conversion equity postings"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"infer-market-prices"] (Name -> RawOpts -> RawOpts
setboolopt Name
"infer-market-prices")
Name
"use costs as additional market prices, as if they were P directives"
,Name -> [Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. Name -> [Name] -> Update a -> Name -> Name -> Flag a
flagOpt Name
"" [Name
"forecast"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"forecast" Name
s RawOpts
opts) Name
"PERIOD" ([Name] -> Name
unwords
[ Name
"Generate transactions from periodic rules,"
, Name
"between the latest recorded txn and 6 months from today,"
, Name
"or during the specified PERIOD (= is required)."
, Name
"Auto posting rules will be applied to these transactions as well."
, Name
"Also, in hledger-ui make future-dated transactions visible."
])
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"auto"] (Name -> RawOpts -> RawOpts
setboolopt Name
"auto") Name
"Generate extra postings by applying auto posting rules to all txns (not just forecast txns)."
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"verbose-tags"] (Name -> RawOpts -> RawOpts
setboolopt Name
"verbose-tags") Name
"Add visible tags indicating transactions or postings which have been generated/modified."
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"commodity-style", Name
"c"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"commodity-style" Name
s RawOpts
opts) Name
"COMM"
Name
"Override the commodity style in the output for the specified commodity. For example 'EUR1.000,00'."
,[Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq [Name
"color",Name
"colour"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"color" Name
s RawOpts
opts) Name
"WHEN"
([Name] -> Name
unlines
[Name
"Should color-supporting commands use ANSI color codes in text output."
,Name
"'auto' (default): whenever stdout seems to be a color-supporting terminal."
,Name
"'always' or 'yes': always, useful eg when piping output into 'less -R'."
,Name
"'never' or 'no': never."
,Name
"A NO_COLOR environment variable overrides this."
])
,Name -> [Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. Name -> [Name] -> Update a -> Name -> Name -> Flag a
flagOpt Name
"yes" [Name
"pretty"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"pretty" Name
s RawOpts
opts) Name
"WHEN"
([Name] -> Name
unwords
[Name
"Show prettier output, e.g. using unicode box-drawing characters."
,Name
"Accepts 'yes' (the default) or 'no'."
,Name
"If you provide an argument you must use '=', e.g. '--pretty=yes'."
])
]
flattreeflags :: Bool -> [Flag RawOpts]
flattreeflags :: Bool -> [Flag RawOpts]
flattreeflags Bool
showamounthelp = [
[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"flat",Name
"l"] (Name -> RawOpts -> RawOpts
setboolopt Name
"flat")
(Name
"show accounts as a flat list (default)"
Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ if Bool
showamounthelp then Name
". Amounts exclude subaccount amounts, except where the account is depth-clipped." else Name
"")
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"tree",Name
"t"] (Name -> RawOpts -> RawOpts
setboolopt Name
"tree")
(Name
"show accounts as a tree" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ if Bool
showamounthelp then Name
". Amounts include subaccount amounts." else Name
"")
]
hiddenflags :: [Flag RawOpts]
hiddenflags :: [Flag RawOpts]
hiddenflags = [
[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"effective",Name
"aux-date"] (Name -> RawOpts -> RawOpts
setboolopt Name
"date2") Name
"Ledger-compatible aliases for --date2"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"infer-value"] (Name -> RawOpts -> RawOpts
setboolopt Name
"infer-market-prices") Name
"legacy flag that was renamed"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"pretty-tables"] (Name -> Name -> RawOpts -> RawOpts
setopt Name
"pretty" Name
"always") Name
"legacy flag that was renamed"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"anon"] (Name -> RawOpts -> RawOpts
setboolopt Name
"anon") Name
"deprecated, renamed to --obfuscate"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"obfuscate"] (Name -> RawOpts -> RawOpts
setboolopt Name
"obfuscate") Name
"slightly obfuscate hledger's output. Warning, does not give privacy. Formerly --anon."
]
outputFormatFlag :: [String] -> Flag RawOpts
outputFormatFlag :: [Name] -> Flag RawOpts
outputFormatFlag [Name]
fmts = [Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq
[Name
"output-format",Name
"O"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"output-format" Name
s RawOpts
opts) Name
"FMT"
(Name
"select the output format. Supported formats:\n" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name -> [Name] -> Name
forall a. [a] -> [[a]] -> [a]
intercalate Name
", " [Name]
fmts Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
".")
outputFileFlag :: Flag RawOpts
outputFileFlag :: Flag RawOpts
outputFileFlag = [Name] -> Update RawOpts -> Name -> Name -> Flag RawOpts
forall a. [Name] -> Update a -> Name -> Name -> Flag a
flagReq
[Name
"output-file",Name
"o"] (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"output-file" Name
s RawOpts
opts) Name
"FILE"
Name
"write output to FILE. A file extension matching one of the above formats selects that format."
argsFlag :: FlagHelp -> Arg RawOpts
argsFlag :: Name -> Arg RawOpts
argsFlag = Update RawOpts -> Name -> Arg RawOpts
forall a. Update a -> Name -> Arg a
flagArg (\Name
s RawOpts
opts -> RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right (RawOpts -> Either Name RawOpts) -> RawOpts -> Either Name RawOpts
forall a b. (a -> b) -> a -> b
$ Name -> Name -> RawOpts -> RawOpts
setopt Name
"args" Name
s RawOpts
opts)
generalflagstitle :: String
generalflagstitle :: Name
generalflagstitle = Name
"\nGeneral flags"
generalflagsgroup1, generalflagsgroup2, generalflagsgroup3 :: (String, [Flag RawOpts])
generalflagsgroup1 :: (Name, [Flag RawOpts])
generalflagsgroup1 = (Name
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 :: (Name, [Flag RawOpts])
generalflagsgroup2 = (Name
generalflagstitle, [Flag RawOpts]
inputflags [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. [a] -> [a] -> [a]
++ [Flag RawOpts]
helpflags)
generalflagsgroup3 :: (Name, [Flag RawOpts])
generalflagsgroup3 = (Name
generalflagstitle, [Flag RawOpts]
helpflags)
defMode :: Mode RawOpts
defMode :: Mode RawOpts
defMode = Mode :: forall a.
Group (Mode a)
-> [Name]
-> a
-> (a -> Either Name a)
-> (a -> Maybe [Name])
-> Bool
-> Name
-> [Name]
-> ([Arg a], Maybe (Arg a))
-> Group (Flag a)
-> Mode a
Mode {
modeNames :: [Name]
modeNames = []
,modeHelp :: Name
modeHelp = Name
""
,modeHelpSuffix :: [Name]
modeHelpSuffix = []
,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags = Group :: forall a. [a] -> [a] -> [(Name, [a])] -> Group a
Group {
groupNamed :: [(Name, [Flag RawOpts])]
groupNamed = []
,groupUnnamed :: [Flag RawOpts]
groupUnnamed = []
,groupHidden :: [Flag RawOpts]
groupHidden = []
}
,modeArgs :: ([Arg RawOpts], Maybe (Arg RawOpts))
modeArgs = ([], Maybe (Arg RawOpts)
forall a. Maybe a
Nothing)
,modeValue :: RawOpts
modeValue = RawOpts
forall a. Default a => a
def
,modeCheck :: RawOpts -> Either Name RawOpts
modeCheck = RawOpts -> Either Name RawOpts
forall a b. b -> Either a b
Right
,modeReform :: RawOpts -> Maybe [Name]
modeReform = Maybe [Name] -> RawOpts -> Maybe [Name]
forall a b. a -> b -> a
const Maybe [Name]
forall a. Maybe a
Nothing
,modeExpandAt :: Bool
modeExpandAt = Bool
True
,modeGroupModes :: Group (Mode RawOpts)
modeGroupModes = [Mode RawOpts] -> Group (Mode RawOpts)
forall a. [a] -> Group a
toGroup []
}
defCommandMode :: [Name] -> Mode RawOpts
defCommandMode :: [Name] -> Mode RawOpts
defCommandMode [Name]
names = Mode RawOpts
defMode {
modeNames :: [Name]
modeNames=[Name]
names
,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags = Group :: forall a. [a] -> [a] -> [(Name, [a])] -> Group a
Group {
groupNamed :: [(Name, [Flag RawOpts])]
groupNamed = []
,groupUnnamed :: [Flag RawOpts]
groupUnnamed = [
[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"help"] (Name -> RawOpts -> RawOpts
setboolopt Name
"help") Name
"Show command-line help"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"man"] (Name -> RawOpts -> RawOpts
setboolopt Name
"man") Name
"Show user manual with man"
,[Name] -> (RawOpts -> RawOpts) -> Name -> Flag RawOpts
forall a. [Name] -> (a -> a) -> Name -> Flag a
flagNone [Name
"info"] (Name -> RawOpts -> RawOpts
setboolopt Name
"info") Name
"Show info manual with info"
]
,groupHidden :: [Flag RawOpts]
groupHidden = []
}
,modeArgs :: ([Arg RawOpts], Maybe (Arg RawOpts))
modeArgs = ([], Arg RawOpts -> Maybe (Arg RawOpts)
forall a. a -> Maybe a
Just (Arg RawOpts -> Maybe (Arg RawOpts))
-> Arg RawOpts -> Maybe (Arg RawOpts)
forall a b. (a -> b) -> a -> b
$ Name -> Arg RawOpts
argsFlag Name
"[QUERY]")
,modeValue :: RawOpts
modeValue=Name -> Name -> RawOpts -> RawOpts
setopt Name
"command" (Name -> [Name] -> Name
forall a. a -> [a] -> a
headDef Name
"" [Name]
names) RawOpts
forall a. Default a => a
def
}
addonCommandMode :: Name -> Mode RawOpts
addonCommandMode :: Name -> Mode RawOpts
addonCommandMode Name
nam = ([Name] -> Mode RawOpts
defCommandMode [Name
nam]) {
modeHelp :: Name
modeHelp = Name
""
,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags = Group :: forall a. [a] -> [a] -> [(Name, [a])] -> Group a
Group {
groupUnnamed :: [Flag RawOpts]
groupUnnamed = []
,groupHidden :: [Flag RawOpts]
groupHidden = [Flag RawOpts]
hiddenflags
,groupNamed :: [(Name, [Flag RawOpts])]
groupNamed = [(Name, [Flag RawOpts])
generalflagsgroup1]
}
}
type CommandDoc = String
hledgerCommandMode :: CommandDoc -> [Flag RawOpts] -> [(String, [Flag RawOpts])]
-> [Flag RawOpts] -> ([Arg RawOpts], Maybe (Arg RawOpts)) -> Mode RawOpts
hledgerCommandMode :: Name
-> [Flag RawOpts]
-> [(Name, [Flag RawOpts])]
-> [Flag RawOpts]
-> ([Arg RawOpts], Maybe (Arg RawOpts))
-> Mode RawOpts
hledgerCommandMode Name
doc [Flag RawOpts]
unnamedflaggroup [(Name, [Flag RawOpts])]
namedflaggroups [Flag RawOpts]
hiddenflaggroup ([Arg RawOpts], Maybe (Arg RawOpts))
argsdescr =
case Name -> Maybe ([Name], Name, [Name])
parseCommandDoc Name
doc of
Maybe ([Name], Name, [Name])
Nothing -> Name -> Mode RawOpts
forall a. Name -> a
error' (Name -> Mode RawOpts) -> Name -> Mode RawOpts
forall a b. (a -> b) -> a -> b
$ Name
"Could not parse command doc:\n"Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
docName -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
"\n"
Just ([Name]
names, Name
shorthelp, [Name]
longhelplines) ->
([Name] -> Mode RawOpts
defCommandMode [Name]
names) {
modeHelp :: Name
modeHelp = Name
shorthelp
,modeHelpSuffix :: [Name]
modeHelpSuffix = [Name]
longhelplines
,modeGroupFlags :: Group (Flag RawOpts)
modeGroupFlags = Group :: forall a. [a] -> [a] -> [(Name, [a])] -> Group a
Group {
groupUnnamed :: [Flag RawOpts]
groupUnnamed = [Flag RawOpts]
unnamedflaggroup
,groupNamed :: [(Name, [Flag RawOpts])]
groupNamed = [(Name, [Flag RawOpts])]
namedflaggroups
,groupHidden :: [Flag RawOpts]
groupHidden = [Flag RawOpts]
hiddenflaggroup
}
,modeArgs :: ([Arg RawOpts], Maybe (Arg RawOpts))
modeArgs = ([Arg RawOpts], Maybe (Arg RawOpts))
argsdescr
}
parseCommandDoc :: CommandDoc -> Maybe ([Name], String, [String])
parseCommandDoc :: Name -> Maybe ([Name], Name, [Name])
parseCommandDoc Name
t =
case Name -> [Name]
lines Name
t of
[] -> Maybe ([Name], Name, [Name])
forall a. Maybe a
Nothing
(Name
l1:Name
_:Name
l3:[Name]
ls) -> ([Name], Name, [Name]) -> Maybe ([Name], Name, [Name])
forall a. a -> Maybe a
Just (Name
cmdnameName -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
cmdaliases, Name
shorthelp, [Name]
longhelplines)
where
cmdname :: Name
cmdname = Name -> Name
strip Name
l1
([Name]
cmdaliases, [Name]
rest) =
if Name
"(" Name -> Name -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` Name
l3 Bool -> Bool -> Bool
&& Name
")" Name -> Name -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` Name
l3
then (Name -> [Name]
words (Name -> [Name]) -> Name -> [Name]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Name -> Name
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
',') (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Int -> Name -> Name
forall a. Int -> [a] -> [a]
drop Int
1 (Name -> Name) -> Name -> Name
forall a b. (a -> b) -> a -> b
$ Name -> Name
forall a. [a] -> [a]
init Name
l3, [Name]
ls)
else ([], Name
l3Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
:[Name]
ls)
([Name]
shorthelpls, [Name]
longhelpls) = (Name -> Bool) -> [Name] -> ([Name], [Name])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"_FLAGS") ([Name] -> ([Name], [Name])) -> [Name] -> ([Name], [Name])
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==Name
"") [Name]
rest
shorthelp :: Name
shorthelp = [Name] -> Name
unlines ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. [a] -> [a]
reverse ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. [a] -> [a]
reverse [Name]
shorthelpls
longhelplines :: [Name]
longhelplines = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ Int -> [Name] -> [Name]
forall a. Int -> [a] -> [a]
drop Int
1 [Name]
longhelpls
[Name]
_ -> Maybe ([Name], Name, [Name])
forall a. Maybe a
Nothing
showModeUsage :: Mode a -> String
showModeUsage :: Mode a -> Name
showModeUsage =
Name -> Name
highlightHelp (Name -> Name) -> (Mode a -> Name) -> Mode a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(TextFormat -> [Text] -> Name
showText TextFormat
defaultWrap :: [Text] -> String) ([Text] -> Name) -> (Mode a -> [Text]) -> Mode a -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
([Name] -> HelpFormat -> Mode a -> [Text]
forall a. [Name] -> HelpFormat -> Mode a -> [Text]
helpText [] HelpFormat
HelpFormatDefault :: Mode a -> [Text])
highlightHelp :: Name -> Name
highlightHelp
| Bool -> Bool
not Bool
useColorOnStdout = Name -> Name
forall a. a -> a
id
| Bool
otherwise = [Name] -> Name
unlines ([Name] -> Name) -> (Name -> [Name]) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Name -> Name) -> [Integer] -> [Name] -> [Name]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Integer, Name) -> Name) -> Integer -> Name -> Name
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (Integer, Name) -> Name
forall a. (Eq a, Num a) => (a, Name) -> Name
f) [Integer
1..] ([Name] -> [Name]) -> (Name -> [Name]) -> Name -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Name]
lines
where
f :: (a, Name) -> Name
f (a
n,Name
s)
| a
na -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
1 = Name -> Name
bold Name
s
| Name
s Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [
Name
"General input flags:"
,Name
"General reporting flags:"
,Name
"General help flags:"
,Name
"Flags:"
,Name
"General flags:"
,Name
"Examples:"
] = Name -> Name
bold Name
s
| Bool
otherwise = Name
s
topicForMode :: Mode a -> Topic
topicForMode :: Mode a -> Name
topicForMode Mode a
m
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"hledger-ui" = Name
"ui"
| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"hledger-web" = Name
"web"
| Bool
otherwise = Name
"cli"
where n :: Name
n = Name -> [Name] -> Name
forall a. a -> [a] -> a
headDef Name
"" ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$ Mode a -> [Name]
forall a. Mode a -> [Name]
modeNames Mode a
m
withAliases :: String -> [String] -> String
Name
s withAliases :: Name -> [Name] -> Name
`withAliases` [] = Name
s
Name
s `withAliases` [Name]
as = Name
s Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
" (" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name -> [Name] -> Name
forall a. [a] -> [[a]] -> [a]
intercalate Name
", " [Name]
as Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
")"
data CliOpts = CliOpts {
CliOpts -> RawOpts
rawopts_ :: RawOpts
,CliOpts -> Name
command_ :: String
,CliOpts -> [Name]
file_ :: [FilePath]
,CliOpts -> InputOpts
inputopts_ :: InputOpts
,CliOpts -> ReportSpec
reportspec_ :: ReportSpec
,CliOpts -> Maybe Name
output_file_ :: Maybe FilePath
,CliOpts -> Maybe Name
output_format_ :: Maybe String
,CliOpts -> Int
debug_ :: Int
,CliOpts -> Bool
no_new_accounts_ :: Bool
,CliOpts -> Maybe Name
width_ :: Maybe String
,CliOpts -> Int
available_width_ :: Int
,CliOpts -> POSIXTime
progstarttime_ :: POSIXTime
} deriving (Int -> CliOpts -> Name -> Name
[CliOpts] -> Name -> Name
CliOpts -> Name
(Int -> CliOpts -> Name -> Name)
-> (CliOpts -> Name) -> ([CliOpts] -> Name -> Name) -> Show CliOpts
forall a.
(Int -> a -> Name -> Name)
-> (a -> Name) -> ([a] -> Name -> Name) -> Show a
showList :: [CliOpts] -> Name -> Name
$cshowList :: [CliOpts] -> Name -> Name
show :: CliOpts -> Name
$cshow :: CliOpts -> Name
showsPrec :: Int -> CliOpts -> Name -> Name
$cshowsPrec :: Int -> CliOpts -> Name -> Name
Show)
instance Default CliOpts where def :: CliOpts
def = CliOpts
defcliopts
defcliopts :: CliOpts
defcliopts :: CliOpts
defcliopts = CliOpts :: RawOpts
-> Name
-> [Name]
-> InputOpts
-> ReportSpec
-> Maybe Name
-> Maybe Name
-> Int
-> Bool
-> Maybe Name
-> Int
-> POSIXTime
-> CliOpts
CliOpts
{ rawopts_ :: RawOpts
rawopts_ = RawOpts
forall a. Default a => a
def
, command_ :: Name
command_ = Name
""
, file_ :: [Name]
file_ = []
, inputopts_ :: InputOpts
inputopts_ = InputOpts
definputopts
, reportspec_ :: ReportSpec
reportspec_ = ReportSpec
forall a. Default a => a
def
, output_file_ :: Maybe Name
output_file_ = Maybe Name
forall a. Maybe a
Nothing
, output_format_ :: Maybe Name
output_format_ = Maybe Name
forall a. Maybe a
Nothing
, debug_ :: Int
debug_ = Int
0
, no_new_accounts_ :: Bool
no_new_accounts_ = Bool
False
, width_ :: Maybe Name
width_ = Maybe Name
forall a. Maybe a
Nothing
, available_width_ :: Int
available_width_ = Int
defaultWidth
, progstarttime_ :: POSIXTime
progstarttime_ = POSIXTime
0
}
defaultWidth :: Int
defaultWidth :: Int
defaultWidth = Int
80
replaceNumericFlags :: [String] -> [String]
replaceNumericFlags :: [Name] -> [Name]
replaceNumericFlags = (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Name
replace
where
replace :: Name -> Name
replace (Char
'-':Name
ds) | Bool -> Bool
not (Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Name
ds) Bool -> Bool -> Bool
&& (Char -> Bool) -> Name -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit Name
ds = Name
"--depth="Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++Name
ds
replace Name
s = Name
s
rawOptsToCliOpts :: RawOpts -> IO CliOpts
rawOptsToCliOpts :: RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts = do
Day
currentDay <- IO Day
getCurrentDay
let day :: Day
day = case Name -> RawOpts -> Maybe Name
maybestringopt Name
"today" RawOpts
rawopts of
Maybe Name
Nothing -> Day
currentDay
Just Name
d -> Day -> Either HledgerParseErrors Day -> Day
forall b a. b -> Either a b -> b
fromRight (Name -> Day
forall a. Name -> a
error' (Name -> Day) -> Name -> Day
forall a b. (a -> b) -> a -> b
$ Name
"Unable to parse date \"" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
d Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
"\"") (Either HledgerParseErrors Day -> Day)
-> Either HledgerParseErrors Day -> Day
forall a b. (a -> b) -> a -> b
$
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 (Name -> Text
T.pack Name
d)
let iopts :: InputOpts
iopts = Day -> RawOpts -> InputOpts
rawOptsToInputOpts Day
day RawOpts
rawopts
ReportSpec
rspec <- (Name -> IO ReportSpec)
-> (ReportSpec -> IO ReportSpec)
-> Either Name ReportSpec
-> IO ReportSpec
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Name -> IO ReportSpec
forall a. Name -> a
error' ReportSpec -> IO ReportSpec
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Name ReportSpec -> IO ReportSpec)
-> Either Name ReportSpec -> IO ReportSpec
forall a b. (a -> b) -> a -> b
$ Day -> RawOpts -> Either Name ReportSpec
rawOptsToReportSpec Day
day RawOpts
rawopts
Maybe Int
mcolumns <- Name -> Maybe Int
forall a. Read a => Name -> Maybe a
readMay (Name -> Maybe Int) -> IO Name -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> IO Name
getEnvSafe Name
"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
#endif
let availablewidth :: Int
availablewidth = [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> [Int] -> 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]
CliOpts -> IO CliOpts
forall (m :: * -> *) a. Monad m => a -> m a
return CliOpts
defcliopts {
rawopts_ :: RawOpts
rawopts_ = RawOpts
rawopts
,command_ :: Name
command_ = Name -> RawOpts -> Name
stringopt Name
"command" RawOpts
rawopts
,file_ :: [Name]
file_ = Name -> RawOpts -> [Name]
listofstringopt Name
"file" RawOpts
rawopts
,inputopts_ :: InputOpts
inputopts_ = InputOpts
iopts
,reportspec_ :: ReportSpec
reportspec_ = ReportSpec
rspec
,output_file_ :: Maybe Name
output_file_ = Name -> RawOpts -> Maybe Name
maybestringopt Name
"output-file" RawOpts
rawopts
,output_format_ :: Maybe Name
output_format_ = Name -> RawOpts -> Maybe Name
maybestringopt Name
"output-format" RawOpts
rawopts
,debug_ :: Int
debug_ = Name -> RawOpts -> Int
posintopt Name
"debug" RawOpts
rawopts
,no_new_accounts_ :: Bool
no_new_accounts_ = Name -> RawOpts -> Bool
boolopt Name
"no-new-accounts" RawOpts
rawopts
,width_ :: Maybe Name
width_ = Name -> RawOpts -> Maybe Name
maybestringopt Name
"width" RawOpts
rawopts
,available_width_ :: Int
available_width_ = Int
availablewidth
}
getHledgerCliOpts' :: Mode RawOpts -> [String] -> IO CliOpts
getHledgerCliOpts' :: Mode RawOpts -> [Name] -> IO CliOpts
getHledgerCliOpts' Mode RawOpts
mode' [Name]
args0 = do
let rawopts :: RawOpts
rawopts = (Name -> RawOpts)
-> (RawOpts -> RawOpts) -> Either Name RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Name -> RawOpts
forall a. Name -> a
usageError RawOpts -> RawOpts
forall a. a -> a
id (Either Name RawOpts -> RawOpts) -> Either Name RawOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [Name] -> Either Name RawOpts
forall a. Mode a -> [Name] -> Either Name a
process Mode RawOpts
mode' [Name]
args0
CliOpts
opts <- RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts
[Name] -> CliOpts -> IO ()
debugArgs [Name]
args0 CliOpts
opts
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name -> RawOpts -> Bool
boolopt Name
"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
$ Name -> IO ()
putStr Name
shorthelp IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
CliOpts -> IO CliOpts
forall (m :: * -> *) a. Monad m => a -> m a
return CliOpts
opts
where
longhelp :: Name
longhelp = Mode RawOpts -> Name
forall a. Mode a -> Name
showModeUsage Mode RawOpts
mode'
shorthelp :: Name
shorthelp =
[Name] -> Name
unlines ([Name] -> Name) -> [Name] -> Name
forall a b. (a -> b) -> a -> b
$
([Name] -> [Name]
forall a. [a] -> [a]
reverse ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Name -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. [a] -> [a]
reverse ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name
"flags:" Name -> Name -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`)) ([Name] -> [Name]) -> [Name] -> [Name]
forall a b. (a -> b) -> a -> b
$ Name -> [Name]
lines Name
longhelp)
[Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
[Name
""
,Name
" See also hledger -h for general hledger options."
]
debugArgs :: [String] -> CliOpts -> IO ()
debugArgs :: [Name] -> CliOpts -> IO ()
debugArgs [Name]
args1 CliOpts
opts =
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Name
"--debug" Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
args1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Name
progname' <- IO Name
getProgName
Name -> IO ()
putStrLn (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Name
"running: " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
progname'
Name -> IO ()
putStrLn (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Name
"raw args: " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ [Name] -> Name
forall a. Show a => a -> Name
show [Name]
args1
Name -> IO ()
putStrLn (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Name
"processed opts:\n" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ CliOpts -> Name
forall a. Show a => a -> Name
show CliOpts
opts
Name -> IO ()
putStrLn (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Name
"search query: " Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Query -> Name
forall a. Show a => a -> Name
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
[Name]
args' <- IO [Name]
getArgs IO [Name] -> ([Name] -> IO [Name]) -> IO [Name]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Name] -> IO [Name]
expandArgsAt
Mode RawOpts -> [Name] -> IO CliOpts
getHledgerCliOpts' Mode RawOpts
mode' [Name]
args'
journalFilePathFromOpts :: CliOpts -> IO [String]
journalFilePathFromOpts :: CliOpts -> IO [Name]
journalFilePathFromOpts CliOpts
opts = do
Name
f <- IO Name
defaultJournalPath
Name
d <- IO Name
getCurrentDirectory
case CliOpts -> [Name]
file_ CliOpts
opts of
[] -> [Name] -> IO [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name
f]
[Name]
fs -> (Name -> IO Name) -> [Name] -> IO [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Name -> Name -> IO Name
expandPathPreservingPrefix Name
d) [Name]
fs
expandPathPreservingPrefix :: FilePath -> PrefixedFilePath -> IO PrefixedFilePath
expandPathPreservingPrefix :: Name -> Name -> IO Name
expandPathPreservingPrefix Name
d Name
prefixedf = do
let (Maybe Name
p,Name
f) = Name -> (Maybe Name, Name)
splitReaderPrefix Name
prefixedf
Name
f' <- Name -> Name -> IO Name
expandPath Name
d Name
f
Name -> IO Name
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> IO Name) -> Name -> IO Name
forall a b. (a -> b) -> a -> b
$ case Maybe Name
p of
Just Name
p' -> Name
p' Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
":" Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ Name
f'
Maybe Name
Nothing -> Name
f'
outputFileFromOpts :: CliOpts -> IO (Maybe FilePath)
outputFileFromOpts :: CliOpts -> IO (Maybe Name)
outputFileFromOpts CliOpts
opts = do
Name
d <- IO Name
getCurrentDirectory
case CliOpts -> Maybe Name
output_file_ CliOpts
opts of
Maybe Name
Nothing -> Maybe Name -> IO (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing
Just Name
f -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> IO Name -> IO (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> Name -> IO Name
expandPath Name
d Name
f
defaultOutputFormat :: String
defaultOutputFormat :: Name
defaultOutputFormat = Name
"txt"
outputFormats :: [String]
outputFormats :: [Name]
outputFormats = [Name
defaultOutputFormat, Name
"beancount", Name
"csv", Name
"json", Name
"html", Name
"sql", Name
"tsv"]
outputFormatFromOpts :: CliOpts -> String
outputFormatFromOpts :: CliOpts -> Name
outputFormatFromOpts CliOpts
opts =
case CliOpts -> Maybe Name
output_format_ CliOpts
opts of
Just Name
f -> Name
f
Maybe Name
Nothing ->
case Name -> Name
filePathExtension (Name -> Name) -> Maybe Name -> Maybe Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> Maybe Name
output_file_ CliOpts
opts of
Just Name
ext | Name
ext Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
outputFormats -> Name
ext
Maybe Name
_ -> Name
defaultOutputFormat
filePathExtension :: FilePath -> String
filePathExtension :: Name -> Name
filePathExtension = (Char -> Bool) -> Name -> Name
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'.') (Name -> Name) -> (Name -> Name) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Name) -> Name
forall a b. (a, b) -> b
snd ((Name, Name) -> Name) -> (Name -> (Name, Name)) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (Name, Name)
splitExtension (Name -> (Name, Name)) -> (Name -> Name) -> Name -> (Name, Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Name) -> Name
forall a b. (a, b) -> b
snd ((Name, Name) -> Name) -> (Name -> (Name, Name)) -> Name -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> (Name, Name)
splitFileName
rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)
rulesFilePathFromOpts :: CliOpts -> IO (Maybe Name)
rulesFilePathFromOpts CliOpts
opts = do
Name
d <- IO Name
getCurrentDirectory
IO (Maybe Name)
-> (Name -> IO (Maybe Name)) -> Maybe Name -> IO (Maybe Name)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe Name -> IO (Maybe Name)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Name
forall a. Maybe a
Nothing) ((Name -> Maybe Name) -> IO Name -> IO (Maybe Name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Name -> Maybe Name
forall a. a -> Maybe a
Just (IO Name -> IO (Maybe Name))
-> (Name -> IO Name) -> Name -> IO (Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Name -> IO Name
expandPath Name
d) (Maybe Name -> IO (Maybe Name)) -> Maybe Name -> IO (Maybe Name)
forall a b. (a -> b) -> a -> b
$ InputOpts -> Maybe Name
mrules_file_ (InputOpts -> Maybe Name) -> InputOpts -> Maybe Name
forall a b. (a -> b) -> a -> b
$ CliOpts -> InputOpts
inputopts_ CliOpts
opts
registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts :: CliOpts -> (Int, Maybe Int)
registerWidthsFromOpts CliOpts{width_ :: CliOpts -> Maybe Name
width_=Maybe Name
Nothing, available_width_ :: CliOpts -> Int
available_width_=Int
w} = (Int
w, Maybe Int
forall a. Maybe a
Nothing)
registerWidthsFromOpts CliOpts{width_ :: CliOpts -> Maybe Name
width_=Just Name
s} =
case Parsec Void Name (Int, Maybe Int)
-> Name
-> Name
-> Either (ParseErrorBundle Name Void) (Int, Maybe Int)
forall e s a.
Parsec e s a -> Name -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Name (Int, Maybe Int)
forall s (m :: * -> *).
(Stream s, Char ~ Token s) =>
ParsecT Void s m (Int, Maybe Int)
registerwidthp Name
"(unknown)" Name
s of
Left ParseErrorBundle Name Void
e -> Name -> (Int, Maybe Int)
forall a. Name -> a
usageError (Name -> (Int, Maybe Int)) -> Name -> (Int, Maybe Int)
forall a b. (a -> b) -> a -> b
$ Name
"could not parse width option: "Name -> Name -> Name
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Name Void -> Name
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> Name
errorBundlePretty ParseErrorBundle Name 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 :: ParsecT Void s m (Int, Maybe Int)
registerwidthp = do
Int
totalwidth <- Name -> Int
forall a. Read a => Name -> a
read (Name -> Int) -> ParsecT Void s m Name -> ParsecT Void s m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT Void s m Char -> ParsecT Void s m Name
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void s m Char
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Name -> Int
forall a. Read a => Name -> a
read (Name -> Int) -> ParsecT Void s m Name -> ParsecT Void s m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT Void s m Char -> ParsecT Void s m Name
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some ParsecT Void s m Char
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 (m :: * -> *) a. Monad m => a -> m a
return (Int
totalwidth, Maybe Int
descwidth)
hledgerAddons :: IO [String]
hledgerAddons :: IO [Name]
hledgerAddons = do
[Name]
as1 <- IO [Name]
hledgerExecutablesInPath
let as2 :: [Name]
as2 = (Name -> Name) -> [Name] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Name
forall a. [a] -> [a]
stripPrognamePrefix [Name]
as1
let as3 :: [[Name]]
as3 = (Name -> Name) -> [Name] -> [[Name]]
forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortOn Name -> Name
takeBaseName [Name]
as2
let as4 :: [Name]
as4 = ([Name] -> [Name]) -> [[Name]] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Name] -> [Name]
dropRedundantSourceVersion [[Name]]
as3
[Name] -> IO [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [Name]
as4
stripPrognamePrefix :: [a] -> [a]
stripPrognamePrefix = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Name -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Name
progname Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
dropRedundantSourceVersion :: [Name] -> [Name]
dropRedundantSourceVersion [Name
f,Name
g]
| (Char -> Char) -> Name -> Name
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Name -> Name
takeExtension Name
f) Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
compiledExts = [Name
f]
| (Char -> Char) -> Name -> Name
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (Name -> Name
takeExtension Name
g) Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name]
compiledExts = [Name
g]
dropRedundantSourceVersion [Name]
fs = [Name]
fs
compiledExts :: [Name]
compiledExts = [Name
"",Name
".com",Name
".exe"]
hledgerExecutablesInPath :: IO [String]
hledgerExecutablesInPath :: IO [Name]
hledgerExecutablesInPath = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
isHledgerExeName ([Name] -> [Name]) -> IO [Name] -> IO [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Name]
likelyExecutablesInPath
likelyExecutablesInPath :: IO [String]
likelyExecutablesInPath :: IO [Name]
likelyExecutablesInPath = do
[Name]
pathdirs <- Name -> Name -> [Name]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn Name
pathsep (Name -> [Name]) -> IO Name -> IO [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> IO Name
getEnvSafe Name
"PATH"
[Name]
pathfiles <- [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> IO [[Name]] -> IO [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (Name -> IO [Name]) -> [Name] -> IO [[Name]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Name -> IO [Name]
getDirectoryContentsSafe [Name]
pathdirs
[Name] -> IO [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Name] -> IO [Name]) -> [Name] -> IO [Name]
forall a b. (a -> b) -> a -> b
$ [Name] -> [Name]
forall a. Ord a => [a] -> [a]
nubSort [Name]
pathfiles
where pathsep :: Name
pathsep = if Name
os Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"mingw32" then Name
";" else Name
":"
isHledgerExeName :: String -> Bool
isHledgerExeName :: Name -> Bool
isHledgerExeName = Either HledgerParseErrors () -> Bool
forall a b. Either a b -> Bool
isRight (Either HledgerParseErrors () -> Bool)
-> (Name -> Either HledgerParseErrors ()) -> Name -> 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 ())
-> (Name -> Text) -> Name -> Either HledgerParseErrors ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
T.pack
where
hledgerexenamep :: ParsecT HledgerParseErrorData Text m ()
hledgerexenamep = do
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
$ Name -> Text
T.pack Name
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
'-'
Name
_ <- ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Name
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Name)
-> ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m Name
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 Text
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
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' ((Name -> ParsecT HledgerParseErrorData Text m Text)
-> [Name] -> [ParsecT HledgerParseErrorData Text m Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ParsecT HledgerParseErrorData Text m Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT HledgerParseErrorData Text m Text)
-> (Name -> Text)
-> Name
-> ParsecT HledgerParseErrorData Text m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
T.pack) [Name]
addonExtensions))
ParsecT HledgerParseErrorData Text m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
addonExtensions :: [String]
addonExtensions :: [Name]
addonExtensions =
[Name
"bat"
,Name
"com"
,Name
"exe"
,Name
"hs"
,Name
"js"
,Name
"lhs"
,Name
"lua"
,Name
"php"
,Name
"pl"
,Name
"py"
,Name
"rb"
,Name
"rkt"
,Name
"sh"
]
getEnvSafe :: String -> IO String
getEnvSafe :: Name -> IO Name
getEnvSafe Name
v = Name -> IO Name
getEnv Name
v IO Name -> (IOException -> IO Name) -> IO Name
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> Name -> IO Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
"")
getDirectoryContentsSafe :: FilePath -> IO [String]
getDirectoryContentsSafe :: Name -> IO [Name]
getDirectoryContentsSafe Name
d =
((Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name
".",Name
".."])) ([Name] -> [Name]) -> IO [Name] -> IO [Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> IO [Name]
getDirectoryContents Name
d) IO [Name] -> (IOException -> IO [Name]) -> IO [Name]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` (\(IOException
_::C.IOException) -> [Name] -> IO [Name]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
makeHledgerClassyLenses ''CliOpts
instance HasInputOpts CliOpts where
inputOpts :: (InputOpts -> f InputOpts) -> CliOpts -> f CliOpts
inputOpts = (InputOpts -> f InputOpts) -> CliOpts -> f CliOpts
forall c. HasCliOpts c => Lens' c InputOpts
inputopts
instance HasBalancingOpts CliOpts where
balancingOpts :: (BalancingOpts -> f BalancingOpts) -> CliOpts -> f CliOpts
balancingOpts = (InputOpts -> f InputOpts) -> CliOpts -> f CliOpts
forall c. HasInputOpts c => Lens' c 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
balancingOpts
instance HasReportSpec CliOpts where
reportSpec :: (ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts
reportSpec = (ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts
forall c. HasCliOpts c => Lens' c ReportSpec
reportspec
instance HasReportOptsNoUpdate CliOpts where
reportOptsNoUpdate :: (ReportOpts -> f ReportOpts) -> CliOpts -> f CliOpts
reportOptsNoUpdate = (ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts
forall c. HasReportSpec c => Lens' c 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
reportOptsNoUpdate
instance HasReportOpts CliOpts where
reportOpts :: (ReportOpts -> f ReportOpts) -> CliOpts -> f CliOpts
reportOpts = (ReportSpec -> f ReportSpec) -> CliOpts -> f CliOpts
forall c. HasReportSpec c => Lens' c 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
reportOpts
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 (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