work around catObjectStream polymorism perf

Breaking it up like this doesn't change perf, and lets another version
be written in just a couple lines.

Git/CatFile.hs

@@ -21,6 +21,7 @@ module Git.CatFile (
 	catObjectDetails,
 	catObjectMetaData,
 	catObjectStream,
+	catObjectStream',
 ) where
 
 import System.IO
@@ -283,12 +284,8 @@ parseCommit b = Commit
 	lt = fromIntegral (ord '<')
 	gt = fromIntegral (ord '>')
 
-{- Uses cat-file to stream the contents of the files listed by lstree
+{- Uses cat-file to stream the contents of the files as efficiently
- - as efficiently as possible. This is much faster than querying it
+ - as possible. This is much faster than querying it repeatedly per file.
- - repeatedly per file.
- -
- - (Note that, while a more polymorphic version of this can be written,
- - this version is faster, possibly due to being less polymorphic.)
  -}
 catObjectStream
 	:: (MonadMask m, MonadIO m)
@@ -297,8 +294,8 @@ catObjectStream
 	-> Repo
 	-> (IO (Maybe (TopFilePath, Maybe L.ByteString)) -> m ())
 	-> m ()
-catObjectStream l want repo a = assertLocal repo $ do
+catObjectStream l want repo a = withCatObjectStream repo feeder $
-	bracketIO start stop $ \(mv, _, _, hout, _) -> a (reader mv hout)
+	\mv hout -> a (catObjectReader mv hout)
   where
 	feeder mv h = do
 		forM_ l $ \ti ->
@@ -309,7 +306,26 @@ catObjectStream l want repo a = assertLocal repo $ do
 				S8.hPutStrLn h (fromRef' sha)
 		hClose h
 
-	reader mv h = ifM (hIsEOF h)
+{- While this variant could be combined with catObjectStream into a 
+ - more polymorphic function, the specialization of both is important for
+ - performance. -}
+catObjectStream'
+	:: (MonadMask m, MonadIO m)
+	=> [(RawFilePath, Sha, FileMode)]
+	-> Repo
+	-> (IO (Maybe (RawFilePath, Maybe L.ByteString)) -> m ())
+	-> m ()
+catObjectStream' l repo a = withCatObjectStream repo feeder $
+	\mv hout -> a (catObjectReader mv hout)
+  where
+	feeder mv h = do
+		forM_ l $ \(f, sha, _) -> do
+			liftIO $ atomically $ snocTList mv (sha, f)
+			S8.hPutStrLn h (fromRef' sha)
+		hClose h
+
+catObjectReader :: TList (Ref, a) -> Handle -> IO (Maybe (a, Maybe L.ByteString))
+catObjectReader mv h = ifM (hIsEOF h)
 	( return Nothing
 	, do
 		(sha, f) <- liftIO $ atomically $ headTList mv
@@ -322,6 +338,15 @@ catObjectStream l want repo a = assertLocal repo $ do
 			Nothing -> error $ "unknown response from git cat-file " ++ show resp
 	)
 
+withCatObjectStream
+	:: (MonadMask m, MonadIO m)
+	=> Repo
+	-> (TList a -> Handle -> IO ())
+	-> (TList a -> Handle -> m ())
+	-> m ()
+withCatObjectStream repo feeder reader = assertLocal repo $
+	bracketIO start stop $ \(mv, _, _, hout, _) -> reader mv hout
+  where
 	params = 
 		[ Param "cat-file"
 		, Param ("--batch=" ++ batchFormat)