implement CommandUse in Annex.Sim

Refactored Remote to keep it pure.

diff --git a/Annex/Sim.hs b/Annex/Sim.hs
index 00742adb2b21dc9388cd1f2b04df2f720a5dac87..6ac44e66640db4c925ac6ad0022c751f05aa5988 100644 (file)
--- a/Annex/Sim.hs
+++ b/Annex/Sim.hs
@@ -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

diff --git a/Remote.hs b/Remote.hs
index 9e41f8ae836254dcfef7fbe93b7fb0d65c837a21..0f19d7a880543747f9b2e3d68f56e95832477a5b 100644 (file)
--- a/Remote.hs
+++ b/Remote.hs
@@ -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