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

@ -23,7 +23,7 @@ module Annex.Content (
import Common.Annex
import Logs.Location
import Logs.UUID
import Annex.UUID
import qualified Git
import qualified Annex
import qualified Annex.Queue

69
Annex/UUID.hs Normal file
View file

@ -0,0 +1,69 @@
{- 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 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

View file

@ -9,7 +9,7 @@ module Command.ConfigList where
import Common.Annex
import Command
import Logs.UUID
import Annex.UUID
command :: [Command]
command = [repoCommand "configlist" paramNothing seek

View file

@ -15,7 +15,7 @@ import qualified Types.Key
import Annex.Content
import Logs.Location
import Logs.Trust
import Logs.UUID
import Annex.UUID
import Utility.DataUnits
import Utility.FileMode
import Config

View file

@ -9,6 +9,7 @@ module Command.Init where
import Common.Annex
import Command
import Annex.UUID
import Logs.UUID
import Init

View file

@ -14,7 +14,7 @@ import Command
import qualified Remote
import qualified Logs.Remote
import qualified Types.Remote as R
import Logs.UUID
import Annex.UUID
command :: [Command]
command = [repoCommand "initremote"

View file

@ -13,6 +13,7 @@ import qualified Data.Map as M
import Common.Annex
import Command
import qualified Git
import Annex.UUID
import Logs.UUID
import Logs.Trust
import Utility.Ssh

View file

@ -14,7 +14,7 @@ import qualified Annex
import Logs.Location
import Annex.Content
import qualified Remote
import Logs.UUID
import Annex.UUID
command :: [Command]
command = [repoCommand "move" paramPaths seek

View file

@ -10,7 +10,6 @@ module Command.Semitrust where
import Common.Annex
import Command
import qualified Remote
import Logs.UUID
import Logs.Trust
command :: [Command]

View file

@ -11,7 +11,6 @@ import Common.Annex
import Command
import qualified Remote
import Logs.Trust
import Logs.UUID
command :: [Command]
command = [repoCommand "trust" (paramRepeating paramRemote) seek

View file

@ -10,7 +10,6 @@ module Command.Untrust where
import Common.Annex
import Command
import qualified Remote
import Logs.UUID
import Logs.Trust
command :: [Command]

View file

@ -15,7 +15,7 @@ import Common.Annex
import qualified Git
import qualified Annex.Branch
import Annex.Version
import Logs.UUID
import Annex.UUID
initialize :: Annex ()
initialize = do

View file

@ -24,7 +24,6 @@ module Logs.Location (
import Common.Annex
import qualified Git
import qualified Annex.Branch
import Logs.UUID
import Logs.Presence
{- Log a change in the presence of a key's value in a repository. -}

View file

@ -21,7 +21,6 @@ import Data.Char
import Common.Annex
import qualified Annex.Branch
import Types.Remote
import Logs.UUID
import Logs.UUIDBased
{- Filename of remote.log. -}

View file

@ -19,8 +19,6 @@ import Common.Annex
import Types.TrustLevel
import qualified Annex.Branch
import qualified Annex
import Logs.UUID
import Logs.UUIDBased
{- Filename of trust.log. -}

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

View file

@ -16,7 +16,6 @@ module Logs.Web (
import Common.Annex
import Logs.Presence
import Logs.Location
import Logs.UUID
type URLString = String

View file

@ -36,6 +36,7 @@ import Common.Annex
import Types.Remote
import qualified Annex
import Config
import Annex.UUID
import Logs.UUID
import Logs.Trust
import Logs.Location

View file

@ -15,7 +15,6 @@ import System.Process
import Common.Annex
import Types.Remote
import qualified Git
import Logs.UUID
import Config
import Utility.Ssh
import Remote.Helper.Special

View file

@ -15,7 +15,6 @@ import Common.Annex
import Utility.CopyFile
import Types.Remote
import qualified Git
import Logs.UUID
import Config
import Utility.FileMode
import Remote.Helper.Special

View file

@ -17,7 +17,7 @@ import Utility.Ssh
import Types.Remote
import qualified Git
import qualified Annex
import Logs.UUID
import Annex.UUID
import qualified Annex.Content
import qualified Utility.Url as Url
import Config

View file

@ -12,7 +12,6 @@ import qualified Data.Map as M
import Common.Annex
import Types.Remote
import qualified Git
import Logs.UUID
{- Special remotes don't have a configured url, so Git.Repo does not
- automatically generate remotes for them. This looks for a different

View file

@ -15,7 +15,6 @@ import System.Exit
import Common.Annex
import Types.Remote
import qualified Git
import Logs.UUID
import Config
import Annex.Content
import Remote.Helper.Special

View file

@ -11,7 +11,6 @@ import Common.Annex
import Types.Remote
import qualified Git
import Config
import Logs.UUID
import Logs.Web
import qualified Utility.Url as Url

View file

@ -8,9 +8,11 @@
module Types (
Annex,
Backend,
Key
Key,
UUID
) where
import Annex
import Types.Backend
import Types.Key
import Types.UUID

View file

@ -13,7 +13,7 @@ import qualified Git
import Utility.SafeCommand
import Types
import Config
import Logs.UUID
import Annex.UUID
{- Generates parameters to ssh to a repository's host and run a command.
- Caller is responsible for doing any neccessary shellEscaping of the

View file

@ -13,7 +13,7 @@ import qualified Git
import CmdLine
import Command
import Options
import Logs.UUID
import Annex.UUID
import qualified Command.ConfigList
import qualified Command.InAnnex

View file

@ -23,6 +23,7 @@ import Common
import qualified Utility.SafeCommand
import qualified Annex
import qualified Annex.UUID
import qualified Backend
import qualified Git
import qualified Locations
@ -609,7 +610,7 @@ checkdangling f = do
checklocationlog :: FilePath -> Bool -> Assertion
checklocationlog f expected = do
thisuuid <- annexeval Logs.UUID.getUUID
thisuuid <- annexeval Annex.UUID.getUUID
r <- annexeval $ Backend.lookupFile f
case r of
Just (k, _) -> do