data SimState = SimState
{ simRepos :: M.Map RepoName UUID
, simRepoList :: [RepoName]
- , simRepoState :: M.Map RepoName SimRepoState
+ , simRepoState :: M.Map UUID SimRepoState
, simConnections :: M.Map UUID (S.Set RemoteName)
, simFiles :: M.Map RawFilePath Key
, simRng :: StdGen
{ simLocations :: M.Map Key (M.Map UUID LocationState)
, simIsSpecialRemote :: Bool
, simRepo :: Maybe SimRepo
+ , simRepoName :: RepoName
}
deriving (Show)
| vc1 > vc2 = l1
| otherwise = l2
-setPresentKey :: UUID -> Key -> RepoName -> SimState -> SimState
-setPresentKey u k repo st = st
- { simRepoState = case M.lookup repo (simRepoState st) of
- Just rst -> M.insert repo
+{- Updates the state of repou to indicate that a key is
+ - present or not in u. -}
+setPresentKey :: UUID -> Key -> UUID -> SimState -> SimState
+setPresentKey u k repou st = st
+ { simRepoState = case M.lookup repou (simRepoState st) of
+ Just rst -> M.insert repou
(setPresentKey' (simVectorClock st) u k rst)
(simRepoState st)
Nothing -> error "no simRepoState in setPresentKey"
where
go k st' [] = Right $ Right st
go k st' (repo:rest) = checkKnownRepo repo st' $ \u ->
- let st'' = setPresentKey u k repo $ st'
+ let st'' = setPresentKey u k u $ st'
{ simFiles = M.insert file k (simFiles st')
}
in go k st'' rest
{ simRng = mkStdGen rngseed
}
applySimCommand' (CommandPresent repo file) st = checkKnownRepo repo st $ \u ->
- case (M.lookup file (simFiles st), M.lookup repo (simRepoState st)) of
+ case (M.lookup file (simFiles st), M.lookup u (simRepoState st)) of
(Just k, Just rst)
| u `S.member` getSimLocations rst k ->
Right $ Right st
++ " to be present in "
++ fromRepoName repo ++ ", but it is not."
applySimCommand' (CommandNotPresent repo file) st = checkKnownRepo repo st $ \u ->
- case (M.lookup file (simFiles st), M.lookup repo (simRepoState st)) of
+ case (M.lookup file (simFiles st), M.lookup u (simRepoState st)) of
(Just k, Just rst)
| u `S.notMember` getSimLocations rst k ->
Right $ Right st
overFilesRemote r u remote S.member wanted go st
where
wanted k f _ = wantGet NoLiveUpdate False k f
- go u _ f k r st' = setPresentKey u k r $
+ go u _ f k r st' = setPresentKey u k u $
addHistory st' $ CommandPresent r f
applySimAction r u (ActionSendWanted remote) st =
overFilesRemote r u remote S.notMember wanted go st
where
wanted = wantGetBy NoLiveUpdate False
- go _ remoteu f k r st' = setPresentKey remoteu k r $
+ go _ remoteu f k r st' =
-- Sending to a remote updates the location log
-- of both the repository sending and the remote.
- setPresentKey remoteu k (remoteNameToRepoName remote) $
+ setPresentKey remoteu k remoteu $
+ setPresentKey remoteu k u $
addHistory st' $ CommandPresent (remoteNameToRepoName remote) f
applySimAction r u (ActionDropUnwanted Nothing) st = undefined -- TODO
applySimAction r u (ActionDropUnwanted (Just remote)) st = undefined -- TODO
overFilesRemote r u remote remotepred checkwant handlewanted st =
checkKnownRemote remote r u st $ \remoteu ->
Right $ Left $ liftIO $
- runSimRepo r st $ \rst ->
+ runSimRepo u st $ \rst ->
let l = M.toList $
M.filter (checkremotepred remoteu rst) $
simFiles st
-> SimState
-> Either String (Either (Annex SimState) SimState)
simulateGitAnnexMerge src dest st =
- case M.lookup dest (simRepoState st) of
- Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName dest
- Just destst -> case M.lookup src (simRepoState st) of
- Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName src
- Just srcst -> Right $ Right $
- let locs = M.unionWith
- (M.unionWith newerLocationState)
- (simLocations destst)
- (simLocations srcst)
- destst' = destst { simLocations = locs }
- in st
- { simRepoState = M.insert dest
- destst'
- (simRepoState st)
- }
+ case (M.lookup src (simRepos st), M.lookup dest (simRepos st)) of
+ (Just srcu, Just destu) -> case M.lookup destu (simRepoState st) of
+ Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName dest
+ Just destst -> case M.lookup srcu (simRepoState st) of
+ Nothing -> Left $ "Unable to find simRepoState for " ++ fromRepoName src
+ Just srcst -> Right $ Right $
+ let locs = M.unionWith
+ (M.unionWith newerLocationState)
+ (simLocations destst)
+ (simLocations srcst)
+ destst' = destst { simLocations = locs }
+ in st
+ { simRepoState = M.insert destu
+ destst'
+ (simRepoState st)
+ }
+ _ -> Left $ "Unable to find " ++ fromRepoName src ++ " or " ++ fromRepoName dest ++ " in simRepos"
checkNonexistantRepo :: RepoName -> SimState -> Either String a -> Either String a
checkNonexistantRepo reponame st a = case M.lookup reponame (simRepos st) of
show _ = "GetSimRepoPath"
data SimRepoConfig = SimRepoConfig
- { simRepoUUID :: UUID
- , simRepoIsSpecialRemote :: Bool
- , simRepoGroups :: S.Set Group
- , simRepoTrustLevel :: TrustLevel
- , simRepoPreferredContent :: Maybe PreferredContentExpression
- , simRepoRequiredContent :: Maybe PreferredContentExpression
- , simRepoGroupPreferredContent :: M.Map Group PreferredContentExpression
- , simRepoMaxSize :: Maybe MaxSize
+ { simRepoConfigUUID :: UUID
+ , simRepoConfigIsSpecialRemote :: Bool
+ , simRepoConfigGroups :: S.Set Group
+ , simRepoConfigTrustLevel :: TrustLevel
+ , simRepoConfigPreferredContent :: Maybe PreferredContentExpression
+ , simRepoConfigRequiredContent :: Maybe PreferredContentExpression
+ , simRepoConfigGroupPreferredContent :: M.Map Group PreferredContentExpression
+ , simRepoConfigMaxSize :: Maybe MaxSize
}
deriving (Show)
newSimRepoConfig :: UUID -> Bool -> SimRepoConfig
newSimRepoConfig u isspecialremote = SimRepoConfig
- { simRepoUUID = u
- , simRepoIsSpecialRemote = isspecialremote
- , simRepoGroups = mempty
- , simRepoTrustLevel = def
- , simRepoPreferredContent = Nothing
- , simRepoRequiredContent = Nothing
- , simRepoGroupPreferredContent = mempty
- , simRepoMaxSize = Nothing
+ { simRepoConfigUUID = u
+ , simRepoConfigIsSpecialRemote = isspecialremote
+ , simRepoConfigGroups = mempty
+ , simRepoConfigTrustLevel = def
+ , simRepoConfigPreferredContent = Nothing
+ , simRepoConfigRequiredContent = Nothing
+ , simRepoConfigGroupPreferredContent = mempty
+ , simRepoConfigMaxSize = Nothing
}
addRepo :: RepoName -> SimRepoConfig -> SimState -> SimState
, simRepoList = if reponame `elem` simRepoList st
then simRepoList st
else reponame : simRepoList st
- , simRepoState = M.insert reponame rst (simRepoState st)
+ , simRepoState = M.insert u rst (simRepoState st)
, simConnections = M.insert u mempty (simConnections st)
- , simGroups = M.insert u (simRepoGroups simrepo) (simGroups st)
+ , simGroups = M.insert u (simRepoConfigGroups simrepo) (simGroups st)
, simTrustLevels = M.insert u
- (simRepoTrustLevel simrepo)
+ (simRepoConfigTrustLevel simrepo)
(simTrustLevels st)
, simWanted = M.alter
- (const $ simRepoPreferredContent simrepo)
+ (const $ simRepoConfigPreferredContent simrepo)
u
(simWanted st)
, simRequired = M.alter
- (const $ simRepoRequiredContent simrepo)
+ (const $ simRepoConfigRequiredContent simrepo)
u
(simRequired st)
, simGroupWanted = M.union
- (simRepoGroupPreferredContent simrepo)
+ (simRepoConfigGroupPreferredContent simrepo)
(simGroupWanted st)
, simMaxSize = M.alter
- (const $ simRepoMaxSize simrepo)
+ (const $ simRepoConfigMaxSize simrepo)
u
(simMaxSize st)
}
where
- u = simRepoUUID simrepo
+ u = simRepoConfigUUID simrepo
rst = SimRepoState
{ simLocations = mempty
- , simIsSpecialRemote = simRepoIsSpecialRemote simrepo
+ , simIsSpecialRemote = simRepoConfigIsSpecialRemote simrepo
, simRepo = Nothing
+ , simRepoName = reponame
}
mkGetExistingRepoByName :: Annex GetExistingRepoByName
let gs = fromMaybe S.empty $
M.lookup u (groupsByUUID groupmap)
in SimRepoConfig
- { simRepoUUID = u
- , simRepoIsSpecialRemote =
+ { simRepoConfigUUID = u
+ , simRepoConfigIsSpecialRemote =
M.member u remoteconfigmap
- , simRepoGroups = gs
- , simRepoTrustLevel =
+ , simRepoConfigGroups = gs
+ , simRepoConfigTrustLevel =
lookupTrust' u trustmap
- , simRepoPreferredContent =
+ , simRepoConfigPreferredContent =
M.lookup u pcmap
- , simRepoRequiredContent =
+ , simRepoConfigRequiredContent =
M.lookup u rcmap
- , simRepoGroupPreferredContent =
+ , simRepoConfigGroupPreferredContent =
M.restrictKeys gpcmap gs
- , simRepoMaxSize =
+ , simRepoConfigMaxSize =
M.lookup u maxsizes
}
(_, msg) -> Left msg
{ simRepoGitRepo :: Repo
, simRepoAnnex :: (Annex.AnnexState, Annex.AnnexRead)
, simRepoCurrState :: SimState
- , simRepoName :: RepoName
+ , simRepoUUID :: UUID
}
instance Show SimRepo where
updateSimRepoStates st = go st (M.toList $ simRepoState st)
where
go st' [] = return st'
- go st' ((reponame, rst):rest) = case simRepo rst of
+ go st' ((u, rst):rest) = case simRepo rst of
Just sr -> do
sr' <- updateSimRepoState st sr
let rst' = rst { simRepo = Just sr' }
let st'' = st
- { simRepoState = M.insert reponame rst'
+ { simRepoState = M.insert u rst'
(simRepoState st)
}
go st'' rest
initNewSimRepos = \st -> go st (M.toList $ simRepoState st)
where
go st [] = return st
- go st ((reponame, rst):rest) =
- case (simRepo rst, M.lookup reponame (simRepos st)) of
- (Nothing, Just u) -> do
+ go st ((u, rst):rest) =
+ case simRepo rst of
+ Nothing -> do
let GetSimRepoPath getdest = simGetSimRepoPath st
- sr <- initSimRepo reponame u (getdest u) st
+ sr <- initSimRepo (simRepoName rst) u (getdest u) st
let rst' = rst { simRepo = Just sr }
let st' = st
- { simRepoState = M.insert reponame rst'
+ { simRepoState = M.insert u rst'
(simRepoState st)
}
go st' rest
(simRng st)
(simGetExistingRepoByName st)
(simGetSimRepoPath st)
- , simRepoName = simreponame
+ , simRepoUUID = u
}
simulatedRepositoryDescription :: RepoName -> String
simulationDifferences :: Differences
simulationDifferences = mkDifferences $ S.singleton Simulation
-runSimRepo :: RepoName -> SimState -> (SimRepoState -> Annex SimState) -> IO SimState
-runSimRepo reponame st a = do
+runSimRepo :: UUID -> SimState -> (SimRepoState -> Annex SimState) -> IO SimState
+runSimRepo u st a = do
st' <- updateSimRepos st
- case M.lookup reponame (simRepoState st') of
+ case M.lookup u (simRepoState st') of
Just rst -> case simRepo rst of
Just sr -> do
(st'', strd) <- Annex.run (simRepoAnnex sr) $
return $ st''
{ simRepoState = M.adjust
(\rst' -> rst' { simRepo = Just sr' })
- (simRepoName sr)
+ u
(simRepoState st'')
}
- Nothing -> error $ "runSimRepo simRepo not set for " ++ fromRepoName reponame
- Nothing -> error $ "runSimRepo simRepoState not found for " ++ fromRepoName reponame
+ Nothing -> error $ "runSimRepo simRepo not set for " ++ fromUUID u
+ Nothing -> error $ "runSimRepo simRepoState not found for " ++ fromUUID u
updateSimRepoState :: SimState -> SimRepo -> IO SimRepo
updateSimRepoState newst sr = do
annexedfilepath f
annexedfilepath f = repoPath (simRepoGitRepo sr) P.</> f
getlocations = maybe mempty simLocations
- . M.lookup (simRepoName sr)
+ . M.lookup (simRepoUUID sr)
. simRepoState
setlocations s k =
mapM_ (\l -> logChange NoLiveUpdate k l s)
projects / git-annex.git / commitdiff