{-# LANGUAGE UndecidableInstances, StandaloneDeriving #-}
module Darcs.Patch.Rebase.Container
    ( Suspended(..)
    , countToEdit, simplifyPush, simplifyPushes
    , addFixupsToSuspended, removeFixupsFromSuspended
    ) where

import Prelude ()
import Darcs.Prelude

import Darcs.Patch.Conflict ( Conflict(..), CommuteNoConflicts(..) )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Format ( PatchListFormat(..) )
import Darcs.Patch.Invert ( invert )
import Darcs.Patch.Named ( Named )
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Show ( ShowPatch(..) )
import Darcs.Patch.Prim ( PrimPatchBase(..), FromPrim(..), FromPrim(..) )
import Darcs.Patch.Read ( bracketedFL )
import Darcs.Patch.Rebase.Fixup ( RebaseFixup(..), namedToFixups )
import Darcs.Patch.Rebase.Item ( RebaseItem(..) )
import qualified Darcs.Patch.Rebase.Item as Item ( countToEdit, simplifyPush, simplifyPushes )
import Darcs.Patch.Repair ( Check(..), Repair(..), RepairToFL(..) )
import Darcs.Patch.Show ( ShowPatchBasic(..) )
import Darcs.Patch.ReadMonads ( lexString, myLex' )
import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed
import Darcs.Patch.Witnesses.Show
    ( Show1(..), Show2(..)
    , ShowDict(ShowDictClass)
    )
import Darcs.Util.Printer ( vcat, text, blueText, ($$), (<+>) )
import qualified Darcs.Util.Diff as D ( DiffAlgorithm(MyersDiff) )

import Control.Applicative ( (<|>) )
import Control.Arrow ( (***), second )
import Control.Monad ( when )
import Data.Maybe ( catMaybes )
import qualified Data.ByteString.Char8 as BC ( pack )


-- TODO: move some of the docs of types to individual constructors
-- once http://trac.haskell.org/haddock/ticket/43 is fixed.

-- |A patch that lives in a repository where a rebase is in
-- progress. Such a repository will consist of @Normal@ patches
-- along with exactly one @Suspended@ patch.
--
-- Most rebase operations will require the @Suspended@ patch
-- to be at the end of the repository.
--
-- @Normal@ represents a normal patch within a respository where a
-- rebase is in progress. @Normal p@ is given the same on-disk
-- representation as @p@, so a repository can be switched into
-- and out of rebasing mode simply by adding or removing a
-- @Suspended@ patch and setting the appropriate format flag.
--
-- The single @Suspended@ patch contains the entire rebase
-- state, in the form of 'RebaseItem's.
--
-- Note that the witnesses are such that the @Suspended@
-- patch has no effect on the context of the rest of the
-- repository; in a sense the patches within it are
-- dangling off to one side from the main repository.
--
-- See Note [Rebase representation] in the 'Darcs.Patch.Rebase' for
-- a discussion of the design choice to embed the rebase state in a
-- single patch.
data Suspended p wX wY where
    Items :: FL (RebaseItem p) wX wY -> Suspended p wX wX

deriving instance (Show2 p, Show2 (PrimOf p)) => Show (Suspended p wX wY)

instance (Show2 p, Show2 (PrimOf p)) => Show1 (Suspended p wX) where
    showDict1 :: ShowDict (Suspended p wX wX)
showDict1 = ShowDict (Suspended p wX wX)
forall a. Show a => ShowDict a
ShowDictClass

instance (Show2 p, Show2 (PrimOf p)) => Show2 (Suspended p) where
    showDict2 :: ShowDict (Suspended p wX wY)
showDict2 = ShowDict (Suspended p wX wY)
forall a. Show a => ShowDict a
ShowDictClass

instance (PrimPatchBase p, PatchInspect p) => PatchInspect (Suspended p) where
  listTouchedFiles :: Suspended p wX wY -> [String]
listTouchedFiles (Items ps :: FL (RebaseItem p) wX wY
ps) = FL (RebaseItem p) wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles FL (RebaseItem p) wX wY
ps
  hunkMatches :: (ByteString -> Bool) -> Suspended p wX wY -> Bool
hunkMatches f :: ByteString -> Bool
f (Items ps :: FL (RebaseItem p) wX wY
ps) = (ByteString -> Bool) -> FL (RebaseItem p) wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f FL (RebaseItem p) wX wY
ps

instance Effect (Suspended p) where
  effect :: Suspended p wX wY -> FL (PrimOf (Suspended p)) wX wY
effect (Items _) = FL (PrimOf (Suspended p)) wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

instance Conflict p => Conflict (Suspended p) where
   resolveConflicts :: Suspended p wX wY -> [[Sealed (FL (PrimOf (Suspended p)) wY)]]
resolveConflicts _ = []
   conflictedEffect :: Suspended p wX wY -> [IsConflictedPrim (PrimOf (Suspended p))]
conflictedEffect _ = []

instance Apply (Suspended p) where
   type ApplyState (Suspended p) = ApplyState p
   apply :: Suspended p wX wY -> m ()
apply _ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance (PrimPatchBase p, PatchListFormat p, ShowPatchBasic p) => ShowPatchBasic (Suspended p) where
   showPatch :: ShowPatchFor -> Suspended p wX wY -> Doc
showPatch f :: ShowPatchFor
f (Items ps :: FL (RebaseItem p) wX wY
ps)
       = String -> Doc
blueText "rebase" Doc -> Doc -> Doc
<+> String -> Doc
text "0.0" Doc -> Doc -> Doc
<+> String -> Doc
blueText "{"
         Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((forall wW wZ. RebaseItem p wW wZ -> Doc)
-> FL (RebaseItem p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> RebaseItem p wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f) FL (RebaseItem p) wX wY
ps)
         Doc -> Doc -> Doc
$$ String -> Doc
blueText "}"

instance (PrimPatchBase p, PatchListFormat p, Apply p, CommuteNoConflicts p, Conflict p, IsHunk p, ShowPatch p) => ShowPatch (Suspended p) where
   summary :: Suspended p wX wY -> Doc
summary (Items ps :: FL (RebaseItem p) wX wY
ps) = FL (RebaseItem p) wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => FL p wX wY -> Doc
summaryFL FL (RebaseItem p) wX wY
ps
   summaryFL :: FL (Suspended p) wX wY -> Doc
summaryFL ps :: FL (Suspended p) wX wY
ps = [Doc] -> Doc
vcat ((forall wX wY. Suspended p wX wY -> Doc)
-> FL (Suspended p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wX wY. Suspended p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
summary FL (Suspended p) wX wY
ps)

instance PrimPatchBase p => PrimPatchBase (Suspended p) where
   type PrimOf (Suspended p) = PrimOf p

instance (PrimPatchBase p, PatchListFormat p, ReadPatch p) => ReadPatch (Suspended p) where
   readPatch' :: m (Sealed (Suspended p wX))
readPatch' =
    do ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
lexString (String -> ByteString
BC.pack "rebase")
       ByteString
version <- m ByteString
forall (m :: * -> *). ParserM m => m ByteString
myLex'
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
version ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= String -> ByteString
BC.pack "0.0") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "can't handle rebase version " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
version
       (ByteString -> m ()
forall (m :: * -> *). ParserM m => ByteString -> m ()
lexString (String -> ByteString
BC.pack "{}") m () -> m (Sealed (Suspended p wX)) -> m (Sealed (Suspended p wX))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sealed (Suspended p wX) -> m (Sealed (Suspended p wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Suspended p wX wX -> Sealed (Suspended p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
seal (FL (RebaseItem p) wX wX -> Suspended p wX wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseItem p) wX wY -> Suspended p wX wX
Items FL (RebaseItem p) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)))
         m (Sealed (Suspended p wX))
-> m (Sealed (Suspended p wX)) -> m (Sealed (Suspended p wX))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
         ((forall wX. FL (RebaseItem p) wX wX -> Sealed (Suspended p wX))
-> Sealed (FL (RebaseItem p) wX) -> Sealed (Suspended p wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (Suspended p wX wX -> Sealed (Suspended p wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (Suspended p wX wX -> Sealed (Suspended p wX))
-> (FL (RebaseItem p) wX wX -> Suspended p wX wX)
-> FL (RebaseItem p) wX wX
-> Sealed (Suspended p wX)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL (RebaseItem p) wX wX -> Suspended p wX wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseItem p) wX wY -> Suspended p wX wX
Items) (Sealed (FL (RebaseItem p) wX) -> Sealed (Suspended p wX))
-> m (Sealed (FL (RebaseItem p) wX)) -> m (Sealed (Suspended p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wY. m (Sealed (RebaseItem p wY)))
-> Char -> Char -> m (Sealed (FL (RebaseItem p) wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
ParserM m =>
(forall wY. m (Sealed (p wY)))
-> Char -> Char -> m (Sealed (FL p wX))
bracketedFL forall wY. m (Sealed (RebaseItem p wY))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch' '{' '}')

instance Check p => Check (Suspended p) where
   isInconsistent :: Suspended p wX wY -> Maybe Doc
isInconsistent (Items ps :: FL (RebaseItem p) wX wY
ps) =
       case [Maybe Doc] -> [Doc]
forall a. [Maybe a] -> [a]
catMaybes ((forall wW wZ. RebaseItem p wW wZ -> Maybe Doc)
-> FL (RebaseItem p) wX wY -> [Maybe Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. RebaseItem p wW wZ -> Maybe Doc
forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent FL (RebaseItem p) wX wY
ps) of
         [] -> Maybe Doc
forall a. Maybe a
Nothing
         xs :: [Doc]
xs -> Doc -> Maybe Doc
forall a. a -> Maybe a
Just ([Doc] -> Doc
vcat [Doc]
xs)

instance Repair (Suspended p) where
   applyAndTryToFix :: Suspended p wX wY -> m (Maybe (String, Suspended p wX wY))
applyAndTryToFix (Items ps :: FL (RebaseItem p) wX wY
ps) =
   -- TODO: ideally we would apply ps in a sandbox to check the individual patches
   -- are consistent with each other.
       Maybe (String, Suspended p wX wY)
-> m (Maybe (String, Suspended p wX wY))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, Suspended p wX wY)
 -> m (Maybe (String, Suspended p wX wY)))
-> (Maybe ([String], FL (RebaseItem p) wX wY)
    -> Maybe (String, Suspended p wX wY))
-> Maybe ([String], FL (RebaseItem p) wX wY)
-> m (Maybe (String, Suspended p wX wY))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String], FL (RebaseItem p) wX wY)
 -> (String, Suspended p wX wY))
-> Maybe ([String], FL (RebaseItem p) wX wY)
-> Maybe (String, Suspended p wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> String
unlines ([String] -> String)
-> (FL (RebaseItem p) wX wY -> Suspended p wX wX)
-> ([String], FL (RebaseItem p) wX wY)
-> (String, Suspended p wX wX)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** FL (RebaseItem p) wX wY -> Suspended p wX wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseItem p) wX wY -> Suspended p wX wX
Items) (Maybe ([String], FL (RebaseItem p) wX wY)
 -> m (Maybe (String, Suspended p wX wY)))
-> Maybe ([String], FL (RebaseItem p) wX wY)
-> m (Maybe (String, Suspended p wX wY))
forall a b. (a -> b) -> a -> b
$ FL (RebaseItem p) wX wY
-> Maybe ([String], FL (RebaseItem p) wX wY)
forall (p :: * -> * -> *) wX wY.
RepairInternal p =>
p wX wY -> Maybe ([String], p wX wY)
repairInternal FL (RebaseItem p) wX wY
ps

instance RepairToFL (Suspended p) where
   applyAndTryToFixFL :: Suspended p wX wY -> m (Maybe (String, FL (Suspended p) wX wY))
applyAndTryToFixFL s :: Suspended p wX wY
s = ((String, Suspended p wX wY) -> (String, FL (Suspended p) wX wY))
-> Maybe (String, Suspended p wX wY)
-> Maybe (String, FL (Suspended p) wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Suspended p wX wY -> FL (Suspended p) wX wY)
-> (String, Suspended p wX wY) -> (String, FL (Suspended p) wX wY)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Suspended p wX wY -> FL (Suspended p) wX wY)
 -> (String, Suspended p wX wY) -> (String, FL (Suspended p) wX wY))
-> (Suspended p wX wY -> FL (Suspended p) wX wY)
-> (String, Suspended p wX wY)
-> (String, FL (Suspended p) wX wY)
forall a b. (a -> b) -> a -> b
$ (Suspended p wX wY
-> FL (Suspended p) wY wY -> FL (Suspended p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (Suspended p) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)) (Maybe (String, Suspended p wX wY)
 -> Maybe (String, FL (Suspended p) wX wY))
-> m (Maybe (String, Suspended p wX wY))
-> m (Maybe (String, FL (Suspended p) wX wY))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Suspended p wX wY -> m (Maybe (String, Suspended p wX wY))
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Repair p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, p wX wY))
applyAndTryToFix Suspended p wX wY
s

