diff --git a/extra/hledger-print-unique.hs b/extra/hledger-print-unique.hs index 182a898be..3417d9b4e 100755 --- a/extra/hledger-print-unique.hs +++ b/extra/hledger-print-unique.hs @@ -11,14 +11,12 @@ import Data.List import Data.Ord import Hledger import Hledger.Cli -import Hledger.Cli.Print (print') main = do - opts <- getHledgerCliOpts [] + opts <- getCliOpts (defCommandMode ["hledger-print-unique"]) withJournalDo opts $ \opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts} where uniquify = nubBy (\t1 t2 -> thingToCompare t1 == thingToCompare t2) . sortBy (comparing thingToCompare) - -thingToCompare = tdescription --- thingToCompare = tdate + thingToCompare = tdescription + -- thingToCompare = tdate diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs index 396deaffd..62284191a 100644 --- a/hledger-web/Hledger/Web/Main.hs +++ b/hledger-web/Hledger/Web/Main.hs @@ -40,9 +40,9 @@ main = do runWith :: WebOpts -> IO () runWith opts - | "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp webmode) >> exitSuccess - | "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess - | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) + | "help" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp webmode) >> exitSuccess + | "version" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess + | "binary-filename" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) | otherwise = do requireJournalFileExists =<< journalFilePathFromOpts (cliopts_ opts) withJournalDo' opts web diff --git a/hledger-web/Hledger/Web/Options.hs b/hledger-web/Hledger/Web/Options.hs index 9a34ed16c..43b0e2735 100644 --- a/hledger-web/Hledger/Web/Options.hs +++ b/hledger-web/Hledger/Web/Options.hs @@ -31,11 +31,11 @@ webflags = [ webmode :: Mode [([Char], [Char])] webmode = (mode "hledger-web" [("command","web")] "start serving the hledger web interface" - mainargsflag []){ + (argsFlag "[PATTERNS]") []){ modeGroupFlags = Group { groupUnnamed = webflags ,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"] - ,groupNamed = [(generalflagstitle, generalflags1)] + ,groupNamed = [generalflagsgroup1] } ,modeHelpSuffix=[ -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui." @@ -61,7 +61,7 @@ defwebopts = WebOpts toWebOpts :: RawOpts -> IO WebOpts toWebOpts rawopts = do - cliopts <- toCliOpts rawopts + cliopts <- rawOptsToCliOpts rawopts let p = fromMaybe defport $ maybeintopt "port" rawopts return defwebopts { port_ = p diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index 2bc92e5af..e934d1e0b 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -99,7 +99,7 @@ main = do addons <- getHledgerAddonCommands -- parse arguments with cmdargs - opts <- getHledgerCliOpts addons + opts <- argsToCliOpts args addons -- select an action and run it. let diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index ad3d9a5f5..54ee19b04 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -7,7 +7,7 @@ Command-line options for the hledger program, and related utilities. module Hledger.Cli.Options ( - -- * cmdargs modes + -- * cmdargs modes & flags -- | These tell cmdargs how to parse the command line arguments. -- There's one mode for each internal subcommand, plus a main mode. mainmode, @@ -22,7 +22,15 @@ module Hledger.Cli.Options ( statsmode, testmode, convertmode, - + defCommandMode, + argsFlag, + helpflags, + inputflags, + reportflags, + generalflagsgroup1, + generalflagsgroup2, + generalflagsgroup3, + -- * raw options -- | To allow the cmdargs modes to be reused and extended by other -- packages (eg, add-ons which want to mimic the standard hledger @@ -30,6 +38,14 @@ module Hledger.Cli.Options ( -- association list, not a fixed ADT. RawOpts, inRawOpts, + boolopt, + intopt, + maybeintopt, + stringopt, + maybestringopt, + listofstringopt, + setopt, + setboolopt, -- * CLI options -- | Raw options are converted to a more convenient, @@ -37,10 +53,9 @@ module Hledger.Cli.Options ( -- throughout hledger CLI code. CliOpts(..), defcliopts, - toCliOpts, -- * CLI option accessors - -- | Some options require more processing. Possibly these should be merged into toCliOpts. + -- | Some options require more processing. Possibly these should be merged into argsToCliOpts. aliasesFromOpts, formatFromOpts, journalFilePathFromOpts, @@ -53,10 +68,15 @@ module Hledger.Cli.Options ( -- * utilities getHledgerAddonCommands, - getHledgerCliOpts, + argsToCliOpts, moveFlagsAfterCommand, + decodeRawOpts, + checkCliOpts, + rawOptsToCliOpts, optserror, showModeHelp, + debugArgs, + getCliOpts, -- * tests tests_Hledger_Cli_Options @@ -66,9 +86,11 @@ where import qualified Control.Exception as C -- import Control.Monad (filterM) +import Control.Monad (when) import Data.List import Data.List.Split import Data.Maybe +import Data.PPrint (pprint) import Data.Time.Calendar import Safe import System.Console.CmdArgs @@ -76,6 +98,7 @@ import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Text import System.Directory import System.Environment +import System.Exit import Test.HUnit import Text.ParserCombinators.Parsec as P import Text.Printf @@ -107,7 +130,7 @@ helpflags = [ inputflags = [ flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different journal file; - means stdin" ,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RULESFILE" "conversion rules for CSV (default: FILE.rules)" - ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "ACCT=ALIAS" "display ACCT's name as ALIAS in reports" + ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "ACCT=ALIAS" "convert ACCT's name to ALIAS" ] -- | Common report-related flags: --period, --cost, --display etc. @@ -137,7 +160,9 @@ generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags) generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags) generalflagsgroup3 = (generalflagstitle, helpflags) --- | Template for creating our modes. +-- cmdargs modes + +-- | A basic mode template. defMode :: Mode RawOpts defMode = Mode { modeNames = [] @@ -147,11 +172,44 @@ defMode = Mode { ,modeCheck = Right ,modeReform = const Nothing ,modeExpandAt = True - ,modeGroupFlags = toGroup [] + ,modeGroupFlags = Group { + groupNamed = [] + ,groupUnnamed = [ + flagNone ["help","h","?"] (setboolopt "help") "Display command help." + ] + ,groupHidden = [] + } ,modeArgs = ([], Nothing) ,modeGroupModes = toGroup [] } +-- | A basic subcommand mode with the given command name(s). +defCommandMode names = defMode { + modeNames=names + ,modeValue=[("command", headDef "" names)] + ,modeArgs = ([], Just $ argsFlag "[PATTERNS]") + } + +-- | A basic subcommand mode suitable for an add-on command. +defAddonCommandMode addon = defMode { + modeNames = [addon] + ,modeHelp = printf "run %s-%s" progname addon + ,modeValue=[("command",addon)] + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [generalflagsgroup1] + } + ,modeArgs = ([], Just $ argsFlag "[ARGS]") + } + +-- | Add command aliases to the command's help string. +withAliases :: String -> [String] -> String +s `withAliases` [] = s +s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")" +s `withAliases` as = s ++ " (aliases: " ++ intercalate ", " as ++ ")" + + -- | The top-level cmdargs mode for hledger. mainmode addons = defMode { modeNames = [progname] @@ -211,49 +269,7 @@ mainmode addons = defMode { -- -- ,"When using both, not: comes last." -- ] --- --- cmdargs modes for subcommands --- - --- | Make a basic command mode given the command's name and any aliases. -defCommandMode names = defMode { - modeNames=names - ,modeValue=[("command", headDef "" names)] - ,modeArgs = ([], Just $ argsFlag "[PATTERNS]") - } - --- | Make a basic command mode suitable for an add-on command. -defAddonCommandMode addon = defMode { - modeNames = [addon] - ,modeHelp = printf "run %s-%s" progname addon - ,modeValue=[("command",addon)] - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [generalflagsgroup1] - } - ,modeArgs = ([], Just $ argsFlag "[ARGS]") - } - -withAliases :: String -> [String] -> String -s `withAliases` [] = s -s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")" -s `withAliases` as = s ++ " (aliases: " ++ intercalate ", " as ++ ")" - --- hidden commands - -convertmode = (defCommandMode ["convert"]) { - modeValue = [("command","convert")] - ,modeHelp = "convert is no longer needed, just use -f FILE.csv" - ,modeArgs = ([], Just $ argsFlag "[CSVFILE]") - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = helpflags - ,groupNamed = [] - } - } - --- visible commands +-- visible subcommand modes addmode = (defCommandMode ["add"]) { modeHelp = "prompt for new transaction entries and add them to the journal" @@ -375,6 +391,19 @@ testmode = (defCommandMode ["test"]) { } } +-- hidden commands + +convertmode = (defCommandMode ["convert"]) { + modeValue = [("command","convert")] + ,modeHelp = "convert is no longer needed, just use -f FILE.csv" + ,modeArgs = ([], Just $ argsFlag "[CSVFILE]") + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = helpflags + ,groupNamed = [] + } + } + -- -- 2. A package-specific data structure holding options used in this -- package and above, parsed from RawOpts. This represents the @@ -411,8 +440,8 @@ instance Default CliOpts where def = defcliopts -- | Parse raw option string values to the desired final data types. -- Any relative smart dates will be converted to fixed dates based on -- today's date. Parsing failures will raise an error. -toCliOpts :: RawOpts -> IO CliOpts -toCliOpts rawopts = do +rawOptsToCliOpts :: RawOpts -> IO CliOpts +rawOptsToCliOpts rawopts = do d <- getCurrentDay return defcliopts { rawopts_ = rawopts @@ -451,16 +480,15 @@ toCliOpts rawopts = do } } --- | Parse hledger CLI options from the command line arguments and --- specified add-on command names, or raise any error. -getHledgerCliOpts :: [String] -> IO CliOpts -getHledgerCliOpts addons = do - args <- getArgs +-- | Parse hledger CLI options from these command line arguments and +-- add-on command names, or raise any error. +argsToCliOpts :: [String] -> [String] -> IO CliOpts +argsToCliOpts args addons = do let args' = moveFlagsAfterCommand args cmdargsopts = System.Console.CmdArgs.Explicit.processValue (mainmode addons) args' cmdargsopts' = decodeRawOpts cmdargsopts - toCliOpts cmdargsopts' >>= checkCliOpts + rawOptsToCliOpts cmdargsopts' >>= checkCliOpts -- | A hacky workaround for cmdargs not accepting flags before the -- subcommand name: try to detect and move such flags after the @@ -505,7 +533,9 @@ checkCliOpts opts@CliOpts{reportopts_=ropts} = do Right _ -> return () return opts +-- -- utils +-- -- | Get the unique suffixes (without hledger-) of hledger-* executables -- found in the current user's PATH, or the empty list if there is any @@ -677,6 +707,31 @@ showModeHelp = . (helpText [] HelpFormatDefault :: Mode a -> [Text]) +-- | Print debug info about arguments and options if --debug is present. +debugArgs :: [String] -> CliOpts -> IO () +debugArgs args opts = + when ("--debug" `elem` args) $ do + progname <- getProgName + putStrLn $ "running: " ++ progname + putStrLn $ "raw args: " ++ show args + putStrLn $ "processed opts:\n" ++ show opts + putStrLn . show =<< pprint opts + d <- getCurrentDay + putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts) + +-- | Parse hledger CLI options from the command line using the given +-- cmdargs mode, and either return them or, if a help flag is present, +-- print the mode help and exit the program. +getCliOpts :: Mode RawOpts -> IO CliOpts +getCliOpts mode = do + args <- getArgs + let rawopts = decodeRawOpts $ processValue mode args + opts <- rawOptsToCliOpts rawopts >>= checkCliOpts + debugArgs args opts + -- if any (`elem` args) ["--help","-h","-?"] + when ("help" `inRawOpts` rawopts_ opts) $ + putStr (showModeHelp mode) >> exitSuccess + return opts tests_Hledger_Cli_Options = TestList [