fix storing files in .git/annex by key

This commit is contained in:
Joey Hess 2010-10-10 15:21:17 -04:00
parent cc23519235
commit 4631927a5c
2 changed files with 25 additions and 18 deletions

View file

@ -9,14 +9,13 @@ import System.Directory
import GitRepo
import Utility
{- An annexed file's content is stored in .git/annex/. -}
annexedFileLocation repo file = do
{- An annexed file's content is stored somewhere under .git/annex/ -}
annexLoc repo key = do
dir <- gitDir repo
return $ dir ++ "/annex/" ++ (gitRelative repo file)
return $ dir ++ "/annex/" ++ key
{- Annexes a file, storing it in a backend, and then moving it into
- the annex directory and setting up the symlink pointing to its
- content. -}
- the annex directory and setting up the symlink pointing to its content. -}
annexFile :: [Backend] -> GitRepo -> FilePath -> IO ()
annexFile backends repo file = do
alreadyannexed <- lookupBackend backends repo file
@ -24,12 +23,12 @@ annexFile backends repo file = do
Just _ -> error $ "already annexed " ++ file
Nothing -> do
stored <- storeFile backends repo file
if (not stored)
then error $ "no backend could store " ++ file
else symlink
case (stored) of
Nothing -> error $ "no backend could store " ++ file
Just key -> symlink key
where
symlink = do
dest <- annexedFileLocation repo file
symlink key = do
dest <- annexLoc repo key
createDirectoryIfMissing True (parentDir dest)
renameFile file dest
createSymbolicLink dest file

View file

@ -44,21 +44,29 @@ backendFile :: Backend -> GitRepo -> FilePath -> String
backendFile backend repo file = gitStateDir repo ++
(gitRelative repo file) ++ "." ++ (name backend)
{- Attempts to Stores a file in one of the backends. -}
storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool)
storeFile [] _ _ = return False
{- Attempts to store a file in one of the backends, and returns
- its key. -}
storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key)
storeFile [] _ _ = return Nothing
storeFile (b:bs) repo file = do
try <- (getKey b) (gitRelative repo file)
case (try) of
Nothing -> storeFile bs repo file
Nothing -> nextbackend
Just key -> do
(storeFileKey b) file key
stored <- (storeFileKey b) file key
if (not stored)
then nextbackend
else do
bookkeeping key
return $ Just key
where
nextbackend = storeFile bs repo file
backendfile = backendFile b repo file
bookkeeping key = do
createDirectoryIfMissing True (parentDir backendfile)
writeFile backendfile key
return True
where backendfile = backendFile b repo file
{- Attempts to retrieve an file from one of the backends, saving it to
{- Attempts to retrieve an file from one of the backends, saving it to
- a specified location. -}
retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO (Bool)
retrieveFile backends repo file dest = do