From aa0f3f31da4d68d44cbc501af947eb2960d56bfb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 24 Jan 2025 14:49:10 -0400 Subject: [PATCH] more OsPath conversion Sponsored-by: Eve --- Assistant/Install/Menu.hs | 5 --- Config/Files.hs | 1 - Git/CatFile.hs | 4 +-- Git/Config.hs | 7 ++--- Git/Construct.hs | 39 +++++++++++------------ Git/CurrentRepo.hs | 14 ++++----- Git/DiffTree.hs | 6 ++-- Git/Hook.hs | 20 ++++++------ Git/Index.hs | 20 ++++++------ Git/LsTree.hs | 7 +++-- Git/Objects.hs | 27 ++++++++-------- Git/Quote.hs | 6 ++-- Git/Ref.hs | 18 +++++------ Git/Repair.hs | 62 +++++++++++++++++-------------------- Git/Status.hs | 12 +++---- Git/Tree.hs | 8 ++--- Git/UpdateIndex.hs | 14 ++++----- Utility/Directory.hs | 1 - Utility/Directory/Stream.hs | 3 +- Utility/FreeDesktop.hs | 6 ---- Utility/OsPath.hs | 35 +++++++++++++++------ Utility/Path/Windows.hs | 4 +-- Utility/StatelessOpenPGP.hs | 2 +- 23 files changed, 155 insertions(+), 166 deletions(-) diff --git a/Assistant/Install/Menu.hs b/Assistant/Install/Menu.hs index c7b4b00a8d..7308608bb4 100644 --- a/Assistant/Install/Menu.hs +++ b/Assistant/Install/Menu.hs @@ -12,11 +12,6 @@ module Assistant.Install.Menu where import Common import Utility.FreeDesktop -import Utility.FileSystemEncoding -import Utility.Path - -import System.IO -import Utility.SystemDirectory installMenu :: String -> OsPath -> OsPath -> OsPath -> IO () #ifdef darwin_HOST_OS diff --git a/Config/Files.hs b/Config/Files.hs index 84abdc866d..fb0670bf39 100644 --- a/Config/Files.hs +++ b/Config/Files.hs @@ -11,7 +11,6 @@ module Config.Files where import Common import Utility.FreeDesktop -import Utility.Exception {- ~/.config/git-annex/file -} userConfigFile :: OsPath -> IO OsPath diff --git a/Git/CatFile.hs b/Git/CatFile.hs index 89df87404d..877186a1ae 100644 --- a/Git/CatFile.hs +++ b/Git/CatFile.hs @@ -99,11 +99,11 @@ catFileMetaDataStop :: CatFileMetaDataHandle -> IO () catFileMetaDataStop = CoProcess.stop . checkFileProcess {- Reads a file from a specified branch. -} -catFile :: CatFileHandle -> Branch -> RawFilePath -> IO L.ByteString +catFile :: CatFileHandle -> Branch -> OsPath -> IO L.ByteString catFile h branch file = catObject h $ Git.Ref.branchFileRef branch file -catFileDetails :: CatFileHandle -> Branch -> RawFilePath -> IO (Maybe (L.ByteString, Sha, ObjectType)) +catFileDetails :: CatFileHandle -> Branch -> OsPath -> IO (Maybe (L.ByteString, Sha, ObjectType)) catFileDetails h branch file = catObjectDetails h $ Git.Ref.branchFileRef branch file diff --git a/Git/Config.hs b/Git/Config.hs index c99a84ee21..4e72b73be6 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -14,7 +14,6 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.List.NonEmpty as NE import Data.Char -import qualified System.FilePath.ByteString as P import Control.Concurrent.Async import Common @@ -76,7 +75,7 @@ read' repo = go repo params = addparams ++ explicitrepoparams ++ ["config", "--null", "--list"] p = (proc "git" params) - { cwd = Just (fromRawFilePath d) + { cwd = Just (fromOsPath d) , env = gitEnv repo , std_out = CreatePipe } @@ -184,7 +183,7 @@ updateLocation' r l@(Local {}) = do Just (ConfigValue d) -> do {- core.worktree is relative to the gitdir -} top <- absPath (gitdir l) - let p = absPathFrom top d + let p = absPathFrom top (toOsPath d) return $ l { worktree = Just p } Just NoConfigValue -> return l return $ r { location = l' } @@ -337,7 +336,7 @@ checkRepoConfigInaccessible r -- Cannot use gitCommandLine here because specifying --git-dir -- will bypass the git security check. let p = (proc "git" ["config", "--local", "--list"]) - { cwd = Just (fromRawFilePath (repoPath r)) + { cwd = Just (fromOsPath (repoPath r)) , env = gitEnv r } (out, ok) <- processTranscript' p Nothing diff --git a/Git/Construct.hs b/Git/Construct.hs index 90aed92bde..229af82aff 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -41,14 +41,12 @@ import qualified Git.Url as Url import Utility.UserInfo import Utility.Url.Parse import qualified Utility.RawFilePath as R - -import qualified Data.ByteString as B -import qualified System.FilePath.ByteString as P +import qualified Utility.OsString as OS {- Finds the git repository used for the cwd, which may be in a parent - directory. -} fromCwd :: IO (Maybe Repo) -fromCwd = R.getCurrentDirectory >>= seekUp +fromCwd = R.getCurrentDirectory >>= seekUp . toOsPath where seekUp dir = do r <- checkForRepo dir @@ -59,31 +57,32 @@ fromCwd = R.getCurrentDirectory >>= seekUp Just loc -> pure $ Just $ newFrom loc {- Local Repo constructor, accepts a relative or absolute path. -} -fromPath :: RawFilePath -> IO Repo +fromPath :: OsPath -> IO Repo fromPath dir -- When dir == "foo/.git", git looks for "foo/.git/.git", -- and failing that, uses "foo" as the repository. - | (P.pathSeparator `B.cons` ".git") `B.isSuffixOf` canondir = - ifM (doesDirectoryExist $ fromOsPath dir ".git") + | (pathSeparator `OS.cons` dotgit) `OS.isSuffixOf` canondir = + ifM (doesDirectoryExist $ dir dotgit) ( ret dir - , ret (P.takeDirectory canondir) + , ret (takeDirectory canondir) ) - | otherwise = ifM (doesDirectoryExist (fromOsPath dir)) + | otherwise = ifM (doesDirectoryExist dir) ( checkGitDirFile dir >>= maybe (ret dir) (pure . newFrom) -- git falls back to dir.git when dir doesn't -- exist, as long as dir didn't end with a -- path separator , if dir == canondir - then ret (dir <> ".git") + then ret (dir <> dotgit) else ret dir ) where + dotgit = literalOsPath ".git" ret = pure . newFrom . LocalUnknown - canondir = P.dropTrailingPathSeparator dir + canondir = dropTrailingPathSeparator dir {- Local Repo constructor, requires an absolute path to the repo be - specified. -} -fromAbsPath :: RawFilePath -> IO Repo +fromAbsPath :: OsPath -> IO Repo fromAbsPath dir | absoluteGitPath dir = fromPath dir | otherwise = @@ -107,7 +106,7 @@ fromUrl url fromUrl' :: String -> IO Repo fromUrl' url | "file://" `isPrefixOf` url = case parseURIPortable url of - Just u -> fromAbsPath $ toRawFilePath $ unEscapeString $ uriPath u + Just u -> fromAbsPath $ toOsPath $ unEscapeString $ uriPath u Nothing -> pure $ newFrom $ UnparseableUrl url | otherwise = case parseURIPortable url of Just u -> pure $ newFrom $ Url u @@ -129,7 +128,7 @@ localToUrl reference r [ s , "//" , auth - , fromRawFilePath (repoPath r) + , fromOsPath (repoPath r) ] in r { location = Url $ fromJust $ parseURIPortable absurl } _ -> r @@ -176,7 +175,7 @@ fromRemoteLocation s knownurl repo = gen $ parseRemoteLocation s knownurl repo fromRemotePath :: FilePath -> Repo -> IO Repo fromRemotePath dir repo = do dir' <- expandTilde dir - fromPath $ repoPath repo P. dir' + fromPath $ repoPath repo dir' {- Git remotes can have a directory that is specified relative - to the user's home directory, or that contains tilde expansions. @@ -263,15 +262,13 @@ adjustGitDirFile loc = fromMaybe loc <$> adjustGitDirFile' loc adjustGitDirFile' :: RepoLocation -> IO (Maybe RepoLocation) adjustGitDirFile' loc@(Local {}) = do let gd = gitdir loc - c <- firstLine <$> catchDefaultIO "" (readFile (fromRawFilePath gd)) + c <- firstLine <$> catchDefaultIO "" (readFile (fromOsPath gd)) if gitdirprefix `isPrefixOf` c then do - top <- fromRawFilePath . P.takeDirectory <$> absPath gd + top <- takeDirectory <$> absPath gd return $ Just $ loc - { gitdir = absPathFrom - (toRawFilePath top) - (toRawFilePath - (drop (length gitdirprefix) c)) + { gitdir = absPathFrom top $ + toOsPath $ drop (length gitdirprefix) c } else return Nothing where diff --git a/Git/CurrentRepo.hs b/Git/CurrentRepo.hs index 40adad0d53..41c3d6f996 100644 --- a/Git/CurrentRepo.hs +++ b/Git/CurrentRepo.hs @@ -16,10 +16,8 @@ import Git.Construct import qualified Git.Config import Utility.Env import Utility.Env.Set -import qualified Utility.RawFilePath as R import qualified Data.ByteString as B -import qualified System.FilePath.ByteString as P {- Gets the current git repository. - @@ -42,14 +40,14 @@ import qualified System.FilePath.ByteString as P get :: IO Repo get = do gd <- getpathenv "GIT_DIR" - r <- configure gd =<< fromCwd + r <- configure (fmap toOsPath gd) =<< fromCwd prefix <- getpathenv "GIT_PREFIX" wt <- maybe (worktree (location r)) Just <$> getpathenvprefix "GIT_WORK_TREE" prefix case wt of Nothing -> relPath r Just d -> do - curr <- R.getCurrentDirectory + curr <- getCurrentDirectory unless (d `dirContains` curr) $ setCurrentDirectory d relPath $ addworktree wt r @@ -66,15 +64,15 @@ get = do getpathenv s >>= \case Nothing -> return Nothing Just d - | d == "." -> return (Just d) + | d == "." -> return (Just (toOsPath d)) | otherwise -> Just - <$> absPath (prefix P. d) - getpathenvprefix s _ = getpathenv s + <$> absPath (toOsPath prefix toOsPath d) + getpathenvprefix s _ = fmap toOsPath <$> getpathenv s configure Nothing (Just r) = Git.Config.read r configure (Just d) _ = do absd <- absPath d - curr <- R.getCurrentDirectory + curr <- getCurrentDirectory loc <- adjustGitDirFile $ Local { gitdir = absd , worktree = Just curr diff --git a/Git/DiffTree.hs b/Git/DiffTree.hs index 102658922b..ed6c7f8768 100644 --- a/Git/DiffTree.hs +++ b/Git/DiffTree.hs @@ -18,7 +18,6 @@ module Git.DiffTree ( parseDiffRaw, ) where -import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.Attoparsec.ByteString.Lazy as A import qualified Data.Attoparsec.ByteString.Char8 as A8 @@ -31,6 +30,7 @@ import Git.FilePath import Git.DiffTreeItem import qualified Git.Quote import qualified Git.Ref +import qualified Utility.OsString as OS import Utility.Attoparsec {- Checks if the DiffTreeItem modifies a file with a given name @@ -38,7 +38,7 @@ import Utility.Attoparsec isDiffOf :: DiffTreeItem -> TopFilePath -> Bool isDiffOf diff f = let f' = getTopFilePath f - in if B.null f' + in if OS.null f' then True -- top of repo contains all else f' `dirContains` getTopFilePath (file diff) @@ -133,6 +133,6 @@ parserDiffRaw f = DiffTreeItem <*> (maybe (fail "bad dstsha") return . extractSha =<< nextword) <* A8.char ' ' <*> A.takeByteString - <*> pure (asTopFilePath $ fromInternalGitPath $ Git.Quote.unquote f) + <*> pure (asTopFilePath $ fromInternalGitPath $ toOsPath $ Git.Quote.unquote f) where nextword = A8.takeTill (== ' ') diff --git a/Git/Hook.hs b/Git/Hook.hs index bf400cc26f..ce0782dd23 100644 --- a/Git/Hook.hs +++ b/Git/Hook.hs @@ -21,10 +21,8 @@ import qualified Utility.RawFilePath as R import System.PosixCompat.Files (fileMode) #endif -import qualified System.FilePath.ByteString as P - data Hook = Hook - { hookName :: RawFilePath + { hookName :: OsPath , hookScript :: String , hookOldScripts :: [String] } @@ -33,8 +31,8 @@ data Hook = Hook instance Eq Hook where a == b = hookName a == hookName b -hookFile :: Hook -> Repo -> RawFilePath -hookFile h r = localGitDir r P. "hooks" P. hookName h +hookFile :: Hook -> Repo -> OsPath +hookFile h r = localGitDir r literalOsPath "hooks" hookName h {- Writes a hook. Returns False if the hook already exists with a different - content. Upgrades old scripts. @@ -65,8 +63,8 @@ hookWrite h r = ifM (doesFileExist f) -- Hook scripts on Windows could use CRLF endings, but -- they typically use unix newlines, which does work there -- and makes the repository more portable. - viaTmp F.writeFile' (toOsPath f) (encodeBS (hookScript h)) - void $ tryIO $ modifyFileMode f (addModes executeModes) + viaTmp F.writeFile' f (encodeBS (hookScript h)) + void $ tryIO $ modifyFileMode (fromOsPath f) (addModes executeModes) return True {- Removes a hook. Returns False if the hook contained something else, and @@ -91,7 +89,7 @@ expectedContent h r = do -- and so a hook file that has CRLF will be treated the same as one -- that has LF. That is intentional, since users may have a reason -- to prefer one or the other. - content <- readFile $ fromRawFilePath $ hookFile h r + content <- readFile $ fromOsPath $ hookFile h r return $ if content == hookScript h then ExpectedContent else if any (content ==) (hookOldScripts h) @@ -103,13 +101,13 @@ hookExists h r = do let f = hookFile h r catchBoolIO $ #ifndef mingw32_HOST_OS - isExecutable . fileMode <$> R.getFileStatus f + isExecutable . fileMode <$> R.getFileStatus (fromOsPath f) #else - doesFileExist (fromRawFilePath f) + doesFileExist f #endif runHook :: (FilePath -> [CommandParam] -> IO a) -> Hook -> [CommandParam] -> Repo -> IO a runHook runner h ps r = do - let f = fromRawFilePath $ hookFile h r + let f = fromOsPath $ hookFile h r (c, cps) <- findShellCommand f runner c (cps ++ ps) diff --git a/Git/Index.hs b/Git/Index.hs index b55fc04b99..45bb238613 100644 --- a/Git/Index.hs +++ b/Git/Index.hs @@ -14,8 +14,6 @@ import Git import Utility.Env import Utility.Env.Set -import qualified System.FilePath.ByteString as P - indexEnv :: String indexEnv = "GIT_INDEX_FILE" @@ -30,8 +28,8 @@ indexEnv = "GIT_INDEX_FILE" - - So, an absolute path is the only safe option for this to return. -} -indexEnvVal :: RawFilePath -> IO String -indexEnvVal p = fromRawFilePath <$> absPath p +indexEnvVal :: OsPath -> IO String +indexEnvVal p = fromOsPath <$> absPath p {- Forces git to use the specified index file. - @@ -40,7 +38,7 @@ indexEnvVal p = fromRawFilePath <$> absPath p - - Warning: Not thread safe. -} -override :: RawFilePath -> Repo -> IO (IO ()) +override :: OsPath -> Repo -> IO (IO ()) override index _r = do res <- getEnv var val <- indexEnvVal index @@ -52,13 +50,13 @@ override index _r = do reset _ = unsetEnv var {- The normal index file. Does not check GIT_INDEX_FILE. -} -indexFile :: Repo -> RawFilePath -indexFile r = localGitDir r P. "index" +indexFile :: Repo -> OsPath +indexFile r = localGitDir r literalOsPath "index" {- The index file git will currently use, checking GIT_INDEX_FILE. -} -currentIndexFile :: Repo -> IO RawFilePath -currentIndexFile r = maybe (indexFile r) toRawFilePath <$> getEnv indexEnv +currentIndexFile :: Repo -> IO OsPath +currentIndexFile r = maybe (indexFile r) toOsPath <$> getEnv indexEnv {- Git locks the index by creating this file. -} -indexFileLock :: RawFilePath -> RawFilePath -indexFileLock f = f <> ".lock" +indexFileLock :: OsPath -> OsPath +indexFileLock f = f <> literalOsPath ".lock" diff --git a/Git/LsTree.hs b/Git/LsTree.hs index 9129d18fc4..5399416707 100644 --- a/Git/LsTree.hs +++ b/Git/LsTree.hs @@ -137,7 +137,8 @@ parserLsTree long = case long of -- sha <*> (Ref <$> A8.takeTill A8.isSpace) - fileparser = asTopFilePath . Git.Quote.unquote <$> A.takeByteString + fileparser = asTopFilePath . toOsPath . Git.Quote.unquote + <$> A.takeByteString sizeparser = fmap Just A8.decimal @@ -152,4 +153,6 @@ formatLsTree ti = S.intercalate (S.singleton (fromIntegral (ord ' '))) [ encodeBS (showOct (mode ti) "") , typeobj ti , fromRef' (sha ti) - ] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti))) + ] + <> (S.cons (fromIntegral (ord '\t')) + (fromOsPath (getTopFilePath (file ti)))) diff --git a/Git/Objects.hs b/Git/Objects.hs index 6c4a87b909..4d2a2e907b 100644 --- a/Git/Objects.hs +++ b/Git/Objects.hs @@ -15,25 +15,23 @@ import Git.Sha import qualified Utility.OsString as OS import qualified Data.ByteString as B -import qualified System.FilePath.ByteString as P +objectsDir :: Repo -> OsPath +objectsDir r = localGitDir r literalOsPath "objects" -objectsDir :: Repo -> RawFilePath -objectsDir r = localGitDir r P. "objects" +packDir :: Repo -> OsPath +packDir r = objectsDir r literalOsPath "pack" -packDir :: Repo -> RawFilePath -packDir r = objectsDir r P. "pack" +packIdxFile :: OsPath -> OsPath +packIdxFile = flip replaceExtension (literalOsPath "idx") -packIdxFile :: RawFilePath -> RawFilePath -packIdxFile = flip P.replaceExtension "idx" - -listPackFiles :: Repo -> IO [RawFilePath] -listPackFiles r = filter (".pack" `B.isSuffixOf`) +listPackFiles :: Repo -> IO [OsPath] +listPackFiles r = filter (literalOsPath ".pack" `OS.isSuffixOf`) <$> catchDefaultIO [] (dirContents $ packDir r) listLooseObjectShas :: Repo -> IO [Sha] listLooseObjectShas r = catchDefaultIO [] $ mapMaybe conv <$> emptyWhenDoesNotExist - (dirContentsRecursiveSkipping (== "pack") True (objectsDir r)) + (dirContentsRecursiveSkipping ispackdir True (objectsDir r)) where conv :: OsPath -> Maybe Sha conv = extractSha @@ -43,17 +41,18 @@ listLooseObjectShas r = catchDefaultIO [] $ . take 2 . reverse . splitDirectories + ispackdir f = f == literalOsPath "pack" looseObjectFile :: Repo -> Sha -> OsPath -looseObjectFile r sha = objectsDir r P. prefix P. rest +looseObjectFile r sha = objectsDir r toOsPath prefix toOsPath rest where (prefix, rest) = B.splitAt 2 (fromRef' sha) listAlternates :: Repo -> IO [FilePath] listAlternates r = catchDefaultIO [] $ - lines <$> readFile (fromRawFilePath alternatesfile) + lines <$> readFile (fromOsPath alternatesfile) where - alternatesfile = objectsDir r P. "info" P. "alternates" + alternatesfile = objectsDir r literalOsPath "info" literalOsPath "alternates" {- A repository recently cloned with --shared will have one or more - alternates listed, and contain no loose objects or packs. -} diff --git a/Git/Quote.hs b/Git/Quote.hs index a8d67ab4d5..ea9d7e55a3 100644 --- a/Git/Quote.hs +++ b/Git/Quote.hs @@ -90,12 +90,12 @@ quotedPaths (p:ps) = QuotedPath p <> if null ps instance Quoteable StringContainingQuotedPath where quote _ (UnquotedString s) = safeOutput (encodeBS s) quote _ (UnquotedByteString s) = safeOutput s - quote qp (QuotedPath p) = quote qp p + quote qp (QuotedPath p) = quote qp (fromOsPath p :: RawFilePath) quote qp (a :+: b) = quote qp a <> quote qp b noquote (UnquotedString s) = encodeBS s noquote (UnquotedByteString s) = s - noquote (QuotedPath p) = p + noquote (QuotedPath p) = fromOsPath p noquote (a :+: b) = noquote a <> noquote b instance IsString StringContainingQuotedPath where @@ -117,6 +117,6 @@ instance Monoid StringContainingQuotedPath where -- limits what's tested to ascii, so avoids running into it. prop_quote_unquote_roundtrip :: TestableFilePath -> Bool prop_quote_unquote_roundtrip ts = - s == fromOsPath (unquote (quoteAlways (toOsPath s))) + s == fromRawFilePath (unquote (quoteAlways (toRawFilePath s))) where s = fromTestableFilePath ts diff --git a/Git/Ref.hs b/Git/Ref.hs index 8c2a846d3d..6721b34051 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -20,17 +20,16 @@ import qualified Utility.FileIO as F import Data.Char (chr, ord) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 -import qualified System.FilePath.ByteString as P headRef :: Ref headRef = Ref "HEAD" -headFile :: Repo -> RawFilePath -headFile r = localGitDir r P. "HEAD" +headFile :: Repo -> OsPath +headFile r = localGitDir r literalOsPath "HEAD" setHeadRef :: Ref -> Repo -> IO () setHeadRef ref r = - F.writeFile' (toOsPath (headFile r)) ("ref: " <> fromRef' ref) + F.writeFile' (headFile r) ("ref: " <> fromRef' ref) {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String @@ -70,7 +69,7 @@ branchRef = underBase "refs/heads" - - If the input file is located outside the repository, returns Nothing. -} -fileRef :: RawFilePath -> Repo -> IO (Maybe Ref) +fileRef :: OsPath -> Repo -> IO (Maybe Ref) fileRef f repo = do -- The filename could be absolute, or contain eg "../repo/file", -- neither of which work in a ref, so convert it to a minimal @@ -80,12 +79,13 @@ fileRef f repo = do -- Prefixing the file with ./ makes this work even when in a -- subdirectory of a repo. Eg, ./foo in directory bar refers -- to bar/foo, not to foo in the top of the repository. - then Just $ Ref $ ":./" <> toInternalGitPath f' + then Just $ Ref $ ":./" <> fromOsPath (toInternalGitPath f') else Nothing {- A Ref that can be used to refer to a file in a particular branch. -} -branchFileRef :: Branch -> RawFilePath -> Ref -branchFileRef branch f = Ref $ fromRef' branch <> ":" <> toInternalGitPath f +branchFileRef :: Branch -> OsPath -> Ref +branchFileRef branch f = Ref $ fromOsPath $ + toOsPath (fromRef' branch) <> literalOsPath ":" <> toInternalGitPath f {- Converts a Ref to refer to the content of the Ref on a given date. -} dateRef :: Ref -> RefDate -> Ref @@ -96,7 +96,7 @@ dateRef r (RefDate d) = Ref $ fromRef' r <> "@" <> encodeBS d - - If the file path is located outside the repository, returns Nothing. -} -fileFromRef :: Ref -> RawFilePath -> Repo -> IO (Maybe Ref) +fileFromRef :: Ref -> OsPath -> Repo -> IO (Maybe Ref) fileFromRef r f repo = fileRef f repo >>= return . \case Just (Ref fr) -> Just (Ref (fromRef' r <> fr)) Nothing -> Nothing diff --git a/Git/Repair.hs b/Git/Repair.hs index ed46161cfe..1eb4e29b7c 100644 --- a/Git/Repair.hs +++ b/Git/Repair.hs @@ -80,8 +80,8 @@ explodePacks :: Repo -> IO Bool explodePacks r = go =<< listPackFiles r where go [] = return False - go packs = withTmpDir (toOsPath "packs") $ \tmpdir -> do - r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" tmpdir + go packs = withTmpDir (literalOsPath "packs") $ \tmpdir -> do + r' <- addGitEnv r "GIT_OBJECT_DIRECTORY" (fromOsPath tmpdir) putStrLn "Unpacking all pack files." forM_ packs $ \packfile -> do -- Just in case permissions are messed up. @@ -90,14 +90,11 @@ explodePacks r = go =<< listPackFiles r void $ tryIO $ pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h -> L.hPut h =<< F.readFile (toOsPath packfile) - objs <- emptyWhenDoesNotExist (dirContentsRecursive (toRawFilePath tmpdir)) + objs <- emptyWhenDoesNotExist (dirContentsRecursive tmpdir) forM_ objs $ \objfile -> do - f <- relPathDirToFile - (toRawFilePath tmpdir) - objfile + f <- relPathDirToFile tmpdir objfile let dest = objectsDir r P. f - createDirectoryIfMissing True - (fromRawFilePath (parentDir dest)) + createDirectoryIfMissing True (parentDir dest) moveFile objfile dest forM_ packs $ \packfile -> do removeWhenExistsWith R.removeLink packfile @@ -114,12 +111,12 @@ explodePacks r = go =<< listPackFiles r retrieveMissingObjects :: FsckResults -> Maybe FilePath -> Repo -> IO FsckResults retrieveMissingObjects missing referencerepo r | not (foundBroken missing) = return missing - | otherwise = withTmpDir (toOsPath "tmprepo") $ \tmpdir -> do - unlessM (boolSystem "git" [Param "init", File tmpdir]) $ - giveup $ "failed to create temp repository in " ++ tmpdir - tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir) - let repoconfig r' = toOsPath (localGitDir r' P. "config") - whenM (doesFileExist (fromRawFilePath (fromOsPath (repoconfig r)))) $ + | otherwise = withTmpDir (literalOsPath "tmprepo") $ \tmpdir -> do + unlessM (boolSystem "git" [Param "init", File (fromOsPath tmpdir)]) $ + giveup $ "failed to create temp repository in " ++ fromOsPath tmpdir + tmpr <- Config.read =<< Construct.fromPath tmpdir + let repoconfig r' = localGitDir r' "config" + whenM (doesFileExist (repoconfig r)) $ F.readFile (repoconfig r) >>= F.writeFile (repoconfig tmpr) rs <- Construct.fromRemotes r stillmissing <- pullremotes tmpr rs fetchrefstags missing @@ -181,8 +178,8 @@ retrieveMissingObjects missing referencerepo r copyObjects :: Repo -> Repo -> IO Bool copyObjects srcr destr = rsync [ Param "-qr" - , File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir srcr - , File $ addTrailingPathSeparator $ fromRawFilePath $ objectsDir destr + , File $ fromOsPath $ addTrailingPathSeparator $ objectsDir srcr + , File $ fromOsPath $ addTrailingPathSeparator $ objectsDir destr ] {- To deal with missing objects that cannot be recovered, resets any @@ -249,38 +246,35 @@ badBranches missing r = filterM isbad =<< getAllRefs r - Relies on packed refs being exploded before it's called. -} getAllRefs :: Repo -> IO [Ref] -getAllRefs r = getAllRefs' (localGitDir r P. "refs") +getAllRefs r = getAllRefs' (localGitDir r literalOsPath "refs") -getAllRefs' :: RawFilePath -> IO [Ref] +getAllRefs' :: OsPath -> IO [Ref] getAllRefs' refdir = do - let topsegs = length (P.splitPath refdir) - 1 - let toref = Ref . toInternalGitPath . encodeBS + let topsegs = length (splitPath refdir) - 1 + let toref = Ref . toInternalGitPath . joinPath . drop topsegs . splitPath - . decodeBS map toref <$> emptyWhenDoesNotExist (dirContentsRecursive refdir) explodePackedRefsFile :: Repo -> IO () explodePackedRefsFile r = do let f = packedRefsFile r - let f' = toRawFilePath f whenM (doesFileExist f) $ do rs <- mapMaybe parsePacked . map decodeBS . fileLines' - <$> catchDefaultIO "" (safeReadFile f') + <$> catchDefaultIO "" (safeReadFile f) forM_ rs makeref - removeWhenExistsWith R.removeLink f' + removeWhenExistsWith R.removeLink (fromOsPath f) where makeref (sha, ref) = do let gitd = localGitDir r - let dest = gitd P. fromRef' ref - let dest' = fromRawFilePath dest + let dest = gitd toOsPath (fromRef' ref) createDirectoryUnder [gitd] (parentDir dest) - unlessM (doesFileExist dest') $ - writeFile dest' (fromRef sha) + unlessM (doesFileExist dest) $ + writeFile (fromOsPath dest) (fromRef sha) -packedRefsFile :: Repo -> FilePath -packedRefsFile r = fromRawFilePath (localGitDir r) "packed-refs" +packedRefsFile :: Repo -> OsPath +packedRefsFile r = localGitDir r "packed-refs" parsePacked :: String -> Maybe (Sha, Ref) parsePacked l = case words l of @@ -411,7 +405,7 @@ checkIndexFast r = do length indexcontents `seq` cleanup missingIndex :: Repo -> IO Bool -missingIndex r = not <$> doesFileExist (fromRawFilePath (localGitDir r) "index") +missingIndex r = not <$> doesFileExist (localGitDir r "index") {- Finds missing and ok files staged in the index. -} partitionIndex :: Repo -> IO ([LsFiles.StagedDetails], [LsFiles.StagedDetails], IO Bool) @@ -655,7 +649,7 @@ runRepair' removablebranch fsckresult forced referencerepo g = do successfulRepair :: (Bool, [Branch]) -> Bool successfulRepair = fst -safeReadFile :: RawFilePath -> IO B.ByteString +safeReadFile :: OsPath -> IO B.ByteString safeReadFile f = do - allowRead f - F.readFile' (toOsPath f) + allowRead (fromOsPath f) + F.readFile' f diff --git a/Git/Status.hs b/Git/Status.hs index 8e50a69fc4..db777a2465 100644 --- a/Git/Status.hs +++ b/Git/Status.hs @@ -57,13 +57,13 @@ parseStatusZ = go [] in go (v : c) xs' _ -> go c xs - cparse 'M' f _ = (Just (Modified (asTopFilePath (toRawFilePath f))), Nothing) - cparse 'A' f _ = (Just (Added (asTopFilePath (toRawFilePath f))), Nothing) - cparse 'D' f _ = (Just (Deleted (asTopFilePath (toRawFilePath f))), Nothing) - cparse 'T' f _ = (Just (TypeChanged (asTopFilePath (toRawFilePath f))), Nothing) - cparse '?' f _ = (Just (Untracked (asTopFilePath (toRawFilePath f))), Nothing) + cparse 'M' f _ = (Just (Modified (asTopFilePath (toOsPath f))), Nothing) + cparse 'A' f _ = (Just (Added (asTopFilePath (toOsPath f))), Nothing) + cparse 'D' f _ = (Just (Deleted (asTopFilePath (toOsPath f))), Nothing) + cparse 'T' f _ = (Just (TypeChanged (asTopFilePath (toOsPath f))), Nothing) + cparse '?' f _ = (Just (Untracked (asTopFilePath (toOsPath f))), Nothing) cparse 'R' f (oldf:xs) = - (Just (Renamed (asTopFilePath (toRawFilePath oldf)) (asTopFilePath (toRawFilePath f))), Just xs) + (Just (Renamed (asTopFilePath (toOsPath oldf)) (asTopFilePath (toOsPath f))), Just xs) cparse _ _ _ = (Nothing, Nothing) getStatus :: [CommandParam] -> [FilePath] -> Repo -> IO ([StagedUnstaged Status], IO Bool) diff --git a/Git/Tree.hs b/Git/Tree.hs index 4c7c129a44..33a4b3cda0 100644 --- a/Git/Tree.hs +++ b/Git/Tree.hs @@ -178,7 +178,7 @@ treeItemsToTree = go M.empty Just (NewSubTree d l) -> go (addsubtree idir m (NewSubTree d (c:l))) is _ -> - go (addsubtree idir m (NewSubTree (asTopFilePath idir) [c])) is + go (addsubtree idir m (NewSubTree (asTopFilePath (toOsPath idir)) [c])) is where p = gitPath i idir = P.takeDirectory p @@ -191,7 +191,7 @@ treeItemsToTree = go M.empty Just (NewSubTree d' l) -> let l' = filter (\ti -> gitPath ti /= d) l in addsubtree parent m' (NewSubTree d' (t:l')) - _ -> addsubtree parent m' (NewSubTree (asTopFilePath parent) [t]) + _ -> addsubtree parent m' (NewSubTree (asTopFilePath (toOsPath parent)) [t]) | otherwise = M.insert d t m where parent = P.takeDirectory d @@ -362,7 +362,7 @@ graftTree' subtree graftloc basetree repo hdl = go basetree subdirs graftdirs subdirs = P.splitDirectories $ gitPath graftloc - graftdirs = map (asTopFilePath . toInternalGitPath) $ + graftdirs = map (asTopFilePath . toInternalGitPath . toOsPath) $ pathPrefixes subdirs {- Assumes the list is ordered, with tree objects coming right before their @@ -401,7 +401,7 @@ instance GitPath FilePath where gitPath = toRawFilePath instance GitPath TopFilePath where - gitPath = getTopFilePath + gitPath = fromOsPath . getTopFilePath instance GitPath TreeItem where gitPath (TreeItem f _ _) = gitPath f diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index f56bc86cbc..c5f1d2f3e1 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -97,15 +97,15 @@ updateIndexLine sha treeitemtype file = L.fromStrict $ <> " blob " <> fromRef' sha <> "\t" - <> indexPath file + <> fromOsPath (indexPath file) -stageFile :: Sha -> TreeItemType -> RawFilePath -> Repo -> IO Streamer +stageFile :: Sha -> TreeItemType -> OsPath -> Repo -> IO Streamer stageFile sha treeitemtype file repo = do p <- toTopFilePath file repo return $ pureStreamer $ updateIndexLine sha treeitemtype p {- A streamer that removes a file from the index. -} -unstageFile :: RawFilePath -> Repo -> IO Streamer +unstageFile :: OsPath -> Repo -> IO Streamer unstageFile file repo = do p <- toTopFilePath file repo return $ unstageFile' p @@ -115,10 +115,10 @@ unstageFile' p = pureStreamer $ L.fromStrict $ "0 " <> fromRef' deleteSha <> "\t" - <> indexPath p + <> fromOsPath (indexPath p) {- A streamer that adds a symlink to the index. -} -stageSymlink :: RawFilePath -> Sha -> Repo -> IO Streamer +stageSymlink :: OsPath -> Sha -> Repo -> IO Streamer stageSymlink file sha repo = do !line <- updateIndexLine <$> pure sha @@ -141,7 +141,7 @@ indexPath = toInternalGitPath . getTopFilePath - update-index. Sending Nothing will wait for update-index to finish - updating the index. -} -refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((Maybe RawFilePath -> IO ()) -> m ()) -> m () +refreshIndex :: (MonadIO m, MonadMask m) => Repo -> ((Maybe OsPath -> IO ()) -> m ()) -> m () refreshIndex repo feeder = bracket (liftIO $ createProcess p) (liftIO . cleanupProcess) @@ -163,7 +163,7 @@ refreshIndex repo feeder = bracket hClose h forceSuccessProcess p pid feeder $ \case - Just f -> S.hPut h (S.snoc f 0) + Just f -> S.hPut h (S.snoc (fromOsPath f) 0) Nothing -> closer liftIO $ closer go _ = error "internal" diff --git a/Utility/Directory.hs b/Utility/Directory.hs index 92ec88b00f..0051dd75fc 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -21,7 +21,6 @@ import Control.Monad import System.PosixCompat.Files (isDirectory, isSymbolicLink) import Control.Applicative import System.IO.Unsafe (unsafeInterleaveIO) -import qualified System.FilePath.ByteString as P import Data.Maybe import Prelude diff --git a/Utility/Directory/Stream.hs b/Utility/Directory/Stream.hs index a74416d2f8..2dd975955c 100644 --- a/Utility/Directory/Stream.hs +++ b/Utility/Directory/Stream.hs @@ -33,6 +33,7 @@ import qualified System.Posix.Directory.ByteString as Posix import Utility.Directory import Utility.Exception import Utility.FileSystemEncoding +import Utility.OsPath #ifndef mingw32_HOST_OS data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream @@ -117,5 +118,5 @@ isDirectoryPopulated d = bracket (openDirectory d) closeDirectory check case v of Nothing -> return False Just f - | not (dirCruft f) -> return True + | not (toOsPath f `elem` dirCruft) -> return True | otherwise -> check h diff --git a/Utility/FreeDesktop.hs b/Utility/FreeDesktop.hs index fb7d712c53..8259544377 100644 --- a/Utility/FreeDesktop.hs +++ b/Utility/FreeDesktop.hs @@ -29,15 +29,9 @@ module Utility.FreeDesktop ( ) where import Common -import Utility.Exception import Utility.UserInfo -import Utility.Process import System.Environment -import Data.List -import Data.Maybe -import Control.Applicative -import Prelude type DesktopEntry = [(Key, Value)] diff --git a/Utility/OsPath.hs b/Utility/OsPath.hs index 99dcdf2180..28e3040841 100644 --- a/Utility/OsPath.hs +++ b/Utility/OsPath.hs @@ -19,19 +19,23 @@ module Utility.OsPath ( fromOsPath, module X, getSearchPath, + unsafeFromChar ) where import Utility.FileSystemEncoding +import Data.ByteString.Short (ShortByteString) +import qualified Data.ByteString.Short as S #ifdef WITH_OSPATH -import System.OsPath as X hiding (OsPath, OsString) +import System.OsPath as X hiding (OsPath, OsString, unsafeFromChar) import System.OsPath import "os-string" System.OsString.Internal.Types -import qualified Data.ByteString.Short as S import qualified System.FilePath.ByteString as PB #else import System.FilePath.ByteString as X hiding (RawFilePath, getSearchPath) import System.FilePath.ByteString (getSearchPath) -import qualified Data.ByteString as S +import Data.ByteString (ByteString) +import Data.Char +import Data.Word #endif class OsPathConv t where @@ -48,24 +52,28 @@ literalOsPath = toOsPath #ifdef WITH_OSPATH instance OsPathConv RawFilePath where + toOsPath = bytesToOsPath . S.toShort + fromOsPath = S.fromShort . bytesFromOsPath + +instance OsPathConv ShortByteString where toOsPath = bytesToOsPath fromOsPath = bytesFromOsPath {- Unlike System.OsString.fromBytes, on Windows this does not ensure a - valid USC-2LE encoding. The input ByteString must be in a valid encoding - already or uses of the OsPath will fail. -} -bytesToOsPath :: RawFilePath -> OsPath +bytesToOsPath :: ShortByteString -> OsPath #if defined(mingw32_HOST_OS) -bytesToOsPath = OsString . WindowsString . S.toShort +bytesToOsPath = OsString . WindowsString #else -bytesToOsPath = OsString . PosixString . S.toShort +bytesToOsPath = OsString . PosixString #endif -bytesFromOsPath :: OsPath -> RawFilePath +bytesFromOsPath :: OsPath -> ShortByteString #if defined(mingw32_HOST_OS) -bytesFromOsPath = S.fromShort . getWindowsString . getOsString +bytesFromOsPath = getWindowsString . getOsString #else -bytesFromOsPath = S.fromShort . getPosixString . getOsString +bytesFromOsPath = getPosixString . getOsString #endif {- For some reason not included in System.OsPath -} @@ -77,9 +85,16 @@ getSearchPath = map toOsPath <$> PB.getSearchPath -} type OsPath = RawFilePath -type OsString = S.ByteString +type OsString = ByteString instance OsPathConv RawFilePath where toOsPath = id fromOsPath = id + +instance OsPathConv ShortByteString where + toOsPath = S.fromShort + fromOsPath = S.toShort + +unsafeFromChar :: Char -> Word8 +unsafeFromChar = fromIntegral . ord #endif diff --git a/Utility/Path/Windows.hs b/Utility/Path/Windows.hs index e61a450d7f..f5342806b2 100644 --- a/Utility/Path/Windows.hs +++ b/Utility/Path/Windows.hs @@ -13,9 +13,9 @@ module Utility.Path.Windows ( ) where import Utility.Path +import Utility.OsPath import Utility.FileSystemEncoding -import System.FilePath.ByteString (combine) import qualified Data.ByteString as B import qualified System.FilePath.Windows.ByteString as P import System.Directory (getCurrentDirectory) @@ -37,7 +37,7 @@ convertToWindowsNativeNamespace f -- Make absolute because any '.' and '..' in the path -- will not be resolved once it's converted. cwd <- toRawFilePath <$> getCurrentDirectory - let p = simplifyPath (combine cwd f) + let p = fromOsPath (simplifyPath (toOsPath (combine cwd f))) -- Normalize slashes. let p' = P.normalise p return (win32_file_namespace <> p') diff --git a/Utility/StatelessOpenPGP.hs b/Utility/StatelessOpenPGP.hs index d3709baa27..874ed84e19 100644 --- a/Utility/StatelessOpenPGP.hs +++ b/Utility/StatelessOpenPGP.hs @@ -163,7 +163,7 @@ feedRead cmd subcmd params password emptydirectory feeder reader = do withTmpFile (toOsPath "sop") $ \tmpfile h -> do liftIO $ B.hPutStr h password liftIO $ hClose h - let passwordfile = [Param $ "--with-password=" ++ fromRawFilePath (fromOsPath tmpfile)] + let passwordfile = [Param $ "--with-password=" ++ fromOsPath tmpfile] -- Don't need to pass emptydirectory since @FD is not used, -- and so tmpfile also does not need to be made absolute. case emptydirectory of