more OsPath conversion
This commit is contained in:
parent
5bca78b813
commit
c64731f16a
4 changed files with 32 additions and 31 deletions
|
@ -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
|
||||||
|
|
|
@ -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) =
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue