almost able to get files from remotes now!
This commit is contained in:
parent
77055f5ff8
commit
e28ff5bdaf
6 changed files with 116 additions and 48 deletions
31
UUID.hs
31
UUID.hs
|
@ -9,12 +9,16 @@ module UUID (
|
|||
UUID,
|
||||
getUUID,
|
||||
prepUUID,
|
||||
genUUID
|
||||
genUUID,
|
||||
reposByUUID
|
||||
) where
|
||||
|
||||
import Maybe
|
||||
import List
|
||||
import System.Cmd.Utils
|
||||
import System.IO
|
||||
import GitRepo
|
||||
import Types
|
||||
|
||||
type UUID = String
|
||||
|
||||
|
@ -26,17 +30,34 @@ genUUID :: IO UUID
|
|||
genUUID = do
|
||||
pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h
|
||||
|
||||
{- Looks up a repo's UUID -}
|
||||
getUUID :: GitRepo -> UUID
|
||||
getUUID repo = gitConfig repo "annex.uuid" ""
|
||||
{- Looks up a repo's UUID. May return "" if none is known.
|
||||
-
|
||||
- UUIDs of remotes are cached in git config, using keys named
|
||||
- remote.<name>.annex-uuid
|
||||
-
|
||||
- -}
|
||||
getUUID :: State -> GitRepo -> UUID
|
||||
getUUID s r =
|
||||
if ("" /= getUUID' r)
|
||||
then getUUID' r
|
||||
else cached s r
|
||||
where
|
||||
cached s r = gitConfig (repo s) (configkey r) ""
|
||||
configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-uuid"
|
||||
getUUID' r = gitConfig r "annex.uuid" ""
|
||||
|
||||
{- Make sure that the repo has an annex.uuid setting. -}
|
||||
prepUUID :: GitRepo -> IO GitRepo
|
||||
prepUUID repo =
|
||||
if ("" == getUUID repo)
|
||||
if ("" == getUUID' repo)
|
||||
then do
|
||||
uuid <- genUUID
|
||||
gitRun repo ["config", configkey, uuid]
|
||||
-- return new repo with updated config
|
||||
gitConfigRead repo
|
||||
else return repo
|
||||
|
||||
{- Filters a list of repos to ones that have listed UUIDs. -}
|
||||
reposByUUID :: State -> [GitRepo] -> [UUID] -> [GitRepo]
|
||||
reposByUUID state repos uuids =
|
||||
filter (\r -> isJust $ elemIndex (getUUID state r) uuids) repos
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue