-- Copyright (C) 2003-2004 David Roundy -- -- This program is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2, or (at your option) -- any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; see the file COPYING. If not, write to -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -- Boston, MA 02110-1301, USA. {-# OPTIONS_GHC -cpp -fglasgow-exts #-} {-# LANGUAGE CPP #-} -- , ScopedTypeVariables, TypeOperators #-} #include "gadts.h" module Darcs.Patch.Depends ( get_common_and_uncommon, get_tags_right, get_common_and_uncommon_or_missing, optimize_patchset, deep_optimize_patchset, slightly_optimize_patchset, get_patches_beyond_tag, get_patches_in_tag, patchset_union, patchset_intersection, commute_to_end, ) where import Data.List ( delete, intersect ) import Control.Monad ( liftM2 ) import Control.Monad.Error ( Error(..) ) import Darcs.Patch ( RepoPatch, Named, getdeps, commute, commuteFL, patch2patchinfo, merge ) import Darcs.Witnesses.Ordered ( (:\/:)(..), (:<)(..), (:/\:)(..), (:>)(..), RL(..), FL(..), (+<+), reverseFL, mapFL_FL, mapFL, concatReverseFL, lengthRL, concatRL, reverseRL, mapRL, unsafeCoerceP, EqCheck(..) ) import Darcs.Patch.Permutations ( partitionRL ) import Darcs.Patch.Info ( PatchInfo, human_friendly, is_tag ) import Darcs.Patch.Set ( PatchSet, SealedPatchSet ) import Darcs.Patch.Patchy ( sloppyIdentity ) import Darcs.Hopefully ( PatchInfoAnd, piap, info, n2pia, hopefully, conscientiously, hopefullyM ) import Darcs.ProgressPatches ( progressRL ) import Darcs.Witnesses.Sealed (Sealed(..), FlippedSeal(..), Sealed2(..) , flipSeal, seal, unseal, mapFlipped ) import Printer ( errorDoc, renderString, ($$), text ) #include "impossible.h" get_common_and_uncommon :: RepoPatch p => (PatchSet p C(x),PatchSet p C(y)) -> ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y)) get_common_and_uncommon_or_missing :: RepoPatch p => (PatchSet p C(x),PatchSet p C(y)) -> Either PatchInfo ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y)) get_common_and_uncommon = either missingPatchError id . get_common_and_uncommon_err get_common_and_uncommon_or_missing = either (\(MissingPatch x _) -> Left x) Right . get_common_and_uncommon_err get_common_and_uncommon_err :: RepoPatch p => (PatchSet p C(x),PatchSet p C(y)) -> Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y)) get_common_and_uncommon_err (ps1,ps2) = gcau (optimize_patchset ps1) ps2 {-| with_partial_intersection takes two 'PatchSet's and splits them into a /common/ intersection portion and two sets of patches. The intersection, however, is only lazily determined, so there is no guarantee that all intersecting patches will be included in the intersection 'PatchSet'. This is a pretty efficient function, because it makes use of the already-broken-up nature of 'PatchSet's. 'PatchSet's have the property that if @ (info $ last $ head a) == (info $ last $ head b) @ then @(tail a)@ and @(tail b)@ are identical repositories, and we want to take advantage of this if possible, to avoid reading too many inventories. In the case of --partial repositories or patch bundles, it is crucial that we don't need to read the whole history, since it isn't available. TODO: The length equalising isn't necessarily right. We probably also be thinking about not going past the end of a partial repository, or favour local repository stuff over remote repository stuff. Also, when comparing l1 to l2, we should really be comparing the newly discovered one to /all/ the lasts in the other patch set that we've got so far. -} with_partial_intersection :: forall a p C(x y). RepoPatch p => PatchSet p C(x) -> PatchSet p C(y) -> (FORALL(z) PatchSet p C(z) -> RL (PatchInfoAnd p) C(z x) -> RL (PatchInfoAnd p) C(z y) -> a) -> a with_partial_intersection NilRL ps2 j = j (NilRL:<:NilRL) NilRL (concatRL ps2) with_partial_intersection ps1 NilRL j = j (NilRL:<:NilRL) (concatRL ps1) NilRL with_partial_intersection (NilRL:<:ps1) ps2 j = with_partial_intersection ps1 ps2 j with_partial_intersection ps1 (NilRL:<:ps2) j = with_partial_intersection ps1 ps2 j -- NOTE: symmetry is broken here, so we want the PatchSet with more history -- first! with_partial_intersection ((pi1:<:NilRL):<:common) ((pi2:<:NilRL):<:_) j -- NOTE: Since the patchsets have the same starting but different ending -- we can coerce them. The type system is not aware of our invariant on tags, -- but both pi1 and pi2 should be tags, thus we check they are both identity -- patches. | info pi1 == info pi2 , IsEq <- sloppyIdentity pi1 , IsEq <- sloppyIdentity pi2 = j common NilRL (unsafeCoerceP NilRL) with_partial_intersection (orig_ps1:<:orig_ps1s) (orig_ps2:<:orig_ps2s) j = f (lengthRL orig_ps1) (last $ mapRL info orig_ps1) (orig_ps1:>:NilFL) orig_ps1s (lengthRL orig_ps2) (last $ mapRL info orig_ps2) (orig_ps2:>:NilFL) orig_ps2s where {- Invariants: nx = length $ concatReverseFL psx lx = last $ concatReverseFL psx -} f :: Int -> PatchInfo -> FL (RL (PatchInfoAnd p)) C(r x) -> PatchSet p C(r) -> Int -> PatchInfo -> FL (RL (PatchInfoAnd p)) C(u y) -> PatchSet p C(u) -> a f _n1 l1 ps1 ps1s _n2 l2 ps2 _ps2s | l1 == l2 = j ps1s (unsafeCoerceP (concatReverseFL ps1)) (unsafeCoerceP (concatReverseFL ps2)) f n1 l1 ps1 ps1s n2 l2 ps2 ps2s = case compare n1 n2 of GT -> case dropWhileNilRL ps2s of ps2':<:ps2s' -> f n1 l1 ps1 ps1s (n2 + lengthRL ps2') (last $ mapRL info ps2') (ps2':>:ps2) ps2s' NilRL -> -- We keep going round f so the l1 == l2 case -- has a chance to kick in case dropWhileNilRL ps1s of ps1':<:ps1s' -> f (n1 + lengthRL ps1') (last $ mapRL info ps1') (ps1':>:ps1) ps1s' n2 l2 ps2 ps2s NilRL -> j (NilRL:<:NilRL) (concatReverseFL ps1) (concatReverseFL ps2) _ -> case dropWhileNilRL ps1s of ps1':<:ps1s' -> f (n1 + lengthRL ps1') (last $ mapRL info ps1') (ps1':>:ps1) ps1s' n2 l2 ps2 ps2s NilRL -> -- We keep going round f so the l1 == l2 case -- has a chance to kick in case dropWhileNilRL ps2s of ps2':<:ps2s' -> f n1 l1 ps1 NilRL (n2 + lengthRL ps2') (last $ mapRL info ps2') (ps2':>:ps2) ps2s' NilRL -> j (NilRL:<:NilRL) (concatReverseFL ps1) (concatReverseFL ps2) {-| 'gcau' determines a list of /common/ patches and patches unique to each of the two 'PatchSet's. The list of /common/ patches only needs to include all patches that are not interspersed with the /unique/ patches, but including more patches in the list of /common/ patches doesn't really hurt, except for efficiency considerations. Mostly, we want to access as few elements as possible of the 'PatchSet' list, since those can be expensive (or unavailable). In other words, the /common/ patches need not be minimal, whereas the 'PatchSet's should be minimal for performance reasons. 'PatchSet's have the property that if @ (info $ last $ head a) == (info $ last $ head b) @ then @(tail a)@ and @(tail b)@ are identical repositories, and we want to take advantage of this if possible, to avoid reading too many inventories. In the case of --partial repositories or patch bundles, it is crucial that we don't need to read the whole history, since it isn't available. TODO: The length equalising isn't necessarily right. We probably also be thinking about not going past the end of a partial repository, or favour local repository stuff over remote repo stuff. Also, when comparing l1 to l2, we should really be comparing the newly discovered one to /all/ the lasts in the other patch set that we've got so far. -} gcau :: forall p C(x y). RepoPatch p => PatchSet p C(x) -> PatchSet p C(y) -> Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y)) gcau NilRL ps2 = return ([], NilRL :\/: concatRL ps2) gcau ps1 NilRL = return ([], concatRL ps1 :\/: NilRL) gcau (NilRL:<:ps1) ps2 = gcau ps1 ps2 gcau ps1 (NilRL:<:ps2) = gcau ps1 ps2 gcau ((pi1:<:NilRL):<:_) ((pi2:<:NilRL):<:_) | info pi1 == info pi2 , IsEq <- sloppyIdentity pi1 , IsEq <- sloppyIdentity pi2 = return ([info pi1], NilRL :\/: unsafeCoerceP NilRL) gcau (orig_ps1:<:orig_ps1s) (orig_ps2:<:orig_ps2s) = f (lengthRL orig_ps1) (unseal info $ lastRL orig_ps1) (orig_ps1:>:NilFL) orig_ps1s (lengthRL orig_ps2) (unseal info $ lastRL orig_ps2) (orig_ps2:>:NilFL) orig_ps2s where {- Invariants: nx = lengthRL $ concatReverseFL psx lx = last $ concatReverseFL psx -} f :: Int -> PatchInfo -> FL (RL (PatchInfoAnd p)) C(r x) -> PatchSet p C(r) -> Int -> PatchInfo -> FL (RL (PatchInfoAnd p)) C(u y) -> PatchSet p C(u) -> Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y)) f _n1 l1 ps1 _ps1s _n2 l2 ps2 _ps2s | l1 == l2 = gcau_simple (unsafeCoerceP (concatReverseFL ps1)) (unsafeCoerceP (concatReverseFL ps2)) f n1 l1 ps1 ps1s n2 l2 ps2 ps2s = case n1 `compare` n2 of GT -> case dropWhileNilRL ps2s of ps2':<:ps2s' -> f n1 l1 ps1 ps1s (n2 + lengthRL ps2') (unseal info $ lastRL ps2') (ps2':>:ps2) ps2s' NilRL -> -- We keep going round f so the l1 == l2 case -- has a chance to kick in case dropWhileNilRL ps1s of ps1':<:ps1s' -> f (n1 + lengthRL ps1') (unseal info $ lastRL ps1') (ps1':>:ps1) ps1s' n2 l2 ps2 ps2s NilRL -> gcau_simple (concatReverseFL ps1) (concatReverseFL ps2) _ -> case dropWhileNilRL ps1s of ps1':<:ps1s' -> f (n1 + lengthRL ps1') (unseal info $ lastRL ps1') (ps1':>:ps1) ps1s' n2 l2 ps2 ps2s NilRL -> -- We keep going round f so the l1 == l2 case -- has a chance to kick in case dropWhileNilRL ps2s of ps2':<:ps2s' -> f n1 l1 ps1 NilRL (n2 + lengthRL ps2') (unseal info $ lastRL ps2') (ps2':>:ps2) ps2s' NilRL -> gcau_simple (concatReverseFL ps1) (concatReverseFL ps2) lastRL :: RL a C(x y) -> Sealed (a C(x)) lastRL (a:<:NilRL) = seal a lastRL (_:<:as) = lastRL as lastRL NilRL = bug "lastRL on empty list" dropWhileNilRL :: PatchSet p C(x) -> PatchSet p C(x) dropWhileNilRL (NilRL:<:xs) = dropWhileNilRL xs dropWhileNilRL xs = xs -- | Filters the common elements from @ps1@ and @ps2@ and returns the simplified sequences. gcau_simple :: RepoPatch p => RL (PatchInfoAnd p) C(x y) -- ^ @ps1@ -> RL (PatchInfoAnd p) C(u v) -- ^ @ps2@ -> Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(y v)) gcau_simple ps1 ps2 = do FlippedSeal ex1 <- get_extra common ps1 FlippedSeal ex2 <- get_extra common ps2 let ps1' = filter (`elem` common) $ ps1_info return (ps1', (unsafeCoerceP ex1 :\/: ex2)) where common = ps1_info `intersect` mapRL info ps2 ps1_info = mapRL info ps1 data MissingPatch = MissingPatch !PatchInfo !String instance Error MissingPatch where -- we don't really need those methods noMsg = bug "MissingPatch doesn't define noMsg." -- | Returns a sub-sequence from @patches@, where all the elements of @common@ have -- been removed by commuting them back into the early part of the history. -- -- An informal illustration of this process as it traverses a mixed list of patches -- where C and x denote common patches and extra patches accordingly. Variants of -- patches obtained through commutation are indicated by letters following the -- patch name. -- -- > in: x6 < x5 < C4 < x3 < C2 < x1 skip: extra: -- > in: x5 < C4 < x3 < C2 < x1 skip: extra: x6 -- > in: C4 < x3 < C2 < x1 skip: extra: x5 > x6 -- > in: x3 < C2 < x1 skip: C4 extra: x5 > x6 -- > in: C2 < x1 skip: C4b extra: x3b > x5 > x6 -- > in: x1 skip: C2 > C4b extra: x3b > x5 > x6 -- > in: skip: C2b > C4c extra: x1b > x3b > x5 > x6 -- -- This function is undefined if for any reason we fail to commute an extra -- patch past one of the common ones. Such a failure would indicate that the -- common patch depends on the extra one, contradicting the claim that the -- \"common\" patch is shared with another repository lacking the extra patches. -- Unfortunately, such cases have crept up in practice. Some notable cases can -- be found on the bugtracker as: -- -- * issue27 - different patches with identical patch info; mistaken identity. -- Note how @common@ consists only of a list of 'PatchInfo' which -- we trust to uniquely identify such patches. -- -- * issue1014 - duplicate patches get_extra :: RepoPatch p => [PatchInfo] -- ^ @common@ -> RL (PatchInfoAnd p) C(u x) -- ^ @patches@ -> Either MissingPatch (FlippedSeal (RL (PatchInfoAnd p)) C(y)) get_extra = get_extra_aux (return $ unsafeCoerceP NilFL) where get_extra_aux :: RepoPatch p => Either MissingPatch (FL (Named p) C(x y)) -> [PatchInfo] -> RL (PatchInfoAnd p) C(u x) -> Either MissingPatch (FlippedSeal (RL (PatchInfoAnd p)) C(y)) get_extra_aux _ _ NilRL = return (flipSeal NilRL) get_extra_aux skipped common (hp:<:pps) = if info hp `elem` common && is_tag (info hp) then case getdeps `fmap` hopefullyM hp of Just ds -> get_extra_aux (liftM2 (:>:) ep skipped) (ds++delete (info hp) common) pps Nothing -> get_extra_aux (liftM2 (:>:) ep skipped) (delete (info hp) common) pps else if info hp `elem` common then get_extra_aux (liftM2 (:>:) ep skipped) (delete (info hp) common) pps else do p <- ep skpd <- skipped case commuteFL (p :> skpd) of Right (skipped_patch' :> p') -> do FlippedSeal x <- get_extra_aux (return skipped_patch') common pps return $ flipSeal (info hp `piap` p' :<: x) -- Failure to commute indicates a bug because it means -- that a patch was interspersed between the common -- patches. This should only happen if that patch was -- commuted there. This uses 2 properties: -- 1) commute is its own inverse -- 2) if patches commute in one adjacent context then -- they commute in any context where they are -- adjacent Left (Sealed2 hpc) -> errorDoc $ text "bug in get_extra commuting patches:" $$ text "First patch is:" $$ human_friendly (info hp) $$ text "Second patch is:" $$ human_friendly (info $ n2pia hpc) where ep = case hopefullyM hp of Right p' -> return p' Left e -> Left (MissingPatch (info hp) e) missingPatchError :: MissingPatch -> a missingPatchError (MissingPatch pinfo e) = errorDoc ( text "failed to read patch in get_extra:" $$ human_friendly pinfo $$ text e $$ text "Perhaps this is a 'partial' repository?" ) get_extra_old :: RepoPatch p => [PatchInfo] -> RL (PatchInfoAnd p) C(u x) -> FlippedSeal (RL (PatchInfoAnd p)) C(y) get_extra_old common pps = either missingPatchError id (get_extra common pps) get_patches_beyond_tag :: RepoPatch p => PatchInfo -> PatchSet p C(x) -> FlippedSeal (RL (PatchInfoAnd p)) C(x) get_patches_beyond_tag t ((hp:<:NilRL):<:_) | info hp == t = flipSeal NilRL get_patches_beyond_tag t patchset@((hp:<:ps):<:pps) = if info hp == t then if get_tags_right patchset == [info hp] then flipSeal NilRL -- special case to avoid looking at redundant patches else get_extra_old [t] (concatRL patchset) else mapFlipped (hp:<:) $ get_patches_beyond_tag t (ps:<:pps) get_patches_beyond_tag t (NilRL:<:pps) = get_patches_beyond_tag t pps get_patches_beyond_tag t NilRL = bug $ "tag\n" ++ renderString (human_friendly t) ++ "\nis not in the patchset in get_patches_beyond_tag." -- | @get_patches_in_tag t ps@ returns a 'SealedPatchSet' of all -- patches in @ps@ which are contained in @t@. get_patches_in_tag :: RepoPatch p => PatchInfo -> PatchSet p C(x) -> SealedPatchSet p get_patches_in_tag t pps@((hp:<:NilRL):<:xs) | info hp == t = seal pps | otherwise = get_patches_in_tag t xs get_patches_in_tag t ((hp:<:ps):<:xs) | info hp /= t = get_patches_in_tag t (ps:<:xs) get_patches_in_tag t ((pa:<:ps):<:xs) = gpit thepis (pa:>:NilFL) (ps:<:xs) where thepis = getdeps $ conscientiously (\e -> text "Couldn't read tag" $$ human_friendly t $$ text "" $$ e) pa gpit :: RepoPatch p => [PatchInfo] -> (FL (PatchInfoAnd p)) C(x y) -> PatchSet p C(x) -> SealedPatchSet p gpit _ sofar NilRL = seal $ reverseFL sofar :<: NilRL gpit deps sofar ((hp:<:NilRL):<:xs') | info hp `elem` deps , IsEq <- sloppyIdentity hp = seal $ (reverseFL $ hp :>: sofar) :<: xs' | IsEq <- sloppyIdentity hp = gpit deps sofar xs' gpit deps sofar (NilRL:<:xs') = gpit deps sofar xs' gpit deps sofar ((hp:<:ps'):<:xs') | info hp `elem` deps = let odeps = filter (/=info hp) deps alldeps = if is_tag $ info hp then odeps ++ getdeps (hopefully hp) else odeps in gpit alldeps (hp:>:sofar) (ps':<:xs') | otherwise = gpit deps (commute_by sofar $ hopefully hp) (ps':<:xs') commute_by :: RepoPatch p => FL (PatchInfoAnd p) C(x y) -> (Named p) C(w x) -> FL (PatchInfoAnd p) C(w z) commute_by NilFL _ = unsafeCoerceP NilFL commute_by (hpa:>:xs') p = case commute (p :> hopefully hpa) of Nothing -> bug "Failure commuting patches in commute_by called by gpit!" Just (a' :> p') -> (info hpa `piap` a') :>: commute_by xs' p' get_patches_in_tag t _ = errorDoc $ text "Couldn't read tag" $$ human_friendly t get_tags_right :: RL (RL (PatchInfoAnd p)) C(x y) -> [PatchInfo] get_tags_right NilRL = [] get_tags_right (ps:<:_) = get_tags_r (mapRL info_and_deps ps) where get_tags_r :: [(PatchInfo, Maybe [PatchInfo])] -> [PatchInfo] get_tags_r [] = [] get_tags_r (hp:pps) = case snd hp of Just ds -> fst hp : get_tags_r (drop_tags_r ds pps) Nothing -> fst hp : get_tags_r pps drop_tags_r :: [PatchInfo] -> [(PatchInfo, Maybe [PatchInfo])] -> [(PatchInfo, Maybe [PatchInfo])] drop_tags_r [] pps = pps drop_tags_r _ [] = [] drop_tags_r ds (hp:pps) | fst hp `elem` ds = case snd hp of Just ds' -> drop_tags_r (ds'++delete (fst hp) ds) pps Nothing -> drop_tags_r (delete (fst hp) ds) pps | otherwise = hp : drop_tags_r ds pps info_and_deps :: PatchInfoAnd p C(x y) -> (PatchInfo, Maybe [PatchInfo]) info_and_deps p | is_tag (info p) = (info p, getdeps `fmap` hopefullyM p) | otherwise = (info p, Nothing) deep_optimize_patchset :: PatchSet p C(x) -> PatchSet p C(x) deep_optimize_patchset pss = optimize_patchset (concatRL pss :<: NilRL) optimize_patchset :: PatchSet p C(x) -> PatchSet p C(x) optimize_patchset NilRL = NilRL optimize_patchset (ps:<:pss) = opsp ps +<+ pss where opsp :: RL (PatchInfoAnd p) C(x y) -> RL (RL (PatchInfoAnd p)) C(x y) opsp NilRL = NilRL opsp (hp:<:pps) | is_tag (info hp) && get_tags_right ((hp:<:pps):<:NilRL) == [info hp] = (hp:<:NilRL) :<: opsp pps | otherwise = hp -:- opsp pps (-:-) :: (PatchInfoAnd p) C(x y) -> RL (RL (PatchInfoAnd p)) C(a x) -> RL (RL (PatchInfoAnd p)) C(a y) pp -:- NilRL = (pp:<:NilRL) :<: NilRL pp -:- (p:<:ps) = ((pp:<:p) :<: ps) slightly_optimize_patchset :: PatchSet p C(x) -> PatchSet p C(x) slightly_optimize_patchset NilRL = NilRL slightly_optimize_patchset (ps:<:pss) = sops (progressRL "Optimizing inventory" ps) +<+ pss where sops :: RL (PatchInfoAnd p) C(x y) -> RL (RL (PatchInfoAnd p)) C(x y) sops NilRL = NilRL sops (pinfomp :<: NilRL) = (pinfomp :<: NilRL) :<: NilRL sops (hp:<:pps) | is_tag (info hp) = if get_tags_right ((hp:<:pps):<:NilRL) == [info hp] then (hp:<:NilRL) :<: (pps:<: NilRL) else hp -:- sops (progressRL "Optimizing inventory" pps) | otherwise = hp -:- sops pps commute_to_end :: forall p C(x y). RepoPatch p => FL (Named p) C(x y) -> PatchSet p C(y) -> (FL (Named p) :< RL (RL (PatchInfoAnd p))) C(() x) commute_to_end select from = ctt (mapFL patch2patchinfo select) from NilFL where -- In order to preserve the structure of the original PatchSet, we commute -- the patches we are going to throw away past the patches we plan to keep. -- This puts them at the end of the PatchSet where it is safe to discard them. -- We return all the patches in the PatchSet which have been commuted. ctt :: [PatchInfo] -> PatchSet p C(v) -> FL (Named p) C(v u) -> (FL (Named p) :< RL (RL (PatchInfoAnd p))) C(() x) -- This unsafeCoerceP should be fine, because if we run out of -- patches in the selection the ending context of the second param -- should be x (because we have commute all of the selected sequence, -- with context C(x y), past the elements of the second parameter. -- Unfortunately this is hard to express in the type system while -- using an accumulator to build up the return value. ctt [] ps acc = (unsafeCoerceP acc) :< ps ctt sel (NilRL:<:ps) acc = ctt sel ps acc ctt sel ((hp:<:hps):<:ps) acc | info hp `elem` sel = case commuteFL (hopefully hp :> acc) of Left _ -> bug "patches to commute_to_end does not commutex (1)" Right (acc' :> _) -> ctt (delete (info hp) sel) (hps:<:ps) acc' | otherwise = ctt sel (hps:<:ps) (hopefully hp:>:acc) ctt _ _ _ = bug "patches to commute_to_end does not commutex (2)" patchset_intersection :: RepoPatch p => [SealedPatchSet p] -> SealedPatchSet p patchset_intersection [] = seal (NilRL :<: NilRL) patchset_intersection [x] = x patchset_intersection (Sealed y:ys) = case patchset_intersection ys of Sealed ys' -> with_partial_intersection y ys' $ \common a b -> case mapRL info a `intersect` mapRL info b of morecommon -> case partitionRL (\e -> info e `notElem` morecommon) a of commonps :> _ -> seal $ commonps :<: common patchset_union :: forall p. RepoPatch p => [SealedPatchSet p] -> SealedPatchSet p patchset_union [] = seal (NilRL :<: NilRL) patchset_union [x] = x patchset_union (Sealed y:ys) = case patchset_union ys of Sealed ys' -> with_partial_intersection y ys' f where f :: FORALL(z x y) PatchSet p C(z) -- ^ @common@ -> RL (PatchInfoAnd p) C(z x) -- ^ @a@ -> RL (PatchInfoAnd p) C(z y) -- ^ @b@ -> SealedPatchSet p f common a b = g_s $ gcau_simple a b where g_s :: Either MissingPatch ([PatchInfo],(RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y)) -> SealedPatchSet p g_s (Left e) = missingPatchError e g_s (Right (_, a' :\/: b')) = case (merge_sets (a' :\/: b')) of Sealed a'b' -> seal $ (a'b' +<+ b) :<: common merge_sets :: RepoPatch p => (RL (PatchInfoAnd p) :\/: RL (PatchInfoAnd p)) C(x y) -> Sealed (RL (PatchInfoAnd p) C(y)) merge_sets (l :\/: r) = let pl = mapFL_FL hopefully $ reverseRL l pr = mapFL_FL hopefully $ reverseRL r p2pimp p = patch2patchinfo p `piap` p in case merge (pl:\/: pr) of (_:/\:pl') -> seal $ reverseFL $ mapFL_FL p2pimp pl'