more OsPath conversion (520/749)
Sponsored-by: mycroft
This commit is contained in:
Joey Hess
parent
9394197621
commit
0d2b805806
11 changed files with 141 additions and 148 deletions
|
|
@ -154,12 +154,12 @@ batchCommandStart a = a >>= \case
|
|||
-- to handle them.
|
||||
--
|
||||
-- File matching options are checked, and non-matching files skipped.
|
||||
batchFiles :: BatchFormat -> ((SeekInput, RawFilePath) -> CommandStart) -> Annex ()
|
||||
batchFiles :: BatchFormat -> ((SeekInput, OsPath) -> CommandStart) -> Annex ()
|
||||
batchFiles fmt a = batchFilesKeys fmt $ \(si, v) -> case v of
|
||||
Right f -> a (si, f)
|
||||
Left _k -> return Nothing
|
||||
|
||||
batchFilesKeys :: BatchFormat -> ((SeekInput, Either Key RawFilePath) -> CommandStart) -> Annex ()
|
||||
batchFilesKeys :: BatchFormat -> ((SeekInput, Either Key OsPath) -> CommandStart) -> Annex ()
|
||||
batchFilesKeys fmt a = do
|
||||
matcher <- getMatcher
|
||||
go $ \si v -> case v of
|
||||
|
|
@ -177,7 +177,7 @@ batchFilesKeys fmt a = do
|
|||
-- CmdLine.Seek uses git ls-files.
|
||||
BatchFormat _ (BatchKeys False) ->
|
||||
Right . Right
|
||||
<$$> liftIO . relPathCwdToFile . toRawFilePath
|
||||
<$$> liftIO . relPathCwdToFile . toOsPath
|
||||
BatchFormat _ (BatchKeys True) -> \i ->
|
||||
pure $ case deserializeKey i of
|
||||
Just k -> Right (Left k)
|
||||
|
|
|
|||
|
|
@ -48,6 +48,7 @@ import qualified Database.Keys
|
|||
import qualified Utility.RawFilePath as R
|
||||
import Utility.Tuple
|
||||
import Utility.HumanTime
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
import Control.Concurrent.Async
|
||||
import Control.Concurrent.STM
|
||||
|
|
@ -55,11 +56,9 @@ import System.Posix.Types
|
|||
import Data.IORef
|
||||
import Data.Time.Clock.POSIX
|
||||
import System.PosixCompat.Files (isDirectory, isSymbolicLink, deviceID, fileID)
|
||||
import qualified System.FilePath.ByteString as P
|
||||
import qualified Data.ByteString as S
|
||||
|
||||
data AnnexedFileSeeker = AnnexedFileSeeker
|
||||
{ startAction :: Maybe KeySha -> SeekInput -> RawFilePath -> Key -> CommandStart
|
||||
{ startAction :: Maybe KeySha -> SeekInput -> OsPath -> Key -> CommandStart
|
||||
, checkContentPresent :: Maybe Bool
|
||||
, usesLocationLog :: Bool
|
||||
}
|
||||
|
|
@ -82,7 +81,7 @@ withFilesInGitAnnexNonRecursive ww needforce a (WorkTreeItems l) = ifM (Annex.ge
|
|||
getfiles c [] = return (reverse c, pure True)
|
||||
getfiles c (p:ps) = do
|
||||
os <- seekOptions ww
|
||||
(fs, cleanup) <- inRepo $ LsFiles.inRepoDetails os [toRawFilePath p]
|
||||
(fs, cleanup) <- inRepo $ LsFiles.inRepoDetails os [toOsPath p]
|
||||
r <- case fs of
|
||||
[f] -> do
|
||||
propagateLsFilesError cleanup
|
||||
|
|
@ -96,18 +95,18 @@ withFilesInGitAnnexNonRecursive ww needforce a (WorkTreeItems l) = ifM (Annex.ge
|
|||
return (r, pure True)
|
||||
withFilesInGitAnnexNonRecursive _ _ _ NoWorkTreeItems = noop
|
||||
|
||||
withFilesNotInGit :: CheckGitIgnore -> WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
|
||||
withFilesNotInGit :: CheckGitIgnore -> WarnUnmatchWhen -> ((SeekInput, OsPath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
|
||||
withFilesNotInGit (CheckGitIgnore ci) ww a l = do
|
||||
force <- Annex.getRead Annex.force
|
||||
let include_ignored = force || not ci
|
||||
seekFiltered (const (pure True)) a $
|
||||
seekHelper id ww (const $ LsFiles.notInRepo [] include_ignored) l
|
||||
|
||||
withPathContents :: ((RawFilePath, RawFilePath) -> CommandSeek) -> CmdParams -> CommandSeek
|
||||
withPathContents :: ((OsPath, OsPath) -> CommandSeek) -> CmdParams -> CommandSeek
|
||||
withPathContents a params = do
|
||||
matcher <- Limit.getMatcher
|
||||
checktimelimit <- mkCheckTimeLimit
|
||||
go matcher checktimelimit params []
|
||||
go matcher checktimelimit (map toOsPath params) []
|
||||
where
|
||||
go _ _ [] [] = return ()
|
||||
go matcher checktimelimit (p:ps) [] =
|
||||
|
|
@ -121,14 +120,12 @@ withPathContents a params = do
|
|||
-- fail if the path that the user provided is a broken symlink,
|
||||
-- the same as it fails if the path that the user provided does not
|
||||
-- exist.
|
||||
get p = ifM (isDirectory <$> R.getFileStatus p')
|
||||
get p = ifM (isDirectory <$> R.getFileStatus (fromOsPath p))
|
||||
( map (\f ->
|
||||
(f, P.makeRelative (P.takeDirectory (P.dropTrailingPathSeparator p')) f))
|
||||
<$> dirContentsRecursiveSkipping (".git" `S.isSuffixOf`) False p'
|
||||
, return [(p', P.takeFileName p')]
|
||||
(f, makeRelative (takeDirectory (dropTrailingPathSeparator p)) f))
|
||||
<$> dirContentsRecursiveSkipping (literalOsPath ".git" `OS.isSuffixOf`) False p
|
||||
, return [(p, takeFileName p)]
|
||||
)
|
||||
where
|
||||
p' = toRawFilePath p
|
||||
|
||||
checkmatch matcher (f, relf) = matcher $ MatchingFile $ FileInfo
|
||||
{ contentFile = f
|
||||
|
|
@ -150,24 +147,24 @@ withPairs a params = sequence_ $
|
|||
pairs c (x:y:xs) = pairs ((x,y):c) xs
|
||||
pairs _ _ = giveup "expected pairs"
|
||||
|
||||
withFilesToBeCommitted :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
|
||||
withFilesToBeCommitted :: WarnUnmatchWhen -> ((SeekInput, OsPath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
|
||||
withFilesToBeCommitted ww a l = seekFiltered (const (pure True)) a $
|
||||
seekHelper id ww (const LsFiles.stagedNotDeleted) l
|
||||
|
||||
{- unlocked pointer files that are staged, and whose content has not been
|
||||
- modified-}
|
||||
withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
|
||||
withUnmodifiedUnlockedPointers :: WarnUnmatchWhen -> ((SeekInput, OsPath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
|
||||
withUnmodifiedUnlockedPointers ww a l =
|
||||
seekFiltered (isUnmodifiedUnlocked . snd) a $
|
||||
seekHelper id ww (const LsFiles.typeChangedStaged) l
|
||||
|
||||
isUnmodifiedUnlocked :: RawFilePath -> Annex Bool
|
||||
isUnmodifiedUnlocked :: OsPath -> Annex Bool
|
||||
isUnmodifiedUnlocked f = catKeyFile f >>= \case
|
||||
Nothing -> return False
|
||||
Just k -> sameInodeCache f =<< Database.Keys.getInodeCaches k
|
||||
|
||||
{- Finds files that may be modified. -}
|
||||
withFilesMaybeModified :: WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
|
||||
withFilesMaybeModified :: WarnUnmatchWhen -> ((SeekInput, OsPath) -> CommandSeek) -> WorkTreeItems -> CommandSeek
|
||||
withFilesMaybeModified ww a params = seekFiltered (const (pure True)) a $
|
||||
seekHelper id ww LsFiles.modified params
|
||||
|
||||
|
|
@ -320,7 +317,7 @@ withKeyOptions' ko auto mkkeyaction fallbackaction worktreeitems = do
|
|||
forM_ ts $ \(t, i) ->
|
||||
keyaction Nothing (SeekInput [], transferKey t, mkActionItem (t, i))
|
||||
|
||||
seekFiltered :: ((SeekInput, RawFilePath) -> Annex Bool) -> ((SeekInput, RawFilePath) -> CommandSeek) -> Annex ([(SeekInput, RawFilePath)], IO Bool) -> Annex ()
|
||||
seekFiltered :: ((SeekInput, OsPath) -> Annex Bool) -> ((SeekInput, OsPath) -> CommandSeek) -> Annex ([(SeekInput, OsPath)], IO Bool) -> Annex ()
|
||||
seekFiltered prefilter a listfs = do
|
||||
matcher <- Limit.getMatcher
|
||||
checktimelimit <- mkCheckTimeLimit
|
||||
|
|
@ -351,7 +348,7 @@ checkMatcherWhen mi c i a
|
|||
-- because of the way data is streamed through git cat-file.
|
||||
--
|
||||
-- It can also precache location logs using the same efficient streaming.
|
||||
seekFilteredKeys :: AnnexedFileSeeker -> Annex ([(SeekInput, (RawFilePath, Git.Sha, FileMode))], IO Bool) -> Annex ()
|
||||
seekFilteredKeys :: AnnexedFileSeeker -> Annex ([(SeekInput, (OsPath, Git.Sha, FileMode))], IO Bool) -> Annex ()
|
||||
seekFilteredKeys seeker listfs = do
|
||||
g <- Annex.gitRepo
|
||||
mi <- MatcherInfo
|
||||
|
|
@ -465,7 +462,7 @@ seekFilteredKeys seeker listfs = do
|
|||
|
||||
-- Check if files exist, because a deleted file will still be
|
||||
-- listed by ls-tree, but should not be processed.
|
||||
exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus p)
|
||||
exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus (fromOsPath p))
|
||||
|
||||
mdprocess mi mdreader ofeeder ocloser = liftIO mdreader >>= \case
|
||||
Just ((si, f), Just (sha, size, _type))
|
||||
|
|
@ -485,18 +482,18 @@ seekFilteredKeys seeker listfs = do
|
|||
null <$> Annex.Branch.getUnmergedRefs
|
||||
| otherwise = pure False
|
||||
|
||||
seekHelper :: (a -> RawFilePath) -> WarnUnmatchWhen -> ([LsFiles.Options] -> [RawFilePath] -> Git.Repo -> IO ([a], IO Bool)) -> WorkTreeItems -> Annex ([(SeekInput, a)], IO Bool)
|
||||
seekHelper :: (a -> OsPath) -> WarnUnmatchWhen -> ([LsFiles.Options] -> [OsPath] -> Git.Repo -> IO ([a], IO Bool)) -> WorkTreeItems -> Annex ([(SeekInput, a)], IO Bool)
|
||||
seekHelper c ww a (WorkTreeItems l) = do
|
||||
os <- seekOptions ww
|
||||
v <- liftIO $ newIORef []
|
||||
r <- inRepo $ \g -> concat . concat <$> forM (segmentXargsOrdered l)
|
||||
(runSegmentPaths' mk c (\fs -> go v os fs g) . map toRawFilePath)
|
||||
(runSegmentPaths' mk c (\fs -> go v os fs g) . map toOsPath)
|
||||
return (r, cleanupall v)
|
||||
where
|
||||
mk (Just i) f = (SeekInput [fromRawFilePath i], f)
|
||||
mk (Just i) f = (SeekInput [fromOsPath i], f)
|
||||
-- This is not accurate, but it only happens when there are a
|
||||
-- great many input WorkTreeItems.
|
||||
mk Nothing f = (SeekInput [fromRawFilePath (c f)], f)
|
||||
mk Nothing f = (SeekInput [fromOsPath (c f)], f)
|
||||
|
||||
go v os fs g = do
|
||||
(ls, cleanup) <- a os fs g
|
||||
|
|
@ -561,7 +558,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
|
|||
currbranch <- getCurrentBranch
|
||||
stopattop <- prepviasymlink
|
||||
ps' <- flip filterM ps $ \p -> do
|
||||
let p' = toRawFilePath p
|
||||
let p' = toOsPath p
|
||||
relf <- liftIO $ relPathCwdToFile p'
|
||||
ifM (not <$> (exists p' <||> hidden currbranch relf))
|
||||
( prob action FileNotFound p' "not found"
|
||||
|
|
@ -574,13 +571,13 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
|
|||
then return NoWorkTreeItems
|
||||
else return (WorkTreeItems ps')
|
||||
|
||||
exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus p)
|
||||
exists p = isJust <$> liftIO (catchMaybeIO $ R.getSymbolicLinkStatus $ fromOsPath p)
|
||||
|
||||
prepviasymlink = do
|
||||
repotopst <- inRepo $
|
||||
maybe
|
||||
(pure Nothing)
|
||||
(catchMaybeIO . R.getSymbolicLinkStatus)
|
||||
(catchMaybeIO . R.getSymbolicLinkStatus . fromOsPath)
|
||||
. Git.repoWorkTree
|
||||
return $ \st -> case repotopst of
|
||||
Nothing -> False
|
||||
|
|
@ -589,7 +586,7 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
|
|||
|
||||
viasymlink _ Nothing = return False
|
||||
viasymlink stopattop (Just p) = do
|
||||
st <- liftIO $ R.getSymbolicLinkStatus p
|
||||
st <- liftIO $ R.getSymbolicLinkStatus $ fromOsPath p
|
||||
if stopattop st
|
||||
then return False
|
||||
else if isSymbolicLink st
|
||||
|
|
@ -602,12 +599,12 @@ workTreeItems' (AllowHidden allowhidden) ww ps = case ww of
|
|||
| otherwise = return False
|
||||
|
||||
prob action errorid p msg = do
|
||||
toplevelFileProblem False errorid msg action p Nothing (SeekInput [fromRawFilePath p])
|
||||
toplevelFileProblem False errorid msg action p Nothing (SeekInput [fromOsPath p])
|
||||
Annex.incError
|
||||
return False
|
||||
|
||||
notSymlink :: RawFilePath -> IO Bool
|
||||
notSymlink f = liftIO $ not . isSymbolicLink <$> R.getSymbolicLinkStatus f
|
||||
notSymlink :: OsPath -> IO Bool
|
||||
notSymlink f = liftIO $ not . isSymbolicLink <$> R.getSymbolicLinkStatus (fromOsPath f)
|
||||
|
||||
{- Returns an action that, when there's a time limit, can be used
|
||||
- to check it before processing a file. The first action is run when
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue