From 93b1f2b0ca1a356a9e6185d4f4129cfcb4efadc9 Mon Sep 17 00:00:00 2001
From: Simon Michael <simon@joyful.com>
Date: Mon, 29 Nov 2010 00:37:21 +0000
Subject: [PATCH] more correct args parsing, fix account filtering in
 hledger-web

---
 hledger-chart/Hledger/Chart/Main.hs |  4 ++--
 hledger-vty/Hledger/Vty/Main.hs     |  4 ++--
 hledger-web/Hledger/Web/Main.hs     |  4 ++--
 hledger/Hledger/Cli/Main.hs         | 10 ++++------
 hledger/Hledger/Cli/Options.hs      | 28 +++++++++++++---------------
 5 files changed, 23 insertions(+), 27 deletions(-)

diff --git a/hledger-chart/Hledger/Chart/Main.hs b/hledger-chart/Hledger/Chart/Main.hs
index 5af1bd24e..fe7d5fe9a 100644
--- a/hledger-chart/Hledger/Chart/Main.hs
+++ b/hledger-chart/Hledger/Chart/Main.hs
@@ -59,8 +59,8 @@ usage_chart = concat [
 
 main :: IO ()
 main = do
-  (opts, cmd, args) <- parseArgumentsWith (options_cli++options_chart) usage_chart
-  run opts (cmd:args)
+  (opts, args) <- parseArgumentsWith (options_cli++options_chart) usage_chart
+  run opts args
     where
       run opts args
        | Help `elem` opts             = putStr usage_chart
diff --git a/hledger-vty/Hledger/Vty/Main.hs b/hledger-vty/Hledger/Vty/Main.hs
index cd874e0ca..9a4b0bcf1 100644
--- a/hledger-vty/Hledger/Vty/Main.hs
+++ b/hledger-vty/Hledger/Vty/Main.hs
@@ -49,8 +49,8 @@ usage_vty = concat [
 
 main :: IO ()
 main = do
-  (opts, cmd, args) <- parseArgumentsWith (options_cli++options_vty) usage_vty
-  run opts (cmd:args)
+  (opts, args) <- parseArgumentsWith (options_cli++options_vty) usage_vty
+  run opts args
     where
       run opts args
        | Help `elem` opts             = putStr usage_vty
diff --git a/hledger-web/Hledger/Web/Main.hs b/hledger-web/Hledger/Web/Main.hs
index dc5d204f7..da3a46a1a 100644
--- a/hledger-web/Hledger/Web/Main.hs
+++ b/hledger-web/Hledger/Web/Main.hs
@@ -54,8 +54,8 @@ usage_web = concat [
 
 main :: IO ()
 main = do
-  (opts, cmd, args) <- parseArgumentsWith (options_cli++options_web) usage_web
-  run opts (cmd:args)
+  (opts, args) <- parseArgumentsWith (options_cli++options_web) usage_web
+  run opts args
     where
       run opts args
        | Help `elem` opts             = putStr usage_web
diff --git a/hledger/Hledger/Cli/Main.hs b/hledger/Hledger/Cli/Main.hs
index c44e160ea..01da32d26 100644
--- a/hledger/Hledger/Cli/Main.hs
+++ b/hledger/Hledger/Cli/Main.hs
@@ -54,14 +54,14 @@ import Hledger.Cli.Version (progversionstr, binaryfilename)
 
 main :: IO ()
 main = do
-  (opts, cmd, args) <- parseArgumentsWith options_cli usage_cli
-  run cmd opts args
+  (opts, args) <- parseArgumentsWith options_cli usage_cli
+  run opts args
     where
-      run cmd opts args
+      run _ []                        = putStr usage_cli
+      run opts (cmd:args)
        | Help `elem` opts             = putStr usage_cli
        | Version `elem` opts          = putStrLn $ progversionstr progname_cli
        | BinaryFilename `elem` opts   = putStrLn $ binaryfilename progname_cli
-       | null cmd                     = maybe (putStr usage_cli) (withJournalDo opts args cmd) defaultcmd
        | cmd `isPrefixOf` "balance"   = withJournalDo opts args cmd balance
        | cmd `isPrefixOf` "convert"   = withJournalDo opts args cmd convert
        | cmd `isPrefixOf` "print"     = withJournalDo opts args cmd print'
@@ -71,5 +71,3 @@ main = do
        | cmd `isPrefixOf` "stats"     = withJournalDo opts args cmd stats
        | cmd `isPrefixOf` "test"      = runtests opts args >> return ()
        | otherwise                    = putStr usage_cli
-
-      defaultcmd = Nothing
diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs
index a6bf22e68..27f5dc93b 100644
--- a/hledger/Hledger/Cli/Options.hs
+++ b/hledger/Hledger/Cli/Options.hs
@@ -141,22 +141,20 @@ optValuesForConstructor f opts = concatMap get opts
 optValuesForConstructors fs opts = concatMap get opts
     where get o = [v | any (\f -> f v == o) fs] where v = value o
 
--- | Parse the command-line arguments into options, command name (first
--- argument), and command arguments (rest of arguments), using the
--- specified options. Any smart dates in the options are converted to
--- explicit YYYY/MM/DD format based on the current time. If parsing fails,
--- raise an error, displaying the problem along with the specified usage
--- string.
-parseArgumentsWith :: [OptDescr Opt] -> String -> IO ([Opt], String, [String])
+-- | Parse the command-line arguments into options and arguments using the
+-- specified option descriptors. Any smart dates in the options are
+-- converted to explicit YYYY/MM/DD format based on the current time. If
+-- parsing fails, raise an error, displaying the problem along with the
+-- provided usage string.
+parseArgumentsWith :: [OptDescr Opt] -> String -> IO ([Opt], [String])
 parseArgumentsWith options usage = do
-  args <- liftM (map decodeString) getArgs
-  let (os,as,es) = getOpt Permute options args
-  os' <- fixOptDates os
-  let os'' = if Debug `elem` os' then Verbose:os' else os'
-  case (as,es) of
-    (cmd:args,[])   -> return (os'',cmd,args)
-    ([],[])         -> return (os'',"",[])
-    (_,errs)        -> ioError (userError' (concat errs ++ usage))
+  rawargs <- liftM (map decodeString) getArgs
+  let (opts,args,errs) = getOpt Permute options rawargs
+  opts' <- fixOptDates opts
+  let opts'' = if Debug `elem` opts' then Verbose:opts' else opts'
+  if null errs
+   then return (opts'',args)
+   else ioError $ userError' $ concat errs ++ usage
 
 -- | Convert any fuzzy dates within these option values to explicit ones,
 -- based on today's date.