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