diff options
author | Joey Hess <joey@kitenet.net> | 2011-01-26 00:17:38 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2011-01-26 00:17:38 -0400 |
commit | 6a97b10fcb3e1fa6a230d92a25b42ded587ff743 (patch) | |
tree | b8a6ce70916c397c67788b47de6a389db8753969 /Command | |
parent | 082b022f9ae56b1446b6607cf7851cd4f1d4f904 (diff) |
rework config storage
Moved away from a map of flags to storing config directly in the AnnexState
structure. Got rid of most accessor functions in Annex.
This allowed supporting multiple --exclude flags.
Diffstat (limited to 'Command')
-rw-r--r-- | Command/DropKey.hs | 2 | ||||
-rw-r--r-- | Command/FromKey.hs | 19 | ||||
-rw-r--r-- | Command/Move.hs | 77 | ||||
-rw-r--r-- | Command/SetKey.hs | 26 |
4 files changed, 59 insertions, 65 deletions
diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 6ba5c117c..8c7566df8 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -28,7 +28,7 @@ start keyname = do backends <- Backend.list let key = genKey (head backends) keyname present <- inAnnex key - force <- Annex.flagIsSet "force" + force <- Annex.getState Annex.force if not present then return Nothing else if not force diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 9c4a3cfdc..881794258 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -10,7 +10,7 @@ module Command.FromKey where import Control.Monad.State (liftIO) import System.Posix.Files import System.Directory -import Control.Monad (when, unless) +import Control.Monad (unless) import Command import qualified Annex @@ -30,22 +30,21 @@ seek = [withFilesMissing start] {- Adds a file pointing at a manually-specified key -} start :: CommandStartString start file = do - keyname <- Annex.flagGet "key" - when (null keyname) $ error "please specify the key with --key" - backends <- Backend.list - let key = genKey (head backends) keyname - + key <- cmdlineKey inbackend <- Backend.hasKey key unless inbackend $ error $ - "key ("++keyname++") is not present in backend" + "key ("++keyName key++") is not present in backend" showStart "fromkey" file - return $ Just $ perform file key -perform :: FilePath -> Key -> CommandPerform -perform file key = do + return $ Just $ perform file + +perform :: FilePath -> CommandPerform +perform file = do + key <- cmdlineKey link <- calcGitLink file key liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ createSymbolicLink link file return $ Just $ cleanup file + cleanup :: FilePath -> CommandCleanup cleanup file = do Annex.queue "add" ["--"] file diff --git a/Command/Move.hs b/Command/Move.hs index 2920c0661..4416134c0 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -34,12 +34,16 @@ seek = [withFilesInGit $ start True] - moving data in the key-value backend. -} start :: Bool -> CommandStartString start move file = do - fromName <- Annex.flagGet "fromrepository" - toName <- Annex.flagGet "torepository" - case (fromName, toName) of - ("", "") -> error "specify either --from or --to" - ("", _) -> toStart move file - (_ , "") -> fromStart move file + to <- Annex.getState Annex.toremote + from <- Annex.getState Annex.fromremote + case (from, to) of + (Nothing, Nothing) -> error "specify either --from or --to" + (Nothing, Just name) -> do + dest <- Remotes.byName name + toStart dest move file + (Just name, Nothing) -> do + src <- Remotes.byName name + fromStart src move file (_ , _) -> error "only one of --from or --to can be specified" showAction :: Bool -> FilePath -> Annex () @@ -65,34 +69,33 @@ 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 -> CommandStartString -toStart move file = isAnnexed file $ \(key, _) -> do +toStart :: Git.Repo -> Bool -> CommandStartString +toStart dest move file = isAnnexed file $ \(key, _) -> do ishere <- inAnnex key if not ishere then return Nothing -- not here, so nothing to do else do showAction move file - return $ Just $ toPerform move key -toPerform :: Bool -> Key -> CommandPerform -toPerform move key = do + return $ Just $ toPerform dest move key +toPerform :: Git.Repo -> Bool -> Key -> CommandPerform +toPerform dest move key = do Remotes.readConfigs -- checking the remote is expensive, so not done in the start step - remote <- Remotes.commandLineRemote - isthere <- Remotes.inAnnex remote key + isthere <- Remotes.inAnnex dest key case isthere of Left err -> do showNote $ show err return Nothing Right False -> do - showNote $ "to " ++ Git.repoDescribe remote ++ "..." - ok <- Remotes.copyToRemote remote key + showNote $ "to " ++ Git.repoDescribe dest ++ "..." + ok <- Remotes.copyToRemote dest key if ok - then return $ Just $ toCleanup move remote key + then return $ Just $ toCleanup dest move key else return Nothing -- failed - Right True -> return $ Just $ toCleanup move remote key -toCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup -toCleanup move remote key = do - remoteHasKey remote key True + Right True -> return $ Just $ toCleanup dest move key +toCleanup :: Git.Repo -> Bool -> Key -> CommandCleanup +toCleanup dest move key = do + remoteHasKey dest key True if move then Command.Drop.cleanup key else return True @@ -103,36 +106,34 @@ toCleanup move remote key = do - If the current repository already has the content, it is still removed - from the other repository when moving. -} -fromStart :: Bool -> CommandStartString -fromStart move file = isAnnexed file $ \(key, _) -> do - remote <- Remotes.commandLineRemote +fromStart :: Git.Repo -> Bool -> CommandStartString +fromStart src move file = isAnnexed file $ \(key, _) -> do (trusted, untrusted, _) <- Remotes.keyPossibilities key - if null $ filter (\r -> Remotes.same r remote) (trusted ++ untrusted) + if null $ filter (\r -> Remotes.same r src) (trusted ++ untrusted) then return Nothing else do showAction move file - return $ Just $ fromPerform move key -fromPerform :: Bool -> Key -> CommandPerform -fromPerform move key = do - remote <- Remotes.commandLineRemote + return $ Just $ fromPerform src move key +fromPerform :: Git.Repo -> Bool -> Key -> CommandPerform +fromPerform src move key = do ishere <- inAnnex key if ishere - then return $ Just $ fromCleanup move remote key + then return $ Just $ fromCleanup src move key else do - showNote $ "from " ++ Git.repoDescribe remote ++ "..." - ok <- getViaTmp key $ Remotes.copyFromRemote remote key + showNote $ "from " ++ Git.repoDescribe src ++ "..." + ok <- getViaTmp key $ Remotes.copyFromRemote src key if ok - then return $ Just $ fromCleanup move remote key + then return $ Just $ fromCleanup src move key else return Nothing -- fail -fromCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup -fromCleanup True remote key = do - ok <- Remotes.onRemote remote (boolSystem, False) "dropkey" +fromCleanup :: Git.Repo -> Bool -> Key -> CommandCleanup +fromCleanup src True key = do + ok <- Remotes.onRemote src (boolSystem, False) "dropkey" ["--quiet", "--force", "--backend=" ++ backendName key, keyName key] - -- better safe than sorry: assume the remote dropped the key + -- better safe than sorry: assume the src dropped the key -- even if it seemed to fail; the failure could have occurred -- after it really dropped it - remoteHasKey remote key False + remoteHasKey src key False return ok -fromCleanup False _ _ = return True +fromCleanup _ False _ = return True diff --git a/Command/SetKey.hs b/Command/SetKey.hs index 412504b2e..388392cd6 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -8,14 +8,10 @@ module Command.SetKey where import Control.Monad.State (liftIO) -import Control.Monad (when) import Command -import qualified Annex import Utility -import qualified Backend import LocationLog -import Types import Content import Messages @@ -29,26 +25,24 @@ seek = [withTempFile start] {- Sets cached content for a key. -} start :: CommandStartString start file = do - keyname <- Annex.flagGet "key" - when (null keyname) $ error "please specify the key with --key" - backends <- Backend.list - let key = genKey (head backends) keyname showStart "setkey" file - return $ Just $ perform file key -perform :: FilePath -> Key -> CommandPerform -perform file key = do + return $ Just $ perform file + +perform :: FilePath -> CommandPerform +perform file = do + key <- cmdlineKey -- the file might be on a different filesystem, so mv is used - -- rather than simply calling moveToObjectDir key file + -- rather than simply calling moveToObjectDir ok <- getViaTmp key $ \dest -> do if dest /= file then liftIO $ boolSystem "mv" [file, dest] else return True if ok - then return $ Just $ cleanup key + then return $ Just $ cleanup else error "mv failed!" -cleanup :: Key -> CommandCleanup -cleanup key = do +cleanup :: CommandCleanup +cleanup = do + key <- cmdlineKey logStatus key ValuePresent return True - |