more OsPath conversion (650/749)

Sponsored-by: Nicholas Golder-Manning
This commit is contained in:
Joey Hess 2025-02-07 17:03:31 -04:00
parent c74c75b352
commit 5eef09a3cc
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 79 additions and 78 deletions

View file

@ -28,7 +28,8 @@ myseek o = do
Command.Sync.prepMerge
Command.Add.seek Command.Add.AddOptions
{ Command.Add.addThese = Command.Sync.contentOfOption o
{ Command.Add.addThese = map fromOsPath $
Command.Sync.contentOfOption o
, Command.Add.batchOption = NoBatch
, Command.Add.updateOnly = False
, Command.Add.largeFilesOverride = Nothing

View file

@ -129,7 +129,7 @@ seek :: ImportOptions -> CommandSeek
seek o@(LocalImportOptions {}) = startConcurrency commandStages $ do
repopath <- liftIO . absPath =<< fromRepo Git.repoPath
inrepops <- liftIO $ filter (dirContains repopath)
<$> mapM (absPath . toRawFilePath) (importFiles o)
<$> mapM (absPath . toOsPath) (importFiles o)
unless (null inrepops) $ do
qp <- coreQuotePath <$> Annex.getGitConfig
giveup $ decodeBS $ quote qp $
@ -145,7 +145,7 @@ seek o@(RemoteImportOptions {}) = startConcurrency commandStages $ do
giveup "That remote does not support imports."
subdir <- maybe
(pure Nothing)
(Just <$$> inRepo . toTopFilePath . toRawFilePath)
(Just <$$> inRepo . toTopFilePath . toOsPath)
(importToSubDir o)
addunlockedmatcher <- addUnlockedMatcher
seekRemote r (importToBranch o) subdir (importContent o)
@ -153,9 +153,9 @@ seek o@(RemoteImportOptions {}) = startConcurrency commandStages $ do
addunlockedmatcher
(messageOption o)
startLocal :: ImportOptions -> AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (RawFilePath, RawFilePath) -> CommandStart
startLocal :: ImportOptions -> AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (OsPath, OsPath) -> CommandStart
startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
ifM (liftIO $ isRegularFile <$> R.getSymbolicLinkStatus srcfile)
ifM (liftIO $ isRegularFile <$> R.getSymbolicLinkStatus (fromOsPath srcfile))
( starting "import" ai si pickaction
, stop
)
@ -167,7 +167,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
showNote $ UnquotedString $ "duplicate of " ++ serializeKey k
verifyExisting k destfile
( do
liftIO $ R.removeLink srcfile
liftIO $ removeFile srcfile
next $ return True
, do
warning "Could not verify that the content is still present in the annex; not removing from the import location."
@ -183,26 +183,26 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
warning $ "not importing " <> QuotedPath destfile <> " which is .gitignored (use --no-check-gitignore to override)"
stop
else do
existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus destfile)
existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath destfile))
case existing of
Nothing -> importfilechecked ld k
Just s
| isDirectory s -> notoverwriting "(is a directory)"
| isSymbolicLink s -> ifM (Annex.getRead Annex.force)
( do
liftIO $ removeWhenExistsWith R.removeLink destfile
liftIO $ removeWhenExistsWith removeFile destfile
importfilechecked ld k
, notoverwriting "(is a symlink)"
)
| otherwise -> ifM (Annex.getRead Annex.force)
( do
liftIO $ removeWhenExistsWith R.removeLink destfile
liftIO $ removeWhenExistsWith removeFile destfile
importfilechecked ld k
, notoverwriting "(use --force to override, or a duplication option such as --deduplicate to clean up)"
)
checkdestdir cont = do
let destdir = parentDir destfile
existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus destdir)
existing <- liftIO (catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath destdir))
case existing of
Nothing -> cont
Just s
@ -217,10 +217,8 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
createWorkTreeDirectory (parentDir destfile)
unwind <- liftIO $ if mode == Duplicate || mode == SkipDuplicates
then do
void $ copyFileExternal CopyAllMetaData
(fromRawFilePath srcfile)
(fromRawFilePath destfile)
return $ removeWhenExistsWith R.removeLink destfile
void $ copyFileExternal CopyAllMetaData srcfile destfile
return $ removeWhenExistsWith removeFile destfile
else do
moveFile srcfile destfile
return $ moveFile destfile srcfile
@ -241,7 +239,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
-- weakly the same as the originally locked down file's
-- inode cache. (Since the file may have been copied,
-- its inodes may not be the same.)
s <- liftIO $ R.getSymbolicLinkStatus destfile
s <- liftIO $ R.getSymbolicLinkStatus (fromOsPath destfile)
newcache <- withTSDelta $ \d -> liftIO $ toInodeCache d destfile s
let unchanged = case (newcache, inodeCache (keySource ld)) of
(_, Nothing) -> True
@ -287,7 +285,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
-- the file gets copied into the repository.
, checkWritePerms = False
}
v <- lockDown cfg (fromRawFilePath srcfile)
v <- lockDown cfg srcfile
case v of
Just ld -> do
backend <- chooseBackend destfile
@ -314,7 +312,7 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
showNote (s <> "; skipping")
next (return True)
verifyExisting :: Key -> RawFilePath -> (CommandPerform, CommandPerform) -> CommandPerform
verifyExisting :: Key -> OsPath -> (CommandPerform, CommandPerform) -> CommandPerform
verifyExisting key destfile (yes, no) = do
-- Look up the numcopies setting for the file that it would be
-- imported to, if it were imported.

View file

@ -9,6 +9,7 @@
module Command.PostReceive where
import Common
import Command
import qualified Annex
import Annex.UpdateInstead
@ -107,12 +108,11 @@ fixPostReceiveHookEnv :: Annex ()
fixPostReceiveHookEnv = do
g <- Annex.gitRepo
case location g of
Local { gitdir = ".", worktree = Just "." } ->
l@(Local {}) | gitdir l == literalOsPath "." && worktree l == Just (literalOsPath ".") ->
Annex.adjustGitRepo $ \g' -> pure $ g'
{ location = case location g' of
loc@(Local {}) -> loc
{ worktree = Just ".." }
{ worktree = Just (literalOsPath "..") }
loc -> loc
}
_ -> noop

View file

@ -110,7 +110,7 @@ data SyncOptions = SyncOptions
, pushOption :: Bool
, contentOption :: Maybe Bool
, noContentOption :: Maybe Bool
, contentOfOption :: [FilePath]
, contentOfOption :: [OsPath]
, cleanupOption :: Bool
, keyOptions :: Maybe KeyOptions
, resolveMergeOverride :: Bool
@ -201,7 +201,7 @@ optParser mode desc = SyncOptions
<> short 'g'
<> help "do not transfer annexed file contents"
)))
<*> many (strOption
<*> many (stringToOsPath <$> strOption
( long "content-of"
<> short 'C'
<> help "transfer contents of annexed files in a given location"
@ -248,7 +248,7 @@ instance DeferredParseClass SyncOptions where
<*> pure (pushOption v)
<*> pure (contentOption v)
<*> pure (noContentOption v)
<*> liftIO (mapM (fromRawFilePath <$$> absPath . toRawFilePath) (contentOfOption v))
<*> liftIO (mapM absPath (contentOfOption v))
<*> pure (cleanupOption v)
<*> pure (keyOptions v)
<*> pure (resolveMergeOverride v)
@ -340,7 +340,7 @@ seek' o = startConcurrency transferStages $ do
- of the repo. This also means that sync always acts on all files in the
- repository, not just on a subdirectory. -}
prepMerge :: Annex ()
prepMerge = Annex.changeDirectory . fromRawFilePath =<< fromRepo Git.repoPath
prepMerge = Annex.changeDirectory =<< fromRepo Git.repoPath
mergeConfig :: Bool -> Annex [Git.Merge.MergeConfig]
mergeConfig mergeunrelated = do
@ -681,7 +681,7 @@ pushRemote o remote (Just branch, _) = do
Nothing -> return True
Just wt -> ifM needemulation
( gitAnnexChildProcess "post-receive" []
(\cp -> cp { cwd = Just (fromRawFilePath wt) })
(\cp -> cp { cwd = Just (fromOsPath wt) })
(\_ _ _ pid -> waitForProcess pid >>= return . \case
ExitSuccess -> True
_ -> False
@ -820,11 +820,13 @@ seekSyncContent o rs currbranch = do
)
_ -> case currbranch of
(Just origbranch, Just adj) | adjustmentHidesFiles adj -> do
l <- workTreeItems' (AllowHidden True) ww (contentOfOption o)
l <- workTreeItems' (AllowHidden True) ww
(map fromOsPath (contentOfOption o))
seekincludinghidden origbranch mvar l (const noop)
pure Nothing
_ -> do
l <- workTreeItems ww (contentOfOption o)
l <- workTreeItems ww
(map fromOsPath (contentOfOption o))
seekworktree mvar l (const noop)
pure Nothing
waitForAllRunningCommandActions
@ -1013,7 +1015,7 @@ seekExportContent' o rs (mcurrbranch, madj)
mtree <- inRepo $ Git.Ref.tree b
let addsubdir = case snd (splitRemoteAnnexTrackingBranchSubdir b) of
Just subdir -> \cb -> Git.Ref $
Git.fromRef' cb <> ":" <> getTopFilePath subdir
Git.fromRef' cb <> ":" <> fromOsPath (getTopFilePath subdir)
Nothing -> id
mcurrtree <- maybe (pure Nothing)
(inRepo . Git.Ref.tree . addsubdir)