more RawFilePath conversion

412/645

Annex/AdjustedBranch.hs

@@ -1,6 +1,6 @@
 {- adjusted branch
  -
- - Copyright 2016-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -57,11 +57,13 @@ import Annex.Tmp
 import Annex.GitOverlay
 import Utility.Tmp.Dir
 import Utility.CopyFile
+import Utility.Directory.Create
 import qualified Database.Keys
 import Config
 
 import qualified Data.Map as M
 import qualified Data.ByteString as S
+import qualified System.FilePath.ByteString as P
 
 -- How to perform various adjustments to a TreeItem.
 class AdjustTreeItem t where
@@ -110,11 +112,10 @@ adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case
 adjustToSymlink :: TreeItem -> Annex (Maybe TreeItem)
 adjustToSymlink = adjustToSymlink' gitAnnexLink
 
-adjustToSymlink' :: (FilePath -> Key -> Git.Repo -> GitConfig -> IO FilePath) -> TreeItem -> Annex (Maybe TreeItem)
+adjustToSymlink' :: (RawFilePath -> Key -> Git.Repo -> GitConfig -> IO RawFilePath) -> TreeItem -> Annex (Maybe TreeItem)
 adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case
 	Just k -> do
-		absf <- inRepo $ \r -> absPath $ 
+		absf <- inRepo $ \r -> absPath $ fromTopFilePath f r
-			fromRawFilePath $ fromTopFilePath f r
 		linktarget <- calcRepo $ gitannexlink absf k
 		Just . TreeItem f (fromTreeItemType TreeSymlink)
 			<$> hashSymlink linktarget
@@ -376,23 +377,27 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
 	 - index file is currently locked.)
 	 -}
 	changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do
-		git_dir <- fromRawFilePath <$> fromRepo Git.localGitDir
+		git_dir <- fromRepo Git.localGitDir
+		let git_dir' = fromRawFilePath git_dir
 		tmpwt <- fromRepo gitAnnexMergeDir
-		withTmpDirIn othertmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
+		withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
 			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
 				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
 				-- Copy in refs and packed-refs, to work
 				-- around bug in git 2.13.0, which
 				-- causes it not to look in GIT_DIR for refs.
 				refs <- liftIO $ dirContentsRecursive $
-					git_dir </> "refs"
+					git_dir' </> "refs"
-				let refs' = (git_dir </> "packed-refs") : refs
+				let refs' = (git_dir' </> "packed-refs") : refs
 				liftIO $ forM_ refs' $ \src ->
 					whenM (doesFileExist src) $ do
