mirror of
https://github.com/simonmichael/hledger.git
synced 2024-10-06 10:57:30 +03:00
feat: config file: add a real parser, support command-specific options
This commit is contained in:
parent
4175dc50ac
commit
e1991be46f
@ -1275,21 +1275,23 @@ emptyorcommentlinep = do
|
||||
|
||||
{-# INLINABLE emptyorcommentlinep #-}
|
||||
|
||||
dp :: String -> TextParser m ()
|
||||
dp = const $ return () -- no-op
|
||||
-- dp = dbgparse 1 -- trace parse state at this --debug level
|
||||
|
||||
-- | A new comment line parser (from TimedotReader).
|
||||
-- Parse empty lines, all-blank lines, and lines beginning with any of
|
||||
-- the provided comment-beginning characters.
|
||||
emptyorcommentlinep' :: [Char] -> TextParser m ()
|
||||
emptyorcommentlinep' cs =
|
||||
label ("empty line or comment line beginning with "++cs) $ do
|
||||
-- traceparse "emptyorcommentlinep" -- XXX possible to combine label and traceparse ?
|
||||
skipNonNewlineSpaces
|
||||
void newline <|> void commentp
|
||||
-- traceparse' "emptyorcommentlinep"
|
||||
where
|
||||
commentp = do
|
||||
choice (map (some.char) cs)
|
||||
void $ takeWhileP Nothing (/='\n')
|
||||
void $ optional newline
|
||||
emptyorcommentlinep' cs = do
|
||||
dp "emptyorcommentlinep'"
|
||||
label ("empty line or comment line beginning with "++cs) $
|
||||
void commentp <|> void (try $ skipNonNewlineSpaces >> newline)
|
||||
where
|
||||
commentp = do
|
||||
choice (map (some.char) cs)
|
||||
void $ takeWhileP Nothing (/='\n')
|
||||
void $ optional newline
|
||||
|
||||
{-# INLINABLE emptyorcommentlinep' #-}
|
||||
|
||||
|
@ -190,7 +190,7 @@ shellchars = "<>(){}[]$7?#!~`"
|
||||
-- NB correctly handles "a'b" but not "''a''". Can raise an error if parsing fails.
|
||||
words' :: String -> [String]
|
||||
words' "" = []
|
||||
words' s = map stripquotes $ fromparse $ parsewithString p s
|
||||
words' s = map stripquotes $ fromparse $ parsewithString p s -- PARTIAL
|
||||
where
|
||||
p = (singleQuotedPattern <|> doubleQuotedPattern <|> patterns) `sepBy` skipNonNewlineSpaces1
|
||||
-- eof
|
||||
|
41
hledger.conf
41
hledger.conf
@ -1,14 +1,35 @@
|
||||
# hledger.conf
|
||||
# Extra general options (for now; and possibly arguments) to be added to hledger commands.
|
||||
# hledger.conf - extra options(/arguments) to be added to hledger commands.
|
||||
# This takes effect if found in the current directory when you run hledger.
|
||||
|
||||
# 1. This first, unnamed section is typically used for general options.
|
||||
# These affect all commands, or when not supported will be ignored.
|
||||
# To see the general options available, run hledger -h
|
||||
|
||||
# show prettier tables in terminal reports by default
|
||||
#--pretty
|
||||
# don't check balance assertions by default (run with -s to check them)
|
||||
--ignore-assertions
|
||||
|
||||
# don't check these by default (use -s when ready to check)
|
||||
#--ignore-assertions
|
||||
# always infer these
|
||||
--infer-costs
|
||||
--infer-equity
|
||||
--infer-market-prices
|
||||
|
||||
# infer more stuff by default
|
||||
#--infer-costs
|
||||
#--infer-equity
|
||||
#--infer-market-prices
|
||||
# always show prettier tables in terminal reports
|
||||
--pretty
|
||||
|
||||
|
||||
# 2. [named] sections define extra command-specific options.
|
||||
# Options can be written on the same line or separate lines.
|
||||
# To see a command's options, run hledger CMD -h
|
||||
|
||||
# help: prefer man pages, bypassing info
|
||||
[help] --man
|
||||
|
||||
# print: show more info by default
|
||||
[print] --explicit --show-costs
|
||||
|
||||
# balance: use these defaults
|
||||
[balance] --tree -p 'monthly from 3 months ago' --depth 3
|
||||
|
||||
# hledger-ui: reload on change (when started via `hledger ui`).
|
||||
# A -- is needed before addon-specific flags, as on command line.
|
||||
[ui] -- --watch
|
||||
|
@ -113,6 +113,7 @@ import Data.Function ((&))
|
||||
import Data.Functor ((<&>))
|
||||
import Control.Monad.Extra (unless)
|
||||
import Data.List.Extra (nubSort)
|
||||
import Data.Char (isDigit)
|
||||
|
||||
|
||||
-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
|
||||
@ -211,7 +212,8 @@ main = withGhcDebug' $ do
|
||||
-- If no command was provided, or if the command line contains a bad flag
|
||||
-- or a wrongly present/missing flag argument, cmd will be "".
|
||||
let
|
||||
cmd = parseArgsWithCmdargs cliargswithcmdfirst addons & either (const "") (stringopt "command")
|
||||
cmd = cmdargsParse cliargswithcmdfirst addons & stringopt "command"
|
||||
-- XXX may need a better error message when cmdargs fails to parse (eg spaced/quoted/malformed flag values)
|
||||
badcmdprovided = null cmd && not nocmdprovided
|
||||
isaddoncmd = not (null cmd) && cmd `elem` addons
|
||||
-- isbuiltincmd = cmd `elem` builtinCommandNames
|
||||
@ -225,21 +227,21 @@ main = withGhcDebug' $ do
|
||||
-- And insert them before the user's args, with adjustments, to get the final args.
|
||||
conf <- getConf
|
||||
let
|
||||
genargsfromconf = confArgsFor "general" conf
|
||||
cmdargsfromconf = if null cmd then [] else confArgsFor cmd conf
|
||||
genargsfromconf = confLookup "general" conf
|
||||
cmdargsfromconf = if null cmd then [] else confLookup cmd conf
|
||||
argsfromcli = drop 1 cliargswithcmdfirst
|
||||
finalargs = -- (avoid breaking vs code haskell highlighting..)
|
||||
(if null clicmdarg then [] else [clicmdarg]) <> genargsfromconf <> cmdargsfromconf <> argsfromcli
|
||||
& replaceNumericFlags -- convert any -NUM opts from the config file
|
||||
-- finalargs' <- expandArgsAt finalargs -- expand any @ARGFILEs from the config file ? don't bother
|
||||
|
||||
unless (null genargsfromconf) $ dbgIO ("extra general args from config file") genargsfromconf
|
||||
unless (null cmdargsfromconf) $ dbgIO ("extra "<>cmd<>" args from config file") cmdargsfromconf
|
||||
unless (null genargsfromconf) $ dbgIO ("extra general args from config file") genargsfromconf
|
||||
unless (null cmdargsfromconf) $ dbgIO ("extra command args from config file") cmdargsfromconf
|
||||
dbgIO "final args" finalargs
|
||||
|
||||
-- Now parse these in full, first to RawOpts with cmdargs, then to hledger CliOpts.
|
||||
-- At this point a bad flag or flag argument will cause the program to exit with an error.
|
||||
let rawopts = either usageError id $ parseArgsWithCmdargs finalargs addons
|
||||
let rawopts = cmdargsParse finalargs addons
|
||||
opts0 <- rawOptsToCliOpts rawopts
|
||||
let opts = opts0{progstarttime_=starttime}
|
||||
|
||||
@ -318,7 +320,7 @@ main = withGhcDebug' $ do
|
||||
| otherwise -> usageError $
|
||||
"could not understand the arguments "++show finalargs
|
||||
<> 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
|
||||
<> if null cmdargsfromconf then "" else "\ncommand arguments added from config file: "++show cmdargsfromconf
|
||||
|
||||
-- And we're done.
|
||||
-- Give ghc-debug a final chance to take control.
|
||||
@ -327,7 +329,6 @@ main = withGhcDebug' $ do
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
|
||||
|
||||
-- | A helper for addons/scripts: this parses hledger CliOpts from these
|
||||
-- command line arguments and add-on command names, roughly how hledger main does.
|
||||
-- If option parsing/validating fails, it exits the program with usageError.
|
||||
@ -336,14 +337,31 @@ main = withGhcDebug' $ do
|
||||
argsToCliOpts :: [String] -> [String] -> IO CliOpts
|
||||
argsToCliOpts args addons = do
|
||||
let args' = args & moveFlagsAfterCommand & replaceNumericFlags
|
||||
let rawopts = either usageError id $ parseArgsWithCmdargs args' addons
|
||||
let rawopts = cmdargsParse args' addons
|
||||
rawOptsToCliOpts rawopts
|
||||
|
||||
-- | 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] -> Either String RawOpts
|
||||
parseArgsWithCmdargs args addons = CmdArgs.process (mainmode addons) args
|
||||
-- If names of addon commands are provided, those too will be recognised.
|
||||
-- Also, convert a valueless --debug flag to one with a value.
|
||||
-- If parsing fails, exit the program with an informative error message.
|
||||
cmdargsParse :: [String] -> [String] -> RawOpts
|
||||
cmdargsParse args0 addons =
|
||||
CmdArgs.process (mainmode addons) args & either
|
||||
(\err -> error' $ unlines [
|
||||
"cmdargs: " <> err
|
||||
,"while processing arguments:"
|
||||
,show args
|
||||
])
|
||||
id
|
||||
where args = ensureDebugHasVal args0
|
||||
|
||||
-- Convert a valueless --debug flag to one with a value.
|
||||
-- See also the --debug flag definition in CliOptions.hs.
|
||||
-- This makes an equals sign unnecessary with this optional-value flag.
|
||||
ensureDebugHasVal as = case break (=="--debug") as of
|
||||
(bs,"--debug":c:cs) | null c || not (all isDigit c) -> bs++"--debug=1":c:cs
|
||||
(bs,["--debug"]) -> bs++["--debug=1"]
|
||||
_ -> as
|
||||
|
||||
-- | cmdargs does not allow flags (options) to appear before the subcommand name.
|
||||
-- We prefer to hide this restriction from the user, making the CLI more forgiving.
|
||||
|
@ -234,9 +234,10 @@ reportflags = [
|
||||
,flagOpt "yes" ["pretty"] (\s opts -> Right $ setopt "pretty" s opts) "YN"
|
||||
"Use box-drawing characters in text output? Can be\n'y'/'yes' or 'n'/'no'.\nIf YN is specified, the equals is required."
|
||||
|
||||
-- ,flagOpt "1" ["debug"] (\s opts -> Right $ setopt "debug" s opts) "LVL" "show debug output (levels 1-9, default: 1)"
|
||||
-- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL].
|
||||
-- But because we handle --debug specially, flagReq also works, and it does not need =, removing a source of confusion.
|
||||
-- ,flagOpt "1" ["debug"] (\s opts -> Right $ setopt "debug" s opts) "LVL" "show debug output (levels 1-9, default: 1)"
|
||||
-- (This involves specially adding the flag value if missing in Cli.hs.)
|
||||
,flagReq ["debug"] (\s opts -> Right $ setopt "debug" s opts) "[1-9]" "show this level of debug output (default: 1)"
|
||||
]
|
||||
|
||||
|
@ -1,6 +1,5 @@
|
||||
{-|
|
||||
Read extra CLI arguments from a hledger config file.
|
||||
Currently this reads only general options from ./hledger.conf if it exists.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
@ -8,19 +7,23 @@ Currently this reads only general options from ./hledger.conf if it exists.
|
||||
|
||||
module Hledger.Cli.Conf (
|
||||
getConf
|
||||
,confArgsFor
|
||||
,confLookup
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Exception (IOException, catch, tryJust)
|
||||
import Control.Monad (guard)
|
||||
import Data.Either (fromRight)
|
||||
import Data.List (isPrefixOf)
|
||||
import Control.Monad (guard, void)
|
||||
import Control.Monad.Identity (Identity)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T (pack)
|
||||
import System.IO.Error (isDoesNotExistError)
|
||||
import Text.Megaparsec -- hiding (parse)
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Hledger (error', strip)
|
||||
import Hledger (error', strip, words')
|
||||
import Hledger.Read.Common
|
||||
import Hledger.Utils.Parse
|
||||
|
||||
|
||||
localConfPath = "hledger.conf"
|
||||
@ -39,7 +42,12 @@ data ConfSection = ConfSection {
|
||||
,csArgs :: [Arg]
|
||||
} deriving (Eq,Show)
|
||||
|
||||
-- | The name of a config file section, with surrounding brackets and whitespace removed.
|
||||
type SectionName = String
|
||||
|
||||
-- | A command line argument to be passed to CmdArgs.process.
|
||||
-- It seems this should be a single command line argument (or flag or flag value).
|
||||
-- If it contains spaces, those are treated as part of a single argument, as with CMD a "b c".
|
||||
type Arg = String
|
||||
|
||||
nullconf = Conf {
|
||||
@ -49,40 +57,104 @@ nullconf = Conf {
|
||||
,confSections = []
|
||||
}
|
||||
|
||||
-- config reading
|
||||
|
||||
-- | 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.
|
||||
confLookup :: SectionName -> Conf -> [Arg]
|
||||
confLookup cmd Conf{confSections} =
|
||||
maybe [] (concatMap words') $ -- XXX PARTIAL
|
||||
M.lookup cmd $
|
||||
M.fromList [(csName,csArgs) | ConfSection{csName,csArgs} <- 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
|
||||
}
|
||||
es <- tryJust (guard . isDoesNotExistError) $ readFile f
|
||||
case es of
|
||||
Left _ -> return nullconf
|
||||
Right s ->
|
||||
case parseConf f (T.pack s) of
|
||||
Left err -> error' $ errorBundlePretty err -- customErrorBundlePretty err
|
||||
Right ss -> return nullconf{
|
||||
confFile = f
|
||||
,confText = s
|
||||
,confFormat = 1
|
||||
,confSections = ss
|
||||
}
|
||||
) `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
|
||||
-- config file parsing
|
||||
|
||||
parseConfSections :: [String] -> [ConfSection]
|
||||
parseConfSections _ = []
|
||||
parseConf :: FilePath -> Text -> Either (ParseErrorBundle Text HledgerParseErrorData) [ConfSection]
|
||||
parseConf = runParser confp
|
||||
|
||||
-- | 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]
|
||||
dp :: String -> TextParser m ()
|
||||
dp = const $ return () -- no-op
|
||||
-- dp = dbgparse 1 -- trace parse state at this --debug level
|
||||
|
||||
whitespacep, commentlinesp, restoflinep :: TextParser Identity ()
|
||||
whitespacep = void $ {- dp "whitespacep" >> -} many spacenonewline
|
||||
commentlinesp = void $ {- dp "commentlinesp" >> -} many (emptyorcommentlinep' "#")
|
||||
restoflinep = void $ {- dp "restoflinep" >> -} whitespacep >> emptyorcommentlinep' "#"
|
||||
|
||||
confp :: TextParser Identity [ConfSection] -- a monadic TextParser to allow reusing other hledger parsers
|
||||
confp = do
|
||||
dp "confp"
|
||||
commentlinesp
|
||||
genas <- many arglinep
|
||||
let s = ConfSection "general" genas
|
||||
ss <- many $ do
|
||||
(n, ma) <- sectionstartp
|
||||
as <- many arglinep
|
||||
return $ ConfSection n (maybe as (:as) ma)
|
||||
eof
|
||||
return $ s:ss
|
||||
|
||||
-- parse a section name and possibly arguments written on the same line
|
||||
sectionstartp :: TextParser Identity (String, Maybe String)
|
||||
sectionstartp = do
|
||||
dp "sectionstartp"
|
||||
char '['
|
||||
n <- fmap strip $ some $ noneOf "]#\n"
|
||||
char ']'
|
||||
-- dp "sectionstartp2"
|
||||
whitespacep
|
||||
-- dp "sectionstartp3"
|
||||
ma <- fmap (fmap strip) $ optional $ some $ noneOf "#\n"
|
||||
-- dp "sectionstartp4"
|
||||
restoflinep
|
||||
-- dp "sectionstartp5"
|
||||
commentlinesp
|
||||
-- dp "sectionstartp6"
|
||||
return (n, ma)
|
||||
|
||||
arglinep :: TextParser Identity String
|
||||
arglinep = do
|
||||
dp "arglinep"
|
||||
notFollowedBy $ char '['
|
||||
-- dp "arglinep2"
|
||||
whitespacep
|
||||
-- dp "arglinep3"
|
||||
a <- some $ noneOf "#\n"
|
||||
-- dp "arglinep4"
|
||||
restoflinep
|
||||
commentlinesp
|
||||
return $ strip a
|
||||
|
||||
|
||||
-- initialiseAndParseJournal :: ErroringJournalParser IO ParsedJournal -> InputOpts
|
||||
-- -> FilePath -> Text -> ExceptT String IO Journal
|
||||
-- initialiseAndParseJournal parser iopts f txt =
|
||||
-- prettyParseErrors $ runParserT (evalStateT parser initJournal) f txt
|
||||
-- where
|
||||
-- y = first3 . toGregorian $ _ioDay iopts
|
||||
-- initJournal = nulljournal{jparsedefaultyear = Just y, jincludefilestack = [f]}
|
||||
-- -- Flatten parse errors and final parse errors, and output each as a pretty String.
|
||||
-- prettyParseErrors :: ExceptT FinalParseError IO (Either (ParseErrorBundle Text HledgerParseErrorData) a)
|
||||
-- -> ExceptT String IO a
|
||||
-- prettyParseErrors = withExceptT customErrorBundlePretty . liftEither
|
||||
-- <=< withExceptT (finalErrorBundlePretty . attachSource f txt)
|
||||
|
Loading…
Reference in New Issue
Block a user