diff options
Diffstat (limited to 'Git')
| -rw-r--r-- | Git/UnionMerge.hs | 41 | ||||
| -rw-r--r-- | Git/UpdateIndex.hs | 49 |
2 files changed, 51 insertions, 39 deletions
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 <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] |