-						dest <- relPathDirToFile git_dir src
+						dest <- relPathDirToFile git_dir
-						let dest' = tmpgit </> dest
+							(toRawFilePath src)
-						createDirectoryUnder git_dir (takeDirectory dest')
+						let dest' = toRawFilePath tmpgit P.</> dest
-						void $ createLinkOrCopy src dest'
+						createDirectoryUnder git_dir
+							(P.takeDirectory dest')
+						void $ createLinkOrCopy src
+							(fromRawFilePath dest')
 				-- This reset makes git merge not care
 				-- that the work tree is empty; otherwise
 				-- it will think that all the files have
@@ -418,7 +423,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
 		setup = do
 			whenM (doesDirectoryExist d) $
 				removeDirectoryRecursive d
-			createDirectoryUnder git_dir d
+			createDirectoryUnder git_dir (toRawFilePath d)
 		cleanup _ = removeDirectoryRecursive d
 
 	{- A merge commit has been made between the basisbranch and 

Annex/AutoMerge.hs

@@ -230,7 +230,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
 		| otherwise = pure f
 
 	makesymlink key dest = do
-		l <- calcRepo $ gitAnnexLink dest key
+		l <- calcRepo $ gitAnnexLink (toRawFilePath dest) key
 		unless inoverlay $ replacewithsymlink dest l
 		dest' <- toRawFilePath <$> stagefile dest
 		stageSymlink dest' =<< hashSymlink l
@@ -267,7 +267,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
 					Nothing -> noop
 					Just sha -> do
 						link <- catSymLinkTarget sha
-						replacewithsymlink item (fromRawFilePath link)
+						replacewithsymlink item link
 			-- And when grafting in anything else vs a symlink,
 			-- the work tree already contains what we want.
 			(_, Just TreeSymlink) -> noop

Annex/Init.hs

@@ -50,6 +50,7 @@ import Upgrade
 import Annex.Tmp
 import Utility.UserInfo
 import Utility.ThreadScheduler
+import qualified Utility.RawFilePath as R
 #ifndef mingw32_HOST_OS
 import Annex.Perms
 import Utility.FileMode
@@ -59,6 +60,7 @@ import Data.Either
 #endif
 
 import qualified Data.Map as M
+import qualified System.FilePath.ByteString as P
 import Control.Concurrent.Async
 
 checkCanInitialize :: Annex a -> Annex a
@@ -79,8 +81,8 @@ canInitialize' = inRepo (noAnnexFileContent . fmap fromRawFilePath . Git.repoWor
 genDescription :: Maybe String -> Annex UUIDDesc
 genDescription (Just d) = return $ UUIDDesc $ encodeBS d
 genDescription Nothing = do
-	reldir <- liftIO . relHome
+	reldir <- liftIO . relHome . fromRawFilePath
-		=<< liftIO . absPath . fromRawFilePath
+		=<< liftIO . absPath
 		=<< fromRepo Git.repoPath
 	hostname <- fromMaybe "" <$> liftIO getHostname
 	let at = if null hostname then "" else "@"
@@ -194,12 +196,12 @@ probeCrippledFileSystem = withEventuallyCleanedOtherTmp $ \tmp -> do
 	mapM_ warning warnings
 	return r
 
-probeCrippledFileSystem' :: FilePath -> IO (Bool, [String])
+probeCrippledFileSystem' :: RawFilePath -> IO (Bool, [String])
 #ifdef mingw32_HOST_OS
 probeCrippledFileSystem' _ = return (True, [])
 #else
 probeCrippledFileSystem' tmp = do
-	let f = tmp </> "gaprobe"
+	let f = fromRawFilePath (tmp P.</> "gaprobe")
 	writeFile f ""
 	r <- probe f
 	void $ tryIO $ allowWrite f
@@ -246,18 +248,18 @@ probeLockSupport :: Annex Bool
 probeLockSupport = return True
 #else
 probeLockSupport = withEventuallyCleanedOtherTmp $ \tmp -> do
-	let f = tmp </> "lockprobe"
+	let f = tmp P.</> "lockprobe"
 	mode <- annexFileMode
 	liftIO $ withAsync warnstall (const (go f mode))
   where
 	go f mode = do
-		removeWhenExistsWith removeLink f
+		removeWhenExistsWith R.removeLink f
 		let locktest = bracket
 			(Posix.lockExclusive (Just mode) f)
 			Posix.dropLock
 			(const noop)
 		ok <- isRight <$> tryNonAsync locktest
-		removeWhenExistsWith removeLink f
+		removeWhenExistsWith R.removeLink f
 		return ok
 	
 	warnstall = do
@@ -272,17 +274,17 @@ probeFifoSupport = do
 	return False
 #else
 	withEventuallyCleanedOtherTmp $ \tmp -> do
-		let f = tmp </> "gaprobe"
+		let f = tmp P.</> "gaprobe"
-		let f2 = tmp </> "gaprobe2"
+		let f2 = tmp P.</> "gaprobe2"
 		liftIO $ do
-			removeWhenExistsWith removeLink f
+			removeWhenExistsWith R.removeLink f
-			removeWhenExistsWith removeLink f2
+			removeWhenExistsWith R.removeLink f2
 			ms <- tryIO $ do
-				createNamedPipe f ownerReadMode
+				createNamedPipe (fromRawFilePath f) ownerReadMode
-				createLink f f2
+				R.createLink f f2
-				getFileStatus f
+				R.getFileStatus f
-			removeWhenExistsWith removeLink f
+			removeWhenExistsWith R.removeLink f
-			removeWhenExistsWith removeLink f2
+			removeWhenExistsWith R.removeLink f2
 			return $ either (const False) isNamedPipe ms
 #endif
 

Upgrade.hs

@@ -51,9 +51,9 @@ needsUpgrade v
   where
 	err msg = do
 		g <- Annex.gitRepo
-		p <- liftIO $ absPath $ fromRawFilePath $ Git.repoPath g
+		p <- liftIO $ absPath $ Git.repoPath g
 		return $ Just $ unwords
-			[ "Repository", p
+			[ "Repository", fromRawFilePath p
 			, "is at unsupported version"
 			, show (fromRepoVersion v) ++ "."
 			, msg

Upgrade/V5.hs

@@ -132,13 +132,14 @@ upgradeDirectWorkTree = do
 
 	fromdirect f k = ifM (Direct.goodContent k f)
 		( do
+			let f' = toRawFilePath f
 			-- If linkToAnnex fails for some reason, the work tree
 			-- file still has the content; the annex object file
 			-- is just not populated with it. Since the work tree
 			-- file is recorded as an associated file, things will
 			-- still work that way, it's just not ideal.
-			ic <- withTSDelta (liftIO . genInodeCache (toRawFilePath f))
+			ic <- withTSDelta (liftIO . genInodeCache f')
-			void $ Content.linkToAnnex k f ic
+			void $ Content.linkToAnnex k f' ic
 		, unlessM (Content.inAnnex k) $ do
 			-- Worktree file was deleted or modified;
 			-- if there are no other copies of the content