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

134
Annex.hs
View file

@ -8,26 +8,18 @@
module Annex ( module Annex (
Annex, Annex,
AnnexState(..), AnnexState(..),
getState,
new, new,
run, run,
eval, eval,
getState,
changeState,
gitRepo, gitRepo,
gitRepoChange,
backendsChange,
FlagName,
Flag(..),
flagIsSet,
flagChange,
flagGet,
queue, queue,
queueGet,
queueRun, queueRun,
setConfig setConfig
) where ) where
import Control.Monad.State import Control.Monad.State
import qualified Data.Map as M
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified GitQueue import qualified GitQueue
@ -37,40 +29,42 @@ import qualified TypeInternals
type Annex = StateT AnnexState IO type Annex = StateT AnnexState IO
-- internal state storage -- internal state storage
data AnnexState = AnnexState { data AnnexState = AnnexState
repo :: Git.Repo, { repo :: Git.Repo
backends :: [TypeInternals.Backend Annex], , backends :: [TypeInternals.Backend Annex]
supportedBackends :: [TypeInternals.Backend Annex], , supportedBackends :: [TypeInternals.Backend Annex]
flags :: M.Map FlagName Flag, , repoqueue :: GitQueue.Queue
repoqueue :: GitQueue.Queue, , quiet :: Bool
quiet :: Bool , force :: Bool
} deriving (Show) , defaultbackend :: Maybe String
, defaultkey :: Maybe String
, toremote :: Maybe String
, fromremote :: Maybe String
, exclude :: [String]
, remotesread :: Bool
} deriving (Show)
-- command-line flags newState :: Git.Repo -> [TypeInternals.Backend Annex] -> AnnexState
type FlagName = String newState gitrepo allbackends = AnnexState
data Flag = { repo = gitrepo
FlagBool Bool | , backends = []
FlagString String , supportedBackends = allbackends
deriving (Eq, Read, Show) , repoqueue = GitQueue.empty
, quiet = False
, force = False
, defaultbackend = Nothing
, defaultkey = Nothing
, toremote = Nothing
, fromremote = Nothing
, exclude = []
, remotesread = False
}
{- Create and returns an Annex state object for the specified git repo. -} {- Create and returns an Annex state object for the specified git repo. -}
new :: Git.Repo -> [TypeInternals.Backend Annex] -> IO AnnexState new :: Git.Repo -> [TypeInternals.Backend Annex] -> IO AnnexState
new gitrepo allbackends = do new gitrepo allbackends = do
let s = AnnexState { gitrepo' <- liftIO $ Git.configRead gitrepo
repo = gitrepo, return $ newState gitrepo' allbackends
backends = [],
supportedBackends = allbackends,
flags = M.empty,
repoqueue = GitQueue.empty,
quiet = False
}
(_,s') <- Annex.run s prep
return s'
where
prep = do
-- read git config and update state
gitrepo' <- liftIO $ Git.configRead gitrepo
Annex.gitRepoChange gitrepo'
{- performs an action in the Annex monad -} {- performs an action in the Annex monad -}
run :: AnnexState -> Annex a -> IO (a, AnnexState) run :: AnnexState -> Annex a -> IO (a, AnnexState)
@ -78,50 +72,26 @@ run state action = runStateT action state
eval :: AnnexState -> Annex a -> IO a eval :: AnnexState -> Annex a -> IO a
eval state action = evalStateT action state eval state action = evalStateT action state
{- gets a value from the internal Annex state -} {- Gets a value from the internal state, selected by the passed value
- constructor. -}
getState :: (AnnexState -> a) -> Annex a getState :: (AnnexState -> a) -> Annex a
getState a = do getState c = do
state <- get state <- get
return (a state) return (c state)
{- Applies a state mutation function to change the internal state.
-
- Example: changeState (\s -> s { quiet = True })
-}
changeState :: (AnnexState -> AnnexState) -> Annex ()
changeState a = do
state <- get
put (a state)
{- Returns the git repository being acted on -} {- Returns the git repository being acted on -}
gitRepo :: Annex Git.Repo gitRepo :: Annex Git.Repo
gitRepo = getState repo gitRepo = getState repo
{- Changes the git repository being acted on. -}
gitRepoChange :: Git.Repo -> Annex ()
gitRepoChange r = do
state <- get
put state { repo = r }
{- Sets the backends to use. -}
backendsChange :: [TypeInternals.Backend Annex] -> Annex ()
backendsChange b = do
state <- get
put state { backends = b }
{- Return True if a Bool flag is set. -}
flagIsSet :: FlagName -> Annex Bool
flagIsSet name = do
state <- get
case (M.lookup name $ flags state) of
Just (FlagBool True) -> return True
_ -> return False
{- Sets the value of a flag. -}
flagChange :: FlagName -> Flag -> Annex ()
flagChange name val = do
state <- get
put state { flags = M.insert name val $ flags state }
{- Gets the value of a String flag (or "" if there is no such String flag) -}
flagGet :: FlagName -> Annex String
flagGet name = do
state <- get
case (M.lookup name $ flags state) of
Just (FlagString s) -> return s
_ -> return ""
{- Adds a git command to the queue. -} {- Adds a git command to the queue. -}
queue :: String -> [String] -> FilePath -> Annex () queue :: String -> [String] -> FilePath -> Annex ()
queue command params file = do queue command params file = do
@ -129,12 +99,6 @@ queue command params file = do
let q = repoqueue state let q = repoqueue state
put state { repoqueue = GitQueue.add q command params file } put state { repoqueue = GitQueue.add q command params file }
{- Returns the queue. -}
queueGet :: Annex GitQueue.Queue
queueGet = do
state <- get
return (repoqueue state)
{- Runs (and empties) the queue. -} {- Runs (and empties) the queue. -}
queueRun :: Annex () queueRun :: Annex ()
queueRun = do queueRun = do
@ -146,9 +110,9 @@ queueRun = do
{- Changes a git config setting in both internal state and .git/config -} {- Changes a git config setting in both internal state and .git/config -}
setConfig :: String -> String -> Annex () setConfig :: String -> String -> Annex ()
setConfig key value = do setConfig k value = do
g <- Annex.gitRepo g <- Annex.gitRepo
liftIO $ Git.run g ["config", key, value] liftIO $ Git.run g ["config", k, value]
-- re-read git config and update the repo's state -- re-read git config and update the repo's state
g' <- liftIO $ Git.configRead g g' <- liftIO $ Git.configRead g
Annex.gitRepoChange g' Annex.changeState $ \s -> s { Annex.repo = g' }

View file

@ -48,20 +48,24 @@ list = do
if not $ null l if not $ null l
then return l then return l
else do else do
s <- getstandard
d <- Annex.getState Annex.defaultbackend
handle d s
where
parseBackendList l [] = l
parseBackendList bs s = map (lookupBackendName bs) $ words s
handle Nothing s = return s
handle (Just "") s = return s
handle (Just name) s = do
bs <- Annex.getState Annex.supportedBackends
let l' = (lookupBackendName bs name):s
Annex.changeState $ \state -> state { Annex.backends = l' }
return l'
getstandard = do
bs <- Annex.getState Annex.supportedBackends bs <- Annex.getState Annex.supportedBackends
g <- Annex.gitRepo g <- Annex.gitRepo
let defaults = parseBackendList bs $ Git.configGet g "annex.backends" "" return $ parseBackendList bs $
backendflag <- Annex.flagGet "backend" Git.configGet g "annex.backends" ""
let l' = if not $ null backendflag
then (lookupBackendName bs backendflag):defaults
else defaults
Annex.backendsChange l'
return l'
where
parseBackendList bs s =
if null s
then bs
else map (lookupBackendName bs) $ words s
{- Looks up a backend in a list. May fail if unknown. -} {- Looks up a backend in a list. May fail if unknown. -}
lookupBackendName :: [Backend Annex] -> String -> Backend Annex lookupBackendName :: [Backend Annex] -> String -> Backend Annex

View file

@ -90,7 +90,7 @@ copyKeyFile key file = do
- error if not. -} - error if not. -}
checkRemoveKey :: Key -> Maybe Int -> Annex Bool checkRemoveKey :: Key -> Maybe Int -> Annex Bool
checkRemoveKey key numcopiesM = do checkRemoveKey key numcopiesM = do
force <- Annex.flagIsSet "force" force <- Annex.getState Annex.force
if force || numcopiesM == Just 0 if force || numcopiesM == Just 0
then return True then return True
else do else do

