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.

2 files changed, 40 insertions, 9 deletions

diff --git a/Git/HashObject.hs b/Git/HashObject.hs
index bb9b20d96..97e1befe6 100644
--- a/Git/HashObject.hs
+++ b/Git/HashObject.hs
@@ -1,6 +1,6 @@
 {- git hash-object interface
  -
- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -13,6 +13,7 @@ import Git.Sha
 import Git.Command
 import Git.Types
 import qualified Utility.CoProcess as CoProcess
+import Utility.Tmp
 
 type HashObjectHandle = CoProcess.CoProcessHandle
 
@@ -34,7 +35,18 @@ hashFile h file = CoProcess.query h send receive
 	send to = hPutStrLn to file
 	receive from = getSha "hash-object" $ hGetLine from
 
-{- Injects some content into git, returning its Sha. -}
+{- Injects a blob into git. Unfortunately, the current git-hash-object
+ - interface does not allow batch hashing without using temp files. -}
+hashBlob :: HashObjectHandle -> String -> IO Sha
+hashBlob h s = withTmpFile "hash" $ \tmp tmph -> do
+	hPutStr tmph s
+	hClose tmph
+	hashFile h tmp
+
+{- Injects some content into git, returning its Sha.
+ - 
+ - Avoids using a tmp file, but runs a new hash-object command each
+ - time called. -}
 hashObject :: ObjectType -> String -> Repo -> IO Sha
 hashObject objtype content = hashObject' objtype (flip hPutStr content)
 
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. -}