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