diff options
author | Joey Hess <joeyh@joeyh.name> | 2015-01-28 17:17:26 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2015-01-28 17:17:26 -0400 |
commit | 20a8350e36f6e38b55603e6578fa7b1c4967c1a9 (patch) | |
tree | 6c6b884cbc52496d614be996d702e0b8f6dc9300 /Logs | |
parent | 6e765717650f0270cdc497d38245bcbc4180e60c (diff) |
implement annex.tune.branchhash1
I hope this doesn't impact speed much -- it does have to pull out a value
from Annex state every time it accesses the branch now.
The test case I dropped has never caught any problems that I can remember,
and would have been rather difficult to convert.
Diffstat (limited to 'Logs')
-rw-r--r-- | Logs/Chunk.hs | 8 | ||||
-rw-r--r-- | Logs/Location.hs | 9 | ||||
-rw-r--r-- | Logs/MetaData.hs | 20 | ||||
-rw-r--r-- | Logs/RemoteState.hs | 10 | ||||
-rw-r--r-- | Logs/Web.hs | 11 |
5 files changed, 40 insertions, 18 deletions
diff --git a/Logs/Chunk.hs b/Logs/Chunk.hs index 8ca3ffed3..8f0e7cedb 100644 --- a/Logs/Chunk.hs +++ b/Logs/Chunk.hs @@ -29,6 +29,7 @@ import Logs import Logs.MapLog import qualified Annex.Branch import Logs.Chunk.Pure +import qualified Annex import qualified Data.Map as M import Data.Time.Clock.POSIX @@ -36,14 +37,17 @@ import Data.Time.Clock.POSIX chunksStored :: UUID -> Key -> ChunkMethod -> ChunkCount -> Annex () chunksStored u k chunkmethod chunkcount = do ts <- liftIO getPOSIXTime - Annex.Branch.change (chunkLogFile k) $ + config <- Annex.getGitConfig + Annex.Branch.change (chunkLogFile config k) $ showLog . changeMapLog ts (u, chunkmethod) chunkcount . parseLog chunksRemoved :: UUID -> Key -> ChunkMethod -> Annex () chunksRemoved u k chunkmethod = chunksStored u k chunkmethod 0 getCurrentChunks :: UUID -> Key -> Annex [(ChunkMethod, ChunkCount)] -getCurrentChunks u k = select . parseLog <$> Annex.Branch.get (chunkLogFile k) +getCurrentChunks u k = do + config <- Annex.getGitConfig + select . parseLog <$> Annex.Branch.get (chunkLogFile config k) where select = filter (\(_m, ct) -> ct > 0) . map (\((_ku, m), l) -> (m, value l)) diff --git a/Logs/Location.hs b/Logs/Location.hs index d0109b848..7c6888c0b 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -29,6 +29,7 @@ import Logs import Logs.Presence import Annex.UUID import Git.Types (RefDate) +import qualified Annex {- Log a change in the presence of a key's value in current repository. -} logStatus :: Key -> LogStatus -> Annex () @@ -38,7 +39,9 @@ logStatus key s = do {- Log a change in the presence of a key's value in a repository. -} logChange :: Key -> UUID -> LogStatus -> Annex () -logChange key (UUID u) s = addLog (locationLogFile key) =<< logNow s u +logChange key (UUID u) s = do + config <- Annex.getGitConfig + addLog (locationLogFile config key) =<< logNow s u logChange _ NoUUID _ = noop {- Returns a list of repository UUIDs that, according to the log, have @@ -51,7 +54,9 @@ loggedLocationsHistorical :: RefDate -> Key -> Annex [UUID] loggedLocationsHistorical = getLoggedLocations . historicalLog getLoggedLocations :: (FilePath -> Annex [String]) -> Key -> Annex [UUID] -getLoggedLocations getter key = map toUUID <$> (getter . locationLogFile) key +getLoggedLocations getter key = do + config <- Annex.getGitConfig + map toUUID <$> (getter . locationLogFile config) key {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs index 3091935cf..ed4e2363e 100644 --- a/Logs/MetaData.hs +++ b/Logs/MetaData.hs @@ -38,6 +38,7 @@ import Common.Annex import Types.MetaData import Annex.MetaData.StandardFields import qualified Annex.Branch +import qualified Annex import Logs import Logs.SingleValue @@ -52,7 +53,9 @@ instance SingleValueSerializable MetaData where deserialize = Types.MetaData.deserialize getMetaDataLog :: Key -> Annex (Log MetaData) -getMetaDataLog = readLog . metaDataLogFile +getMetaDataLog key = do + config <- Annex.getGitConfig + readLog $ metaDataLogFile config key {- Go through the log from oldest to newest, and combine it all - into a single MetaData representing the current state. @@ -97,10 +100,12 @@ addMetaData k metadata = addMetaData' k metadata =<< liftIO getPOSIXTime addMetaData' :: Key -> MetaData -> POSIXTime -> Annex () addMetaData' k d@(MetaData m) now | d == emptyMetaData = noop - | otherwise = Annex.Branch.change (metaDataLogFile k) $ - showLog . simplifyLog - . S.insert (LogEntry now metadata) - . parseLog + | otherwise = do + config <- Annex.getGitConfig + Annex.Branch.change (metaDataLogFile config k) $ + showLog . simplifyLog + . S.insert (LogEntry now metadata) + . parseLog where metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m @@ -181,6 +186,7 @@ copyMetaData oldkey newkey | oldkey == newkey = noop | otherwise = do l <- getMetaDataLog oldkey - unless (S.null l) $ - Annex.Branch.change (metaDataLogFile newkey) $ + unless (S.null l) $ do + config <- Annex.getGitConfig + Annex.Branch.change (metaDataLogFile config newkey) $ const $ showLog l diff --git a/Logs/RemoteState.hs b/Logs/RemoteState.hs index 7b3859a35..b302b739a 100644 --- a/Logs/RemoteState.hs +++ b/Logs/RemoteState.hs @@ -14,6 +14,7 @@ import Common.Annex import Logs import Logs.UUIDBased import qualified Annex.Branch +import qualified Annex import qualified Data.Map as M import Data.Time.Clock.POSIX @@ -23,11 +24,14 @@ type RemoteState = String setRemoteState :: UUID -> Key -> RemoteState -> Annex () setRemoteState u k s = do ts <- liftIO getPOSIXTime - Annex.Branch.change (remoteStateLogFile k) $ + config <- Annex.getGitConfig + Annex.Branch.change (remoteStateLogFile config k) $ showLogNew id . changeLog ts u s . parseLogNew Just getRemoteState :: UUID -> Key -> Annex (Maybe RemoteState) -getRemoteState u k = extract . parseLogNew Just - <$> Annex.Branch.get (remoteStateLogFile k) +getRemoteState u k = do + config <- Annex.getGitConfig + extract . parseLogNew Just + <$> Annex.Branch.get (remoteStateLogFile config k) where extract m = value <$> M.lookup u m diff --git a/Logs/Web.hs b/Logs/Web.hs index 4729cead4..38993c33c 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -37,7 +37,8 @@ import Utility.Url {- Gets all urls that a key might be available from. -} getUrls :: Key -> Annex [URLString] getUrls key = do - l <- go $ urlLogFile key : oldurlLogs key + config <- Annex.getGitConfig + l <- go $ urlLogFile config key : oldurlLogs config key tmpl <- Annex.getState (maybeToList . M.lookup key . Annex.tempurls) return (tmpl ++ l) where @@ -54,13 +55,15 @@ getUrlsWithPrefix key prefix = filter (prefix `isPrefixOf`) <$> getUrls key setUrlPresent :: UUID -> Key -> URLString -> Annex () setUrlPresent uuid key url = do us <- getUrls key - unless (url `elem` us) $ - addLog (urlLogFile key) =<< logNow InfoPresent url + unless (url `elem` us) $ do + config <- Annex.getGitConfig + addLog (urlLogFile config key) =<< logNow InfoPresent url logChange key uuid InfoPresent setUrlMissing :: UUID -> Key -> URLString -> Annex () setUrlMissing uuid key url = do - addLog (urlLogFile key) =<< logNow InfoMissing url + config <- Annex.getGitConfig + addLog (urlLogFile config key) =<< logNow InfoMissing url whenM (null <$> getUrls key) $ logChange key uuid InfoMissing |