summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-01-27 17:00:32 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-01-27 17:00:32 -0400
commit167523f09d48777f3a5931fdcbc21b9d363e0e6c (patch)
tree698c1c601b39b617ccc02259053c3c39372ed5db
parent6be516ae3bddb8f05ea62661019836e03be12a2c (diff)
better directory handling
Rename Locations functions for better consitency, and make their values more consistent too. Used </> rather than manually building paths. There are still more places that manually do so, but are tricky, due to the behavior of </> when the second FilePath is absolute. So I only changed places where it obviously was relative.
-rw-r--r--Backend/File.hs2
-rw-r--r--Backend/SHA1.hs2
-rw-r--r--Backend/WORM.hs2
-rw-r--r--CmdLine.hs2
-rw-r--r--Command.hs2
-rw-r--r--Command/DropUnused.hs2
-rw-r--r--Command/Init.hs3
-rw-r--r--Command/Migrate.hs2
-rw-r--r--Command/SendKey.hs2
-rw-r--r--Command/Unlock.hs2
-rw-r--r--Command/Unused.hs2
-rw-r--r--Content.hs20
-rw-r--r--Locations.hs74
-rw-r--r--Remotes.hs6
-rw-r--r--Upgrade.hs4
-rw-r--r--Version.hs8
16 files changed, 78 insertions, 57 deletions
diff --git a/Backend/File.hs b/Backend/File.hs
index 35cbc0191..68dd4db27 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -77,7 +77,7 @@ copyKeyFile key file = do
-- before going on to the next remote.)
probablyPresent r =
if not $ Git.repoIsUrl r
- then liftIO $ doesFileExist $ annexLocation r key
+ then liftIO $ doesFileExist $ gitAnnexLocation r key
else return True
docopy r continue = do
showNote $ "copying from " ++ Git.repoDescribe r ++ "..."
diff --git a/Backend/SHA1.hs b/Backend/SHA1.hs
index f8dbea4b0..3d868dbd1 100644
--- a/Backend/SHA1.hs
+++ b/Backend/SHA1.hs
@@ -48,7 +48,7 @@ keyValue file = do
checkKeySHA1 :: Key -> Annex Bool
checkKeySHA1 key = do
g <- Annex.gitRepo
- let file = annexLocation g key
+ let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file
if not present
then return True
diff --git a/Backend/WORM.hs b/Backend/WORM.hs
index 56f243396..20a81d841 100644
--- a/Backend/WORM.hs
+++ b/Backend/WORM.hs
@@ -57,7 +57,7 @@ keySize key = read $ section !! 1
checkKeySize :: Key -> Annex Bool
checkKeySize key = do
g <- Annex.gitRepo
- let file = annexLocation g key
+ let file = gitAnnexLocation g key
present <- liftIO $ doesFileExist file
if not present
then return True
diff --git a/CmdLine.hs b/CmdLine.hs
index 76402a821..68d1e0dd3 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -111,7 +111,7 @@ shutdown errnum = do
-- are left behind to allow resuming on re-run.
when (errnum == 0) $ do
g <- Annex.gitRepo
- let tmp = annexTmpLocation g
+ let tmp = gitAnnexTmpDir g
exists <- liftIO $ doesDirectoryExist tmp
when exists $ liftIO $ removeDirectoryRecursive tmp
liftIO $ createDirectoryIfMissing True tmp
diff --git a/Command.hs b/Command.hs
index bedb18cc9..bebbf3f1b 100644
--- a/Command.hs
+++ b/Command.hs
@@ -187,7 +187,7 @@ filterFiles l = do
let regexp = compile (toregex exclude) []
return $ filter (notExcluded regexp) l'
where
- notState f = not $ isPrefixOf stateLoc f
+ notState f = not $ isPrefixOf stateDir f
notExcluded r f = case match r f [] of
Nothing -> True
Just _ -> False
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index cfd6fc3d0..9427f8103 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -40,7 +40,7 @@ start s = do
readUnusedLog :: Annex (M.Map String Key)
readUnusedLog = do
g <- Annex.gitRepo
- let f = annexUnusedLog g
+ let f = gitAnnexUnusedLog g
e <- liftIO $ doesFileExist f
if e
then do
diff --git a/Command/Init.hs b/Command/Init.hs
index 47ac8e4c0..e780c8863 100644
--- a/Command/Init.hs
+++ b/Command/Init.hs
@@ -10,6 +10,7 @@ module Command.Init where
import Control.Monad.State (liftIO)
import Control.Monad (when)
import System.Directory
+import System.FilePath
import Command
import qualified Annex
@@ -75,7 +76,7 @@ gitAttributesWrite repo = do
attributes]
attrLine :: String
-attrLine = stateLoc ++ "*.log merge=union"
+attrLine = stateDir </> "*.log merge=union"
{- set up a git pre-commit hook, if one is not already present -}
gitPreCommitHookWrite :: Git.Repo -> Annex ()
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index 566b508c0..c0e80c5b4 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -50,7 +50,7 @@ perform file oldkey newbackend = do
-- (the file can't be stored as usual, because it's already a symlink).
-- The old backend's key is not dropped from it, because there may
-- be other files still pointing at that key.
- let src = annexLocation g oldkey
+ let src = gitAnnexLocation g oldkey
stored <- Backend.storeFileKey src $ Just newbackend
case stored of
Nothing -> return Nothing
diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index aaa0b4836..cb883b53a 100644
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -32,7 +32,7 @@ start keyname = do
let key = genKey (head backends) keyname
present <- inAnnex key
g <- Annex.gitRepo
- let file = annexLocation g key
+ let file = gitAnnexLocation g key
when present $
liftIO $ rsyncServerSend file
liftIO exitFailure
diff --git a/Command/Unlock.hs b/Command/Unlock.hs
index 645fac8a2..bd1021cc3 100644
--- a/Command/Unlock.hs
+++ b/Command/Unlock.hs
@@ -43,7 +43,7 @@ perform dest key = do
error "content not present"
g <- Annex.gitRepo
- let src = annexLocation g key
+ let src = gitAnnexLocation g key
liftIO $ removeFile dest
showNote "copying..."
ok <- liftIO $ copyFile src dest
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 9fdf4cda6..5e5698e38 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -43,7 +43,7 @@ checkUnused = do
unused <- unusedKeys
let list = number 1 unused
g <- Annex.gitRepo
- liftIO $ writeFile (annexUnusedLog g) $ unlines $
+ liftIO $ writeFile (gitAnnexUnusedLog g) $ unlines $
map (\(n, k) -> show n ++ " " ++ show k) list
if null unused
then return True
diff --git a/Content.hs b/Content.hs
index 0cbd6905c..d0ed8d861 100644
--- a/Content.hs
+++ b/Content.hs
@@ -35,12 +35,12 @@ import qualified GitRepo as Git
import qualified Annex
import Utility
-{- Checks if a given key is currently present in the annexLocation. -}
+{- Checks if a given key is currently present in the gitAnnexLocation. -}
inAnnex :: Key -> Annex Bool
inAnnex key = do
g <- Annex.gitRepo
when (Git.repoIsUrl g) $ error "inAnnex cannot check remote repo"
- liftIO $ doesFileExist $ annexLocation g key
+ liftIO $ doesFileExist $ gitAnnexLocation g key
{- Calculates the relative path to use to link a file to a key. -}
calcGitLink :: FilePath -> Key -> Annex FilePath
@@ -51,7 +51,7 @@ calcGitLink file key = do
Just f -> f
Nothing -> error $ "unable to normalize " ++ file
return $ relPathDirToDir (parentDir absfile) (Git.workTree g) ++
- annexLocationRelative key
+ annexLocation key
{- Updates the LocationLog when a key's presence changes. -}
logStatus :: Key -> LogStatus -> Annex ()
@@ -67,7 +67,7 @@ logStatus key status = do
getViaTmp :: Key -> (FilePath -> Annex Bool) -> Annex Bool
getViaTmp key action = do
g <- Annex.gitRepo
- let tmp = annexTmpLocation g ++ keyFile key
+ let tmp = gitAnnexTmpDir g </> keyFile key
liftIO $ createDirectoryIfMissing True (parentDir tmp)
success <- action tmp
if success
@@ -97,7 +97,7 @@ allowWrite f = do
moveAnnex :: Key -> FilePath -> Annex ()
moveAnnex key src = do
g <- Annex.gitRepo
- let dest = annexLocation g key
+ let dest = gitAnnexLocation g key
let dir = parentDir dest
liftIO $ do
createDirectoryIfMissing True dir
@@ -110,7 +110,7 @@ moveAnnex key src = do
removeAnnex :: Key -> Annex ()
removeAnnex key = do
g <- Annex.gitRepo
- let file = annexLocation g key
+ let file = gitAnnexLocation g key
let dir = parentDir file
liftIO $ do
allowWrite dir
@@ -121,7 +121,7 @@ removeAnnex key = do
fromAnnex :: Key -> FilePath -> Annex ()
fromAnnex key dest = do
g <- Annex.gitRepo
- let file = annexLocation g key
+ let file = gitAnnexLocation g key
let dir = parentDir file
liftIO $ do
allowWrite dir
@@ -134,8 +134,8 @@ fromAnnex key dest = do
moveBad :: Key -> Annex FilePath
moveBad key = do
g <- Annex.gitRepo
- let src = annexLocation g key
- let dest = annexBadLocation g ++ takeFileName src
+ let src = gitAnnexLocation g key
+ let dest = gitAnnexBadDir g </> takeFileName src
liftIO $ createDirectoryIfMissing True (parentDir dest)
liftIO $ allowWrite (parentDir src)
liftIO $ renameFile src dest
@@ -146,7 +146,7 @@ moveBad key = do
getKeysPresent :: Annex [Key]
getKeysPresent = do
g <- Annex.gitRepo
- getKeysPresent' $ annexObjectDir g
+ getKeysPresent' $ gitAnnexObjectDir g
getKeysPresent' :: FilePath -> Annex [Key]
getKeysPresent' dir = do
exists <- liftIO $ doesDirectoryExist dir
diff --git a/Locations.hs b/Locations.hs
index 327c099e3..b2624754e 100644
--- a/Locations.hs
+++ b/Locations.hs
@@ -7,73 +7,93 @@
module Locations (
gitStateDir,
- stateLoc,
+ stateDir,
keyFile,
fileKey,
+ gitAnnexLocation,
annexLocation,
- annexLocationRelative,
- annexTmpLocation,
- annexBadLocation,
- annexUnusedLog,
+ gitAnnexDir,
+ gitAnnexObjectDir,
+ gitAnnexTmpDir,
+ gitAnnexBadDir,
+ gitAnnexUnusedLog,
isLinkToAnnex,
- annexDir,
- annexObjectDir,
prop_idempotent_fileKey
) where
+import System.FilePath
import Data.String.Utils
import Data.List
import Types
import qualified GitRepo as Git
+{- Conventions:
+ -
+ - Functions ending in "Dir" should always return values ending with a
+ - trailing path separator. Most code does not rely on that, but a few
+ - things do.
+ -
+ - Everything else should not end in a trailing path sepatator.
+ -
+ - Only functions (with names starting with "git") that build a path
+ - based on a git repository should return an absolute path.
+ - Everything else should use relative paths.
+ -}
+
{- Long-term, cross-repo state is stored in files inside the .git-annex
- directory, in the git repository's working tree. -}
-stateLoc :: String
-stateLoc = ".git-annex/"
+stateDir :: FilePath
+stateDir = addTrailingPathSeparator $ ".git-annex"
gitStateDir :: Git.Repo -> FilePath
-gitStateDir repo = Git.workTree repo ++ "/" ++ stateLoc
+gitStateDir repo = addTrailingPathSeparator $ Git.workTree repo </> stateDir
-{- Annexed file's absolute location. -}
-annexLocation :: Git.Repo -> Key -> FilePath
-annexLocation r key =
- Git.workTree r ++ "/" ++ annexLocationRelative key
+{- Annexed content is stored in .git/annex/objects; .git/annex is used
+ - for other temporary storage also. -}
+annexDir :: FilePath
+annexDir = addTrailingPathSeparator $ ".git/annex"
+objectDir :: FilePath
+objectDir = addTrailingPathSeparator $ annexDir </> "objects"
{- Annexed file's location relative to git's working tree.
-
- Note: Assumes repo is NOT bare.-}
-annexLocationRelative :: Key -> FilePath
-annexLocationRelative key = ".git/annex/objects/" ++ f ++ "/" ++ f
+annexLocation :: Key -> FilePath
+annexLocation key = ".git/annex/objects" </> f </> f
where
f = keyFile key
+{- Annexed file's absolute location in a repository. -}
+gitAnnexLocation :: Git.Repo -> Key -> FilePath
+gitAnnexLocation r key = Git.workTree r </> annexLocation key
+
{- The annex directory of a repository.
-
- Note: Assumes repo is NOT bare. -}
-annexDir :: Git.Repo -> FilePath
-annexDir r = Git.workTree r ++ "/.git/annex"
+gitAnnexDir :: Git.Repo -> FilePath
+gitAnnexDir r = addTrailingPathSeparator $ Git.workTree r </> annexDir
{- The part of the annex directory where file contents are stored.
-}
-annexObjectDir :: Git.Repo -> FilePath
-annexObjectDir r = annexDir r ++ "/objects"
+gitAnnexObjectDir :: Git.Repo -> FilePath
+gitAnnexObjectDir r = addTrailingPathSeparator $ Git.workTree r </> objectDir
{- .git-annex/tmp/ is used for temp files -}
-annexTmpLocation :: Git.Repo -> FilePath
-annexTmpLocation r = annexDir r ++ "/tmp/"
+gitAnnexTmpDir :: Git.Repo -> FilePath
+gitAnnexTmpDir r = addTrailingPathSeparator $ gitAnnexDir r </> "tmp"
{- .git-annex/bad/ is used for bad files found during fsck -}
-annexBadLocation :: Git.Repo -> FilePath
-annexBadLocation r = annexDir r ++ "/bad/"
+gitAnnexBadDir :: Git.Repo -> FilePath
+gitAnnexBadDir r = addTrailingPathSeparator $ gitAnnexDir r </> "bad"
{- .git/annex/unused is used to number possibly unused keys -}
-annexUnusedLog :: Git.Repo -> FilePath
-annexUnusedLog r = annexDir r ++ "/unused"
+gitAnnexUnusedLog :: Git.Repo -> FilePath
+gitAnnexUnusedLog r = gitAnnexDir r </> "unused"
{- Checks a symlink target to see if it appears to point to annexed content. -}
isLinkToAnnex :: FilePath -> Bool
-isLinkToAnnex s = isInfixOf "/.git/annex/objects/" s
+isLinkToAnnex s = isInfixOf ("/" ++ objectDir) s
{- Converts a key into a filename fragment.
-
diff --git a/Remotes.hs b/Remotes.hs
index be4c1383a..616db225e 100644
--- a/Remotes.hs
+++ b/Remotes.hs
@@ -225,7 +225,7 @@ byName name = do
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool
copyFromRemote r key file
- | not $ Git.repoIsUrl r = liftIO $ copyFile (annexLocation r key) file
+ | not $ Git.repoIsUrl r = liftIO $ copyFile (gitAnnexLocation r key) file
| Git.repoIsSsh r = rsynchelper r True key file
| otherwise = error "copying from non-ssh repo not supported"
@@ -234,7 +234,7 @@ copyToRemote :: Git.Repo -> Key -> Annex Bool
copyToRemote r key
| not $ Git.repoIsUrl r = do
g <- Annex.gitRepo
- let keysrc = annexLocation g key
+ let keysrc = gitAnnexLocation g key
-- run copy from perspective of remote
liftIO $ do
a <- Annex.new r []
@@ -245,7 +245,7 @@ copyToRemote r key
return ok
| Git.repoIsSsh r = do
g <- Annex.gitRepo
- let keysrc = annexLocation g key
+ let keysrc = gitAnnexLocation g key
rsynchelper r False key keysrc
| otherwise = error "copying to non-ssh repo not supported"
diff --git a/Upgrade.hs b/Upgrade.hs
index 596d525db..1e70e68d5 100644
--- a/Upgrade.hs
+++ b/Upgrade.hs
@@ -39,9 +39,9 @@ upgradeFrom0 = do
g <- Annex.gitRepo
-- do the reorganisation of the files
- let olddir = annexDir g
+ let olddir = gitAnnexDir g
keys <- getKeysPresent0' olddir
- _ <- mapM (\k -> moveAnnex k $ olddir ++ "/" ++ keyFile k) keys
+ _ <- mapM (\k -> moveAnnex k $ olddir </> keyFile k) keys
-- update the symlinks to the files
files <- liftIO $ Git.inRepo g [Git.workTree g]
diff --git a/Version.hs b/Version.hs
index fc1ce3d7e..9e31d3c9e 100644
--- a/Version.hs
+++ b/Version.hs
@@ -29,10 +29,10 @@ getVersion = do
then return $ Just v
else do
-- version 0 was not recorded in .git/config;
- -- such a repo should have an annexDir but no
- -- annexObjectDir
- d <- liftIO $ doesDirectoryExist $ annexDir g
- o <- liftIO $ doesDirectoryExist $ annexObjectDir g
+ -- such a repo should have an gitAnnexDir but no
+ -- gitAnnexObjectDir
+ d <- liftIO $ doesDirectoryExist $ gitAnnexDir g
+ o <- liftIO $ doesDirectoryExist $ gitAnnexObjectDir g
if d && not o
then return $ Just "0"
else return Nothing -- no version yet