This commit is contained in:
Joey Hess 2011-11-09 01:15:51 -04:00
parent bf460a0a98
commit 56b8194470
7 changed files with 13 additions and 22 deletions

View file

@ -1,6 +1,6 @@
{- git-annex monad
-
- Copyright 2010 Joey Hess <joey@kitenet.net>
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -48,6 +48,8 @@ newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
Applicative
)
data OutputType = NormalOutput | QuietOutput | JSONOutput
-- internal state storage
data AnnexState = AnnexState
{ repo :: Git.Repo
@ -70,8 +72,6 @@ data AnnexState = AnnexState
, cipher :: Maybe Cipher
}
data OutputType = NormalOutput | QuietOutput | JSONOutput
newState :: Git.Repo -> AnnexState
newState gitrepo = AnnexState
{ repo = gitrepo

View file

@ -56,9 +56,8 @@ calcGitLink file key = do
- repository. -}
logStatus :: Key -> LogStatus -> Annex ()
logStatus key status = do
g <- gitRepo
u <- getUUID
logChange g key u status
logChange key u status
{- Runs an action, passing it a temporary filename to download,
- and if the action succeeds, moves the temp file into

View file

@ -109,8 +109,7 @@ verifyLocationLog key desc = do
where
fix u s = do
showNote "fixing location log"
g <- gitRepo
logChange g key u s
logChange key u s
{- The size of the data for a key is checked against the size encoded in
- the key's metadata, if available. -}

View file

@ -23,16 +23,13 @@ module Logs.Location (
) where
import Common.Annex
import qualified Git
import qualified Annex.Branch
import Logs.Presence
{- Log a change in the presence of a key's value in a repository. -}
logChange :: Git.Repo -> Key -> UUID -> LogStatus -> Annex ()
logChange _ key (UUID u) s = addLog (logFile key) =<< logNow s u
logChange repo _ NoUUID _ = error $
"unknown UUID for " ++ Git.repoDescribe repo ++
" (have you run git annex init there?)"
logChange :: Key -> UUID -> LogStatus -> Annex ()
logChange key (UUID u) s = addLog (logFile key) =<< logNow s u
logChange _ NoUUID _ = return ()
{- Returns a list of repository UUIDs that, according to the log, have
- the value of a key. -}

View file

@ -42,12 +42,11 @@ getUrls key = do
{- Records a change in an url for a key. -}
setUrl :: Key -> URLString -> LogStatus -> Annex ()
setUrl key url status = do
g <- gitRepo
addLog (urlLog key) =<< logNow status url
-- update location log to indicate that the web has the key, or not
us <- getUrls key
logChange g key webUUID (if null us then InfoMissing else InfoPresent)
logChange key webUUID (if null us then InfoMissing else InfoPresent)
setUrlPresent :: Key -> URLString -> Annex ()
setUrlPresent key url = setUrl key url InfoPresent

View file

@ -231,9 +231,6 @@ forceTrust level remotename = do
- key to the remote, or removing the key from it *may* log the change
- on the remote, but this cannot always be relied on. -}
remoteHasKey :: Remote Annex -> Key -> Bool -> Annex ()
remoteHasKey remote key present = do
let remoteuuid = uuid remote
g <- gitRepo
logChange g key remoteuuid status
remoteHasKey remote key present = logChange key (uuid remote) status
where
status = if present then InfoPresent else InfoMissing

View file

@ -19,10 +19,10 @@ import qualified Git
-}
findSpecialRemotes :: String -> Annex [Git.Repo]
findSpecialRemotes s = do
g <- gitRepo
return $ map construct $ remotepairs g
m <- fromRepo $ Git.configMap
return $ map construct $ remotepairs m
where
remotepairs r = M.toList $ M.filterWithKey match $ Git.configMap r
remotepairs = M.toList . M.filterWithKey match
construct (k,_) = Git.repoRemoteNameFromKey k Git.repoFromUnknown
match k _ = startswith "remote." k && endswith (".annex-"++s) k