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:
parent
082b022f9a
commit
6a97b10fcb
15 changed files with 179 additions and 198 deletions
134
Annex.hs
134
Annex.hs
|
@ -8,26 +8,18 @@
|
|||
module Annex (
|
||||
Annex,
|
||||
AnnexState(..),
|
||||
getState,
|
||||
new,
|
||||
run,
|
||||
eval,
|
||||
getState,
|
||||
changeState,
|
||||
gitRepo,
|
||||
gitRepoChange,
|
||||
backendsChange,
|
||||
FlagName,
|
||||
Flag(..),
|
||||
flagIsSet,
|
||||
flagChange,
|
||||
flagGet,
|
||||
queue,
|
||||
queueGet,
|
||||
queueRun,
|
||||
setConfig
|
||||
) where
|
||||
|
||||
import Control.Monad.State
|
||||
import qualified Data.Map as M
|
||||
|
||||
import qualified GitRepo as Git
|
||||
import qualified GitQueue
|
||||
|
@ -37,40 +29,42 @@ import qualified TypeInternals
|
|||
type Annex = StateT AnnexState IO
|
||||
|
||||
-- internal state storage
|
||||
data AnnexState = AnnexState {
|
||||
repo :: Git.Repo,
|
||||
backends :: [TypeInternals.Backend Annex],
|
||||
supportedBackends :: [TypeInternals.Backend Annex],
|
||||
flags :: M.Map FlagName Flag,
|
||||
repoqueue :: GitQueue.Queue,
|
||||
quiet :: Bool
|
||||
} deriving (Show)
|
||||
data AnnexState = AnnexState
|
||||
{ repo :: Git.Repo
|
||||
, backends :: [TypeInternals.Backend Annex]
|
||||
, supportedBackends :: [TypeInternals.Backend Annex]
|
||||
, repoqueue :: GitQueue.Queue
|
||||
, quiet :: Bool
|
||||
, force :: Bool
|
||||
, defaultbackend :: Maybe String
|
||||
, defaultkey :: Maybe String
|
||||
, toremote :: Maybe String
|
||||
, fromremote :: Maybe String
|
||||
, exclude :: [String]
|
||||
, remotesread :: Bool
|
||||
} deriving (Show)
|
||||
|
||||
-- command-line flags
|
||||
type FlagName = String
|
||||
data Flag =
|
||||
FlagBool Bool |
|
||||
FlagString String
|
||||
deriving (Eq, Read, Show)
|
||||
newState :: Git.Repo -> [TypeInternals.Backend Annex] -> AnnexState
|
||||
newState gitrepo allbackends = AnnexState
|
||||
{ repo = gitrepo
|
||||
, backends = []
|
||||
, supportedBackends = allbackends
|
||||
, 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. -}
|
||||
new :: Git.Repo -> [TypeInternals.Backend Annex] -> IO AnnexState
|
||||
new gitrepo allbackends = do
|
||||
let s = AnnexState {
|
||||
repo = gitrepo,
|
||||
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'
|
||||
gitrepo' <- liftIO $ Git.configRead gitrepo
|
||||
return $ newState gitrepo' allbackends
|
||||
|
||||
{- performs an action in the Annex monad -}
|
||||
run :: AnnexState -> Annex a -> IO (a, AnnexState)
|
||||
|
@ -78,50 +72,26 @@ run state action = runStateT action state
|
|||
eval :: AnnexState -> Annex a -> IO a
|
||||
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 a = do
|
||||
getState c = do
|
||||
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 -}
|
||||
gitRepo :: Annex Git.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. -}
|
||||
queue :: String -> [String] -> FilePath -> Annex ()
|
||||
queue command params file = do
|
||||
|
@ -129,12 +99,6 @@ queue command params file = do
|
|||
let q = repoqueue state
|
||||
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. -}
|
||||
queueRun :: Annex ()
|
||||
queueRun = do
|
||||
|
@ -146,9 +110,9 @@ queueRun = do
|
|||
|
||||
{- Changes a git config setting in both internal state and .git/config -}
|
||||
setConfig :: String -> String -> Annex ()
|
||||
setConfig key value = do
|
||||
setConfig k value = do
|
||||
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
|
||||
g' <- liftIO $ Git.configRead g
|
||||
Annex.gitRepoChange g'
|
||||
Annex.changeState $ \s -> s { Annex.repo = g' }
|
||||
|
|
28
Backend.hs
28
Backend.hs
|
@ -48,20 +48,24 @@ list = do
|
|||
if not $ null l
|
||||
then return l
|
||||
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
|
||||
g <- Annex.gitRepo
|
||||
let defaults = parseBackendList bs $ Git.configGet g "annex.backends" ""
|
||||
backendflag <- Annex.flagGet "backend"
|
||||
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
|
||||
return $ parseBackendList bs $
|
||||
Git.configGet g "annex.backends" ""
|
||||
|
||||
{- Looks up a backend in a list. May fail if unknown. -}
|
||||
lookupBackendName :: [Backend Annex] -> String -> Backend Annex
|
||||
|
|
|
@ -90,7 +90,7 @@ copyKeyFile key file = do
|
|||
- error if not. -}
|
||||
checkRemoveKey :: Key -> Maybe Int -> Annex Bool
|
||||
checkRemoveKey key numcopiesM = do
|
||||
force <- Annex.flagIsSet "force"
|
||||
force <- Annex.getState Annex.force
|
||||
if force || numcopiesM == Just 0
|
||||
then return True
|
||||
else do
|
||||
|
|
|
@ -102,7 +102,7 @@ startup = do
|
|||
{- Cleanup actions. -}
|
||||
shutdown :: Integer -> Annex ()
|
||||
shutdown errnum = do
|
||||
q <- Annex.queueGet
|
||||
q <- Annex.getState Annex.repoqueue
|
||||
unless (q == GitQueue.empty) $ do
|
||||
showSideAction "Recording state in git..."
|
||||
Annex.queueRun
|
||||
|
|
21
Command.hs
21
Command.hs
|
@ -179,11 +179,11 @@ backendPairs a files = do
|
|||
filterFiles :: [FilePath] -> Annex [FilePath]
|
||||
filterFiles l = do
|
||||
let l' = filter notState l
|
||||
exclude <- Annex.flagGet "exclude"
|
||||
exclude <- Annex.getState Annex.exclude
|
||||
if null exclude
|
||||
then return l'
|
||||
else do
|
||||
let regexp = compile ("^" ++ wildToRegex exclude) []
|
||||
let regexp = compile (toregex exclude) []
|
||||
return $ filter (notExcluded regexp) l'
|
||||
where
|
||||
notState f = stateLoc /= take stateLocLen f
|
||||
|
@ -191,6 +191,10 @@ filterFiles l = do
|
|||
notExcluded r f = case match r f [] of
|
||||
Nothing -> True
|
||||
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 -}
|
||||
notSymlink :: FilePath -> IO Bool
|
||||
|
@ -219,3 +223,16 @@ paramName :: String
|
|||
paramName = "NAME"
|
||||
paramNothing :: String
|
||||
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"
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
14
GitAnnex.hs
14
GitAnnex.hs
|
@ -13,6 +13,7 @@ import qualified GitRepo as Git
|
|||
import CmdLine
|
||||
import Command
|
||||
import Options
|
||||
import qualified Annex
|
||||
|
||||
import qualified Command.Add
|
||||
import qualified Command.Unannex
|
||||
|
@ -65,15 +66,20 @@ cmds = concat
|
|||
|
||||
options :: [Option]
|
||||
options = commonOptions ++
|
||||
[ Option ['k'] ["key"] (ReqArg (storeOptString "key") paramKey)
|
||||
[ Option ['k'] ["key"] (ReqArg setkey paramKey)
|
||||
"specify a key to use"
|
||||
, Option ['t'] ["to"] (ReqArg (storeOptString "torepository") paramRemote)
|
||||
, Option ['t'] ["to"] (ReqArg setto paramRemote)
|
||||
"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"
|
||||
, Option ['x'] ["exclude"] (ReqArg (storeOptString "exclude") paramGlob)
|
||||
, Option ['x'] ["exclude"] (ReqArg addexclude paramGlob)
|
||||
"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 = "Usage: git-annex command [option ..]"
|
||||
|
|
|
@ -17,7 +17,7 @@ import qualified Annex
|
|||
|
||||
verbose :: Annex () -> Annex ()
|
||||
verbose a = do
|
||||
q <- Annex.flagIsSet "quiet"
|
||||
q <- Annex.getState Annex.quiet
|
||||
unless q a
|
||||
|
||||
showSideAction :: String -> Annex ()
|
||||
|
|
17
Options.hs
17
Options.hs
|
@ -18,19 +18,18 @@ import Command
|
|||
-}
|
||||
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 ['f'] ["force"] (NoArg (storeOptBool "force" True))
|
||||
[ Option ['f'] ["force"] (NoArg (setforce True))
|
||||
"allow actions that may lose annexed data"
|
||||
, Option ['q'] ["quiet"] (NoArg (storeOptBool "quiet" True))
|
||||
, Option ['q'] ["quiet"] (NoArg (setquiet True))
|
||||
"avoid verbose output"
|
||||
, Option ['v'] ["verbose"] (NoArg (storeOptBool "quiet" False))
|
||||
, Option ['v'] ["verbose"] (NoArg (setquiet False))
|
||||
"allow verbose output"
|
||||
, Option ['b'] ["backend"] (ReqArg (storeOptString "backend") paramName)
|
||||
, Option ['b'] ["backend"] (ReqArg setdefaultbackend paramName)
|
||||
"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 }
|
||||
|
|
30
Remotes.hs
30
Remotes.hs
|
@ -11,7 +11,6 @@ module Remotes (
|
|||
keyPossibilities,
|
||||
inAnnex,
|
||||
same,
|
||||
commandLineRemote,
|
||||
byName,
|
||||
copyFromRemote,
|
||||
copyToRemote,
|
||||
|
@ -69,7 +68,7 @@ tryGitConfigRead r
|
|||
g <- Annex.gitRepo
|
||||
let l = Git.remotes g
|
||||
let g' = Git.remotesAdd g $ exchange l r'
|
||||
Annex.gitRepoChange g'
|
||||
Annex.changeState $ \s -> s { Annex.repo = g' }
|
||||
return $ Right r'
|
||||
exchange [] _ = []
|
||||
exchange (old:ls) new =
|
||||
|
@ -93,7 +92,7 @@ tryGitConfigRead r
|
|||
readConfigs :: Annex ()
|
||||
readConfigs = do
|
||||
g <- Annex.gitRepo
|
||||
remotesread <- Annex.flagIsSet "remotesread"
|
||||
remotesread <- Annex.getState Annex.remotesread
|
||||
unless remotesread $ do
|
||||
allremotes <- filterM repoNotIgnored $ Git.remotes g
|
||||
let cheap = filter (not . Git.repoIsUrl) allremotes
|
||||
|
@ -105,7 +104,7 @@ readConfigs = do
|
|||
let todo = cheap ++ doexpensive
|
||||
unless (null todo) $ do
|
||||
_ <- mapM tryGitConfigRead todo
|
||||
Annex.flagChange "remotesread" $ Annex.FlagBool True
|
||||
Annex.changeState $ \s -> s { Annex.remotesread = True }
|
||||
where
|
||||
cachedUUID r = do
|
||||
u <- getUUID r
|
||||
|
@ -204,27 +203,22 @@ repoCost r = do
|
|||
repoNotIgnored :: Git.Repo -> Annex Bool
|
||||
repoNotIgnored r = do
|
||||
ignored <- repoConfig r "ignore" "false"
|
||||
fromName <- Annex.flagGet "fromrepository"
|
||||
toName <- Annex.flagGet "torepository"
|
||||
let name = if null fromName then toName else fromName
|
||||
if not $ null name
|
||||
then return $ match name
|
||||
to <- match Annex.toremote
|
||||
from <- match Annex.fromremote
|
||||
if to || from
|
||||
then return True
|
||||
else return $ not $ Git.configTrue ignored
|
||||
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. -}
|
||||
same :: Git.Repo -> Git.Repo -> Bool
|
||||
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. -}
|
||||
byName :: String -> Annex Git.Repo
|
||||
byName name = do
|
||||
|
|
1
debian/changelog
vendored
1
debian/changelog
vendored
|
@ -1,6 +1,7 @@
|
|||
git-annex (0.19) UNRELEASED; urgency=low
|
||||
|
||||
* 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
|
||||
|
||||
|
|
|
@ -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
|
||||
the current directory.
|
||||
|
||||
This option can be specified multiple times.
|
||||
|
||||
* --backend=name
|
||||
|
||||
Specifies which key-value backend to use.
|
||||
|
|
Loading…
Add table
Reference in a new issue