diff options
| -rw-r--r-- | CmdLine.hs | 11 | ||||
| -rw-r--r-- | Command.hs | 2 | ||||
| -rw-r--r-- | Command/Assistant.hs | 4 | ||||
| -rw-r--r-- | Command/Help.hs | 16 | ||||
| -rw-r--r-- | Command/Upgrade.hs | 2 | ||||
| -rw-r--r-- | Command/Version.hs | 5 | ||||
| -rw-r--r-- | Command/WebApp.hs | 6 | ||||
| -rw-r--r-- | Command/XMPPGit.hs | 5 | ||||
| -rw-r--r-- | Types/Command.hs | 4 |
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 |