hledger now detects and runs hledger-* add-ons found in path; many options cleanups

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
 

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)){
+            commandargsflag []){
-             modeHelpSuffix=[
+              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."
                  ]
            }

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
 

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)){
+            commandargsflag []){
-             modeHelpSuffix=[
+              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."
                  ]
            }

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)){
+            commandargsflag []){
-             modeHelpSuffix=[
+              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."
                  ]
            }

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
 

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
+  run' opts addons args
-
-runWith :: CliOpts -> IO ()
-runWith opts = run' opts
     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

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."
+ ,modeHelp = "run the specified hledger command. hledger COMMAND --help for more detail. \nIn general, COMMAND should precede OPTIONS."
- ,modeHelpSuffix = help_postscript
+ ,modeHelpSuffix = [""]
  ,modeGroupFlags = Group {
-     groupUnnamed = []
+     groupUnnamed = helpflags
-    ,groupHidden = []
+    ,groupHidden = [flagNone ["binary-filename"] (setboolopt "binary-filename") "show the download filename for this executable, and exit"]
-    ,groupNamed = [(generalflagstitle, generalflags1)]
+    ,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
+-- | Get all command-line options, specifying any extra commands that are allowed, or fail on parse errors.
--- just handles commonest cases
+getHledgerCliOpts :: [String] -> IO CliOpts
-moveFlagsAfterCommand (fflagandval@('-':'f':_:_):cmd:rest) = cmd:fflagandval:rest
+getHledgerCliOpts addons = do
-moveFlagsAfterCommand ("-f":fval:cmd:rest) = cmd:"-f":fval:rest
+  args <- getArgs
-moveFlagsAfterCommand as = as
+  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.
+-- workaround for http://code.google.com/p/ndmitchell/issues/detail?id=457
-getHledgerOpts :: IO CliOpts
+-- just handles commonest case, -f option before command
--- getHledgerOpts = processArgs mainmode >>= return . decodeRawOpts >>= toOpts >>= checkOpts
+tempMoveFlagsAfterCommand (fflagandval@('-':'f':_:_):cmd:rest) = cmd:fflagandval:rest
-getHledgerOpts = do
+tempMoveFlagsAfterCommand ("-f":fval:cmd:rest) = cmd:"-f":fval:rest
-  args <- getArgs
+tempMoveFlagsAfterCommand as = as
-  toCliOpts (decodeRawOpts $ processValue mainmode $ moveFlagsAfterCommand args) >>= checkCliOpts
-
--- utils
 
 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
+printModeHelpAndExit mode = putStr (showModeHelp mode) >> exitSuccess
-    where help = showText defaultWrap $ helpText HelpFormatDefault mode
+
+showModeHelp = showText defaultWrap . helpText HelpFormatDefault
 
 printVersionAndExit = putStrLn progversion >> exitSuccess