Merge branch 'master' into v8

This commit is contained in:
Joey Hess 2020-01-01 14:26:43 -04:00
commit 2cea674d1e
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
44 changed files with 665 additions and 140 deletions

View file

@ -1,6 +1,6 @@
{- git cat-file interface
-
- Copyright 2011-2018 Joey Hess <id@joeyh.name>
- Copyright 2011-2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -33,6 +33,7 @@ import Text.Read
import Common
import Git
import Git.Sha
import qualified Git.Ref
import Git.Command
import Git.Types
import Git.FilePath
@ -109,22 +110,23 @@ catObjectDetails h object = query (catFileProcess h) object newlinefallback $ \f
return (Just (content, sha, objtype))
{- Gets the size and type of an object, without reading its content. -}
catObjectMetaData :: CatFileHandle -> Ref -> IO (Maybe (Integer, ObjectType))
catObjectMetaData :: CatFileHandle -> Ref -> IO (Maybe (Sha, FileSize, ObjectType))
catObjectMetaData h object = query (checkFileProcess h) object newlinefallback $ \from -> do
resp <- hGetLine from
case parseResp object resp of
Just (ParsedResp _ size objtype) ->
return $ Just (size, objtype)
Just (ParsedResp sha size objtype) ->
return $ Just (sha, size, objtype)
Just DNE -> return Nothing
Nothing -> error $ "unknown response from git cat-file " ++ show (resp, object)
where
-- Slow fallback path for filenames containing newlines.
newlinefallback = do
sha <- Git.Ref.sha object (gitRepo h)
sz <- querySize object (gitRepo h)
objtype <- queryObjectType object (gitRepo h)
return $ (,) <$> sz <*> objtype
return $ (,,) <$> sha <*> sz <*> objtype
data ParsedResp = ParsedResp Sha Integer ObjectType | DNE
data ParsedResp = ParsedResp Sha FileSize ObjectType | DNE
query :: CoProcess.CoProcessHandle -> Ref -> IO a -> (Handle -> IO a) -> IO a
query hdl object newlinefallback receive
@ -180,7 +182,7 @@ querySingle o r repo reader = assertLocal repo $
, return Nothing
)
querySize :: Ref -> Repo -> IO (Maybe Integer)
querySize :: Ref -> Repo -> IO (Maybe FileSize)
querySize r repo = maybe Nothing (readMaybe . takeWhile (/= '\n'))
<$> querySingle (Param "-s") r repo hGetContentsStrict

View file

@ -46,8 +46,8 @@ prop_encode_decode_roundtrip s = s' ==
-- "\343\200\271".
--
-- This property papers over the problem, by only
-- testing chars < 256.
nohigh = filter (\c -> ord c < 256)
-- testing ascii
nohigh = filter isAscii
-- A String can contain a NUL, but toRawFilePath
-- truncates on the NUL, which is generally fine
-- because unix filenames cannot contain NUL.

View file

@ -23,12 +23,12 @@ import Data.ByteString.Builder
type HashObjectHandle = CoProcess.CoProcessHandle
hashObjectStart :: Repo -> IO HashObjectHandle
hashObjectStart = gitCoProcessStart True
[ Param "hash-object"
, Param "-w"
, Param "--stdin-paths"
, Param "--no-filters"
hashObjectStart :: Bool -> Repo -> IO HashObjectHandle
hashObjectStart writeobject = gitCoProcessStart True $ catMaybes
[ Just (Param "hash-object")
, if writeobject then Just (Param "-w") else Nothing
, Just (Param "--stdin-paths")
, Just (Param "--no-filters")
]
hashObjectStop :: HashObjectHandle -> IO ()

View file

@ -117,5 +117,5 @@ parseRemoteLocation s repo = ret $ calcloc s
-- git on Windows will write a path to .git/config with "drive:",
-- which is not to be confused with a "host:"
dosstyle = hasDrive
dospath = fromInternalGitPath
dospath = fromRawFilePath . fromInternalGitPath . toRawFilePath
#endif

View file

@ -31,7 +31,7 @@ import Git.FilePath
-}
merge :: Ref -> Ref -> Repo -> IO ()
merge x y repo = do
hashhandle <- hashObjectStart repo
hashhandle <- hashObjectStart True repo
ch <- catFileStart repo
streamUpdateIndex repo
[ lsTree x repo