more RawFilePath conversion

Most of Git/ builds now.

Notable win is toTopFilePath no longer double converts

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.

Git/CheckAttr.hs

@@ -1,6 +1,6 @@
 {- git check-attr interface
  -
- - Copyright 2010-2012 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -10,11 +10,13 @@ module Git.CheckAttr where
 import Common
 import Git
 import Git.Command
+import Utility.Path.AbsRel
 import qualified Utility.CoProcess as CoProcess
 
 import System.IO.Error
+import qualified Data.ByteString as B
 
-type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], String)
+type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], RawFilePath)
 
 type Attr = String
 
@@ -22,7 +24,7 @@ type Attr = String
  - values and returns a handle.  -}
 checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle
 checkAttrStart attrs repo = do
-	currdir <- getCurrentDirectory
+	currdir <- toRawFilePath <$> getCurrentDirectory
 	h <- gitCoProcessStart True params repo
 	return (h, attrs, currdir)
   where
@@ -38,16 +40,16 @@ checkAttrStop (h, _, _) = CoProcess.stop h
 
 {- Gets an attribute of a file. When the attribute is not specified,
  - returns "" -}
-checkAttr :: CheckAttrHandle -> Attr -> FilePath -> IO String
+checkAttr :: CheckAttrHandle -> Attr -> RawFilePath -> IO String
 checkAttr (h, attrs, currdir) want file = do
 	pairs <- CoProcess.query h send (receive "")
 	let vals = map snd $ filter (\(attr, _) -> attr == want) pairs
 	case vals of
 		["unspecified"] -> return ""
 		[v] -> return v
-		_ -> error $ "unable to determine " ++ want ++ " attribute of " ++ file
+		_ -> error $ "unable to determine " ++ want ++ " attribute of " ++ fromRawFilePath file
   where
-	send to = hPutStr to $ file' ++ "\0"
+	send to = B.hPutStr to $ file' `B.snoc` 0
 	receive c from = do
 		s <- hGetSomeString from 1024
 		if null s

Git/Config.hs

@@ -23,6 +23,7 @@ import qualified Git.Command
 import qualified Git.Construct
 import Utility.UserInfo
 import Utility.ThreadScheduler
+import Utility.Path.AbsRel
 
 {- Returns a single git config setting, or a fallback value if not set. -}
 get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue
@@ -141,9 +142,9 @@ updateLocation' r l = do
 		Nothing -> return l
 		Just (ConfigValue d) -> do
 			{- core.worktree is relative to the gitdir -}
-			top <- absPath $ fromRawFilePath (gitdir l)
-			let p = absPathFrom top (fromRawFilePath d)
-			return $ l { worktree = Just (toRawFilePath p) }
+			top <- absPath (gitdir l)
+			let p = absPathFrom top d
+			return $ l { worktree = Just p }
 		Just NoConfigValue -> return l
 	return $ r { location = l' }
 

Git/Construct.hs

@@ -5,6 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
 
 module Git.Construct (
@@ -37,6 +38,10 @@ import Git.Remote
 import Git.FilePath
 import qualified Git.Url as Url
 import Utility.UserInfo
+import Utility.Path.AbsRel
+
+import qualified Data.ByteString as B
+import qualified System.FilePath.ByteString as P
 
 {- Finds the git repository used for the cwd, which may be in a parent
  - directory. -}
@@ -46,40 +51,40 @@ fromCwd = getCurrentDirectory >>= seekUp
 	seekUp dir = do
 		r <- checkForRepo dir
 		case r of
-			Nothing -> case upFrom dir of
+			Nothing -> case upFrom (toRawFilePath dir) of
 				Nothing -> return Nothing
-				Just d -> seekUp d
+				Just d -> seekUp (fromRawFilePath d)
 			Just loc -> pure $ Just $ newFrom loc
 
 {- Local Repo constructor, accepts a relative or absolute path. -}
-fromPath :: FilePath -> IO Repo
+fromPath :: RawFilePath -> IO Repo
 fromPath dir = fromAbsPath =<< absPath dir
 
 {- Local Repo constructor, requires an absolute path to the repo be
  - specified. -}
-fromAbsPath :: FilePath -> IO Repo
+fromAbsPath :: RawFilePath -> IO Repo
 fromAbsPath dir
-	| absoluteGitPath (encodeBS dir) = hunt
+	| absoluteGitPath dir = hunt
 	| otherwise =
-		error $ "internal error, " ++ dir ++ " is not absolute"
+		error $ "internal error, " ++ show dir ++ " is not absolute"
   where
-	ret = pure . newFrom . LocalUnknown . toRawFilePath
-	canondir = dropTrailingPathSeparator dir
+	ret = pure . newFrom . LocalUnknown
+	canondir = P.dropTrailingPathSeparator dir
 	{- When dir == "foo/.git", git looks for "foo/.git/.git",
 	 - and failing that, uses "foo" as the repository. -}
 	hunt
-		| (pathSeparator:".git") `isSuffixOf` canondir =
-			ifM (doesDirectoryExist $ dir </> ".git")
+		| (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir =
+			ifM (doesDirectoryExist $ fromRawFilePath dir </> ".git")
 				( ret dir
-				, ret (takeDirectory canondir)
+				, ret (P.takeDirectory canondir)
 				)
-		| otherwise = ifM (doesDirectoryExist dir)
+		| otherwise = ifM (doesDirectoryExist (fromRawFilePath dir))
 			( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom)
 			-- git falls back to dir.git when dir doesn't
 			-- exist, as long as dir didn't end with a
 			-- path separator
 			, if dir == canondir
-				then ret (dir ++ ".git")
+				then ret (dir <> ".git")
 				else ret dir
 			)
 
@@ -95,7 +100,8 @@ fromUrl url
 
 fromUrlStrict :: String -> IO Repo
 fromUrlStrict url
-	| "file://" `isPrefixOf` url = fromAbsPath $ unEscapeString $ uriPath u
+	| "file://" `isPrefixOf` url = fromAbsPath $ toRawFilePath $
+		unEscapeString $ uriPath u
 	| otherwise = pure $ newFrom $ Url u
   where
 	u = fromMaybe bad $ parseURI url
@@ -155,7 +161,7 @@ fromRemoteLocation s repo = gen $ parseRemoteLocation s repo
 fromRemotePath :: FilePath -> Repo -> IO Repo
 fromRemotePath dir repo = do
 	dir' <- expandTilde dir
-	fromPath $ fromRawFilePath (repoPath repo) </> dir'
+	fromPath $ repoPath repo P.</> toRawFilePath dir'
 
 {- Git remotes can have a directory that is specified relative
  - to the user's home directory, or that contains tilde expansions.
@@ -199,7 +205,7 @@ expandTilde = expandt True
 checkForRepo :: FilePath -> IO (Maybe RepoLocation)
 checkForRepo dir = 
 	check isRepo $
-		check (checkGitDirFile dir) $
+		check (checkGitDirFile (toRawFilePath dir)) $
 			check isBareRepo $
 				return Nothing
   where
@@ -221,10 +227,10 @@ checkForRepo dir =
 	gitSignature file = doesFileExist $ dir </> file
 
 -- Check for a .git file.
-checkGitDirFile :: FilePath -> IO (Maybe RepoLocation)
+checkGitDirFile :: RawFilePath -> IO (Maybe RepoLocation)
 checkGitDirFile dir = adjustGitDirFile' $ Local 
-	{ gitdir = toRawFilePath (dir </> ".git")
-	, worktree = Just (toRawFilePath dir)
+	{ gitdir = dir P.</> ".git"
+	, worktree = Just dir
 	}
 
 -- git-submodule, git-worktree, and --separate-git-dir
@@ -236,14 +242,16 @@ adjustGitDirFile loc = fromMaybe loc <$> adjustGitDirFile' loc
 
 adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation)
 adjustGitDirFile' loc = do
-	let gd = fromRawFilePath (gitdir loc)
-	c <- firstLine <$> catchDefaultIO "" (readFile gd)
+	let gd = gitdir loc
+	c <- firstLine <$> catchDefaultIO "" (readFile (fromRawFilePath gd))
 	if gitdirprefix `isPrefixOf` c
 		then do
-			top <- takeDirectory <$> absPath gd
+			top <- fromRawFilePath . P.takeDirectory <$> absPath gd
 			return $ Just $ loc
-				{ gitdir = toRawFilePath $ absPathFrom top $
-					drop (length gitdirprefix) c
+				{ gitdir = absPathFrom 
+					(toRawFilePath top)
+					(toRawFilePath 
+						(drop (length gitdirprefix) c))
 				}
 		else return Nothing
  where

Git/CurrentRepo.hs

@@ -1,6 +1,6 @@
 {- The current git repository.
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -13,6 +13,7 @@ import Git.Construct
 import qualified Git.Config
 import Utility.Env
 import Utility.Env.Set
+import Utility.Path.AbsRel
 
 {- Gets the current git repository.
  -

Git/DiffTree.hs

@@ -17,6 +17,7 @@ module Git.DiffTree (
 	commitDiff,
 ) where
 
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Attoparsec.ByteString.Lazy as A
 import qualified Data.Attoparsec.ByteString.Char8 as A8
@@ -34,9 +35,11 @@ import Utility.Attoparsec
 {- Checks if the DiffTreeItem modifies a file with a given name
  - or under a directory by that name. -}
 isDiffOf :: DiffTreeItem -> TopFilePath -> Bool
-isDiffOf diff f = case fromRawFilePath (getTopFilePath f) of
-	"" -> True -- top of repo contains all
-	d -> d `dirContains` fromRawFilePath (getTopFilePath (file diff))
+isDiffOf diff f = 
+	let f' = getTopFilePath f
+	in if B.null f'
+		then True -- top of repo contains all
+		else f' `dirContains` getTopFilePath (file diff)
 
 {- Diffs two tree Refs. -}
 diffTree :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool)

Git/FilePath.hs

@@ -30,6 +30,7 @@ module Git.FilePath (
 
 import Common
 import Git
+import Utility.Path.AbsRel
 
 import qualified System.FilePath.ByteString as P
 import qualified System.FilePath.Posix.ByteString
@@ -58,8 +59,7 @@ fromTopFilePath p repo = P.combine (repoPath repo) (getTopFilePath p)
 
 {- The input FilePath can be absolute, or relative to the CWD. -}
 toTopFilePath :: RawFilePath -> Git.Repo -> IO TopFilePath
-toTopFilePath file repo = TopFilePath . toRawFilePath
-	<$> relPathDirToFile (fromRawFilePath (repoPath repo)) (fromRawFilePath file)
+toTopFilePath file repo = TopFilePath <$> relPathDirToFile (repoPath repo) file
 
 {- The input RawFilePath must already be relative to the top of the git
  - repository -}

Git/HashObject.hs

@@ -16,6 +16,7 @@ import Git.Command
 import Git.Types
 import qualified Utility.CoProcess as CoProcess
 import Utility.Tmp
+import Utility.Path.AbsRel
 
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
@@ -36,10 +37,10 @@ hashObjectStop :: HashObjectHandle -> IO ()
 hashObjectStop = CoProcess.stop
 
 {- Injects a file into git, returning the Sha of the object. -}
-hashFile :: HashObjectHandle -> FilePath -> IO Sha
+hashFile :: HashObjectHandle -> RawFilePath -> IO Sha
 hashFile h file = CoProcess.query h send receive
   where
-	send to = hPutStrLn to =<< absPath file
+	send to = S8.hPutStrLn to =<< absPath file
 	receive from = getSha "hash-object" $ S8.hGetLine from
 
 class HashableBlob t where
@@ -60,7 +61,7 @@ hashBlob :: HashableBlob b => HashObjectHandle -> b -> IO Sha
 hashBlob h b = withTmpFile "hash" $ \tmp tmph -> do
 	hashableBlobToHandle tmph b
 	hClose tmph
-	hashFile h tmp
+	hashFile h (toRawFilePath tmp)
 
 {- Injects some content into git, returning its Sha.
  - 

Git/Index.hs

@@ -11,6 +11,7 @@ import Common
 import Git
 import Utility.Env
 import Utility.Env.Set
+import Utility.Path.AbsRel
 
 indexEnv :: String
 indexEnv = "GIT_INDEX_FILE"
@@ -27,7 +28,7 @@ indexEnv = "GIT_INDEX_FILE"
  - So, an absolute path is the only safe option for this to return.
  -}
 indexEnvVal :: FilePath -> IO String
-indexEnvVal = absPath
+indexEnvVal p = fromRawFilePath <$> absPath (toRawFilePath p)
 
 {- Forces git to use the specified index file.
  -

Git/LsFiles.hs

@@ -37,12 +37,14 @@ import Git.Sha
 import Utility.InodeCache
 import Utility.TimeStamp
 import Utility.Attoparsec
+import Utility.Path.AbsRel
 
 import System.Posix.Types
 import qualified Data.Map as M
 import qualified Data.ByteString as S
 import qualified Data.Attoparsec.ByteString as A
 import qualified Data.Attoparsec.ByteString.Char8 as A8
+import qualified System.FilePath.ByteString as P
 
 {- It's only safe to use git ls-files on the current repo, not on a remote.
  -
@@ -208,12 +210,12 @@ typeChanged = typeChanged' []
 
 typeChanged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
 typeChanged' ps l repo = guardSafeForLsFiles repo $ do
-	(fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo
+	(fs, cleanup) <- pipeNullSplit' (prefix ++ ps ++ suffix) repo
 	-- git diff returns filenames relative to the top of the git repo;
 	-- convert to filenames relative to the cwd, like git ls-files.
-	top <- absPath (fromRawFilePath (repoPath repo))
-	currdir <- getCurrentDirectory
-	return (map (\f -> toRawFilePath (relPathDirToFileAbs currdir $ top </> decodeBL' f)) fs, cleanup)
+	top <- absPath (repoPath repo)
+	currdir <- toRawFilePath <$> getCurrentDirectory
+	return (map (\f -> relPathDirToFileAbs currdir $ top P.</> f) fs, cleanup)
   where
 	prefix = 
 		[ Param "diff"

Git/Repair.hs

@@ -35,12 +35,14 @@ import qualified Git.Ref as Ref
 import qualified Git.RefLog as RefLog
 import qualified Git.UpdateIndex as UpdateIndex
 import qualified Git.Branch as Branch
+import Utility.Directory.Create
 import Utility.Tmp.Dir
 import Utility.Rsync
 import Utility.FileMode
 
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as L
+import qualified System.FilePath.ByteString as P
 
 {- Given a set of bad objects found by git fsck, which may not
  - be complete, finds and removes all corrupt objects. -}
@@ -99,7 +101,7 @@ retrieveMissingObjects missing referencerepo r
 	| otherwise = withTmpDir "tmprepo" $ \tmpdir -> do
 		unlessM (boolSystem "git" [Param "init", File tmpdir]) $
 			error $ "failed to create temp repository in " ++ tmpdir
-		tmpr <- Config.read =<< Construct.fromAbsPath tmpdir
+		tmpr <- Config.read =<< Construct.fromAbsPath (toRawFilePath tmpdir)
 		rs <- Construct.fromRemotes r
 		stillmissing <- pullremotes tmpr rs fetchrefstags missing
 		if S.null (knownMissing stillmissing)
@@ -246,11 +248,14 @@ explodePackedRefsFile r = do
 		nukeFile f
   where
 	makeref (sha, ref) = do
-		let gitd = fromRawFilePath (localGitDir r)
-		let dest = gitd </> fromRef ref
-		createDirectoryUnder gitd (parentDir dest)
-		unlessM (doesFileExist dest) $
-			writeFile dest (fromRef sha)
+		let gitd = localGitDir r
+		let dest = gitd P.</> fromRef' ref
+		let dest' = fromRawFilePath dest
+		createDirectoryUnder
+			(fromRawFilePath gitd)
+			(fromRawFilePath (parentDir dest))
+		unlessM (doesFileExist dest') $
+			writeFile dest' (fromRef sha)
 
 packedRefsFile :: Repo -> FilePath
 packedRefsFile r = fromRawFilePath (localGitDir r) </> "packed-refs"