assistant adding of files in direct mode
This commit is contained in:
parent
da8fbb9e3e
commit
c6d2bbe402
3 changed files with 32 additions and 13 deletions
|
@ -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
|
||||
|
@ -154,7 +155,8 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
|
|||
|
||||
returnWhen (null toadd) $ do
|
||||
added <- catMaybes <$> forM toadd add
|
||||
if DirWatcher.eventsCoalesce || null added
|
||||
direct <- liftAnnex isDirect
|
||||
if DirWatcher.eventsCoalesce || null added || direct
|
||||
then return $ added ++ otherchanges
|
||||
else do
|
||||
r <- handleAdds delayadd =<< getChanges
|
||||
|
@ -195,13 +197,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
|
||||
|
||||
|
|
|
@ -223,7 +223,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 =
|
||||
|
|
|
@ -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"]
|
||||
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue