From f0f7e900cc9248c05314eaed418317de690a24d8 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 21 Nov 2016 20:56:58 -0400
Subject: try to gather scattered writes

git upload-pack makes some uncessary writes in sequence, this tries to
gather them together to avoid needing to send multiple DATA packets when
just one will do.

In a small pull, this reduces the average number of DATA packets from
4.5 to 2.5.
---
 Remote/Helper/P2P/IO.hs | 34 ++++++++++++++++++++++++++++------
 1 file changed, 28 insertions(+), 6 deletions(-)

diff --git a/Remote/Helper/P2P/IO.hs b/Remote/Helper/P2P/IO.hs
index b3597abf9..dd0b9631d 100644
--- a/Remote/Helper/P2P/IO.hs
+++ b/Remote/Helper/P2P/IO.hs
@@ -5,7 +5,7 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RankNTypes, CPP #-}
 
 module Remote.Helper.P2P.IO
 	( RunProto
@@ -179,9 +179,31 @@ relayReader :: MVar RelayData -> Handle -> IO ()
 relayReader v hout = loop
   where
 	loop = do
-		b <- B.hGetSome hout 65536
-		if B.null b
-			then return ()
-			else do
-				putMVar v $ RelayToPeer (L.fromChunks [b])
+		bs <- getsome []
+		case bs of
+			[] -> return ()
+			_ -> do
+				putMVar v $ RelayToPeer (L.fromChunks bs)
 				loop
+	
+	-- Waiit for the first available chunk. Then, without blocking,
+	-- try to get more chunks, in case a stream of chunks is being
+	-- written in close succession. 
+	--
+	-- On Windows, hGetNonBlocking is broken, so avoid using it there.
+	getsome [] = do
+		b <- B.hGetSome hout chunk
+		if B.null b
+			then return []
+#ifndef mingw32_HOST_OS
+			else getsome [b]
+#else
+			else return [b]
+#endif
+	getsome bs = do
+		b <- B.hGetNonBlocking hout chunk
+		if B.null b
+			then return (reverse bs)
+			else getsome (b:bs)
+	
+	chunk = 65536
-- 
cgit v1.2.3