set oneshot mode on a per-command basis

Avoids ugly (and test suite failing) hack in Command.Version
This commit is contained in:
Joey Hess 2012-02-14 12:40:40 -04:00
parent 33e03d58ae
commit 90a8b38ac0
11 changed files with 19 additions and 16 deletions

View file

@ -28,8 +28,8 @@ type Params = [String]
type Flags = [Annex ()] type Flags = [Annex ()]
{- Runs the passed command line. -} {- Runs the passed command line. -}
dispatch :: Bool -> Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO () dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
dispatch oneshot args cmds commonoptions header getgitrepo = do dispatch args cmds commonoptions header getgitrepo = do
setupConsole setupConsole
r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo) r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
case r of case r of
@ -39,7 +39,7 @@ dispatch oneshot args cmds commonoptions header getgitrepo = do
(actions, state') <- Annex.run state $ do (actions, state') <- Annex.run state $ do
sequence_ flags sequence_ flags
prepCommand cmd params prepCommand cmd params
tryRun state' cmd $ [startup] ++ actions ++ [shutdown oneshot] tryRun state' cmd $ [startup] ++ actions ++ [shutdown $ cmdoneshot cmd]
where where
(flags, cmd, params) = parseCmd args cmds commonoptions header (flags, cmd, params) = parseCmd args cmds commonoptions header

View file

@ -8,6 +8,7 @@
module Command ( module Command (
command, command,
noRepo, noRepo,
oneShot,
withOptions, withOptions,
next, next,
stop, stop,
@ -39,7 +40,11 @@ import Annex.CheckAttr
{- Generates a normal command -} {- Generates a normal command -}
command :: String -> String -> [CommandSeek] -> String -> Command command :: String -> String -> [CommandSeek] -> String -> Command
command = Command [] Nothing commonChecks command = Command [] Nothing commonChecks False
{- Makes a command run in oneshot mode. -}
oneShot :: Command -> Command
oneShot c = c { cmdoneshot = True }
{- Adds a fallback action to a command, that will be run if it's used {- Adds a fallback action to a command, that will be run if it's used
- outside a git repository. -} - outside a git repository. -}

View file

@ -12,7 +12,7 @@ import Command
import Annex.UUID import Annex.UUID
def :: [Command] def :: [Command]
def = [command "configlist" paramNothing seek def = [oneShot $ command "configlist" paramNothing seek
"outputs relevant git configuration"] "outputs relevant git configuration"]
seek :: [CommandSeek] seek :: [CommandSeek]

View file

@ -14,7 +14,7 @@ import Logs.Location
import Annex.Content import Annex.Content
def :: [Command] def :: [Command]
def = [command "dropkey" (paramRepeating paramKey) seek def = [oneShot $ command "dropkey" (paramRepeating paramKey) seek
"drops annexed content for specified keys"] "drops annexed content for specified keys"]
seek :: [CommandSeek] seek :: [CommandSeek]

View file

@ -12,7 +12,7 @@ import Command
import Annex.Content import Annex.Content
def :: [Command] def :: [Command]
def = [command "inannex" (paramRepeating paramKey) seek def = [oneShot $ command "inannex" (paramRepeating paramKey) seek
"checks if keys are present in the annex"] "checks if keys are present in the annex"]
seek :: [CommandSeek] seek :: [CommandSeek]

View file

@ -14,7 +14,7 @@ import Annex.Content
import Utility.RsyncFile import Utility.RsyncFile
def :: [Command] def :: [Command]
def = [command "recvkey" paramKey seek def = [oneShot $ command "recvkey" paramKey seek
"runs rsync in server mode to receive content"] "runs rsync in server mode to receive content"]
seek :: [CommandSeek] seek :: [CommandSeek]

View file

@ -13,7 +13,7 @@ import Annex.Content
import Utility.RsyncFile import Utility.RsyncFile
def :: [Command] def :: [Command]
def = [command "sendkey" paramKey seek def = [oneShot $ command "sendkey" paramKey seek
"runs rsync in server mode to send content"] "runs rsync in server mode to send content"]
seek :: [CommandSeek] seek :: [CommandSeek]

View file

@ -11,10 +11,9 @@ import Common.Annex
import Command import Command
import qualified Build.SysConfig as SysConfig import qualified Build.SysConfig as SysConfig
import Annex.Version import Annex.Version
import CmdLine
def :: [Command] def :: [Command]
def = [noRepo showPackageVersion $ dontCheck repoExists $ def = [oneShot $ noRepo showPackageVersion $ dontCheck repoExists $
command "version" paramNothing seek "show version info"] command "version" paramNothing seek "show version info"]
seek :: [CommandSeek] seek :: [CommandSeek]
@ -29,9 +28,7 @@ start = do
putStrLn $ "default repository version: " ++ defaultVersion putStrLn $ "default repository version: " ++ defaultVersion
putStrLn $ "supported repository versions: " ++ vs supportedVersions putStrLn $ "supported repository versions: " ++ vs supportedVersions
putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions putStrLn $ "upgrade supported from repository versions: " ++ vs upgradableVersions
-- avoid normal cleanup stop
_ <- shutdown True
liftIO exitSuccess
where where
vs = join " " vs = join " "

View file

@ -129,4 +129,4 @@ header :: String
header = "Usage: git-annex command [option ..]" header = "Usage: git-annex command [option ..]"
run :: [String] -> IO () run :: [String] -> IO ()
run args = dispatch False args cmds options header Git.Construct.fromCurrent run args = dispatch args cmds options header Git.Construct.fromCurrent

View file

@ -36,6 +36,7 @@ data Command = Command
{ cmdoptions :: [Option] -- command-specific options { cmdoptions :: [Option] -- command-specific options
, cmdnorepo :: Maybe (IO ()) -- an action to run when not in a repo , cmdnorepo :: Maybe (IO ()) -- an action to run when not in a repo
, cmdcheck :: [CommandCheck] -- check stage , cmdcheck :: [CommandCheck] -- check stage
, cmdoneshot :: Bool -- don't save state after running
, cmdname :: String , cmdname :: String
, cmdparamdesc :: String -- description of params for usage , cmdparamdesc :: String -- description of params for usage
, cmdseek :: [CommandSeek] -- seek stage , cmdseek :: [CommandSeek] -- seek stage

View file

@ -82,7 +82,7 @@ builtins = map cmdname cmds
builtin :: String -> String -> [String] -> IO () builtin :: String -> String -> [String] -> IO ()
builtin cmd dir params = do builtin cmd dir params = do
checkNotReadOnly cmd checkNotReadOnly cmd
dispatch True (cmd : filterparams params) cmds options header $ dispatch (cmd : filterparams params) cmds options header $
Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
external :: [String] -> IO () external :: [String] -> IO ()