crazy optimisation

Crazy like a fox..

1 files changed, 11 insertions, 6 deletions

diff --git a/Git/CatFile.hs b/Git/CatFile.hs
index d5b367945..8a320a712 100644
--- a/Git/CatFile.hs
+++ b/Git/CatFile.hs
@@ -10,7 +10,8 @@ module Git.CatFile (
 	catFileStart,
 	catFileStop,
 	catFile,
-	catObject
+	catObject,
+	catObjectDetails,
 ) where
 
 import System.IO
@@ -42,7 +43,11 @@ 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 h object = CoProcess.query h send receive
+catObject h object = maybe L.empty fst <$> catObjectDetails h object
+
+{- Gets both the content of an object, and its Sha. -}
+catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha))
+catObjectDetails h object = CoProcess.query h send receive
 	where
 		send to = do
 			fileEncoding to
@@ -55,16 +60,16 @@ catObject h object = CoProcess.query h send receive
 					| length sha == shaSize &&
 					  isJust (readObjectType objtype) -> 
 						case reads size of
-							[(bytes, "")] -> readcontent bytes from
+							[(bytes, "")] -> readcontent bytes from sha
 							_ -> dne
 					| otherwise -> dne
 				_
 					| header == show object ++ " missing" -> dne
 					| otherwise -> error $ "unknown response from git cat-file " ++ show (header, object)
-		readcontent bytes from = do
+		readcontent bytes from sha = do
 			content <- S.hGet from bytes
 			c <- hGetChar from
 			when (c /= '\n') $
 				error "missing newline from git cat-file"
-			return $ L.fromChunks [content]
-		dne = return L.empty
+			return $ Just (L.fromChunks [content], Ref sha)
+		dne = return Nothing