-- Just repair the internals of the patch, without applying it to anything
-- or checking against an external context.
-- Included for the internal implementation of applyAndTryToFixFL for Rebasing,
-- consider either generalising it for use everywhere, or removing once
-- the implementation works in a sandbox and thus can use the "full" Repair on the
-- contained patches.
class RepairInternalFL p where
   repairInternalFL :: p wX wY -> Maybe ([String], FL p wX wY)

class RepairInternal p where
   repairInternal :: p wX wY -> Maybe ([String], p wX wY)

instance RepairInternalFL p => RepairInternal (FL p) where
   repairInternal :: FL p wX wY -> Maybe ([String], FL p wX wY)
repairInternal NilFL = Maybe ([String], FL p wX wY)
forall a. Maybe a
Nothing
   repairInternal (x :: p wX wY
x :>: ys :: FL p wY wY
ys) =
     case (p wX wY -> Maybe ([String], FL p wX wY)
forall (p :: * -> * -> *) wX wY.
RepairInternalFL p =>
p wX wY -> Maybe ([String], FL p wX wY)
repairInternalFL p wX wY
x, FL p wY wY -> Maybe ([String], FL p wY wY)
forall (p :: * -> * -> *) wX wY.
RepairInternal p =>
p wX wY -> Maybe ([String], p wX wY)
repairInternal FL p wY wY
ys) of
       (Nothing      , Nothing)        -> Maybe ([String], FL p wX wY)
