git-annex/Annex/UUID.hs
Joey Hess bf460a0a98 reorder repo parameters last
Many functions took the repo as their first parameter. Changing it
consistently to be the last parameter allows doing some useful things with
currying, that reduce boilerplate.

In particular, g <- gitRepo is almost never needed now, instead
use inRepo to run an IO action in the repo, and fromRepo to get
a value from the repo.

This also provides more opportunities to use monadic and applicative
combinators.
2011-11-08 16:27:20 -04:00

72 lines
1.8 KiB
Haskell

{- git-annex uuids
-
- Each git repository used by git-annex has an annex.uuid setting that
- uniquely identifies that repository.
-
- UUIDs of remotes are cached in git config, using keys named
- remote.<name>.annex-uuid
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.UUID (
getUUID,
getRepoUUID,
getUncachedUUID,
prepUUID,
genUUID
) where
import Common.Annex
import qualified Git
import qualified Build.SysConfig as SysConfig
import Config
configkey :: String
configkey = "annex.uuid"
{- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -}
genUUID :: IO UUID
genUUID = pOpen ReadFromPipe command params $ liftM toUUID . hGetLine
where
command = SysConfig.uuid
params = if command == "uuid"
-- request a random uuid be generated
then ["-m"]
-- uuidgen generates random uuid by default
else []
getUUID :: Annex UUID
getUUID = getRepoUUID =<< gitRepo
{- Looks up a repo's UUID. May return "" if none is known. -}
getRepoUUID :: Git.Repo -> Annex UUID
getRepoUUID r = do
c <- fromRepo cached
let u = getUncachedUUID r
if c /= u && u /= NoUUID
then do
updatecache u
return u
else return c
where
cached g = toUUID $ Git.configGet cachekey "" g
updatecache u = do
g <- gitRepo
when (g /= r) $ storeUUID cachekey u
cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-uuid"
getUncachedUUID :: Git.Repo -> UUID
getUncachedUUID = toUUID . Git.configGet configkey ""
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex ()
prepUUID = whenM ((==) NoUUID <$> getUUID) $
storeUUID configkey =<< liftIO genUUID
storeUUID :: String -> UUID -> Annex ()
storeUUID configfield = setConfig configfield . fromUUID