diff options
author | Joey Hess <joey@kitenet.net> | 2010-12-30 14:19:16 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-12-30 14:19:16 -0400 |
commit | 6a5be9d53cad9ee2988c6d54001f387dfe1f2716 (patch) | |
tree | bae7346474d2ae932b856f1d70a0fca187ca6454 | |
parent | 14d59b40fb4f3a4c9a89266fecae91a0daf08088 (diff) |
rename some stuff and prepare to break out more into Command/*
-rw-r--r-- | Annex.hs | 4 | ||||
-rw-r--r-- | CmdLine.hs | 69 | ||||
-rw-r--r-- | Command.hs | 112 | ||||
-rw-r--r-- | Command/Add.hs | 11 | ||||
-rw-r--r-- | Command/Copy.hs | 2 | ||||
-rw-r--r-- | Command/Drop.hs | 8 | ||||
-rw-r--r-- | Command/DropKey.hs | 8 | ||||
-rw-r--r-- | Command/DropUnused.hs | 4 | ||||
-rw-r--r-- | Command/Find.hs | 4 | ||||
-rw-r--r-- | Command/Fix.hs | 8 | ||||
-rw-r--r-- | Command/FromKey.hs | 8 | ||||
-rw-r--r-- | Command/Fsck.hs | 6 | ||||
-rw-r--r-- | Command/Get.hs | 6 | ||||
-rw-r--r-- | Command/Init.hs | 8 | ||||
-rw-r--r-- | Command/Lock.hs | 6 | ||||
-rw-r--r-- | Command/Move.hs | 16 | ||||
-rw-r--r-- | Command/PreCommit.hs | 10 | ||||
-rw-r--r-- | Command/SetKey.hs | 8 | ||||
-rw-r--r-- | Command/Trust.hs | 6 | ||||
-rw-r--r-- | Command/Unannex.hs | 8 | ||||
-rw-r--r-- | Command/Uninit.hs | 6 | ||||
-rw-r--r-- | Command/Unlock.hs | 6 | ||||
-rw-r--r-- | Command/Untrust.hs | 6 | ||||
-rw-r--r-- | Command/Unused.hs | 6 |
24 files changed, 177 insertions, 159 deletions
@@ -110,10 +110,10 @@ flagGet name = do {- Adds a git command to the queue. -} queue :: String -> [String] -> FilePath -> Annex () -queue subcommand params file = do +queue command params file = do state <- get let q = Internals.repoqueue state - put state { Internals.repoqueue = GitQueue.add q subcommand params file } + put state { Internals.repoqueue = GitQueue.add q command params file } {- Returns the queue. -} queueGet :: Annex GitQueue.Queue diff --git a/CmdLine.hs b/CmdLine.hs index 7eab0a7e2..40ce4b121 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -37,51 +37,50 @@ import qualified Command.Uninit import qualified Command.Trust import qualified Command.Untrust -subCmds :: [SubCommand] -subCmds = - [ SubCommand "add" path Command.Add.seek - "add files to annex" - , SubCommand "get" path Command.Get.seek +cmds :: [Command] +cmds = + [ Command.Add.command + , Command "get" path Command.Get.seek "make content of annexed files available" - , SubCommand "drop" path Command.Drop.seek + , Command "drop" path Command.Drop.seek "indicate content of files not currently wanted" - , SubCommand "move" path Command.Move.seek + , Command "move" path Command.Move.seek "move content of files to/from another repository" - , SubCommand "copy" path Command.Copy.seek + , Command "copy" path Command.Copy.seek "copy content of files to/from another repository" - , SubCommand "unlock" path Command.Unlock.seek + , Command "unlock" path Command.Unlock.seek "unlock files for modification" - , SubCommand "edit" path Command.Unlock.seek + , Command "edit" path Command.Unlock.seek "same as unlock" - , SubCommand "lock" path Command.Lock.seek + , Command "lock" path Command.Lock.seek "undo unlock command" - , SubCommand "init" desc Command.Init.seek + , Command "init" desc Command.Init.seek "initialize git-annex with repository description" - , SubCommand "unannex" path Command.Unannex.seek + , Command "unannex" path Command.Unannex.seek "undo accidential add command" - , SubCommand "uninit" path Command.Uninit.seek + , Command "uninit" path Command.Uninit.seek "de-initialize git-annex and clean out repository" - , SubCommand "pre-commit" path Command.PreCommit.seek + , Command "pre-commit" path Command.PreCommit.seek "run by git pre-commit hook" - , SubCommand "trust" remote Command.Trust.seek + , Command "trust" remote Command.Trust.seek "trust a repository" - , SubCommand "untrust" remote Command.Untrust.seek + , Command "untrust" remote Command.Untrust.seek "do not trust a repository" - , SubCommand "fromkey" key Command.FromKey.seek + , Command "fromkey" key Command.FromKey.seek "adds a file using a specific key" - , SubCommand "dropkey" key Command.DropKey.seek + , Command "dropkey" key Command.DropKey.seek "drops annexed content for specified keys" - , SubCommand "setkey" key Command.SetKey.seek + , Command "setkey" key Command.SetKey.seek "sets annexed content for a key using a temp file" - , SubCommand "fix" path Command.Fix.seek + , Command "fix" path Command.Fix.seek "fix up symlinks to point to annexed content" - , SubCommand "fsck" maybepath Command.Fsck.seek + , Command "fsck" maybepath Command.Fsck.seek "check for problems" - , SubCommand "unused" nothing Command.Unused.seek + , Command "unused" nothing Command.Unused.seek "look for unused file content" - , SubCommand "dropunused" number Command.DropUnused.seek + , Command "dropunused" number Command.DropUnused.seek "drop unused file content" - , SubCommand "find" maybepath Command.Find.seek + , Command "find" maybepath Command.Find.seek "lists available files" ] where @@ -125,13 +124,13 @@ header = "Usage: git-annex subcommand [option ..]" usage :: String usage = usageInfo header options ++ "\nSubcommands:\n" ++ cmddescs where - cmddescs = unlines $ map (indent . showcmd) subCmds + cmddescs = unlines $ map (indent . showcmd) cmds showcmd c = - subcmdname c ++ - pad 11 (subcmdname c) ++ - subcmdparams c ++ - pad 13 (subcmdparams c) ++ - subcmddesc c + cmdname c ++ + pad 11 (cmdname c) ++ + cmdparams c ++ + pad 13 (cmdparams c) ++ + cmddesc c indent l = " " ++ l pad n s = replicate (n - length s) ' ' @@ -143,12 +142,12 @@ parseCmd argv = do when (null params) $ error usage case lookupCmd (head params) of [] -> error usage - [subcommand] -> do + [command] -> do _ <- sequence flags - prepSubCmd subcommand (drop 1 params) - _ -> error "internal error: multiple matching subcommands" + prepCmd command (drop 1 params) + _ -> error "internal error: multiple matching commands" where getopt = case getOpt Permute options argv of (flags, params, []) -> return (flags, params) (_, _, errs) -> ioError (userError (concat errs ++ usage)) - lookupCmd cmd = filter (\c -> cmd == subcmdname c) subCmds + lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds diff --git a/Command.hs b/Command.hs index e30904d0f..2144da353 100644 --- a/Command.hs +++ b/Command.hs @@ -21,54 +21,54 @@ import qualified Annex import qualified GitRepo as Git import Locations -{- A subcommand runs in four stages. +{- A command runs in four stages. - - - 0. The seek stage takes the parameters passed to the subcommand, + - 0. The seek stage takes the parameters passed to the command, - looks through the repo to find the ones that are relevant - - to that subcommand (ie, new files to add), and generates + - to that command (ie, new files to add), and generates - a list of start stage actions. -} -type SubCmdSeek = [String] -> Annex [SubCmdStart] +type CommandSeek = [String] -> Annex [CommandStart] {- 1. The start stage is run before anything is printed about the - - subcommand, is passed some input, and can early abort it + - 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 SubCmdStart = Annex (Maybe SubCmdPerform) -{- 2. The perform stage is run after a message is printed about the subcommand +type CommandStart = Annex (Maybe CommandPerform) +{- 2. 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 SubCmdPerform = Annex (Maybe SubCmdCleanup) +type CommandPerform = Annex (Maybe CommandCleanup) {- 3. The cleanup stage is run only if the perform stage succeeds, and it - - returns the overall success/fail of the subcommand. -} -type SubCmdCleanup = Annex Bool -{- Some helper functions are used to build up SubCmdSeek and SubCmdStart + - returns the overall success/fail of the command. -} +type CommandCleanup = Annex Bool +{- Some helper functions are used to build up CommandSeek and CommandStart - functions. -} -type SubCmdSeekStrings = SubCmdStartString -> SubCmdSeek -type SubCmdStartString = String -> SubCmdStart +type CommandSeekStrings = CommandStartString -> CommandSeek +type CommandStartString = String -> CommandStart type BackendFile = (FilePath, Maybe Backend) -type SubCmdSeekBackendFiles = SubCmdStartBackendFile -> SubCmdSeek -type SubCmdStartBackendFile = BackendFile -> SubCmdStart +type CommandSeekBackendFiles = CommandStartBackendFile -> CommandSeek +type CommandStartBackendFile = BackendFile -> CommandStart type AttrFile = (FilePath, String) -type SubCmdSeekAttrFiles = SubCmdStartAttrFile -> SubCmdSeek -type SubCmdStartAttrFile = AttrFile -> SubCmdStart -type SubCmdSeekNothing = SubCmdStart -> SubCmdSeek -type SubCmdStartNothing = SubCmdStart - -data SubCommand = SubCommand { - subcmdname :: String, - subcmdparams :: String, - subcmdseek :: [SubCmdSeek], - subcmddesc :: String +type CommandSeekAttrFiles = CommandStartAttrFile -> CommandSeek +type CommandStartAttrFile = AttrFile -> CommandStart +type CommandSeekNothing = CommandStart -> CommandSeek +type CommandStartNothing = CommandStart + +data Command = Command { + cmdname :: String, + cmdparams :: String, + cmdseek :: [CommandSeek], + cmddesc :: String } -{- Prepares a list of actions to run to perform a subcommand, based on +{- Prepares a list of actions to run to perform a command, based on - the parameters passed to it. -} -prepSubCmd :: SubCommand -> [String] -> Annex [Annex Bool] -prepSubCmd SubCommand { subcmdseek = seek } params = do +prepCmd :: Command -> [String] -> Annex [Annex Bool] +prepCmd Command { cmdseek = seek } params = do lists <- mapM (\s -> s params) seek - return $ map doSubCmd $ foldl (++) [] lists + return $ map doCommand $ foldl (++) [] lists -{- Runs a subcommand through the start, perform and cleanup stages -} -doSubCmd :: SubCmdStart -> SubCmdCleanup -doSubCmd start = do +{- Runs a command through the start, perform and cleanup stages -} +doCommand :: CommandStart -> CommandCleanup +doCommand start = do s <- start case s of Nothing -> return True @@ -104,20 +104,20 @@ isAnnexed file a = do {- These functions find appropriate files or other things based on a user's parameters, and run a specified action on them. -} -withFilesInGit :: SubCmdSeekStrings +withFilesInGit :: CommandSeekStrings withFilesInGit a params = do repo <- Annex.gitRepo files <- liftIO $ Git.inRepo repo params files' <- filterFiles files return $ map a files' -withAttrFilesInGit :: String -> SubCmdSeekAttrFiles +withAttrFilesInGit :: String -> CommandSeekAttrFiles withAttrFilesInGit attr a params = do repo <- Annex.gitRepo files <- liftIO $ Git.inRepo repo params files' <- filterFiles files pairs <- liftIO $ Git.checkAttr repo attr files' return $ map a pairs -withFilesMissing :: SubCmdSeekStrings +withFilesMissing :: CommandSeekStrings withFilesMissing a params = do files <- liftIO $ filterM missing params files' <- filterFiles files @@ -126,27 +126,27 @@ withFilesMissing a params = do missing f = do e <- doesFileExist f return $ not e -withFilesNotInGit :: SubCmdSeekBackendFiles +withFilesNotInGit :: CommandSeekBackendFiles withFilesNotInGit a params = do repo <- Annex.gitRepo newfiles <- liftIO $ Git.notInRepo repo params newfiles' <- filterFiles newfiles backendPairs a newfiles' -withString :: SubCmdSeekStrings +withString :: CommandSeekStrings withString a params = return [a $ unwords params] -withStrings :: SubCmdSeekStrings +withStrings :: CommandSeekStrings withStrings a params = return $ map a params -withFilesToBeCommitted :: SubCmdSeekStrings +withFilesToBeCommitted :: CommandSeekStrings withFilesToBeCommitted a params = do repo <- Annex.gitRepo tocommit <- liftIO $ Git.stagedFiles repo params tocommit' <- filterFiles tocommit return $ map a tocommit' -withFilesUnlocked :: SubCmdSeekBackendFiles +withFilesUnlocked :: CommandSeekBackendFiles withFilesUnlocked = withFilesUnlocked' Git.typeChangedFiles -withFilesUnlockedToBeCommitted :: SubCmdSeekBackendFiles +withFilesUnlockedToBeCommitted :: CommandSeekBackendFiles withFilesUnlockedToBeCommitted = withFilesUnlocked' Git.typeChangedStagedFiles -withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> SubCmdSeekBackendFiles +withFilesUnlocked' :: (Git.Repo -> [FilePath] -> IO [FilePath]) -> CommandSeekBackendFiles withFilesUnlocked' typechanged a params = do -- unlocked files have changed type from a symlink to a regular file repo <- Annex.gitRepo @@ -155,29 +155,29 @@ withFilesUnlocked' typechanged a params = do map (\f -> Git.workTree repo ++ "/" ++ f) typechangedfiles unlockedfiles' <- filterFiles unlockedfiles backendPairs a unlockedfiles' -withKeys :: SubCmdSeekStrings +withKeys :: CommandSeekStrings withKeys a params = return $ map a params -withTempFile :: SubCmdSeekStrings +withTempFile :: CommandSeekStrings withTempFile a params = return $ map a params -withNothing :: SubCmdSeekNothing +withNothing :: CommandSeekNothing withNothing a [] = return [a] withNothing _ _ = return [] -backendPairs :: SubCmdSeekBackendFiles +backendPairs :: CommandSeekBackendFiles backendPairs a files = do pairs <- Backend.chooseBackends files return $ map a pairs {- Default to acting on all files matching the seek action if - none are specified. -} -withAll :: (a -> SubCmdSeek) -> a -> SubCmdSeek +withAll :: (a -> CommandSeek) -> a -> CommandSeek withAll w a [] = do g <- Annex.gitRepo w a [Git.workTree g] withAll w a p = w a p {- Provides a default parameter to act on if none is specified. -} -withDefault :: String-> (a -> SubCmdSeek) -> (a -> SubCmdSeek) +withDefault :: String-> (a -> CommandSeek) -> (a -> CommandSeek) withDefault d w a [] = w a [d] withDefault _ w a p = w a p @@ -204,3 +204,19 @@ notSymlink :: FilePath -> IO Bool notSymlink f = do s <- liftIO $ getSymbolicLinkStatus f return $ not $ isSymbolicLink s + +{- descriptions of params used in usage message -} +paramPath :: String +paramPath = "PATH ..." +paramMaybePath :: String +paramMaybePath = "[PATH ...]" +paramKey :: String +paramKey = "KEY ..." +paramDesc :: String +paramDesc = "DESCRIPTION" +paramNumber :: String +paramNumber = "NUMBER ..." +paramRemote :: String +paramRemote = "REMOTE ..." +paramNothing :: String +paramNothing = "" diff --git a/Command/Add.hs b/Command/Add.hs index d141448a3..08a880206 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -18,14 +18,17 @@ import Types import Core import Messages +command :: Command +command = Command "add" paramPath seek "add files to annex" + {- Add acts on both files not checked into git yet, and unlocked files. -} -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesNotInGit start, withFilesUnlocked start] {- The add subcommand annexes a file, storing it in a backend, and then - moving it into the annex directory and setting up the symlink pointing - to its content. -} -start :: SubCmdStartBackendFile +start :: CommandStartBackendFile start pair@(file, _) = notAnnexed file $ do s <- liftIO $ getSymbolicLinkStatus file if (isSymbolicLink s) || (not $ isRegularFile s) @@ -34,14 +37,14 @@ start pair@(file, _) = notAnnexed file $ do showStart "add" file return $ Just $ perform pair -perform :: BackendFile -> SubCmdPerform +perform :: BackendFile -> CommandPerform perform (file, backend) = do stored <- Backend.storeFileKey file backend case stored of Nothing -> return Nothing Just (key, _) -> return $ Just $ cleanup file key -cleanup :: FilePath -> Key -> SubCmdCleanup +cleanup :: FilePath -> Key -> CommandCleanup cleanup file key = do moveAnnex key file logStatus key ValuePresent diff --git a/Command/Copy.hs b/Command/Copy.hs index aa55731d9..873df7ef2 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -11,5 +11,5 @@ import Command import qualified Command.Move -- A copy is just a move that does not delete the source file. -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesInGit $ Command.Move.start False] diff --git a/Command/Drop.hs b/Command/Drop.hs index 7c4fbea60..3f2740570 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -17,12 +17,12 @@ import Core import Messages import Utility -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withAttrFilesInGit "annex.numcopies" start] {- Indicates a file's content is not wanted anymore, and should be removed - if it's safe to do so. -} -start :: SubCmdStartAttrFile +start :: CommandStartAttrFile start (file, attr) = isAnnexed file $ \(key, backend) -> do inbackend <- Backend.hasKey key if not inbackend @@ -33,14 +33,14 @@ start (file, attr) = isAnnexed file $ \(key, backend) -> do where numcopies = readMaybe attr :: Maybe Int -perform :: Key -> Backend -> Maybe Int -> SubCmdPerform +perform :: Key -> Backend -> Maybe Int -> CommandPerform perform key backend numcopies = do success <- Backend.removeKey backend key numcopies if success then return $ Just $ cleanup key else return Nothing -cleanup :: Key -> SubCmdCleanup +cleanup :: Key -> CommandCleanup cleanup key = do inannex <- inAnnex key when inannex $ removeAnnex key diff --git a/Command/DropKey.hs b/Command/DropKey.hs index aa72e1bbd..870e9a7ab 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -15,11 +15,11 @@ import Types import Core import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withKeys start] {- Drops cached content for a key. -} -start :: SubCmdStartString +start :: CommandStartString start keyname = do backends <- Backend.list let key = genKey (head backends) keyname @@ -33,12 +33,12 @@ start keyname = do showStart "dropkey" keyname return $ Just $ perform key -perform :: Key -> SubCmdPerform +perform :: Key -> CommandPerform perform key = do removeAnnex key return $ Just $ cleanup key -cleanup :: Key -> SubCmdCleanup +cleanup :: Key -> CommandCleanup cleanup key = do logStatus key ValueMissing return True diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs index 016a9faa7..9984e49f3 100644 --- a/Command/DropUnused.hs +++ b/Command/DropUnused.hs @@ -18,11 +18,11 @@ import qualified Annex import qualified Command.Drop import Backend -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withStrings start] {- Drops unused content by number. -} -start :: SubCmdStartString +start :: CommandStartString start s = do m <- readUnusedLog case M.lookup s m of diff --git a/Command/Find.hs b/Command/Find.hs index 7b3c8c463..9927b692d 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -13,11 +13,11 @@ import Control.Monad.State (liftIO) import Command import Core -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withDefault "." withFilesInGit start] {- Output a list of files. -} -start :: SubCmdStartString +start :: CommandStartString start file = isAnnexed file $ \(key, _) -> do exists <- inAnnex key when exists $ liftIO $ putStrLn file diff --git a/Command/Fix.hs b/Command/Fix.hs index 33630031f..accdadd31 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -17,11 +17,11 @@ import Utility import Core import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesInGit start] {- Fixes the symlink to an annexed file. -} -start :: SubCmdStartString +start :: CommandStartString start file = isAnnexed file $ \(key, _) -> do link <- calcGitLink file key l <- liftIO $ readSymbolicLink file @@ -31,14 +31,14 @@ start file = isAnnexed file $ \(key, _) -> do showStart "fix" file return $ Just $ perform file link -perform :: FilePath -> FilePath -> SubCmdPerform +perform :: FilePath -> FilePath -> CommandPerform perform file link = do liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ removeFile file liftIO $ createSymbolicLink link file return $ Just $ cleanup file -cleanup :: FilePath -> SubCmdCleanup +cleanup :: FilePath -> CommandCleanup cleanup file = do Annex.queue "add" ["--"] file return True diff --git a/Command/FromKey.hs b/Command/FromKey.hs index eb9ad5e51..991428136 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -20,11 +20,11 @@ import Types import Core import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesMissing start] {- Adds a file pointing at a manually-specified key -} -start :: SubCmdStartString +start :: CommandStartString start file = do keyname <- Annex.flagGet "key" when (null keyname) $ error "please specify the key with --key" @@ -36,13 +36,13 @@ start file = do "key ("++keyname++") is not present in backend" showStart "fromkey" file return $ Just $ perform file key -perform :: FilePath -> Key -> SubCmdPerform +perform :: FilePath -> Key -> CommandPerform perform file key = do link <- calcGitLink file key liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ createSymbolicLink link file return $ Just $ cleanup file -cleanup :: FilePath -> SubCmdCleanup +cleanup :: FilePath -> CommandCleanup cleanup file = do Annex.queue "add" ["--"] file return True diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 9acecfce6..034bdc388 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -13,18 +13,18 @@ import Types import Messages import Utility -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withAll (withAttrFilesInGit "annex.numcopies") start] {- Checks a file's backend data for problems. -} -start :: SubCmdStartAttrFile +start :: CommandStartAttrFile start (file, attr) = isAnnexed file $ \(key, backend) -> do showStart "fsck" file return $ Just $ perform key backend numcopies where numcopies = readMaybe attr :: Maybe Int -perform :: Key -> Backend -> Maybe Int -> SubCmdPerform +perform :: Key -> Backend -> Maybe Int -> CommandPerform perform key backend numcopies = do success <- Backend.fsckKey backend key numcopies if success diff --git a/Command/Get.hs b/Command/Get.hs index 628ed6293..214b689b8 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -13,11 +13,11 @@ import Types import Core import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesInGit start] {- Gets an annexed file from one of the backends. -} -start :: SubCmdStartString +start :: CommandStartString start file = isAnnexed file $ \(key, backend) -> do inannex <- inAnnex key if inannex @@ -26,7 +26,7 @@ start file = isAnnexed file $ \(key, backend) -> do showStart "get" file return $ Just $ perform key backend -perform :: Key -> Backend -> SubCmdPerform +perform :: Key -> Backend -> CommandPerform perform key backend = do ok <- getViaTmp key (Backend.retrieveKeyFile backend key) if ok diff --git a/Command/Init.hs b/Command/Init.hs index e19849ba3..806c34c98 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -20,18 +20,18 @@ import Messages import Locations import Types -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withString start] {- Stores description for the repository etc. -} -start :: SubCmdStartString +start :: CommandStartString start description = do when (null description) $ error "please specify a description of this repository\n" showStart "init" description return $ Just $ perform description -perform :: String -> SubCmdPerform +perform :: String -> CommandPerform perform description = do g <- Annex.gitRepo u <- getUUID g @@ -41,7 +41,7 @@ perform description = do gitPreCommitHookWrite g return $ Just cleanup -cleanup :: SubCmdCleanup +cleanup :: CommandCleanup cleanup = do g <- Annex.gitRepo logfile <- uuidLog diff --git a/Command/Lock.hs b/Command/Lock.hs index 27a030bc2..381162536 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -15,16 +15,16 @@ import Messages import qualified Annex import qualified GitRepo as Git -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesUnlocked start] {- Undo unlock -} -start :: SubCmdStartBackendFile +start :: CommandStartBackendFile start (file, _) = do showStart "lock" file return $ Just $ perform file -perform :: FilePath -> SubCmdPerform +perform :: FilePath -> CommandPerform perform file = do liftIO $ removeFile file g <- Annex.gitRepo diff --git a/Command/Move.hs b/Command/Move.hs index eb223f5ab..8ba8dbfac 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -21,14 +21,14 @@ import qualified Remotes import UUID import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesInGit $ start True] {- Move (or copy) a file either --to or --from a repository. - - This only operates on the cached file content; it does not involve - moving data in the key-value backend. -} -start :: Bool -> SubCmdStartString +start :: Bool -> CommandStartString start move file = do fromName <- Annex.flagGet "fromrepository" toName <- Annex.flagGet "torepository" @@ -61,7 +61,7 @@ remoteHasKey remote key present = do - A file's content can be moved even if there are insufficient copies to - allow it to be dropped. -} -toStart :: Bool -> SubCmdStartString +toStart :: Bool -> CommandStartString toStart move file = isAnnexed file $ \(key, _) -> do ishere <- inAnnex key if not ishere @@ -69,7 +69,7 @@ toStart move file = isAnnexed file $ \(key, _) -> do else do showAction move file return $ Just $ toPerform move key -toPerform :: Bool -> Key -> SubCmdPerform +toPerform :: Bool -> Key -> CommandPerform toPerform move key = do -- checking the remote is expensive, so not done in the start step remote <- Remotes.commandLineRemote @@ -86,7 +86,7 @@ toPerform move key = do then return $ Just $ toCleanup move remote key tmpfile else return Nothing -- failed Right True -> return $ Just $ Command.Drop.cleanup key -toCleanup :: Bool -> Git.Repo -> Key -> FilePath -> SubCmdCleanup +toCleanup :: Bool -> Git.Repo -> Key -> FilePath -> CommandCleanup toCleanup move remote key tmpfile = do -- Tell remote to use the transferred content. ok <- Remotes.runCmd remote "git-annex" ["setkey", "--quiet", @@ -107,7 +107,7 @@ toCleanup move remote key tmpfile = do - If the current repository already has the content, it is still removed - from the other repository when moving. -} -fromStart :: Bool -> SubCmdStartString +fromStart :: Bool -> CommandStartString fromStart move file = isAnnexed file $ \(key, _) -> do remote <- Remotes.commandLineRemote (trusted, untrusted, _) <- Remotes.keyPossibilities key @@ -116,7 +116,7 @@ fromStart move file = isAnnexed file $ \(key, _) -> do else do showAction move file return $ Just $ fromPerform move key -fromPerform :: Bool -> Key -> SubCmdPerform +fromPerform :: Bool -> Key -> CommandPerform fromPerform move key = do remote <- Remotes.commandLineRemote ishere <- inAnnex key @@ -128,7 +128,7 @@ fromPerform move key = do if ok then return $ Just $ fromCleanup move remote key else return Nothing -- fail -fromCleanup :: Bool -> Git.Repo -> Key -> SubCmdCleanup +fromCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup fromCleanup True remote key = do ok <- Remotes.runCmd remote "git-annex" ["dropkey", "--quiet", "--force", diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs index 513d5d43f..8d488514a 100644 --- a/Command/PreCommit.hs +++ b/Command/PreCommit.hs @@ -17,21 +17,21 @@ import qualified Command.Fix {- The pre-commit hook needs to fix symlinks to all files being committed. - And, it needs to inject unlocked files into the annex. -} -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesToBeCommitted Command.Fix.start, withFilesUnlockedToBeCommitted start] -start :: SubCmdStartBackendFile +start :: CommandStartBackendFile start pair = return $ Just $ perform pair -perform :: BackendFile -> SubCmdPerform +perform :: BackendFile -> CommandPerform perform pair@(file, _) = do - ok <- doSubCmd $ Command.Add.start pair + ok <- doCommand $ Command.Add.start pair if ok then return $ Just $ cleanup file else error $ "failed to add " ++ file ++ "; canceling commit" -cleanup :: FilePath -> SubCmdCleanup +cleanup :: FilePath -> CommandCleanup cleanup file = do -- git commit will have staged the file's content; -- drop that and run command queued by Add.state to diff --git a/Command/SetKey.hs b/Command/SetKey.hs index 55472ccae..4c82de3a5 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -19,11 +19,11 @@ import Types import Core import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withTempFile start] {- Sets cached content for a key. -} -start :: SubCmdStartString +start :: CommandStartString start file = do keyname <- Annex.flagGet "key" when (null keyname) $ error "please specify the key with --key" @@ -31,7 +31,7 @@ start file = do let key = genKey (head backends) keyname showStart "setkey" file return $ Just $ perform file key -perform :: FilePath -> Key -> SubCmdPerform +perform :: FilePath -> Key -> CommandPerform perform file key = do -- the file might be on a different filesystem, so mv is used -- rather than simply calling moveToObjectDir key file @@ -43,7 +43,7 @@ perform file key = do then return $ Just $ cleanup key else error "mv failed!" -cleanup :: Key -> SubCmdCleanup +cleanup :: Key -> CommandCleanup cleanup key = do logStatus key ValuePresent return True diff --git a/Command/Trust.hs b/Command/Trust.hs index 8060ee66f..3c3ec3b7e 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -17,17 +17,17 @@ import qualified Remotes import UUID import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withString start] {- Marks a remote as trusted. -} -start :: SubCmdStartString +start :: CommandStartString start name = do r <- Remotes.byName name showStart "trust" name return $ Just $ perform r -perform :: Git.Repo -> SubCmdPerform +perform :: Git.Repo -> CommandPerform perform repo = do uuid <- getUUID repo trusted <- getTrusted diff --git a/Command/Unannex.hs b/Command/Unannex.hs index 9580fc5e7..42354b8c4 100644 --- a/Command/Unannex.hs +++ b/Command/Unannex.hs @@ -20,16 +20,16 @@ import Core import qualified GitRepo as Git import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesInGit start] {- The unannex subcommand undoes an add. -} -start :: SubCmdStartString +start :: CommandStartString start file = isAnnexed file $ \(key, backend) -> do showStart "unannex" file return $ Just $ perform file key backend -perform :: FilePath -> Key -> Backend -> SubCmdPerform +perform :: FilePath -> Key -> Backend -> CommandPerform perform file key backend = do -- force backend to always remove ok <- Backend.removeKey backend key (Just 0) @@ -37,7 +37,7 @@ perform file key backend = do then return $ Just $ cleanup file key else return Nothing -cleanup :: FilePath -> Key -> SubCmdCleanup +cleanup :: FilePath -> Key -> CommandCleanup cleanup file key = do g <- Annex.gitRepo diff --git a/Command/Uninit.hs b/Command/Uninit.hs index fcb77a92b..6001c55cd 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -20,15 +20,15 @@ import qualified Annex import qualified Command.Unannex import qualified Command.Init -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withAll withFilesInGit Command.Unannex.start, withNothing start] -start :: SubCmdStartNothing +start :: CommandStartNothing start = do showStart "uninit" "" return $ Just $ perform -perform :: SubCmdPerform +perform :: CommandPerform perform = do g <- Annex.gitRepo diff --git a/Command/Unlock.hs b/Command/Unlock.hs index ff22fa84b..21f34d1db 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -18,17 +18,17 @@ import Locations import Core import CopyFile -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withFilesInGit start] {- The unlock subcommand replaces the symlink with a copy of the file's - content. -} -start :: SubCmdStartString +start :: CommandStartString start file = isAnnexed file $ \(key, _) -> do showStart "unlock" file return $ Just $ perform file key -perform :: FilePath -> Key -> SubCmdPerform +perform :: FilePath -> Key -> CommandPerform perform dest key = do g <- Annex.gitRepo let src = annexLocation g key diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 5ed8de245..6458040b3 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -17,17 +17,17 @@ import qualified Remotes import UUID import Messages -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withString start] {- Marks a remote as not trusted. -} -start :: SubCmdStartString +start :: CommandStartString start name = do r <- Remotes.byName name showStart "untrust" name return $ Just $ perform r -perform :: Git.Repo -> SubCmdPerform +perform :: Git.Repo -> CommandPerform perform repo = do uuid <- getUUID repo trusted <- getTrusted diff --git a/Command/Unused.hs b/Command/Unused.hs index 69a16f254..dba9aa517 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -17,16 +17,16 @@ import Messages import Locations import qualified Annex -seek :: [SubCmdSeek] +seek :: [CommandSeek] seek = [withNothing start] {- Finds unused content in the annex. -} -start :: SubCmdStartNothing +start :: CommandStartNothing start = do showStart "unused" "" return $ Just perform -perform :: SubCmdPerform +perform :: CommandPerform perform = do _ <- checkUnused return $ Just $ return True |