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:
parent
6edac746f0
commit
fa3045aa8b
9 changed files with 31 additions and 24 deletions
|
@ -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."
|
||||
)
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue