diff options
| -rw-r--r-- | Annex/CatFile.hs | 6 | ||||
| -rw-r--r-- | Annex/Content/Direct.hs | 7 | ||||
| -rw-r--r-- | Annex/Direct.hs | 8 | ||||
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 25 |
4 files changed, 39 insertions, 7 deletions
diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index 161554f29..ffac4fccd 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -44,6 +44,6 @@ catFileHandle = maybe startup return =<< Annex.getState Annex.catfilehandle Annex.changeState $ \s -> s { Annex.catfilehandle = Just h } return h -{- From the Sha of a symlink back to the key. -} -catKey :: Sha -> Annex (Maybe Key) -catKey sha = fileKey . takeFileName . encodeW8 . L.unpack <$> catObject sha +{- From the Sha or Ref of a symlink back to the key. -} +catKey :: Ref -> Annex (Maybe Key) +catKey ref = fileKey . takeFileName . encodeW8 . L.unpack <$> catObject ref diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs index 75a32e3fc..75cdaad79 100644 --- a/Annex/Content/Direct.hs +++ b/Annex/Content/Direct.hs @@ -10,6 +10,7 @@ module Annex.Content.Direct ( removeAssociatedFile, addAssociatedFile, goodContent, + changedFileStatus, updateCache, recordedCache, compareCache, @@ -79,6 +80,12 @@ goodContent key file = do old <- recordedCache key compareCache file old +changedFileStatus :: Key -> FileStatus -> Annex Bool +changedFileStatus key status = do + old <- recordedCache key + let curr = toCache status + return $ curr == old + {- Gets the recorded cache for a key. -} recordedCache :: Key -> Annex (Maybe Cache) recordedCache key = withCacheFile key $ \cachefile -> diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 77a544257..e44081639 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -209,3 +209,11 @@ removeDirect k f = do liftIO $ do nukeFile f void $ catchMaybeIO $ removeDirectory $ parentDir f + +{- Called when a direct mode file has been changed. Its old content may be + - lost. -} +changedDirect :: Key -> FilePath -> Annex () +changedDirect oldk f = do + locs <- removeAssociatedFile oldk f + whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ + logStatus oldk InfoMissing diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index fd59f1b27..507362dd8 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -33,6 +33,8 @@ import qualified Git.HashObject import qualified Git.LsFiles as LsFiles import qualified Backend import Annex.Content +import Annex.Direct +import Annex.Content.Direct import Annex.CatFile import Git.Types import Config @@ -60,7 +62,7 @@ watchThread :: NamedThread watchThread = NamedThread "Watcher" $ do startup <- asIO1 startupScan direct <- liftAnnex isDirect - addhook <- hook $ onAdd direct + addhook <- hook $ if direct then onAddDirect else onAdd delhook <- hook onDel addsymlinkhook <- hook onAddSymlink deldirhook <- hook onDelDir @@ -126,12 +128,27 @@ runHandler handler file filestatus = void $ do liftAnnex $ Annex.Queue.flushWhenFull recordChange change -onAdd :: Bool -> Handler -onAdd isdirect file filestatus - | isdirect = pendingAddChange file +onAdd :: Handler +onAdd file filestatus | maybe False isRegularFile filestatus = pendingAddChange file | otherwise = noChange +{- In direct mode, add events are received for both new files, and + - modified existing files. Or, in some cases, existing files that have not + - really been modified. -} +onAddDirect :: Handler +onAddDirect file fs = do + v <- liftAnnex $ catKey (Ref $ ':':file) + case (v, fs) of + (Just key, Just filestatus) -> + ifM (liftAnnex $ changedFileStatus key filestatus) + ( noChange + , do + liftAnnex $ changedDirect key file + pendingAddChange file + ) + _ -> pendingAddChange file + {- A symlink might be an arbitrary symlink, which is just added. - Or, if it is a git-annex symlink, ensure it points to the content - before adding it. |