From f1bd72ea546be705334ba8f6d01d9dcfb0c33cf9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 6 Jun 2012 00:03:08 -0400 Subject: factor out generic update-index code from unionmerge code --- Annex/Branch.hs | 9 +++++---- Git/UnionMerge.hs | 41 ++--------------------------------------- Git/UpdateIndex.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 56 insertions(+), 43 deletions(-) create mode 100644 Git/UpdateIndex.hs diff --git a/Annex/Branch.hs b/Annex/Branch.hs index 706522f3b..c8d0719b0 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -33,6 +33,7 @@ import qualified Git.Command import qualified Git.Ref import qualified Git.Branch import qualified Git.UnionMerge +import qualified Git.UpdateIndex import Git.HashObject import qualified Git.Index import Annex.CatFile @@ -258,8 +259,8 @@ files = withIndexUpdate $ do - in changes from other branches. -} genIndex :: Git.Repo -> IO () -genIndex g = Git.UnionMerge.stream_update_index g - [Git.UnionMerge.ls_tree fullname g] +genIndex g = Git.UpdateIndex.stream_update_index g + [Git.UpdateIndex.ls_tree fullname g] {- Merges the specified refs into the index. - Any changes staged in the index will be preserved. -} @@ -335,13 +336,13 @@ stageJournal = do g <- gitRepo withIndex $ liftIO $ do h <- hashObjectStart g - Git.UnionMerge.stream_update_index g + Git.UpdateIndex.stream_update_index g [genstream (gitAnnexJournalDir g) h fs] hashObjectStop h where genstream dir h fs streamer = forM_ fs $ \file -> do let path = dir file sha <- hashFile h path - _ <- streamer $ Git.UnionMerge.update_index_line + _ <- streamer $ Git.UpdateIndex.update_index_line sha (fileJournal file) removeFile path diff --git a/Git/UnionMerge.hs b/Git/UnionMerge.hs index d68bb61ab..9ff820dc9 100644 --- a/Git/UnionMerge.hs +++ b/Git/UnionMerge.hs @@ -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] diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs new file mode 100644 index 000000000..04bc4da5b --- /dev/null +++ b/Git/UpdateIndex.hs @@ -0,0 +1,49 @@ +{- git-update-index library + - + - Copyright 2011, 2012 Joey Hess + - + - 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] -- cgit v1.2.3