more OsPath conversion
Sponsored-by: Eve
This commit is contained in:
Joey Hess
parent
dd01406018
commit
aa0f3f31da
23 changed files with 155 additions and 166 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -11,7 +11,6 @@ module Config.Files where
|
|||
|
||||
import Common
|
||||
import Utility.FreeDesktop
|
||||
import Utility.Exception
|
||||
|
||||
{- ~/.config/git-annex/file -}
|
||||
userConfigFile :: OsPath -> IO OsPath
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 (== ' ')
|
||||
|
|
|
|||
20
Git/Hook.hs
20
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)
|
||||
|
|
|
|||
20
Git/Index.hs
20
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"
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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. -}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
18
Git/Ref.hs
18
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)]
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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')
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue