split out utility functions

This commit is contained in:
Joey Hess 2012-06-06 13:07:30 -04:00
parent 4b32ea793d
commit 723eb19bbf

View file

@ -50,8 +50,8 @@ start file = notBareRepo $ ifAnnexed file fixup add
- to prevent it from being modified in between. It's hard linked into a - to prevent it from being modified in between. It's hard linked into a
- temporary location, and its writable bits are removed. It could still be - temporary location, and its writable bits are removed. It could still be
- written to by a process that already has it open for writing. -} - written to by a process that already has it open for writing. -}
perform :: FilePath -> CommandPerform lockDown :: FilePath -> Annex FilePath
perform file = do lockDown file = do
liftIO $ preventWrite file liftIO $ preventWrite file
tmp <- fromRepo gitAnnexTmpDir tmp <- fromRepo gitAnnexTmpDir
createAnnexDirectory tmp createAnnexDirectory tmp
@ -59,18 +59,27 @@ perform file = do
let tmpfile = tmp </> "add" ++ show pid ++ "." ++ takeFileName file let tmpfile = tmp </> "add" ++ show pid ++ "." ++ takeFileName file
nuke tmpfile nuke tmpfile
liftIO $ createLink file tmpfile liftIO $ createLink file tmpfile
return tmpfile
nuke :: FilePath -> Annex ()
nuke file = liftIO $ whenM (doesFileExist file) $ removeFile file
{- Moves the file into the annex. -}
ingest :: FilePath -> Annex (Maybe Key)
ingest file = do
tmpfile <- lockDown file
let source = KeySource { keyFilename = file, contentLocation = tmpfile } let source = KeySource { keyFilename = file, contentLocation = tmpfile }
backend <- chooseBackend file backend <- chooseBackend file
genKey source backend >>= go tmpfile genKey source backend >>= go tmpfile
where where
go _ Nothing = stop go _ Nothing = return Nothing
go tmpfile (Just (key, _)) = do go tmpfile (Just (key, _)) = do
handle (undo file key) $ moveAnnex key tmpfile handle (undo file key) $ moveAnnex key tmpfile
nuke file nuke file
next $ cleanup file key True return $ Just key
nuke :: FilePath -> Annex () perform :: FilePath -> CommandPerform
nuke file = liftIO $ whenM (doesFileExist file) $ removeFile file perform file = maybe stop (\key -> next $ cleanup file key True) =<< ingest file
{- On error, put the file back so it doesn't seem to have vanished. {- On error, put the file back so it doesn't seem to have vanished.
- This can be called before or after the symlink is in place. -} - This can be called before or after the symlink is in place. -}
@ -88,21 +97,26 @@ undo file key e = do
src <- inRepo $ gitAnnexLocation key src <- inRepo $ gitAnnexLocation key
liftIO $ moveFile src file liftIO $ moveFile src file
{- Creates the symlink to the annexed content. -}
link :: FilePath -> Key -> Bool -> Annex ()
link file key hascontent = handle (undo file key) $ do
l <- calcGitLink file key
liftIO $ createSymbolicLink l file
when hascontent $ do
logStatus key InfoPresent
-- touch the symlink to have the same mtime as the
-- file it points to
liftIO $ do
mtime <- modificationTime <$> getFileStatus file
touch file (TimeSpec mtime) False
{- Note: Several other commands call this, and expect it to
- create the symlink and add it. -}
cleanup :: FilePath -> Key -> Bool -> CommandCleanup cleanup :: FilePath -> Key -> Bool -> CommandCleanup
cleanup file key hascontent = do cleanup file key hascontent = do
handle (undo file key) $ do link file key hascontent
link <- calcGitLink file key
liftIO $ createSymbolicLink link file
when hascontent $ do
logStatus key InfoPresent
-- touch the symlink to have the same mtime as the
-- file it points to
liftIO $ do
mtime <- modificationTime <$> getFileStatus file
touch file (TimeSpec mtime) False
params <- ifM (Annex.getState Annex.force) params <- ifM (Annex.getState Annex.force)
( return [Param "-f"] ( return [Param "-f"]
, return [] , return []