sim: implement dropunwantedfrom

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index 80c2829b939f3a07915c34a99def891728f92303..b0536387ff70a6d9a2c2909a1d05315a55737a4f 100644 (file)
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@@ -447,49 +447,11 @@ getSimActionComponents (ActionSendWanted repo remote) st =
                addHistory st' $ CommandPresent (remoteNameToRepoName remote) f
 getSimActionComponents (ActionDropUnwanted repo Nothing) st =
        checkKnownRepo repo st $ \u ->
-               Right $ Left (st, map (go u) $ M.toList $ simFiles st)
-  where
-       go u (f, k) st' = liftIO $ runSimRepo u st' $ \rst ->
-               let af = AssociatedFile $ Just f
-               in if present u rst k
-                       then ifM (wantDrop NoLiveUpdate False Nothing (Just k) af Nothing)
-                               ( return $ checkdrop u rst k st'
-                               , return st'
-                               )
-                       else return st'
-       
-       present u rst k = u `S.member` getSimLocations rst k
-
-       checkdrop u rst k st' =
-               let numcopies = simNumCopies st'
-                   mincopies = simMinCopies st'
-                   verifiedcopies = mapMaybe (verifypresent u k st') $
-                       filter (/= u) $ S.toList $ getSimLocations rst k
-               in case safeDropAnalysis numcopies mincopies verifiedcopies Nothing of
-                       UnsafeDrop -> st'
-                       SafeDrop -> dodrop u k st'
-                       SafeDropCheckTime -> dodrop u k st'
-
-       dodrop u k = setPresentKey False u k u
-       
-       remotes u = S.fromList $ mapMaybe 
-               (\remote -> M.lookup (remoteNameToRepoName remote) (simRepos st))
-               (maybe mempty S.toList $ M.lookup u $ simConnections st)
-       
-       verifypresent u k st' ru = do
-               rst <- M.lookup ru (simRepoState st')
-               if present ru rst k
-                       then if ru `S.member` remotes u
-                               then Just $ if simIsSpecialRemote rst
-                                       then mkVerifiedCopy RecentlyVerifiedCopy ru
-                                       else mkVerifiedCopy LockedCopy ru
-                               else case M.lookup ru (simTrustLevels st') of
-                                       Just Trusted -> Just $
-                                               mkVerifiedCopy TrustedCopy ru
-                                       _ -> Nothing
-                       else Nothing
-getSimActionComponents (ActionDropUnwanted _repo (Just _remote)) _st =
-       undefined -- TODO
+               simulateDropUnwanted st u repo u
+getSimActionComponents (ActionDropUnwanted repo (Just remote)) st =
+       checkKnownRepo repo st $ \u ->
+               checkKnownRemote remote repo u st $ \ru ->
+                       simulateDropUnwanted st u (remoteNameToRepoName remote) ru
 getSimActionComponents (ActionGitPush repo remote) st =
        checkKnownRepo repo st $ \u -> 
                checkKnownRemote remote repo u st $ \_ ->
@@ -602,6 +564,58 @@ simulateGitAnnexMerge src dest st =
                                                }
                _ -> Left $ "Unable to find " ++ fromRepoName src ++ " or " ++ fromRepoName dest ++ " in simRepos"
 
+simulateDropUnwanted
+       :: SimState SimRepo
+       -> UUID
+       -> RepoName
+       -> UUID
+       -> Either String (Either (SimState SimRepo, [SimState SimRepo -> Annex (SimState SimRepo)]) (SimState SimRepo))
+simulateDropUnwanted st u dropfromname dropfrom =
+       Right $ Left (st, map go $ M.toList $ simFiles st)
+  where
+       go (f, k) st' = liftIO $ runSimRepo u st' $ \rst ->
+               let af = AssociatedFile $ Just f
+               in if present dropfrom rst k
+                       then ifM (wantDrop NoLiveUpdate False (Just dropfrom) (Just k) af Nothing)
+                               ( return $ checkdrop rst k f st'
+                               , return st'
+                               )
+                       else return st'
+       
+       present ru rst k = ru `S.member` getSimLocations rst k
+
+       checkdrop rst k f st' =
+               let numcopies = simNumCopies st'
+                   mincopies = simMinCopies st'
+                   verifiedcopies = mapMaybe (verifypresent k st') $
+                       filter (/= dropfrom) $ S.toList $ getSimLocations rst k
+               in case safeDropAnalysis numcopies mincopies verifiedcopies Nothing of
+                       UnsafeDrop -> st'
+                       SafeDrop -> dodrop k f st'
+                       SafeDropCheckTime -> dodrop k f st'
+
+       dodrop k f st' =
+               setPresentKey False dropfrom k u $
+                       setPresentKey False dropfrom k dropfrom $
+                               addHistory st' $ CommandNotPresent dropfromname f
+       
+       remotes = S.fromList $ mapMaybe 
+               (\remote -> M.lookup (remoteNameToRepoName remote) (simRepos st))
+               (maybe mempty S.toList $ M.lookup u $ simConnections st)
+       
+       verifypresent k st' ru = do
+               rst <- M.lookup ru (simRepoState st')
+               if present ru rst k
+                       then if ru `S.member` remotes || ru == u
+                               then Just $ if simIsSpecialRemote rst
+                                       then mkVerifiedCopy RecentlyVerifiedCopy ru
+                                       else mkVerifiedCopy LockedCopy ru
+                               else case M.lookup ru (simTrustLevels st') of
+                                       Just Trusted -> Just $
+                                               mkVerifiedCopy TrustedCopy ru
+                                       _ -> Nothing
+                       else Nothing
+
 checkNonexistantRepo :: RepoName -> SimState SimRepo -> Either String a -> Either String a
 checkNonexistantRepo reponame st a = case M.lookup reponame (simRepos st) of
        Nothing -> a

diff --git a/Annex/Sim/File.hs b/Annex/Sim/File.hs
index f6c28822bebc28e8d57031b383fd190c5b85b5fc..eee9f4d955aad10775709ece42bc7c5c0f622cf5 100644 (file)
--- a/Annex/Sim/File.hs
+++ b/Annex/Sim/File.hs
@@ -97,7 +97,7 @@ formatAction (ActionSync (RepoName repo) (RemoteName remote)) =
 formatAction (ActionGetWanted (RepoName repo) (RemoteName remote)) =
        ["action", repo, "getwanted", remote]
 formatAction (ActionDropUnwanted (RepoName repo) (Just (RemoteName remote))) =
-       ["action", repo, "dropunwanted", remote]
+       ["action", repo, "dropunwantedfrom", remote]
 formatAction (ActionDropUnwanted (RepoName repo) Nothing) =
        ["action", repo, "dropunwanted"]
 formatAction (ActionSendWanted (RepoName repo) (RemoteName remote)) =
@@ -197,11 +197,11 @@ parseSimAction ("action":repo:"getwanted":remote:rest) =
        mkAction rest $ ActionGetWanted (RepoName repo) (RemoteName remote)
 parseSimAction ("action":repo:"sendwanted":remote:rest) =
        mkAction rest $ ActionSendWanted (RepoName repo) (RemoteName remote)
-parseSimAction ("action":repo:"dropunwanted":rest) =
-       mkAction rest $ ActionDropUnwanted (RepoName repo) Nothing
-parseSimAction ("action":repo:"dropunwanted":remote:rest) =
+parseSimAction ("action":repo:"dropunwantedfrom":remote:rest) =
        mkAction rest $ ActionDropUnwanted (RepoName repo)
                (Just (RemoteName remote))
+parseSimAction ("action":repo:"dropunwanted":rest) =
+       mkAction rest $ ActionDropUnwanted (RepoName repo) Nothing
 parseSimAction ("action":repo:"gitpush":remote:rest) =
        mkAction rest $ ActionGitPush (RepoName repo) (RemoteName remote)
 parseSimAction ("action":repo:"gitpull":remote:rest) =

diff --git a/doc/git-annex-sim.mdwn b/doc/git-annex-sim.mdwn
index eeb3b1cf073d080e05c33de03639490c81f8e954..9b86a041fefafe53f607957cdc9ebb81d710685a 100644 (file)
--- a/doc/git-annex-sim.mdwn
+++ b/doc/git-annex-sim.mdwn
@@ -192,7 +192,7 @@ as passed to "git annex sim" while a simulation is running.
   Simulate the repository dropping files it does not want, 
   when it is able to verify enough copies exist on remotes.
 
-* `action repo dropunwanted remote`
+* `action repo dropunwantedfrom remote`
 
   Simulate the repository dropping files from the remote that the remote
   does not want, when it is able to verify enouh copies exist.
@@ -217,7 +217,7 @@ as passed to "git annex sim" while a simulation is running.
 * `action repo push remote`
 
   Simulate the equivilant of [[git-annex-push]](1) by combining
-  the actions sendwanted, dropunwanted, and gitpush.
+  the actions sendwanted, dropunwantedfrom, and gitpush.
 
 * `action repo sync remote`
 

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index 0ac0b95c68abab2e0a1c754c5aed4b14d41f7a23..755d04a7965181589e849ce49cc0a407b9c0054c 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -34,8 +34,6 @@ Planned schedule of work:
 
 * sim: implement addtree
 
-* sim: implement ActionDropUnwanted
-
 ## items deferred until later for balanced preferred content and maxsize tracking
 
 * `git-annex assist --rebalance` of `balanced=foo:2`