diff options
Diffstat (limited to 'Command')
-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 |
21 files changed, 77 insertions, 74 deletions
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 |