aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-11-30 15:18:40 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-11-30 15:18:40 -0400
commit440f3b1068a1d0a49dff1307124c4f7f0bcd6f5d (patch)
treedcc4b0c54f52b89aa95956c0e32cf6e781f17057
parentf04b34c4584e18f4c722700eda5e80eb0345f035 (diff)
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.
-rw-r--r--CmdLine.hs11
-rw-r--r--Command.hs2
-rw-r--r--Command/Assistant.hs4
-rw-r--r--Command/Help.hs16
-rw-r--r--Command/Upgrade.hs2
-rw-r--r--Command/Version.hs5
-rw-r--r--Command/WebApp.hs6
-rw-r--r--Command/XMPPGit.hs5
-rw-r--r--Types/Command.hs4
9 files changed, 31 insertions, 24 deletions
diff --git a/CmdLine.hs b/CmdLine.hs
index 83a89ef7d..7c28ecec8 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -32,16 +32,13 @@ import Annex.Environment
import Command
import Types.Messages
-type Params = [String]
-type Flags = [Annex ()]
-
{- Runs the passed command line. -}
-dispatch :: Bool -> Params -> [Command] -> [Option] -> [(String, String)] -> String -> IO Git.Repo -> IO ()
+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 -> fromMaybe (throw e) (cmdnorepo cmd)
+ Left e -> maybe (throw e) (\a -> a params) (cmdnorepo cmd)
Right g -> do
state <- Annex.new g
(actions, state') <- Annex.run state $ do
@@ -66,7 +63,7 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
{- Parses command line params far enough to find the Command to run, and
- returns the remaining params.
- Does fuzzy matching if necessary, which may result in multiple Commands. -}
-findCmd :: Bool -> Params -> [Command] -> (String -> String) -> (Bool, [Command], String, Params)
+findCmd :: Bool -> CmdParams -> [Command] -> (String -> String) -> (Bool, [Command], String, CmdParams)
findCmd fuzzyok argv cmds err
| isNothing name = error $ err "missing command"
| not (null exactcmds) = (False, exactcmds, fromJust name, args)
@@ -85,7 +82,7 @@ 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 :: Params -> Command -> [Option] -> (Flags, Params)
+getOptCmd :: CmdParams -> Command -> [Option] -> ([Annex ()], CmdParams)
getOptCmd argv cmd commonoptions = check $
getOpt Permute (commonoptions ++ cmdoptions cmd) argv
where
diff --git a/Command.hs b/Command.hs
index 2c157304f..b6484749e 100644
--- a/Command.hs
+++ b/Command.hs
@@ -55,7 +55,7 @@ noMessages c = c { cmdnomessages = True }
{- Adds a fallback action to a command, that will be run if it's used
- outside a git repository. -}
-noRepo :: IO () -> Command -> Command
+noRepo :: (CmdParams -> IO ()) -> Command -> Command
noRepo a c = c { cmdnorepo = Just a }
{- Adds options to a command. -}
diff --git a/Command/Assistant.hs b/Command/Assistant.hs
index 521a88571..cef4392dc 100644
--- a/Command/Assistant.hs
+++ b/Command/Assistant.hs
@@ -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."
)
diff --git a/Command/Help.hs b/Command/Help.hs
index c77f739c1..71e767663 100644
--- a/Command/Help.hs
+++ b/Command/Help.hs
@@ -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
diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs
index c6c0f7a8c..de34278dd 100644
--- a/Command/Upgrade.hs
+++ b/Command/Upgrade.hs
@@ -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
diff --git a/Command/Version.hs b/Command/Version.hs
index b330d1ff1..13b839e66 100644
--- a/Command/Version.hs
+++ b/Command/Version.hs
@@ -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
diff --git a/Command/WebApp.hs b/Command/WebApp.hs
index 70f28a113..a009be15d 100644
--- a/Command/WebApp.hs
+++ b/Command/WebApp.hs
@@ -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
diff --git a/Command/XMPPGit.hs b/Command/XMPPGit.hs
index c1ff0b108..796e8b4ed 100644
--- a/Command/XMPPGit.hs
+++ b/Command/XMPPGit.hs
@@ -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
diff --git a/Types/Command.hs b/Types/Command.hs
index 3187efd17..d012c6e25 100644
--- a/Types/Command.hs
+++ b/Types/Command.hs
@@ -36,7 +36,7 @@ type CommandCleanup = Annex Bool
{- A command is defined by specifying these things. -}
data Command = Command
{ cmdoptions :: [Option] -- command-specific options
- , cmdnorepo :: Maybe (IO ()) -- an action to run when not in a repo
+ , cmdnorepo :: Maybe (CmdParams -> IO ()) -- an action to run when not in a repo
, cmdcheck :: [CommandCheck] -- check stage
, cmdnocommit :: Bool -- don't commit journalled state changes
, cmdnomessages :: Bool -- don't output normal messages
@@ -47,6 +47,8 @@ data Command = Command
, cmddesc :: String -- description of command for usage
}
+type CmdParams = [String]
+
{- CommandCheck functions can be compared using their unique id. -}
instance Eq CommandCheck where
a == b = idCheck a == idCheck b