aboutsummaryrefslogtreecommitdiff
path: root/Logs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-01-28 17:17:26 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-01-28 17:17:26 -0400
commit20a8350e36f6e38b55603e6578fa7b1c4967c1a9 (patch)
tree6c6b884cbc52496d614be996d702e0b8f6dc9300 /Logs
parent6e765717650f0270cdc497d38245bcbc4180e60c (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.hs8
-rw-r--r--Logs/Location.hs9
-rw-r--r--Logs/MetaData.hs20
-rw-r--r--Logs/RemoteState.hs10
-rw-r--r--Logs/Web.hs11
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