more RawFilePath conversion

Converted file mode setting to it, and follow-on changes.

Compiles up through 369/646.

This commit was sponsored by Ethan Aubin.

Git/Index.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.Index where
 
 import Common
@@ -12,6 +14,8 @@ import Git
 import Utility.Env
 import Utility.Env.Set
 
+import qualified System.FilePath.ByteString as P
+
 indexEnv :: String
 indexEnv = "GIT_INDEX_FILE"
 
@@ -26,8 +30,8 @@ indexEnv = "GIT_INDEX_FILE"
  -
  - So, an absolute path is the only safe option for this to return.
  -}
-indexEnvVal :: FilePath -> IO String
-indexEnvVal p = fromRawFilePath <$> absPath (toRawFilePath p)
+indexEnvVal :: RawFilePath -> IO String
+indexEnvVal p = fromRawFilePath <$> absPath p
 
 {- Forces git to use the specified index file.
  -
@@ -36,7 +40,7 @@ indexEnvVal p = fromRawFilePath <$> absPath (toRawFilePath p)
  -
  - Warning: Not thread safe.
  -}
-override :: FilePath -> Repo -> IO (IO ())
+override :: RawFilePath -> Repo -> IO (IO ())
 override index _r = do
 	res <- getEnv var
 	val <- indexEnvVal index
@@ -48,13 +52,13 @@ override index _r = do
 	reset _ = unsetEnv var
 
 {- The normal index file. Does not check GIT_INDEX_FILE. -}
-indexFile :: Repo -> FilePath
-indexFile r = fromRawFilePath (localGitDir r) </> "index"
+indexFile :: Repo -> RawFilePath
+indexFile r = localGitDir r P.</> "index"
 
 {- The index file git will currently use, checking GIT_INDEX_FILE. -}
-currentIndexFile :: Repo -> IO FilePath
-currentIndexFile r = fromMaybe (indexFile r) <$> getEnv indexEnv	
+currentIndexFile :: Repo -> IO RawFilePath
+currentIndexFile r = maybe (indexFile r) toRawFilePath <$> getEnv indexEnv
 
 {- Git locks the index by creating this file. -}
-indexFileLock :: FilePath -> FilePath
-indexFileLock f = f ++ ".lock"
+indexFileLock :: RawFilePath -> RawFilePath
+indexFileLock f = f <> ".lock"

Git/Objects.hs

@@ -5,39 +5,45 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.Objects where
 
 import Common
 import Git
 import Git.Sha
 
-objectsDir :: Repo -> FilePath
-objectsDir r = fromRawFilePath (localGitDir r) </> "objects"
+import qualified Data.ByteString as B
+import qualified System.FilePath.ByteString as P
 
-packDir :: Repo -> FilePath
-packDir r = objectsDir r </> "pack"
+objectsDir :: Repo -> RawFilePath
+objectsDir r = localGitDir r P.</> "objects"
 
-packIdxFile :: FilePath -> FilePath
-packIdxFile = flip replaceExtension "idx"
+packDir :: Repo -> RawFilePath
+packDir r = objectsDir r P.</> "pack"
+
+packIdxFile :: RawFilePath -> RawFilePath
+packIdxFile = flip P.replaceExtension "idx"
 
 listPackFiles :: Repo -> IO [FilePath]
 listPackFiles r = filter (".pack" `isSuffixOf`) 
-	<$> catchDefaultIO [] (dirContents $ packDir r)
+	<$> catchDefaultIO [] (dirContents $ fromRawFilePath $ packDir r)
 
 listLooseObjectShas :: Repo -> IO [Sha]
 listLooseObjectShas r = catchDefaultIO [] $
 	mapMaybe (extractSha . encodeBS . concat . reverse . take 2 . reverse . splitDirectories)
-		<$> dirContentsRecursiveSkipping (== "pack") True (objectsDir r)
+		<$> dirContentsRecursiveSkipping (== "pack") True (fromRawFilePath (objectsDir r))
 
-looseObjectFile :: Repo -> Sha -> FilePath
-looseObjectFile r sha = objectsDir r </> prefix </> rest
+looseObjectFile :: Repo -> Sha -> RawFilePath
+looseObjectFile r sha = objectsDir r P.</> prefix P.</> rest
   where
-	(prefix, rest) = splitAt 2 (fromRef sha)
+	(prefix, rest) = B.splitAt 2 (fromRef' sha)
 
 listAlternates :: Repo -> IO [FilePath]
-listAlternates r = catchDefaultIO [] (lines <$> readFile alternatesfile)
+listAlternates r = catchDefaultIO [] $
+	lines <$> readFile (fromRawFilePath alternatesfile)
   where
-	alternatesfile = objectsDir r </> "info" </> "alternates"
+	alternatesfile = objectsDir r P.</> "info" P.</> "alternates"
 
 {- A repository recently cloned with --shared will have one or more
  - alternates listed, and contain no loose objects or packs. -}

Git/Repair.hs

@@ -53,9 +53,9 @@ cleanCorruptObjects fsckresults r = do
 	mapM_ removeLoose (S.toList $ knownMissing fsckresults)
 	mapM_ removeBad =<< listLooseObjectShas r
   where
-	removeLoose s = removeWhenExistsWith removeLink (looseObjectFile r s)
+	removeLoose s = removeWhenExistsWith R.removeLink (looseObjectFile r s)
 	removeBad s = do
-		void $ tryIO $ allowRead $  looseObjectFile r s
+		void $ tryIO $ allowRead $ looseObjectFile r s
 		whenM (isMissing s r) $
 			removeLoose s
 
@@ -79,10 +79,11 @@ explodePacks r = go =<< listPackFiles r
 		putStrLn "Unpacking all pack files."
 		forM_ packs $ \packfile -> do
 			moveFile packfile (tmpdir </> takeFileName packfile)
-			removeWhenExistsWith removeLink $ packIdxFile packfile
+			removeWhenExistsWith R.removeLink
+				(packIdxFile (toRawFilePath packfile))
 		forM_ packs $ \packfile -> do
 			let tmp = tmpdir </> takeFileName packfile
-			allowRead tmp
+			allowRead (toRawFilePath tmp)
 			-- May fail, if pack file is corrupt.
 			void $ tryIO $
 				pipeWrite [Param "unpack-objects", Param "-r"] r $ \h ->
@@ -163,8 +164,8 @@ retrieveMissingObjects missing referencerepo r
 copyObjects :: Repo -> Repo -> IO Bool
 copyObjects srcr destr = rsync
 	[ Param "-qr"
-	, File $ addTrailingPathSeparator $ objectsDir srcr
-	, File $ addTrailingPathSeparator $ objectsDir destr
+	, File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir srcr
+	, File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir destr
 	]
 
 {- To deal with missing objects that cannot be recovered, resets any
@@ -395,7 +396,7 @@ rewriteIndex r
 	| otherwise = do
 		(bad, good, cleanup) <- partitionIndex r
 		unless (null bad) $ do
-			removeWhenExistsWith removeLink (indexFile r)
+			removeWhenExistsWith R.removeLink (indexFile r)
 			UpdateIndex.streamUpdateIndex r
 				=<< (catMaybes <$> mapM reinject good)
 		void cleanup
@@ -446,9 +447,8 @@ preRepair g = do
 		removeWhenExistsWith removeLink headfile
 		writeFile headfile "ref: refs/heads/master"
 	explodePackedRefsFile g
-	unless (repoIsLocalBare g) $ do
-		let f = indexFile g
-		void $ tryIO $ allowWrite f
+	unless (repoIsLocalBare g) $
+		void $ tryIO $ allowWrite $ indexFile g
   where
 	headfile = fromRawFilePath (localGitDir g) </> "HEAD"
 	validhead s = "ref: refs/" `isPrefixOf` s
@@ -572,7 +572,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do
 			else successfulfinish modifiedbranches
 
 	corruptedindex = do
-		removeWhenExistsWith removeLink (indexFile g)
+		removeWhenExistsWith R.removeLink (indexFile g)
 		-- The corrupted index can prevent fsck from finding other
 		-- problems, so re-run repair.
 		fsckresult' <- findBroken False g
@@ -618,5 +618,5 @@ successfulRepair = fst
 
 safeReadFile :: FilePath -> IO String
 safeReadFile f = do
-	allowRead f
+	allowRead (toRawFilePath f)
 	readFileStrict f