uuid cache done
This commit is contained in:
parent
7c975eab07
commit
f9557d7c5e
3 changed files with 29 additions and 16 deletions
|
@ -91,7 +91,6 @@ tryGitConfigRead :: Git.Repo -> Annex (Maybe Git.Repo)
|
|||
tryGitConfigRead r = do
|
||||
if (Map.null $ Git.configMap r)
|
||||
then do
|
||||
liftIO $ putStrLn $ "read config for " ++ (show r)
|
||||
result <- liftIO $ try (Git.configRead r)
|
||||
case (result) of
|
||||
Left err -> return Nothing
|
||||
|
|
2
TODO
2
TODO
|
@ -1,8 +1,6 @@
|
|||
* bug when annexing files while in a subdir of a git repo
|
||||
* bug when specifying absolute path to files when annexing
|
||||
|
||||
* query remotes for their annex.uuid settings and cache
|
||||
|
||||
* --push/--pull/--want/--drop
|
||||
|
||||
* how to handle git mv file?
|
||||
|
|
42
UUID.hs
42
UUID.hs
|
@ -40,15 +40,25 @@ genUUID = liftIO $ pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h
|
|||
- -}
|
||||
getUUID :: Git.Repo -> Annex UUID
|
||||
getUUID r = do
|
||||
if ("" /= configured r)
|
||||
then return $ configured r
|
||||
else cached r
|
||||
g <- Annex.gitRepo
|
||||
let uuid = cached r g
|
||||
if (uuid /= "")
|
||||
then return $ uuid
|
||||
else do
|
||||
let uuid = uncached r
|
||||
if (uuid /= "")
|
||||
then do
|
||||
updatecache r g uuid
|
||||
return uuid
|
||||
else return ""
|
||||
where
|
||||
configured r = Git.configGet r "annex.uuid" ""
|
||||
cached r = do
|
||||
g <- Annex.gitRepo
|
||||
return $ Git.configGet g (configkey r) ""
|
||||
configkey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
|
||||
uncached r = Git.configGet r "annex.uuid" ""
|
||||
cached r g = Git.configGet g (cachekey r) ""
|
||||
updatecache r g uuid = do
|
||||
if (g /= r)
|
||||
then setConfig (cachekey r) uuid
|
||||
else return ()
|
||||
cachekey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
|
||||
|
||||
{- Make sure that the repo has an annex.uuid setting. -}
|
||||
prepUUID :: Annex ()
|
||||
|
@ -58,13 +68,19 @@ prepUUID = do
|
|||
if ("" == u)
|
||||
then do
|
||||
uuid <- genUUID
|
||||
liftIO $ Git.run g ["config", configkey, uuid]
|
||||
-- re-read git config and update the repo's state
|
||||
g' <- liftIO $ Git.configRead g
|
||||
Annex.gitRepoChange g'
|
||||
return ()
|
||||
setConfig configkey uuid
|
||||
else return ()
|
||||
|
||||
{- Changes a git config setting in both internal state and .git/config -}
|
||||
setConfig :: String -> String -> Annex ()
|
||||
setConfig key value = do
|
||||
g <- Annex.gitRepo
|
||||
liftIO $ Git.run g ["config", key, value]
|
||||
-- re-read git config and update the repo's state
|
||||
g' <- liftIO $ Git.configRead g
|
||||
Annex.gitRepoChange g'
|
||||
return ()
|
||||
|
||||
{- Filters a list of repos to ones that have listed UUIDs. -}
|
||||
reposByUUID :: [Git.Repo] -> [UUID] -> Annex [Git.Repo]
|
||||
reposByUUID repos uuids = do
|
||||
|
|
Loading…
Reference in a new issue