more RawFilePath conversion

At 318/645 after 4k lines of changes

This commit was sponsored by Jake Vosloo on Patreon.

Logs/File.hs

@@ -29,8 +29,8 @@ import qualified Data.ByteString.Lazy.Char8 as L8
 -- | Writes content to a file, replacing the file atomically, and
 -- making the new file have whatever permissions the git repository is
 -- configured to use. Creates the parent directory when necessary.
-writeLogFile :: FilePath -> String -> Annex ()
-writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c
+writeLogFile :: RawFilePath -> String -> Annex ()
+writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (fromRawFilePath f) c
   where
 	writelog f' c' = do
 		liftIO $ writeFile f' c'
@@ -38,10 +38,10 @@ writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c
 
 -- | Runs the action with a handle connected to a temp file.
 -- The temp file replaces the log file once the action succeeds.
-withLogHandle :: FilePath -> (Handle -> Annex a) -> Annex a
+withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a
 withLogHandle f a = do
 	createAnnexDirectory (parentDir f)
-	replaceGitAnnexDirFile f $ \tmp ->
+	replaceGitAnnexDirFile (fromRawFilePath f) $ \tmp ->
 		bracket (setup tmp) cleanup a
   where
 	setup tmp = do
@@ -51,10 +51,12 @@ withLogHandle f a = do
 
 -- | Appends a line to a log file, first locking it to prevent
 -- concurrent writers.
-appendLogFile :: FilePath -> (Git.Repo -> FilePath) -> L.ByteString -> Annex ()
-appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do
-	liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c
-	setAnnexFilePerm f
+appendLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> L.ByteString -> Annex ()
+appendLogFile f lck c = 
+	createDirWhenNeeded (toRawFilePath f) $
+		withExclusiveLock lck $ do
+			liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c
+			setAnnexFilePerm f
 
 -- | Modifies a log file.
 --
@@ -64,13 +66,13 @@ appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do
 --
 -- The file is locked to prevent concurrent writers, and it is written
 -- atomically.
-modifyLogFile :: FilePath -> (Git.Repo -> FilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
+modifyLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
 modifyLogFile f lck modf = withExclusiveLock lck $ do
 	ls <- liftIO $ fromMaybe []
 		<$> tryWhenExists (L8.lines <$> L.readFile f)
 	let ls' = modf ls
 	when (ls' /= ls) $
-		createDirWhenNeeded f $
+		createDirWhenNeeded (toRawFilePath f) $
 			viaTmp writelog f (L8.unlines ls')
   where
 	writelog f' b = do
@@ -83,7 +85,7 @@ modifyLogFile f lck modf = withExclusiveLock lck $ do
 -- action is concurrently modifying the file. It does not lock the file,
 -- for speed, but instead relies on the fact that a log file usually
 -- ends in a newline.
-checkLogFile :: FilePath -> (Git.Repo -> FilePath) -> (L.ByteString -> Bool) -> Annex Bool
+checkLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> (L.ByteString -> Bool) -> Annex Bool
 checkLogFile f lck matchf = withExclusiveLock lck $ bracket setup cleanup go
   where
 	setup = liftIO $ tryWhenExists $ openFile f ReadMode
@@ -117,7 +119,7 @@ fullLines = go []
 -- 
 -- Locking is used to prevent writes to to the log file while this
 -- is running.
-streamLogFile :: FilePath -> (Git.Repo -> FilePath) -> (String -> Annex ()) -> Annex ()
+streamLogFile :: FilePath -> (Git.Repo -> RawFilePath) -> (String -> Annex ()) -> Annex ()
 streamLogFile f lck a = withExclusiveLock lck $ bracketOnError setup cleanup go
   where
 	setup = liftIO $ tryWhenExists $ openFile f ReadMode 
@@ -130,7 +132,7 @@ streamLogFile f lck a = withExclusiveLock lck $ bracketOnError setup cleanup go
 		liftIO $ writeFile f ""
 		setAnnexFilePerm f
 
-createDirWhenNeeded :: FilePath -> Annex () -> Annex ()
+createDirWhenNeeded :: RawFilePath -> Annex () -> Annex ()
 createDirWhenNeeded f a = a `catchNonAsync` \_e -> do
 	-- Most of the time, the directory will exist, so this is only
 	-- done if writing the file fails.

Logs/FsckResults.hs

@@ -15,6 +15,7 @@ import Annex.Common
 import Git.Fsck
 import Git.Types
 import Logs.File
+import qualified Utility.RawFilePath as R
 
 import qualified Data.Set as S
 
@@ -24,7 +25,8 @@ writeFsckResults u fsckresults = do
 	case fsckresults of
 		FsckFailed -> store S.empty False logfile
 		FsckFoundMissing s t
-			| S.null s -> liftIO $ removeWhenExistsWith removeLink logfile
+			| S.null s -> liftIO $
+				removeWhenExistsWith R.removeLink logfile
 			| otherwise -> store s t logfile
   where
 	store s t logfile = writeLogFile logfile $ serialize s t
@@ -38,7 +40,7 @@ readFsckResults :: UUID -> Annex FsckResults
 readFsckResults u = do
 	logfile <- fromRepo $ gitAnnexFsckResultsLog u
 	liftIO $ catchDefaultIO (FsckFoundMissing S.empty False) $
-		deserialize . lines <$> readFile logfile
+		deserialize . lines <$> readFile (fromRawFilePath logfile)
   where
 	deserialize ("truncated":ls) = deserialize' ls True
 	deserialize ls = deserialize' ls False
@@ -47,6 +49,6 @@ readFsckResults u = do
 		in if S.null s then FsckFailed else FsckFoundMissing s t
 
 clearFsckResults :: UUID -> Annex ()
-clearFsckResults = liftIO . removeWhenExistsWith removeLink
+clearFsckResults = liftIO . removeWhenExistsWith R.removeLink
 	<=< fromRepo . gitAnnexFsckResultsLog
 	

Logs/Transfer.hs

@@ -5,6 +5,7 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE CPP #-}
 
 module Logs.Transfer where
@@ -19,6 +20,7 @@ import Utility.PID
 import Annex.LockPool
 import Utility.TimeStamp
 import Logs.File
+import qualified Utility.RawFilePath as R
 #ifndef mingw32_HOST_OS
 import Annex.Perms
 #endif
@@ -26,6 +28,8 @@ import Annex.Perms
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Control.Concurrent
+import qualified Data.ByteString.Char8 as B8
+import qualified System.FilePath.ByteString as P
 
 describeTransfer :: Transfer -> TransferInfo -> String
 describeTransfer t info = unwords
@@ -56,12 +60,12 @@ percentComplete t info =
  - which should be run after locking the transfer lock file, but
  - before using the callback, and a MVar that can be used to read
  - the number of bytesComplete. -}
-mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, Annex (), MVar Integer)
+mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, RawFilePath, Annex (), MVar Integer)
 mkProgressUpdater t info = do
 	tfile <- fromRepo $ transferFile t
 	let createtfile = void $ tryNonAsync $ writeTransferInfoFile info tfile
 	mvar <- liftIO $ newMVar 0
-	return (liftIO . updater tfile mvar, tfile, createtfile, mvar)
+	return (liftIO . updater (fromRawFilePath tfile) mvar, tfile, createtfile, mvar)
   where
 	updater tfile mvar b = modifyMVar_ mvar $ \oldbytes -> do
 		let newbytes = fromBytesProcessed b
@@ -103,13 +107,13 @@ checkTransfer t = debugLocks $ do
 	tfile <- fromRepo $ transferFile t
 	let lck = transferLockFile tfile
 	let cleanstale = do
-		void $ tryIO $ removeFile tfile
-		void $ tryIO $ removeFile lck
+		void $ tryIO $ R.removeLink tfile
+		void $ tryIO $ R.removeLink lck
 #ifndef mingw32_HOST_OS
 	v <- getLockStatus lck
 	case v of
 		StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $
-			readTransferInfoFile (Just pid) tfile
+			readTransferInfoFile (Just pid) (fromRawFilePath tfile)
 		_ -> do
 			-- Take a non-blocking lock while deleting
 			-- the stale lock file. Ignore failure
@@ -145,7 +149,7 @@ getTransfers' dirs wanted = do
 	infos <- mapM checkTransfer transfers
 	return $ mapMaybe running $ zip transfers infos
   where
-	findfiles = liftIO . mapM dirContentsRecursive
+	findfiles = liftIO . mapM (dirContentsRecursive . fromRawFilePath)
 		=<< mapM (fromRepo . transferDir) dirs
 	running (t, Just i) = Just (t, i)
 	running (_, Nothing) = Nothing
@@ -172,7 +176,7 @@ getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles
 		return $ case (mt, mi) of
 			(Just t, Just i) -> Just (t, i)
 			_ -> Nothing
-	findfiles = liftIO . mapM dirContentsRecursive
+	findfiles = liftIO . mapM (dirContentsRecursive . fromRawFilePath)
 		=<< mapM (fromRepo . failedTransferDir u) [Download, Upload]
 
 clearFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)]
@@ -184,7 +188,7 @@ clearFailedTransfers u = do
 removeFailedTransfer :: Transfer -> Annex ()
 removeFailedTransfer t = do
 	f <- fromRepo $ failedTransferFile t
-	liftIO $ void $ tryIO $ removeFile f
+	liftIO $ void $ tryIO $ R.removeLink f
 
 recordFailedTransfer :: Transfer -> TransferInfo -> Annex ()
 recordFailedTransfer t info = do
@@ -192,20 +196,23 @@ recordFailedTransfer t info = do
 	writeTransferInfoFile info failedtfile
 
 {- The transfer information file to use for a given Transfer. -}
-transferFile :: Transfer -> Git.Repo -> FilePath
-transferFile (Transfer direction u kd) r = transferDir direction r
-	</> filter (/= '/') (fromUUID u)
-	</> fromRawFilePath (keyFile (mkKey (const kd)))
+transferFile :: Transfer -> Git.Repo -> RawFilePath
+transferFile (Transfer direction u kd) r =
+	transferDir direction r
+		P.</> B8.filter (/= '/') (fromUUID u)
+		P.</> keyFile (mkKey (const kd))
 
 {- The transfer information file to use to record a failed Transfer -}
-failedTransferFile :: Transfer -> Git.Repo -> FilePath
-failedTransferFile (Transfer direction u kd) r = failedTransferDir u direction r
-	</> fromRawFilePath (keyFile (mkKey (const kd)))
+failedTransferFile :: Transfer -> Git.Repo -> RawFilePath
+failedTransferFile (Transfer direction u kd) r = 
+	failedTransferDir u direction r
+		P.</> keyFile (mkKey (const kd))
 
 {- The transfer lock file corresponding to a given transfer info file. -}
-transferLockFile :: FilePath -> FilePath
-transferLockFile infofile = let (d,f) = splitFileName infofile in
-	combine d ("lck." ++ f)
+transferLockFile :: RawFilePath -> RawFilePath
+transferLockFile infofile = 
+	let (d, f) = P.splitFileName infofile
+	in P.combine d ("lck." <> f)
 
 {- Parses a transfer information filename to a Transfer. -}
 parseTransferFile :: FilePath -> Maybe Transfer
@@ -220,7 +227,7 @@ parseTransferFile file
   where
 	bits = splitDirectories file
 
-writeTransferInfoFile :: TransferInfo -> FilePath -> Annex ()
+writeTransferInfoFile :: TransferInfo -> RawFilePath -> Annex ()
 writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info
 
 -- The file keeps whatever permissions it has, so should be used only
@@ -286,16 +293,16 @@ readTransferInfo mpid s = TransferInfo
 		else pure Nothing -- not failure
 
 {- The directory holding transfer information files for a given Direction. -}
-transferDir :: Direction -> Git.Repo -> FilePath
-transferDir direction r = gitAnnexTransferDir r </> formatDirection direction
+transferDir :: Direction -> Git.Repo -> RawFilePath
+transferDir direction r = gitAnnexTransferDir r P.</> formatDirection direction
 
 {- The directory holding failed transfer information files for a given
  - Direction and UUID -}
-failedTransferDir :: UUID -> Direction -> Git.Repo -> FilePath
+failedTransferDir :: UUID -> Direction -> Git.Repo -> RawFilePath
 failedTransferDir u direction r = gitAnnexTransferDir r
-	</> "failed"
-	</> formatDirection direction
-	</> filter (/= '/') (fromUUID u)
+	P.</> "failed"
+	P.</> formatDirection direction
+	P.</> B8.filter (/= '/') (fromUUID u)
 
 prop_read_write_transferinfo :: TransferInfo -> Bool
 prop_read_write_transferinfo info

Logs/Unused.hs

@@ -15,6 +15,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Logs.Unused (
 	UnusedMap,
 	updateUnusedLog,
@@ -55,13 +57,13 @@ preserveTimestamps oldl newl = M.intersection (M.unionWith oldts oldl newl) newl
   where
 	oldts _old@(_, ts) _new@(int, _) = (int, ts)
 
-updateUnusedLog :: FilePath -> UnusedMap -> Annex ()
+updateUnusedLog :: RawFilePath -> UnusedMap -> Annex ()
 updateUnusedLog prefix m = do
 	oldl <- readUnusedLog prefix
 	newl <- preserveTimestamps oldl . flip map2log m <$> liftIO getPOSIXTime
 	writeUnusedLog prefix newl
 
-writeUnusedLog :: FilePath -> UnusedLog -> Annex ()
+writeUnusedLog :: RawFilePath -> UnusedLog -> Annex ()
 writeUnusedLog prefix l = do
 	logfile <- fromRepo $ gitAnnexUnusedLog prefix
 	writeLogFile logfile $ unlines $ map format $ M.toList l
@@ -69,9 +71,9 @@ writeUnusedLog prefix l = do
 	format (k, (i, Just t)) = show i ++ " " ++ serializeKey k ++ " " ++ show t
 	format (k, (i, Nothing)) = show i ++ " " ++ serializeKey k
 
-readUnusedLog :: FilePath -> Annex UnusedLog
+readUnusedLog :: RawFilePath -> Annex UnusedLog
 readUnusedLog prefix = do
-	f <- fromRepo $ gitAnnexUnusedLog prefix
+	f <- fromRawFilePath <$> fromRepo (gitAnnexUnusedLog prefix)
 	ifM (liftIO $ doesFileExist f)
 		( M.fromList . mapMaybe parse . lines
 			<$> liftIO (readFileStrict f)
@@ -87,13 +89,13 @@ readUnusedLog prefix = do
 		skey = reverse rskey
 		ts = reverse rts
 
-readUnusedMap :: FilePath -> Annex UnusedMap
+readUnusedMap :: RawFilePath -> Annex UnusedMap
 readUnusedMap = log2map <$$> readUnusedLog
 
-dateUnusedLog :: FilePath -> Annex (Maybe UTCTime)
+dateUnusedLog :: RawFilePath -> Annex (Maybe UTCTime)
 dateUnusedLog prefix = do
 	f <- fromRepo $ gitAnnexUnusedLog prefix
-	liftIO $ catchMaybeIO $ getModificationTime f
+	liftIO $ catchMaybeIO $ getModificationTime $ fromRawFilePath f
 
 {- Set of unused keys. This is cached for speed. -}
 unusedKeys :: Annex (S.Set Key)

Logs/View.hs

@@ -50,7 +50,7 @@ removeView v = writeViews =<< filter (/= v) <$> recentViews
 
 recentViews :: Annex [View]
 recentViews = do
-	f <- fromRepo gitAnnexViewLog
+	f <- fromRawFilePath <$> fromRepo gitAnnexViewLog
 	liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)
 
 {- Gets the currently checked out view, if there is one. -}