2011-06-21 18:09:06 +00:00
|
|
|
{- git-union-merge library
|
|
|
|
-
|
2015-01-21 16:50:09 +00:00
|
|
|
- Copyright 2011 Joey Hess <id@joeyh.name>
|
2011-06-21 18:09:06 +00:00
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2011-06-21 18:09:06 +00:00
|
|
|
-}
|
|
|
|
|
2011-06-30 17:32:47 +00:00
|
|
|
module Git.UnionMerge (
|
2011-06-21 23:09:20 +00:00
|
|
|
merge,
|
2012-06-08 04:29:39 +00:00
|
|
|
mergeIndex
|
2011-06-21 18:09:06 +00:00
|
|
|
) where
|
|
|
|
|
2020-04-07 17:27:11 +00:00
|
|
|
import qualified Data.ByteString as S
|
2019-11-25 20:18:19 +00:00
|
|
|
import qualified Data.ByteString.Lazy as L
|
2019-01-05 12:06:47 +00:00
|
|
|
import qualified Data.ByteString.Lazy.Char8 as L8
|
2020-04-07 17:27:11 +00:00
|
|
|
import qualified Data.ByteString.Char8 as S8
|
2011-12-12 05:33:02 +00:00
|
|
|
import qualified Data.Set as S
|
2011-06-21 18:09:06 +00:00
|
|
|
|
2011-10-07 17:17:54 +00:00
|
|
|
import Common
|
2011-06-30 17:32:47 +00:00
|
|
|
import Git
|
2011-12-14 19:30:14 +00:00
|
|
|
import Git.Sha
|
2011-11-12 21:45:12 +00:00
|
|
|
import Git.CatFile
|
2011-12-14 19:56:11 +00:00
|
|
|
import Git.Command
|
2012-06-06 04:03:08 +00:00
|
|
|
import Git.UpdateIndex
|
2012-06-06 06:31:31 +00:00
|
|
|
import Git.HashObject
|
|
|
|
import Git.Types
|
2012-06-06 18:26:15 +00:00
|
|
|
import Git.FilePath
|
improve type signatures with a Ref newtype
In git, a Ref can be a Sha, or a Branch, or a Tag. I added type aliases for
those. Note that this does not prevent mixing up of eg, refs and branches
at the type level. Since git really doesn't care, except rare cases like
git update-ref, or git tag -d, that seems ok for now.
There's also a tree-ish, but let's just use Ref for it. A given Sha or Ref
may or may not be a tree-ish, depending on the object type, so there seems
no point in trying to represent it at the type level.
2011-11-16 06:23:34 +00:00
|
|
|
|
2011-06-21 23:52:40 +00:00
|
|
|
{- Performs a union merge between two branches, staging it in the index.
|
|
|
|
- Any previously staged changes in the index will be lost.
|
2011-06-21 21:39:45 +00:00
|
|
|
-
|
2011-12-14 19:30:14 +00:00
|
|
|
- Should be run with a temporary index file configured by useIndex.
|
2011-06-21 21:39:45 +00:00
|
|
|
-}
|
improve type signatures with a Ref newtype
In git, a Ref can be a Sha, or a Branch, or a Tag. I added type aliases for
those. Note that this does not prevent mixing up of eg, refs and branches
at the type level. Since git really doesn't care, except rare cases like
git update-ref, or git tag -d, that seems ok for now.
There's also a tree-ish, but let's just use Ref for it. A given Sha or Ref
may or may not be a tree-ish, depending on the object type, so there seems
no point in trying to represent it at the type level.
2011-11-16 06:23:34 +00:00
|
|
|
merge :: Ref -> Ref -> Repo -> IO ()
|
2011-11-08 19:34:10 +00:00
|
|
|
merge x y repo = do
|
2019-12-27 18:58:10 +00:00
|
|
|
hashhandle <- hashObjectStart True repo
|
2016-03-14 20:23:22 +00:00
|
|
|
ch <- catFileStart repo
|
2012-06-08 04:29:39 +00:00
|
|
|
streamUpdateIndex repo
|
|
|
|
[ lsTree x repo
|
2016-03-14 20:23:22 +00:00
|
|
|
, mergeTrees x y hashhandle ch repo
|
2011-11-16 03:28:01 +00:00
|
|
|
]
|
2016-03-14 20:23:22 +00:00
|
|
|
catFileStop ch
|
|
|
|
hashObjectStop hashhandle
|
2011-10-07 17:17:54 +00:00
|
|
|
|
2012-06-08 04:29:39 +00:00
|
|
|
{- Merges a list of branches into the index. Previously staged changes in
|
2013-01-17 01:31:06 +00:00
|
|
|
- the index are preserved (and participate in the merge).
|
|
|
|
-
|
|
|
|
- update-index is run once per ref in turn, so that each ref is merged on
|
|
|
|
- top of the merge for the previous ref. It would be more efficient, but
|
|
|
|
- harder to calculate a single union merge involving all the refs, as well
|
|
|
|
- as the index.
|
|
|
|
-}
|
2016-03-14 20:23:22 +00:00
|
|
|
mergeIndex :: HashObjectHandle -> CatFileHandle -> Repo -> [Ref] -> IO ()
|
|
|
|
mergeIndex hashhandle ch repo bs = forM_ bs $ \b ->
|
|
|
|
streamUpdateIndex repo [mergeTreeIndex b hashhandle ch repo]
|
2011-06-21 18:09:06 +00:00
|
|
|
|
2011-06-21 23:52:40 +00:00
|
|
|
{- For merging two trees. -}
|
2016-03-14 20:23:22 +00:00
|
|
|
mergeTrees :: Ref -> Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer
|
2020-04-07 17:27:11 +00:00
|
|
|
mergeTrees x y hashhandle ch = doMerge hashhandle ch
|
|
|
|
("diff-tree":diffOpts ++ [fromRef x, fromRef y, "--"])
|
2011-06-21 23:52:40 +00:00
|
|
|
|
|
|
|
{- For merging a single tree into the index. -}
|
2016-03-14 20:23:22 +00:00
|
|
|
mergeTreeIndex :: Ref -> HashObjectHandle -> CatFileHandle -> Repo -> Streamer
|
2020-04-07 17:27:11 +00:00
|
|
|
mergeTreeIndex r hashhandle ch = doMerge hashhandle ch $
|
|
|
|
"diff-index" : diffOpts ++ ["--cached", fromRef r, "--"]
|
2011-06-23 21:38:27 +00:00
|
|
|
|
2012-06-08 04:29:39 +00:00
|
|
|
diffOpts :: [String]
|
|
|
|
diffOpts = ["--raw", "-z", "-r", "--no-renames", "-l0"]
|
2011-06-21 23:52:40 +00:00
|
|
|
|
2012-06-08 04:29:39 +00:00
|
|
|
{- Streams update-index changes to perform a merge,
|
|
|
|
- using git to get a raw diff. -}
|
2016-03-14 20:23:22 +00:00
|
|
|
doMerge :: HashObjectHandle -> CatFileHandle -> [String] -> Repo -> Streamer
|
|
|
|
doMerge hashhandle ch differ repo streamer = do
|
2020-04-07 17:27:11 +00:00
|
|
|
(diff, cleanup) <- pipeNullSplit' (map Param differ) repo
|
2019-12-18 19:57:40 +00:00
|
|
|
go diff
|
2012-10-04 22:47:31 +00:00
|
|
|
void $ cleanup
|
2012-12-13 04:24:19 +00:00
|
|
|
where
|
|
|
|
go [] = noop
|
2020-04-07 17:27:11 +00:00
|
|
|
go (info:file:rest) = mergeFile info file hashhandle ch >>=
|
2012-12-13 04:24:19 +00:00
|
|
|
maybe (go rest) (\l -> streamer l >> go rest)
|
2023-04-10 17:38:14 +00:00
|
|
|
go (_:[]) = giveup $ "parse error " ++ show differ
|
2011-06-22 17:59:42 +00:00
|
|
|
|
|
|
|
{- Given an info line from a git raw diff, and the filename, generates
|
2012-02-09 21:35:36 +00:00
|
|
|
- a line suitable for update-index that union merges the two sides of the
|
2011-06-22 17:59:42 +00:00
|
|
|
- diff. -}
|
2020-04-07 17:27:11 +00:00
|
|
|
mergeFile :: S.ByteString -> RawFilePath -> HashObjectHandle -> CatFileHandle -> IO (Maybe L.ByteString)
|
2020-04-15 17:55:08 +00:00
|
|
|
mergeFile info file hashhandle h = case S8.words info of
|
|
|
|
[_colonmode, _bmode, asha, bsha, _status] ->
|
|
|
|
case filter (`notElem` nullShas) [Ref asha, Ref bsha] of
|
|
|
|
[] -> return Nothing
|
|
|
|
(sha:[]) -> use sha
|
|
|
|
shas -> use
|
|
|
|
=<< either return (hashBlob hashhandle . L8.unlines)
|
|
|
|
=<< calcMerge . zip shas <$> mapM getcontents shas
|
|
|
|
_ -> return Nothing
|
2012-12-13 04:24:19 +00:00
|
|
|
where
|
|
|
|
use sha = return $ Just $
|
2019-12-18 19:57:40 +00:00
|
|
|
updateIndexLine sha TreeFile $ asTopFilePath file
|
2019-01-05 12:06:47 +00:00
|
|
|
-- Get file and split into lines to union merge.
|
|
|
|
-- The encoding of the file is assumed to be either ASCII or utf-8;
|
|
|
|
-- in either case it's safe to split on \n
|
|
|
|
getcontents s = L8.lines <$> catObject h s
|
2011-12-12 04:48:25 +00:00
|
|
|
|
2011-12-12 05:33:02 +00:00
|
|
|
{- Calculates a union merge between a list of refs, with contents.
|
|
|
|
-
|
|
|
|
- When possible, reuses the content of an existing ref, rather than
|
|
|
|
- generating new content.
|
|
|
|
-}
|
2019-01-05 12:06:47 +00:00
|
|
|
calcMerge :: [(Ref, [L8.ByteString])] -> Either Ref [L8.ByteString]
|
2011-12-12 05:33:02 +00:00
|
|
|
calcMerge shacontents
|
2023-03-13 22:55:18 +00:00
|
|
|
| null reusable = Right new
|
|
|
|
| otherwise = Left $ fst $ Prelude.head reusable
|
2012-12-13 04:24:19 +00:00
|
|
|
where
|
2023-03-13 22:55:18 +00:00
|
|
|
reusable = filter (\c -> sorteduniq (snd c) == new) shacontents
|
2012-12-13 04:24:19 +00:00
|
|
|
new = sorteduniq $ concat $ map snd shacontents
|
|
|
|
sorteduniq = S.toList . S.fromList
|