aboutsummaryrefslogtreecommitdiff
path: root/CmdLine.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-08-19 12:55:01 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-08-19 12:55:15 -0400
commit764d73be5d1a4cd3876a39bb19acf44290222076 (patch)
tree852c0fee6b90fe0c75d455d83962eca32ccffb2b /CmdLine.hs
parent52fc6cd95aa278cdf438041c717edc1bc009c160 (diff)
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.
Diffstat (limited to 'CmdLine.hs')
-rw-r--r--CmdLine.hs45
1 files changed, 24 insertions, 21 deletions
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
]