diff options
Diffstat (limited to 'Git/UpdateIndex.hs')
| -rw-r--r-- | Git/UpdateIndex.hs | 33 |
1 files changed, 26 insertions, 7 deletions
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 3b33ac846..73beaba3a 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. -} |