forall a. Maybe a
Nothing
       (Just (e :: [String]
e, rxs :: FL p wX wY
rxs), Nothing)        -> ([String], FL p wX wY) -> Maybe ([String], FL p wX wY)
forall a. a -> Maybe a
Just ([String]
e      , FL p wX wY
rxs FL p wX wY -> FL p wY wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL p wY wY
ys )
       (Nothing      , Just (e' :: [String]
e', rys :: FL p wY wY
rys)) -> ([String], FL p wX wY) -> Maybe ([String], FL p wX wY)
forall a. a -> Maybe a
Just ([String]
e'     , p wX wY
x   p wX wY -> FL p wY wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wY wY
rys)
       (Just (e :: [String]
e, rxs :: FL p wX wY
rxs), Just (e' :: [String]
e', rys :: FL p wY wY
rys)) -> ([String], FL p wX wY) -> Maybe ([String], FL p wX wY)
forall a. a -> Maybe a
Just ([String]
e [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
e', FL p wX wY
rxs FL p wX wY -> FL p wY wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL p wY wY
rys)

instance RepairInternalFL (RebaseItem p) where
   repairInternalFL :: RebaseItem p wX wY -> Maybe ([String], FL (RebaseItem p) wX wY)
repairInternalFL (ToEdit _) = Maybe ([String], FL (RebaseItem p) wX wY)
forall a. Maybe a
Nothing
   repairInternalFL (Fixup p :: RebaseFixup p wX wY
p) = (([String], FL (RebaseFixup p) wX wY)
 -> ([String], FL (RebaseItem p) wX wY))
-> Maybe ([String], FL (RebaseFixup p) wX wY)
-> Maybe ([String], FL (RebaseItem p) wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FL (RebaseFixup p) wX wY -> FL (RebaseItem p) wX wY)
-> ([String], FL (RebaseFixup p) wX wY)
-> ([String], FL (RebaseItem p) wX wY)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((FL (RebaseFixup p) wX wY -> FL (RebaseItem p) wX wY)
 -> ([String], FL (RebaseFixup p) wX wY)
 -> ([String], FL (RebaseItem p) wX wY))
-> (FL (RebaseFixup p) wX wY -> FL (RebaseItem p) wX wY)
-> ([String], FL (RebaseFixup p) wX wY)
-> ([String], FL (RebaseItem p) wX wY)
forall a b. (a -> b) -> a -> b
$ (forall wW wY. RebaseFixup p wW wY -> RebaseItem p wW wY)
-> FL (RebaseFixup p) wX wY -> FL (RebaseItem p) wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. RebaseFixup p wW wY -> RebaseItem p wW wY
forall (p :: * -> * -> *) wX wY.
RebaseFixup p wX wY -> RebaseItem p wX wY
Fixup) (Maybe ([String], FL (RebaseFixup p) wX wY)
 -> Maybe ([String], FL (RebaseItem p) wX wY))
-> Maybe ([String], FL (RebaseFixup p) wX wY)
-> Maybe ([String], FL (RebaseItem p) wX wY)
forall a b. (a -> b) -> a -> b
$ RebaseFixup p wX wY -> Maybe ([String], FL (RebaseFixup p) wX wY)
forall (p :: * -> * -> *) wX wY.
RepairInternalFL p =>
p wX wY -> Maybe ([String], FL p wX wY)
repairInternalFL RebaseFixup p wX wY
p

instance RepairInternalFL (RebaseFixup p) where
   repairInternalFL :: RebaseFixup p wX wY -> Maybe ([String], FL (RebaseFixup p) wX wY)
repairInternalFL (PrimFixup _) = Maybe ([String], FL (RebaseFixup p) wX wY)
forall a. Maybe a
Nothing
   repairInternalFL (NameFixup _) = Maybe ([String], FL (RebaseFixup p) wX wY)
forall a. Maybe a
Nothing

countToEdit :: Suspended p wX wY -> Int
countToEdit :: Suspended p wX wY -> Int
countToEdit (Items ps :: FL (RebaseItem p) wX wY
ps) = FL (RebaseItem p) wX wY -> Int
forall (p :: * -> * -> *) wX wY. FL (RebaseItem p) wX wY -> Int
Item.countToEdit FL (RebaseItem p) wX wY
ps

