%  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.

\section{Dependencies}
\begin{code}
{-# OPTIONS_GHC -cpp -fglasgow-exts #-}
#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,
                 is_tag,
                 patchset_union, patchset_intersection,
                 commute_to_end,
               ) where
import Data.List ( delete, intersect )
import Control.Monad ( liftM2 )
import Control.Monad.Error (Error(..), MonadError(..))

import Darcs.Patch ( RepoPatch, Named, getdeps, commutex,
                     commuteFL,
                     patch2patchinfo, merge )
import Darcs.Patch.Ordered ( (:\/:)(..), (:<)(..), (:/\:)(..), (:>)(..),
                             RL(..), FL(..),
                             (+<+),
                             reverseFL, mapFL_FL, mapFL, concatReverseFL,
                             lengthRL, concatRL, reverseRL, mapRL,
                             unsafeCoerceP, EqCheck(..) )
import Darcs.Patch.Permutations ( partitionRL )
import Darcs.Patch.Info ( PatchInfo, just_name, human_friendly )
import Darcs.Patch.Set ( PatchSet, SealedPatchSet )
import Darcs.Patch.Patchy ( sloppyIdentity )
import Darcs.Hopefully ( PatchInfoAnd, piap, info,
                         hopefully, conscientiously, hopefullyM )
import Darcs.Progress ( progressRL )
import Darcs.Sealed (Sealed(..), FlippedSeal(..)
                    , flipSeal, seal )
import Printer ( errorDoc, renderString, ($$), text )
#include "impossible.h"
\end{code}

\begin{code}
get_common_and_uncommon :: RepoPatch p => (PatchSet p C(x),PatchSet p C(y)) ->
                           ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (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 (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
\end{code}

\begin{code}
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 (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
get_common_and_uncommon_err (ps1,ps2) = gcau (optimize_patchset ps1) ps2

{-
with_partial_intersection takes two PatchSets 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
PatchSets.

PatchSets 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 PatchSets.  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).

PatchSets 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 (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
gcau NilRL ps2 = return ([], NilRL:<:NilRL :\/: concatRL ps2 :<: NilRL)
gcau ps1 NilRL = return ([], concatRL ps1 :<: NilRL :\/: NilRL:<: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:<:NilRL :\/: unsafeCoerceP (NilRL:<:NilRL))
gcau (orig_ps1:<:orig_ps1s) (orig_ps2:<:orig_ps2s)
 = 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 = 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 (RL (PatchInfoAnd p)) :\/: RL (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 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 -> gcau_simple (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 -> gcau_simple (concatReverseFL ps1) (concatReverseFL ps2)

dropWhileNilRL :: PatchSet p C(x) -> PatchSet p C(x)
dropWhileNilRL (NilRL:<:xs) = dropWhileNilRL xs
dropWhileNilRL xs = xs

gcau_simple :: RepoPatch p => RL (PatchInfoAnd p) C(x y) -> RL (PatchInfoAnd p) C(u v)
            -> Either MissingPatch ([PatchInfo],(RL (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(y v))
gcau_simple ps1 ps2 = do
 FlippedSeal ex1 <- get_extra (return NilFL) common ps1
 FlippedSeal ex2 <- get_extra (return NilFL) common ps2
 let ps1' = filter (`elem` common) $ ps1_info
 return (ps1', (unsafeCoerceP ex1 :<: NilRL) :\/: ex2 :<: NilRL)
  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."

get_extra :: 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 _ _ NilRL = return (flipSeal NilRL)
get_extra skipped common (hp:<:pps) =
    if info hp `elem` common && is_tag (info hp)
    then case getdeps `fmap` hopefullyM hp of
         Just ds -> get_extra (liftM2 (:>:) ep skipped) (ds++delete (info hp) common) pps
         Nothing -> get_extra (liftM2 (:>:) ep skipped) (delete (info hp) common) pps
    else if info hp `elem` common
         then get_extra (liftM2 (:>:) ep skipped) (delete (info hp) common) pps
         else do
            p <- ep
            skpd <- skipped
            case commuteFL (p :> skpd) of
              Just (skipped_patch' :> p') -> do
                  FlippedSeal x <- get_extra (return skipped_patch') common pps
                  return $ flipSeal (info hp `piap` p' :<: x)
              Nothing -> errorDoc $ text "bug in get_extra commuting patch:"
                         $$ human_friendly (info hp)
    where ep = case hopefullyM hp of
               Right p' -> return p'
               Left e -> throwError (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 => FL (Named p) C(x y)
              -> [PatchInfo]
              -> RL (PatchInfoAnd p) C(u x)
              -> FlippedSeal (RL (PatchInfoAnd p)) C(y)
get_extra_old skipped common pps =
    either missingPatchError id (get_extra (return skipped) common pps)
              
\end{code}

\begin{code}
get_patches_beyond_tag :: RepoPatch p => PatchInfo -> PatchSet p C(x) -> FlippedSeal (RL (RL (PatchInfoAnd p))) C(x)
get_patches_beyond_tag t ((hp:<:NilRL):<:_) | info hp == t = flipSeal $ NilRL :<: 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 :<: NilRL -- special case to avoid looking at redundant patches
         else case get_extra_old NilFL [t] (concatRL patchset) of
              FlippedSeal x -> flipSeal $ x :<: NilRL
    else hp `prepend` get_patches_beyond_tag t (ps:<:pps)
 where
 prepend :: (PatchInfoAnd p) C(x y) -> FlippedSeal (RL (RL (PatchInfoAnd p))) C(x) -> FlippedSeal (RL (RL (PatchInfoAnd p))) C(y)
 prepend pp (FlippedSeal NilRL)     = flipSeal $ (pp:<:NilRL) :<: NilRL
 prepend pp (FlippedSeal (p:<:ps')) = flipSeal $ (pp:<:p)     :<: ps'
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 :: 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 commutex (hopefully hpa :< p) of
                Nothing -> bug "Failure commuting patches in commute_by called by gpit!"
                Just (p':<a') -> (info hpa `piap` a') :>: commute_by xs' p'

get_patches_in_tag t _ = errorDoc $ text "Couldn't read tag"
                                 $$ human_friendly t
\end{code}

\begin{code}
is_tag :: PatchInfo -> Bool
is_tag pinfo = take 4 (just_name pinfo) == "TAG "

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)
\end{code}

\begin{code}
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
\end{code}

\begin{code}
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
              Nothing -> bug "patches to commute_to_end does not commutex (1)"
              Just (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)"
\end{code}

\begin{code}
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 `elem` morecommon) a of
                commonps :> _ -> seal $ commonps :<: common

patchset_union :: 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' $
      \common a b ->
        case gcau_simple a b of
        Left e -> missingPatchError e
        Right (_, (a' :<: NilRL) :\/: (b' :<: NilRL)) -> 
          case (merge_sets (a' :\/: b')) of
          Sealed a'b' -> seal $ (a'b' +<+ b) :<: common
        _ -> impossible

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'
\end{code}