From 764d73be5d1a4cd3876a39bb19acf44290222076 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Tue, 19 Aug 2014 12:55:01 -0400
Subject: Make --help work when not in a git repository. Closes: #758592

Note that this means getopt parsing is done even when not in a git
repository, even though currently cmdnorepo is not passed the results of
it. I'd like to move to cmdnorepo not doing its own ad-hoc option parsing,
so this is really a good thing. (But as long as eg, getOptionFlag needs an
Annex monad, it cannot be used in cmdnorepo handling.)

There is a potential for problems if any cmdnorepo branch of a command
handles options that are not in its regular getopt, but that would be a bug
anyway.
---
 CmdLine.hs | 45 ++++++++++++++++++++++++---------------------
 1 file changed, 24 insertions(+), 21 deletions(-)

(limited to 'CmdLine.hs')

diff --git a/CmdLine.hs b/CmdLine.hs
index a165b041a..a8d071ddf 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -6,6 +6,7 @@
  -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
 
 module CmdLine (
 	dispatch,
@@ -34,28 +35,30 @@ import Types.Messages
 dispatch :: Bool -> CmdParams -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO ()
 dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
 	setupConsole
-	r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
-	case r of
-		Left e -> maybe (throw e) (\a -> a params) (cmdnorepo cmd)
-		Right g -> do
-			state <- Annex.new g
-			Annex.eval state $ do
-				checkEnvironment
-				checkfuzzy
-				forM_ fields $ uncurry Annex.setField
-				when (cmdnomessages cmd) $ 
-					Annex.setOutput QuietOutput
-				sequence_ flags
-				whenM (annexDebug <$> Annex.getGitConfig) $
-					liftIO enableDebugOutput
-				startup
-				performCommandAction cmd params
-				shutdown $ cmdnocommit cmd
+	case getOptCmd args cmd commonoptions of
+		Right (flags, params) -> go flags params
+			=<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
+		Left parseerr -> error parseerr
   where
+	go flags params (Right g) = do
+		state <- Annex.new g
+		Annex.eval state $ do
+			checkEnvironment
+			checkfuzzy
+			forM_ fields $ uncurry Annex.setField
+			when (cmdnomessages cmd) $ 
+				Annex.setOutput QuietOutput
+			sequence_ flags
+			whenM (annexDebug <$> Annex.getGitConfig) $
+				liftIO enableDebugOutput
+			startup
+			performCommandAction cmd params
+			shutdown $ cmdnocommit cmd
+	go _flags params (Left e) =
+		maybe (throw e) (\a -> a params) (cmdnorepo cmd)
 	err msg = msg ++ "\n\n" ++ usage header allcmds
 	cmd = Prelude.head cmds
 	(fuzzy, cmds, name, args) = findCmd fuzzyok allargs allcmds err
-	(flags, params) = getOptCmd args cmd commonoptions
 	checkfuzzy = when fuzzy $
 		inRepo $ Git.AutoCorrect.prepare name cmdname cmds
 
@@ -81,12 +84,12 @@ findCmd fuzzyok argv cmds err
 
 {- Parses command line options, and returns actions to run to configure flags
  - and the remaining parameters for the command. -}
-getOptCmd :: CmdParams -> Command -> [Option] -> ([Annex ()], CmdParams)
+getOptCmd :: CmdParams -> Command -> [Option] -> Either String ([Annex ()], CmdParams)
 getOptCmd argv cmd commonoptions = check $
 	getOpt Permute (commonoptions ++ cmdoptions cmd) argv
   where
-	check (flags, rest, []) = (flags, rest)
-	check (_, _, errs) = error $ unlines
+	check (flags, rest, []) = Right (flags, rest)
+	check (_, _, errs) = Left $ unlines
 		[ concat errs
 		, commandUsage cmd
 		]
-- 
cgit v1.2.3