diff --git a/hledger-lib/Hledger/Data/RawOptions.hs b/hledger-lib/Hledger/Data/RawOptions.hs index c375006bd..48ad9996d 100644 --- a/hledger-lib/Hledger/Data/RawOptions.hs +++ b/hledger-lib/Hledger/Data/RawOptions.hs @@ -9,6 +9,7 @@ more easily by hledger commands/scripts in this and other packages. module Hledger.Data.RawOptions ( RawOpts, + YNA, mkRawOpts, overRawOpts, setopt, @@ -26,7 +27,9 @@ module Hledger.Data.RawOptions ( posintopt, maybeintopt, maybeposintopt, - maybecharopt + maybecharopt, + maybeynopt, + maybeynaopt, ) where @@ -35,6 +38,8 @@ import Data.Default (Default(..)) import Safe (headMay, lastMay, readDef) import Hledger.Utils +import Data.Char (toLower) +import Data.List (intercalate) -- | The result of running cmdargs: an association list of option names to string values. @@ -139,3 +144,22 @@ maybeclippedintopt minVal maxVal name = ++ " must lie in the range " ++ show minVal ++ " to " ++ show maxVal ++ ", but is " ++ show n + +maybeynopt :: String -> RawOpts -> Maybe Bool +maybeynopt name rawopts = + case maybestringopt name rawopts of + Just v | map toLower v `elem` ["y","yes","always"] -> Just True + Just v | map toLower v `elem` ["n","no","never"] -> Just False + Just _ -> error' $ name <> " value should be one of " <> (intercalate ", " ["y","yes","n","no"]) + _ -> Nothing + +data YNA = Yes | No | Auto deriving (Eq,Show) + +maybeynaopt :: String -> RawOpts -> Maybe YNA +maybeynaopt name rawopts = + case maybestringopt name rawopts of + Just v | map toLower v `elem` ["y","yes","always"] -> Just Yes + Just v | map toLower v `elem` ["n","no","never"] -> Just No + Just v | map toLower v `elem` ["a","auto"] -> Just Auto + Just _ -> error' $ name <> " value should be one of " <> (intercalate ", " ["y","yes","n","no","a","auto"]) + _ -> Nothing diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index b4015d143..fe51344bb 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -346,7 +346,7 @@ ynopt opt rawopts = case maybestringopt opt rawopts of Just "never" -> Just False Just "no" -> Just False Just "n" -> Just False - Just _ -> usageError "--pretty's argument should be \"yes\" or \"no\" (or y, n, always, never)" + Just _ -> usageError "this argument should be one of y, yes, n, no" _ -> Nothing balanceAccumulationOverride :: RawOpts -> Maybe BalanceAccumulation diff --git a/hledger-lib/Hledger/Utils/IO.hs b/hledger-lib/Hledger/Utils/IO.hs index 429d50ed8..2d15df096 100644 --- a/hledger-lib/Hledger/Utils/IO.hs +++ b/hledger-lib/Hledger/Utils/IO.hs @@ -20,8 +20,8 @@ module Hledger.Utils.IO ( pprint', -- * Viewing with pager - pager, setupPager, + runPager, -- * Terminal size getTerminalHeightWidth, @@ -32,6 +32,9 @@ module Hledger.Utils.IO ( progArgs, outputFileOption, hasOutputFile, + splitFlagsAndVals, + getLongOpt, + parseYN, -- * ANSI color colorOption, @@ -130,6 +133,7 @@ import Text.Pretty.Simple defaultOutputOptionsDarkBg, defaultOutputOptionsNoColor, pShowOpt, pPrintOpt) import Hledger.Utils.Text (WideBuilder(WideBuilder)) +import Data.Char (toLower) -- Pretty showing/printing with pretty-simple @@ -210,13 +214,18 @@ setupPager = do -- supports those, the pager should be configured to display those, otherwise -- users will see junk on screen (#2015). -- Call "setupPager" at program startup to make that less likely. -pager :: String -> IO () +-- +-- Pager use is influenced by the --pager option, at least. +-- Rather than pass in a huge CliOpts, or duplicate conditional logic at every call site, +-- this does some redundant local options parsing. +runPager :: String -> IO () #ifdef mingw32_HOST_OS -pager = putStr +runPager = putStr #else -pager s = do - -- disable pager when --no-pager is specified - nopager <- elem "--no-pager" <$> getArgs +runPager s = do + -- disable pager with --pager=no + mpager <- getLongOpt "pager" + let nopager = not $ maybe True parseYN mpager -- disable pager when TERM=dumb (for Emacs shell users) dumbterm <- (== Just "dumb") <$> lookupEnv "TERM" -- disable pager with single-line output (https://github.com/pharpend/pager/issues/2) @@ -238,6 +247,33 @@ pager s = do s #endif +-- | Given a list of arguments, split any of the form --flag=val into --flag, val. +splitFlagsAndVals :: [String] -> [String] +splitFlagsAndVals = + concatMap + (\a -> + if "--" `isPrefixOf` a && '=' `elem` a + then let (x,y) = break (=='=') a in [x, drop 1 y] + else [a]) + +-- | Read the value of the rightmost long option of this name from the command line arguments. +-- If the value is missing raise an error. +getLongOpt :: String -> IO (Maybe String) +getLongOpt name = do + rargs <- reverse . splitFlagsAndVals <$> getArgs + let flag = "--"<>name + return $ + case break (==flag) rargs of + ([],_) -> error' $ flag <> " requires a value" + (argsafter,_) -> Just $ last argsafter + +-- | Parse y/yes/always or n/no/never to true or false, or with any other value raise an error. +parseYN :: String -> Bool +parseYN s + | l `elem` ["y","yes","always"] = True + | l `elem` ["n","no","never"] = False + | otherwise = error' $ "value should be one of " <> (intercalate ", " ["y","yes","n","no"]) + where l = map toLower s -- Command line arguments diff --git a/hledger-ui/Hledger/UI/Main.hs b/hledger-ui/Hledger/UI/Main.hs index de1d4af5d..1fbab2035 100644 --- a/hledger-ui/Hledger/UI/Main.hs +++ b/hledger-ui/Hledger/UI/Main.hs @@ -75,7 +75,7 @@ hledgerUiMain = withGhcDebug' $ withProgName "hledger-ui.log" $ do -- force Hle let copts' = copts{inputopts_=iopts{forecast_=forecast_ iopts <|> Just nulldatespan}} case True of - _ | boolopt "help" rawopts -> pager $ showModeUsage uimode ++ "\n" + _ | boolopt "help" rawopts -> runPager $ showModeUsage uimode ++ "\n" _ | boolopt "tldr" rawopts -> runTldrForPage "hledger-ui" _ | boolopt "info" rawopts -> runInfoForTopic "hledger-ui" Nothing _ | boolopt "man" rawopts -> runManForTopic "hledger-ui" Nothing diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 6f5041c09..97f4a0f63 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -55,7 +55,7 @@ hledgerWebMain = withGhcDebug' $ do wopts@WebOpts{cliopts_=copts@CliOpts{debug_, rawopts_}} <- getHledgerWebOpts when (debug_ > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show wopts) if - | boolopt "help" rawopts_ -> pager $ showModeUsage webmode ++ "\n" + | boolopt "help" rawopts_ -> runPager $ showModeUsage webmode ++ "\n" | boolopt "tldr" rawopts_ -> runTldrForPage "hledger-web" | boolopt "info" rawopts_ -> runInfoForTopic "hledger-web" Nothing | boolopt "man" rawopts_ -> runManForTopic "hledger-web" Nothing diff --git a/hledger.conf b/hledger.conf index e9597ab04..ca4385c13 100644 --- a/hledger.conf +++ b/hledger.conf @@ -1,3 +1,6 @@ # This is an empty config file, to disable your personal hledger config # while developing and testing hledger in this directory. # For an example config, see hledger.conf.sample. +--pager yes +# --color=no +# --debug diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 5ce71a20a..0cbc44272 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -345,7 +345,7 @@ main = withGhcDebug' $ do withArgs (progname:finalargs) $ if -- 6.1. no command and a help/doc flag found - show general help/docs - | nocmdprovided && helpFlag -> pager $ showModeUsage (mainmode []) ++ "\n" + | nocmdprovided && helpFlag -> runPager $ showModeUsage (mainmode []) ++ "\n" | nocmdprovided && tldrFlag -> runTldrForPage "hledger" | nocmdprovided && infoFlag -> runInfoForTopic "hledger" Nothing | nocmdprovided && manFlag -> runManForTopic "hledger" Nothing @@ -375,7 +375,7 @@ main = withGhcDebug' $ do -- run the builtin command according to its type if -- 6.5.1. help/doc flag - show command help/docs - | helpFlag -> pager $ showModeUsage cmdmode ++ "\n" + | helpFlag -> runPager $ showModeUsage cmdmode ++ "\n" | tldrFlag -> runTldrForPage tldrpagename | infoFlag -> runInfoForTopic "hledger" mmodecmdname | manFlag -> runManForTopic "hledger" mmodecmdname diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 5b34f0d75..a72f73005 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -22,8 +22,8 @@ module Hledger.Cli.CliOptions ( -- * cmdargs flags & modes inputflags, reportflags, - terminalflags, helpflags, + terminalflags, helpflagstitle, flattreeflags, confflags, @@ -240,17 +240,17 @@ helpflags = [ -- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL] in help. -- But flagReq plus special handling in Cli.hs makes the = optional, removing a source of confusion. ,flagReq ["debug"] (\s opts -> Right $ setopt "debug" s opts) "[1-9]" "show this much debug output (default: 1)" - ] --- XXX why are these duplicated in defCommandMode below ? + ] -- XXX why are these duplicated in defCommandMode below ? <> terminalflags -- Low-level flags affecting terminal output. -- These are included in helpflags so they appear everywhere. terminalflags = [ - flagNone ["no-pager"] (setboolopt "no-pager") "don't use a pager for long output" + flagReq ["pager"] (\s opts -> Right $ setopt "pager" s opts) "YN" + "use pager for long output ? y/yes or n/no" -- This has special support in hledger-lib:colorOption, keep synced ,flagReq ["color","colour"] (\s opts -> Right $ setopt "color" s opts) "YN" - "use ANSI color in terminal ? 'y'/'yes', 'n'/'no', or 'auto' (default)" + "use ANSI color ? y/yes, n/no, or auto (default)" ] -- | Flags for selecting flat/tree mode, used for reports organised by account. @@ -542,6 +542,8 @@ data CliOpts = CliOpts { ,reportspec_ :: ReportSpec ,output_file_ :: Maybe FilePath ,output_format_ :: Maybe String + ,pageropt_ :: Maybe Bool -- ^ --pager + ,coloropt_ :: Maybe YNA -- ^ --color. Controls use of ANSI color and ANSI styles. ,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. ,no_new_accounts_ :: Bool -- add ,width_ :: Maybe String -- ^ the --width value provided, if any @@ -563,6 +565,8 @@ defcliopts = CliOpts , reportspec_ = def , output_file_ = Nothing , output_format_ = Nothing + , pageropt_ = Nothing + , coloropt_ = Nothing , debug_ = 0 , no_new_accounts_ = False , width_ = Nothing @@ -621,6 +625,8 @@ rawOptsToCliOpts rawopts = do ,reportspec_ = rspec ,output_file_ = maybestringopt "output-file" rawopts ,output_format_ = maybestringopt "output-format" rawopts + ,pageropt_ = maybeynopt "pager" rawopts + ,coloropt_ = maybeynaopt "color" rawopts ,debug_ = posintopt "debug" rawopts ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add ,width_ = maybestringopt "width" rawopts diff --git a/hledger/Hledger/Cli/Commands.hs b/hledger/Hledger/Cli/Commands.hs index 50324c4d4..377f80c58 100644 --- a/hledger/Hledger/Cli/Commands.hs +++ b/hledger/Hledger/Cli/Commands.hs @@ -327,7 +327,7 @@ printCommandsList progversion installedaddons = seq (length $ dbg8 "uninstalledknownaddons" uninstalledknownaddons) $ -- for debug output seq (length $ dbg8 "installedknownaddons" installedknownaddons) $ seq (length $ dbg8 "installedunknownaddons" installedunknownaddons) $ - pager $ unlines $ map unplus $ filter (not.isuninstalledaddon) $ + runPager $ unlines $ map unplus $ filter (not.isuninstalledaddon) $ commandsList progversion installedunknownaddons where knownaddons = knownAddonCommands diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 2e1c8e6ed..85eeb08b8 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -130,7 +130,7 @@ writeOutput opts s = do writeOutputLazyText :: CliOpts -> TL.Text -> IO () writeOutputLazyText opts s = do f <- outputFileFromOpts opts - maybe (pager . TL.unpack) TL.writeFile f s + maybe (runPager . TL.unpack) TL.writeFile f s -- -- | Get a journal from the given string and options, or throw an error. -- readJournal :: CliOpts -> String -> IO Journal