more OsPath conversion
Sponsored-by: Brock Spratlen
This commit is contained in:
Joey Hess
parent
c69e57aede
commit
474cf3bc8b
38 changed files with 342 additions and 330 deletions
|
|
@ -39,11 +39,11 @@ import Utility.CopyFile
|
|||
import qualified Database.Keys.Handle
|
||||
import qualified Utility.RawFilePath as R
|
||||
import qualified Utility.FileIO as F
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified System.FilePath.ByteString as P
|
||||
#ifndef mingw32_HOST_OS
|
||||
#if MIN_VERSION_unix(2,8,0)
|
||||
#else
|
||||
|
|
@ -103,7 +103,7 @@ getAnnexLinkTarget' file coresymlinks = if coresymlinks
|
|||
then mempty
|
||||
else s
|
||||
|
||||
makeAnnexLink :: LinkTarget -> RawFilePath -> Annex ()
|
||||
makeAnnexLink :: LinkTarget -> OsPath -> Annex ()
|
||||
makeAnnexLink = makeGitLink
|
||||
|
||||
{- Creates a link on disk.
|
||||
|
|
@ -113,26 +113,31 @@ makeAnnexLink = makeGitLink
|
|||
- it's staged as such, so use addAnnexLink when adding a new file or
|
||||
- modified link to git.
|
||||
-}
|
||||
makeGitLink :: LinkTarget -> RawFilePath -> Annex ()
|
||||
makeGitLink :: LinkTarget -> OsPath -> Annex ()
|
||||
makeGitLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
|
||||
( liftIO $ do
|
||||
void $ tryIO $ R.removeLink file
|
||||
R.createSymbolicLink linktarget file
|
||||
, liftIO $ F.writeFile' (toOsPath file) linktarget
|
||||
void $ tryIO $ R.removeLink file'
|
||||
R.createSymbolicLink linktarget file'
|
||||
, liftIO $ F.writeFile' file linktarget
|
||||
)
|
||||
where
|
||||
file' = fromOsPath file
|
||||
|
||||
{- Creates a link on disk, and additionally stages it in git. -}
|
||||
addAnnexLink :: LinkTarget -> RawFilePath -> Annex ()
|
||||
addAnnexLink :: LinkTarget -> OsPath -> Annex ()
|
||||
addAnnexLink linktarget file = do
|
||||
makeAnnexLink linktarget file
|
||||
stageSymlink file =<< hashSymlink linktarget
|
||||
|
||||
{- Injects a symlink target into git, returning its Sha. -}
|
||||
hashSymlink :: LinkTarget -> Annex Sha
|
||||
hashSymlink = hashBlob . toInternalGitPath
|
||||
hashSymlink = go . fromOsPath . toInternalGitPath . toOsPath
|
||||
where
|
||||
go :: LinkTarget -> Annex Sha
|
||||
go = hashBlob
|
||||
|
||||
{- Stages a symlink to an annexed object, using a Sha of its target. -}
|
||||
stageSymlink :: RawFilePath -> Sha -> Annex ()
|
||||
stageSymlink :: OsPath -> Sha -> Annex ()
|
||||
stageSymlink file sha =
|
||||
Annex.Queue.addUpdateIndex =<<
|
||||
inRepo (Git.UpdateIndex.stageSymlink file sha)
|
||||
|
|
@ -142,7 +147,7 @@ hashPointerFile :: Key -> Annex Sha
|
|||
hashPointerFile key = hashBlob $ formatPointer key
|
||||
|
||||
{- Stages a pointer file, using a Sha of its content -}
|
||||
stagePointerFile :: RawFilePath -> Maybe FileMode -> Sha -> Annex ()
|
||||
stagePointerFile :: OsPath -> Maybe FileMode -> Sha -> Annex ()
|
||||
stagePointerFile file mode sha =
|
||||
Annex.Queue.addUpdateIndex =<<
|
||||
inRepo (Git.UpdateIndex.stageFile sha treeitemtype file)
|
||||
|
|
@ -151,10 +156,10 @@ stagePointerFile file mode sha =
|
|||
| maybe False isExecutable mode = TreeExecutable
|
||||
| otherwise = TreeFile
|
||||
|
||||
writePointerFile :: RawFilePath -> Key -> Maybe FileMode -> IO ()
|
||||
writePointerFile :: OsPath -> Key -> Maybe FileMode -> IO ()
|
||||
writePointerFile file k mode = do
|
||||
F.writeFile' (toOsPath file) (formatPointer k)
|
||||
maybe noop (R.setFileMode file) mode
|
||||
F.writeFile' file (formatPointer k)
|
||||
maybe noop (R.setFileMode (fromOsPath file)) mode
|
||||
|
||||
newtype Restage = Restage Bool
|
||||
|
||||
|
|
@ -187,7 +192,7 @@ newtype Restage = Restage Bool
|
|||
- if the process is interrupted before the git queue is fulushed, the
|
||||
- restage will be taken care of later.
|
||||
-}
|
||||
restagePointerFile :: Restage -> RawFilePath -> InodeCache -> Annex ()
|
||||
restagePointerFile :: Restage -> OsPath -> InodeCache -> Annex ()
|
||||
restagePointerFile (Restage False) f orig = do
|
||||
flip writeRestageLog orig =<< inRepo (toTopFilePath f)
|
||||
toplevelWarning True $ unableToRestage $ Just f
|
||||
|
|
@ -225,14 +230,14 @@ restagePointerFiles r = unlessM (Annex.getState Annex.insmudgecleanfilter) $ do
|
|||
=<< Annex.getRead Annex.keysdbhandle
|
||||
realindex <- liftIO $ Git.Index.currentIndexFile r
|
||||
numsz@(numfiles, _) <- calcnumsz
|
||||
let lock = fromRawFilePath (Git.Index.indexFileLock realindex)
|
||||
let lock = Git.Index.indexFileLock realindex
|
||||
lockindex = liftIO $ catchMaybeIO $ Git.LockFile.openLock' lock
|
||||
unlockindex = liftIO . maybe noop Git.LockFile.closeLock
|
||||
showwarning = warning $ unableToRestage Nothing
|
||||
go Nothing = showwarning
|
||||
go (Just _) = withtmpdir $ \tmpdir -> do
|
||||
tsd <- getTSDelta
|
||||
let tmpindex = toRawFilePath (tmpdir </> "index")
|
||||
let tmpindex = tmpdir </> literalOsPath "index"
|
||||
let replaceindex = liftIO $ moveFile tmpindex realindex
|
||||
let updatetmpindex = do
|
||||
r' <- liftIO $ Git.Env.addGitEnv r Git.Index.indexEnv
|
||||
|
|
@ -247,8 +252,8 @@ restagePointerFiles r = unlessM (Annex.getState Annex.insmudgecleanfilter) $ do
|
|||
bracket lockindex unlockindex go
|
||||
where
|
||||
withtmpdir = withTmpDirIn
|
||||
(fromRawFilePath $ Git.localGitDir r)
|
||||
(toOsPath "annexindex")
|
||||
(Git.localGitDir r)
|
||||
(literalOsPath "annexindex")
|
||||
|
||||
isunmodified tsd f orig =
|
||||
genInodeCache f tsd >>= return . \case
|
||||
|
|
@ -325,7 +330,7 @@ restagePointerFiles r = unlessM (Annex.getState Annex.insmudgecleanfilter) $ do
|
|||
ck = ConfigKey "filter.annex.process"
|
||||
ckd = ConfigKey "filter.annex.process-temp-disabled"
|
||||
|
||||
unableToRestage :: Maybe RawFilePath -> StringContainingQuotedPath
|
||||
unableToRestage :: Maybe OsPath -> StringContainingQuotedPath
|
||||
unableToRestage mf =
|
||||
"git status will show " <> maybe "some files" QuotedPath mf
|
||||
<> " to be modified, since content availability has changed"
|
||||
|
|
@ -361,7 +366,8 @@ parseLinkTargetOrPointer' b =
|
|||
Nothing -> Right Nothing
|
||||
where
|
||||
parsekey l
|
||||
| isLinkToAnnex l = fileKey $ snd $ S8.breakEnd pathsep l
|
||||
| isLinkToAnnex l = fileKey $ toOsPath $
|
||||
snd $ S8.breakEnd pathsep l
|
||||
| otherwise = Nothing
|
||||
|
||||
restvalid r
|
||||
|
|
@ -400,9 +406,9 @@ parseLinkTargetOrPointerLazy' b =
|
|||
in parseLinkTargetOrPointer' (L.toStrict b')
|
||||
|
||||
formatPointer :: Key -> S.ByteString
|
||||
formatPointer k = prefix <> keyFile k <> nl
|
||||
formatPointer k = fromOsPath prefix <> fromOsPath (keyFile k) <> nl
|
||||
where
|
||||
prefix = toInternalGitPath $ P.pathSeparator `S.cons` objectDir
|
||||
prefix = toInternalGitPath $ pathSeparator `OS.cons` objectDir
|
||||
nl = S8.singleton '\n'
|
||||
|
||||
{- Maximum size of a file that could be a pointer to a key.
|
||||
|
|
@ -434,21 +440,21 @@ maxSymlinkSz = 8192
|
|||
- an object that looks like a pointer file. Or that a non-annex
|
||||
- symlink does. Avoids a false positive in those cases.
|
||||
- -}
|
||||
isPointerFile :: RawFilePath -> IO (Maybe Key)
|
||||
isPointerFile :: OsPath -> IO (Maybe Key)
|
||||
isPointerFile f = catchDefaultIO Nothing $
|
||||
#if defined(mingw32_HOST_OS)
|
||||
F.withFile (toOsPath f) ReadMode readhandle
|
||||
F.withFile f ReadMode readhandle
|
||||
#else
|
||||
#if MIN_VERSION_unix(2,8,0)
|
||||
let open = do
|
||||
fd <- openFd (fromRawFilePath f) ReadOnly
|
||||
fd <- openFd (fromOsPath f) ReadOnly
|
||||
(defaultFileFlags { nofollow = True })
|
||||
fdToHandle fd
|
||||
in bracket open hClose readhandle
|
||||
#else
|
||||
ifM (isSymbolicLink <$> R.getSymbolicLinkStatus f)
|
||||
ifM (isSymbolicLink <$> R.getSymbolicLinkStatus (toRawFilePath f))
|
||||
( return Nothing
|
||||
, F.withFile (toOsPath f) ReadMode readhandle
|
||||
, F.withFile f ReadMode readhandle
|
||||
)
|
||||
#endif
|
||||
#endif
|
||||
|
|
@ -463,13 +469,13 @@ isPointerFile f = catchDefaultIO Nothing $
|
|||
- than .git to be used.
|
||||
-}
|
||||
isLinkToAnnex :: S.ByteString -> Bool
|
||||
isLinkToAnnex s = p `S.isInfixOf` s
|
||||
isLinkToAnnex s = p `OS.isInfixOf` (toOsPath s)
|
||||
#ifdef mingw32_HOST_OS
|
||||
-- '/' is used inside pointer files on Windows, not the native '\'
|
||||
|| p' `S.isInfixOf` s
|
||||
|| p' `OS.isInfixOf` s
|
||||
#endif
|
||||
where
|
||||
p = P.pathSeparator `S.cons` objectDir
|
||||
p = pathSeparator `OS.cons` objectDir
|
||||
#ifdef mingw32_HOST_OS
|
||||
p' = toInternalGitPath p
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue