small improvement to packet flushing
This commit is contained in:
parent
65de44aa13
commit
4649625f04
2 changed files with 12 additions and 4 deletions
|
@ -79,7 +79,8 @@ handshake selectrole selectcapability input output =
|
||||||
case selectrole role of
|
case selectrole role of
|
||||||
Left e -> return (Left e)
|
Left e -> return (Left e)
|
||||||
Right myrole -> sendpkt rolePkt myrole $
|
Right myrole -> sendpkt rolePkt myrole $
|
||||||
sendpkt versionPkt (Version "2") $
|
sendpkt versionPkt (Version "2") $ do
|
||||||
|
hFlush output
|
||||||
exchangecaps $ \mycaps -> return $
|
exchangecaps $ \mycaps -> return $
|
||||||
Right (myrole, mycaps)
|
Right (myrole, mycaps)
|
||||||
where
|
where
|
||||||
|
@ -87,13 +88,15 @@ handshake selectrole selectcapability input output =
|
||||||
|
|
||||||
sendpkt f v cnt = case f v of
|
sendpkt f v cnt = case f v of
|
||||||
Just pkt -> do
|
Just pkt -> do
|
||||||
hPutBuilder output $ encodePktLine pkt
|
writePktLine output pkt
|
||||||
hFlush output
|
|
||||||
cnt
|
cnt
|
||||||
Nothing -> return $ Left $
|
Nothing -> return $ Left $
|
||||||
"failed constructing pkt-line packet for: " ++ show v
|
"failed constructing pkt-line packet for: " ++ show v
|
||||||
|
|
||||||
sendpkts _ [] cnt = sendpkt Just flushPkt cnt
|
sendpkts _ [] cnt = do
|
||||||
|
writePktLine output flushPkt
|
||||||
|
hFlush output
|
||||||
|
cnt
|
||||||
sendpkts f (v:vs) cnt = sendpkt f v $ sendpkts f vs cnt
|
sendpkts f (v:vs) cnt = sendpkt f v $ sendpkts f vs cnt
|
||||||
|
|
||||||
getpkt parser cnt = readPktLine input >>= \case
|
getpkt parser cnt = readPktLine input >>= \case
|
||||||
|
|
|
@ -19,6 +19,7 @@ module Git.Protocol.PktLine (
|
||||||
decodePktLine,
|
decodePktLine,
|
||||||
splitPktLine,
|
splitPktLine,
|
||||||
readPktLine,
|
readPktLine,
|
||||||
|
writePktLine,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.ByteString as S
|
import qualified Data.ByteString as S
|
||||||
|
@ -156,3 +157,7 @@ readPktLine h = do
|
||||||
body <- S.hGet h (len - 4)
|
body <- S.hGet h (len - 4)
|
||||||
let parser = parsePktLine' len <* endOfInput
|
let parser = parsePktLine' len <* endOfInput
|
||||||
return $ Just $ parseOnly parser body
|
return $ Just $ parseOnly parser body
|
||||||
|
|
||||||
|
-- | Sends a packet to the Handle. Does not flush the Handle.
|
||||||
|
writePktLine :: Handle -> PktLine -> IO ()
|
||||||
|
writePktLine h = hPutBuilder h . encodePktLine
|
||||||
|
|
Loading…
Reference in a new issue