summaryrefslogtreecommitdiff
path: root/Annex.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2010-10-13 03:30:51 -0400
committerGravatar Joey Hess <joey@kitenet.net>2010-10-13 03:30:51 -0400
commitcc5cf0093ea1aacc4c5460dfdd4d35f2963687bd (patch)
treeef7ccfa0a6bed6b76c2d88c82c40dfdaac32ba4e /Annex.hs
parent4b801b265afa94b1219a1abb6e52e08e0790582a (diff)
cleanup
Diffstat (limited to 'Annex.hs')
-rw-r--r--Annex.hs64
1 files changed, 33 insertions, 31 deletions
diff --git a/Annex.hs b/Annex.hs
index 30ec0843a..7cee3c4cb 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -41,20 +41,24 @@ startAnnex = do
backends = parseBackendList $ gitConfig r' "annex.backends" ""
}
+inBackend file yes no = do
+ r <- lookupFile file
+ case (r) of
+ Just v -> yes v
+ Nothing -> no
+notinBackend file yes no = inBackend file no yes
+
{- 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. -}
annexFile :: State -> FilePath -> IO ()
-annexFile state file = do
- r <- lookupFile file
- case (r) of
- Just _ -> error $ "already annexed " ++ file
- Nothing -> do
- checkLegal file
- stored <- storeFile state file
- case (stored) of
- Nothing -> error $ "no backend could store: " ++ file
- Just (key, backend) -> setup key backend
+annexFile state file = inBackend file err $ do
+ checkLegal file
+ stored <- storeFile state file
+ case (stored) of
+ Nothing -> error $ "no backend could store: " ++ file
+ Just (key, backend) -> setup key backend
where
+ err = error $ "already annexed " ++ file
checkLegal file = do
s <- getSymbolicLinkStatus file
if ((isSymbolicLink s) || (not $ isRegularFile s))
@@ -82,27 +86,25 @@ annexFile state file = do
{- Inverse of annexFile. -}
unannexFile :: State -> FilePath -> IO ()
-unannexFile state file = do
- r <- lookupFile file
- case (r) of
- Nothing -> error $ "not annexed " ++ file
- Just (key, backend) -> do
- dropped <- dropFile state backend key
- if (not dropped)
- then error $ "backend refused to drop " ++ file
- else do
- let src = annexLocation state backend key
- removeFile file
- gitRun (repo state) ["rm", file]
- gitRun (repo state) ["commit", "-m",
- ("git-annex unannexed " ++ file),
- file]
- -- git rm deletes empty directories;
- -- put them back
- createDirectoryIfMissing True (parentDir file)
- renameFile src file
- logStatus state key ValueMissing
- return ()
+unannexFile state file = notinBackend file err $ \(key, backend) -> do
+ dropped <- dropFile state backend key
+ if (not dropped)
+ then error $ "backend refused to drop " ++ file
+ else cleanup key backend
+ where
+ err = error $ "not annexed " ++ file
+ cleanup key backend = do
+ let src = annexLocation state backend key
+ removeFile file
+ gitRun (repo state) ["rm", file]
+ gitRun (repo state) ["commit", "-m",
+ ("git-annex unannexed " ++ file), file]
+ -- git rm deletes empty directories;
+ -- put them back
+ createDirectoryIfMissing True (parentDir file)
+ renameFile src file
+ logStatus state key ValueMissing
+ return ()
{- Transfers the file from a remote. -}
annexGetFile :: State -> FilePath -> IO ()