converted several commands to use Remote
only move and map still to convert
This commit is contained in:
parent
3470260a85
commit
30f427700f
7 changed files with 58 additions and 46 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
40
Remote.hs
40
Remote.hs
|
@ -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
|
||||
|
||||
|
|
9
UUID.hs
9
UUID.hs
|
@ -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
|
||||
|
|
2
test.hs
2
test.hs
|
@ -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]
|
||||
|
|
Loading…
Reference in a new issue