diff options
38 files changed, 73 insertions, 67 deletions
diff --git a/CmdLine.hs b/CmdLine.hs index b1c9c1728..1037401e0 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -21,7 +21,6 @@ import qualified Git import Annex.Content import Command import Options -import Init {- Runs the passed command line. -} dispatch :: [String] -> [Command] -> [Option] -> String -> Git.Repo -> IO () @@ -41,7 +40,7 @@ parseCmd argv header cmds options = do [] -> error $ "unknown command" ++ usagemsg [command] -> do _ <- sequence flags - checkCmdEnviron command + checkCommand command prepCommand command (drop 1 params) _ -> error "internal error: multiple matching commands" where @@ -53,10 +52,6 @@ parseCmd argv header cmds options = do lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds usagemsg = "\n\n" ++ usage header cmds options -{- Checks that the command can be run in the current environment. -} -checkCmdEnviron :: Command -> Annex () -checkCmdEnviron command = when (cmdusesrepo command) ensureInitialized - {- Usage message with lists of commands and options. -} usage :: String -> [Command] -> [Option] -> String usage header cmds options = diff --git a/Command.hs b/Command.hs index f282791fb..d19dad260 100644 --- a/Command.hs +++ b/Command.hs @@ -18,42 +18,38 @@ import Logs.Location import Config import Backend import Limit +import Init -{- A command runs in four stages. +{- A command runs in these stages. - - - 0. The seek stage takes the parameters passed to the command, + - a. The check stage is run once and should error out if anything + - prevents the command from running. -} +type CommandCheck = Annex () +{- b. The seek stage takes the parameters passed to the command, - looks through the repo to find the ones that are relevant - to that command (ie, new files to add), and generates - a list of start stage actions. -} type CommandSeek = [String] -> Annex [CommandStart] -{- 1. The start stage is run before anything is printed about the +{- c. The start stage is run before anything is printed about the - command, is passed some input, and can early abort it - if the input does not make sense. It should run quickly and - should not modify Annex state. -} type CommandStart = Annex (Maybe CommandPerform) -{- 2. The perform stage is run after a message is printed about the command +{- d. The perform stage is run after a message is printed about the command - being run, and it should be where the bulk of the work happens. -} type CommandPerform = Annex (Maybe CommandCleanup) -{- 3. The cleanup stage is run only if the perform stage succeeds, and it +{- e. The cleanup stage is run only if the perform stage succeeds, and it - returns the overall success/fail of the command. -} type CommandCleanup = Annex Bool data Command = Command { - cmdusesrepo :: Bool, cmdname :: String, cmdparams :: String, + cmdcheck :: CommandCheck, cmdseek :: [CommandSeek], cmddesc :: String } -{- Most commands operate on files in a git repo. -} -repoCommand :: String -> String -> [CommandSeek] -> String -> Command -repoCommand = Command True - -{- Others can run anywhere. -} -standaloneCommand :: String -> String -> [CommandSeek] -> String -> Command -standaloneCommand = Command False - {- For start and perform stages to indicate what step to run next. -} next :: a -> Annex (Maybe a) next a = return $ Just a @@ -62,6 +58,18 @@ next a = return $ Just a stop :: Annex (Maybe a) stop = return Nothing +needsNothing :: CommandCheck +needsNothing = return () + +{- Most commands will check this, as they need to be run in an initialized + - repo. -} +needsRepo :: CommandCheck +needsRepo = ensureInitialized + +{- Checks that the command can be run in the current environment. -} +checkCommand :: Command -> Annex () +checkCommand Command { cmdcheck = check } = check + {- Prepares a list of actions to run to perform a command, based on - the parameters passed to it. -} prepCommand :: Command -> [String] -> Annex [Annex Bool] diff --git a/Command/Add.hs b/Command/Add.hs index bfddd72ee..255e787b7 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -19,7 +19,7 @@ import Utility.Touch import Backend command :: [Command] -command = [repoCommand "add" paramPaths seek "add files to annex"] +command = [Command "add" paramPaths needsRepo seek "add files to annex"] {- Add acts on both files not checked into git yet, and unlocked files. -} seek :: [CommandSeek] diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index f32b5b86a..8deb79541 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -20,7 +20,7 @@ import Annex.Content import Logs.Web command :: [Command] -command = [repoCommand "addurl" (paramRepeating paramUrl) seek +command = [Command "addurl" (paramRepeating paramUrl) needsRepo seek "add urls to annex"] seek :: [CommandSeek] diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index 43315f67c..35a939b38 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -12,7 +12,7 @@ import Command import Annex.UUID command :: [Command] -command = [repoCommand "configlist" paramNothing seek +command = [Command "configlist" paramNothing needsRepo seek "outputs relevant git configuration"] seek :: [CommandSeek] diff --git a/Command/Copy.hs b/Command/Copy.hs index d7625ccdb..2f10d981c 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -11,7 +11,7 @@ import Command import qualified Command.Move command :: [Command] -command = [repoCommand "copy" paramPaths seek +command = [Command "copy" paramPaths needsRepo seek "copy content of files to/from another repository"] seek :: [CommandSeek] diff --git a/Command/Describe.hs b/Command/Describe.hs index 65cd8d0bf..9184ede9c 100644 --- a/Command/Describe.hs +++ b/Command/Describe.hs @@ -13,7 +13,7 @@ import qualified Remote import Logs.UUID command :: [Command] -command = [repoCommand "describe" (paramPair paramRemote paramDesc) seek +command = [Command "describe" (paramPair paramRemote paramDesc) needsRepo seek "change description of a repository"] seek :: [CommandSeek] diff --git a/Command/Drop.hs b/Command/Drop.hs index dc858fb29..7309c2acd 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -17,7 +17,7 @@ import Annex.Content import Config command :: [Command] -command = [repoCommand "drop" paramPaths seek +command = [Command "drop" paramPaths needsRepo seek "indicate content of files not currently wanted"] seek :: [CommandSeek] diff --git a/Command/DropKey.hs b/Command/DropKey.hs index fde6ce02e..9e3554856 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -14,7 +14,7 @@ import Logs.Location import Annex.Content command :: [Command] -command = [repoCommand "dropkey" (paramRepeating paramKey) seek +command = [Command "dropkey" (paramRepeating paramKey) needsRepo seek "drops annexed content for specified keys"] seek :: [CommandSeek] diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 005068556..019fab076 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -21,7 +21,7 @@ import Types.Key type UnusedMap = M.Map String Key command :: [Command] -command = [repoCommand "dropunused" (paramRepeating paramNumber) seek +command = [Command "dropunused" (paramRepeating paramNumber) needsRepo seek "drop unused file content"] seek :: [CommandSeek] diff --git a/Command/Find.hs b/Command/Find.hs index 98501078e..5b13c742a 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -13,7 +13,7 @@ import Annex.Content import Limit command :: [Command] -command = [repoCommand "find" paramPaths seek "lists available files"] +command = [Command "find" paramPaths needsRepo seek "lists available files"] seek :: [CommandSeek] seek = [withFilesInGit start] diff --git a/Command/Fix.hs b/Command/Fix.hs index 5b6f1f7a4..5e58f0733 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -13,7 +13,7 @@ import qualified Annex.Queue import Annex.Content command :: [Command] -command = [repoCommand "fix" paramPaths seek +command = [Command "fix" paramPaths needsRepo seek "fix up symlinks to point to annexed content"] seek :: [CommandSeek] diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 1b05d71fb..30243964e 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -14,7 +14,7 @@ import Annex.Content import Types.Key command :: [Command] -command = [repoCommand "fromkey" paramPath seek +command = [Command "fromkey" paramPath needsRepo seek "adds a file using a specific key"] seek :: [CommandSeek] diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 1c1687a00..0098a822d 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -21,7 +21,7 @@ import Utility.FileMode import Config command :: [Command] -command = [repoCommand "fsck" paramPaths seek "check for problems"] +command = [Command "fsck" paramPaths needsRepo seek "check for problems"] seek :: [CommandSeek] seek = [withNumCopies start] diff --git a/Command/Get.hs b/Command/Get.hs index acf7e0722..d9596c3fe 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -15,7 +15,7 @@ import Annex.Content import qualified Command.Move command :: [Command] -command = [repoCommand "get" paramPaths seek +command = [Command "get" paramPaths needsRepo seek "make content of annexed files available"] seek :: [CommandSeek] diff --git a/Command/InAnnex.hs b/Command/InAnnex.hs index 773693b65..b4db849c9 100644 --- a/Command/InAnnex.hs +++ b/Command/InAnnex.hs @@ -12,7 +12,7 @@ import Command import Annex.Content command :: [Command] -command = [repoCommand "inannex" (paramRepeating paramKey) seek +command = [Command "inannex" (paramRepeating paramKey) needsRepo seek "checks if keys are present in the annex"] seek :: [CommandSeek] diff --git a/Command/Init.hs b/Command/Init.hs index 3dd449329..06bdf4ad5 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -14,8 +14,7 @@ import Logs.UUID import Init command :: [Command] -command = [standaloneCommand "init" paramDesc seek - "initialize git-annex"] +command = [Command "init" paramDesc needsNothing seek "initialize git-annex"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 073ba72f9..8f97199b7 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -17,10 +17,9 @@ import qualified Types.Remote as R import Annex.UUID command :: [Command] -command = [repoCommand "initremote" - (paramPair paramName $ - paramOptional $ paramRepeating paramKeyValue) seek - "sets up a special (non-git) remote"] +command = [Command "initremote" + (paramPair paramName $ paramOptional $ paramRepeating paramKeyValue) + needsRepo seek "sets up a special (non-git) remote"] seek :: [CommandSeek] seek = [withWords start] diff --git a/Command/Lock.hs b/Command/Lock.hs index c6c66a158..bf3b12559 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -13,7 +13,7 @@ import qualified Annex.Queue import Backend command :: [Command] -command = [repoCommand "lock" paramPaths seek "undo unlock command"] +command = [Command "lock" paramPaths needsRepo seek "undo unlock command"] seek :: [CommandSeek] seek = [withFilesUnlocked start, withFilesUnlockedToBeCommitted start] diff --git a/Command/Map.hs b/Command/Map.hs index 48cba63f9..6fbc6930b 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -23,7 +23,8 @@ import qualified Utility.Dot as Dot data Link = Link Git.Repo Git.Repo command :: [Command] -command = [repoCommand "map" paramNothing seek "generate map of repositories"] +command = [Command "map" paramNothing needsNothing seek + "generate map of repositories"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Merge.hs b/Command/Merge.hs index eef2f3857..2b7162946 100644 --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -12,7 +12,7 @@ import Command import qualified Annex.Branch command :: [Command] -command = [repoCommand "merge" paramNothing seek +command = [Command "merge" paramNothing needsRepo seek "auto-merge remote changes into git-annex branch"] seek :: [CommandSeek] diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 8167ac96e..e3956c5aa 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -17,7 +17,7 @@ import Backend import Logs.Web command :: [Command] -command = [repoCommand "migrate" paramPaths seek +command = [Command "migrate" paramPaths needsRepo seek "switch data to different backend"] seek :: [CommandSeek] diff --git a/Command/Move.hs b/Command/Move.hs index a816aacde..ae5e0e1d4 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -17,7 +17,7 @@ import qualified Remote import Annex.UUID command :: [Command] -command = [repoCommand "move" paramPaths seek +command = [Command "move" paramPaths needsRepo seek "move content of files to/from another repository"] seek :: [CommandSeek] diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index b6323e2b7..50bc2662e 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -13,7 +13,8 @@ import qualified Command.Fix import Backend command :: [Command] -command = [repoCommand "pre-commit" paramPaths seek "run by git pre-commit hook"] +command = [Command "pre-commit" paramPaths needsRepo seek + "run by git pre-commit hook"] {- The pre-commit hook needs to fix symlinks to all files being committed. - And, it needs to inject unlocked files into the annex. -} diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index d3b77d8ac..9dc436a68 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -14,7 +14,7 @@ import Annex.Content import Utility.RsyncFile command :: [Command] -command = [repoCommand "recvkey" paramKey seek +command = [Command "recvkey" paramKey needsRepo seek "runs rsync in server mode to receive content"] seek :: [CommandSeek] diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index 5d60977eb..f6a2f639c 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -13,7 +13,7 @@ import qualified Remote import Logs.Trust command :: [Command] -command = [repoCommand "semitrust" (paramRepeating paramRemote) seek +command = [Command "semitrust" (paramRepeating paramRemote) needsRepo seek "return repository to default trust level"] seek :: [CommandSeek] diff --git a/Command/SendKey.hs b/Command/SendKey.hs index ad47cd009..e8ba3ae79 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -13,7 +13,7 @@ import Annex.Content import Utility.RsyncFile command :: [Command] -command = [repoCommand "sendkey" paramKey seek +command = [Command "sendkey" paramKey needsRepo seek "runs rsync in server mode to send content"] seek :: [CommandSeek] diff --git a/Command/SetKey.hs b/Command/SetKey.hs index b707e0b91..51f344f20 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -13,7 +13,7 @@ import Logs.Location import Annex.Content command :: [Command] -command = [repoCommand "setkey" paramPath seek +command = [Command "setkey" paramPath needsRepo seek "sets annexed content for a key using a temp file"] seek :: [CommandSeek] diff --git a/Command/Status.hs b/Command/Status.hs index 70282b79e..155e53ee2 100644 --- a/Command/Status.hs +++ b/Command/Status.hs @@ -39,7 +39,7 @@ data StatInfo = StatInfo type StatState = StateT StatInfo Annex command :: [Command] -command = [repoCommand "status" paramNothing seek +command = [Command "status" paramNothing needsRepo seek "shows status information about the annex"] seek :: [CommandSeek] diff --git a/Command/Trust.hs b/Command/Trust.hs index eeeadc9af..1af458630 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -13,7 +13,7 @@ import qualified Remote import Logs.Trust command :: [Command] -command = [repoCommand "trust" (paramRepeating paramRemote) seek +command = [Command "trust" (paramRepeating paramRemote) needsRepo seek "trust a repository"] seek :: [CommandSeek] diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 083984d0c..cdaa790c0 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -19,7 +19,8 @@ import qualified Git import qualified Git.LsFiles as LsFiles command :: [Command] -command = [repoCommand "unannex" paramPaths seek "undo accidential add command"] +command = [Command "unannex" paramPaths needsRepo seek + "undo accidential add command"] seek :: [CommandSeek] seek = [withFilesInGit start] diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 8214c4208..60e86cc03 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -19,18 +19,15 @@ import qualified Annex.Branch import Annex.Content command :: [Command] -command = [repoCommand "uninit" paramPaths seek +command = [Command "uninit" paramPaths check seek "de-initialize git-annex and clean out repository"] -seek :: [CommandSeek] -seek = [withNothing startCheck, withFilesInGit startUnannex, withNothing start] - -startCheck :: CommandStart -startCheck = do +check :: Annex () +check = do + needsRepo b <- current_branch when (b == Annex.Branch.name) $ error $ "cannot uninit when the " ++ b ++ " branch is checked out" - stop where current_branch = do g <- gitRepo @@ -38,6 +35,9 @@ startCheck = do Git.pipeRead g [Params "rev-parse --abbrev-ref HEAD"] return $ head $ lines $ B.unpack b +seek :: [CommandSeek] +seek = [withFilesInGit startUnannex, withNothing start] + startUnannex :: FilePath -> CommandStart startUnannex file = do -- Force fast mode before running unannex. This way, if multiple diff --git a/Command/Unlock.hs b/Command/Unlock.hs index 9b568b5a6..c89b61de7 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -15,9 +15,11 @@ import Utility.FileMode command :: [Command] command = - [ repoCommand "unlock" paramPaths seek "unlock files for modification" - , repoCommand "edit" paramPaths seek "same as unlock" + [ c "unlock" "unlock files for modification" + , c "edit" "same as unlock" ] + where + c n = Command n paramPaths needsRepo seek seek :: [CommandSeek] seek = [withFilesInGit start] diff --git a/Command/Untrust.hs b/Command/Untrust.hs index f8bf498f2..7d65c1af9 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -13,7 +13,7 @@ import qualified Remote import Logs.Trust command :: [Command] -command = [repoCommand "untrust" (paramRepeating paramRemote) seek +command = [Command "untrust" (paramRepeating paramRemote) needsRepo seek "do not trust a repository"] seek :: [CommandSeek] diff --git a/Command/Unused.hs b/Command/Unused.hs index a90174752..5cef829d6 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -28,7 +28,7 @@ import qualified Annex.Branch import Annex.CatFile command :: [Command] -command = [repoCommand "unused" paramNothing seek +command = [Command "unused" paramNothing needsRepo seek "look for unused file content"] seek :: [CommandSeek] diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 90d3a4e95..77d15c930 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -13,7 +13,7 @@ import Upgrade import Annex.Version command :: [Command] -command = [standaloneCommand "upgrade" paramNothing seek +command = [Command "upgrade" paramNothing needsNothing seek "upgrade repository layout"] seek :: [CommandSeek] diff --git a/Command/Version.hs b/Command/Version.hs index 5ac87099b..dae9a31d3 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -13,7 +13,7 @@ import qualified Build.SysConfig as SysConfig import Annex.Version command :: [Command] -command = [standaloneCommand "version" paramNothing seek "show version info"] +command = [Command "version" paramNothing needsNothing seek "show version info"] seek :: [CommandSeek] seek = [withNothing start] diff --git a/Command/Whereis.hs b/Command/Whereis.hs index b1646ae69..71b3ad96b 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -14,7 +14,7 @@ import Remote import Logs.Trust command :: [Command] -command = [repoCommand "whereis" paramPaths seek +command = [Command "whereis" paramPaths needsRepo seek "lists repositories that have file content"] seek :: [CommandSeek] |