catFile expects no \r, even on Windows

This commit is contained in:
Joey Hess 2013-05-11 15:32:34 -05:00
parent 3c7e30a295
commit c45a723876

16
Git/CatFile.hs Normal file → Executable file
View file

@ -5,6 +5,8 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-}
module Git.CatFile ( module Git.CatFile (
CatFileHandle, CatFileHandle,
catFileStart, catFileStart,
@ -51,6 +53,9 @@ catObjectDetails h object = CoProcess.query h send receive
where where
send to = do send to = do
fileEncoding to fileEncoding to
#ifdef __WINDOWS__
hSetNewlineMode to noNewlineTranslation
#endif
hPutStrLn to $ show object hPutStrLn to $ show object
receive from = do receive from = do
fileEncoding from fileEncoding from
@ -68,8 +73,13 @@ catObjectDetails h object = CoProcess.query h send receive
| otherwise -> error $ "unknown response from git cat-file " ++ show (header, object) | otherwise -> error $ "unknown response from git cat-file " ++ show (header, object)
readcontent bytes from sha = do readcontent bytes from sha = do
content <- S.hGet from bytes content <- S.hGet from bytes
c <- hGetChar from #ifdef __WINDOWS__
when (c /= '\n') $ eatchar '\r' from
error "missing newline from git cat-file" #endif
eatchar '\n' from
return $ Just (L.fromChunks [content], Ref sha) return $ Just (L.fromChunks [content], Ref sha)
dne = return Nothing dne = return Nothing
eatchar expected from = do
c <- hGetChar from
when (c /= expected) $
error $ "missing " ++ (show c) ++ " from git cat-file"