From 0d2b805806f2eba7d7932fa3216d40ce90c4b4c3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 5 Feb 2025 15:07:59 -0400 Subject: [PATCH] more OsPath conversion (520/749) Sponsored-by: mycroft --- Annex/FileMatcher.hs | 13 +++---- Annex/Ingest.hs | 71 +++++++++++++++++++------------------- Annex/NumCopies.hs | 12 +++---- Annex/Proxy.hs | 19 +++++----- Annex/View.hs | 45 ++++++++++++------------ Annex/View/ViewedFile.hs | 13 ++++--- Assistant/Types/Changes.hs | 4 +-- CmdLine/Batch.hs | 6 ++-- CmdLine/Seek.hs | 59 +++++++++++++++---------------- Limit.hs | 45 +++++++++++------------- Types/FileMatcher.hs | 2 +- 11 files changed, 141 insertions(+), 148 deletions(-) diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs index 3d175875eb..6157efa3f0 100644 --- a/Annex/FileMatcher.hs +++ b/Annex/FileMatcher.hs @@ -5,6 +5,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Annex.FileMatcher ( @@ -56,14 +57,14 @@ import Data.Either import qualified Data.Set as S import Control.Monad.Writer -type GetFileMatcher = RawFilePath -> Annex (FileMatcher Annex) +type GetFileMatcher = OsPath -> Annex (FileMatcher Annex) -checkFileMatcher :: LiveUpdate -> GetFileMatcher -> RawFilePath -> Annex Bool +checkFileMatcher :: LiveUpdate -> GetFileMatcher -> OsPath -> Annex Bool checkFileMatcher lu getmatcher file = checkFileMatcher' lu getmatcher file (return True) -- | Allows running an action when no matcher is configured for the file. -checkFileMatcher' :: LiveUpdate -> GetFileMatcher -> RawFilePath -> Annex Bool -> Annex Bool +checkFileMatcher' :: LiveUpdate -> GetFileMatcher -> OsPath -> Annex Bool -> Annex Bool checkFileMatcher' lu getmatcher file notconfigured = do matcher <- getmatcher file checkMatcher matcher Nothing afile lu S.empty notconfigured d @@ -120,7 +121,7 @@ checkMatcher' (matcher, (MatcherDesc matcherdesc)) mi lu notpresent = fromMaybe mempty descmsg <> UnquotedString s return False -fileMatchInfo :: RawFilePath -> Maybe Key -> Annex MatchInfo +fileMatchInfo :: OsPath -> Maybe Key -> Annex MatchInfo fileMatchInfo file mkey = do matchfile <- getTopFilePath <$> inRepo (toTopFilePath file) return $ MatchingFile FileInfo @@ -160,7 +161,7 @@ parseToken l t = case syntaxToken t of tokenizeMatcher :: String -> [String] tokenizeMatcher = filter (not . null) . concatMap splitparens . words where - splitparens = segmentDelim (`elem` "()") + splitparens = segmentDelim (`elem` ("()" :: String)) commonTokens :: LimitBy -> [ParseToken (MatchFiles Annex)] commonTokens lb = @@ -201,7 +202,7 @@ preferredContentTokens pcd = , ValueToken "fullysizebalanced" (usev $ limitFullySizeBalanced (repoUUID pcd) (getGroupMap pcd)) ] ++ commonTokens LimitAnnexFiles where - preferreddir = maybe "public" fromProposedAccepted $ + preferreddir = toOsPath $ maybe "public" fromProposedAccepted $ M.lookup preferreddirField =<< (`M.lookup` configMap pcd) =<< repoUUID pcd preferredContentParser :: [ParseToken (MatchFiles Annex)] -> String -> [ParseResult (MatchFiles Annex)] diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index ed7479526f..47399567fc 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -66,7 +66,7 @@ data LockedDown = LockedDown data LockDownConfig = LockDownConfig { lockingFile :: Bool -- ^ write bit removed during lock down - , hardlinkFileTmpDir :: Maybe RawFilePath + , hardlinkFileTmpDir :: Maybe OsPath -- ^ hard link to temp directory , checkWritePerms :: Bool -- ^ check that write perms are successfully removed @@ -87,13 +87,13 @@ data LockDownConfig = LockDownConfig - Lockdown can fail if a file gets deleted, or if it's unable to remove - write permissions, and Nothing will be returned. -} -lockDown :: LockDownConfig-> FilePath -> Annex (Maybe LockedDown) +lockDown :: LockDownConfig-> OsPath -> Annex (Maybe LockedDown) lockDown cfg file = either (\e -> warning (UnquotedString (show e)) >> return Nothing) (return . Just) =<< lockDown' cfg file -lockDown' :: LockDownConfig -> FilePath -> Annex (Either SomeException LockedDown) +lockDown' :: LockDownConfig -> OsPath -> Annex (Either SomeException LockedDown) lockDown' cfg file = tryNonAsync $ ifM crippledFileSystem ( nohardlink , case hardlinkFileTmpDir cfg of @@ -101,49 +101,46 @@ lockDown' cfg file = tryNonAsync $ ifM crippledFileSystem Just tmpdir -> withhardlink tmpdir ) where - file' = toRawFilePath file - nohardlink = do setperms withTSDelta $ liftIO . nohardlink' nohardlink' delta = do - cache <- genInodeCache file' delta + cache <- genInodeCache file delta return $ LockedDown cfg $ KeySource - { keyFilename = file' - , contentLocation = file' + { keyFilename = file + , contentLocation = file , inodeCache = cache } withhardlink tmpdir = do setperms withTSDelta $ \delta -> liftIO $ do - (tmpfile, h) <- openTmpFileIn (toOsPath tmpdir) $ - relatedTemplate $ toRawFilePath $ - "ingest-" ++ takeFileName file + (tmpfile, h) <- openTmpFileIn tmpdir $ + relatedTemplate $ fromOsPath $ + literalOsPath "ingest-" <> takeFileName file hClose h - let tmpfile' = fromOsPath tmpfile - removeWhenExistsWith R.removeLink tmpfile' - withhardlink' delta tmpfile' + removeWhenExistsWith R.removeLink (fromOsPath tmpfile) + withhardlink' delta tmpfile `catchIO` const (nohardlink' delta) withhardlink' delta tmpfile = do - R.createLink file' tmpfile + R.createLink (fromOsPath file) (fromOsPath tmpfile) cache <- genInodeCache tmpfile delta return $ LockedDown cfg $ KeySource - { keyFilename = file' + { keyFilename = file , contentLocation = tmpfile , inodeCache = cache } setperms = when (lockingFile cfg) $ do - freezeContent file' + freezeContent file when (checkWritePerms cfg) $ do qp <- coreQuotePath <$> Annex.getGitConfig maybe noop (giveup . decodeBS . quote qp) - =<< checkLockedDownWritePerms file' file' + =<< checkLockedDownWritePerms file file -checkLockedDownWritePerms :: RawFilePath -> RawFilePath -> Annex (Maybe StringContainingQuotedPath) +checkLockedDownWritePerms :: OsPath -> OsPath -> Annex (Maybe StringContainingQuotedPath) checkLockedDownWritePerms file displayfile = checkContentWritePerm file >>= return . \case Just False -> Just $ "Unable to remove all write permissions from " <> QuotedPath displayfile @@ -167,7 +164,8 @@ ingestAdd' meterupdate ld@(Just (LockedDown cfg source)) mk = do then addSymlink f k mic else do mode <- liftIO $ catchMaybeIO $ - fileMode <$> R.getFileStatus (contentLocation source) + fileMode <$> R.getFileStatus + (fromOsPath (contentLocation source)) stagePointerFile f mode =<< hashPointerFile k return (Just k) @@ -188,7 +186,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage = fst <$> genKey source meterupdate backend Just k -> return k let src = contentLocation source - ms <- liftIO $ catchMaybeIO $ R.getFileStatus src + ms <- liftIO $ catchMaybeIO $ R.getFileStatus (fromOsPath src) mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta src) ms case (mcache, inodeCache source) of (_, Nothing) -> go k mcache @@ -263,12 +261,12 @@ populateUnlockedFiles key source restage _ = do cleanCruft :: KeySource -> Annex () cleanCruft source = when (contentLocation source /= keyFilename source) $ - liftIO $ removeWhenExistsWith R.removeLink $ contentLocation source + liftIO $ removeWhenExistsWith removeFile $ contentLocation source -- If a worktree file was was hard linked to an annex object before, -- modifying the file would have caused the object to have the wrong -- content. Clean up from that. -cleanOldKeys :: RawFilePath -> Key -> Annex () +cleanOldKeys :: OsPath -> Key -> Annex () cleanOldKeys file newkey = do g <- Annex.gitRepo topf <- inRepo (toTopFilePath file) @@ -293,37 +291,38 @@ cleanOldKeys file newkey = do {- On error, put the file back so it doesn't seem to have vanished. - This can be called before or after the symlink is in place. -} -restoreFile :: RawFilePath -> Key -> SomeException -> Annex a +restoreFile :: OsPath -> Key -> SomeException -> Annex a restoreFile file key e = do whenM (inAnnex key) $ do - liftIO $ removeWhenExistsWith R.removeLink file + liftIO $ removeWhenExistsWith removeFile file -- The key could be used by other files too, so leave the -- content in the annex, and make a copy back to the file. - obj <- fromRawFilePath <$> calcRepo (gitAnnexLocation key) - unlessM (liftIO $ copyFileExternal CopyTimeStamps obj (fromRawFilePath file)) $ - warning $ "Unable to restore content of " <> QuotedPath file <> "; it should be located in " <> QuotedPath (toRawFilePath obj) + obj <- calcRepo (gitAnnexLocation key) + unlessM (liftIO $ copyFileExternal CopyTimeStamps obj file) $ + warning $ "Unable to restore content of " <> QuotedPath file <> "; it should be located in " <> QuotedPath obj thawContent file throwM e {- Creates the symlink to the annexed content, returns the link target. -} -makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget +makeLink :: OsPath -> Key -> Maybe InodeCache -> Annex LinkTarget makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do - l <- calcRepo $ gitAnnexLink file key + l <- fromOsPath <$> calcRepo (gitAnnexLink file key) replaceWorkTreeFile file $ makeAnnexLink l -- touch symlink to have same time as the original file, -- as provided in the InodeCache case mcache of - Just c -> liftIO $ touch file (inodeCacheToMtime c) False + Just c -> liftIO $ + touch (fromOsPath file) (inodeCacheToMtime c) False Nothing -> noop return l {- Creates the symlink to the annexed content, and stages it in git. -} -addSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex () +addSymlink :: OsPath -> Key -> Maybe InodeCache -> Annex () addSymlink file key mcache = stageSymlink file =<< genSymlink file key mcache -genSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex Git.Sha +genSymlink :: OsPath -> Key -> Maybe InodeCache -> Annex Git.Sha genSymlink file key mcache = do linktarget <- makeLink file key mcache hashSymlink linktarget @@ -368,12 +367,12 @@ addUnlocked matcher mi contentpresent = - - When the content of the key is not accepted into the annex, returns False. -} -addAnnexedFile :: AddUnlockedMatcher -> RawFilePath -> Key -> Maybe RawFilePath -> Annex Bool +addAnnexedFile :: AddUnlockedMatcher -> OsPath -> Key -> Maybe OsPath -> Annex Bool addAnnexedFile matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mtmp)) ( do mode <- maybe (pure Nothing) - (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus tmp) + (\tmp -> liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus (fromOsPath tmp)) mtmp stagePointerFile file mode =<< hashPointerFile key Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) @@ -411,7 +410,7 @@ addAnnexedFile matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mtmp) {- Use with actions that add an already existing annex symlink or pointer - file. The warning avoids a confusing situation where the file got copied - from another git-annex repo, probably by accident. -} -addingExistingLink :: RawFilePath -> Key -> Annex a -> Annex a +addingExistingLink :: OsPath -> Key -> Annex a -> Annex a addingExistingLink f k a = do unlessM (isKnownKey k <||> inAnnex k) $ do islink <- isJust <$> isAnnexLink f diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs index 6ec339cae8..a3885415c5 100644 --- a/Annex/NumCopies.hs +++ b/Annex/NumCopies.hs @@ -88,7 +88,7 @@ getMinCopies = fromSourcesOr defaultMinCopies {- NumCopies and MinCopies value for a file, from any configuration source, - including .gitattributes. -} -getFileNumMinCopies :: RawFilePath -> Annex (NumCopies, MinCopies) +getFileNumMinCopies :: OsPath -> Annex (NumCopies, MinCopies) getFileNumMinCopies f = do fnumc <- getForcedNumCopies fminc <- getForcedMinCopies @@ -141,7 +141,7 @@ getSafestNumMinCopies afile k = Database.Keys.getAssociatedFilesIncluding afile k >>= getSafestNumMinCopies' afile k -getSafestNumMinCopies' :: AssociatedFile -> Key -> [RawFilePath] -> Annex (NumCopies, MinCopies) +getSafestNumMinCopies' :: AssociatedFile -> Key -> [OsPath] -> Annex (NumCopies, MinCopies) getSafestNumMinCopies' afile k fs = do l <- mapM getFileNumMinCopies fs let l' = zip l fs @@ -174,13 +174,13 @@ getSafestNumMinCopies' afile k fs = do {- This is the globally visible numcopies value for a file. So it does - not include local configuration in the git config or command line - options. -} -getGlobalFileNumCopies :: RawFilePath -> Annex NumCopies +getGlobalFileNumCopies :: OsPath -> Annex NumCopies getGlobalFileNumCopies f = fromSourcesOr defaultNumCopies [ fst <$> getNumMinCopiesAttr f , getGlobalNumCopies ] -getNumMinCopiesAttr :: RawFilePath -> Annex (Maybe NumCopies, Maybe MinCopies) +getNumMinCopiesAttr :: OsPath -> Annex (Maybe NumCopies, Maybe MinCopies) getNumMinCopiesAttr file = checkAttrs ["annex.numcopies", "annex.mincopies"] file >>= \case (n:m:[]) -> return @@ -196,12 +196,12 @@ getNumMinCopiesAttr file = - This is good enough for everything except dropping the file, which - requires active verification of the copies. -} -numCopiesCheck :: RawFilePath -> Key -> (Int -> Int -> v) -> Annex v +numCopiesCheck :: OsPath -> Key -> (Int -> Int -> v) -> Annex v numCopiesCheck file key vs = do have <- trustExclude UnTrusted =<< Remote.keyLocations key numCopiesCheck' file vs have -numCopiesCheck' :: RawFilePath -> (Int -> Int -> v) -> [UUID] -> Annex v +numCopiesCheck' :: OsPath -> (Int -> Int -> v) -> [UUID] -> Annex v numCopiesCheck' file vs have = do needed <- fst <$> getFileNumMinCopies file let nhave = numCopiesCount have diff --git a/Annex/Proxy.hs b/Annex/Proxy.hs index fe11be06b3..d6c3fe8f12 100644 --- a/Annex/Proxy.hs +++ b/Annex/Proxy.hs @@ -41,7 +41,6 @@ import Control.Concurrent.STM import Control.Concurrent.Async import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L -import qualified System.FilePath.ByteString as P import qualified Data.Map as M import qualified Data.Set as S #ifndef mingw32_HOST_OS @@ -177,8 +176,8 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go -- independently. Also, this key is not getting added into the -- local annex objects. withproxytmpfile k a = withOtherTmp $ \othertmpdir -> - withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath "proxy") $ \tmpdir -> - a (toRawFilePath tmpdir P. keyFile k) + withTmpDirIn othertmpdir (literalOsPath "proxy") $ \tmpdir -> + a (tmpdir keyFile k) proxyput af k = do liftIO $ sendmessage $ PUT_FROM (Offset 0) @@ -188,14 +187,14 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go -- the client, to avoid bad content -- being stored in the special remote. iv <- startVerifyKeyContentIncrementally Remote.AlwaysVerify k - h <- liftIO $ F.openFile (toOsPath tmpfile) WriteMode - let nuketmp = liftIO $ removeWhenExistsWith removeFile (fromRawFilePath tmpfile) + h <- liftIO $ F.openFile tmpfile WriteMode + let nuketmp = liftIO $ removeWhenExistsWith removeFile tmpfile gotall <- liftIO $ receivetofile iv h len liftIO $ hClose h verified <- if gotall then fst <$> finishVerifyKeyContentIncrementally' True iv else pure False - let store = tryNonAsync (storeput k af (decodeBS tmpfile)) >>= \case + let store = tryNonAsync (storeput k af tmpfile) >>= \case Right () -> liftIO $ sendmessage SUCCESS Left err -> liftIO $ propagateerror err if protoversion > ProtocolVersion 1 @@ -262,8 +261,8 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go storetofile iv h (n - fromIntegral (B.length b)) bs proxyget offset af k = withproxytmpfile k $ \tmpfile -> do - let retrieve = tryNonAsync $ Remote.retrieveKeyFile r k af - (fromRawFilePath tmpfile) nullMeterUpdate vc + let retrieve = tryNonAsync $ Remote.retrieveKeyFile + r k af tmpfile nullMeterUpdate vc #ifndef mingw32_HOST_OS ordered <- Remote.retrieveKeyFileInOrder r #else @@ -298,7 +297,7 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go sendlen offset size waitforfile x <- tryNonAsync $ do - h <- openFileBeingWritten f + h <- openFileBeingWritten (fromOsPath f) hSeek h AbsoluteSeek offset senddata' h (getcontents size) case x of @@ -350,7 +349,7 @@ proxySpecialRemote protoversion r ihdl ohdl owaitv oclosedv mexportdb = go senddata (Offset offset) f = do size <- fromIntegral <$> getFileSize f sendlen offset size - withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do + F.withBinaryFile f ReadMode $ \h -> do hSeek h AbsoluteSeek offset senddata' h L.hGetContents diff --git a/Annex/View.hs b/Annex/View.hs index 0f9a759acb..563419d88b 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -40,13 +40,12 @@ import Logs.View import Utility.Glob import Types.Command import CmdLine.Action -import qualified Utility.RawFilePath as R +import qualified Utility.OsString as OS import qualified Data.Text as T import qualified Data.ByteString as B import qualified Data.Set as S import qualified Data.Map as M -import qualified System.FilePath.ByteString as P import Control.Concurrent.Async import "mtl" Control.Monad.Writer @@ -251,7 +250,7 @@ combineViewFilter (ExcludeValues _) new@(FilterGlobOrUnset _ _) = (new, Widening - evaluate this function with the view parameter and reuse - the result. The globs in the view will then be compiled and memoized. -} -viewedFiles :: View -> MkViewedFile -> FilePath -> MetaData -> [ViewedFile] +viewedFiles :: View -> MkViewedFile -> OsPath -> MetaData -> [ViewedFile] viewedFiles view = let matchers = map viewComponentMatcher (viewComponents view) in \mkviewedfile file metadata -> @@ -260,7 +259,8 @@ viewedFiles view = then [] else let paths = pathProduct $ - map (map toviewpath) (visible matches) + map (map (toOsPath . toviewpath)) + (visible matches) in if null paths then [mkviewedfile file] else map ( mkviewedfile file) paths @@ -346,7 +346,7 @@ fromViewPath = toMetaValue . encodeBS . deescapepseudo [] prop_viewPath_roundtrips :: MetaValue -> Bool prop_viewPath_roundtrips v = fromViewPath (toViewPath v) == v -pathProduct :: [[FilePath]] -> [FilePath] +pathProduct :: [[OsPath]] -> [OsPath] pathProduct [] = [] pathProduct (l:ls) = foldl combinel l ls where @@ -364,7 +364,7 @@ fromView view f = MetaData $ m `M.difference` derived filter (not . isviewunset) (zip visible values) visible = filter viewVisible (viewComponents view) paths = splitDirectories (dropFileName f) - values = map (S.singleton . fromViewPath) paths + values = map (S.singleton . fromViewPath . fromOsPath) paths MetaData derived = getViewedFileMetaData f convfield (vc, v) = (viewField vc, v) @@ -385,9 +385,9 @@ fromView view f = MetaData $ m `M.difference` derived prop_view_roundtrips :: AssociatedFile -> MetaData -> Bool -> Bool prop_view_roundtrips (AssociatedFile Nothing) _ _ = True prop_view_roundtrips (AssociatedFile (Just f)) metadata visible = or - [ B.null (P.takeFileName f) && B.null (P.takeDirectory f) + [ OS.null (takeFileName f) && OS.null (takeDirectory f) , viewTooLarge view - , all hasfields (viewedFiles view (viewedFileFromReference' Nothing Nothing) (fromRawFilePath f) metadata) + , all hasfields (viewedFiles view (viewedFileFromReference' Nothing Nothing) f metadata) ] where view = View (Git.Ref "foo") $ @@ -402,19 +402,19 @@ prop_view_roundtrips (AssociatedFile (Just f)) metadata visible = or - Note that this may generate MetaFields that legalField rejects. - This is necessary to have a 1:1 mapping between directory names and - fields. So this MetaData cannot safely be serialized. -} -getDirMetaData :: FilePath -> MetaData +getDirMetaData :: OsPath -> MetaData getDirMetaData d = MetaData $ M.fromList $ zip fields values where dirs = splitDirectories d - fields = map (mkMetaFieldUnchecked . T.pack . addTrailingPathSeparator . joinPath) + fields = map (mkMetaFieldUnchecked . T.pack . fromOsPath . addTrailingPathSeparator . joinPath) (inits dirs) values = map (S.singleton . toMetaValue . encodeBS . fromMaybe "" . headMaybe) - (tails dirs) + (tails (map fromOsPath dirs)) -getWorkTreeMetaData :: FilePath -> MetaData +getWorkTreeMetaData :: OsPath -> MetaData getWorkTreeMetaData = getDirMetaData . dropFileName -getViewedFileMetaData :: FilePath -> MetaData +getViewedFileMetaData :: OsPath -> MetaData getViewedFileMetaData = getDirMetaData . dirFromViewedFile . takeFileName {- Applies a view to the currently checked out branch, generating a new @@ -439,7 +439,7 @@ narrowView = applyView' viewedFileReuse getViewedFileMetaData - Look up the metadata of annexed files, and generate any ViewedFiles, - and stage them. -} -applyView' :: MkViewedFile -> (FilePath -> MetaData) -> View -> Maybe Adjustment -> Annex Git.Branch +applyView' :: MkViewedFile -> (OsPath -> MetaData) -> View -> Maybe Adjustment -> Annex Git.Branch applyView' mkviewedfile getfilemetadata view madj = do top <- fromRepo Git.repoPath (l, clean) <- inRepo $ Git.LsFiles.inRepoDetails [] [top] @@ -452,7 +452,7 @@ applyView' mkviewedfile getfilemetadata view madj = do applyView'' :: MkViewedFile - -> (FilePath -> MetaData) + -> (OsPath -> MetaData) -> View -> Maybe Adjustment -> [t] @@ -488,18 +488,18 @@ applyView'' mkviewedfile getfilemetadata view madj l clean conv = do -- Git.UpdateIndex.streamUpdateIndex' -- here would race with process's calls -- to it. - | "." `B.isPrefixOf` getTopFilePath topf -> - feed "dummy" + | literalOsPath "." `OS.isPrefixOf` getTopFilePath topf -> + feed (literalOsPath "dummy") | otherwise -> noop getmetadata gc mdfeeder mdcloser ts process uh mdreader = liftIO mdreader >>= \case Just ((topf, _, mtreeitemtype, Just k), mdlog) -> do let metadata = maybe emptyMetaData parseCurrentMetaData mdlog - let f = fromRawFilePath $ getTopFilePath topf + let f = getTopFilePath topf let metadata' = getfilemetadata f `unionMetaData` metadata forM_ (genviewedfiles f metadata') $ \fv -> do - f' <- fromRepo (fromTopFilePath $ asTopFilePath $ toRawFilePath fv) + f' <- fromRepo (fromTopFilePath $ asTopFilePath fv) stagefile uh f' k mtreeitemtype process uh mdreader Just ((topf, sha, Just treeitemtype, Nothing), _) -> do @@ -527,7 +527,7 @@ applyView'' mkviewedfile getfilemetadata view madj l clean conv = do _ -> stagesymlink uh f k stagesymlink uh f k = do - linktarget <- calcRepo (gitAnnexLink f k) + linktarget <- fromOsPath <$> calcRepo (gitAnnexLink f k) sha <- hashSymlink linktarget liftIO . Git.UpdateIndex.streamUpdateIndex' uh =<< inRepo (Git.UpdateIndex.stageSymlink f sha) @@ -609,7 +609,7 @@ withViewChanges addmeta removemeta = do =<< catKey (DiffTree.dstsha item) | otherwise = noop handlechange item a = maybe noop - (void . commandAction . a (fromRawFilePath $ getTopFilePath $ DiffTree.file item)) + (void . commandAction . a (getTopFilePath $ DiffTree.file item)) {- Runs an action using the view index file. - Note that the file does not necessarily exist, or can contain @@ -619,7 +619,8 @@ withViewIndex = withIndexFile ViewIndexFile . const withNewViewIndex :: Annex a -> Annex a withNewViewIndex a = do - liftIO . removeWhenExistsWith R.removeLink =<< fromRepo gitAnnexViewIndex + liftIO . removeWhenExistsWith removeFile + =<< fromRepo gitAnnexViewIndex withViewIndex a {- Generates a branch for a view, using the view index file diff --git a/Annex/View/ViewedFile.hs b/Annex/View/ViewedFile.hs index 897e40929e..4ac872fb46 100644 --- a/Annex/View/ViewedFile.hs +++ b/Annex/View/ViewedFile.hs @@ -25,8 +25,7 @@ import qualified Utility.OsString as OS import qualified Data.ByteString as S -type FileName = String -type ViewedFile = FileName +type ViewedFile = OsPath type MkViewedFile = OsPath -> ViewedFile @@ -45,7 +44,7 @@ viewedFileFromReference g = viewedFileFromReference' (annexMaxExtensions g) viewedFileFromReference' :: Maybe Int -> Maybe Int -> MkViewedFile -viewedFileFromReference' maxextlen maxextensions f = concat $ +viewedFileFromReference' maxextlen maxextensions f = toOsPath $ concat $ [ escape (fromOsPath base') , if null dirs then "" @@ -90,12 +89,12 @@ escchar = '!' {- For use when operating already within a view, so whatever filepath - is present in the work tree is already a ViewedFile. -} viewedFileReuse :: MkViewedFile -viewedFileReuse = fromOsPath . takeFileName +viewedFileReuse = takeFileName {- Extracts from a ViewedFile the directory where the file is located on - in the reference branch. -} -dirFromViewedFile :: ViewedFile -> FilePath -dirFromViewedFile = fromOsPath . joinPath . map toOsPath . drop 1 . sep [] "" +dirFromViewedFile :: ViewedFile -> OsPath +dirFromViewedFile = joinPath . map toOsPath . drop 1 . sep [] "" . fromOsPath where sep l _ [] = reverse l sep l curr (c:cs) @@ -110,7 +109,7 @@ prop_viewedFile_roundtrips tf -- Relative filenames wanted, not directories. | OS.any isPathSeparator (toOsPath (end f ++ beginning f)) = True | isAbsolute (toOsPath f) || isDrive (toOsPath f) = True - | otherwise = fromOsPath dir == dirFromViewedFile + | otherwise = dir == dirFromViewedFile (viewedFileFromReference' Nothing Nothing (toOsPath f)) where f = fromTestableFilePath tf diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs index a08810ba54..01bcbb4990 100644 --- a/Assistant/Types/Changes.hs +++ b/Assistant/Types/Changes.hs @@ -9,10 +9,10 @@ module Assistant.Types.Changes where +import Common import Types.KeySource import Types.Key import Utility.TList -import Utility.FileSystemEncoding import Annex.Ingest import Control.Concurrent.STM @@ -58,7 +58,7 @@ changeInfoKey _ = Nothing changeFile :: Change -> FilePath changeFile (Change _ f _) = f changeFile (PendingAddChange _ f) = f -changeFile (InProcessAddChange _ ld) = fromRawFilePath $ keyFilename $ keySource ld +changeFile (InProcessAddChange _ ld) = fromOsPath $ keyFilename $ keySource ld isPendingAddChange :: Change -> Bool isPendingAddChange (PendingAddChange {}) = True diff --git a/CmdLine/Batch.hs b/CmdLine/Batch.hs index 2a7924ab2b..3f69022d34 100644 --- a/CmdLine/Batch.hs +++ b/CmdLine/Batch.hs @@ -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) diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs index a25c6b083b..c012811ac3 100644 --- a/CmdLine/Seek.hs +++ b/CmdLine/Seek.hs @@ -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 diff --git a/Limit.hs b/Limit.hs index 2c7ce3c22e..4bdd7f6e1b 100644 --- a/Limit.hs +++ b/Limit.hs @@ -48,7 +48,6 @@ import Control.Monad.Writer import Data.Time.Clock.POSIX import qualified Data.Set as S import qualified Data.Map as M -import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (accessTime, isSymbolicLink) {- Some limits can look at the current status of files on @@ -140,11 +139,12 @@ matchGlobFile :: String -> MatchInfo -> Annex Bool matchGlobFile glob = go where cglob = compileGlob glob CaseSensitive (GlobFilePath True) -- memoized - go (MatchingFile fi) = pure $ matchGlob cglob (fromRawFilePath (matchFile fi)) + go (MatchingFile fi) = pure $ matchGlob cglob (fromOsPath (matchFile fi)) go (MatchingInfo p) = pure $ case providedFilePath p of - Just f -> matchGlob cglob (fromRawFilePath f) + Just f -> matchGlob cglob (fromOsPath f) Nothing -> False - go (MatchingUserInfo p) = matchGlob cglob <$> getUserInfo (userProvidedFilePath p) + go (MatchingUserInfo p) = matchGlob cglob . fromOsPath + <$> getUserInfo (userProvidedFilePath p) {- Add a limit to skip files when there is no other file using the same - content, with a name matching the glob. -} @@ -188,23 +188,22 @@ matchSameContentGlob glob mi = checkKey (go mi) mi Just f -> check k f Nothing -> return False go (MatchingUserInfo p) k = - check k . toRawFilePath - =<< getUserInfo (userProvidedFilePath p) + check k =<< getUserInfo (userProvidedFilePath p) cglob = compileGlob glob CaseSensitive (GlobFilePath True) -- memoized - matchesglob f = matchGlob cglob (fromRawFilePath f) + matchesglob f = matchGlob cglob (fromOsPath f) #ifdef mingw32_HOST_OS - || matchGlob cglob (fromRawFilePath (toInternalGitPath f)) + || matchGlob cglob (fromOsPath (toInternalGitPath f)) #endif check k skipf = do -- Find other files with the same content, with filenames -- matching the glob. g <- Annex.gitRepo - fs <- filter (/= P.normalise skipf) + fs <- filter (/= normalise skipf) . filter matchesglob - . map (\f -> P.normalise (fromTopFilePath f g)) + . map (\f -> normalise (fromTopFilePath f g)) <$> Database.Keys.getAssociatedFiles k -- Some associated files in the keys database may no longer -- correspond to files in the repository. This is checked @@ -219,7 +218,7 @@ addMimeEncoding = addMagicLimit "mimeencoding" getMagicMimeEncoding providedMime addMagicLimit :: String - -> (Magic -> FilePath -> Annex (Maybe String)) + -> (Magic -> OsPath -> Annex (Maybe String)) -> (ProvidedInfo -> Maybe String) -> (UserProvidedInfo -> UserInfo String) -> String @@ -228,20 +227,19 @@ addMagicLimit limitname querymagic selectprovidedinfo selectuserprovidedinfo glo magic <- liftIO initMagicMime addLimit $ matchMagic limitname querymagic' selectprovidedinfo selectuserprovidedinfo magic glob where - querymagic' magic f = liftIO (isPointerFile (toRawFilePath f)) >>= \case + querymagic' magic f = liftIO (isPointerFile f) >>= \case -- Avoid getting magic of a pointer file, which would -- wrongly be detected as text. Just _ -> return Nothing -- When the file is an annex symlink, get magic of the -- object file. - Nothing -> isAnnexLink (toRawFilePath f) >>= \case - Just k -> withObjectLoc k $ - querymagic magic . fromRawFilePath + Nothing -> isAnnexLink f >>= \case + Just k -> withObjectLoc k (querymagic magic) Nothing -> querymagic magic f matchMagic :: String - -> (Magic -> FilePath -> Annex (Maybe String)) + -> (Magic -> OsPath -> Annex (Maybe String)) -> (ProvidedInfo -> Maybe String) -> (UserProvidedInfo -> UserInfo String) -> Maybe Magic @@ -261,7 +259,7 @@ matchMagic limitname querymagic selectprovidedinfo selectuserprovidedinfo (Just cglob = compileGlob glob CaseSensitive (GlobFilePath False) -- memoized go (MatchingFile fi) = catchBoolIO $ maybe False (matchGlob cglob) - <$> querymagic magic (fromRawFilePath (contentFile fi)) + <$> querymagic magic (contentFile fi) go (MatchingInfo p) = maybe (usecontent (providedKey p)) (pure . matchGlob cglob) @@ -269,8 +267,7 @@ matchMagic limitname querymagic selectprovidedinfo selectuserprovidedinfo (Just go (MatchingUserInfo p) = matchGlob cglob <$> getUserInfo (selectuserprovidedinfo p) usecontent (Just k) = withObjectLoc k $ \obj -> catchBoolIO $ - maybe False (matchGlob cglob) - <$> querymagic magic (fromRawFilePath obj) + maybe False (matchGlob cglob) <$> querymagic magic obj usecontent Nothing = pure False matchMagic limitname _ _ _ Nothing _ = Left $ "unable to load magic database; \""++limitname++"\" cannot be used" @@ -305,7 +302,7 @@ matchLockStatus wantlocked (MatchingFile fi) = liftIO $ do islocked <- isPointerFile f >>= \case Just _key -> return False Nothing -> isSymbolicLink - <$> R.getSymbolicLinkStatus f + <$> R.getSymbolicLinkStatus (fromOsPath f) return (islocked == wantlocked) matchLockStatus wantlocked (MatchingInfo p) = pure $ case providedLinkType p of @@ -388,7 +385,7 @@ limitPresent u = MatchFiles } {- Limit to content that is in a directory, anywhere in the repository tree -} -limitInDir :: FilePath -> String -> MatchFiles Annex +limitInDir :: OsPath -> String -> MatchFiles Annex limitInDir dir desc = MatchFiles { matchAction = const $ const go , matchNeedsFileName = True @@ -400,8 +397,8 @@ limitInDir dir desc = MatchFiles , matchDesc = matchDescSimple desc } where - go (MatchingFile fi) = checkf $ fromRawFilePath $ matchFile fi - go (MatchingInfo p) = maybe (pure False) (checkf . fromRawFilePath) (providedFilePath p) + go (MatchingFile fi) = checkf $ matchFile fi + go (MatchingInfo p) = maybe (pure False) checkf (providedFilePath p) go (MatchingUserInfo p) = checkf =<< getUserInfo (userProvidedFilePath p) checkf = return . elem dir . splitPath . takeDirectory @@ -867,7 +864,7 @@ addAccessedWithin duration = do where check now k = inAnnexCheck k $ \f -> liftIO $ catchDefaultIO False $ do - s <- R.getSymbolicLinkStatus f + s <- R.getSymbolicLinkStatus (fromOsPath f) let accessed = realToFrac (accessTime s) let delta = now - accessed return $ delta <= secs diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs index 18225a3981..24e53c1650 100644 --- a/Types/FileMatcher.hs +++ b/Types/FileMatcher.hs @@ -61,7 +61,7 @@ keyMatchInfoWithoutContent key file = MatchingInfo $ ProvidedInfo -- This is used when testing a matcher, with values to match against -- provided by the user. data UserProvidedInfo = UserProvidedInfo - { userProvidedFilePath :: UserInfo FilePath + { userProvidedFilePath :: UserInfo OsPath , userProvidedKey :: UserInfo Key , userProvidedFileSize :: UserInfo FileSize , userProvidedMimeType :: UserInfo MimeType