crazy optimisation

Crazy like a fox..

2 files changed, 14 insertions, 10 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
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 07057ed98..31e8a45b2 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -24,7 +24,6 @@ import Git
 import Git.Types
 import Git.Command
 import Git.FilePath
-import Git.HashObject
 import Git.Sha
 
 {- Streamers are passed a callback and should feed it lines in the form
@@ -70,10 +69,10 @@ unstageFile file repo = do
 	return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ getTopFilePath p
 
 {- A streamer that adds a symlink to the index. -}
-stageSymlink :: FilePath -> String -> Repo -> IO Streamer
-stageSymlink file linktext repo = do
+stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
+stageSymlink file sha repo = do
 	line <- updateIndexLine
-		<$> hashObject BlobObject linktext repo
+		<$> pure sha
 		<*> pure SymlinkBlob
 		<*> toTopFilePath file repo
 	return $ pureStreamer line