diff --git a/hledger-chart/Hledger/Chart/Main.hs b/hledger-chart/Hledger/Chart/Main.hs index 312b21bed..6fd878af2 100644 --- a/hledger-chart/Hledger/Chart/Main.hs +++ b/hledger-chart/Hledger/Chart/Main.hs @@ -18,7 +18,7 @@ import Data.Maybe import Data.Ord import Data.Tree import Graphics.Rendering.Chart -import System.Exit (exitFailure) +import System.Exit import Text.Printf import Hledger @@ -38,7 +38,8 @@ runWith :: ChartOpts -> IO () runWith opts = run opts where run opts - | "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit chartmode + | "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp chartmode) >> exitSuccess + | "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) | otherwise = withJournalDo' opts chart diff --git a/hledger-chart/Hledger/Chart/Options.hs b/hledger-chart/Hledger/Chart/Options.hs index 8967a690d..f90dcd495 100644 --- a/hledger-chart/Hledger/Chart/Options.hs +++ b/hledger-chart/Hledger/Chart/Options.hs @@ -26,8 +26,13 @@ chartflags = [ chartmode = (mode "hledger-chart" [("command","chart")] "generate a pie chart image for the top account balances (of one sign only)" - commandargsflag (chartflags++generalflags1)){ - modeHelpSuffix=[ + commandargsflag []){ + modeGroupFlags = Group { + groupUnnamed = chartflags + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + ,modeHelpSuffix=[ -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui." ] } diff --git a/hledger-vty/Hledger/Vty/Main.hs b/hledger-vty/Hledger/Vty/Main.hs index 97c17d5c5..e86217f6d 100644 --- a/hledger-vty/Hledger/Vty/Main.hs +++ b/hledger-vty/Hledger/Vty/Main.hs @@ -13,6 +13,7 @@ import Data.Maybe import Data.Time.Calendar import Graphics.Vty import Safe +import System.Exit import Text.Printf import Hledger @@ -32,7 +33,8 @@ runWith :: VtyOpts -> IO () runWith opts = run opts where run opts - | "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit vtymode + | "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp vtymode) >> exitSuccess + | "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) | otherwise = withJournalDo' opts vty diff --git a/hledger-vty/Hledger/Vty/Options.hs b/hledger-vty/Hledger/Vty/Options.hs index 8093be94d..ede6a04be 100644 --- a/hledger-vty/Hledger/Vty/Options.hs +++ b/hledger-vty/Hledger/Vty/Options.hs @@ -19,8 +19,13 @@ vtyflags = [ vtymode = (mode "hledger-vty" [("command","vty")] "browse accounts, postings and entries in a full-window curses interface" - commandargsflag (vtyflags++generalflags1)){ - modeHelpSuffix=[ + commandargsflag []){ + modeGroupFlags = Group { + groupUnnamed = vtyflags + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + ,modeHelpSuffix=[ -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui." ] } diff --git a/hledger-web/Hledger/Web/Options.hs b/hledger-web/Hledger/Web/Options.hs index ddf611392..4de0ffe67 100644 --- a/hledger-web/Hledger/Web/Options.hs +++ b/hledger-web/Hledger/Web/Options.hs @@ -27,8 +27,13 @@ webflags = [ webmode = (mode "hledger-web" [("command","web")] "start serving the hledger web interface" - commandargsflag (webflags++generalflags1)){ - modeHelpSuffix=[ + commandargsflag []){ + modeGroupFlags = Group { + groupUnnamed = webflags + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + ,modeHelpSuffix=[ -- "Reads your ~/.hledger.journal file, or another specified by $LEDGER_FILE or -f, and starts the full-window curses ui." ] } diff --git a/hledger-web/hledger-web.hs b/hledger-web/hledger-web.hs index 95c2d8aa0..8bc0fc8c2 100644 --- a/hledger-web/hledger-web.hs +++ b/hledger-web/hledger-web.hs @@ -17,7 +17,7 @@ import Network.Wai.Handler.Warp (run) #else import Network.Wai.Middleware.Debug (debug) #endif -import System.Exit (exitFailure) +import System.Exit import System.IO.Storage (withStore, putValue) import Text.Printf import Yesod.Helpers.Static @@ -40,7 +40,8 @@ runWith :: WebOpts -> IO () runWith opts = run opts where run opts - | "help" `in_` (rawopts_ $ cliopts_ opts) = printModeHelpAndExit webmode + | "help" `in_` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp webmode) >> exitSuccess + | "version" `in_` (rawopts_ $ cliopts_ opts) = putStrLn progversion >> exitSuccess | "binary-filename" `in_` (rawopts_ $ cliopts_ opts) = putStrLn (binaryfilename progname) | otherwise = withJournalDo' opts web diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs index cab18f8eb..f0403d1b0 100644 --- a/hledger/Hledger/Cli/Main.hs +++ b/hledger/Hledger/Cli/Main.hs @@ -41,6 +41,10 @@ module Hledger.Cli.Main where import Control.Monad import Data.List +import Safe +import System.Environment +import System.Exit +import System.Process import Text.Printf import Hledger.Cli.Add @@ -54,15 +58,15 @@ import Hledger.Cli.Options import Hledger.Cli.Tests import Hledger.Cli.Utils import Hledger.Cli.Version +import Hledger.Utils main :: IO () main = do - opts <- getHledgerOpts + args <- getArgs + addons <- getHledgerAddonCommands + opts <- getHledgerCliOpts addons when (debug_ opts) $ printf "%s\n" progversion >> printf "opts: %s\n" (show opts) - runWith opts - -runWith :: CliOpts -> IO () -runWith opts = run' opts + run' opts addons args where cmd = command_ opts run' opts @@ -70,7 +74,7 @@ runWith opts = run' opts | any (cmd `isPrefixOf`) ["accounts","balance"] = showModeHelpOr accountsmode $ withJournalDo opts balance | any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram | cmd `isPrefixOf` "add" = showModeHelpOr addmode $ withJournalDo opts add - | cmd `isPrefixOf` "convert" = showModeHelpOr convertmode $ convert opts + | cmd `isPrefixOf` "convert" = showModeHelpOr convertmode $ withJournalDo opts convert | any (cmd `isPrefixOf`) ["entries","print"] = showModeHelpOr entriesmode $ withJournalDo opts print' | any (cmd `isPrefixOf`) ["postings","register"] = showModeHelpOr postingsmode $ withJournalDo opts register | cmd `isPrefixOf` "stats" = showModeHelpOr statsmode $ withJournalDo opts stats diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index 198af7bf2..b530de9c8 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -6,16 +6,20 @@ Command-line options for the hledger program, and option-parsing utilities. module Hledger.Cli.Options where --- import Data.List +import Data.List +import Data.List.Split import Data.Maybe import Data.Time.Calendar import Safe import System.Console.CmdArgs import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Text +import System.Directory import System.Environment import System.Exit import Test.HUnit +import Text.Parsec +import Text.Printf import Hledger.Cli.Format as Format import Hledger.Cli.Reports @@ -46,21 +50,20 @@ defmode = Mode { ,modeGroupModes = toGroup [] } -mainmode = defmode { +mainmode addons = defmode { modeNames = [progname] - ,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. When mixing general and command-specific flags, put them all after COMMAND." - ,modeHelpSuffix = help_postscript + ,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. \nIn general, COMMAND should precede OPTIONS." + ,modeHelpSuffix = [""] ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [(generalflagstitle, generalflags1)] + groupUnnamed = helpflags + ,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"] + ,groupNamed = [] } ,modeArgs = Just mainargsflag ,modeGroupModes = Group { groupUnnamed = [ ] ,groupHidden = [ - binaryfilenamemode ] ,groupNamed = [ ("Misc commands", [ @@ -77,9 +80,23 @@ mainmode = defmode { ,statsmode ]) ] + ++ case addons of [] -> [] + cs -> [("\nAdd-on commands found", map addonmode cs)] } } +addonmode name = defmode { + modeNames = [name] + ,modeHelp = printf "[-- OPTIONS] run the %s-%s program" progname name + ,modeValue=[("command",name)] + ,modeGroupFlags = Group { + groupUnnamed = [] + ,groupHidden = [] + ,groupNamed = [(generalflagstitle, generalflags1)] + } + ,modeArgs = Just addonargsflag + } + help_postscript = [ -- "DATES can be Y/M/D or smart dates like \"last month\"." -- ,"PATTERNS are regular" @@ -131,6 +148,8 @@ mainargsflag = flagArg f "" commandargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[PATTERNS]" +addonargsflag = flagArg (\s opts -> Right $ setopt "args" s opts) "[ARGS]" + commandmode names = defmode {modeNames=names, modeValue=[("command",headDef "" names)]} addmode = (commandmode ["add"]) { @@ -236,16 +255,6 @@ statsmode = (commandmode ["stats"]) { } } -binaryfilenamemode = (commandmode ["binaryfilename"]) { - modeHelp = "show the download filename for this hledger build, and exit" - ,modeArgs = Nothing - ,modeGroupFlags = Group { - groupUnnamed = [] - ,groupHidden = [] - ,groupNamed = [(generalflagstitle, generalflags3)] - } - } - -- 2. ADT holding options used in this package and above, parsed from RawOpts. -- This represents the command-line options that were provided, with all -- parsing completed, but before adding defaults or derived values (XXX add) @@ -314,23 +323,33 @@ toCliOpts rawopts = do } } --- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457 --- just handles commonest cases -moveFlagsAfterCommand (fflagandval@('-':'f':_:_):cmd:rest) = cmd:fflagandval:rest -moveFlagsAfterCommand ("-f":fval:cmd:rest) = cmd:"-f":fval:rest -moveFlagsAfterCommand as = as +-- | Get all command-line options, specifying any extra commands that are allowed, or fail on parse errors. +getHledgerCliOpts :: [String] -> IO CliOpts +getHledgerCliOpts addons = do + args <- getArgs + toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ tempMoveFlagsAfterCommand args) >>= checkCliOpts + +-- utils + +getHledgerAddonCommands :: IO [String] +getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerProgramsInPath + +getHledgerProgramsInPath :: IO [String] +getHledgerProgramsInPath = do + pathdirs <- splitOn ":" `fmap` getEnv "PATH" + pathexes <- concat `fmap` mapM getDirectoryContents pathdirs + return $ nub $ sort $ filter (isRight . parsewith hledgerprog) pathexes + where + hledgerprog = string progname >> char '-' >> many1 (letter <|> char '-') >> eof -- | Convert possibly encoded option values to regular unicode strings. decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val)) --- | Get all command-line options, failing on any parse errors. -getHledgerOpts :: IO CliOpts --- getHledgerOpts = processArgs mainmode >>= return . decodeRawOpts >>= toOpts >>= checkOpts -getHledgerOpts = do - args <- getArgs - toCliOpts (decodeRawOpts $ processValue mainmode $ moveFlagsAfterCommand args) >>= checkCliOpts - --- utils +-- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457 +-- just handles commonest case, -f option before command +tempMoveFlagsAfterCommand (fflagandval@('-':'f':_:_):cmd:rest) = cmd:fflagandval:rest +tempMoveFlagsAfterCommand ("-f":fval:cmd:rest) = cmd:"-f":fval:rest +tempMoveFlagsAfterCommand as = as optserror = error' . (++ " (run with --help for usage)") @@ -422,8 +441,9 @@ aliasesFromOpts = map parseAlias . alias_ alias' = case alias of ('=':rest) -> rest _ -> orig -printModeHelpAndExit mode = putStrLn progversion >> putStr help >> exitSuccess - where help = showText defaultWrap $ helpText HelpFormatDefault mode +printModeHelpAndExit mode = putStr (showModeHelp mode) >> exitSuccess + +showModeHelp = showText defaultWrap . helpText HelpFormatDefault printVersionAndExit = putStrLn progversion >> exitSuccess