summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-01-26 00:17:38 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-01-26 00:17:38 -0400
commit6a97b10fcb3e1fa6a230d92a25b42ded587ff743 (patch)
treeb8a6ce70916c397c67788b47de6a389db8753969 /Command
parent082b022f9ae56b1446b6607cf7851cd4f1d4f904 (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.hs2
-rw-r--r--Command/FromKey.hs19
-rw-r--r--Command/Move.hs77
-rw-r--r--Command/SetKey.hs26
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
-