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

@ -33,6 +33,7 @@ import qualified Git.Command
import qualified Git.Ref import qualified Git.Ref
import qualified Git.Branch import qualified Git.Branch
import qualified Git.UnionMerge import qualified Git.UnionMerge
import qualified Git.UpdateIndex
import Git.HashObject import Git.HashObject
import qualified Git.Index import qualified Git.Index
import Annex.CatFile import Annex.CatFile
@ -258,8 +259,8 @@ files = withIndexUpdate $ do
- in changes from other branches. - in changes from other branches.
-} -}
genIndex :: Git.Repo -> IO () genIndex :: Git.Repo -> IO ()
genIndex g = Git.UnionMerge.stream_update_index g genIndex g = Git.UpdateIndex.stream_update_index g
[Git.UnionMerge.ls_tree fullname g] [Git.UpdateIndex.ls_tree fullname g]
{- Merges the specified refs into the index. {- Merges the specified refs into the index.
- Any changes staged in the index will be preserved. -} - Any changes staged in the index will be preserved. -}
@ -335,13 +336,13 @@ stageJournal = do
g <- gitRepo g <- gitRepo
withIndex $ liftIO $ do withIndex $ liftIO $ do
h <- hashObjectStart g h <- hashObjectStart g
Git.UnionMerge.stream_update_index g Git.UpdateIndex.stream_update_index g
[genstream (gitAnnexJournalDir g) h fs] [genstream (gitAnnexJournalDir g) h fs]
hashObjectStop h hashObjectStop h
where where
genstream dir h fs streamer = forM_ fs $ \file -> do genstream dir h fs streamer = forM_ fs $ \file -> do
let path = dir </> file let path = dir </> file
sha <- hashFile h path sha <- hashFile h path
_ <- streamer $ Git.UnionMerge.update_index_line _ <- streamer $ Git.UpdateIndex.update_index_line
sha (fileJournal file) sha (fileJournal file)
removeFile path removeFile path

View file

@ -7,11 +7,7 @@
module Git.UnionMerge ( module Git.UnionMerge (
merge, merge,
merge_index, merge_index
update_index,
stream_update_index,
update_index_line,
ls_tree
) where ) where
import System.Cmd.Utils import System.Cmd.Utils
@ -24,8 +20,7 @@ import Git
import Git.Sha import Git.Sha
import Git.CatFile import Git.CatFile
import Git.Command import Git.Command
import Git.UpdateIndex
type Streamer = (String -> IO ()) -> IO ()
{- Performs a union merge between two branches, staging it in the index. {- Performs a union merge between two branches, staging it in the index.
- Any previously staged changes in the index will be lost. - 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 = merge_index h repo bs =
stream_update_index repo $ map (\b -> merge_tree_index b 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. -} {- For merging two trees. -}
merge_trees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer merge_trees :: Ref -> Ref -> CatFileHandle -> Repo -> Streamer
merge_trees (Ref x) (Ref y) h = calc_merge h $ "diff-tree":diff_opts ++ [x, y] 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]