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.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
|
||||
|
|
|
@ -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) =
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue