mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 2

implement CommandUse in Annex.Sim

Browse source 
Refactored Remote to keep it pure.
This commit is contained in:
Joey Hess 2024-09-05 10:50:04 -04:00
parent b932acf4ad
commit 710a199ce9
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 49 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
Annex/Sim.hs
View file

@ -19,6 +19,7 @@ import Annex (Annex)
import Backend.Hash (genTestKey)
import Annex.UUID
import Utility.FileSystemEncoding
import qualified Remote
import System.Random
import Data.Word
@ -51,11 +52,12 @@ data SimState = SimState
, simGroupWanted :: M.Map GroupName Matcher
, simMaxSize :: M.Map RepoName MaxSize
, simRebalance :: Bool
, simExistingRepoByName :: ExistingRepoByName
}
deriving (Show)
emptySimState :: Int -> SimState
emptySimState rngseed = SimState
emptySimState :: Int -> ExistingRepoByName -> SimState
emptySimState rngseed repobyname = SimState
{ simRepos = mempty
, simSpecialRemotes = mempty
, simRepoState = mempty
@ -69,6 +71,7 @@ emptySimState rngseed = SimState
, simGroupWanted = mempty
, simMaxSize = mempty
, simRebalance = False
, simExistingRepoByName = repobyname
}
-- State that can vary between different repos in the simulation.
@ -130,7 +133,14 @@ applySimCommand (CommandInitRemote reponame) st =
in Right $ st'
{ simSpecialRemotes = M.insert reponame u (simSpecialRemotes st')
}
applySimCommand (CommandUse reponame s) st = error "TODO" -- XXX
applySimCommand (CommandUse reponame s) st =
case existingRepoByName (simExistingRepoByName st) reponame of
(u:[], _) -> Right $ st
{ simSpecialRemotes = M.insert reponame u (simSpecialRemotes st)
}
(_, msg) -> Left $ "Unable to use a repository \""
++ fromRepoName reponame
++ "\" in the simulation because " ++ msg
applySimCommand (CommandConnect repo remote) st = Right $ st
{ simConnections =
let s = case M.lookup repo (simConnections st) of
@ -235,3 +245,15 @@ genSimUUID st (RepoName reponame) = simRandom st (randomWords 1024)
simUUIDNameSpace :: U.UUID
simUUIDNameSpace = U5.generateNamed U5.namespaceURL $
B.unpack "http://git-annex.branchable.com/git-annex-sim/"
newtype ExistingRepoByName = ExistingRepoByName
{ existingRepoByName :: RepoName -> ([UUID], String)
}
instance Show ExistingRepoByName where
show _ = "ExistingRepoByName"
mkExistingRepoByName :: Annex ExistingRepoByName
mkExistingRepoByName = do
f <- Remote.nameToUUID''
return $ ExistingRepoByName $ f . fromRepoName

33
Remote.hs
View file

@ -52,6 +52,7 @@ module Remote (
remoteLocations,
nameToUUID,
nameToUUID',
nameToUUID'',
showTriedRemotes,
listRemoteNames,
showLocations,
@ -148,8 +149,11 @@ byNameWithUUID = checkuuid <=< byName
| otherwise = return $ Just r
byName' :: RemoteName -> Annex (Either String Remote)
byName' "" = return $ Left "no repository name specified"
byName' n = go . filter matching <$> remoteList
byName' n = byName'' n <$> remoteList
byName'' :: RemoteName -> [Remote] -> Either String Remote
byName'' "" _ = Left "no repository name specified"
byName'' n remotelist = go $ filter matching remotelist
where
go [] = Left $ "there is no available git remote named \"" ++ n ++ "\""
go (match:_) = Right match
@ -182,20 +186,31 @@ nameToUUID n = nameToUUID' n >>= \case
(_, msg) -> giveup msg
nameToUUID' :: RemoteName -> Annex ([UUID], String)
nameToUUID' n
nameToUUID' n = do
f <- nameToUUID''
return (f n)
nameToUUID'' :: Annex (RemoteName -> ([UUID], String))
nameToUUID'' = do
l <- remoteList
u <- getUUID
m <- uuidDescMap
return $ \n -> nameToUUID''' n l u m
nameToUUID''' :: RemoteName -> [Remote] -> UUID -> UUIDDescMap -> ([UUID], String)
nameToUUID''' n remotelist hereu m
| n == "." = currentrepo
| n == "here" = currentrepo
| otherwise = byName' n >>= go
| otherwise = go (byName'' n remotelist)
where
currentrepo = mkone <$> getUUID
currentrepo = mkone hereu
go (Right r) = return $ case uuid r of
go (Right r) = case uuid r of
NoUUID -> ([], noRemoteUUIDMsg r)
u -> mkone u
go (Left e) = do
m <- uuidDescMap
go (Left e) =
let descn = UUIDDesc (encodeBS n)
return $ case M.keys (M.filter (== descn) m) of
in case M.keys (M.filter (== descn) m) of
[] ->
let u = toUUID n
in case M.keys (M.filterWithKey (\k _ -> k == u) m) of