refactor and function name cleanup

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

3 files changed, 50 insertions, 32 deletions

diff --git a/Git/Queue.hs b/Git/Queue.hs
index f2312cfaa..78b52a2bc 100644
--- a/Git/Queue.hs
+++ b/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
diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs
index d38bdfe22..0987f9131 100644
--- a/Git/UnionMerge.hs
+++ b/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
-		[ ls_tree x repo
-		, merge_trees x y h repo
+	streamUpdateIndex repo
+		[ lsTree x 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 ()
-merge_index h repo bs =
-	stream_update_index repo $ map (\b -> merge_tree_index b h repo) bs
+mergeIndex :: CatFileHandle -> Repo -> [Ref] -> IO ()
+mergeIndex h repo bs =
+	streamUpdateIndex repo $ map (\b -> mergeTreeIndex b h repo) bs
 
 {- For merging two trees. -}
-merge_trees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
-merge_trees (Ref x) (Ref y) h = calc_merge h $ "diff-tree":diff_opts ++ [x, y]
+mergeTrees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
+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
-merge_tree_index (Ref x) h = calc_merge h $
-	"diff-index" : diff_opts ++ ["--cached", x]
+mergeTreeIndex :: Ref -> CatFileHandle -> Repo -> Streamer
+mergeTreeIndex (Ref x) h = doMerge h $
+	"diff-index" : diffOpts ++ ["--cached", x]
 
-diff_opts :: [String]
-diff_opts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
+diffOpts :: [String]
+diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
 
-{- Calculates how to perform a merge, using git to get a raw diff,
- - and generating update-index input. -}
-calc_merge :: CatFileHandle -> [String] -> Repo -> Streamer
-calc_merge ch differ repo streamer = gendiff >>= go
+{- Streams update-index changes to perform a merge,
+ - using git to get a raw diff. -}
+doMerge :: CatFileHandle -> [String] -> Repo -> Streamer
+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.
  -
diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs
index 8c003dd13..a32db8b9d 100644
--- a/Git/UpdateIndex.hs
+++ b/Git/UpdateIndex.hs
@@ -7,9 +7,11 @@
 
 module Git.UpdateIndex (
 	Streamer,
-	stream_update_index,
-	ls_tree,
-	update_index_line,
+	pureStreamer,
+	streamUpdateIndex,
+	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 ()
-stream_update_index repo as = do
+streamUpdateIndex :: Repo -> [Streamer] -> IO ()
+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. -}
-ls_tree :: Ref -> Repo -> Streamer
-ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
+{- A streamer that adds the current tree for a ref. Useful for eg, copying
+ - and modifying branches. -}
+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
-update_index_line sha filetype file =
+updateIndexLine :: Sha -> BlobType -> TopFilePath -> String
+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