more OsPath conversion
About 1/10th done with this I think.
This commit is contained in:
Joey Hess
parent
8021d22955
commit
c412c59ecd
16 changed files with 152 additions and 142 deletions
|
|
@ -11,12 +11,11 @@ import Common
|
|||
import Git
|
||||
import Git.Command
|
||||
import qualified Utility.CoProcess as CoProcess
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
import System.IO.Error
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], RawFilePath)
|
||||
type CheckAttrHandle = (CoProcess.CoProcessHandle, [Attr], OsPath)
|
||||
|
||||
type Attr = String
|
||||
|
||||
|
|
@ -24,7 +23,7 @@ type Attr = String
|
|||
- and returns a handle. -}
|
||||
checkAttrStart :: [Attr] -> Repo -> IO CheckAttrHandle
|
||||
checkAttrStart attrs repo = do
|
||||
currdir <- R.getCurrentDirectory
|
||||
currdir <- getCurrentDirectory
|
||||
h <- gitCoProcessStart True params repo
|
||||
return (h, attrs, currdir)
|
||||
where
|
||||
|
|
@ -38,14 +37,14 @@ checkAttrStart attrs repo = do
|
|||
checkAttrStop :: CheckAttrHandle -> IO ()
|
||||
checkAttrStop (h, _, _) = CoProcess.stop h
|
||||
|
||||
checkAttr :: CheckAttrHandle -> Attr -> RawFilePath -> IO String
|
||||
checkAttr :: CheckAttrHandle -> Attr -> OsPath -> IO String
|
||||
checkAttr h want file = checkAttrs h [want] file >>= return . \case
|
||||
(v:_) -> v
|
||||
[] -> ""
|
||||
|
||||
{- Gets attributes of a file. When an attribute is not specified,
|
||||
- returns "" for it. -}
|
||||
checkAttrs :: CheckAttrHandle -> [Attr] -> RawFilePath -> IO [String]
|
||||
checkAttrs :: CheckAttrHandle -> [Attr] -> OsPath -> IO [String]
|
||||
checkAttrs (h, attrs, currdir) want file = do
|
||||
l <- CoProcess.query h send (receive "")
|
||||
return (getvals l want)
|
||||
|
|
@ -54,9 +53,9 @@ checkAttrs (h, attrs, currdir) want file = do
|
|||
getvals l (x:xs) = case map snd $ filter (\(attr, _) -> attr == x) l of
|
||||
["unspecified"] -> "" : getvals l xs
|
||||
[v] -> v : getvals l xs
|
||||
_ -> giveup $ "unable to determine " ++ x ++ " attribute of " ++ fromRawFilePath file
|
||||
_ -> giveup $ "unable to determine " ++ x ++ " attribute of " ++ fromOsPath file
|
||||
|
||||
send to = B.hPutStr to $ file' `B.snoc` 0
|
||||
send to = B.hPutStr to $ (fromOsPath file') `B.snoc` 0
|
||||
receive c from = do
|
||||
s <- hGetSomeString from 1024
|
||||
if null s
|
||||
|
|
|
|||
|
|
@ -24,10 +24,10 @@ gitCommandLine params r@(Repo { location = l@(Local { } ) }) =
|
|||
where
|
||||
setdir
|
||||
| gitEnvOverridesGitDir r = []
|
||||
| otherwise = [Param $ "--git-dir=" ++ fromRawFilePath (gitdir l)]
|
||||
| otherwise = [Param $ "--git-dir=" ++ fromOsPath (gitdir l)]
|
||||
settree = case worktree l of
|
||||
Nothing -> []
|
||||
Just t -> [Param $ "--work-tree=" ++ fromRawFilePath t]
|
||||
Just t -> [Param $ "--work-tree=" ++ fromOsPath t]
|
||||
gitCommandLine _ repo = assertLocal repo $ error "internal"
|
||||
|
||||
{- Runs git in the specified repo. -}
|
||||
|
|
|
|||
|
|
@ -30,9 +30,9 @@ addGitEnv g var val = adjustGitEnv g (addEntry var val)
|
|||
- and a copy of the rest of the system environment. -}
|
||||
propGitEnv :: Repo -> IO [(String, String)]
|
||||
propGitEnv g = do
|
||||
g' <- addGitEnv g "GIT_DIR" (fromRawFilePath (localGitDir g))
|
||||
g' <- addGitEnv g "GIT_DIR" (fromOsPath (localGitDir g))
|
||||
g'' <- maybe (pure g')
|
||||
(addGitEnv g' "GIT_WORK_TREE" . fromRawFilePath)
|
||||
(addGitEnv g' "GIT_WORK_TREE" . fromOsPath)
|
||||
(repoWorkTree g)
|
||||
return $ fromMaybe [] (gitEnv g'')
|
||||
|
||||
|
|
|
|||
|
|
@ -89,5 +89,5 @@ fromInternalGitPath = toOsPath . encodeBS . replace "/" "\\" . decodeBS . fromOs
|
|||
{- isAbsolute on Windows does not think "/foo" or "\foo" is absolute,
|
||||
- so try posix paths.
|
||||
-}
|
||||
absoluteGitPath :: RawFilePath -> Bool
|
||||
absoluteGitPath :: OsPath -> Bool
|
||||
absoluteGitPath p = isAbsolute p || isAbsolute (toInternalGitPath p)
|
||||
|
|
|
|||
|
|
@ -15,14 +15,14 @@ import Git
|
|||
import Git.Sha
|
||||
import Git.Command
|
||||
import Git.Types
|
||||
import qualified Utility.CoProcess as CoProcess
|
||||
import Utility.Tmp
|
||||
import qualified Utility.CoProcess as CoProcess
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Data.ByteString.Builder
|
||||
import Data.Char
|
||||
|
||||
data HashObjectHandle = HashObjectHandle CoProcess.CoProcessHandle Repo [CommandParam]
|
||||
|
||||
|
|
@ -41,7 +41,7 @@ hashObjectStop :: HashObjectHandle -> IO ()
|
|||
hashObjectStop (HashObjectHandle h _ _) = CoProcess.stop h
|
||||
|
||||
{- Injects a file into git, returning the Sha of the object. -}
|
||||
hashFile :: HashObjectHandle -> RawFilePath -> IO Sha
|
||||
hashFile :: HashObjectHandle -> OsPath -> IO Sha
|
||||
hashFile hdl@(HashObjectHandle h _ _) file = do
|
||||
-- git hash-object chdirs to the top of the repository on
|
||||
-- start, so if the filename is relative, it will
|
||||
|
|
@ -49,24 +49,24 @@ hashFile hdl@(HashObjectHandle h _ _) file = do
|
|||
-- So, make the filename absolute, which will work now
|
||||
-- and also if git's behavior later changes.
|
||||
file' <- absPath file
|
||||
if newline `S.elem` file' || carriagereturn `S.elem` file
|
||||
if newline `OS.elem` file' || carriagereturn `OS.elem` file
|
||||
then hashFile' hdl file
|
||||
else CoProcess.query h (send file') receive
|
||||
else CoProcess.query h (send (fromOsPath file')) receive
|
||||
where
|
||||
send file' to = S8.hPutStrLn to file'
|
||||
receive from = getSha "hash-object" $ S8.hGetLine from
|
||||
newline = fromIntegral (ord '\n')
|
||||
newline = unsafeFromChar '\n'
|
||||
-- git strips carriage return from the end of a line, out of some
|
||||
-- misplaced desire to support windows, so also use the newline
|
||||
-- fallback for those.
|
||||
carriagereturn = fromIntegral (ord '\r')
|
||||
carriagereturn = unsafeFromChar '\r'
|
||||
|
||||
{- Runs git hash-object once per call, rather than using a running
|
||||
- one, so is slower. But, is able to handle newlines in the filepath,
|
||||
- which --stdin-paths cannot. -}
|
||||
hashFile' :: HashObjectHandle -> RawFilePath -> IO Sha
|
||||
hashFile' :: HashObjectHandle -> OsPath -> IO Sha
|
||||
hashFile' (HashObjectHandle _ repo ps) file = getSha "hash-object" $
|
||||
pipeReadStrict (ps ++ [File (fromRawFilePath file)]) repo
|
||||
pipeReadStrict (ps ++ [File (fromOsPath file)]) repo
|
||||
|
||||
class HashableBlob t where
|
||||
hashableBlobToHandle :: Handle -> t -> IO ()
|
||||
|
|
@ -86,7 +86,7 @@ hashBlob :: HashableBlob b => HashObjectHandle -> b -> IO Sha
|
|||
hashBlob h b = withTmpFile (literalOsPath "hash") $ \tmp tmph -> do
|
||||
hashableBlobToHandle tmph b
|
||||
hClose tmph
|
||||
hashFile h (fromOsPath tmp)
|
||||
hashFile h tmp
|
||||
|
||||
{- Injects some content into git, returning its Sha.
|
||||
-
|
||||
|
|
|
|||
|
|
@ -21,9 +21,9 @@ import System.Win32.File
|
|||
#endif
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
data LockHandle = LockHandle FilePath Fd
|
||||
data LockHandle = LockHandle OsPath Fd
|
||||
#else
|
||||
data LockHandle = LockHandle FilePath HANDLE
|
||||
data LockHandle = LockHandle OsPath HANDLE
|
||||
#endif
|
||||
|
||||
{- Uses the same exclusive locking that git does.
|
||||
|
|
@ -33,14 +33,14 @@ data LockHandle = LockHandle FilePath HANDLE
|
|||
- a dangling lock can be left if a process is terminated at the wrong
|
||||
- time.
|
||||
-}
|
||||
openLock :: FilePath -> IO LockHandle
|
||||
openLock :: OsPath -> IO LockHandle
|
||||
openLock lck = openLock' lck `catchNonAsync` lckerr
|
||||
where
|
||||
lckerr e = do
|
||||
-- Same error message displayed by git.
|
||||
whenM (doesFileExist lck) $
|
||||
hPutStrLn stderr $ unlines
|
||||
[ "fatal: Unable to create '" ++ lck ++ "': " ++ show e
|
||||
[ "fatal: Unable to create '" ++ fromOsPath lck ++ "': " ++ show e
|
||||
, ""
|
||||
, "If no other git process is currently running, this probably means a"
|
||||
, "git process crashed in this repository earlier. Make sure no other git"
|
||||
|
|
@ -48,11 +48,11 @@ openLock lck = openLock' lck `catchNonAsync` lckerr
|
|||
]
|
||||
throwM e
|
||||
|
||||
openLock' :: FilePath -> IO LockHandle
|
||||
openLock' :: OsPath -> IO LockHandle
|
||||
openLock' lck = do
|
||||
#ifndef mingw32_HOST_OS
|
||||
-- On unix, git simply uses O_EXCL
|
||||
h <- openFdWithMode (toRawFilePath lck) ReadWrite (Just 0O666)
|
||||
h <- openFdWithMode (fromOsPath lck) ReadWrite (Just 0O666)
|
||||
(defaultFileFlags { exclusive = True })
|
||||
setFdOption h CloseOnExec True
|
||||
#else
|
||||
|
|
@ -65,7 +65,7 @@ openLock' lck = do
|
|||
-- So, all that's needed is a way to open the file, that fails
|
||||
-- if the file already exists. Using CreateFile with CREATE_NEW
|
||||
-- accomplishes that.
|
||||
h <- createFile lck gENERIC_WRITE fILE_SHARE_NONE Nothing
|
||||
h <- createFile (fromOsPath lck) gENERIC_WRITE fILE_SHARE_NONE Nothing
|
||||
cREATE_NEW fILE_ATTRIBUTE_NORMAL Nothing
|
||||
#endif
|
||||
return (LockHandle lck h)
|
||||
|
|
|
|||
|
|
@ -39,14 +39,13 @@ import Git.Sha
|
|||
import Utility.InodeCache
|
||||
import Utility.TimeStamp
|
||||
import Utility.Attoparsec
|
||||
import qualified Utility.RawFilePath as R
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
import System.Posix.Types
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.Attoparsec.ByteString as A
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A8
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
{- It's only safe to use git ls-files on the current repo, not on a remote.
|
||||
-
|
||||
|
|
@ -78,20 +77,22 @@ opParam ErrorUnmatch = Param "--error-unmatch"
|
|||
{- Lists files that are checked into git's index at the specified paths.
|
||||
- With no paths, all files are listed.
|
||||
-}
|
||||
inRepo :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
inRepo :: [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
inRepo = inRepo' [Param "--cached"]
|
||||
|
||||
inRepo' :: [CommandParam] -> [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
inRepo' ps os l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo
|
||||
inRepo' :: [CommandParam] -> [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
inRepo' ps os l repo = guardSafeForLsFiles repo $ do
|
||||
(fs, cleanup) <- pipeNullSplit' params repo
|
||||
return (map toOsPath fs, cleanup)
|
||||
where
|
||||
params =
|
||||
Param "ls-files" :
|
||||
Param "-z" :
|
||||
map opParam os ++ ps ++
|
||||
(Param "--" : map (File . fromRawFilePath) l)
|
||||
(Param "--" : map (File . fromOsPath) l)
|
||||
|
||||
{- Lists the same files inRepo does, but with sha and mode. -}
|
||||
inRepoDetails :: [Options] -> [RawFilePath] -> Repo -> IO ([(RawFilePath, Sha, FileMode)], IO Bool)
|
||||
inRepoDetails :: [Options] -> [OsPath] -> Repo -> IO ([(OsPath, Sha, FileMode)], IO Bool)
|
||||
inRepoDetails = stagedDetails' parser . map opParam
|
||||
where
|
||||
parser s = case parseStagedDetails s of
|
||||
|
|
@ -102,17 +103,17 @@ inRepoDetails = stagedDetails' parser . map opParam
|
|||
|
||||
{- Files that are checked into the index or have been committed to a
|
||||
- branch. -}
|
||||
inRepoOrBranch :: Branch -> [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
inRepoOrBranch :: Branch -> [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
inRepoOrBranch b = inRepo'
|
||||
[ Param "--cached"
|
||||
, Param ("--with-tree=" ++ fromRef b)
|
||||
]
|
||||
|
||||
{- Scans for files at the specified locations that are not checked into git. -}
|
||||
notInRepo :: [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
notInRepo :: [Options] -> Bool -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
notInRepo = notInRepo' []
|
||||
|
||||
notInRepo' :: [CommandParam] -> [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
notInRepo' :: [CommandParam] -> [Options] -> Bool -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
notInRepo' ps os include_ignored =
|
||||
inRepo' (Param "--others" : ps ++ exclude) os
|
||||
where
|
||||
|
|
@ -122,41 +123,42 @@ notInRepo' ps os include_ignored =
|
|||
|
||||
{- Scans for files at the specified locations that are not checked into
|
||||
- git. Empty directories are included in the result. -}
|
||||
notInRepoIncludingEmptyDirectories :: [Options] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
notInRepoIncludingEmptyDirectories :: [Options] -> Bool -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
notInRepoIncludingEmptyDirectories = notInRepo' [Param "--directory"]
|
||||
|
||||
{- Finds all files in the specified locations, whether checked into git or
|
||||
- not. -}
|
||||
allFiles :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
allFiles :: [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
allFiles = inRepo' [Param "--cached", Param "--others"]
|
||||
|
||||
{- Returns a list of files in the specified locations that have been
|
||||
- deleted. -}
|
||||
deleted :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
deleted :: [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
deleted = inRepo' [Param "--deleted"]
|
||||
|
||||
{- Returns a list of files in the specified locations that have been
|
||||
- modified. -}
|
||||
modified :: [Options] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
modified :: [Options] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
modified = inRepo' [Param "--modified"]
|
||||
|
||||
{- Returns a list of all files that are staged for commit. -}
|
||||
staged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
staged :: [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
staged = staged' []
|
||||
|
||||
{- Returns a list of the files, staged for commit, that are being added,
|
||||
- moved, or changed (but not deleted), from the specified locations. -}
|
||||
stagedNotDeleted :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
stagedNotDeleted :: [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]
|
||||
|
||||
staged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
staged' ps l repo = guardSafeForLsFiles repo $
|
||||
pipeNullSplit' (prefix ++ ps ++ suffix) repo
|
||||
staged' :: [CommandParam] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
staged' ps l repo = guardSafeForLsFiles repo $ do
|
||||
(fs, cleanup) <- pipeNullSplit' (prefix ++ ps ++ suffix) repo
|
||||
return (map toOsPath fs, cleanup)
|
||||
where
|
||||
prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"]
|
||||
suffix = Param "--" : map (File . fromRawFilePath) l
|
||||
suffix = Param "--" : map (File . fromOsPath) l
|
||||
|
||||
type StagedDetails = (RawFilePath, Sha, FileMode, StageNum)
|
||||
type StagedDetails = (OsPath, Sha, FileMode, StageNum)
|
||||
|
||||
type StageNum = Int
|
||||
|
||||
|
|
@ -174,16 +176,16 @@ mergeConflictHeadStageNum = 2
|
|||
- Note that, during a conflict, a file will appear in the list
|
||||
- more than once with different stage numbers.
|
||||
-}
|
||||
stagedDetails :: [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)
|
||||
stagedDetails :: [OsPath] -> Repo -> IO ([StagedDetails], IO Bool)
|
||||
stagedDetails = stagedDetails' parseStagedDetails []
|
||||
|
||||
stagedDetails' :: (S.ByteString -> Maybe t) -> [CommandParam] -> [RawFilePath] -> Repo -> IO ([t], IO Bool)
|
||||
stagedDetails' :: (S.ByteString -> Maybe t) -> [CommandParam] -> [OsPath] -> Repo -> IO ([t], IO Bool)
|
||||
stagedDetails' parser ps l repo = guardSafeForLsFiles repo $ do
|
||||
(ls, cleanup) <- pipeNullSplit' params repo
|
||||
return (mapMaybe parser ls, cleanup)
|
||||
where
|
||||
params = Param "ls-files" : Param "--stage" : Param "-z" : ps ++
|
||||
Param "--" : map (File . fromRawFilePath) l
|
||||
Param "--" : map (File . fromOsPath) l
|
||||
|
||||
parseStagedDetails :: S.ByteString -> Maybe StagedDetails
|
||||
parseStagedDetails = eitherToMaybe . A.parseOnly parser
|
||||
|
|
@ -196,28 +198,28 @@ parseStagedDetails = eitherToMaybe . A.parseOnly parser
|
|||
stagenum <- A8.decimal
|
||||
void $ A8.char '\t'
|
||||
file <- A.takeByteString
|
||||
return (file, sha, mode, stagenum)
|
||||
return (toOsPath file, sha, mode, stagenum)
|
||||
|
||||
nextword = A8.takeTill (== ' ')
|
||||
|
||||
{- Returns a list of the files in the specified locations that are staged
|
||||
- for commit, and whose type has changed. -}
|
||||
typeChangedStaged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
typeChangedStaged :: [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
typeChangedStaged = typeChanged' [Param "--cached"]
|
||||
|
||||
{- Returns a list of the files in the specified locations whose type has
|
||||
- changed. Files only staged for commit will not be included. -}
|
||||
typeChanged :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
typeChanged :: [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
typeChanged = typeChanged' []
|
||||
|
||||
typeChanged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)
|
||||
typeChanged' :: [CommandParam] -> [OsPath] -> Repo -> IO ([OsPath], IO Bool)
|
||||
typeChanged' ps l repo = guardSafeForLsFiles repo $ do
|
||||
(fs, cleanup) <- pipeNullSplit' (prefix ++ ps ++ suffix) repo
|
||||
-- git diff returns filenames relative to the top of the git repo;
|
||||
-- convert to filenames relative to the cwd, like git ls-files.
|
||||
top <- absPath (repoPath repo)
|
||||
currdir <- R.getCurrentDirectory
|
||||
return (map (\f -> relPathDirToFileAbs currdir $ top P.</> f) fs, cleanup)
|
||||
currdir <- getCurrentDirectory
|
||||
return (map (\f -> relPathDirToFileAbs currdir $ top </> toOsPath f) fs, cleanup)
|
||||
where
|
||||
prefix =
|
||||
[ Param "diff"
|
||||
|
|
@ -225,7 +227,7 @@ typeChanged' ps l repo = guardSafeForLsFiles repo $ do
|
|||
, Param "--diff-filter=T"
|
||||
, Param "-z"
|
||||
]
|
||||
suffix = Param "--" : (if null l then [File "."] else map (File . fromRawFilePath) l)
|
||||
suffix = Param "--" : (if null l then [File "."] else map (File . fromOsPath) l)
|
||||
|
||||
{- A item in conflict has two possible values.
|
||||
- Either can be Nothing, when that side deleted the file. -}
|
||||
|
|
@ -235,10 +237,10 @@ data Conflicting v = Conflicting
|
|||
} deriving (Show)
|
||||
|
||||
data Unmerged = Unmerged
|
||||
{ unmergedFile :: RawFilePath
|
||||
{ unmergedFile :: OsPath
|
||||
, unmergedTreeItemType :: Conflicting TreeItemType
|
||||
, unmergedSha :: Conflicting Sha
|
||||
, unmergedSiblingFile :: Maybe RawFilePath
|
||||
, unmergedSiblingFile :: Maybe OsPath
|
||||
-- ^ Normally this is Nothing, because a
|
||||
-- merge conflict is represented as a single file with two
|
||||
-- stages. However, git resolvers sometimes choose to stage
|
||||
|
|
@ -257,7 +259,7 @@ data Unmerged = Unmerged
|
|||
- 3 = them
|
||||
- If line 2 or 3 is omitted, that side removed the file.
|
||||
-}
|
||||
unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool)
|
||||
unmerged :: [OsPath] -> Repo -> IO ([Unmerged], IO Bool)
|
||||
unmerged l repo = guardSafeForLsFiles repo $ do
|
||||
(fs, cleanup) <- pipeNullSplit params repo
|
||||
return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL) fs, cleanup)
|
||||
|
|
@ -267,11 +269,11 @@ unmerged l repo = guardSafeForLsFiles repo $ do
|
|||
Param "--unmerged" :
|
||||
Param "-z" :
|
||||
Param "--" :
|
||||
map (File . fromRawFilePath) l
|
||||
map (File . fromOsPath) l
|
||||
|
||||
data InternalUnmerged = InternalUnmerged
|
||||
{ isus :: Bool
|
||||
, ifile :: RawFilePath
|
||||
, ifile :: OsPath
|
||||
, itreeitemtype :: Maybe TreeItemType
|
||||
, isha :: Maybe Sha
|
||||
} deriving (Show)
|
||||
|
|
@ -287,7 +289,7 @@ parseUnmerged s
|
|||
else do
|
||||
treeitemtype <- readTreeItemType (encodeBS rawtreeitemtype)
|
||||
sha <- extractSha (encodeBS rawsha)
|
||||
return $ InternalUnmerged (stage == 2) (toRawFilePath file)
|
||||
return $ InternalUnmerged (stage == 2) (toOsPath file)
|
||||
(Just treeitemtype) (Just sha)
|
||||
_ -> Nothing
|
||||
where
|
||||
|
|
@ -321,7 +323,7 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
|
|||
-- foo~<ref> are unmerged sibling files of foo
|
||||
-- Some versions or resolvers of git stage the sibling files,
|
||||
-- other versions or resolvers do not.
|
||||
issibfile x y = (ifile x <> "~") `S.isPrefixOf` ifile y
|
||||
issibfile x y = (ifile x <> literalOsPath "~") `OS.isPrefixOf` ifile y
|
||||
&& isus x || isus y
|
||||
&& not (isus x && isus y)
|
||||
|
||||
|
|
@ -330,7 +332,7 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
|
|||
- Note that this uses a --debug option whose output could change at some
|
||||
- point in the future. If the output is not as expected, will use Nothing.
|
||||
-}
|
||||
inodeCaches :: [RawFilePath] -> Repo -> IO ([(FilePath, Maybe InodeCache)], IO Bool)
|
||||
inodeCaches :: [OsPath] -> Repo -> IO ([(FilePath, Maybe InodeCache)], IO Bool)
|
||||
inodeCaches locs repo = guardSafeForLsFiles repo $ do
|
||||
(ls, cleanup) <- pipeNullSplit params repo
|
||||
return (parse Nothing (map decodeBL ls), cleanup)
|
||||
|
|
@ -341,7 +343,7 @@ inodeCaches locs repo = guardSafeForLsFiles repo $ do
|
|||
Param "-z" :
|
||||
Param "--debug" :
|
||||
Param "--" :
|
||||
map (File . fromRawFilePath) locs
|
||||
map (File . fromOsPath) locs
|
||||
|
||||
parse Nothing (f:ls) = parse (Just f) ls
|
||||
parse (Just f) (s:[]) =
|
||||
|
|
|
|||
|
|
@ -12,6 +12,7 @@ module Git.Objects where
|
|||
import Common
|
||||
import Git
|
||||
import Git.Sha
|
||||
import qualified Utility.OsString as OS
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
|
@ -31,10 +32,19 @@ listPackFiles r = filter (".pack" `B.isSuffixOf`)
|
|||
|
||||
listLooseObjectShas :: Repo -> IO [Sha]
|
||||
listLooseObjectShas r = catchDefaultIO [] $
|
||||
mapMaybe (extractSha . encodeBS . concat . reverse . take 2 . reverse . splitDirectories . decodeBS)
|
||||
<$> emptyWhenDoesNotExist (dirContentsRecursiveSkipping (== "pack") True (objectsDir r))
|
||||
mapMaybe conv <$> emptyWhenDoesNotExist
|
||||
(dirContentsRecursiveSkipping (== "pack") True (objectsDir r))
|
||||
where
|
||||
conv :: OsPath -> Maybe Sha
|
||||
conv = extractSha
|
||||
. fromOsPath
|
||||
. OS.concat
|
||||
. reverse
|
||||
. take 2
|
||||
. reverse
|
||||
. splitDirectories
|
||||
|
||||
looseObjectFile :: Repo -> Sha -> RawFilePath
|
||||
looseObjectFile :: Repo -> Sha -> OsPath
|
||||
looseObjectFile r sha = objectsDir r P.</> prefix P.</> rest
|
||||
where
|
||||
(prefix, rest) = B.splitAt 2 (fromRef' sha)
|
||||
|
|
|
|||
|
|
@ -77,11 +77,11 @@ instance Quoteable RawFilePath where
|
|||
data StringContainingQuotedPath
|
||||
= UnquotedString String
|
||||
| UnquotedByteString S.ByteString
|
||||
| QuotedPath RawFilePath
|
||||
| QuotedPath OsPath
|
||||
| StringContainingQuotedPath :+: StringContainingQuotedPath
|
||||
deriving (Show, Eq)
|
||||
|
||||
quotedPaths :: [RawFilePath] -> StringContainingQuotedPath
|
||||
quotedPaths :: [OsPath] -> StringContainingQuotedPath
|
||||
quotedPaths [] = mempty
|
||||
quotedPaths (p:ps) = QuotedPath p <> if null ps
|
||||
then mempty
|
||||
|
|
@ -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 == fromRawFilePath (unquote (quoteAlways (toRawFilePath s)))
|
||||
s == fromOsPath (unquote (quoteAlways (toOsPath s)))
|
||||
where
|
||||
s = fromTestableFilePath ts
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue