more RawFilePath conversion

Notable wins in Annex.Locations which was sometimes doing 6 conversions
in a single function call.

This commit was sponsored by Denis Dzyubenko on Patreon.

Annex/Fixup.hs

@@ -13,6 +13,7 @@ import Git.Types
 import Git.Config
 import Types.GitConfig
 import Utility.Path
+import Utility.Path.AbsRel
 import Utility.SafeCommand
 import Utility.Directory
 import Utility.Exception
@@ -22,15 +23,13 @@ import qualified Utility.RawFilePath as R
 import Utility.PartialPrelude
 
 import System.IO
-import System.FilePath
-import System.PosixCompat.Files
 import Data.List
 import Data.Maybe
 import Control.Monad
 import Control.Monad.IfElse
 import qualified Data.Map as M
-import qualified System.FilePath.ByteString as P
 import qualified Data.ByteString as S
+import System.FilePath.ByteString
 import Control.Applicative
 import Prelude
 
@@ -54,7 +53,7 @@ disableWildcardExpansion r = r
 fixupDirect :: Repo -> Repo
 fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do
 	r
-		{ location = l { worktree = Just (toRawFilePath (parentDir (fromRawFilePath d))) }
+		{ location = l { worktree = Just (parentDir d) }
 		, gitGlobalOpts = gitGlobalOpts r ++
 			[ Param "-c"
 			, Param $ fromConfigKey coreBare ++ "=" ++ boolConfig False
@@ -109,13 +108,13 @@ fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d
 		, return r
 		)
   where
-	dotgit = w P.</> ".git"
+	dotgit = w </> ".git"
 	dotgit' = fromRawFilePath dotgit
 
 	replacedotgit = whenM (doesFileExist dotgit') $ do
 		linktarget <- relPathDirToFile w d
 		nukeFile dotgit'
-		R.createSymbolicLink linktarget dotgit'
+		R.createSymbolicLink linktarget dotgit
 	
 	unsetcoreworktree =
 		maybe (error "unset core.worktree failed") (\_ -> return ())
@@ -125,13 +124,14 @@ fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d
 		-- git-worktree sets up a "commondir" file that contains
 		-- the path to the main git directory.
 		-- Using --separate-git-dir does not.
-		catchDefaultIO Nothing (headMaybe . lines <$> readFile (fromRawFilePath (d P.</> "commondir"))) >>= \case
+		catchDefaultIO Nothing (headMaybe . lines <$> readFile (fromRawFilePath (d </> "commondir"))) >>= \case
 			Just gd -> do
 				-- Make the worktree's git directory
 				-- contain an annex symlink to the main
 				-- repository's annex directory.
-				let linktarget = gd </> "annex"
-				createSymbolicLink linktarget (dotgit' </> "annex")
+				let linktarget = toRawFilePath gd </> "annex"
+				R.createSymbolicLink linktarget
+					(dotgit </> "annex")
 			Nothing -> return ()
 
 	-- Repo adjusted, so that symlinks to objects that get checked
@@ -144,7 +144,7 @@ fixupUnusualRepos r _ = return r
 
 needsSubmoduleFixup :: Repo -> Bool
 needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) =
-	(".git" P.</> "modules") `S.isInfixOf` d
+	(".git" </> "modules") `S.isInfixOf` d
 needsSubmoduleFixup _ = False
 
 needsGitLinkFixup :: Repo -> IO Bool
@@ -152,6 +152,6 @@ needsGitLinkFixup (Repo { location = (Local { worktree = Just wt, gitdir = d })
 	-- Optimization: Avoid statting .git in the common case; only
 	-- when the gitdir is not in the usual place inside the worktree
 	-- might .git be a file.
-	| wt P.</> ".git" == d = return False
-	| otherwise = doesFileExist (fromRawFilePath (wt P.</> ".git"))
+	| wt </> ".git" == d = return False
+	| otherwise = doesFileExist (fromRawFilePath (wt </> ".git"))
 needsGitLinkFixup _ = return False

Annex/Locations.hs

@@ -1,6 +1,6 @@
 {- git-annex file locations
  -
- - Copyright 2010-2019 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -108,6 +108,7 @@ import qualified Git.Types as Git
 import Git.FilePath
 import Annex.DirHashes
 import Annex.Fixup
+import Utility.Path.AbsRel
 import qualified Utility.RawFilePath as R
 
 {- Conventions:
@@ -199,32 +200,27 @@ gitAnnexLocation' key r config crippled symlinkssupported checker gitdir
 	check [] = error "internal"
 
 {- Calculates a symlink target to link a file to an annexed object. -}
-gitAnnexLink :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath
+gitAnnexLink :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath
 gitAnnexLink file key r config = do
-	currdir <- getCurrentDirectory
+	currdir <- R.getCurrentDirectory
 	let absfile = absNormPathUnix currdir file
 	let gitdir = getgitdir currdir
 	loc <- gitAnnexLocation' key r config False False (\_ -> return True) gitdir
-	fromRawFilePath . toInternalGitPath . toRawFilePath
-		<$> relPathDirToFile (parentDir absfile) (fromRawFilePath loc)
+	toInternalGitPath <$> relPathDirToFile (parentDir absfile) loc
   where
 	getgitdir currdir
 		{- This special case is for git submodules on filesystems not
 		 - supporting symlinks; generate link target that will
 		 - work portably. -}
 		| not (coreSymlinks config) && needsSubmoduleFixup r =
-			toRawFilePath $
-				absNormPathUnix currdir $ fromRawFilePath $
-					Git.repoPath r P.</> ".git"
+			absNormPathUnix currdir (Git.repoPath r P.</> ".git")
 		| otherwise = Git.localGitDir r
-	absNormPathUnix d p = fromRawFilePath $ toInternalGitPath $ toRawFilePath $
-		absPathFrom
-			(fromRawFilePath $ toInternalGitPath $ toRawFilePath d)
-			(fromRawFilePath $ toInternalGitPath $ toRawFilePath p)
+	absNormPathUnix d p = toInternalGitPath $
+		absPathFrom (toInternalGitPath d) (toInternalGitPath p)
 
 {- Calculates a symlink target as would be used in a typical git
  - repository, with .git in the top of the work tree. -}
-gitAnnexLinkCanonical :: FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath
+gitAnnexLinkCanonical :: RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath
 gitAnnexLinkCanonical file key r config = gitAnnexLink file key r' config'
   where
 	r' = case r of

Git/CurrentRepo.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.CurrentRepo where
 
 import Common
@@ -14,6 +16,10 @@ import qualified Git.Config
 import Utility.Env
 import Utility.Env.Set
 import Utility.Path.AbsRel
+import qualified Utility.RawFilePath as R
+
+import qualified Data.ByteString as B
+import qualified System.FilePath.ByteString as P
 
 {- Gets the current git repository.
  -
@@ -38,14 +44,14 @@ get = do
 	gd <- getpathenv "GIT_DIR"
 	r <- configure gd =<< fromCwd
 	prefix <- getpathenv "GIT_PREFIX"
-	wt <- maybe (fromRawFilePath <$> worktree (location r)) Just
+	wt <- maybe (worktree (location r)) Just
 		<$> getpathenvprefix "GIT_WORK_TREE" prefix
 	case wt of
 		Nothing -> return r
 		Just d -> do
-			curr <- getCurrentDirectory
+			curr <- R.getCurrentDirectory
 			unless (d `dirContains` curr) $
-				setCurrentDirectory d
+				setCurrentDirectory (fromRawFilePath d)
 			return $ addworktree wt r
   where
 	getpathenv s = do
@@ -53,24 +59,25 @@ get = do
 		case v of
 			Just d -> do
 				unsetEnv s
-				return (Just d)
+				return (Just (toRawFilePath d))
 			Nothing -> return Nothing
 	
-	getpathenvprefix s (Just prefix) | not (null prefix) =
+	getpathenvprefix s (Just prefix) | not (B.null prefix) =
 		getpathenv s >>= \case
 			Nothing -> return Nothing
 			Just d
 				| d == "." -> return (Just d)
-				| otherwise -> Just <$> absPath (prefix </> d)
+				| otherwise -> Just 
+					<$> absPath (prefix P.</> d)
 	getpathenvprefix s _ = getpathenv s
 
 	configure Nothing (Just r) = Git.Config.read r
 	configure (Just d) _ = do
-		absd <- absPath (fromRawFilePath d)
-		curr <- getCurrentDirectory
+		absd <- absPath d
+		curr <- R.getCurrentDirectory
 		loc <- adjustGitDirFile $ Local
 			{ gitdir = absd
-			, worktree = Just (toRawFilePath curr)
+			, worktree = Just curr
 			}
 		r <- Git.Config.read $ newFrom loc
 		return $ if Git.Config.isBare r
@@ -80,6 +87,7 @@ get = do
 
 	addworktree w r = changelocation r $ Local
 		{ gitdir = gitdir (location r)
-		, worktree = fmap toRawFilePath w
+		, worktree = w
 		}
+	
 	changelocation r l = r { location = l }