From c64731f16a281f425685d71b6c050704bdb872d7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 25 Jan 2025 11:56:35 -0400 Subject: [PATCH] more OsPath conversion --- Annex/Fixup.hs | 31 ++++++++++++++++--------------- Database/Handle.hs | 27 ++++++++++++++------------- Database/Queue.hs | 4 ++-- Utility/LockFile/Posix.hs | 1 - 4 files changed, 32 insertions(+), 31 deletions(-) diff --git a/Annex/Fixup.hs b/Annex/Fixup.hs index 112c55224a..f27ab45e38 100644 --- a/Annex/Fixup.hs +++ b/Annex/Fixup.hs @@ -18,10 +18,11 @@ import Utility.SafeCommand import Utility.Directory import Utility.Exception import Utility.Monad -import Utility.FileSystemEncoding import Utility.SystemDirectory +import Utility.OsPath import qualified Utility.RawFilePath as R import Utility.PartialPrelude +import qualified Utility.OsString as OS import System.IO import Data.List @@ -29,8 +30,6 @@ import Data.Maybe import Control.Monad import Control.Monad.IfElse import qualified Data.Map as M -import qualified Data.ByteString as S -import System.FilePath.ByteString import Control.Applicative import Prelude @@ -109,28 +108,30 @@ fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d , return r ) where - dotgit = w ".git" + dotgit = w literalOsPath ".git" - replacedotgit = whenM (doesFileExist (fromRawFilePath dotgit)) $ do + replacedotgit = whenM (doesFileExist dotgit) $ do linktarget <- relPathDirToFile w d - removeWhenExistsWith R.removeLink dotgit - R.createSymbolicLink linktarget dotgit + let dotgit' = fromOsPath dotgit + removeWhenExistsWith R.removeLink dotgit' + R.createSymbolicLink (fromOsPath linktarget) dotgit' -- Unsetting a config fails if it's not set, so ignore failure. unsetcoreworktree = void $ Git.Config.unset "core.worktree" r - worktreefixup = + worktreefixup = do -- git-worktree sets up a "commondir" file that contains -- the path to the main git directory. -- Using --separate-git-dir does not. - catchDefaultIO Nothing (headMaybe . lines <$> readFile (fromRawFilePath (d "commondir"))) >>= \case + let commondirfile = fromOsPath (d literalOsPath "commondir") + catchDefaultIO Nothing (headMaybe . lines <$> readFile commondirfile) >>= \case Just gd -> do -- Make the worktree's git directory -- contain an annex symlink to the main -- repository's annex directory. - let linktarget = toRawFilePath gd "annex" - R.createSymbolicLink linktarget - (dotgit "annex") + let linktarget = toOsPath gd literalOsPath "annex" + R.createSymbolicLink (fromOsPath linktarget) $ + fromOsPath $ dotgit literalOsPath "annex" Nothing -> return () -- Repo adjusted, so that symlinks to objects that get checked @@ -143,7 +144,7 @@ fixupUnusualRepos r _ = return r needsSubmoduleFixup :: Repo -> Bool needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) = - (".git" "modules") `S.isInfixOf` d + (literalOsPath ".git" literalOsPath "modules") `OS.isInfixOf` d needsSubmoduleFixup _ = False needsGitLinkFixup :: Repo -> IO Bool @@ -151,6 +152,6 @@ needsGitLinkFixup (Repo { location = (Local { worktree = Just wt, gitdir = d }) -- Optimization: Avoid statting .git in the common case; only -- when the gitdir is not in the usual place inside the worktree -- might .git be a file. - | wt ".git" == d = return False - | otherwise = doesFileExist (fromRawFilePath (wt ".git")) + | wt literalOsPath ".git" == d = return False + | otherwise = doesFileExist (wt literalOsPath ".git") needsGitLinkFixup _ = return False diff --git a/Database/Handle.hs b/Database/Handle.hs index 23e7df2d33..ff358f7588 100644 --- a/Database/Handle.hs +++ b/Database/Handle.hs @@ -23,6 +23,7 @@ import Utility.FileSystemEncoding import Utility.Debug import Utility.DebugLocks import Utility.InodeCache +import Utility.OsPath import Database.Persist.Sqlite import qualified Database.Sqlite as Sqlite @@ -41,14 +42,14 @@ import System.IO {- A DbHandle is a reference to a worker thread that communicates with - the database. It has a MVar which Jobs are submitted to. - There is also an MVar which it will fill when there is a fatal error-} -data DbHandle = DbHandle RawFilePath (Async ()) (MVar Job) (MVar String) +data DbHandle = DbHandle OsPath (Async ()) (MVar Job) (MVar String) {- Name of a table that should exist once the database is initialized. -} type TableName = String {- Opens the database, but does not perform any migrations. Only use - once the database is known to exist and have the right tables. -} -openDb :: RawFilePath -> TableName -> IO DbHandle +openDb :: OsPath -> TableName -> IO DbHandle openDb db tablename = do jobs <- newEmptyMVar errvar <- newEmptyMVar @@ -135,7 +136,7 @@ data Job | ChangeJob (SqlPersistM ()) | CloseJob -workerThread :: RawFilePath -> TableName -> MVar Job -> MVar String -> IO () +workerThread :: OsPath -> TableName -> MVar Job -> MVar String -> IO () workerThread db tablename jobs errvar = newconn where newconn = do @@ -174,7 +175,7 @@ workerThread db tablename jobs errvar = newconn - retrying only if the database shows signs of being modified by another - process at least once each 30 seconds. -} -runSqliteRobustly :: TableName -> RawFilePath -> (SqlPersistM a) -> IO a +runSqliteRobustly :: TableName -> OsPath -> (SqlPersistM a) -> IO a runSqliteRobustly tablename db a = do conn <- opensettle maxretries emptyDatabaseInodeCache go conn maxretries emptyDatabaseInodeCache @@ -194,9 +195,9 @@ runSqliteRobustly tablename db a = do opensettle retries ic = do #if MIN_VERSION_persistent_sqlite(2,13,3) - conn <- Sqlite.open' db + conn <- Sqlite.open' (fromOsPath db) #else - conn <- Sqlite.open (T.pack (fromRawFilePath db)) + conn <- Sqlite.open (T.pack (fromOsPath db)) #endif settle conn retries ic @@ -237,7 +238,7 @@ withSqlConnRobustly , BaseBackend backend ~ SqlBackend , BackendCompatible SqlBackend backend ) - => RawFilePath + => OsPath -> (LogFunc -> IO backend) -> (backend -> m a) -> m a @@ -260,7 +261,7 @@ closeRobustly , BaseBackend backend ~ SqlBackend , BackendCompatible SqlBackend backend ) - => RawFilePath + => OsPath -> backend -> IO () closeRobustly db conn = go maxretries emptyDatabaseInodeCache @@ -294,7 +295,7 @@ retryHelper => String -> err -> Int - -> RawFilePath + -> OsPath -> Int -> DatabaseInodeCache -> (Int -> DatabaseInodeCache -> IO a) @@ -309,9 +310,9 @@ retryHelper action err maxretries db retries ic a = do else giveup (databaseAccessStalledMsg action db err) else a retries' ic -databaseAccessStalledMsg :: Show err => String -> RawFilePath -> err -> String +databaseAccessStalledMsg :: Show err => String -> OsPath -> err -> String databaseAccessStalledMsg action db err = - "Repeatedly unable to " ++ action ++ " sqlite database " ++ fromRawFilePath db + "Repeatedly unable to " ++ action ++ " sqlite database " ++ fromOsPath db ++ ": " ++ show err ++ ". " ++ "Perhaps another git-annex process is suspended and is " ++ "keeping this database locked?" @@ -321,10 +322,10 @@ data DatabaseInodeCache = DatabaseInodeCache (Maybe InodeCache) (Maybe InodeCach emptyDatabaseInodeCache :: DatabaseInodeCache emptyDatabaseInodeCache = DatabaseInodeCache Nothing Nothing -getDatabaseInodeCache :: RawFilePath -> IO DatabaseInodeCache +getDatabaseInodeCache :: OsPath -> IO DatabaseInodeCache getDatabaseInodeCache db = DatabaseInodeCache <$> genInodeCache db noTSDelta - <*> genInodeCache (db <> "-wal") noTSDelta + <*> genInodeCache (db <> literalOsPath "-wal") noTSDelta isDatabaseModified :: DatabaseInodeCache -> DatabaseInodeCache -> Bool isDatabaseModified (DatabaseInodeCache a1 b1) (DatabaseInodeCache a2 b2) = diff --git a/Database/Queue.hs b/Database/Queue.hs index 8e941fa66c..0f3f5233ba 100644 --- a/Database/Queue.hs +++ b/Database/Queue.hs @@ -19,9 +19,9 @@ module Database.Queue ( ) where import Utility.Monad -import Utility.RawFilePath import Utility.DebugLocks import Utility.Exception +import Utility.OsPath import Database.Handle import Database.Persist.Sqlite @@ -39,7 +39,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 :: RawFilePath -> TableName -> IO DbQueue +openDbQueue :: OsPath -> TableName -> IO DbQueue openDbQueue db tablename = DQ <$> openDb db tablename <*> (newMVar =<< emptyQueue) diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs index e05f813e99..5c7dd33f08 100644 --- a/Utility/LockFile/Posix.hs +++ b/Utility/LockFile/Posix.hs @@ -31,7 +31,6 @@ import System.IO import System.Posix.Types import System.Posix.IO.ByteString import System.Posix.Files.ByteString -import System.FilePath.ByteString (RawFilePath) import Data.Maybe type LockFile = OsPath