-- 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(..), MonadError(..))

import Darcs.Patch ( RepoPatch, Named, getdeps, commutex,
                     commuteFL,
                     patch2patchinfo, merge )
import Darcs.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.Sealed (Sealed(..), FlippedSeal(..), Sealed2(..)
                    , flipSeal, seal, unseal )
import Printer ( errorDoc, renderString, ($$), text )
#include "impossible.h"

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

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 '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 (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) (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 (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 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 (RL (PatchInfoAnd p)) :\/: RL (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 :<: 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."

-- | Returns a sub-sequence from @patches@, where all the elements of @common@ have
-- been removed by commuting them out.
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 -> 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 => [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 (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 [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 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 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

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 (RL (PatchInfoAnd p)) :\/: RL (RL (PatchInfoAnd p))) C(x y))
          -> SealedPatchSet p
      g_s (Left e) = missingPatchError e
      g_s (Right (_, (a' :<: NilRL) :\/: (b' :<: NilRL))) =
          case (merge_sets (a' :\/: b')) of
          Sealed a'b' -> seal $ (a'b' +<+ b) :<: common
      g_s _ = 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'