factor out generic update-index code from unionmerge code

1 files changed, 49 insertions, 0 deletions

diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
new file mode 100644
index 000000000..04bc4da5b
--- /dev/null
+++ b/Git/UpdateIndex.hs
@@ -0,0 +1,49 @@
+{- git-update-index library
+ -
+ - Copyright 2011, 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.UpdateIndex (
+	Streamer,
+	stream_update_index,
+	update_index_line,
+	ls_tree
+) where
+
+import System.Cmd.Utils
+
+import Common
+import Git
+import Git.Command
+
+{- 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 ()
+
+{- Streams content into update-index from a list of Streamers. -}
+stream_update_index :: Repo -> [Streamer] -> IO ()
+stream_update_index repo as = do
+	(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
+	fileEncoding h
+	forM_ as (stream h)
+	hClose h
+	forceSuccess p
+	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"
+
+{- Generates a line suitable to be fed into update-index, to add
+ - a given file with a given sha. -}
+update_index_line :: Sha -> FilePath -> String
+update_index_line sha file = "100644 blob " ++ show sha ++ "\t" ++ file
+
+{- Gets the current tree for a ref. -}
+ls_tree :: Ref -> Repo -> Streamer
+ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
+	where
+		params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]