From 878e7471fa09dcc36b478e1ac1fd305d5a90b7bf Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 24 Feb 2014 19:40:14 -0400
Subject: merge from git-annex

---
 Git/UpdateIndex.hs | 37 ++++++++++++++++++++++++++++---------
 1 file changed, 28 insertions(+), 9 deletions(-)

(limited to 'Git/UpdateIndex.hs')

diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 3b33ac8..6d1ff25 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -11,6 +11,9 @@ module Git.UpdateIndex (
 	Streamer,
 	pureStreamer,
 	streamUpdateIndex,
+	streamUpdateIndex',
+	startUpdateIndex,
+	stopUpdateIndex,
 	lsTree,
 	updateIndexLine,
 	stageFile,
@@ -25,6 +28,9 @@ import Git.Command
 import Git.FilePath
 import Git.Sha
 
+import Control.Exception (bracket)
+import System.Process (std_in)
+
 {- Streamers are passed a callback and should feed it lines in the form
  - read by update-index, and generated by ls-tree. -}
 type Streamer = (String -> IO ()) -> IO ()
@@ -35,16 +41,29 @@ pureStreamer !s = \streamer -> streamer s
 
 {- Streams content into update-index from a list of Streamers. -}
 streamUpdateIndex :: Repo -> [Streamer] -> IO ()
-streamUpdateIndex repo as = pipeWrite params repo $ \h -> do
+streamUpdateIndex repo as = bracket (startUpdateIndex repo) stopUpdateIndex $
+	(\h -> forM_ as $ streamUpdateIndex' h)
+
+data UpdateIndexHandle = UpdateIndexHandle ProcessHandle Handle
+
+streamUpdateIndex' :: UpdateIndexHandle -> Streamer -> IO ()
+streamUpdateIndex' (UpdateIndexHandle _ h) a = a $ \s -> do
+	hPutStr h s
+	hPutStr h "\0"
+
+startUpdateIndex :: Repo -> IO UpdateIndexHandle
+startUpdateIndex repo = do
+	(Just h, _, _, p) <- createProcess (gitCreateProcess params repo)
+		{ std_in = CreatePipe }
 	fileEncoding h
-	forM_ as (stream h)
-	hClose h
+	return $ UpdateIndexHandle p h
   where
 	params = map Param ["update-index", "-z", "--index-info"]
-	stream h a = a (streamer h)
-	streamer h s = do
-		hPutStr h s
-		hPutStr h "\0"
+
+stopUpdateIndex :: UpdateIndexHandle -> IO Bool
+stopUpdateIndex (UpdateIndexHandle p h) = do
+	hClose h
+	checkSuccessProcess p
 
 {- A streamer that adds the current tree for a ref. Useful for eg, copying
  - and modifying branches. -}
@@ -60,7 +79,7 @@ lsTree (Ref x) repo streamer = do
  - a given file with a given sha. -}
 updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
 updateIndexLine sha filetype file =
-	show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file
+	show filetype ++ " blob " ++ fromRef sha ++ "\t" ++ indexPath file
 
 stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer
 stageFile sha filetype file repo = do
@@ -71,7 +90,7 @@ stageFile sha filetype file repo = do
 unstageFile :: FilePath -> Repo -> IO Streamer
 unstageFile file repo = do
 	p <- toTopFilePath file repo
-	return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ indexPath p
+	return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p
 
 {- A streamer that adds a symlink to the index. -}
 stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
-- 
cgit v1.2.3