more OsPath conversion

This commit is contained in:
Joey Hess 2025-01-25 11:56:35 -04:00
parent 5bca78b813
commit c64731f16a
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 32 additions and 31 deletions

View file

@ -18,10 +18,11 @@ import Utility.SafeCommand
import Utility.Directory import Utility.Directory
import Utility.Exception import Utility.Exception
import Utility.Monad import Utility.Monad
import Utility.FileSystemEncoding
import Utility.SystemDirectory import Utility.SystemDirectory
import Utility.OsPath
import qualified Utility.RawFilePath as R import qualified Utility.RawFilePath as R
import Utility.PartialPrelude import Utility.PartialPrelude
import qualified Utility.OsString as OS
import System.IO import System.IO
import Data.List import Data.List
@ -29,8 +30,6 @@ import Data.Maybe
import Control.Monad import Control.Monad
import Control.Monad.IfElse import Control.Monad.IfElse
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString as S
import System.FilePath.ByteString
import Control.Applicative import Control.Applicative
import Prelude import Prelude
@ -109,28 +108,30 @@ fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d
, return r , return r
) )
where where
dotgit = w </> ".git" dotgit = w </> literalOsPath ".git"
replacedotgit = whenM (doesFileExist (fromRawFilePath dotgit)) $ do replacedotgit = whenM (doesFileExist dotgit) $ do
linktarget <- relPathDirToFile w d linktarget <- relPathDirToFile w d
removeWhenExistsWith R.removeLink dotgit let dotgit' = fromOsPath dotgit
R.createSymbolicLink linktarget dotgit removeWhenExistsWith R.removeLink dotgit'
R.createSymbolicLink (fromOsPath linktarget) dotgit'
-- Unsetting a config fails if it's not set, so ignore failure. -- Unsetting a config fails if it's not set, so ignore failure.
unsetcoreworktree = void $ Git.Config.unset "core.worktree" r unsetcoreworktree = void $ Git.Config.unset "core.worktree" r
worktreefixup = worktreefixup = do
-- git-worktree sets up a "commondir" file that contains -- git-worktree sets up a "commondir" file that contains
-- the path to the main git directory. -- the path to the main git directory.
-- Using --separate-git-dir does not. -- 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 Just gd -> do
-- Make the worktree's git directory -- Make the worktree's git directory
-- contain an annex symlink to the main -- contain an annex symlink to the main
-- repository's annex directory. -- repository's annex directory.
let linktarget = toRawFilePath gd </> "annex" let linktarget = toOsPath gd </> literalOsPath "annex"
R.createSymbolicLink linktarget R.createSymbolicLink (fromOsPath linktarget) $
(dotgit </> "annex") fromOsPath $ dotgit </> literalOsPath "annex"
Nothing -> return () Nothing -> return ()
-- Repo adjusted, so that symlinks to objects that get checked -- Repo adjusted, so that symlinks to objects that get checked
@ -143,7 +144,7 @@ fixupUnusualRepos r _ = return r
needsSubmoduleFixup :: Repo -> Bool needsSubmoduleFixup :: Repo -> Bool
needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) = needsSubmoduleFixup (Repo { location = (Local { worktree = Just _, gitdir = d }) }) =
(".git" </> "modules") `S.isInfixOf` d (literalOsPath ".git" </> literalOsPath "modules") `OS.isInfixOf` d
needsSubmoduleFixup _ = False needsSubmoduleFixup _ = False
needsGitLinkFixup :: Repo -> IO Bool 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 -- Optimization: Avoid statting .git in the common case; only
-- when the gitdir is not in the usual place inside the worktree -- when the gitdir is not in the usual place inside the worktree
-- might .git be a file. -- might .git be a file.
| wt </> ".git" == d = return False | wt </> literalOsPath ".git" == d = return False
| otherwise = doesFileExist (fromRawFilePath (wt </> ".git")) | otherwise = doesFileExist (wt </> literalOsPath ".git")
needsGitLinkFixup _ = return False needsGitLinkFixup _ = return False

View file

@ -23,6 +23,7 @@ import Utility.FileSystemEncoding
import Utility.Debug import Utility.Debug
import Utility.DebugLocks import Utility.DebugLocks
import Utility.InodeCache import Utility.InodeCache
import Utility.OsPath
import Database.Persist.Sqlite import Database.Persist.Sqlite
import qualified Database.Sqlite as 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 {- A DbHandle is a reference to a worker thread that communicates with
- the database. It has a MVar which Jobs are submitted to. - 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-} - 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. -} {- Name of a table that should exist once the database is initialized. -}
type TableName = String type TableName = String
{- Opens the database, but does not perform any migrations. Only use {- Opens the database, but does not perform any migrations. Only use
- once the database is known to exist and have the right tables. -} - 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 openDb db tablename = do
jobs <- newEmptyMVar jobs <- newEmptyMVar
errvar <- newEmptyMVar errvar <- newEmptyMVar
@ -135,7 +136,7 @@ data Job
| ChangeJob (SqlPersistM ()) | ChangeJob (SqlPersistM ())
| CloseJob | CloseJob
workerThread :: RawFilePath -> TableName -> MVar Job -> MVar String -> IO () workerThread :: OsPath -> TableName -> MVar Job -> MVar String -> IO ()
workerThread db tablename jobs errvar = newconn workerThread db tablename jobs errvar = newconn
where where
newconn = do newconn = do
@ -174,7 +175,7 @@ workerThread db tablename jobs errvar = newconn
- retrying only if the database shows signs of being modified by another - retrying only if the database shows signs of being modified by another
- process at least once each 30 seconds. - 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 runSqliteRobustly tablename db a = do
conn <- opensettle maxretries emptyDatabaseInodeCache conn <- opensettle maxretries emptyDatabaseInodeCache
go conn maxretries emptyDatabaseInodeCache go conn maxretries emptyDatabaseInodeCache
@ -194,9 +195,9 @@ runSqliteRobustly tablename db a = do
opensettle retries ic = do opensettle retries ic = do
#if MIN_VERSION_persistent_sqlite(2,13,3) #if MIN_VERSION_persistent_sqlite(2,13,3)
conn <- Sqlite.open' db conn <- Sqlite.open' (fromOsPath db)
#else #else
conn <- Sqlite.open (T.pack (fromRawFilePath db)) conn <- Sqlite.open (T.pack (fromOsPath db))
#endif #endif
settle conn retries ic settle conn retries ic
@ -237,7 +238,7 @@ withSqlConnRobustly
, BaseBackend backend ~ SqlBackend , BaseBackend backend ~ SqlBackend
, BackendCompatible SqlBackend backend , BackendCompatible SqlBackend backend
) )
=> RawFilePath => OsPath
-> (LogFunc -> IO backend) -> (LogFunc -> IO backend)
-> (backend -> m a) -> (backend -> m a)
-> m a -> m a
@ -260,7 +261,7 @@ closeRobustly
, BaseBackend backend ~ SqlBackend , BaseBackend backend ~ SqlBackend
, BackendCompatible SqlBackend backend , BackendCompatible SqlBackend backend
) )
=> RawFilePath => OsPath
-> backend -> backend
-> IO () -> IO ()
closeRobustly db conn = go maxretries emptyDatabaseInodeCache closeRobustly db conn = go maxretries emptyDatabaseInodeCache
@ -294,7 +295,7 @@ retryHelper
=> String => String
-> err -> err
-> Int -> Int
-> RawFilePath -> OsPath
-> Int -> Int
-> DatabaseInodeCache -> DatabaseInodeCache
-> (Int -> DatabaseInodeCache -> IO a) -> (Int -> DatabaseInodeCache -> IO a)
@ -309,9 +310,9 @@ retryHelper action err maxretries db retries ic a = do
else giveup (databaseAccessStalledMsg action db err) else giveup (databaseAccessStalledMsg action db err)
else a retries' ic else a retries' ic
databaseAccessStalledMsg :: Show err => String -> RawFilePath -> err -> String databaseAccessStalledMsg :: Show err => String -> OsPath -> err -> String
databaseAccessStalledMsg action db err = databaseAccessStalledMsg action db err =
"Repeatedly unable to " ++ action ++ " sqlite database " ++ fromRawFilePath db "Repeatedly unable to " ++ action ++ " sqlite database " ++ fromOsPath db
++ ": " ++ show err ++ ". " ++ ": " ++ show err ++ ". "
++ "Perhaps another git-annex process is suspended and is " ++ "Perhaps another git-annex process is suspended and is "
++ "keeping this database locked?" ++ "keeping this database locked?"
@ -321,10 +322,10 @@ data DatabaseInodeCache = DatabaseInodeCache (Maybe InodeCache) (Maybe InodeCach
emptyDatabaseInodeCache :: DatabaseInodeCache emptyDatabaseInodeCache :: DatabaseInodeCache
emptyDatabaseInodeCache = DatabaseInodeCache Nothing Nothing emptyDatabaseInodeCache = DatabaseInodeCache Nothing Nothing
getDatabaseInodeCache :: RawFilePath -> IO DatabaseInodeCache getDatabaseInodeCache :: OsPath -> IO DatabaseInodeCache
getDatabaseInodeCache db = DatabaseInodeCache getDatabaseInodeCache db = DatabaseInodeCache
<$> genInodeCache db noTSDelta <$> genInodeCache db noTSDelta
<*> genInodeCache (db <> "-wal") noTSDelta <*> genInodeCache (db <> literalOsPath "-wal") noTSDelta
isDatabaseModified :: DatabaseInodeCache -> DatabaseInodeCache -> Bool isDatabaseModified :: DatabaseInodeCache -> DatabaseInodeCache -> Bool
isDatabaseModified (DatabaseInodeCache a1 b1) (DatabaseInodeCache a2 b2) = isDatabaseModified (DatabaseInodeCache a1 b1) (DatabaseInodeCache a2 b2) =

View file

@ -19,9 +19,9 @@ module Database.Queue (
) where ) where
import Utility.Monad import Utility.Monad
import Utility.RawFilePath
import Utility.DebugLocks import Utility.DebugLocks
import Utility.Exception import Utility.Exception
import Utility.OsPath
import Database.Handle import Database.Handle
import Database.Persist.Sqlite 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 {- 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 - if the database is known to exist and have the right tables; ie after
- running initDb. -} - running initDb. -}
openDbQueue :: RawFilePath -> TableName -> IO DbQueue openDbQueue :: OsPath -> TableName -> IO DbQueue
openDbQueue db tablename = DQ openDbQueue db tablename = DQ
<$> openDb db tablename <$> openDb db tablename
<*> (newMVar =<< emptyQueue) <*> (newMVar =<< emptyQueue)

View file

@ -31,7 +31,6 @@ import System.IO
import System.Posix.Types import System.Posix.Types
import System.Posix.IO.ByteString import System.Posix.IO.ByteString
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
import System.FilePath.ByteString (RawFilePath)
import Data.Maybe import Data.Maybe
type LockFile = OsPath type LockFile = OsPath