onSuspended
  :: (forall wZ . FL (RebaseItem p) wY wZ -> Sealed (FL (RebaseItem p) wX))
  -> Suspended p wY wY
  -> Suspended p wX wX
onSuspended :: (forall wZ.
 FL (RebaseItem p) wY wZ -> Sealed (FL (RebaseItem p) wX))
-> Suspended p wY wY -> Suspended p wX wX
onSuspended f :: forall wZ. FL (RebaseItem p) wY wZ -> Sealed (FL (RebaseItem p) wX)
f (Items ps :: FL (RebaseItem p) wY wY
ps) = (forall wX. FL (RebaseItem p) wX wX -> Suspended p wX wX)
-> Sealed (FL (RebaseItem p) wX) -> Suspended p wX wX
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. FL (RebaseItem p) wX wX -> Suspended p wX wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseItem p) wX wY -> Suspended p wX wX
Items (FL (RebaseItem p) wY wY -> Sealed (FL (RebaseItem p) wX)
forall wZ. FL (RebaseItem p) wY wZ -> Sealed (FL (RebaseItem p) wX)
f FL (RebaseItem p) wY wY
ps)

-- |add fixups for the name and effect of a patch to a 'Suspended'
addFixupsToSuspended
  :: (PrimPatchBase p, Commute p, FromPrim p, Effect p)
  => Named p wX wY
  -> Suspended p wY wY
  -> Suspended p wX wX
addFixupsToSuspended :: Named p wX wY -> Suspended p wY wY -> Suspended p wX wX
addFixupsToSuspended p :: Named p wX wY
p = DiffAlgorithm
-> FL (RebaseFixup p) wX wY
-> Suspended p wY wY
-> Suspended p wX wX
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
DiffAlgorithm
-> FL (RebaseFixup p) wX wY
-> Suspended p wY wY
-> Suspended p wX wX
simplifyPushes DiffAlgorithm
D.MyersDiff (Named p wX wY -> FL (RebaseFixup p) wX wY
forall (p :: * -> * -> *) wX wY.
(PrimPatch (PrimOf p), Effect p) =>
Named p wX wY -> FL (RebaseFixup p) wX wY
namedToFixups Named p wX wY
p)

