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.
This commit is contained in:
Joey Hess 2011-01-26 00:17:38 -04:00
parent 082b022f9a
commit 6a97b10fcb
15 changed files with 179 additions and 198 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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