summaryrefslogtreecommitdiff
path: root/UUID.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-14 13:49:45 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-14 13:49:45 -0400
commitf9557d7c5e2aa7ef19a5d589594154a21c7f2caa (patch)
treeee4f1794a6ff5e4cc8afdcb682abee16e4709ae9 /UUID.hs
parent7c975eab07d842e3d91626871027f803f34c6372 (diff)
uuid cache done
Diffstat (limited to 'UUID.hs')
-rw-r--r--UUID.hs42
1 files changed, 29 insertions, 13 deletions
diff --git a/UUID.hs b/UUID.hs
index 1c31a343f..c77004527 100644
--- a/UUID.hs
+++ b/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