-- |remove fixups (actually, add their inverse) for the name and effect of a patch to a 'Suspended'
removeFixupsFromSuspended
  :: (PrimPatchBase p, Commute p, FromPrim p, Effect p)
  => Named p wX wY
  -> Suspended p wX wX
  -> Suspended p wY wY
removeFixupsFromSuspended :: Named p wX wY -> Suspended p wX wX -> Suspended p wY wY
removeFixupsFromSuspended p :: Named p wX wY
p = DiffAlgorithm
-> FL (RebaseFixup p) wY wX
-> Suspended p wX wX
-> Suspended p wY wY
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
DiffAlgorithm
-> FL (RebaseFixup p) wX wY
-> Suspended p wY wY
-> Suspended p wX wX
simplifyPushes DiffAlgorithm
D.MyersDiff (FL (RebaseFixup p) wX wY -> FL (RebaseFixup p) wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (Named p wX wY -> FL (RebaseFixup p) wX wY
forall (p :: * -> * -> *) wX wY.
(PrimPatch (PrimOf p), Effect p) =>
Named p wX wY -> FL (RebaseFixup p) wX wY
namedToFixups Named p wX wY
p))

simplifyPush
  :: (PrimPatchBase p, Commute p, FromPrim p, Effect p)
  => D.DiffAlgorithm
  -> RebaseFixup p wX wY
  -> Suspended p wY wY
  -> Suspended p wX wX
simplifyPush :: DiffAlgorithm
-> RebaseFixup p wX wY -> Suspended p wY wY -> Suspended p wX wX
simplifyPush da :: DiffAlgorithm
da fixups :: RebaseFixup p wX wY
fixups = (forall wZ.
 FL (RebaseItem p) wY wZ -> Sealed (FL (RebaseItem p) wX))
-> Suspended p wY wY -> Suspended p wX wX
forall (p :: * -> * -> *) wY wX.
(forall wZ.
 FL (RebaseItem p) wY wZ -> Sealed (FL (RebaseItem p) wX))
-> Suspended p wY wY -> Suspended p wX wX
onSuspended (DiffAlgorithm
-> RebaseFixup p wX wY
-> FL (RebaseItem p) wY wZ
-> Sealed (FL (RebaseItem p) wX)
forall (p :: * -> * -> *) wX wY wZ.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
DiffAlgorithm
-> RebaseFixup p wX wY
-> FL (RebaseItem p) wY wZ
-> Sealed (FL (RebaseItem p) wX)
Item.simplifyPush DiffAlgorithm
da RebaseFixup p wX wY
fixups)

simplifyPushes
  :: (PrimPatchBase p, Commute p, FromPrim p, Effect p)
  => D.DiffAlgorithm
  -> FL (RebaseFixup p) wX wY
  -> Suspended p wY wY
  -> Suspended p wX wX
simplifyPushes :: DiffAlgorithm
-> FL (RebaseFixup p) wX wY
-> Suspended p wY wY
-> Suspended p wX wX
simplifyPushes da :: DiffAlgorithm
da fixups :: FL (RebaseFixup p) wX wY
fixups = (forall wZ.
 FL (RebaseItem p) wY wZ -> Sealed (FL (RebaseItem p) wX))
-> Suspended p wY wY -> Suspended p wX wX
forall (p :: * -> * -> *) wY wX.
(forall wZ.
 FL (RebaseItem p) wY wZ -> Sealed (FL (RebaseItem p) wX))
-> Suspended p wY wY -> Suspended p wX wX
onSuspended (DiffAlgorithm
-> FL (RebaseFixup p) wX wY
-> FL (RebaseItem p) wY wZ
-> Sealed (FL (RebaseItem p) wX)
forall (p :: * -> * -> *) wX wY wZ.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
DiffAlgorithm
-> FL (RebaseFixup p) wX wY
-> FL (RebaseItem p) wY wZ
-> Sealed (FL (RebaseItem p) wX)
Item.simplifyPushes DiffAlgorithm
da FL (RebaseFixup p) wX wY
fixups)