split out utility functions
This commit is contained in:
parent
4b32ea793d
commit
723eb19bbf
1 changed files with 33 additions and 19 deletions
|
@ -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 []
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue