finished this stage of the RawFilePath conversion

Finally compiles again, and test suite passes.

This commit was sponsored by Brock Spratlen on Patreon.

Assistant/Pairing/MakeRemote.hs

@@ -26,7 +26,7 @@ setupAuthorizedKeys :: PairMsg -> FilePath -> IO ()
 setupAuthorizedKeys msg repodir = case validateSshPubKey $ remoteSshPubKey $ pairMsgData msg of
 	Left err -> error err
 	Right pubkey -> do
-		absdir <- absPath repodir
+		absdir <- fromRawFilePath <$> absPath (toRawFilePath repodir)
 		unlessM (liftIO $ addAuthorizedKeys True absdir pubkey) $
 			error "failed setting up ssh authorized keys"
 

Assistant/Repair.hs

@@ -91,10 +91,10 @@ runRepair u mrmt destructiverepair = do
 	remoterepair fsckresults = case Remote.repairRepo =<< mrmt of
 		Nothing -> return False
 		Just mkrepair -> do
-			thisrepopath <- liftIO . absPath . fromRawFilePath
+			thisrepopath <- liftIO . absPath
 				=<< liftAnnex (fromRepo Git.repoPath)
 			a <- liftAnnex $ mkrepair $
-				repair fsckresults (Just thisrepopath)
+				repair fsckresults (Just (fromRawFilePath thisrepopath))
 			liftIO $ catchBoolIO a
 
 	repair fsckresults referencerepo = do

Assistant/Restart.hs

@@ -17,6 +17,7 @@ import Utility.ThreadScheduler
 import Utility.NotificationBroadcaster
 import Utility.Url
 import Utility.PID
+import qualified Utility.RawFilePath as R
 import qualified Git.Construct
 import qualified Git.Config
 import qualified Annex
@@ -39,8 +40,8 @@ import Network.URI
 prepRestart :: Assistant ()
 prepRestart = do
 	liftIO . maybe noop (`throwTo` PauseWatcher) =<< namedThreadId watchThread
-	liftIO . removeWhenExistsWith removeLink =<< liftAnnex (fromRepo gitAnnexUrlFile)
-	liftIO . removeWhenExistsWith removeLink =<< liftAnnex (fromRepo gitAnnexPidFile)
+	liftIO . removeWhenExistsWith R.removeLink =<< liftAnnex (fromRepo gitAnnexUrlFile)
+	liftIO . removeWhenExistsWith R.removeLink =<< liftAnnex (fromRepo gitAnnexPidFile)
 
 {- To finish a restart, send a global redirect to the new url
  - to any web browsers that are displaying the webapp.
@@ -75,8 +76,8 @@ newAssistantUrl repo = do
 	geturl
   where
 	geturl = do
-		r <- Git.Config.read =<< Git.Construct.fromPath repo
-		waiturl $ gitAnnexUrlFile r
+		r <- Git.Config.read =<< Git.Construct.fromPath (toRawFilePath repo)
+		waiturl $ fromRawFilePath $ gitAnnexUrlFile r
 	waiturl urlfile = do
 		v <- tryIO $ readFile urlfile
 		case v of

Assistant/Threads/Committer.hs

@@ -57,10 +57,11 @@ commitThread = namedThread "Committer" $ do
 	liftAnnex $ do
 		-- Clean up anything left behind by a previous process
 		-- on unclean shutdown.
-		void $ liftIO $ tryIO $ removeDirectoryRecursive lockdowndir
+		void $ liftIO $ tryIO $ removeDirectoryRecursive
+			(fromRawFilePath lockdowndir)
 		void $ createAnnexDirectory lockdowndir
 	waitChangeTime $ \(changes, time) -> do
-		readychanges <- handleAdds lockdowndir havelsof delayadd $
+		readychanges <- handleAdds (fromRawFilePath lockdowndir) havelsof delayadd $
 			simplifyChanges changes
 		if shouldCommit False time (length readychanges) readychanges
 			then do
@@ -261,7 +262,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
 	let (pending, inprocess) = partition isPendingAddChange incomplete
 	let lockdownconfig = LockDownConfig
 		{ lockingFile = False
-		, hardlinkFileTmpDir = Just lockdowndir
+		, hardlinkFileTmpDir = Just (toRawFilePath lockdowndir)
 		}
 	(postponed, toadd) <- partitionEithers
 		<$> safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess
@@ -304,7 +305,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
 		delta <- liftAnnex getTSDelta
 		let cfg = LockDownConfig
 			{ lockingFile = False
-			, hardlinkFileTmpDir = Just lockdowndir
+			, hardlinkFileTmpDir = Just (toRawFilePath lockdowndir)
 			}
 		if M.null m
 			then forM toadd (add cfg)

Assistant/Threads/Merger.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Assistant.Threads.Merger where
 
 import Assistant.Common
@@ -13,6 +15,7 @@ import Assistant.BranchChange
 import Assistant.Sync
 import Utility.DirWatcher
 import Utility.DirWatcher.Types
+import Utility.Directory.Create
 import Annex.CurrentBranch
 import qualified Annex
 import qualified Annex.Branch
@@ -21,13 +24,15 @@ import qualified Git.Branch
 import qualified Git.Ref
 import qualified Command.Sync
 
+import qualified System.FilePath.ByteString as P
+
 {- This thread watches for changes to .git/refs/, and handles incoming
  - pushes. -}
 mergeThread :: NamedThread
 mergeThread = namedThread "Merger" $ do
 	g <- liftAnnex gitRepo
-	let gitd = fromRawFilePath (Git.localGitDir g)
-	let dir = gitd </> "refs"
+	let gitd = Git.localGitDir g
+	let dir = gitd P.</> "refs"
 	liftIO $ createDirectoryUnder gitd dir
 	let hook a = Just <$> asIO2 (runHandler a)
 	changehook <- hook onChange
@@ -37,8 +42,8 @@ mergeThread = namedThread "Merger" $ do
 		, modifyHook = changehook
 		, errHook = errhook
 		}
-	void $ liftIO $ watchDir dir (const False) True hooks id
-	debug ["watching", dir]
+	void $ liftIO $ watchDir (fromRawFilePath dir) (const False) True hooks id
+	debug ["watching", fromRawFilePath dir]
 
 type Handler = FilePath -> Assistant ()
 

Assistant/Threads/MountWatcher.hs

@@ -159,7 +159,7 @@ handleMount urlrenderer dir = do
  -}
 remotesUnder :: FilePath -> Assistant [Remote]
 remotesUnder dir = do
-	repotop <- liftAnnex $ fromRawFilePath <$> fromRepo Git.repoPath
+	repotop <- liftAnnex $ fromRepo Git.repoPath
 	rs <- liftAnnex remoteList
 	pairs <- liftAnnex $ mapM (checkremote repotop) rs
 	let (waschanged, rs') = unzip pairs
@@ -169,7 +169,7 @@ remotesUnder dir = do
 	return $ mapMaybe snd $ filter fst pairs
   where
 	checkremote repotop r = case Remote.localpath r of
-		Just p | dirContains dir (absPathFrom repotop p) ->
+		Just p | dirContains (toRawFilePath dir) (absPathFrom repotop (toRawFilePath p)) ->
 			(,) <$> pure True <*> updateRemote r
 		_ -> return (False, Just r)
 

Assistant/Threads/SanityChecker.hs

@@ -221,7 +221,7 @@ hourlyCheck = do
  -}
 checkLogSize :: Int -> Assistant ()
 checkLogSize n = do
-	f <- liftAnnex $ fromRepo gitAnnexDaemonLogFile
+	f <- liftAnnex $ fromRawFilePath <$> fromRepo gitAnnexDaemonLogFile
 	logs <- liftIO $ listLogs f
 	totalsize <- liftIO $ sum <$> mapM getFileSize logs
 	when (totalsize > 2 * oneMegabyte) $ do

Assistant/Threads/TransferPoller.hs

@@ -37,7 +37,7 @@ transferPollerThread = namedThread "TransferPoller" $ do
 		 - temp file being used for the transfer. -}
 		| transferDirection t == Download = do
 			let f = gitAnnexTmpObjectLocation (transferKey t) g
-			sz <- liftIO $ catchMaybeIO $ getFileSize f
+			sz <- liftIO $ catchMaybeIO $ getFileSize (fromRawFilePath f)
 			newsize t info sz
 		{- Uploads don't need to be polled for when the TransferWatcher
 		 - thread can track file modifications. -}
@@ -47,7 +47,7 @@ transferPollerThread = namedThread "TransferPoller" $ do
 		| otherwise = do
 			let f = transferFile t g
 			mi <- liftIO $ catchDefaultIO Nothing $
-				readTransferInfoFile Nothing f
+				readTransferInfoFile Nothing (fromRawFilePath f)
 			maybe noop (newsize t info . bytesComplete) mi
 
 	newsize t info sz

Assistant/Threads/TransferWatcher.hs

@@ -37,7 +37,7 @@ transferWatcherThread = namedThread "TransferWatcher" $ do
 		, modifyHook = modifyhook
 		, errHook = errhook
 		}
-	void $ liftIO $ watchDir dir (const False) True hooks id
+	void $ liftIO $ watchDir (fromRawFilePath dir) (const False) True hooks id
 	debug ["watching for transfers"]
 
 type Handler = FilePath -> Assistant ()

Assistant/Threads/UpgradeWatcher.hs

@@ -46,7 +46,7 @@ upgradeWatcherThread urlrenderer = namedThread "UpgradeWatcher" $ do
 			, modifyHook = changed
 			, delDirHook = changed
 			}
-		let dir = parentDir flagfile
+		let dir = fromRawFilePath (parentDir (toRawFilePath flagfile))
 		let depth = length (splitPath dir) + 1
 		let nosubdirs f = length (splitPath f) == depth
 		void $ liftIO $ watchDir dir nosubdirs False hooks (startup mvar)

Assistant/Threads/Watcher.hs

@@ -24,6 +24,7 @@ import Assistant.Alert
 import Utility.DirWatcher
 import Utility.DirWatcher.Types
 import Utility.InodeCache
+import qualified Utility.RawFilePath as R
 import qualified Annex
 import qualified Annex.Queue
 import qualified Git
@@ -169,7 +170,7 @@ ignored = ig . takeFileName
 	ig _ = False
 
 unlessIgnored :: FilePath -> Assistant (Maybe Change) -> Assistant (Maybe Change)
-unlessIgnored file a = ifM (liftAnnex $ checkIgnored (CheckGitIgnore True) file)
+unlessIgnored file a = ifM (liftAnnex $ checkIgnored (CheckGitIgnore True) (toRawFilePath file))
 	( noChange
 	, a
 	)
@@ -194,7 +195,7 @@ runHandler handler file filestatus = void $ do
 
 {- Small files are added to git as-is, while large ones go into the annex. -}
 add :: GetFileMatcher -> FilePath -> Assistant (Maybe Change)
-add largefilematcher file = ifM (liftAnnex $ checkFileMatcher largefilematcher file)
+add largefilematcher file = ifM (liftAnnex $ checkFileMatcher largefilematcher (toRawFilePath file))
 	( pendingAddChange file
 	, do
 		liftAnnex $ Annex.Queue.addCommand "add"
@@ -280,7 +281,7 @@ onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkss
 						Nothing -> noop
 						Just key -> liftAnnex $
 							addassociatedfile key file
-					onAddSymlink' (Just $ fromRawFilePath lt) mk file fs
+					onAddSymlink' (Just lt) mk file fs
 
 {- A symlink might be an arbitrary symlink, which is just added.
  - Or, if it is a git-annex symlink, ensure it points to the content
@@ -288,15 +289,17 @@ onAddUnlocked' contentchanged addassociatedfile addlink samefilestatus symlinkss
  -}
 onAddSymlink :: Handler
 onAddSymlink file filestatus = unlessIgnored file $ do
-	linktarget <- liftIO (catchMaybeIO $ readSymbolicLink file)
-	kv <- liftAnnex (lookupKey (toRawFilePath file))
+	linktarget <- liftIO (catchMaybeIO $ R.readSymbolicLink file')
+	kv <- liftAnnex (lookupKey file')
 	onAddSymlink' linktarget kv file filestatus
+  where
+	file' = toRawFilePath file
 
-onAddSymlink' :: Maybe String -> Maybe Key -> Handler
+onAddSymlink' :: Maybe LinkTarget -> Maybe Key -> Handler
 onAddSymlink' linktarget mk file filestatus = go mk
   where
 	go (Just key) = do
-		link <- liftAnnex $ calcRepo $ gitAnnexLink file key
+		link <- liftAnnex $ calcRepo $ gitAnnexLink (toRawFilePath file) key
 		if linktarget == Just link
 			then ensurestaged (Just link) =<< getDaemonStatus
 			else do
@@ -326,17 +329,17 @@ onAddSymlink' linktarget mk file filestatus = go mk
 	ensurestaged Nothing _ = noChange
 
 {- For speed, tries to reuse the existing blob for symlink target. -}
-addLink :: FilePath -> FilePath -> Maybe Key -> Assistant (Maybe Change)
+addLink :: FilePath -> LinkTarget -> Maybe Key -> Assistant (Maybe Change)
 addLink file link mk = do
 	debug ["add symlink", file]
 	liftAnnex $ do
 		v <- catObjectDetails $ Ref $ encodeBS' $ ':':file
 		case v of
 			Just (currlink, sha, _type)
-				| s2w8 link == L.unpack currlink ->
+				| L.fromStrict link == currlink ->
 					stageSymlink (toRawFilePath file) sha
 			_ -> stageSymlink (toRawFilePath file)
-				=<< hashSymlink (toRawFilePath link)
+				=<< hashSymlink link
 	madeChange file $ LinkChange mk
 
 onDel :: Handler

Assistant/Threads/WebApp.hs

@@ -91,7 +91,9 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
 		else do
 			htmlshim <- getAnnex' $ fromRepo gitAnnexHtmlShim
 			urlfile <- getAnnex' $ fromRepo gitAnnexUrlFile
-			go tlssettings addr webapp htmlshim (Just urlfile)
+			go tlssettings addr webapp
+				(fromRawFilePath htmlshim)
+				(Just (fromRawFilePath urlfile))
   where
 	-- The webapp thread does not wait for the startupSanityCheckThread
 	-- to finish, so that the user interface remains responsive while
@@ -100,8 +102,7 @@ webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost
 	getreldir
 		| noannex = return Nothing
 		| otherwise = Just <$>
-			(relHome =<< absPath . fromRawFilePath
-				=<< getAnnex' (fromRepo repoPath))
+			(relHome . fromRawFilePath =<< absPath =<< getAnnex' (fromRepo repoPath))
 	go tlssettings addr webapp htmlshim urlfile = do
 		let url = myUrl tlssettings webapp addr
 		maybe noop (`writeFileProtected` url) urlfile

Assistant/Upgrade.hs

@@ -188,7 +188,7 @@ upgradeToDistribution newdir cleanup distributionfile = do
 	 - into place. -}
 	unpack = liftIO $ do
 		olddir <- oldVersionLocation
-		withTmpDirIn (parentDir newdir) "git-annex.upgrade" $ \tmpdir -> do
+		withTmpDirIn (fromRawFilePath $ parentDir $ toRawFilePath newdir) "git-annex.upgrade" $ \tmpdir -> do
 			let tarball = tmpdir </> "tar"
 			-- Cannot rely on filename extension, and this also
 			-- avoids problems if tar doesn't support transparent
@@ -219,7 +219,7 @@ upgradeToDistribution newdir cleanup distributionfile = do
 		unlessM (doesDirectoryExist dir) $
 			error $ "did not find " ++ dir ++ " in " ++ distributionfile
 	makeorigsymlink olddir = do
-		let origdir = parentDir olddir </> installBase
+		let origdir = fromRawFilePath (parentDir (toRawFilePath olddir)) </> installBase
 		removeWhenExistsWith removeLink origdir
 		createSymbolicLink newdir origdir
 
@@ -228,7 +228,7 @@ oldVersionLocation :: IO FilePath
 oldVersionLocation = readProgramFile >>= \case
 	Nothing -> error "Cannot find old distribution bundle; not upgrading."
 	Just pf -> do
-		let pdir = parentDir pf
+		let pdir = fromRawFilePath $ parentDir $ toRawFilePath pf
 #ifdef darwin_HOST_OS
 		let dirs = splitDirectories pdir
 		{- It will probably be deep inside a git-annex.app directory. -}
@@ -257,7 +257,7 @@ newVersionLocation d olddir =
 			return Nothing
   where
 	s = installBase ++ "." ++ distributionVersion d
-	topdir = parentDir olddir
+	topdir = fromRawFilePath $ parentDir $ toRawFilePath olddir
 	newloc = topdir </> s
 	trymkdir dir fallback =
 		(createDirectory dir >> return (Just dir))

Assistant/WebApp/Configurators/Delete.hs

@@ -16,7 +16,7 @@ import Assistant.ScanRemotes
 import Assistant.Sync
 import qualified Remote
 import qualified Git
-import Config.Files
+import Config.Files.AutoStart
 import Logs.Trust
 import Logs.Remote
 import Logs.PreferredContent
@@ -90,7 +90,8 @@ deleteCurrentRepository = dangerPage $ do
 				mapM_ (\r -> changeSyncable (Just r) False) rs
 
 			liftAnnex $ prepareRemoveAnnexDir dir
-			liftIO $ removeDirectoryRecursive =<< absPath dir
+			liftIO $ removeDirectoryRecursive . fromRawFilePath
+				=<< absPath (toRawFilePath dir)
 			
 			redirect ShutdownConfirmedR
 		_ -> $(widgetFile "configurators/delete/currentrepository")

Assistant/WebApp/Configurators/Edit.hs

@@ -247,7 +247,7 @@ checkAssociatedDirectory cfg (Just r) = do
 		RepoGroupStandard gr -> case associatedDirectory repoconfig gr of
 			Just d -> do
 				top <- fromRawFilePath <$> fromRepo Git.repoPath
-				createWorkTreeDirectory (top </> d)
+				createWorkTreeDirectory (toRawFilePath (top </> d))
 			Nothing -> noop
 		_ -> noop
 

Assistant/WebApp/Configurators/Local.hs

@@ -20,7 +20,7 @@ import qualified Annex
 import qualified Git
 import qualified Git.Config
 import qualified Git.Command
-import Config.Files
+import Config.Files.AutoStart
 import Utility.FreeDesktop
 import Utility.DiskFree
 #ifndef mingw32_HOST_OS
@@ -78,8 +78,8 @@ checkRepositoryPath :: Text -> IO (Either (SomeMessage WebApp) (Maybe Text))
 checkRepositoryPath p = do
 	home <- myHomeDir
 	let basepath = expandTilde home $ T.unpack p
-	path <- absPath basepath
-	let parent = parentDir path
+	path <- fromRawFilePath <$> absPath (toRawFilePath basepath)
+	let parent = fromRawFilePath $ parentDir (toRawFilePath path)
 	problems <- catMaybes <$> mapM runcheck
 		[ (return $ path == "/", "Enter the full path to use for the repository.")
 		, (return $ all isSpace basepath, "A blank path? Seems unlikely.")
@@ -354,7 +354,9 @@ combineRepos :: FilePath -> String -> Handler Remote
 combineRepos dir name = liftAnnex $ do
 	hostname <- fromMaybe "host" <$> liftIO getHostname
 	mylocation <- fromRepo Git.repoLocation
-	mypath <- liftIO $ relPathDirToFile dir mylocation
+	mypath <- liftIO $ fromRawFilePath <$> relPathDirToFile
+		(toRawFilePath dir)
+		(toRawFilePath mylocation)
 	liftIO $ inDir dir $ void $ makeGitRemote hostname mypath
 	addRemote $ makeGitRemote name dir
 
@@ -415,7 +417,9 @@ startFullAssistant path repogroup setup = do
 canWrite :: FilePath -> IO Bool		
 canWrite dir = do
 	tocheck <- ifM (doesDirectoryExist dir)
-		(return dir, return $ parentDir dir)
+		( return dir
+		, return $ fromRawFilePath $ parentDir $ toRawFilePath dir
+		)
 	catchBoolIO $ fileAccess tocheck False True False
 
 {- Gets the UUID of the git repo at a location, which may not exist, or

Assistant/WebApp/Configurators/Preferences.hs

@@ -16,7 +16,7 @@ import Assistant.WebApp.Common
 import qualified Annex
 import qualified Git
 import Config
-import Config.Files
+import Config.Files.AutoStart
 import Annex.NumCopies
 import Utility.DataUnits
 import Git.Config
@@ -24,6 +24,7 @@ import Types.Distribution
 import qualified BuildInfo
 
 import qualified Data.Text as T
+import qualified System.FilePath.ByteString as P
 
 data PrefsForm = PrefsForm
 	{ diskReserve :: Text
@@ -119,5 +120,5 @@ postPreferencesR = page "Preferences" (Just Configuration) $ do
 inAutoStartFile :: Annex Bool
 inAutoStartFile = do
 	here <- liftIO . absPath =<< fromRepo Git.repoPath
-	any (`equalFilePath` here) . toRawFilePath
+	any (`P.equalFilePath` here) . map toRawFilePath
 		<$> liftIO readAutoStartFile

Assistant/WebApp/Control.hs

@@ -73,6 +73,6 @@ getRestartThreadR name = do
 getLogR :: Handler Html
 getLogR = page "Logs" Nothing $ do
 	logfile <- liftAnnex $ fromRepo gitAnnexDaemonLogFile
-	logs <- liftIO $ listLogs logfile
+	logs <- liftIO $ listLogs (fromRawFilePath logfile)
 	logcontent <- liftIO $ concat <$> mapM readFile logs
 	$(widgetFile "control/log")

Assistant/WebApp/DashBoard.hs

@@ -118,8 +118,8 @@ getFileBrowserR = whenM openFileBrowser redirectBack
  - blocking the response to the browser on it. -}
 openFileBrowser :: Handler Bool
 openFileBrowser = do
-	path <- liftIO . absPath . fromRawFilePath
-		=<< liftAnnex (fromRepo Git.repoPath)
+	path <- fromRawFilePath 
+		<$> (liftIO . absPath =<< liftAnnex (fromRepo Git.repoPath))
 #ifdef darwin_HOST_OS
 	let cmd = "open"
 	let p = proc cmd [path]

Assistant/WebApp/OtherRepos.hs

@@ -12,9 +12,10 @@ module Assistant.WebApp.OtherRepos where
 import Assistant.Common
 import Assistant.WebApp.Types
 import Assistant.WebApp.Page
-import Config.Files
+import Config.Files.AutoStart
 import Utility.Yesod
 import Assistant.Restart
+import qualified Utility.RawFilePath as R
 
 getRepositorySwitcherR :: Handler Html
 getRepositorySwitcherR = page "Switch repository" Nothing $ do
@@ -24,9 +25,9 @@ getRepositorySwitcherR = page "Switch repository" Nothing $ do
 listOtherRepos :: IO [(String, String)]
 listOtherRepos = do
 	dirs <- readAutoStartFile
-	pwd <- getCurrentDirectory
+	pwd <- R.getCurrentDirectory
 	gooddirs <- filterM isrepo $
-		filter (\d -> not $ d `dirContains` pwd) dirs
+		filter (\d -> not $ toRawFilePath d `dirContains` pwd) dirs
 	names <- mapM relHome gooddirs
 	return $ sort $ zip names gooddirs
   where