summaryrefslogtreecommitdiff
path: root/Git
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-06 00:03:08 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-06 00:10:34 -0400
commitf1bd72ea546be705334ba8f6d01d9dcfb0c33cf9 (patch)
treec14d5f0c567c34265526c23faa4743685d7f7bcd /Git
parent141fa3c94d9b5d9404b8e875b6806f27340f2cf3 (diff)
factor out generic update-index code from unionmerge code
Diffstat (limited to 'Git')
-rw-r--r--Git/UnionMerge.hs41
-rw-r--r--Git/UpdateIndex.hs49
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]