fix storing files in .git/annex by key
This commit is contained in:
parent
cc23519235
commit
4631927a5c
2 changed files with 25 additions and 18 deletions
19
Annex.hs
19
Annex.hs
|
@ -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
|
||||
|
|
24
Backend.hs
24
Backend.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue