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