factor out generic update-index code from unionmerge code

This commit is contained in:
Joey Hess 2012-06-06 00:03:08 -04:00
parent 141fa3c94d
commit f1bd72ea54
3 changed files with 56 additions and 43 deletions

View file

@ -7,11 +7,7 @@
module Git.UnionMerge (
merge,
merge_index,
update_index,
stream_update_index,
update_index_line,
ls_tree
merge_index
) where
import System.Cmd.Utils
@ -24,8 +20,7 @@ import Git
import Git.Sha
import Git.CatFile
import Git.Command
type Streamer = (String -> IO ()) -> IO ()
import Git.UpdateIndex
{- Performs a union merge between two branches, staging it in the index.
- Any previously staged changes in the index will be lost.
@ -47,38 +42,6 @@ merge_index :: CatFileHandle -> Repo -> [Ref] -> IO ()
merge_index h repo bs =
stream_update_index repo $ map (\b -> merge_tree_index b h repo) bs
{- Feeds content into update-index. Later items in the list can override
- earlier ones, so the list can be generated from any combination of
- ls_tree, merge_trees, and merge_tree_index. -}
update_index :: Repo -> [String] -> IO ()
update_index repo ls = stream_update_index repo [(`mapM_` ls)]
{- Streams content into update-index. -}
stream_update_index :: Repo -> [Streamer] -> IO ()
stream_update_index repo as = do
(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
fileEncoding h
forM_ as (stream h)
hClose h
forceSuccess p
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"
{- Generates a line suitable to be fed into update-index, to add
- a given file with a given sha. -}
update_index_line :: Sha -> FilePath -> String
update_index_line sha file = "100644 blob " ++ show sha ++ "\t" ++ file
{- Gets the current tree for a ref. -}
ls_tree :: Ref -> Repo -> Streamer
ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
where
params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]
{- 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]

49
Git/UpdateIndex.hs Normal file
View file

@ -0,0 +1,49 @@
{- git-update-index library
-
- Copyright 2011, 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Git.UpdateIndex (
Streamer,
stream_update_index,
update_index_line,
ls_tree
) where
import System.Cmd.Utils
import Common
import Git
import Git.Command
{- 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 ()
{- Streams content into update-index from a list of Streamers. -}
stream_update_index :: Repo -> [Streamer] -> IO ()
stream_update_index repo as = do
(p, h) <- hPipeTo "git" (toCommand $ gitCommandLine params repo)
fileEncoding h
forM_ as (stream h)
hClose h
forceSuccess p
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"
{- Generates a line suitable to be fed into update-index, to add
- a given file with a given sha. -}
update_index_line :: Sha -> FilePath -> String
update_index_line sha file = "100644 blob " ++ show sha ++ "\t" ++ file
{- Gets the current tree for a ref. -}
ls_tree :: Ref -> Repo -> Streamer
ls_tree (Ref x) repo streamer = mapM_ streamer =<< pipeNullSplit params repo
where
params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]