refactor and function name cleanup

(oops, I had a calcMerge and a calc_merge!)

Annex/Branch.hs

@@ -261,15 +261,15 @@ files = withIndexUpdate $ do
  - in changes from other branches.
  -}
 genIndex :: Git.Repo -> IO ()
-genIndex g = Git.UpdateIndex.stream_update_index g
+genIndex g = Git.UpdateIndex.streamUpdateIndex g
-	[Git.UpdateIndex.ls_tree fullname g]
+	[Git.UpdateIndex.lsTree fullname g]
 
 {- Merges the specified refs into the index.
  - Any changes staged in the index will be preserved. -}
 mergeIndex :: [Git.Ref] -> Annex ()
 mergeIndex branches = do
 	h <- catFileHandle
-	inRepo $ \g -> Git.UnionMerge.merge_index h g branches
+	inRepo $ \g -> Git.UnionMerge.mergeIndex h g branches
 
 {- Runs an action using the branch's index file. -}
 withIndex :: Annex a -> Annex a
@@ -338,13 +338,13 @@ stageJournal = do
 	g <- gitRepo
 	withIndex $ liftIO $ do
 		h <- hashObjectStart g
-		Git.UpdateIndex.stream_update_index g
+		Git.UpdateIndex.streamUpdateIndex g
 			[genstream (gitAnnexJournalDir g) h fs]
 		hashObjectStop h
 	where
 		genstream dir h fs streamer = forM_ fs $ \file -> do
 			let path = dir </> file
 			sha <- hashFile h path
-			_ <- streamer $ Git.UpdateIndex.update_index_line
+			_ <- streamer $ Git.UpdateIndex.updateIndexLine
 				sha FileBlob (asTopFilePath $ fileJournal file)
 			removeFile path

Command/Watch.hs

@@ -19,9 +19,6 @@ import qualified Annex.Queue
 import qualified Command.Add
 import qualified Git.Command
 import qualified Git.UpdateIndex
-import Git.HashObject
-import Git.Types
-import Git.FilePath
 import qualified Backend
 import Annex.Content
 
@@ -140,9 +137,6 @@ onErr = warning
 {- Adds a symlink to the index, without ever accessing the actual symlink
  - on disk. -}
 stageSymlink :: FilePath -> String -> Annex ()
-stageSymlink file linktext = do
+stageSymlink file linktext =
-	line <- Git.UpdateIndex.update_index_line
+	Annex.Queue.addUpdateIndex =<<
-		<$> inRepo (hashObject BlobObject linktext)
+		inRepo (Git.UpdateIndex.stageSymlink file linktext)
-		<*> pure SymlinkBlob
-		<*> inRepo (toTopFilePath file)
-	Annex.Queue.addUpdateIndex $ \streamer -> streamer line

Git/Queue.hs

@@ -151,7 +151,7 @@ flush (Queue _ lim m) repo = do
  - this allows queueing commands that do not need a list of files. -}
 runAction :: Repo -> Action -> IO ()
 runAction repo (UpdateIndexAction streamers) =
-	Git.UpdateIndex.stream_update_index repo streamers
+	Git.UpdateIndex.streamUpdateIndex repo streamers
 runAction repo action@(CommandAction {}) =
 	pOpen WriteToPipe "xargs" ("-0":"git":params) feedxargs
 	where

Git/UnionMerge.hs

@@ -7,7 +7,7 @@
 
 module Git.UnionMerge (
 	merge,
-	merge_index
+	mergeIndex
 ) where
 
 import qualified Data.Text.Lazy as L
@@ -32,40 +32,40 @@ import Git.FilePath
 merge :: Ref -> Ref -> Repo -> IO ()
 merge x y repo = do
 	h <- catFileStart repo
