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 GitRepo
|
||||||
import Utility
|
import Utility
|
||||||
|
|
||||||
{- An annexed file's content is stored in .git/annex/. -}
|
{- An annexed file's content is stored somewhere under .git/annex/ -}
|
||||||
annexedFileLocation repo file = do
|
annexLoc repo key = do
|
||||||
dir <- gitDir repo
|
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
|
{- Annexes a file, storing it in a backend, and then moving it into
|
||||||
- the annex directory and setting up the symlink pointing to its
|
- the annex directory and setting up the symlink pointing to its content. -}
|
||||||
- content. -}
|
|
||||||
annexFile :: [Backend] -> GitRepo -> FilePath -> IO ()
|
annexFile :: [Backend] -> GitRepo -> FilePath -> IO ()
|
||||||
annexFile backends repo file = do
|
annexFile backends repo file = do
|
||||||
alreadyannexed <- lookupBackend backends repo file
|
alreadyannexed <- lookupBackend backends repo file
|
||||||
|
@ -24,12 +23,12 @@ annexFile backends repo file = do
|
||||||
Just _ -> error $ "already annexed " ++ file
|
Just _ -> error $ "already annexed " ++ file
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
stored <- storeFile backends repo file
|
stored <- storeFile backends repo file
|
||||||
if (not stored)
|
case (stored) of
|
||||||
then error $ "no backend could store " ++ file
|
Nothing -> error $ "no backend could store " ++ file
|
||||||
else symlink
|
Just key -> symlink key
|
||||||
where
|
where
|
||||||
symlink = do
|
symlink key = do
|
||||||
dest <- annexedFileLocation repo file
|
dest <- annexLoc repo key
|
||||||
createDirectoryIfMissing True (parentDir dest)
|
createDirectoryIfMissing True (parentDir dest)
|
||||||
renameFile file dest
|
renameFile file dest
|
||||||
createSymbolicLink dest file
|
createSymbolicLink dest file
|
||||||
|
|
24
Backend.hs
24
Backend.hs
|
@ -44,21 +44,29 @@ backendFile :: Backend -> GitRepo -> FilePath -> String
|
||||||
backendFile backend repo file = gitStateDir repo ++
|
backendFile backend repo file = gitStateDir repo ++
|
||||||
(gitRelative repo file) ++ "." ++ (name backend)
|
(gitRelative repo file) ++ "." ++ (name backend)
|
||||||
|
|
||||||
{- Attempts to Stores a file in one of the backends. -}
|
{- Attempts to store a file in one of the backends, and returns
|
||||||
storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Bool)
|
- its key. -}
|
||||||
storeFile [] _ _ = return False
|
storeFile :: [Backend] -> GitRepo -> FilePath -> IO (Maybe Key)
|
||||||
|
storeFile [] _ _ = return Nothing
|
||||||
storeFile (b:bs) repo file = do
|
storeFile (b:bs) repo file = do
|
||||||
try <- (getKey b) (gitRelative repo file)
|
try <- (getKey b) (gitRelative repo file)
|
||||||
case (try) of
|
case (try) of
|
||||||
Nothing -> storeFile bs repo file
|
Nothing -> nextbackend
|
||||||
Just key -> do
|
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)
|
createDirectoryIfMissing True (parentDir backendfile)
|
||||||
writeFile backendfile key
|
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. -}
|
- a specified location. -}
|
||||||
retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO (Bool)
|
retrieveFile :: [Backend] -> GitRepo -> FilePath -> FilePath -> IO (Bool)
|
||||||
retrieveFile backends repo file dest = do
|
retrieveFile backends repo file dest = do
|
||||||
|
|
Loading…
Reference in a new issue