Avoid unncessary write to the location log when a file is unlocked and then added back with unchanged content.
Implemented with no additional overhead of compares etc. This is safe to do for presence logs because of their locality of change; a given repo's presence logs are only ever changed in that repo, or in a repo that has just been actively changing the content of that repo. So, we don't need to worry about a split-brain situation where there'd be disagreement about the location of a key in a repo. And so, it's ok to not update the timestamp when that's the only change that would be made due to logging presence info.
This commit is contained in:
parent
82ba8c9a6a
commit
f9adb905fc
7 changed files with 65 additions and 14 deletions
|
@ -48,7 +48,7 @@ logChange = logChange' logNow
|
|||
logChange' :: (LogStatus -> String -> Annex LogLine) -> Key -> UUID -> LogStatus -> Annex ()
|
||||
logChange' mklog key (UUID u) s = do
|
||||
config <- Annex.getGitConfig
|
||||
addLog (locationLogFile config key) =<< mklog s u
|
||||
maybeAddLog (locationLogFile config key) =<< mklog s u
|
||||
logChange' _ _ NoUUID _ = noop
|
||||
|
||||
{- Returns a list of repository UUIDs that, according to the log, have
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
- a way that can be union merged.
|
||||
-
|
||||
- A line of the log will look like: "date N INFO"
|
||||
- Where N=1 when the INFO is present, and 0 otherwise.
|
||||
- Where N=1 when the INFO is present, 0 otherwise.
|
||||
-
|
||||
- Copyright 2010-2014 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
|
@ -14,6 +14,7 @@
|
|||
module Logs.Presence (
|
||||
module X,
|
||||
addLog,
|
||||
maybeAddLog,
|
||||
readLog,
|
||||
logNow,
|
||||
currentLog,
|
||||
|
@ -28,10 +29,21 @@ import Common.Annex
|
|||
import qualified Annex.Branch
|
||||
import Git.Types (RefDate)
|
||||
|
||||
{- Adds a LogLine to the log, removing any LogLines that are obsoleted by
|
||||
- adding it. -}
|
||||
addLog :: FilePath -> LogLine -> Annex ()
|
||||
addLog file line = Annex.Branch.change file $ \s ->
|
||||
addLog file line = Annex.Branch.change file $ \s ->
|
||||
showLog $ compactLog (line : parseLog s)
|
||||
|
||||
{- When a LogLine already exists with the same status and info, but an
|
||||
- older timestamp, that LogLine is preserved, rather than updating the log
|
||||
- with a newer timestamp.
|
||||
-}
|
||||
maybeAddLog :: FilePath -> LogLine -> Annex ()
|
||||
maybeAddLog file line = Annex.Branch.maybeChange file $ \s -> do
|
||||
m <- insertNewStatus line $ logMap $ parseLog s
|
||||
return $ showLog $ mapLog m
|
||||
|
||||
{- Reads a log file.
|
||||
- Note that the LogLines returned may be in any order. -}
|
||||
readLog :: FilePath -> Annex [LogLine]
|
||||
|
|
|
@ -61,21 +61,39 @@ filterPresent = filter (\l -> InfoPresent == status l) . compactLog
|
|||
{- Compacts a set of logs, returning a subset that contains the current
|
||||
- status. -}
|
||||
compactLog :: [LogLine] -> [LogLine]
|
||||
compactLog = M.elems . foldr mapLog M.empty
|
||||
compactLog = mapLog . logMap
|
||||
|
||||
type LogMap = M.Map String LogLine
|
||||
|
||||
{- Inserts a log into a map of logs, if the log has better (ie, newer)
|
||||
- information than the other logs in the map -}
|
||||
mapLog :: LogLine -> LogMap -> LogMap
|
||||
mapLog l m
|
||||
| better = M.insert i l m
|
||||
| otherwise = m
|
||||
mapLog :: LogMap -> [LogLine]
|
||||
mapLog = M.elems
|
||||
|
||||
logMap :: [LogLine] -> LogMap
|
||||
logMap = foldr insertNewerLogLine M.empty
|
||||
|
||||
insertBetter :: (LogLine -> Bool) -> LogLine -> LogMap -> Maybe LogMap
|
||||
insertBetter betterthan l m
|
||||
| better = Just (M.insert i l m)
|
||||
| otherwise = Nothing
|
||||
where
|
||||
better = maybe True newer $ M.lookup i m
|
||||
newer l' = date l' <= date l
|
||||
better = maybe True betterthan (M.lookup i m)
|
||||
i = info l
|
||||
|
||||
{- Inserts a log into a map of logs, if the log has newer
|
||||
- information than the other logs in the map for the same info. -}
|
||||
insertNewerLogLine :: LogLine -> LogMap -> LogMap
|
||||
insertNewerLogLine l m = fromMaybe m $ insertBetter newer l m
|
||||
where
|
||||
newer l' = date l' <= date l
|
||||
|
||||
{- Inserts the log unless there's already one in the map with
|
||||
- the same status for its info, in which case there's no need to
|
||||
- change anything, to avoid log churn. -}
|
||||
insertNewStatus :: LogLine -> LogMap -> Maybe LogMap
|
||||
insertNewStatus l m = insertBetter diffstatus l m
|
||||
where
|
||||
diffstatus l' = status l' /= status l
|
||||
|
||||
instance Arbitrary LogLine where
|
||||
arbitrary = LogLine
|
||||
<$> arbitrary
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue