more RawFilePath conversion

Converted file mode setting to it, and follow-on changes.

Compiles up through 369/646.

This commit was sponsored by Ethan Aubin.

Database/Benchmark.hs

@@ -25,12 +25,13 @@ import Criterion.Main
 import qualified Data.ByteString.Char8 as B8
 import System.Random
 import Control.Concurrent
+import qualified System.FilePath.ByteString as P
 #endif
 
 benchmarkDbs :: CriterionMode -> Integer -> Annex ()
 #ifdef WITH_BENCHMARK
 benchmarkDbs mode n = withTmpDirIn "." "benchmark" $ \tmpdir -> do
-	db <- benchDb tmpdir n
+	db <- benchDb (toRawFilePath tmpdir) n
 	liftIO $ runMode mode
 		[ bgroup "keys database"
 			[ getAssociatedFilesHitBench db
@@ -101,18 +102,18 @@ fileMiss = fileN 0 -- 0 is never stored
 
 data BenchDb = BenchDb H.DbQueue Integer (MVar Integer)
 
-benchDb :: FilePath -> Integer -> Annex BenchDb
+benchDb :: RawFilePath -> Integer -> Annex BenchDb
 benchDb tmpdir num = do
 	liftIO $ putStrLn $ "setting up database with " ++ show num ++ " items"
 	initDb db SQL.createTables
 	h <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable
 	liftIO $ populateAssociatedFiles h num
-	sz <- liftIO $ getFileSize (toRawFilePath db)
+	sz <- liftIO $ getFileSize db
 	liftIO $ putStrLn $ "size of database on disk: " ++ 
 		roughSize storageUnits False sz
 	mv <- liftIO $ newMVar 1
 	return (BenchDb h num mv)
   where
-	db = tmpdir </> show num </> "db"
+	db = tmpdir P.</> toRawFilePath (show num </> "db")
 
 #endif /* WITH_BENCHMARK */

Database/ContentIdentifier.hs

@@ -47,9 +47,11 @@ import qualified Git.Ref
 import qualified Git.DiffTree as DiffTree
 import Logs
 import qualified Logs.ContentIdentifier as Log
+import qualified Utility.RawFilePath as R
 
 import Database.Persist.Sql hiding (Key)
 import Database.Persist.TH
+import qualified System.FilePath.ByteString as P
 
 data ContentIdentifierHandle = ContentIdentifierHandle H.DbQueue
 
@@ -75,8 +77,8 @@ AnnexBranch
 openDb :: Annex ContentIdentifierHandle
 openDb = do
 	dbdir <- fromRawFilePath <$> fromRepo gitAnnexContentIdentifierDbDir
-	let db = dbdir </> "db"
-	unlessM (liftIO $ doesFileExist db) $ do
+	let db = dbdir P.</> "db"
+	unlessM (liftIO $ R.doesPathExist db) $ do
 		initDb db $ void $
 			runMigrationSilent migrateContentIdentifier
 	h <- liftIO $ H.openDbQueue H.SingleWriter db "content_identifiers"

Database/Export.hs

@@ -59,9 +59,11 @@ import Git.Types
 import Git.Sha
 import Git.FilePath
 import qualified Git.DiffTree
+import qualified Utility.RawFilePath as R
 
 import Database.Persist.Sql hiding (Key)
 import Database.Persist.TH
+import qualified System.FilePath.ByteString as P
 
 data ExportHandle = ExportHandle H.DbQueue UUID
 
@@ -96,9 +98,9 @@ ExportTreeCurrent
  -}
 openDb :: UUID -> Annex ExportHandle
 openDb u = do
-	dbdir <- fromRawFilePath <$> fromRepo (gitAnnexExportDbDir u)
-	let db = dbdir </> "db"
-	unlessM (liftIO $ doesFileExist db) $ do
+	dbdir <- fromRepo (gitAnnexExportDbDir u)
+	let db = dbdir P.</> "db"
+	unlessM (liftIO $ R.doesPathExist db) $ do
 		initDb db $ void $
 			runMigrationSilent migrateExport
 	h <- liftIO $ H.openDbQueue H.SingleWriter db "exported"

Database/Fsck.hs

@@ -33,10 +33,12 @@ import Annex.Locations
 import Utility.Exception
 import Annex.Common
 import Annex.LockFile
+import qualified Utility.RawFilePath as R
 
 import Database.Persist.Sql hiding (Key)
 import Database.Persist.TH
 import Data.Time.Clock
+import qualified System.FilePath.ByteString as P
 
 data FsckHandle = FsckHandle H.DbQueue UUID
 
@@ -68,8 +70,8 @@ newPass u = isJust <$> tryExclusiveLock (gitAnnexFsckDbLock u) go
 openDb :: UUID -> Annex FsckHandle
 openDb u = do
 	dbdir <- fromRepo (gitAnnexFsckDbDir u)
-	let db = fromRawFilePath dbdir </> "db"
-	unlessM (liftIO $ doesFileExist db) $ do
+	let db = dbdir P.</> "db"
+	unlessM (liftIO $ R.doesPathExist db) $ do
 		initDb db $ void $
 			runMigrationSilent migrateFsck
 	lockFileCached =<< fromRepo (gitAnnexFsckDbLock u)

Database/Handle.hs

@@ -63,10 +63,10 @@ data DbConcurrency = SingleWriter | MultiWriter
 
 {- Opens the database, but does not perform any migrations. Only use
  - once the database is known to exist and have the right tables. -}
-openDb :: DbConcurrency -> FilePath -> TableName -> IO DbHandle
+openDb :: DbConcurrency -> RawFilePath -> TableName -> IO DbHandle
 openDb dbconcurrency db tablename = do
 	jobs <- newEmptyMVar
-	worker <- async (workerThread (T.pack db) tablename jobs)
+	worker <- async (workerThread (T.pack (fromRawFilePath db)) tablename jobs)
 	
 	-- work around https://github.com/yesodweb/persistent/issues/474
 	liftIO $ fileEncoding stderr

Database/Init.hs

@@ -5,16 +5,20 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Database.Init where
 
 import Annex.Common
 import Annex.Perms
 import Utility.FileMode
 import Utility.Directory.Create
+import qualified Utility.RawFilePath as R
 
 import Database.Persist.Sqlite
-import qualified Data.Text as T
 import Lens.Micro
+import qualified Data.Text as T
+import qualified System.FilePath.ByteString as P
 
 {- Ensures that the database is freshly initialized. Deletes any
  - existing database. Pass the migration action for the database.
@@ -24,24 +28,24 @@ import Lens.Micro
  - file causes Sqlite to always use the same permissions for additional
  - files it writes later on
  -}
-initDb :: FilePath -> SqlPersistM () -> Annex ()
+initDb :: P.RawFilePath -> SqlPersistM () -> Annex ()
 initDb db migration = do
-	let dbdir = takeDirectory db
-	let tmpdbdir = dbdir ++ ".tmp"
-	let tmpdb = tmpdbdir </> "db"
-	let tdb = T.pack tmpdb
+	let dbdir = P.takeDirectory db
+	let tmpdbdir = dbdir <> ".tmp"
+	let tmpdb = tmpdbdir P.</> "db"
+	let tdb = T.pack (fromRawFilePath tmpdb)
 	top <- parentDir <$> fromRepo gitAnnexDir
 	liftIO $ do
-		createDirectoryUnder top (toRawFilePath tmpdbdir)
+		createDirectoryUnder top tmpdbdir
 		runSqliteInfo (enableWAL tdb) migration
 	setAnnexDirPerm tmpdbdir
 	-- Work around sqlite bug that prevents it from honoring
 	-- less restrictive umasks.
-	liftIO $ setFileMode tmpdb =<< defaultFileMode
+	liftIO $ R.setFileMode tmpdb =<< defaultFileMode
 	setAnnexFilePerm tmpdb
 	liftIO $ do
-		void $ tryIO $ removeDirectoryRecursive dbdir
-		rename tmpdbdir dbdir
+		void $ tryIO $ removeDirectoryRecursive (fromRawFilePath dbdir)
+		rename (fromRawFilePath tmpdbdir) (fromRawFilePath dbdir)
 
 {- Make sure that the database uses WAL mode, to prevent readers
  - from blocking writers, and prevent a writer from blocking readers.

Database/Keys.hs

@@ -43,6 +43,7 @@ import Git.FilePath
 import Git.Command
 import Git.Types
 import Git.Index
+import qualified Utility.RawFilePath as R
 
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
@@ -114,8 +115,8 @@ openDb _ st@(DbOpen _) = return st
 openDb False DbUnavailable = return DbUnavailable
 openDb createdb _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
 	dbdir <- fromRepo gitAnnexKeysDb
-	let db = fromRawFilePath dbdir </> "db"
-	dbexists <- liftIO $ doesFileExist db
+	let db = dbdir P.</> "db"
+	dbexists <- liftIO $ R.doesPathExist db
 	case (dbexists, createdb) of
 		(True, _) -> open db
 		(False, True) -> do
@@ -215,7 +216,7 @@ reconcileStaged :: H.DbQueue -> Annex ()
 reconcileStaged qh = do
 	gitindex <- inRepo currentIndexFile
 	indexcache <- fromRawFilePath <$> fromRepo gitAnnexKeysDbIndexCache
-	withTSDelta (liftIO . genInodeCache (toRawFilePath gitindex)) >>= \case
+	withTSDelta (liftIO . genInodeCache gitindex) >>= \case
 		Just cur -> 
 			liftIO (maybe Nothing readInodeCache <$> catchMaybeIO (readFile indexcache)) >>= \case
 				Nothing -> go cur indexcache

Database/Queue.hs

@@ -19,6 +19,7 @@ module Database.Queue (
 ) where
 
 import Utility.Monad
+import Utility.RawFilePath
 import Database.Handle
 
 import Database.Persist.Sqlite
@@ -36,7 +37,7 @@ data DbQueue = DQ DbHandle (MVar Queue)
 {- Opens the database queue, but does not perform any migrations. Only use
  - if the database is known to exist and have the right tables; ie after
  - running initDb. -}
-openDbQueue :: DbConcurrency -> FilePath -> TableName -> IO DbQueue
+openDbQueue :: DbConcurrency -> RawFilePath -> TableName -> IO DbQueue
 openDbQueue dbconcurrency db tablename = DQ
 	<$> openDb dbconcurrency db tablename
 	<*> (newMVar =<< emptyQueue)