diff options
-rw-r--r-- | Assistant/Threads/Committer.hs | 24 | ||||
-rw-r--r-- | Assistant/Threads/Watcher.hs | 27 | ||||
-rw-r--r-- | Command.hs | 7 | ||||
-rw-r--r-- | Command/Add.hs | 24 | ||||
-rw-r--r-- | Git/LsFiles.hs | 16 |
5 files changed, 72 insertions, 26 deletions
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index ca2148236..4d623eb0a 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -31,6 +31,7 @@ import qualified Utility.DirWatcher as DirWatcher import Types.KeySource import Config import Annex.Exception +import Annex.Content import Data.Time.Clock import Data.Tuple.Utils @@ -146,7 +147,10 @@ delayaddDefault = Nothing handleAdds :: Maybe Seconds -> [Change] -> Assistant [Change] handleAdds delayadd cs = returnWhen (null incomplete) $ do let (pending, inprocess) = partition isPendingAddChange incomplete - pending' <- findnew pending + direct <- liftAnnex isDirect + pending' <- if direct + then return pending + else findnew pending (postponed, toadd) <- partitionEithers <$> safeToAdd delayadd pending' inprocess unless (null postponed) $ @@ -154,7 +158,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do returnWhen (null toadd) $ do added <- catMaybes <$> forM toadd add - if DirWatcher.eventsCoalesce || null added + if DirWatcher.eventsCoalesce || null added || direct then return $ added ++ otherchanges else do r <- handleAdds delayadd =<< getChanges @@ -195,13 +199,15 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do liftAnnex showEndFail return Nothing done change file (Just key) = do - link <- liftAnnex $ Command.Add.link file key True - when DirWatcher.eventsCoalesce $ - liftAnnex $ do - sha <- inRepo $ - Git.HashObject.hashObject BlobObject link - stageSymlink file sha - showEndOk + link <- liftAnnex $ ifM isDirect + ( calcGitLink file key + , Command.Add.link file key True + ) + liftAnnex $ whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do + sha <- inRepo $ + Git.HashObject.hashObject BlobObject link + stageSymlink file sha + showEndOk queueTransfers Next key (Just file) Upload return $ Just change diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 08689cca4..fd59f1b27 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -27,13 +27,15 @@ import Utility.Types.DirWatcher import Utility.Lsof import qualified Annex import qualified Annex.Queue -import qualified Git.Command +import qualified Git import qualified Git.UpdateIndex import qualified Git.HashObject +import qualified Git.LsFiles as LsFiles import qualified Backend import Annex.Content import Annex.CatFile import Git.Types +import Config import Data.Bits.Utils import qualified Data.ByteString.Lazy as L @@ -57,7 +59,8 @@ needLsof = error $ unlines watchThread :: NamedThread watchThread = NamedThread "Watcher" $ do startup <- asIO1 startupScan - addhook <- hook onAdd + direct <- liftAnnex isDirect + addhook <- hook $ onAdd direct delhook <- hook onDel addsymlinkhook <- hook onAddSymlink deldirhook <- hook onDelDir @@ -83,9 +86,15 @@ startupScan scanner = do -- Notice any files that were deleted before -- watching was started. - liftAnnex $ do - inRepo $ Git.Command.run "add" [Param "--update"] - showAction "started" + top <- liftAnnex $ fromRepo Git.repoPath + (fs, cleanup) <- liftAnnex $ inRepo $ LsFiles.deleted [top] + forM_ fs $ \f -> do + liftAnnex $ Annex.Queue.addUpdateIndex =<< + inRepo (Git.UpdateIndex.unstageFile f) + maybe noop recordChange =<< madeChange f RmChange + void $ liftIO $ cleanup + + liftAnnex $ showAction "started" modifyDaemonStatus_ $ \s -> s { scanComplete = True } @@ -117,8 +126,9 @@ runHandler handler file filestatus = void $ do liftAnnex $ Annex.Queue.flushWhenFull recordChange change -onAdd :: Handler -onAdd file filestatus +onAdd :: Bool -> Handler +onAdd isdirect file filestatus + | isdirect = pendingAddChange file | maybe False isRegularFile filestatus = pendingAddChange file | otherwise = noChange @@ -223,7 +233,8 @@ onErr msg _ = do {- Adds a symlink to the index, without ever accessing the actual symlink - on disk. This avoids a race if git add is used, where the symlink is - - changed to something else immediately after creation. + - changed to something else immediately after creation. It also allows + - direct mode to work. -} stageSymlink :: FilePath -> Sha -> Annex () stageSymlink file sha = diff --git a/Command.hs b/Command.hs index 478dfdc39..6c127c15d 100644 --- a/Command.hs +++ b/Command.hs @@ -18,6 +18,7 @@ module Command ( whenAnnexed, ifAnnexed, notBareRepo, + notDirect, isBareRepo, numCopies, numCopiesCheck, @@ -103,6 +104,12 @@ notBareRepo a = do error "You cannot run this subcommand in a bare repository." a +notDirect :: Annex a -> Annex a +notDirect a = ifM isDirect + ( error "You cannot run this subcommand in a direct mode repository." + , a + ) + isBareRepo :: Annex Bool isBareRepo = fromRepo Git.repoIsLocalBare diff --git a/Command/Add.hs b/Command/Add.hs index edb2f9cf4..e18f8592c 100644 --- a/Command/Add.hs +++ b/Command/Add.hs @@ -16,9 +16,11 @@ import Types.KeySource import Backend import Logs.Location import Annex.Content +import Annex.Content.Direct import Annex.Perms import Utility.Touch import Utility.FileMode +import Config def :: [Command] def = [command "add" paramPaths seek "add files to annex"] @@ -31,7 +33,7 @@ seek = [withFilesNotInGit start, withFilesUnlocked start] - backend, and then moving it into the annex directory and setting up - the symlink pointing to its content. -} start :: FilePath -> CommandStart -start file = notBareRepo $ ifAnnexed file fixup add +start file = notBareRepo $ notDirect $ ifAnnexed file fixup add where add = do s <- liftIO $ getSymbolicLinkStatus file @@ -62,7 +64,11 @@ lockDown file = do createLink file tmpfile return $ KeySource { keyFilename = file , contentLocation = tmpfile } -{- Moves a locked down file into the annex. -} +{- Moves a locked down file into the annex. + - + - In direct mode, leaves the file alone, and just updates bookeeping + - information. + -} ingest :: KeySource -> Annex (Maybe Key) ingest source = do backend <- chooseBackend $ keyFilename source @@ -72,9 +78,17 @@ ingest source = do liftIO $ nukeFile $ contentLocation source return Nothing go (Just (key, _)) = do - handle (undo (keyFilename source) key) $ - moveAnnex key $ contentLocation source - liftIO $ nukeFile $ keyFilename source + ifM isDirect + ( do + updateCache key $ keyFilename source + void $ addAssociatedFile key $ keyFilename source + liftIO $ allowWrite $ keyFilename source + liftIO $ nukeFile $ contentLocation source + , do + handle (undo (keyFilename source) key) $ + moveAnnex key $ contentLocation source + liftIO $ nukeFile $ keyFilename source + ) return $ Just key perform :: FilePath -> CommandPerform diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 45c830cd6..401ed5562 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -8,6 +8,7 @@ module Git.LsFiles ( inRepo, notInRepo, + deleted, staged, stagedNotDeleted, stagedDetails, @@ -38,6 +39,13 @@ notInRepo include_ignored l repo = pipeNullSplit params repo | include_ignored = [] | otherwise = [Param "--exclude-standard"] +{- Returns a list of files in the specified locations that have been + - deleted. -} +deleted :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) +deleted l repo = pipeNullSplit params repo + where + params = [Params "ls-files --deleted -z --"] ++ map File l + {- Returns a list of all files that are staged for commit. -} staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) staged = staged' [] @@ -112,7 +120,7 @@ data Unmerged = Unmerged - 1 = old version, can be ignored - 2 = us - 3 = them - - If a line is omitted, that side deleted the file. + - If a line is omitted, that side removed the file. -} unmerged :: [FilePath] -> Repo -> IO ([Unmerged], IO Bool) unmerged l repo = do @@ -157,11 +165,11 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest , unmergedBlobType = Conflicting blobtypeA blobtypeB , unmergedSha = Conflicting shaA shaB } - findsib templatei [] = ([], deleted templatei) + findsib templatei [] = ([], removed templatei) findsib templatei (l:ls) | ifile l == ifile templatei = (ls, l) - | otherwise = (l:ls, deleted templatei) - deleted templatei = templatei + | otherwise = (l:ls, removed templatei) + removed templatei = templatei { isus = not (isus templatei) , iblobtype = Nothing , isha = Nothing |