more RawFilePath conversion

451/645

Annex/FileMatcher.hs

@@ -52,18 +52,19 @@ import Annex.Magic
 import Data.Either
 import qualified Data.Set as S
 
-type GetFileMatcher = FilePath -> Annex (FileMatcher Annex)
+type GetFileMatcher = RawFilePath -> Annex (FileMatcher Annex)
 
-checkFileMatcher :: GetFileMatcher -> FilePath -> Annex Bool
+checkFileMatcher :: GetFileMatcher -> RawFilePath -> Annex Bool
-checkFileMatcher getmatcher file = checkFileMatcher' getmatcher file (return True)
+checkFileMatcher getmatcher file =
+	checkFileMatcher' getmatcher file (return True)
 
 -- | Allows running an action when no matcher is configured for the file.
-checkFileMatcher' :: GetFileMatcher -> FilePath -> Annex Bool -> Annex Bool
+checkFileMatcher' :: GetFileMatcher -> RawFilePath -> Annex Bool -> Annex Bool
 checkFileMatcher' getmatcher file notconfigured = do
 	matcher <- getmatcher file
 	checkMatcher matcher Nothing afile S.empty notconfigured d
   where
-	afile = AssociatedFile (Just (toRawFilePath file))
+	afile = AssociatedFile (Just file)
 	-- checkMatcher will never use this, because afile is provided.
 	d = return True
 

Annex/Ingest.hs

@@ -157,7 +157,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
 	k <- case mk of
 		Nothing -> do
 			backend <- maybe
-				(chooseBackend $ fromRawFilePath $ keyFilename source)
+				(chooseBackend $ keyFilename source)
 				(return . Just)
 				preferredbackend
 			fst <$> genKey source meterupdate backend
@@ -176,7 +176,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
 	go _ _ Nothing = failure "failed to generate a key"
 
 	golocked key mcache s =
-		tryNonAsync (moveAnnex key $ fromRawFilePath $ contentLocation source) >>= \case
+		tryNonAsync (moveAnnex key $ contentLocation source) >>= \case
 			Right True -> do
 				populateAssociatedFiles key source restage
 				success key mcache s		
@@ -189,7 +189,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
 		-- already has a hard link.
 		cleanCruft source
 		cleanOldKeys (keyFilename source) key
-		linkToAnnex key (fromRawFilePath $ keyFilename source) (Just cache) >>= \case
+		linkToAnnex key (keyFilename source) (Just cache) >>= \case
 			LinkAnnexFailed -> failure "failed to link to annex"
 			_ -> do
 				finishIngestUnlocked' key source restage
@@ -254,7 +254,7 @@ cleanOldKeys file newkey = do
 				-- so no need for any recovery.
 				(f:_) -> do
 					ic <- withTSDelta (liftIO . genInodeCache f)
-					void $ linkToAnnex key (fromRawFilePath f) ic
+					void $ linkToAnnex key f ic
 				_ -> logStatus key InfoMissing
 
 {- On error, put the file back so it doesn't seem to have vanished.
@@ -272,9 +272,9 @@ restoreFile file key e = do
 	throwM e
 
 {- Creates the symlink to the annexed content, returns the link target. -}
-makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex String
+makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex LinkTarget
 makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
-	l <- calcRepo $ gitAnnexLink file key
+	l <- calcRepo $ gitAnnexLink (toRawFilePath file) key
 	replaceWorkTreeFile file $ makeAnnexLink l . toRawFilePath
 
 	-- touch symlink to have same time as the original file,
@@ -349,7 +349,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
 		stagePointerFile file' mode =<< hashPointerFile key
 		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file')
 		case mtmp of
-			Just tmp -> ifM (moveAnnex key tmp)
+			Just tmp -> ifM (moveAnnex key (toRawFilePath tmp))
 				( linkunlocked mode >> return True
 				, writepointer mode >> return False
 				)
@@ -360,7 +360,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
 	, do
 		addLink ci file key Nothing
 		case mtmp of
-			Just tmp -> moveAnnex key tmp
+			Just tmp -> moveAnnex key (toRawFilePath tmp)
 			Nothing -> return True
 	)
   where
@@ -380,7 +380,7 @@ addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi)
 			, providedMimeEncoding = Nothing
 			}
 	
-	linkunlocked mode = linkFromAnnex key file mode >>= \case
+	linkunlocked mode = linkFromAnnex key file' mode >>= \case
 		LinkAnnexFailed -> liftIO $
 			writePointerFile file' key mode
 		_ -> return ()

Annex/Link.hs

@@ -126,7 +126,7 @@ hashSymlink = hashBlob . toInternalGitPath
 stageSymlink :: RawFilePath -> Sha -> Annex ()
 stageSymlink file sha =
 	Annex.Queue.addUpdateIndex =<<
-		inRepo (Git.UpdateIndex.stageSymlink (fromRawFilePath file) sha)
+		inRepo (Git.UpdateIndex.stageSymlink file sha)
 
 {- Injects a pointer file content into git, returning its Sha. -}
 hashPointerFile :: Key -> Annex Sha

Annex/Locations.hs

@@ -268,11 +268,8 @@ gitAnnexObjectDir r = fromRawFilePath $
 	P.addTrailingPathSeparator $ Git.localGitDir r P.</> objectDir'
 
 {- .git/annex/tmp/ is used for temp files for key's contents -}
-gitAnnexTmpObjectDir :: Git.Repo -> FilePath
+gitAnnexTmpObjectDir :: Git.Repo -> RawFilePath
-gitAnnexTmpObjectDir = fromRawFilePath . gitAnnexTmpObjectDir'
+gitAnnexTmpObjectDir r = P.addTrailingPathSeparator $
-
-gitAnnexTmpObjectDir' :: Git.Repo -> RawFilePath
-gitAnnexTmpObjectDir' r = P.addTrailingPathSeparator $
 	gitAnnexDir r P.</> "tmp"
 
 {- .git/annex/othertmp/ is used for other temp files -}
@@ -297,7 +294,7 @@ gitAnnexTmpWatcherDir r = fromRawFilePath $
 
 {- The temp file to use for a given key's content. -}
 gitAnnexTmpObjectLocation :: Key -> Git.Repo -> RawFilePath
-gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir' r P.</> keyFile key
+gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r P.</> keyFile key
 
 {- Given a temp file such as gitAnnexTmpObjectLocation, makes a name for a
  - subdirectory in the same location, that can be used as a work area
@@ -531,8 +528,8 @@ gitAnnexUrlFile :: Git.Repo -> FilePath
 gitAnnexUrlFile r = fromRawFilePath $ gitAnnexDir r P.</> "url"
 
 {- Temporary file used to edit configuriation from the git-annex branch. -}
-gitAnnexTmpCfgFile :: Git.Repo -> FilePath
+gitAnnexTmpCfgFile :: Git.Repo -> RawFilePath
-gitAnnexTmpCfgFile r = fromRawFilePath $ gitAnnexDir r P.</> "config.tmp"
+gitAnnexTmpCfgFile r = gitAnnexDir r P.</> "config.tmp"
 
 {- .git/annex/ssh/ is used for ssh connection caching -}
 gitAnnexSshDir :: Git.Repo -> RawFilePath

Annex/NumCopies.hs

@@ -63,7 +63,7 @@ getNumCopies = fromSources
 
 {- Numcopies value for a file, from any configuration source, including the
  - deprecated git config. -}
-getFileNumCopies :: FilePath -> Annex NumCopies
+getFileNumCopies :: RawFilePath -> Annex NumCopies
 getFileNumCopies f = fromSources
 	[ getForcedNumCopies
 	, getFileNumCopies' f
@@ -72,17 +72,17 @@ getFileNumCopies f = fromSources
 
 getAssociatedFileNumCopies :: AssociatedFile -> Annex NumCopies
 getAssociatedFileNumCopies (AssociatedFile afile) =
-	maybe getNumCopies getFileNumCopies (fromRawFilePath <$> afile)
+	maybe getNumCopies getFileNumCopies afile
 
 {- This is the globally visible numcopies value for a file. So it does
  - not include local configuration in the git config or command line
  - options. -}
-getGlobalFileNumCopies :: FilePath  -> Annex NumCopies
+getGlobalFileNumCopies :: RawFilePath  -> Annex NumCopies
 getGlobalFileNumCopies f = fromSources
 	[ getFileNumCopies' f
 	]
 
-getFileNumCopies' :: FilePath  -> Annex (Maybe NumCopies)
+getFileNumCopies' :: RawFilePath  -> Annex (Maybe NumCopies)
 getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr
   where
 	getattr = (NumCopies <$$> readish)
@@ -95,12 +95,12 @@ getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr
  - This is good enough for everything except dropping the file, which
  - requires active verification of the copies.
  -}
-numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
+numCopiesCheck :: RawFilePath -> Key -> (Int -> Int -> v) -> Annex v
 numCopiesCheck file key vs = do
 	have <- trustExclude UnTrusted =<< Remote.keyLocations key
 	numCopiesCheck' file vs have
 
-numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v
+numCopiesCheck' :: RawFilePath -> (Int -> Int -> v) -> [UUID] -> Annex v
 numCopiesCheck' file vs have = do
 	NumCopies needed <- getFileNumCopies file
 	return $ length have `vs` needed

Annex/View.hs

@@ -369,8 +369,7 @@ applyView' mkviewedfile getfilemetadata view = do
 		let f = fromRawFilePath $ getTopFilePath topf
 		let metadata' = getfilemetadata f `unionMetaData` metadata
 		forM_ (genviewedfiles f metadata') $ \fv -> do
-			f' <- fromRawFilePath <$> 
+			f' <- fromRepo (fromTopFilePath $ asTopFilePath $ toRawFilePath fv)
-				fromRepo (fromTopFilePath $ asTopFilePath $ toRawFilePath fv)
 			stagesymlink uh f' =<< calcRepo (gitAnnexLink f' k)
 	go uh topf sha (Just treeitemtype) Nothing
 		| "." `B.isPrefixOf` getTopFilePath topf =

CmdLine/Batch.hs

@@ -137,7 +137,7 @@ batchFilesMatching fmt a = do
 			)
   where
 	go a' = batchInput fmt 
-		(Right <$$> liftIO . relPathCwdToFile)
+		(Right . fromRawFilePath <$$> liftIO . relPathCwdToFile . toRawFilePath)
 		(batchCommandAction . uncurry a')
 
 batchAnnexedFilesMatching :: BatchFormat -> AnnexedFileSeeker -> Annex ()

CmdLine/Seek.hs

@@ -25,6 +25,7 @@ import qualified Git.Ref
 import Git.FilePath
 import qualified Limit
 import CmdLine.GitAnnex.Options
+import CmdLine.Action
 import Logs
 import Logs.Unused
 import Types.Transfer
@@ -44,7 +45,6 @@ import qualified Annex.BranchState
 import qualified Database.Keys
 import qualified Utility.RawFilePath as R
 import Utility.Tuple
-import CmdLine.Action
 
 import Control.Concurrent.Async
 import System.Posix.Types
@@ -102,7 +102,7 @@ withPathContents a params = do
 				a f
   where
 	get p = ifM (isDirectory <$> getFileStatus p)
-		( map (\f -> (f, makeRelative (parentDir p) f))
+		( map (\f -> (f, makeRelative (takeDirectory (dropTrailingPathSeparator p)) f))
 			<$> dirContentsRecursiveSkipping (".git" `isSuffixOf`) True p
 		, return [(p, takeFileName p)]
 		)
@@ -490,7 +490,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
 		currbranch <- getCurrentBranch
 		stopattop <- prepviasymlink
 		ps' <- flip filterM ps $ \p -> do
-			relf <- liftIO $ relPathCwdToFile p
+			relf <- liftIO $ relPathCwdToFile $ toRawFilePath p
 			ifM (not <$> (exists p <||> hidden currbranch relf))
 				( prob (p ++ " not found")
 				, ifM (viasymlink stopattop (upFrom relf))
@@ -517,7 +517,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
 
 	viasymlink _ Nothing = return False
 	viasymlink stopattop (Just p) = do
-		st <- liftIO $ getSymbolicLinkStatus p
+		st <- liftIO $ R.getSymbolicLinkStatus p
 		if stopattop st
 			then return False
 			else if isSymbolicLink st
@@ -526,7 +526,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
 
 	hidden currbranch f
 		| allowhidden = isJust
-			<$> catObjectMetaDataHidden (toRawFilePath f) currbranch
+			<$> catObjectMetaDataHidden f currbranch
 		| otherwise = return False
 
 	prob msg = do

Command.hs

@@ -129,7 +129,8 @@ noDaemonRunning :: Command -> Command
 noDaemonRunning = addCheck $ whenM (isJust <$> daemonpid) $
 	giveup "You cannot run this command while git-annex watch or git-annex assistant is running."
   where
-	daemonpid = liftIO . checkDaemon =<< fromRepo gitAnnexPidFile
+	daemonpid = liftIO . checkDaemon . fromRawFilePath
+		=<< fromRepo gitAnnexPidFile
 
 dontCheck :: CommandCheck -> Command -> Command
 dontCheck check cmd = mutateCheck cmd $ \c -> filter (/= check) c

Command/Uninit.hs

@@ -31,8 +31,8 @@ check = do
 	b <- current_branch
 	when (b == Annex.Branch.name) $ giveup $
 		"cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out"
-	top <- fromRawFilePath <$> fromRepo Git.repoPath
+	top <- fromRepo Git.repoPath
-	currdir <- liftIO getCurrentDirectory
+	currdir <- liftIO R.getCurrentDirectory
 	whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath currdir)) $
 		giveup "can only run uninit from the top of the git repository"
   where

Command/Unlock.hs

@@ -50,7 +50,7 @@ perform dest key = do
 	replaceWorkTreeFile (fromRawFilePath dest) $ \tmp ->
 		ifM (inAnnex key)
 			( do
-				r <- linkFromAnnex key tmp destmode
+				r <- linkFromAnnex key (toRawFilePath tmp) destmode
 				case r of
 					LinkAnnexOk -> return ()
 					LinkAnnexNoop -> return ()

Command/Unused.hs

@@ -108,7 +108,7 @@ check file msg a c = do
 	l <- a
 	let unusedlist = number c l
 	unless (null l) $ showLongNote $ msg unusedlist
-	updateUnusedLog file $ M.fromList unusedlist
+	updateUnusedLog (toRawFilePath file) (M.fromList unusedlist)
 	return $ c + length l
 
 number :: Int -> [a] -> [(Int, a)]

Command/Vicfg.hs

@@ -43,11 +43,12 @@ seek = withNothing (commandAction start)
 start :: CommandStart
 start = do
 	f <- fromRepo gitAnnexTmpCfgFile
+	let f' = fromRawFilePath f
 	createAnnexDirectory $ parentDir f
 	cfg <- getCfg
 	descs <- uuidDescriptions
-	liftIO $ writeFile f $ genCfg cfg descs
+	liftIO $ writeFile f' $ genCfg cfg descs
-	vicfg cfg f
+	vicfg cfg f'
 	stop
 
 vicfg :: Cfg -> FilePath -> Annex ()

Command/View.hs

@@ -19,6 +19,8 @@ import Types.View
 import Annex.View
 import Logs.View
 
+import qualified System.FilePath.ByteString as P
+
 cmd :: Command
 cmd = notBareRepo $
 	command "view" SectionMetaData "enter a view branch"
@@ -101,19 +103,19 @@ checkoutViewBranch view mkbranch = do
 		 - and this pollutes the view, so remove them.
 		 - (However, emptry directories used by submodules are not
 		 - removed.) -}
-		top <- liftIO . absPath . fromRawFilePath =<< fromRepo Git.repoPath
+		top <- liftIO . absPath =<< fromRepo Git.repoPath
 		(l, cleanup) <- inRepo $
-			LsFiles.notInRepoIncludingEmptyDirectories [] False
+			LsFiles.notInRepoIncludingEmptyDirectories [] False [top]
-				[toRawFilePath top]
 		forM_ l (removeemptydir top)
 		liftIO $ void cleanup
 		unlessM (liftIO $ doesDirectoryExist here) $ do
-			showLongNote (cwdmissing top)
+			showLongNote (cwdmissing (fromRawFilePath top))
 	return ok
   where
 	removeemptydir top d = do
 		p <- inRepo $ toTopFilePath d
-		liftIO $ tryIO $ removeDirectory (top </> fromRawFilePath (getTopFilePath p))
+		liftIO $ tryIO $ removeDirectory $
+			fromRawFilePath $ (top P.</> getTopFilePath p)
 	cwdmissing top = unlines
 		[ "This view does not include the subdirectory you are currently in."
 		, "Perhaps you should:  cd " ++ top

Git/UpdateIndex.hs

@@ -118,12 +118,12 @@ unstageFile' p = pureStreamer $ L.fromStrict $
 	<> indexPath p
 
 {- A streamer that adds a symlink to the index. -}
-stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
+stageSymlink :: RawFilePath -> Sha -> Repo -> IO Streamer
 stageSymlink file sha repo = do
 	!line <- updateIndexLine
 		<$> pure sha
 		<*> pure TreeSymlink
-		<*> toTopFilePath (toRawFilePath file) repo
+		<*> toTopFilePath file repo
 	return $ pureStreamer line
 
 {- A streamer that applies a DiffTreeItem to the index. -}

Limit.hs

@@ -333,7 +333,7 @@ limitLackingCopies approx want = case readish want of
 			then approxNumCopies
 			else case mi of
 				MatchingFile fi -> getGlobalFileNumCopies $
-					fromRawFilePath $ matchFile fi
+					matchFile fi
 				MatchingKey _ _ -> approxNumCopies
 				MatchingInfo {} -> approxNumCopies
 				MatchingUserInfo {} -> approxNumCopies

Remote/Git.hs

@@ -640,8 +640,8 @@ copyFromRemoteCheap r st repo
 		loc <- liftIO $ gitAnnexLocation key repo gc
 		liftIO $ ifM (R.doesPathExist loc)
 			( do
-				absloc <- absPath (fromRawFilePath loc)
+				absloc <- absPath loc
-				createSymbolicLink absloc file
+				R.createSymbolicLink absloc (toRawFilePath file)
 			, giveup "remote does not contain key"
 			)
 	| Git.repoIsSsh repo = Just $ \key af file ->
@@ -692,7 +692,7 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
 				let rsp = RetrievalAllKeysSecure
 				res <- Annex.Content.getViaTmp rsp verify key $ \dest ->
 					metered (Just (combineMeterUpdate meterupdate p)) key $ \_ p' -> 
-						copier object dest p' (liftIO checksuccessio)
+						copier object (fromRawFilePath dest) p' (liftIO checksuccessio)
 				Annex.Content.saveState True
 				return res
 			)

Remote/Rsync.hs

@@ -352,7 +352,7 @@ sendParams = ifM crippledFileSystem
  - up trees for rsync. -}
 withRsyncScratchDir :: (FilePath -> Annex a) -> Annex a
 withRsyncScratchDir a = do
-	t <- fromRepo gitAnnexTmpObjectDir
+	t <- fromRawFilePath <$> fromRepo gitAnnexTmpObjectDir
 	withTmpDirIn t "rsynctmp" a
 
 rsyncRetrieve :: RsyncOpts -> [RsyncUrl] -> FilePath -> Maybe MeterUpdate -> Annex ()