summaryrefslogtreecommitdiff
path: root/Git/UpdateIndex.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-02-18 17:38:23 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-02-18 18:22:20 -0400
commit2fb1cfc4ae0cfb3f012e074f2f855c592f866b05 (patch)
tree7416b03c25e431898042fef6ad2e5ab27e6882d0 /Git/UpdateIndex.hs
parent6f7ff00cb67546008918ed735f8be66b65cf9ce8 (diff)
add git annex view command
(And a vpop command, which is still a bit buggy.) Still need to do vadd and vrm, though this also adds their documentation. Currently not very happy with the view log data serialization. I had to lose the TDFA regexps temporarily, so I can have Read/Show instances of View. I expect the view log format will change in some incompatable way later, probably adding last known refs for the parent branch to View or something like that. Anyway, it basically works, although it's a bit slow looking up the metadata. The actual git branch construction is about as fast as it can be using the current git plumbing. This commit was sponsored by Peter Hogg.
Diffstat (limited to 'Git/UpdateIndex.hs')
-rw-r--r--Git/UpdateIndex.hs33
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. -}