factor out generic update-index code from unionmerge code
This commit is contained in:
parent
141fa3c94d
commit
f1bd72ea54
3 changed files with 56 additions and 43 deletions
|
@ -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]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue