This commit is contained in:
Joey Hess 2012-02-20 15:20:36 -04:00
parent ac5cff3668
commit 6c0155efb7
4 changed files with 77 additions and 51 deletions

View file

@ -13,7 +13,6 @@ module Git.CatFile (
catObject
) where
import System.Cmd.Utils
import System.IO
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
@ -22,20 +21,18 @@ import Common
import Git
import Git.Sha
import Git.Command
import qualified Utility.CoProcess as CoProcess
type CatFileHandle = (PipeHandle, Handle, Handle)
type CatFileHandle = CoProcess.CoProcessHandle
{- Starts git cat-file running in batch mode in a repo and returns a handle. -}
catFileStart :: Repo -> IO CatFileHandle
catFileStart repo = hPipeBoth "git" $ toCommand $
catFileStart repo = CoProcess.start "git" $ toCommand $
gitCommandLine [Param "cat-file", Param "--batch"] repo
{- Stops git cat-file. -}
catFileStop :: CatFileHandle -> IO ()
catFileStop (pid, from, to) = do
hClose to
hClose from
forceSuccess pid
catFileStop = CoProcess.stop
{- Reads a file from a specified branch. -}
catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString
@ -44,23 +41,23 @@ catFile h branch file = catObject h $ Ref $ show branch ++ ":" ++ file
{- Uses a running git cat-file read the content of an object.
- Objects that do not exist will have "" returned. -}
catObject :: CatFileHandle -> Ref -> IO L.ByteString
catObject (_, from, to) object = do
hPutStrLn to $ show object
hFlush to
header <- hGetLine from
case words header of
[sha, objtype, size]
| length sha == shaSize &&
validobjtype objtype -> handle size
| otherwise -> dne
_
| header == show object ++ " missing" -> dne
| otherwise -> error $ "unknown response from git cat-file " ++ header
catObject h object = CoProcess.query h send receive
where
handle size = case reads size of
[(bytes, "")] -> readcontent bytes
_ -> dne
readcontent bytes = do
send to = hPutStrLn to $ show object
receive from = do
header <- hGetLine from
case words header of
[sha, objtype, size]
| length sha == shaSize &&
validobjtype objtype ->
case reads size of
[(bytes, "")] -> readcontent bytes from
_ -> dne
| otherwise -> dne
_
| header == show object ++ " missing" -> dne
| otherwise -> error $ "unknown response from git cat-file " ++ header
readcontent bytes from = do
content <- S.hGet from bytes
c <- hGetChar from
when (c /= '\n') $