break out non-log stuff to separate module

This commit is contained in:
Joey Hess 2011-10-15 17:47:03 -04:00
parent ec169f84b1
commit ee9af605bc
28 changed files with 86 additions and 78 deletions

View file

@ -14,12 +14,6 @@
-}
module Logs.UUID (
UUID,
getUUID,
getRepoUUID,
getUncachedUUID,
prepUUID,
genUUID,
describeUUID,
uuidMap
) where
@ -28,61 +22,13 @@ import qualified Data.Map as M
import Data.Time.Clock.POSIX
import Common.Annex
import qualified Git
import qualified Annex.Branch
import Types.UUID
import qualified Build.SysConfig as SysConfig
import Config
import Logs.UUIDBased
configkey :: String
configkey = "annex.uuid"
{- Filename of uuid.log. -}
logfile :: FilePath
logfile = "uuid.log"
{- 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 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
g <- gitRepo
let c = cached g
let u = getUncachedUUID r
if c /= u && u /= ""
then do
updatecache g u
return u
else return c
where
cached g = Git.configGet g cachekey ""
updatecache g u = when (g /= r) $ setConfig cachekey u
cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-uuid"
getUncachedUUID :: Git.Repo -> UUID
getUncachedUUID r = Git.configGet r configkey ""
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex ()
prepUUID = whenM (null <$> getUUID) $
setConfig configkey =<< liftIO genUUID
{- Records a description for a uuid in the log. -}
describeUUID :: UUID -> String -> Annex ()
describeUUID uuid desc = do