View file

@ -102,7 +102,7 @@ startup = do
{- Cleanup actions. -} {- Cleanup actions. -}
shutdown :: Integer -> Annex () shutdown :: Integer -> Annex ()
shutdown errnum = do shutdown errnum = do
q <- Annex.queueGet q <- Annex.getState Annex.repoqueue
unless (q == GitQueue.empty) $ do unless (q == GitQueue.empty) $ do
showSideAction "Recording state in git..." showSideAction "Recording state in git..."
Annex.queueRun Annex.queueRun

View file

@ -179,11 +179,11 @@ backendPairs a files = do
filterFiles :: [FilePath] -> Annex [FilePath] filterFiles :: [FilePath] -> Annex [FilePath]
filterFiles l = do filterFiles l = do
let l' = filter notState l let l' = filter notState l
exclude <- Annex.flagGet "exclude" exclude <- Annex.getState Annex.exclude
if null exclude if null exclude
then return l' then return l'
else do else do
let regexp = compile ("^" ++ wildToRegex exclude) [] let regexp = compile (toregex exclude) []
return $ filter (notExcluded regexp) l' return $ filter (notExcluded regexp) l'
where where
notState f = stateLoc /= take stateLocLen f notState f = stateLoc /= take stateLocLen f
@ -191,6 +191,10 @@ filterFiles l = do
notExcluded r f = case match r f [] of notExcluded r f = case match r f [] of
Nothing -> True Nothing -> True
Just _ -> False Just _ -> False
toregex exclude = "^(" ++ toregex' exclude "" ++ ")"
toregex' [] c = c
toregex' (w:ws) "" = toregex' ws (wildToRegex w)
toregex' (w:ws) c = toregex' ws (c ++ "|" ++ wildToRegex w)
{- filter out symlinks -} {- filter out symlinks -}
notSymlink :: FilePath -> IO Bool notSymlink :: FilePath -> IO Bool
@ -219,3 +223,16 @@ paramName :: String
paramName = "NAME" paramName = "NAME"
paramNothing :: String paramNothing :: String
paramNothing = "" paramNothing = ""
{- The Key specified by the --key and --backend parameters. -}
cmdlineKey :: Annex Key
cmdlineKey = do
k <- Annex.getState Annex.defaultkey
backends <- Backend.list
return $ genKey (head backends) (keyname' k)
where
keyname' Nothing = badkey
keyname' (Just "") = badkey
keyname' (Just n) = n
badkey = error "please specify the key with --key"

View file

@ -28,7 +28,7 @@ start keyname = do
backends <- Backend.list backends <- Backend.list
let key = genKey (head backends) keyname let key = genKey (head backends) keyname
present <- inAnnex key present <- inAnnex key
force <- Annex.flagIsSet "force" force <- Annex.getState Annex.force
if not present if not present
then return Nothing then return Nothing
else if not force else if not force

View file

@ -10,7 +10,7 @@ module Command.FromKey where
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import System.Posix.Files import System.Posix.Files
import System.Directory import System.Directory
import Control.Monad (when, unless) import Control.Monad (unless)
import Command import Command
import qualified Annex import qualified Annex
@ -30,22 +30,21 @@ seek = [withFilesMissing start]
{- Adds a file pointing at a manually-specified key -} {- Adds a file pointing at a manually-specified key -}
start :: CommandStartString start :: CommandStartString
start file = do start file = do
keyname <- Annex.flagGet "key" key <- cmdlineKey
when (null keyname) $ error "please specify the key with --key"
backends <- Backend.list
let key = genKey (head backends) keyname
inbackend <- Backend.hasKey key inbackend <- Backend.hasKey key
unless inbackend $ error $ unless inbackend $ error $
"key ("++keyname++") is not present in backend" "key ("++keyName key++") is not present in backend"
showStart "fromkey" file showStart "fromkey" file
return $ Just $ perform file key return $ Just $ perform file
perform :: FilePath -> Key -> CommandPerform
perform file key = do perform :: FilePath -> CommandPerform
perform file = do
key <- cmdlineKey
link <- calcGitLink file key link <- calcGitLink file key
liftIO $ createDirectoryIfMissing True (parentDir file) liftIO $ createDirectoryIfMissing True (parentDir file)
liftIO $ createSymbolicLink link file liftIO $ createSymbolicLink link file
return $ Just $ cleanup file return $ Just $ cleanup file
cleanup :: FilePath -> CommandCleanup cleanup :: FilePath -> CommandCleanup
cleanup file = do cleanup file = do
Annex.queue "add" ["--"] file Annex.queue "add" ["--"] file

View file

@ -34,12 +34,16 @@ seek = [withFilesInGit $ start True]
- moving data in the key-value backend. -} - moving data in the key-value backend. -}
start :: Bool -> CommandStartString start :: Bool -> CommandStartString
start move file = do start move file = do
fromName <- Annex.flagGet "fromrepository" to <- Annex.getState Annex.toremote
toName <- Annex.flagGet "torepository" from <- Annex.getState Annex.fromremote
case (fromName, toName) of case (from, to) of
("", "") -> error "specify either --from or --to" (Nothing, Nothing) -> error "specify either --from or --to"
("", _) -> toStart move file (Nothing, Just name) -> do
(_ , "") -> fromStart move file 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" (_ , _) -> error "only one of --from or --to can be specified"
showAction :: Bool -> FilePath -> Annex () 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 - A file's content can be moved even if there are insufficient copies to
- allow it to be dropped. - allow it to be dropped.
-} -}
toStart :: Bool -> CommandStartString toStart :: Git.Repo -> Bool -> CommandStartString
toStart move file = isAnnexed file $ \(key, _) -> do toStart dest move file = isAnnexed file $ \(key, _) -> do
ishere <- inAnnex key ishere <- inAnnex key
if not ishere if not ishere
then return Nothing -- not here, so nothing to do then return Nothing -- not here, so nothing to do
else do else do
showAction move file showAction move file
return $ Just $ toPerform move key return $ Just $ toPerform dest move key
toPerform :: Bool -> Key -> CommandPerform toPerform :: Git.Repo -> Bool -> Key -> CommandPerform
toPerform move key = do toPerform dest move key = do
Remotes.readConfigs Remotes.readConfigs
-- checking the remote is expensive, so not done in the start step -- checking the remote is expensive, so not done in the start step
remote <- Remotes.commandLineRemote isthere <- Remotes.inAnnex dest key
isthere <- Remotes.inAnnex remote key
case isthere of case isthere of
Left err -> do Left err -> do
showNote $ show err showNote $ show err
return Nothing return Nothing
Right False -> do Right False -> do
showNote $ "to " ++ Git.repoDescribe remote ++ "..." showNote $ "to " ++ Git.repoDescribe dest ++ "..."
ok <- Remotes.copyToRemote remote key ok <- Remotes.copyToRemote dest key
if ok if ok
then return $ Just $ toCleanup move remote key then return $ Just $ toCleanup dest move key
else return Nothing -- failed else return Nothing -- failed
Right True -> return $ Just $ toCleanup move remote key Right True -> return $ Just $ toCleanup dest move key
toCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup toCleanup :: Git.Repo -> Bool -> Key -> CommandCleanup
toCleanup move remote key = do toCleanup dest move key = do
remoteHasKey remote key True remoteHasKey dest key True
if move if move
then Command.Drop.cleanup key then Command.Drop.cleanup key
else return True else return True
@ -103,36 +106,34 @@ toCleanup move remote key = do
- If the current repository already has the content, it is still removed - If the current repository already has the content, it is still removed
- from the other repository when moving. - from the other repository when moving.
-} -}
fromStart :: Bool -> CommandStartString fromStart :: Git.Repo -> Bool -> CommandStartString
fromStart move file = isAnnexed file $ \(key, _) -> do fromStart src move file = isAnnexed file $ \(key, _) -> do
remote <- Remotes.commandLineRemote
(trusted, untrusted, _) <- Remotes.keyPossibilities key (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 then return Nothing
else do else do
showAction move file showAction move file
return $ Just $ fromPerform move key return $ Just $ fromPerform src move key
fromPerform :: Bool -> Key -> CommandPerform fromPerform :: Git.Repo -> Bool -> Key -> CommandPerform
fromPerform move key = do fromPerform src move key = do
remote <- Remotes.commandLineRemote
ishere <- inAnnex key ishere <- inAnnex key
if ishere if ishere
then return $ Just $ fromCleanup move remote key then return $ Just $ fromCleanup src move key
else do else do
showNote $ "from " ++ Git.repoDescribe remote ++ "..." showNote $ "from " ++ Git.repoDescribe src ++ "..."
ok <- getViaTmp key $ Remotes.copyFromRemote remote key ok <- getViaTmp key $ Remotes.copyFromRemote src key
if ok if ok
then return $ Just $ fromCleanup move remote key then return $ Just $ fromCleanup src move key
else return Nothing -- fail else return Nothing -- fail
fromCleanup :: Bool -> Git.Repo -> Key -> CommandCleanup fromCleanup :: Git.Repo -> Bool -> Key -> CommandCleanup
fromCleanup True remote key = do fromCleanup src True key = do
ok <- Remotes.onRemote remote (boolSystem, False) "dropkey" ok <- Remotes.onRemote src (boolSystem, False) "dropkey"
["--quiet", "--force", ["--quiet", "--force",
"--backend=" ++ backendName key, "--backend=" ++ backendName key,
keyName 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 -- even if it seemed to fail; the failure could have occurred
-- after it really dropped it -- after it really dropped it
remoteHasKey remote key False remoteHasKey src key False
return ok return ok
fromCleanup False _ _ = return True fromCleanup _ False _ = return True

View file

@ -8,14 +8,10 @@
module Command.SetKey where module Command.SetKey where
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import Control.Monad (when)
import Command import Command
import qualified Annex
import Utility import Utility
import qualified Backend
import LocationLog import LocationLog
import Types
import Content import Content
import Messages import Messages
@ -29,26 +25,24 @@ seek = [withTempFile start]
{- Sets cached content for a key. -} {- Sets cached content for a key. -}
start :: CommandStartString start :: CommandStartString
start file = do 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 showStart "setkey" file
return $ Just $ perform file key return $ Just $ perform file
perform :: FilePath -> Key -> CommandPerform
perform file key = do perform :: FilePath -> CommandPerform
perform file = do
key <- cmdlineKey
-- the file might be on a different filesystem, so mv is used -- 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 ok <- getViaTmp key $ \dest -> do
if dest /= file if dest /= file
then liftIO $ boolSystem "mv" [file, dest] then liftIO $ boolSystem "mv" [file, dest]
else return True else return True
if ok if ok
then return $ Just $ cleanup key then return $ Just $ cleanup
else error "mv failed!" else error "mv failed!"
cleanup :: Key -> CommandCleanup cleanup :: CommandCleanup
cleanup key = do cleanup = do
key <- cmdlineKey
logStatus key ValuePresent logStatus key ValuePresent
return True return True

View file

@ -13,6 +13,7 @@ import qualified GitRepo as Git
import CmdLine import CmdLine
import Command import Command
import Options import Options
import qualified Annex
import qualified Command.Add import qualified Command.Add
import qualified Command.Unannex import qualified Command.Unannex
@ -65,15 +66,20 @@ cmds = concat
options :: [Option] options :: [Option]
options = commonOptions ++ options = commonOptions ++
[ Option ['k'] ["key"] (ReqArg (storeOptString "key") paramKey) [ Option ['k'] ["key"] (ReqArg setkey paramKey)
"specify a key to use" "specify a key to use"
, Option ['t'] ["to"] (ReqArg (storeOptString "torepository") paramRemote) , Option ['t'] ["to"] (ReqArg setto paramRemote)
"specify to where to transfer content" "specify to where to transfer content"
, Option ['f'] ["from"] (ReqArg (storeOptString "fromrepository") paramRemote) , Option ['f'] ["from"] (ReqArg setfrom paramRemote)
"specify from where to transfer content" "specify from where to transfer content"
, Option ['x'] ["exclude"] (ReqArg (storeOptString "exclude") paramGlob) , Option ['x'] ["exclude"] (ReqArg addexclude paramGlob)
"skip files matching the glob pattern" "skip files matching the glob pattern"
] ]
where
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v }
setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v }
setfrom v = Annex.changeState $ \s -> s { Annex.fromremote = Just v }
addexclude v = Annex.changeState $ \s -> s { Annex.exclude = v:(Annex.exclude s) }
header :: String header :: String
header = "Usage: git-annex command [option ..]" header = "Usage: git-annex command [option ..]"

View file

@ -17,7 +17,7 @@ import qualified Annex
verbose :: Annex () -> Annex () verbose :: Annex () -> Annex ()
verbose a = do verbose a = do
q <- Annex.flagIsSet "quiet" q <- Annex.getState Annex.quiet
unless q a unless q a
showSideAction :: String -> Annex () showSideAction :: String -> Annex ()

View file

@ -18,19 +18,18 @@ import Command
-} -}
type Option = OptDescr (Annex ()) type Option = OptDescr (Annex ())
storeOptBool :: Annex.FlagName -> Bool -> Annex ()
storeOptBool name val = Annex.flagChange name $ Annex.FlagBool val
storeOptString :: Annex.FlagName -> String -> Annex ()
storeOptString name val = Annex.flagChange name $ Annex.FlagString val
commonOptions :: [Option] commonOptions :: [Option]
commonOptions = commonOptions =
[ Option ['f'] ["force"] (NoArg (storeOptBool "force" True)) [ Option ['f'] ["force"] (NoArg (setforce True))
"allow actions that may lose annexed data" "allow actions that may lose annexed data"
, Option ['q'] ["quiet"] (NoArg (storeOptBool "quiet" True)) , Option ['q'] ["quiet"] (NoArg (setquiet True))
"avoid verbose output" "avoid verbose output"
, Option ['v'] ["verbose"] (NoArg (storeOptBool "quiet" False)) , Option ['v'] ["verbose"] (NoArg (setquiet False))
"allow verbose output" "allow verbose output"
, Option ['b'] ["backend"] (ReqArg (storeOptString "backend") paramName) , Option ['b'] ["backend"] (ReqArg setdefaultbackend paramName)
"specify default key-value backend to use" "specify default key-value backend to use"
] ]
where
setforce v = Annex.changeState $ \s -> s { Annex.force = v }
setquiet v = Annex.changeState $ \s -> s { Annex.quiet = v }
setdefaultbackend v = Annex.changeState $ \s -> s { Annex.defaultbackend = Just v }

