more RawFilePath conversion
removeFile changed to removeLink, because AFAICS it should be fine to remove non-file things here. In particular, it's fine to remove a symlink, since we're about to write a symlink. (removeLink does not remove directories, so file, symlink, and unix socket are the only possibilities.)
This commit is contained in:
parent
8f452416f7
commit
ca80c3154c
6 changed files with 13 additions and 13 deletions
|
@ -241,7 +241,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
|
|||
makepointer key dest destmode = do
|
||||
unless inoverlay $
|
||||
unlessM (reuseOldFile unstagedmap key file dest) $
|
||||
linkFromAnnex key dest destmode >>= \case
|
||||
linkFromAnnex key (toRawFilePath dest) destmode >>= \case
|
||||
LinkAnnexFailed -> liftIO $
|
||||
writePointerFile (toRawFilePath dest) key destmode
|
||||
_ -> noop
|
||||
|
|
|
@ -42,7 +42,7 @@ import qualified Data.ByteString.Char8 as S8
|
|||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
type LinkTarget = String
|
||||
type LinkTarget = S.ByteString
|
||||
|
||||
{- Checks if a file is a link to a key. -}
|
||||
isAnnexLink :: RawFilePath -> Annex (Maybe Key)
|
||||
|
@ -56,7 +56,7 @@ isAnnexLink file = maybe Nothing parseLinkTargetOrPointer <$> getAnnexLinkTarget
|
|||
- Returns Nothing if the file is not a symlink, or not a link to annex
|
||||
- content.
|
||||
-}
|
||||
getAnnexLinkTarget :: RawFilePath -> Annex (Maybe S.ByteString)
|
||||
getAnnexLinkTarget :: RawFilePath -> Annex (Maybe LinkTarget)
|
||||
getAnnexLinkTarget f = getAnnexLinkTarget' f
|
||||
=<< (coreSymlinks <$> Annex.getGitConfig)
|
||||
|
||||
|
@ -107,9 +107,9 @@ makeAnnexLink = makeGitLink
|
|||
makeGitLink :: LinkTarget -> RawFilePath -> Annex ()
|
||||
makeGitLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
|
||||
( liftIO $ do
|
||||
void $ tryIO $ removeFile (fromRawFilePath file)
|
||||
createSymbolicLink linktarget (fromRawFilePath file)
|
||||
, liftIO $ writeFile (fromRawFilePath file) linktarget
|
||||
void $ tryIO $ R.removeLink file
|
||||
R.createSymbolicLink linktarget file
|
||||
, liftIO $ S.writeFile (fromRawFilePath file) linktarget
|
||||
)
|
||||
|
||||
{- Creates a link on disk, and additionally stages it in git. -}
|
||||
|
@ -120,7 +120,7 @@ addAnnexLink linktarget file = do
|
|||
|
||||
{- Injects a symlink target into git, returning its Sha. -}
|
||||
hashSymlink :: LinkTarget -> Annex Sha
|
||||
hashSymlink = hashBlob . toInternalGitPath . toRawFilePath
|
||||
hashSymlink = hashBlob . toInternalGitPath
|
||||
|
||||
{- Stages a symlink to an annexed object, using a Sha of its target. -}
|
||||
stageSymlink :: RawFilePath -> Sha -> Annex ()
|
||||
|
|
|
@ -106,7 +106,7 @@ scanUnlockedFiles = whenM (inRepo Git.Ref.headExists <&&> not <$> isBareRepo) $
|
|||
fileMode <$> R.getFileStatus f
|
||||
ic <- replaceWorkTreeFile (fromRawFilePath f) $ \tmp -> do
|
||||
let tmp' = toRawFilePath tmp
|
||||
linkFromAnnex k tmp destmode >>= \case
|
||||
linkFromAnnex k tmp' destmode >>= \case
|
||||
LinkAnnexOk ->
|
||||
withTSDelta (liftIO . genInodeCache tmp')
|
||||
LinkAnnexNoop -> return Nothing
|
||||
|
|
|
@ -141,7 +141,7 @@ youtubeDlMaxSize workdir = ifM (Annex.getState Annex.force)
|
|||
youtubeDlTo :: Key -> URLString -> FilePath -> MeterUpdate -> Annex Bool
|
||||
youtubeDlTo key url dest p = do
|
||||
res <- withTmpWorkDir key $ \workdir ->
|
||||
youtubeDl url workdir p >>= \case
|
||||
youtubeDl url (fromRawFilePath workdir) p >>= \case
|
||||
Right (Just mediafile) -> do
|
||||
liftIO $ renameFile mediafile dest
|
||||
return (Just True)
|
||||
|
|
|
@ -40,7 +40,7 @@ runLocal :: RunState -> RunProto Annex -> LocalF (Proto a) -> Annex (Either Prot
|
|||
runLocal runst runner a = case a of
|
||||
TmpContentSize k next -> do
|
||||
tmp <- fromRepo $ gitAnnexTmpObjectLocation k
|
||||
size <- liftIO $ catchDefaultIO 0 $ getFileSize tmp
|
||||
size <- liftIO $ catchDefaultIO 0 $ getFileSize $ fromRawFilePath tmp
|
||||
runner (next (Len size))
|
||||
FileSize f next -> do
|
||||
size <- liftIO $ catchDefaultIO 0 $ getFileSize f
|
||||
|
@ -77,7 +77,7 @@ runLocal runst runner a = case a of
|
|||
let runtransfer ti =
|
||||
Right <$> transfer download k af (\p ->
|
||||
getViaTmp rsp DefaultVerify k $ \tmp ->
|
||||
storefile tmp o l getb validitycheck p ti)
|
||||
storefile (fromRawFilePath tmp) o l getb validitycheck p ti)
|
||||
let fallback = return $ Left $
|
||||
ProtoFailureMessage "transfer already in progress, or unable to take transfer lock"
|
||||
checktransfer runtransfer fallback
|
||||
|
|
|
@ -285,11 +285,11 @@ bup2GitRemote :: BupRepo -> IO Git.Repo
|
|||
bup2GitRemote "" = do
|
||||
-- bup -r "" operates on ~/.bup
|
||||
h <- myHomeDir
|
||||
Git.Construct.fromAbsPath $ h </> ".bup"
|
||||
Git.Construct.fromAbsPath $ toRawFilePath $ h </> ".bup"
|
||||
bup2GitRemote r
|
||||
| bupLocal r =
|
||||
if "/" `isPrefixOf` r
|
||||
then Git.Construct.fromAbsPath r
|
||||
then Git.Construct.fromAbsPath (toRawFilePath r)
|
||||
else giveup "please specify an absolute path"
|
||||
| otherwise = Git.Construct.fromUrl $ "ssh://" ++ host ++ slash dir
|
||||
where
|
||||
|
|
Loading…
Reference in a new issue