make "git annex help options" work outside a git repo

Option parsing for commands that run outside git repos is still screwy,
as there is no Annex monad and so the flags cannot be passed in. But,
any remaining parameters can be, which is enough for this fix.
This commit is contained in:
Joey Hess 2013-11-30 15:18:40 -04:00
parent 6edac746f0
commit fa3045aa8b
9 changed files with 31 additions and 24 deletions

View file

@ -55,8 +55,8 @@ start foreground stopdaemon autostart startdelay
{- Run outside a git repository. Check to see if any parameter is
- --autostart and enter autostart mode. -}
checkAutoStart :: IO ()
checkAutoStart = ifM (elem "--autostart" <$> getArgs)
checkAutoStart :: CmdParams -> IO ()
checkAutoStart _ = ifM (elem "--autostart" <$> getArgs)
( autoStart Nothing
, error "Not in a git repository."
)

View file

@ -23,20 +23,24 @@ import GitAnnex.Options
import System.Console.GetOpt
def :: [Command]
def = [noCommit $ noRepo showGeneralHelp $ dontCheck repoExists $
def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
command "help" paramNothing seek SectionQuery "display help"]
seek :: [CommandSeek]
seek = [withWords start]
start :: [String] -> CommandStart
start ["options"] = do
liftIO showCommonOptions
stop
start _ = do
liftIO showGeneralHelp
start params = do
liftIO $ start' params
stop
startNoRepo :: CmdParams -> IO ()
startNoRepo = start'
start' :: [String] -> IO ()
start' ["options"] = showCommonOptions
start' _ = showGeneralHelp
showCommonOptions :: IO ()
showCommonOptions = putStrLn $ usageInfo "Common options:" options

View file

@ -10,8 +10,6 @@ module Command.Upgrade where
import Common.Annex
import Command
import Upgrade
import Annex.Version
import Config
def :: [Command]
def = [dontCheck repoExists $ -- because an old version may not seem to exist

View file

@ -18,7 +18,7 @@ import qualified Remote
import qualified Backend
def :: [Command]
def = [noCommit $ noRepo showPackageVersion $ dontCheck repoExists $
def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
command "version" paramNothing seek SectionQuery "show version info"]
seek :: [CommandSeek]
@ -37,6 +37,9 @@ start = do
unwords upgradableVersions
stop
startNoRepo :: CmdParams -> IO ()
startNoRepo _ = showPackageVersion
showPackageVersion :: IO ()
showPackageVersion = do
info "git-annex version" SysConfig.packageversion

View file

@ -82,7 +82,7 @@ start' allowauto listenhost = do
else openBrowser browser htmlshim url origout origerr
)
auto
| allowauto = liftIO startNoRepo
| allowauto = liftIO $ startNoRepo []
| otherwise = do
d <- liftIO getCurrentDirectory
error $ "no git repository in " ++ d
@ -93,8 +93,8 @@ start' allowauto listenhost = do
{- When run without a repo, start the first available listed repository in
- the autostart file. If not, it's our first time being run! -}
startNoRepo :: IO ()
startNoRepo = do
startNoRepo :: CmdParams -> IO ()
startNoRepo _ = do
-- FIXME should be able to reuse regular getopt, but
-- it currently runs in the Annex monad.
args <- getArgs

View file

@ -12,7 +12,7 @@ import Command
import Assistant.XMPP.Git
def :: [Command]
def = [noCommit $ noRepo xmppGitRelay $ dontCheck repoExists $
def = [noCommit $ noRepo startNoRepo $ dontCheck repoExists $
command "xmppgit" paramNothing seek
SectionPlumbing "git to XMPP relay"]
@ -25,6 +25,9 @@ start _ = do
liftIO xmppGitRelay
stop
startNoRepo :: CmdParams -> IO ()
startNoRepo _ = xmppGitRelay
{- A basic implementation of the git-remote-helpers protocol. -}
gitRemoteHelper :: IO ()
gitRemoteHelper = do