diff options
author | Joey Hess <joey@kitenet.net> | 2014-02-24 19:40:14 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-02-24 19:40:14 -0400 |
commit | 878e7471fa09dcc36b478e1ac1fd305d5a90b7bf (patch) | |
tree | d552b8faa43078e3dfe1f8b10063ec566eced4e2 /Git/UpdateIndex.hs | |
parent | d80c547a7d1261f158148ca85e627cc2ecb005f2 (diff) | |
download | git-repair-878e7471fa09dcc36b478e1ac1fd305d5a90b7bf.tar.gz |
merge from git-annex
Diffstat (limited to 'Git/UpdateIndex.hs')
-rw-r--r-- | Git/UpdateIndex.hs | 37 |
1 files changed, 28 insertions, 9 deletions
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 |