assistant adding of files in direct mode

This commit is contained in:
Joey Hess 2012-12-24 13:37:29 -04:00
parent da8fbb9e3e
commit c6d2bbe402
3 changed files with 32 additions and 13 deletions

View file

@ -31,6 +31,7 @@ import qualified Utility.DirWatcher as DirWatcher
import Types.KeySource import Types.KeySource
import Config import Config
import Annex.Exception import Annex.Exception
import Annex.Content
import Data.Time.Clock import Data.Time.Clock
import Data.Tuple.Utils import Data.Tuple.Utils
@ -154,7 +155,8 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
returnWhen (null toadd) $ do returnWhen (null toadd) $ do
added <- catMaybes <$> forM toadd add added <- catMaybes <$> forM toadd add
if DirWatcher.eventsCoalesce || null added direct <- liftAnnex isDirect
if DirWatcher.eventsCoalesce || null added || direct
then return $ added ++ otherchanges then return $ added ++ otherchanges
else do else do
r <- handleAdds delayadd =<< getChanges r <- handleAdds delayadd =<< getChanges
@ -195,13 +197,15 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
liftAnnex showEndFail liftAnnex showEndFail
return Nothing return Nothing
done change file (Just key) = do done change file (Just key) = do
link <- liftAnnex $ Command.Add.link file key True link <- liftAnnex $ ifM isDirect
when DirWatcher.eventsCoalesce $ ( calcGitLink file key
liftAnnex $ do , Command.Add.link file key True
sha <- inRepo $ )
Git.HashObject.hashObject BlobObject link liftAnnex $ whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do
stageSymlink file sha sha <- inRepo $
showEndOk Git.HashObject.hashObject BlobObject link
stageSymlink file sha
showEndOk
queueTransfers Next key (Just file) Upload queueTransfers Next key (Just file) Upload
return $ Just change return $ Just change

View file

@ -223,7 +223,8 @@ onErr msg _ = do
{- Adds a symlink to the index, without ever accessing the actual symlink {- 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 - 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 :: FilePath -> Sha -> Annex ()
stageSymlink file sha = stageSymlink file sha =

View file

@ -16,9 +16,11 @@ import Types.KeySource
import Backend import Backend
import Logs.Location import Logs.Location
import Annex.Content import Annex.Content
import Annex.Content.Direct
import Annex.Perms import Annex.Perms
import Utility.Touch import Utility.Touch
import Utility.FileMode import Utility.FileMode
import Config
def :: [Command] def :: [Command]
def = [command "add" paramPaths seek "add files to annex"] def = [command "add" paramPaths seek "add files to annex"]
@ -62,7 +64,11 @@ lockDown file = do
createLink file tmpfile createLink file tmpfile
return $ KeySource { keyFilename = file , contentLocation = 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 :: KeySource -> Annex (Maybe Key)
ingest source = do ingest source = do
backend <- chooseBackend $ keyFilename source backend <- chooseBackend $ keyFilename source
@ -72,9 +78,17 @@ ingest source = do
liftIO $ nukeFile $ contentLocation source liftIO $ nukeFile $ contentLocation source
return Nothing return Nothing
go (Just (key, _)) = do go (Just (key, _)) = do
handle (undo (keyFilename source) key) $ ifM isDirect
moveAnnex key $ contentLocation source ( do
liftIO $ nukeFile $ keyFilename source 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 return $ Just key
perform :: FilePath -> CommandPerform perform :: FilePath -> CommandPerform