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
|
@ -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
|
||||||
|
|
|
@ -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
49
Git/UpdateIndex.hs
Normal 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]
|
Loading…
Reference in a new issue