summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-06 13:07:30 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-06 13:07:30 -0400
commit723eb19bbf30d502cb6979655b8013de49ce0b5e (patch)
tree636417e8751de48ecb37e6c31d2291f966150b5d
parent4b32ea793d4e747c3e6cff92041e35061a78c410 (diff)
split out utility functions
-rw-r--r--Command/Add.hs50
1 files changed, 32 insertions, 18 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index 2c671eea2..7fbfa6e7f 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -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
- temporary location, and its writable bits are removed. It could still be
- written to by a process that already has it open for writing. -}
-perform :: FilePath -> CommandPerform
-perform file = do
+lockDown :: FilePath -> Annex FilePath
+lockDown file = do
liftIO $ preventWrite file
tmp <- fromRepo gitAnnexTmpDir
createAnnexDirectory tmp
@@ -59,18 +59,27 @@ perform file = do
let tmpfile = tmp </> "add" ++ show pid ++ "." ++ takeFileName file
nuke 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 }
backend <- chooseBackend file
genKey source backend >>= go tmpfile
where
- go _ Nothing = stop
+ go _ Nothing = return Nothing
go tmpfile (Just (key, _)) = do
handle (undo file key) $ moveAnnex key tmpfile
nuke file
- next $ cleanup file key True
+ return $ Just key
-nuke :: FilePath -> Annex ()
-nuke file = liftIO $ whenM (doesFileExist file) $ removeFile file
+perform :: FilePath -> CommandPerform
+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.
- 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
liftIO $ moveFile src file
-cleanup :: FilePath -> Key -> Bool -> CommandCleanup
-cleanup file key hascontent = do
- handle (undo file key) $ do
- link <- calcGitLink file key
- liftIO $ createSymbolicLink link 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
+ 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
+ -- 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 file key hascontent = do
+ link file key hascontent
params <- ifM (Annex.getState Annex.force)
( return [Param "-f"]
, return []