summaryrefslogtreecommitdiff
path: root/Annex.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-12 20:04:36 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-12 20:04:36 -0400
commitb7858ada038084c8455cdf9d3598382308dc52b3 (patch)
tree373fec9662eb3b7c592dc28ccd301473fb3ce1a2 /Annex.hs
parent476f66abb99ad2baa18b699c26ac9ee7250eca76 (diff)
bugfixes
Diffstat (limited to 'Annex.hs')
-rw-r--r--Annex.hs51
1 files changed, 32 insertions, 19 deletions
diff --git a/Annex.hs b/Annex.hs
index 29cd7b0fd..b8e70e6c8 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -24,15 +24,6 @@ import UUID
import LocationLog
import Types
-{- An annexed file's content is stored somewhere under .git/annex/,
- - based on the key. Since the symlink is user-visible, the filename
- - used should be as close to the key as possible, in case the key is a
- - filename or url. Just escape "/" in the key name, to keep a flat
- - tree of files and avoid issues with files ending with "/" etc. -}
-annexLocation :: State -> Key -> FilePath
-annexLocation state key = gitDir (repo state) ++ "/annex/" ++ (transform key)
- where transform s = replace "/" "%" $ replace "%" "%%" s
-
{- Checks if a given key is currently present in the annexLocation -}
inAnnex :: State -> Key -> IO Bool
inAnnex state key = doesFileExist $ annexLocation state key
@@ -62,15 +53,18 @@ annexFile state file = do
stored <- storeFile state file
case (stored) of
Nothing -> error $ "no backend could store: " ++ file
- Just key -> symlink key
+ Just (key, backend) -> setup key backend
where
- symlink key = do
+ setup key backend = do
let dest = annexLocation state key
createDirectoryIfMissing True (parentDir dest)
renameFile file dest
- logChange (repo state) file (getUUID (repo state)) FilePresent
createSymbolicLink dest file
- gitAdd (repo state) file
+ gitRun (repo state) ["add", file, bfile]
+ gitRun (repo state) ["commit", "-m",
+ ("git-annex annexed " ++ file), file, bfile]
+ logStatus state key ValuePresent
+ where bfile = backendFile state backend file
checkLegal file = do
s <- getSymbolicLinkStatus file
if ((isSymbolicLink s) || (not $ isRegularFile s))
@@ -87,11 +81,17 @@ unannexFile state file = do
mkey <- dropFile state file
case (mkey) of
Nothing -> return ()
- Just key -> do
+ Just (key, backend) -> do
let src = annexLocation state key
removeFile file
+ gitRun (repo state) ["rm", file, bfile]
+ gitRun (repo state) ["commit", "-m",
+ ("git-annex unannexed " ++ file),
+ file, bfile]
renameFile src file
+ logStatus state key ValueMissing
return ()
+ where bfile = backendFile state backend file
{- Transfers the file from a remote. -}
annexGetFile :: State -> FilePath -> IO ()
@@ -109,7 +109,9 @@ annexGetFile state file = do
createDirectoryIfMissing True (parentDir dest)
success <- retrieveFile state file dest
if (success)
- then return ()
+ then do
+ logStatus state key ValuePresent
+ return ()
else error $ "failed to get " ++ file
{- Indicates a file is wanted. -}
@@ -132,17 +134,28 @@ annexPullRepo state reponame = do error "not implemented" -- TODO
gitPrep :: GitRepo -> IO ()
gitPrep repo = do
-- configure git to use union merge driver on state files
- let attrLine = stateLoc ++ "/*.log merge=union"
- let attributes = gitAttributes repo
exists <- doesFileExist attributes
if (not exists)
then do
writeFile attributes $ attrLine ++ "\n"
- gitAdd repo attributes
+ commit
else do
content <- readFile attributes
if (all (/= attrLine) (lines content))
then do
appendFile attributes $ attrLine ++ "\n"
- gitAdd repo attributes
+ commit
else return ()
+ where
+ attrLine = stateLoc ++ "/*.log merge=union"
+ attributes = gitAttributes repo
+ commit = do
+ gitRun repo ["add", attributes]
+ gitRun repo ["commit", "-m", "git-annex setup",
+ attributes]
+
+{- Updates the LocationLog when a key's presence changes. -}
+logStatus state key status = do
+ f <- logChange (repo state) key (getUUID (repo state)) status
+ gitRun (repo state) ["add", f]
+ gitRun (repo state) ["commit", "-m", "git-annex log update", f]