mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

more OsPath conversion

Browse source 
Sponsored-by: Jack Hill
This commit is contained in:
Joey Hess 2025-01-30 15:46:32 -04:00
parent a03c609268
commit c69e57aede
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
17 changed files with 83 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Annex/Locations.hs
View file

@ -795,6 +795,3 @@ keyPath key hasher = hasher key </> f </> f
keyPaths :: Key -> NE.NonEmpty OsPath
keyPaths key = NE.map (\h -> keyPath key (h def)) dirHashes
uuidPath :: UUID -> OsPath
uuidPath u = toOsPath (fromUUID u :: SB.ShortByteString)

23
Annex/LockFile.hs
View file

@ -26,11 +26,10 @@ import Annex.Perms
import Annex.LockPool
import qualified Data.Map as M
import qualified System.FilePath.ByteString as P
{- Create a specified lock file, and takes a shared lock, which is retained
- in the cache. -}
lockFileCached :: RawFilePath -> Annex ()
lockFileCached :: OsPath -> Annex ()
lockFileCached file = go =<< fromLockCache file
where
go (Just _) = noop -- already locked
@ -43,7 +42,7 @@ lockFileCached file = go =<< fromLockCache file
#endif
changeLockCache $ M.insert file lockhandle
unlockFile :: RawFilePath -> Annex ()
unlockFile :: OsPath -> Annex ()
unlockFile file = maybe noop go =<< fromLockCache file
where
go lockhandle = do
@ -53,7 +52,7 @@ unlockFile file = maybe noop go =<< fromLockCache file
getLockCache :: Annex LockCache
getLockCache = getState lockcache
fromLockCache :: RawFilePath -> Annex (Maybe LockHandle)
fromLockCache :: OsPath -> Annex (Maybe LockHandle)
fromLockCache file = M.lookup file <$> getLockCache
changeLockCache :: (LockCache -> LockCache) -> Annex ()
@ -63,9 +62,9 @@ changeLockCache a = do
{- Runs an action with a shared lock held. If an exclusive lock is held,
- blocks until it becomes free. -}
withSharedLock :: RawFilePath -> Annex a -> Annex a
withSharedLock :: OsPath -> Annex a -> Annex a
withSharedLock lockfile a = debugLocks $ do
createAnnexDirectory $ P.takeDirectory lockfile
createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
bracket (lock mode lockfile) (liftIO . dropLock) (const a)
where
@ -77,16 +76,16 @@ withSharedLock lockfile a = debugLocks $ do
{- Runs an action with an exclusive lock held. If the lock is already
- held, blocks until it becomes free. -}
withExclusiveLock :: RawFilePath -> Annex a -> Annex a
withExclusiveLock :: OsPath -> Annex a -> Annex a
withExclusiveLock lockfile a = bracket
(takeExclusiveLock lockfile)
(liftIO . dropLock)
(const a)
{- Takes an exclusive lock, blocking until it's free. -}
takeExclusiveLock :: RawFilePath -> Annex LockHandle
takeExclusiveLock :: OsPath -> Annex LockHandle
takeExclusiveLock lockfile = debugLocks $ do
createAnnexDirectory $ P.takeDirectory lockfile
createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
lock mode lockfile
where
@ -98,9 +97,9 @@ takeExclusiveLock lockfile = debugLocks $ do
{- Tries to take an exclusive lock and run an action. If the lock is
- already held, returns Nothing. -}
tryExclusiveLock :: RawFilePath -> Annex a -> Annex (Maybe a)
tryExclusiveLock :: OsPath -> Annex a -> Annex (Maybe a)
tryExclusiveLock lockfile a = debugLocks $ do
createAnnexDirectory $ P.takeDirectory lockfile
createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
bracket (lock mode lockfile) (liftIO . unlock) go
where
@ -118,7 +117,7 @@ tryExclusiveLock lockfile a = debugLocks $ do
- Does not create the lock directory or lock file if it does not exist,
- taking an exclusive lock will create them.
-}
trySharedLock :: RawFilePath -> Annex (Maybe LockHandle)
trySharedLock :: OsPath -> Annex (Maybe LockHandle)
trySharedLock lockfile = debugLocks $
#ifndef mingw32_HOST_OS
tryLockShared Nothing lockfile

18
Annex/ReplaceFile.hs
View file

@ -24,17 +24,17 @@ import Utility.Directory.Create
import qualified System.FilePath.ByteString as P
{- replaceFile on a file located inside the gitAnnexDir. -}
replaceGitAnnexDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
replaceGitAnnexDirFile :: OsPath -> (OsPath -> Annex a) -> Annex a
replaceGitAnnexDirFile = replaceFile createAnnexDirectory
{- replaceFile on a file located inside the .git directory. -}
replaceGitDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
replaceGitDirFile :: OsPath -> (OsPath -> Annex a) -> Annex a
replaceGitDirFile = replaceFile $ \dir -> do
top <- fromRepo localGitDir
liftIO $ createDirectoryUnder [top] dir
{- replaceFile on a worktree file. -}
replaceWorkTreeFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
replaceWorkTreeFile :: OsPath -> (OsPath -> Annex a) -> Annex a
replaceWorkTreeFile = replaceFile createWorkTreeDirectory
{- Replaces a possibly already existing file with a new version,
@ -52,20 +52,20 @@ replaceWorkTreeFile = replaceFile createWorkTreeDirectory
- The createdirectory action is only run when moving the file into place
- fails, and can create any parent directory structure needed.
-}
replaceFile :: (RawFilePath -> Annex ()) -> RawFilePath -> (RawFilePath -> Annex a) -> Annex a
replaceFile :: (OsPath -> Annex ()) -> OsPath -> (OsPath -> Annex a) -> Annex a
replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action
replaceFile' :: (RawFilePath -> Annex ()) -> RawFilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a
replaceFile' :: (OsPath -> Annex ()) -> OsPath -> (a -> Bool) -> (OsPath -> Annex a) -> Annex a
replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do
let basetmp = relatedTemplate' (P.takeFileName file)
withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath basetmp) $ \tmpdir -> do
let tmpfile = toRawFilePath tmpdir P.</> basetmp
let basetmp = relatedTemplate (fromOsPath (takeFileName file))
withTmpDirIn othertmpdir basetmp $ \tmpdir -> do
let tmpfile = tmpdir </> basetmp
r <- action tmpfile
when (checkres r) $
replaceFileFrom tmpfile file createdirectory
return r
replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex ()
replaceFileFrom :: OsPath -> OsPath -> (OsPath -> Annex ()) -> Annex ()
replaceFileFrom src dest createdirectory = go `catchIO` fallback
where
go = liftIO $ moveFile src dest

13
Annex/Tmp.hs
View file

@ -23,7 +23,7 @@ import System.PosixCompat.Files (modificationTime)
-- directory that is passed to it. However, once the action is done,
-- any files left in that directory may be cleaned up by another process at
-- any time.
withOtherTmp :: (RawFilePath -> Annex a) -> Annex a
withOtherTmp :: (OsPath -> Annex a) -> Annex a
withOtherTmp a = do
Annex.addCleanupAction OtherTmpCleanup cleanupOtherTmp
tmpdir <- fromRepo gitAnnexTmpOtherDir
@ -40,14 +40,14 @@ withOtherTmp a = do
-- Unlike withOtherTmp, this does not rely on locking working.
-- Its main use is in situations where the state of lockfile is not
-- determined yet, eg during initialization.
withEventuallyCleanedOtherTmp :: (RawFilePath -> Annex a) -> Annex a
withEventuallyCleanedOtherTmp :: (OsPath -> Annex a) -> Annex a
withEventuallyCleanedOtherTmp = bracket setup cleanup
where
setup = do
tmpdir <- fromRepo gitAnnexTmpOtherDirOld
void $ createAnnexDirectory tmpdir
return tmpdir
cleanup = liftIO . void . tryIO . removeDirectory . fromRawFilePath
cleanup = liftIO . void . tryIO . removeDirectory
-- | Cleans up any tmp files that were left by a previous
-- git-annex process that got interrupted or failed to clean up after
@ -58,14 +58,13 @@ cleanupOtherTmp :: Annex ()
cleanupOtherTmp = do
tmplck <- fromRepo gitAnnexTmpOtherLock
void $ tryIO $ tryExclusiveLock tmplck $ do
tmpdir <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDir
tmpdir <- fromRepo gitAnnexTmpOtherDir
void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir
oldtmp <- fromRepo gitAnnexTmpOtherDirOld
liftIO $ mapM_ cleanold
liftIO $ mapM_ (cleanold . fromOsPath)
=<< emptyWhenDoesNotExist (dirContentsRecursive oldtmp)
-- remove when empty
liftIO $ void $ tryIO $
removeDirectory (fromRawFilePath oldtmp)
liftIO $ void $ tryIO $ removeDirectory oldtmp
where
cleanold f = do
now <- liftIO getPOSIXTime

4
Database/ContentIdentifier.hs
View file

@ -98,8 +98,8 @@ AnnexBranch
openDb :: Annex ContentIdentifierHandle
openDb = do
dbdir <- calcRepo' gitAnnexContentIdentifierDbDir
let db = dbdir P.</> "db"
isnew <- liftIO $ not <$> R.doesPathExist db
let db = dbdir </> literalOsPath "db"
isnew <- liftIO $ not <$> doesDirectoryPathExist db
if isnew
then initDb db $ void $
runMigrationSilent migrateContentIdentifier

8
Database/Fsck.hs
View file

@ -33,12 +33,10 @@ 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
@ -66,14 +64,14 @@ newPass u = do
go = do
removedb =<< calcRepo' (gitAnnexFsckDbDir u)
removedb =<< calcRepo' (gitAnnexFsckDbDirOld u)
removedb = liftIO . void . tryIO . removeDirectoryRecursive . fromRawFilePath
removedb = liftIO . void . tryIO . removeDirectoryRecursive
{- Opens the database, creating it if it doesn't exist yet. -}
openDb :: UUID -> Annex FsckHandle
openDb u = do
dbdir <- calcRepo' (gitAnnexFsckDbDir u)
let db = dbdir P.</> "db"
unlessM (liftIO $ R.doesPathExist db) $ do
let db = dbdir </> literalOsPath "db"
unlessM (liftIO $ doesDirectoryExist db) $ do
initDb db $ void $
runMigrationSilent migrateFsck
lockFileCached =<< calcRepo' (gitAnnexFsckDbLock u)

6
Database/RepoSize.hs
View file

@ -42,11 +42,9 @@ import Database.Utility
import Database.Types
import Annex.LockFile
import Git.Types
import qualified Utility.RawFilePath as R
import Database.Persist.Sql hiding (Key)
import Database.Persist.TH
import qualified System.FilePath.ByteString as P
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Control.Exception
@ -107,8 +105,8 @@ getRepoSizeHandle = Annex.getState Annex.reposizehandle >>= \case
openDb :: Annex RepoSizeHandle
openDb = lockDbWhile permerr $ do
dbdir <- calcRepo' gitAnnexRepoSizeDbDir
let db = dbdir P.</> "db"
unlessM (liftIO $ R.doesPathExist db) $ do
let db = dbdir </> literalOsPath "db"
unlessM (liftIO $ doesDirectoryExist db) $ do
initDb db $ void $
runMigrationSilent migrateRepoSizes
h <- liftIO $ H.openDb db "repo_sizes"

2
Git/Repair.hs
View file

@ -95,7 +95,7 @@ explodePacks r = go =<< listPackFiles r
f <- relPathDirToFile tmpdir objfile
let dest = objectsDir r </> f
createDirectoryIfMissing True (parentDir dest)
moveFile (fromOsPath objfile) (fromOsPath dest)
moveFile objfile dest
forM_ packs $ \packfile -> do
removeWhenExistsWith R.removeLink (fromOsPath packfile)
removeWhenExistsWith R.removeLink (fromOsPath (packIdxFile packfile))

45
Logs/File.hs
View file

@ -34,16 +34,16 @@ import qualified Data.ByteString.Lazy.Char8 as L8
-- | Writes content to a file, replacing the file atomically, and
-- making the new file have whatever permissions the git repository is
-- configured to use. Creates the parent directory when necessary.
writeLogFile :: RawFilePath -> String -> Annex ()
writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (toOsPath f) c
writeLogFile :: OsPath -> String -> Annex ()
writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c
where
writelog tmp c' = do
liftIO $ writeFile (fromRawFilePath (fromOsPath tmp)) c'
setAnnexFilePerm (fromOsPath tmp)
liftIO $ writeFile (fromOsPath tmp) c'
setAnnexFilePerm tmp
-- | Runs the action with a handle connected to a temp file.
-- The temp file replaces the log file once the action succeeds.
withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a
withLogHandle :: OsPath -> (Handle -> Annex a) -> Annex a
withLogHandle f a = do
createAnnexDirectory (parentDir f)
replaceGitAnnexDirFile f $ \tmp ->
@ -51,16 +51,16 @@ withLogHandle f a = do
where
setup tmp = do
setAnnexFilePerm tmp
liftIO $ F.openFile (toOsPath tmp) WriteMode
liftIO $ F.openFile tmp WriteMode
cleanup h = liftIO $ hClose h
-- | Appends a line to a log file, first locking it to prevent
-- concurrent writers.
appendLogFile :: RawFilePath -> RawFilePath -> L.ByteString -> Annex ()
appendLogFile :: OsPath -> OsPath -> L.ByteString -> Annex ()
appendLogFile f lck c =
createDirWhenNeeded f $
withExclusiveLock lck $ do
liftIO $ F.withFile (toOsPath f) AppendMode $
liftIO $ F.withFile f AppendMode $
\h -> L8.hPutStrLn h c
setAnnexFilePerm f
@ -72,25 +72,24 @@ appendLogFile f lck c =
--
-- The file is locked to prevent concurrent writers, and it is written
-- atomically.
modifyLogFile :: RawFilePath -> RawFilePath -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
modifyLogFile :: OsPath -> OsPath -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
modifyLogFile f lck modf = withExclusiveLock lck $ do
ls <- liftIO $ fromMaybe []
<$> tryWhenExists (fileLines <$> F.readFile f')
<$> tryWhenExists (fileLines <$> F.readFile f)
let ls' = modf ls
when (ls' /= ls) $
createDirWhenNeeded f $
viaTmp writelog f' (L8.unlines ls')
viaTmp writelog f (L8.unlines ls')
where
f' = toOsPath f
writelog lf b = do
liftIO $ F.writeFile lf b
setAnnexFilePerm (fromOsPath lf)
setAnnexFilePerm lf
-- | Checks the content of a log file to see if any line matches.
checkLogFile :: RawFilePath -> RawFilePath -> (L.ByteString -> Bool) -> Annex Bool
checkLogFile :: OsPath -> OsPath -> (L.ByteString -> Bool) -> Annex Bool
checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go
where
setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode
setup = liftIO $ tryWhenExists $ F.openFile f ReadMode
cleanup Nothing = noop
cleanup (Just h) = liftIO $ hClose h
go Nothing = return False
@ -99,15 +98,15 @@ checkLogFile f lck matchf = withSharedLock lck $ bracket setup cleanup go
return r
-- | Folds a function over lines of a log file to calculate a value.
calcLogFile :: RawFilePath -> RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t
calcLogFile :: OsPath -> OsPath -> t -> (L.ByteString -> t -> t) -> Annex t
calcLogFile f lck start update =
withSharedLock lck $ calcLogFileUnsafe f start update
-- | Unsafe version that does not do locking.
calcLogFileUnsafe :: RawFilePath -> t -> (L.ByteString -> t -> t) -> Annex t
calcLogFileUnsafe :: OsPath -> t -> (L.ByteString -> t -> t) -> Annex t
calcLogFileUnsafe f start update = bracket setup cleanup go
where
setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode
setup = liftIO $ tryWhenExists $ F.openFile f ReadMode
cleanup Nothing = noop
cleanup (Just h) = liftIO $ hClose h
go Nothing = return start
@ -129,19 +128,19 @@ calcLogFileUnsafe f start update = bracket setup cleanup go
--
-- Locking is used to prevent writes to to the log file while this
-- is running.
streamLogFile :: RawFilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex ()
streamLogFile :: OsPath -> OsPath -> Annex () -> (String -> Annex ()) -> Annex ()
streamLogFile f lck finalizer processor =
withExclusiveLock lck $ do
streamLogFileUnsafe f finalizer processor
liftIO $ F.writeFile' (toOsPath f) mempty
liftIO $ F.writeFile' f mempty
setAnnexFilePerm f
-- Unsafe version that does not do locking, and does not empty the file
-- at the end.
streamLogFileUnsafe :: RawFilePath -> Annex () -> (String -> Annex ()) -> Annex ()
streamLogFileUnsafe :: OsPath -> Annex () -> (String -> Annex ()) -> Annex ()
streamLogFileUnsafe f finalizer processor = bracketOnError setup cleanup go
where
setup = liftIO $ tryWhenExists $ F.openFile (toOsPath f) ReadMode
setup = liftIO $ tryWhenExists $ F.openFile f ReadMode
cleanup Nothing = noop
cleanup (Just h) = liftIO $ hClose h
go Nothing = finalizer
@ -150,7 +149,7 @@ streamLogFileUnsafe f finalizer processor = bracketOnError setup cleanup go
liftIO $ hClose h
finalizer
createDirWhenNeeded :: RawFilePath -> Annex () -> Annex ()
createDirWhenNeeded :: OsPath -> Annex () -> Annex ()
createDirWhenNeeded f a = a `catchNonAsync` \_e -> do
-- Most of the time, the directory will exist, so this is only
-- done if writing the file fails.

18
Logs/Unused.hs
View file

@ -58,13 +58,13 @@ preserveTimestamps oldl newl = M.intersection (M.unionWith oldts oldl newl) newl
where
oldts _old@(_, ts) _new@(int, _) = (int, ts)
updateUnusedLog :: RawFilePath -> UnusedMap -> Annex ()
updateUnusedLog :: OsPath -> UnusedMap -> Annex ()
updateUnusedLog prefix m = do
oldl <- readUnusedLog prefix
newl <- preserveTimestamps oldl . flip map2log m <$> liftIO getPOSIXTime
writeUnusedLog prefix newl
writeUnusedLog :: RawFilePath -> UnusedLog -> Annex ()
writeUnusedLog :: OsPath -> UnusedLog -> Annex ()
writeUnusedLog prefix l = do
logfile <- fromRepo $ gitAnnexUnusedLog prefix
writeLogFile logfile $ unlines $ map format $ M.toList l
@ -72,12 +72,12 @@ writeUnusedLog prefix l = do
format (k, (i, Just t)) = show i ++ " " ++ serializeKey k ++ " " ++ show t
format (k, (i, Nothing)) = show i ++ " " ++ serializeKey k
readUnusedLog :: RawFilePath -> Annex UnusedLog
readUnusedLog :: OsPath -> Annex UnusedLog
readUnusedLog prefix = do
f <- fromRepo (gitAnnexUnusedLog prefix)
ifM (liftIO $ doesFileExist (fromRawFilePath f))
ifM (liftIO $ doesFileExist f)
( M.fromList . mapMaybe (parse . decodeBS) . fileLines'
<$> liftIO (F.readFile' (toOsPath f))
<$> liftIO (F.readFile' f)
, return M.empty
)
where
@ -90,13 +90,13 @@ readUnusedLog prefix = do
skey = reverse rskey
ts = reverse rts
readUnusedMap :: RawFilePath -> Annex UnusedMap
readUnusedMap :: OsPath -> Annex UnusedMap
readUnusedMap = log2map <$$> readUnusedLog
dateUnusedLog :: RawFilePath -> Annex (Maybe UTCTime)
dateUnusedLog :: OsPath -> Annex (Maybe UTCTime)
dateUnusedLog prefix = do
f <- fromRepo $ gitAnnexUnusedLog prefix
liftIO $ catchMaybeIO $ getModificationTime $ fromRawFilePath f
liftIO $ catchMaybeIO $ getModificationTime f
{- Set of unused keys. This is cached for speed. -}
unusedKeys :: Annex (S.Set Key)
@ -104,7 +104,7 @@ unusedKeys = maybe (setUnusedKeys =<< unusedKeys') return
=<< Annex.getState Annex.unusedkeys
unusedKeys' :: Annex [Key]
unusedKeys' = M.keys <$> readUnusedLog ""
unusedKeys' = M.keys <$> readUnusedLog (literalOsPath "")
setUnusedKeys :: [Key] -> Annex (S.Set Key)
setUnusedKeys ks = do

4
Logs/Upgrade.hs
View file

@ -33,9 +33,9 @@ writeUpgradeLog v t = do
readUpgradeLog :: Annex [(RepoVersion, POSIXTime)]
readUpgradeLog = do
logfile <- fromRepo gitAnnexUpgradeLog
ifM (liftIO $ doesFileExist (fromRawFilePath logfile))
ifM (liftIO $ doesFileExist logfile)
( mapMaybe (parse . decodeBS) . fileLines'
<$> liftIO (F.readFile' (toOsPath logfile))
<$> liftIO (F.readFile' logfile)
, return []
)
where

2
Logs/View.hs
View file

@ -54,7 +54,7 @@ removeView v = writeViews =<< filter (/= v) <$> recentViews
recentViews :: Annex [View]
recentViews = do
f <- fromRawFilePath <$> fromRepo gitAnnexViewLog
f <- fromOsPath <$> fromRepo gitAnnexViewLog
liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)
{- Gets the currently checked out view, if there is one.

5
Remote/Helper/Hooks.hs
View file

@ -11,7 +11,6 @@
module Remote.Helper.Hooks (addHooks) where
import qualified Data.Map as M
import qualified System.FilePath.ByteString as P
import Annex.Common
import Types.Remote
@ -51,13 +50,13 @@ addHooks' r starthook stophook = r'
runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a
runHooks r starthook stophook a = do
dir <- fromRepo gitAnnexRemotesDir
let lck = dir P.</> remoteid <> ".lck"
let lck = dir </> remoteid <> literalOsPath ".lck"
whenM (notElem lck . M.keys <$> getLockCache) $ do
createAnnexDirectory dir
firstrun lck
a
where
remoteid = fromUUID (uuid r)
remoteid = uuidPath (uuid r)
run Nothing = noop
run (Just command) = void $ liftIO $
boolSystem "sh" [Param "-c", Param command]

4
Types/LockCache.hs
View file

@ -13,6 +13,6 @@ module Types.LockCache (
import Utility.LockPool (LockHandle)
import qualified Data.Map as M
import System.FilePath.ByteString (RawFilePath)
import Utility.OsPath
type LockCache = M.Map RawFilePath LockHandle
type LockCache = M.Map OsPath LockHandle

4
Types/UUID.hs
View file

@ -24,6 +24,7 @@ import Git.Types (ConfigValue(..))
import Utility.FileSystemEncoding
import Utility.QuickCheck
import Utility.Aeson
import Utility.OsPath
import qualified Utility.SimpleProtocol as Proto
-- A UUID is either an arbitrary opaque string, or UUID info may be missing.
@ -101,6 +102,9 @@ buildUUID NoUUID = mempty
isUUID :: String -> Bool
isUUID = isJust . U.fromString
uuidPath :: UUID -> OsPath
uuidPath u = toOsPath (fromUUID u :: SB.ShortByteString)
-- A description of a UUID.
newtype UUIDDesc = UUIDDesc B.ByteString
deriving (Eq, Sem.Semigroup, Monoid, IsString)

13
Utility/MoveFile.hs
View file

@ -27,21 +27,20 @@ import Utility.SystemDirectory
import Utility.Tmp
import Utility.Exception
import Utility.Monad
import Utility.FileSystemEncoding
import Utility.OsPath
import qualified Utility.RawFilePath as R
import Author
{- Moves one filename to another.
- First tries a rename, but falls back to moving across devices if needed. -}
moveFile :: RawFilePath -> RawFilePath -> IO ()
moveFile src dest = tryIO (R.rename src dest) >>= onrename
moveFile :: OsPath -> OsPath -> IO ()
moveFile src dest = tryIO (renamePath src dest) >>= onrename
where
onrename (Right _) = noop
onrename (Left e)
| isPermissionError e = rethrow
| isDoesNotExistError e = rethrow
| otherwise = viaTmp mv (toOsPath dest) ()
| otherwise = viaTmp mv dest ()
where
rethrow = throwM e
@ -57,8 +56,8 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename
whenM (isdir dest) rethrow
ok <- copyright =<< boolSystem "mv"
[ Param "-f"
, Param (fromRawFilePath src)
, Param (fromRawFilePath (fromOsPath tmp))
, Param (fromOsPath src)
, Param (fromOsPath tmp)
]
let e' = e
#else
@ -74,7 +73,7 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename
#ifndef mingw32_HOST_OS
isdir f = do
r <- tryIO $ R.getSymbolicLinkStatus f
r <- tryIO $ R.getSymbolicLinkStatus (fromOsPath f)
case r of
(Left _) -> return False
(Right s) -> return $ isDirectory s

2
Utility/RawFilePath.hs
View file

@ -104,7 +104,7 @@ setFileMode p m = do
P.setFileMode p' m
{- Using renamePath rather than the rename provided in unix-compat
- because of this bug https://github.com/jacobstanley/unix-compat/issues/56-}
- because of this bug https://github.com/jacobstanley/unix-compat/issues/56 -}
rename :: RawFilePath -> RawFilePath -> IO ()
rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b)