mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-18 17:57:11 +03:00
feat: cli: basic config file support for hledger
And some refactoring of command line parsing code. General options only, in ./hledger.conf, for now.
This commit is contained in:
parent
6c47fa034a
commit
204df22739
14
hledger.conf
Normal file
14
hledger.conf
Normal file
@ -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
|
@ -75,6 +75,7 @@ module Hledger.Cli (
|
|||||||
argsToCliOpts,
|
argsToCliOpts,
|
||||||
-- * Re-exports
|
-- * Re-exports
|
||||||
module Hledger.Cli.CliOptions,
|
module Hledger.Cli.CliOptions,
|
||||||
|
module Hledger.Cli.Conf,
|
||||||
module Hledger.Cli.Commands,
|
module Hledger.Cli.Commands,
|
||||||
module Hledger.Cli.DocFiles,
|
module Hledger.Cli.DocFiles,
|
||||||
module Hledger.Cli.Utils,
|
module Hledger.Cli.Utils,
|
||||||
@ -91,7 +92,7 @@ import qualified Data.List.NonEmpty as NE
|
|||||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||||
import Safe
|
import Safe
|
||||||
import System.Console.CmdArgs.Explicit hiding (Name) -- don't clash with hledger-ui
|
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.Environment
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
@ -100,13 +101,18 @@ import Text.Printf
|
|||||||
|
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
|
import Hledger.Cli.Conf
|
||||||
import Hledger.Cli.Commands
|
import Hledger.Cli.Commands
|
||||||
import Hledger.Cli.DocFiles
|
import Hledger.Cli.DocFiles
|
||||||
import Hledger.Cli.Utils
|
import Hledger.Cli.Utils
|
||||||
import Hledger.Cli.Version
|
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 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 {
|
mainmode addons = defMode {
|
||||||
modeNames = [progname ++ " [COMMAND]"]
|
modeNames = [progname ++ " [COMMAND]"]
|
||||||
,modeArgs = ([], Just $ argsFlag "[ARGS]")
|
,modeArgs = ([], Just $ argsFlag "[ARGS]")
|
||||||
@ -161,41 +167,53 @@ main = withGhcDebug' $ do
|
|||||||
-- command-line.test.
|
-- command-line.test.
|
||||||
|
|
||||||
-- some preliminary (imperfect) argument parsing to supplement cmdargs
|
-- some preliminary (imperfect) argument parsing to supplement cmdargs
|
||||||
args <- getArgs >>= expandArgsAt
|
rawcliargs <- getArgs >>= expandArgsAt
|
||||||
let
|
let
|
||||||
args' = moveFlagsAfterCommand $ replaceNumericFlags args
|
cliargswithcmdfirst = rawcliargs & replaceNumericFlags & moveFlagsAfterCommand
|
||||||
isFlag = ("-" `isPrefixOf`)
|
isNonEmptyNonFlag s = not $ null s || "-" `isPrefixOf` s
|
||||||
isNonEmptyNonFlag s = not (isFlag s) && not (null s)
|
clicmdarg = headDef "" $ takeWhile isNonEmptyNonFlag cliargswithcmdfirst
|
||||||
rawcmd = headDef "" $ takeWhile isNonEmptyNonFlag args'
|
isNullCommand = null clicmdarg
|
||||||
isNullCommand = null rawcmd
|
(rawcliargsbeforecmd, rawcliargsaftercmd) = second (drop 1) $ break (==clicmdarg) rawcliargs
|
||||||
(argsbeforecmd, argsaftercmd') = break (==rawcmd) args
|
dbgIO :: Show a => String -> a -> IO () -- type signature needed
|
||||||
argsaftercmd = drop 1 argsaftercmd'
|
|
||||||
dbgIO :: Show a => String -> a -> IO ()
|
|
||||||
dbgIO = ptraceAtIO 8
|
dbgIO = ptraceAtIO 8
|
||||||
|
|
||||||
dbgIO "running" prognameandversion
|
dbgIO "running" prognameandversion
|
||||||
dbgIO "raw args" args
|
dbgIO "raw cli args" rawcliargs
|
||||||
dbgIO "raw args rearranged for cmdargs" args'
|
dbgIO "raw args before command" rawcliargsbeforecmd
|
||||||
dbgIO "raw command is probably" rawcmd
|
dbgIO "raw args after command" rawcliargsaftercmd
|
||||||
dbgIO "raw args before command" argsbeforecmd
|
dbgIO "raw cli args rearranged for cmdargs" cliargswithcmdfirst
|
||||||
dbgIO "raw args after command" argsaftercmd
|
dbgIO "command argument is probably" clicmdarg
|
||||||
|
|
||||||
-- Search PATH for add-ons, excluding any that match built-in command names
|
-- search PATH for addon commands, excluding any that match builtin command names
|
||||||
addons' <- hledgerAddons
|
addons <- hledgerAddons <&> filter (not . (`elem` builtinCommandNames) . dropExtension)
|
||||||
let addons = filter (not . (`elem` builtinCommandNames) . dropExtension) addons'
|
|
||||||
|
|
||||||
-- parse arguments with cmdargs
|
-- do a preliminary parse with cmdargs to identify the full command name
|
||||||
opts' <- argsToCliOpts args addons
|
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}
|
let opts = opts'{progstarttime_=starttime}
|
||||||
|
|
||||||
-- select an action and prepare to run it
|
-- select an action and prepare to run it
|
||||||
let
|
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)
|
isInternalCommand = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons)
|
||||||
isExternalCommand = not (null cmd) && cmd `elem` addons -- probably
|
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"
|
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
|
helpFlag = boolopt "help" $ rawopts_ opts
|
||||||
tldrFlag = boolopt "tldr" $ rawopts_ opts
|
tldrFlag = boolopt "tldr" $ rawopts_ opts
|
||||||
infoFlag = boolopt "info" $ rawopts_ opts
|
infoFlag = boolopt "info" $ rawopts_ opts
|
||||||
@ -246,7 +264,7 @@ main = withGhcDebug' $ do
|
|||||||
|
|
||||||
-- addon commands
|
-- addon commands
|
||||||
| isExternalCommand = do
|
| isExternalCommand = do
|
||||||
let externalargs = argsbeforecmd ++ filter (/="--") argsaftercmd
|
let externalargs = rawcliargsbeforecmd ++ filter (/="--") rawcliargsaftercmd
|
||||||
let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String
|
let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String
|
||||||
dbgIO "external command selected" cmd
|
dbgIO "external command selected" cmd
|
||||||
dbgIO "external command arguments" (map quoteIfNeeded externalargs)
|
dbgIO "external command arguments" (map quoteIfNeeded externalargs)
|
||||||
@ -254,24 +272,35 @@ main = withGhcDebug' $ do
|
|||||||
system shellcmd >>= exitWith
|
system shellcmd >>= exitWith
|
||||||
|
|
||||||
-- deprecated commands
|
-- deprecated commands
|
||||||
-- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure
|
-- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure
|
||||||
|
|
||||||
-- shouldn't reach here
|
-- XXX shouldn't/doesn't reach here, but this output might be helpful
|
||||||
| otherwise = usageError ("could not understand the arguments "++show args) >> exitFailure
|
| 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
|
-- do it
|
||||||
runHledgerCommand
|
runHledgerCommand
|
||||||
|
|
||||||
when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause'
|
when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause'
|
||||||
|
|
||||||
-- | Parse hledger CLI options from these command line arguments and
|
-- | Parse hledger CLI options from these command line arguments and add-on command names.
|
||||||
-- add-on command names, or raise any error.
|
-- Or if it fails, exit the program with usageError.
|
||||||
argsToCliOpts :: [String] -> [String] -> IO CliOpts
|
argsToCliOpts :: [String] -> [String] -> IO CliOpts
|
||||||
argsToCliOpts args addons = do
|
argsToCliOpts rawargs addons = do
|
||||||
let
|
-- Try to ensure the command argument is first, and rewrite -NUM flags
|
||||||
args' = moveFlagsAfterCommand $ replaceNumericFlags args
|
-- which cmdargs doesn't support. This is already done in main but
|
||||||
cmdargsopts = either usageError id $ C.process (mainmode addons) args'
|
-- perhaps there are other users of this function.
|
||||||
rawOptsToCliOpts cmdargsopts
|
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
|
-- | A hacky workaround for cmdargs not accepting flags before the
|
||||||
-- subcommand name: try to detect and move such flags after the
|
-- subcommand name: try to detect and move such flags after the
|
||||||
|
88
hledger/Hledger/Cli/Conf.hs
Normal file
88
hledger/Hledger/Cli/Conf.hs
Normal file
@ -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]
|
@ -164,6 +164,7 @@ library:
|
|||||||
cpp-options: -DVERSION="1.34.99"
|
cpp-options: -DVERSION="1.34.99"
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
- Hledger.Cli
|
- Hledger.Cli
|
||||||
|
- Hledger.Cli.Anon
|
||||||
- Hledger.Cli.CliOptions
|
- Hledger.Cli.CliOptions
|
||||||
- Hledger.Cli.Commands
|
- Hledger.Cli.Commands
|
||||||
- Hledger.Cli.Commands.Accounts
|
- Hledger.Cli.Commands.Accounts
|
||||||
@ -195,7 +196,7 @@ library:
|
|||||||
- Hledger.Cli.Commands.Stats
|
- Hledger.Cli.Commands.Stats
|
||||||
- Hledger.Cli.Commands.Tags
|
- Hledger.Cli.Commands.Tags
|
||||||
- Hledger.Cli.CompoundBalanceCommand
|
- Hledger.Cli.CompoundBalanceCommand
|
||||||
- Hledger.Cli.Anon
|
- Hledger.Cli.Conf
|
||||||
- Hledger.Cli.DocFiles
|
- Hledger.Cli.DocFiles
|
||||||
- Hledger.Cli.Script
|
- Hledger.Cli.Script
|
||||||
- Hledger.Cli.Utils
|
- Hledger.Cli.Utils
|
||||||
|
Loading…
Reference in New Issue
Block a user