From 204df227398acd0f03204728cc07c8df5c0d1f38 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 13 Jun 2024 19:11:06 +0100 Subject: [PATCH] feat: cli: basic config file support for hledger And some refactoring of command line parsing code. General options only, in ./hledger.conf, for now. --- hledger.conf | 14 ++++++ hledger/Hledger/Cli.hs | 97 ++++++++++++++++++++++++------------- hledger/Hledger/Cli/Conf.hs | 88 +++++++++++++++++++++++++++++++++ hledger/package.yaml | 3 +- 4 files changed, 167 insertions(+), 35 deletions(-) create mode 100644 hledger.conf create mode 100644 hledger/Hledger/Cli/Conf.hs diff --git a/hledger.conf b/hledger.conf new file mode 100644 index 000000000..ef8d4cb13 --- /dev/null +++ b/hledger.conf @@ -0,0 +1,14 @@ +# hledger.conf +# Extra general options (for now; and possibly arguments) to be added to hledger commands. +# To see the general options available, run hledger -h + +# show prettier tables in terminal reports by default +#--pretty + +# don't check these by default (use -s when ready to check) +#--ignore-assertions + +# infer more stuff by default +#--infer-costs +#--infer-equity +#--infer-market-prices diff --git a/hledger/Hledger/Cli.hs b/hledger/Hledger/Cli.hs index 15d19fcb3..501080901 100644 --- a/hledger/Hledger/Cli.hs +++ b/hledger/Hledger/Cli.hs @@ -75,6 +75,7 @@ module Hledger.Cli ( argsToCliOpts, -- * Re-exports module Hledger.Cli.CliOptions, + module Hledger.Cli.Conf, module Hledger.Cli.Commands, module Hledger.Cli.DocFiles, module Hledger.Cli.Utils, @@ -91,7 +92,7 @@ import qualified Data.List.NonEmpty as NE import Data.Time.Clock.POSIX (getPOSIXTime) import Safe import System.Console.CmdArgs.Explicit hiding (Name) -- don't clash with hledger-ui -import qualified System.Console.CmdArgs.Explicit as C +import qualified System.Console.CmdArgs.Explicit as CmdArgs import System.Environment import System.Exit import System.FilePath @@ -100,13 +101,18 @@ import Text.Printf import Hledger import Hledger.Cli.CliOptions +import Hledger.Cli.Conf import Hledger.Cli.Commands import Hledger.Cli.DocFiles import Hledger.Cli.Utils import Hledger.Cli.Version +import Data.Bifunctor (second) +import Data.Function ((&)) +import Data.Functor ((<&>)) -- | The overall cmdargs mode describing hledger's command-line options and subcommands. +-- The names of known addons are provided so they too can be recognised as commands. mainmode addons = defMode { modeNames = [progname ++ " [COMMAND]"] ,modeArgs = ([], Just $ argsFlag "[ARGS]") @@ -161,41 +167,53 @@ main = withGhcDebug' $ do -- command-line.test. -- some preliminary (imperfect) argument parsing to supplement cmdargs - args <- getArgs >>= expandArgsAt + rawcliargs <- getArgs >>= expandArgsAt let - args' = moveFlagsAfterCommand $ replaceNumericFlags args - isFlag = ("-" `isPrefixOf`) - isNonEmptyNonFlag s = not (isFlag s) && not (null s) - rawcmd = headDef "" $ takeWhile isNonEmptyNonFlag args' - isNullCommand = null rawcmd - (argsbeforecmd, argsaftercmd') = break (==rawcmd) args - argsaftercmd = drop 1 argsaftercmd' - dbgIO :: Show a => String -> a -> IO () + cliargswithcmdfirst = rawcliargs & replaceNumericFlags & moveFlagsAfterCommand + isNonEmptyNonFlag s = not $ null s || "-" `isPrefixOf` s + clicmdarg = headDef "" $ takeWhile isNonEmptyNonFlag cliargswithcmdfirst + isNullCommand = null clicmdarg + (rawcliargsbeforecmd, rawcliargsaftercmd) = second (drop 1) $ break (==clicmdarg) rawcliargs + dbgIO :: Show a => String -> a -> IO () -- type signature needed dbgIO = ptraceAtIO 8 dbgIO "running" prognameandversion - dbgIO "raw args" args - dbgIO "raw args rearranged for cmdargs" args' - dbgIO "raw command is probably" rawcmd - dbgIO "raw args before command" argsbeforecmd - dbgIO "raw args after command" argsaftercmd + dbgIO "raw cli args" rawcliargs + dbgIO "raw args before command" rawcliargsbeforecmd + dbgIO "raw args after command" rawcliargsaftercmd + dbgIO "raw cli args rearranged for cmdargs" cliargswithcmdfirst + dbgIO "command argument is probably" clicmdarg - -- Search PATH for add-ons, excluding any that match built-in command names - addons' <- hledgerAddons - let addons = filter (not . (`elem` builtinCommandNames) . dropExtension) addons' + -- search PATH for addon commands, excluding any that match builtin command names + addons <- hledgerAddons <&> filter (not . (`elem` builtinCommandNames) . dropExtension) - -- parse arguments with cmdargs - opts' <- argsToCliOpts args addons + -- do a preliminary parse with cmdargs to identify the full command name + let cmd = stringopt "command" $ parseArgsWithCmdargs cliargswithcmdfirst addons + + -- get any extra args/opts declared in a config file, both general and command-specific + conf <- getConf + let + genargsfromconf = confArgsFor "general" conf + cmdargsfromconf = confArgsFor cmd conf + dbgIO ("extra general args from config file") genargsfromconf + dbgIO ("extra "<>cmd<>" args from config file") cmdargsfromconf + + -- insert the config file args (before the others) and parse the lot with cmdargs + let + (clicmdarg',cliotherargs) = splitAt 1 cliargswithcmdfirst + allargswithcmdfirst = clicmdarg' <> genargsfromconf <> cmdargsfromconf <> cliotherargs & replaceNumericFlags + dbgIO "allargswithcmdfirst" allargswithcmdfirst + opts' <- argsToCliOpts allargswithcmdfirst addons + -- and save the start time let opts = opts'{progstarttime_=starttime} -- select an action and prepare to run it let - cmd = command_ opts -- the full matched internal or external command name, if any isInternalCommand = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons) isExternalCommand = not (null cmd) && cmd `elem` addons -- probably - isBadCommand = not (null rawcmd) && null cmd + isBadCommand = not (null clicmdarg) && null cmd printUsage = pager $ showModeUsage (mainmode addons) ++ "\n" - badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL: + badCommandError = error' ("command "++clicmdarg++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL: helpFlag = boolopt "help" $ rawopts_ opts tldrFlag = boolopt "tldr" $ rawopts_ opts infoFlag = boolopt "info" $ rawopts_ opts @@ -246,7 +264,7 @@ main = withGhcDebug' $ do -- addon commands | isExternalCommand = do - let externalargs = argsbeforecmd ++ filter (/="--") argsaftercmd + let externalargs = rawcliargsbeforecmd ++ filter (/="--") rawcliargsaftercmd let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String dbgIO "external command selected" cmd dbgIO "external command arguments" (map quoteIfNeeded externalargs) @@ -254,24 +272,35 @@ main = withGhcDebug' $ do system shellcmd >>= exitWith -- deprecated commands - -- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure + -- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure - -- shouldn't reach here - | otherwise = usageError ("could not understand the arguments "++show args) >> exitFailure + -- XXX shouldn't/doesn't reach here, but this output might be helpful + | otherwise = usageError $ + "could not understand the arguments "++show allargswithcmdfirst + <> if null genargsfromconf then "" else "\ngeneral arguments added from config file: "++show genargsfromconf + <> if null cmdargsfromconf then "" else "\ncommand "<>cmd<>" arguments added from config file: "++show cmdargsfromconf -- do it runHledgerCommand when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause' --- | Parse hledger CLI options from these command line arguments and --- add-on command names, or raise any error. +-- | Parse hledger CLI options from these command line arguments and add-on command names. +-- Or if it fails, exit the program with usageError. argsToCliOpts :: [String] -> [String] -> IO CliOpts -argsToCliOpts args addons = do - let - args' = moveFlagsAfterCommand $ replaceNumericFlags args - cmdargsopts = either usageError id $ C.process (mainmode addons) args' - rawOptsToCliOpts cmdargsopts +argsToCliOpts rawargs addons = do + -- Try to ensure the command argument is first, and rewrite -NUM flags + -- which cmdargs doesn't support. This is already done in main but + -- perhaps there are other users of this function. + let args = moveFlagsAfterCommand $ replaceNumericFlags rawargs + rawOptsToCliOpts $ parseArgsWithCmdargs args addons + +-- | Parse these command line arguments/options with cmdargs using mainmode. +-- The names of known addon commands are provided so they too can be recognised. +-- If it fails, exit the program with usageError. +parseArgsWithCmdargs :: [String] -> [String] -> RawOpts +parseArgsWithCmdargs args addons = + either usageError id $ CmdArgs.process (mainmode addons) args -- | A hacky workaround for cmdargs not accepting flags before the -- subcommand name: try to detect and move such flags after the diff --git a/hledger/Hledger/Cli/Conf.hs b/hledger/Hledger/Cli/Conf.hs new file mode 100644 index 000000000..b10a6505c --- /dev/null +++ b/hledger/Hledger/Cli/Conf.hs @@ -0,0 +1,88 @@ +{-| +Read extra CLI arguments from a hledger config file. +Currently this reads only general options from ./hledger.conf if it exists. +-} + +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Hledger.Cli.Conf ( + getConf + ,confArgsFor +) +where + +import Control.Exception (IOException, catch, tryJust) +import Control.Monad (guard) +import Data.Either (fromRight) +import Data.List (isPrefixOf) +import qualified Data.Map as M +import Data.Maybe +import System.IO.Error (isDoesNotExistError) + +import Hledger (error', strip) + + +localConfPath = "hledger.conf" + +-- | A hledger config file. +data Conf = Conf { + confFile :: FilePath + ,confText :: String + ,confFormat :: Int + ,confSections :: [ConfSection] +} deriving (Eq,Show) + +-- | One section in a hledger config file. +data ConfSection = ConfSection { + csName :: SectionName + ,csArgs :: [Arg] +} deriving (Eq,Show) + +type SectionName = String +type Arg = String + +nullconf = Conf { + confFile = "" + ,confText = "" + ,confFormat = 1 + ,confSections = [] +} + +-- | Try to read a hledger config file. +-- If none is found, this returns a null Conf. +-- Any other IO error will cause an exit. +getConf :: IO Conf +getConf = (do + let f = localConfPath + et <- tryJust (guard . isDoesNotExistError) $ readFile f + let f' = either (const "") (const f) et + let t = fromRight "" et + return $ nullconf { + confFile = f' + ,confText = t + ,confFormat = 1 + ,confSections = parseConf t + } + ) `catch` \(e :: IOException) -> error' $ show e + +-- | Parse the content of a hledger config file +-- (a limited prototype, only reads general options until the first [sectionheading]). +parseConf :: String -> [ConfSection] +parseConf s = + let + conflines = filter (\l -> not $ null l || "#" `isPrefixOf` l) $ map strip $ lines s + (ls1,rest) = break (("[" `isPrefixOf`)) conflines -- XXX also breaks on lines like " [..." + in + ConfSection "general" ls1 : parseConfSections rest + +parseConfSections :: [String] -> [ConfSection] +parseConfSections _ = [] + +-- | Fetch all the arguments/options defined in a section with this name, if it exists. +-- This should be "general" for the unnamed first section, or a hledger command name. +confArgsFor :: SectionName -> Conf -> [Arg] +confArgsFor cmd Conf{confSections} = + fromMaybe [] $ + M.lookup cmd $ + M.fromList [(csName,csArgs) | ConfSection{csName,csArgs} <- confSections] diff --git a/hledger/package.yaml b/hledger/package.yaml index 0963553bd..dc1dc8da0 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -164,6 +164,7 @@ library: cpp-options: -DVERSION="1.34.99" exposed-modules: - Hledger.Cli + - Hledger.Cli.Anon - Hledger.Cli.CliOptions - Hledger.Cli.Commands - Hledger.Cli.Commands.Accounts @@ -195,7 +196,7 @@ library: - Hledger.Cli.Commands.Stats - Hledger.Cli.Commands.Tags - Hledger.Cli.CompoundBalanceCommand - - Hledger.Cli.Anon + - Hledger.Cli.Conf - Hledger.Cli.DocFiles - Hledger.Cli.Script - Hledger.Cli.Utils