-	stream_update_index repo
+	streamUpdateIndex repo
-		[ ls_tree x repo
+		[ lsTree x repo
-		, merge_trees x y h repo
+		, mergeTrees x y h repo
 		]
 	catFileStop h
 
-{- Merges a list of branches into the index. Previously staged changed in
+{- Merges a list of branches into the index. Previously staged changes in
  - the index are preserved (and participate in the merge). -}
-merge_index :: CatFileHandle -> Repo -> [Ref] -> IO ()
+mergeIndex :: CatFileHandle -> Repo -> [Ref] -> IO ()
-merge_index h repo bs =
+mergeIndex h repo bs =
-	stream_update_index repo $ map (\b -> merge_tree_index b h repo) bs
+	streamUpdateIndex repo $ map (\b -> mergeTreeIndex b h repo) bs
 
 {- For merging two trees. -}
-merge_trees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
+mergeTrees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
-merge_trees (Ref x) (Ref y) h = calc_merge h $ "diff-tree":diff_opts ++ [x, y]
+mergeTrees (Ref x) (Ref y) h = doMerge h $ "diff-tree":diffOpts ++ [x, y]
 
 {- For merging a single tree into the index. -}
-merge_tree_index :: Ref -> CatFileHandle -> Repo -> Streamer
+mergeTreeIndex :: Ref -> CatFileHandle -> Repo -> Streamer
-merge_tree_index (Ref x) h = calc_merge h $
+mergeTreeIndex (Ref x) h = doMerge h $
-	"diff-index" : diff_opts ++ ["--cached", x]
+	"diff-index" : diffOpts ++ ["--cached", x]
 
-diff_opts :: [String]
+diffOpts :: [String]
-diff_opts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
+diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
 
-{- Calculates how to perform a merge, using git to get a raw diff,
+{- Streams update-index changes to perform a merge,
- - and generating update-index input. -}
+ - using git to get a raw diff. -}
-calc_merge :: CatFileHandle -> [String] -> Repo -> Streamer
+doMerge :: CatFileHandle -> [String] -> Repo -> Streamer
-calc_merge ch differ repo streamer = gendiff >>= go
+doMerge ch differ repo streamer = gendiff >>= go
 	where
 		gendiff = pipeNullSplit (map Param differ) repo
 		go [] = noop
 		go (info:file:rest) = mergeFile info file ch repo >>=
 			maybe (go rest) (\l -> streamer l >> go rest)
-		go (_:[]) = error "calc_merge parse error"
+		go (_:[]) = error $ "parse error " ++ show differ
 
 {- Given an info line from a git raw diff, and the filename, generates
  - a line suitable for update-index that union merges the two sides of the
@@ -81,7 +81,8 @@ mergeFile info file h repo = case filter (/= nullSha) [Ref asha, Ref bsha] of
 		[_colonmode, _bmode, asha, bsha, _status] = words info
 		getcontents s = map L.unpack . L.lines .
 			L.decodeUtf8 <$> catObject h s
-		use sha = return $ Just $ update_index_line sha FileBlob $ asTopFilePath file
+		use sha = return $ Just $
+			updateIndexLine sha FileBlob $ asTopFilePath file
 
 {- Calculates a union merge between a list of refs, with contents.
  -

Git/UpdateIndex.hs

@@ -7,9 +7,11 @@
 
 module Git.UpdateIndex (
 	Streamer,
-	stream_update_index,
+	pureStreamer,
-	ls_tree,
+	streamUpdateIndex,
-	update_index_line,
+	lsTree,
+	updateIndexLine,
+	stageSymlink
 ) where
 
 import System.Cmd.Utils
@@ -19,14 +21,19 @@ import Git
 import Git.Types
 import Git.Command
 import Git.FilePath
+import Git.HashObject
 
 {- 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 ()
 
+{- A streamer with a precalculated value. -}
+pureStreamer :: String -> Streamer
+pureStreamer s = \streamer -> streamer s
+
 {- Streams content into update-index from a list of Streamers. -}
-stream_update_index :: Repo -> [Streamer] -> IO ()
+streamUpdateIndex :: Repo -> [Streamer] -> IO ()
-stream_update_index repo as = do
+streamUpdateIndex repo as = do
 	(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
 	fileEncoding h
 	forM_ as (stream h)
@@ -39,14 +46,24 @@ stream_update_index repo as = do
 			hPutStr h s
 			hPutStr h "\0"
 
-{- Gets the current tree for a ref. -}
+{- A streamer that adds the current tree for a ref. Useful for eg, copying
-ls_tree :: Ref -> Repo -> Streamer
+ - and modifying branches. -}
-ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
+lsTree :: Ref -> Repo -> Streamer
+lsTree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
 	where
 		params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]
 
 {- Generates a line suitable to be fed into update-index, to add
  - a given file with a given sha. -}
-update_index_line :: Sha -> BlobType -> TopFilePath -> String
+updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
-update_index_line sha filetype file =
+updateIndexLine sha filetype file =
 	show filetype ++ " blob " ++ show sha ++ "\t" ++ getTopFilePath file
+
+{- A streamer that adds a symlink to the index. -}
+stageSymlink :: FilePath -> String -> Repo -> IO Streamer
+stageSymlink file linktext repo = do
+	line <- updateIndexLine
+		<$> hashObject BlobObject linktext repo
+		<*> pure SymlinkBlob
+		<*> toTopFilePath file repo
+	return $ pureStreamer line