converted several commands to use Remote

only move and map still to convert
This commit is contained in:
Joey Hess 2011-03-27 16:55:43 -04:00
parent 3470260a85
commit 30f427700f
7 changed files with 58 additions and 46 deletions

View file

@ -7,10 +7,8 @@
module Command.Describe where
import Command
import qualified GitRepo as Git
import qualified Remotes
import qualified Remote
import UUID
import Messages
import qualified Command.Init
@ -30,12 +28,10 @@ start params = notBareRepo $ do
_ -> error "Specify a repository and a description."
showStart "describe" name
Remotes.readConfigs
r <- Remotes.byName name
return $ Just $ perform r description
u <- Remote.nameToUUID name
return $ Just $ perform u description
perform :: Git.Repo -> String -> CommandPerform
perform repo description = do
u <- getUUID repo
perform :: UUID -> String -> CommandPerform
perform u description = do
describeUUID u description
return $ Just $ Command.Init.cleanup

View file

@ -8,8 +8,7 @@
module Command.Semitrust where
import Command
import qualified GitRepo as Git
import qualified Remotes
import qualified Remote
import UUID
import Trust
import Messages
@ -24,12 +23,10 @@ seek = [withString start]
start :: CommandStartString
start name = notBareRepo $ do
showStart "semitrust" name
Remotes.readConfigs
r <- Remotes.byName name
return $ Just $ perform r
u <- Remote.nameToUUID name
return $ Just $ perform u
perform :: Git.Repo -> CommandPerform
perform repo = do
uuid <- getUUID repo
perform :: UUID -> CommandPerform
perform uuid = do
trustSet uuid SemiTrusted
return $ Just $ return True

View file

@ -8,8 +8,7 @@
module Command.Trust where
import Command
import qualified GitRepo as Git
import qualified Remotes
import qualified Remote
import Trust
import UUID
import Messages
@ -24,12 +23,10 @@ seek = [withString start]
start :: CommandStartString
start name = notBareRepo $ do
showStart "trust" name
Remotes.readConfigs
r <- Remotes.byName name
return $ Just $ perform r
u <- Remote.nameToUUID name
return $ Just $ perform u
perform :: Git.Repo -> CommandPerform
perform repo = do
uuid <- getUUID repo
perform :: UUID -> CommandPerform
perform uuid = do
trustSet uuid Trusted
return $ Just $ return True

View file

@ -8,8 +8,7 @@
module Command.Untrust where
import Command
import qualified GitRepo as Git
import qualified Remotes
import qualified Remote
import UUID
import Trust
import Messages
@ -24,12 +23,10 @@ seek = [withString start]
start :: CommandStartString
start name = notBareRepo $ do
showStart "untrust" name
Remotes.readConfigs
r <- Remotes.byName name
return $ Just $ perform r
u <- Remote.nameToUUID name
return $ Just $ perform u
perform :: Git.Repo -> CommandPerform
perform repo = do
uuid <- getUUID repo
perform :: UUID -> CommandPerform
perform uuid = do
trustSet uuid UnTrusted
return $ Just $ return True

View file

@ -6,12 +6,15 @@
-}
module Remote (
byName,
nameToUUID,
keyPossibilities,
remotesWithUUID,
remotesWithoutUUID
) where
import Control.Monad.State (liftIO)
import Control.Monad (when, liftM)
import Data.List
import RemoteClass
@ -21,6 +24,7 @@ import UUID
import qualified Annex
import Trust
import LocationLog
import Messages
{- add generators for new Remotes here -}
generators :: [Annex [Remote Annex]]
@ -30,7 +34,9 @@ generators = [Remote.GitRemote.generate]
- Since doing so can be expensive, the list is cached in the Annex. -}
genList :: Annex [Remote Annex]
genList = do
liftIO $ putStrLn "Remote.genList"
g <- Annex.gitRepo
u <- getUUID g
showNote $ "Remote.genList " ++ u
rs <- Annex.getState Annex.remotes
if null rs
then do
@ -40,13 +46,24 @@ genList = do
return rs'
else return rs
{- Filters a list of remotes to ones that have the listed uuids. -}
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
{- Looks up a remote by name. (Or by UUID.) -}
byName :: String -> Annex (Remote Annex)
byName "" = error "no remote specified"
byName n = do
allremotes <- genList
let match = filter matching allremotes
when (null match) $ error $
"there is no git remote named \"" ++ n ++ "\""
return $ head match
where
matching r = n == name r || n == uuid r
{- Filters a list of remotes to ones that do not have the listed uuids. -}
remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
{- Looks up a remote by name (or by UUID), and returns its UUID. -}
nameToUUID :: String -> Annex UUID
nameToUUID "." = do -- special case for current repo
g <- Annex.gitRepo
getUUID g
nameToUUID n = liftM uuid (byName n)
{- Cost ordered lists of remotes that the LocationLog indicate may have a key.
-
@ -71,3 +88,12 @@ keyPossibilities key = do
let validremotes = remotesWithUUID allremotes validuuids
return (sort validremotes, validtrusteduuids)
{- Filters a list of remotes to ones that have the listed uuids. -}
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
{- Filters a list of remotes to ones that do not have the listed uuids. -}
remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs

View file

@ -3,6 +3,9 @@
- Each git repository used by git-annex has an annex.uuid setting that
- uniquely identifies that repository.
-
- UUIDs of remotes are cached in git config, using keys named
- remote.<name>.annex-uuid
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
@ -51,11 +54,7 @@ genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h
else []
{- Looks up a repo's UUID. May return "" if none is known.
-
- UUIDs of remotes are cached in git config, using keys named
- remote.<name>.annex-uuid
-
- -}
-}
getUUID :: Git.Repo -> Annex UUID
getUUID r = do
g <- Annex.gitRepo

View file

@ -334,6 +334,7 @@ test_trust = "git-annex trust/untrust/semitrust" ~: intmpclonerepo $ do
git_annex "semitrust" ["-q", repo] @? "semitrust of semitrusted failed"
trustcheck Trust.SemiTrusted "semitrusted 2"
where
repo = "origin"
trustcheck expected msg = do
present <- annexeval $ do
Remotes.readConfigs
@ -342,7 +343,6 @@ test_trust = "git-annex trust/untrust/semitrust" ~: intmpclonerepo $ do
u <- UUID.getUUID r
return $ u `elem` l
assertBool msg present
repo = "origin"
test_fsck :: Test
test_fsck = "git-annex fsck" ~: TestList [basicfsck, withlocaluntrusted, withremoteuntrusted]