View file

@ -11,7 +11,6 @@ module Remotes (
keyPossibilities, keyPossibilities,
inAnnex, inAnnex,
same, same,
commandLineRemote,
byName, byName,
copyFromRemote, copyFromRemote,
copyToRemote, copyToRemote,
@ -69,7 +68,7 @@ tryGitConfigRead r
g <- Annex.gitRepo g <- Annex.gitRepo
let l = Git.remotes g let l = Git.remotes g
let g' = Git.remotesAdd g $ exchange l r' let g' = Git.remotesAdd g $ exchange l r'
Annex.gitRepoChange g' Annex.changeState $ \s -> s { Annex.repo = g' }
return $ Right r' return $ Right r'
exchange [] _ = [] exchange [] _ = []
exchange (old:ls) new = exchange (old:ls) new =
@ -93,7 +92,7 @@ tryGitConfigRead r
readConfigs :: Annex () readConfigs :: Annex ()
readConfigs = do readConfigs = do
g <- Annex.gitRepo g <- Annex.gitRepo
remotesread <- Annex.flagIsSet "remotesread" remotesread <- Annex.getState Annex.remotesread
unless remotesread $ do unless remotesread $ do
allremotes <- filterM repoNotIgnored $ Git.remotes g allremotes <- filterM repoNotIgnored $ Git.remotes g
let cheap = filter (not . Git.repoIsUrl) allremotes let cheap = filter (not . Git.repoIsUrl) allremotes
@ -105,7 +104,7 @@ readConfigs = do
let todo = cheap ++ doexpensive let todo = cheap ++ doexpensive
unless (null todo) $ do unless (null todo) $ do
_ <- mapM tryGitConfigRead todo _ <- mapM tryGitConfigRead todo
Annex.flagChange "remotesread" $ Annex.FlagBool True Annex.changeState $ \s -> s { Annex.remotesread = True }
where where
cachedUUID r = do cachedUUID r = do
u <- getUUID r u <- getUUID r
@ -204,27 +203,22 @@ repoCost r = do
repoNotIgnored :: Git.Repo -> Annex Bool repoNotIgnored :: Git.Repo -> Annex Bool
repoNotIgnored r = do repoNotIgnored r = do
ignored <- repoConfig r "ignore" "false" ignored <- repoConfig r "ignore" "false"
fromName <- Annex.flagGet "fromrepository" to <- match Annex.toremote
toName <- Annex.flagGet "torepository" from <- match Annex.fromremote
let name = if null fromName then toName else fromName if to || from
if not $ null name then return True
then return $ match name
else return $ not $ Git.configTrue ignored else return $ not $ Git.configTrue ignored
where where
match name = name == Git.repoRemoteName r match a = do
name <- Annex.getState a
case name of
Nothing -> return False
Just n -> return $ n == Git.repoRemoteName r
{- Checks if two repos are the same, by comparing their remote names. -} {- Checks if two repos are the same, by comparing their remote names. -}
same :: Git.Repo -> Git.Repo -> Bool same :: Git.Repo -> Git.Repo -> Bool
same a b = Git.repoRemoteName a == Git.repoRemoteName b same a b = Git.repoRemoteName a == Git.repoRemoteName b
{- Returns the remote specified by --from or --to, may fail with error. -}
commandLineRemote :: Annex Git.Repo
commandLineRemote = do
fromName <- Annex.flagGet "fromrepository"
toName <- Annex.flagGet "torepository"
let name = if null fromName then toName else fromName
byName name
{- Looks up a remote by name. -} {- Looks up a remote by name. -}
byName :: String -> Annex Git.Repo byName :: String -> Annex Git.Repo
byName name = do byName name = do

1
debian/changelog vendored
View file

@ -1,6 +1,7 @@
git-annex (0.19) UNRELEASED; urgency=low git-annex (0.19) UNRELEASED; urgency=low
* Support using the uuidgen command if the uuid command is not available. * Support using the uuidgen command if the uuid command is not available.
* Allow --exclude to be specified more than once.
-- Joey Hess <joeyh@debian.org> Wed, 19 Jan 2011 18:07:51 -0400 -- Joey Hess <joeyh@debian.org> Wed, 19 Jan 2011 18:07:51 -0400

View file

@ -258,6 +258,8 @@ Many git-annex commands will stage changes for later `git commit` by you.
Skips files matching the glob pattern. The glob is matched relative to Skips files matching the glob pattern. The glob is matched relative to
the current directory. the current directory.
This option can be specified multiple times.
* --backend=name * --backend=name
Specifies which key-value backend to use. Specifies which key-value backend to use.