break out non-log stuff to separate module
This commit is contained in:
parent
ec169f84b1
commit
ee9af605bc
28 changed files with 86 additions and 78 deletions
54
Logs/UUID.hs
54
Logs/UUID.hs
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue