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.

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 ++ "..."

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

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

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

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

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

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 ()

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

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

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

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

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 src = gitAnnexLocation g key
-	let dest = annexBadLocation g ++ takeFileName src
+	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

Locations.hs

@@ -7,73 +7,93 @@
 
 module Locations (
 	gitStateDir,
-	stateLoc,
+	stateDir,
 	keyFile,
 	fileKey,
+	gitAnnexLocation,
 	annexLocation,
-	annexLocationRelative,
+	gitAnnexDir,
-	annexTmpLocation,
+	gitAnnexObjectDir,
-	annexBadLocation,
+	gitAnnexTmpDir,
-	annexUnusedLog,
+	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
+stateDir :: FilePath
-stateLoc = ".git-annex/"
+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. -}
+{- Annexed content is stored in .git/annex/objects; .git/annex is used
-annexLocation :: Git.Repo -> Key -> FilePath
+ - for other temporary storage also. -}
-annexLocation r key = 
+annexDir :: FilePath
-	Git.workTree r ++ "/" ++ annexLocationRelative key
+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
+annexLocation :: Key -> FilePath
-annexLocationRelative key = ".git/annex/objects/" ++ f ++ "/" ++ f
+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
+gitAnnexDir :: Git.Repo -> FilePath
-annexDir r = Git.workTree r ++ "/.git/annex"
+gitAnnexDir r = addTrailingPathSeparator $ Git.workTree r </> annexDir
 
 {- The part of the annex directory where file contents are stored.
  -}
-annexObjectDir :: Git.Repo -> FilePath
+gitAnnexObjectDir :: Git.Repo -> FilePath
-annexObjectDir r = annexDir r ++ "/objects"
+gitAnnexObjectDir r = addTrailingPathSeparator $ Git.workTree r </> objectDir
 
 {- .git-annex/tmp/ is used for temp files -}
-annexTmpLocation :: Git.Repo -> FilePath
+gitAnnexTmpDir :: Git.Repo -> FilePath
-annexTmpLocation r = annexDir r ++ "/tmp/"
+gitAnnexTmpDir r = addTrailingPathSeparator $ gitAnnexDir r </> "tmp"
 
 {- .git-annex/bad/ is used for bad files found during fsck -}
-annexBadLocation :: Git.Repo -> FilePath
+gitAnnexBadDir :: Git.Repo -> FilePath
-annexBadLocation r = annexDir r ++ "/bad/"
+gitAnnexBadDir r = addTrailingPathSeparator $ gitAnnexDir r </> "bad"
 
 {- .git/annex/unused is used to number possibly unused keys -}
-annexUnusedLog :: Git.Repo -> FilePath
+gitAnnexUnusedLog :: Git.Repo -> FilePath
-annexUnusedLog r = annexDir r ++ "/unused"
+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.
  -

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"
 

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]

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
+			-- such a repo should have an gitAnnexDir but no
-			-- annexObjectDir
+			-- gitAnnexObjectDir
-			d <- liftIO $ doesDirectoryExist $ annexDir g
+			d <- liftIO $ doesDirectoryExist $ gitAnnexDir g
-			o <- liftIO $ doesDirectoryExist $ annexObjectDir g
+			o <- liftIO $ doesDirectoryExist $ gitAnnexObjectDir g
 			if d && not o
 				then return $ Just "0"
 				else return Nothing -- no version yet