--  Copyright (C) 2009 Ganesh Sittampalam
--
--  BSD3
module Darcs.Patch.Rebase.Change
    ( RebaseChange(..)
    , toRebaseChanges
    , extractRebaseChange
    , reifyRebaseChange
    , partitionUnconflicted
    , rcToPia
    , WithDroppedDeps(..)
    , WDDNamed
    , commuterIdWDD
    , simplifyPush, simplifyPushes
    , addNamedToRebase
    ) where

import Darcs.Prelude

import Darcs.Patch.Commute ( commuteFL, commuteRL )
import Darcs.Patch.CommuteFn
    ( CommuteFn
    , MergeFn
    , commuterFLId, commuterIdFL
    )
import Darcs.Patch.Debug ( PatchDebug(..) )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Format ( PatchListFormat(..) )
import Darcs.Patch.Ident ( Ident(..), PatchId )
import Darcs.Patch.Info ( PatchInfo, patchinfo, displayPatchInfo )
import Darcs.Patch.Invert ( Invert, invert, invertFL )
import Darcs.Patch.Merge ( selfMerger )
import Darcs.Patch.Named
    ( Named(..)
    , HasDeps(..)
    , infopatch
    , mergerIdNamed
    , patchcontents
    , ShowDepsFormat(..)
    , showDependencies
    )

import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, PatchInfoAndG, n2pia )
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(..), displayPatch )
import Darcs.Patch.Summary
    ( ConflictState(..)
    , IsConflictedPrim(..)
    , Summary(..)
    , plainSummary
    , plainSummaryFL
    )
import Darcs.Patch.FromPrim ( PrimPatchBase(..), FromPrim(..) )
import Darcs.Patch.Permutations ( genCommuteWhatWeCanFL )
import Darcs.Patch.Prim.Class ( PrimPatch )
import Darcs.Patch.Rebase.Fixup
    ( RebaseFixup(..)
    , commuteFixupNamed, commuteNamedFixup
    , flToNamesPrims
    , pushFixupFixup
    )
import Darcs.Patch.Rebase.Name ( RebaseName(..) )
import Darcs.Patch.Rebase.PushFixup
  ( PushFixupFn, dropFixups
  , pushFixupFLMB_FLFLMB
  , pushFixupIdMB_FLFLMB
  , pushFixupIdMB_FLIdFLFL
  )
import Darcs.Patch.RepoPatch ( RepoPatch )
import Darcs.Patch.RepoType ( RepoType(..), RebaseType(..) )
import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatchFor(..), ShowContextPatch(..) )
import Darcs.Patch.Unwind ( Unwound(..), fullUnwind )
import Darcs.Patch.Witnesses.Maybe ( Maybe2(..) )
import Darcs.Patch.Witnesses.Ordered
import Darcs.Patch.Witnesses.Sealed
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import qualified Darcs.Util.Diff as D ( DiffAlgorithm )
import Darcs.Util.IsoDate ( getIsoDateTime )
import Darcs.Util.Parser ( lexString )
import Darcs.Util.Printer ( Doc, ($$), ($+$), (<+>), blueText, redText, empty, vcat )

import qualified Data.ByteString.Char8 as BC ( pack )
import Data.List ( (\\) )
import Data.List.Ordered ( nubSort )
import Data.Maybe ( fromMaybe )

data RebaseChange prim wX wY where
    RC :: FL (RebaseFixup prim) wX wY -> Named prim wY wZ -> RebaseChange prim wX wZ

instance Show2 prim => Show1 (RebaseChange prim wX)

instance Show2 prim => Show2 (RebaseChange prim)

deriving instance Show2 prim => Show (RebaseChange prim wX wY)

-- |Get hold of the 'Named' patch inside a 'RebaseChange' and wrap it in a
-- 'PatchInfoAnd'.
rcToPia :: RebaseChange prim wX wY -> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia :: RebaseChange prim wX wY
-> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toEdit) = PatchInfoAndG ('RepoType 'NoRebase) (Named prim) wY wY
-> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
forall (a :: * -> * -> *) wX wY. a wX wY -> Sealed2 a
Sealed2 (Named prim wY wY
-> PatchInfoAndG ('RepoType 'NoRebase) (Named prim) wY wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia Named prim wY wY
toEdit)

instance PrimPatch prim => PrimPatchBase (RebaseChange prim) where
  type PrimOf (RebaseChange prim) = prim

instance PatchDebug prim => PatchDebug (RebaseChange prim)

instance HasDeps (RebaseChange prim) where
  getdeps :: RebaseChange prim wX wY -> [PatchInfo]
getdeps (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toedit) = Named prim wY wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps Named prim wY wY
toedit

type instance PatchId (RebaseChange prim) = PatchInfo

instance Ident (RebaseChange prim) where
  ident :: RebaseChange prim wX wY -> PatchId (RebaseChange prim)
ident (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toedit) = Named prim wY wY -> PatchId (Named prim)
forall (p :: * -> * -> *) wX wY. Ident p => p wX wY -> PatchId p
ident Named prim wY wY
toedit

instance Apply prim => Apply (RebaseChange prim) where
   type ApplyState (RebaseChange prim) = ApplyState prim
   apply :: RebaseChange prim wX wY -> m ()
apply (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) = FL (RebaseFixup prim) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL (RebaseFixup prim) wX wY
fixups m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Named prim wY wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Named prim wY wY
toedit
   unapply :: RebaseChange prim wX wY -> m ()
unapply (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) = Named prim wY wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply Named prim wY wY
toedit m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FL (RebaseFixup prim) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply FL (RebaseFixup prim) wX wY
fixups

instance Commute prim => Summary (RebaseChange prim) where
  conflictedEffect :: RebaseChange prim wX wY
-> [IsConflictedPrim (PrimOf (RebaseChange prim))]
conflictedEffect (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) =
    case FL (RebaseFixup prim) wX wY -> (:>) (FL RebaseName) (FL prim) wX wY
forall (prim :: * -> * -> *) wX wY.
FL (RebaseFixup prim) wX wY -> (:>) (FL RebaseName) (FL prim) wX wY
flToNamesPrims FL (RebaseFixup prim) wX wY
fixups of
      FL RebaseName wX wZ
_names :> FL prim wZ wY
prims ->
        -- Report on the conflicts we would get if we unsuspended just this patch.
        -- An alternative implementation strategy would be to "force commute"
        -- prims :> toedit and report on the resulting conflicts in toedit.
        -- However this ties us to a specific RepoPatch type which isn't really
        -- needed for a simple calculation like this.
        --
        -- The rebase invariants should mean that 'fixups' (if non-empty) won't
        -- commute with 'changes' as a whole, but here we need to report each individual
        -- prim as conflicted or not, so we try to push the fixups as far through
        -- the individual prims as we can.
        --
        -- Taking the effect also means that any conflicts already present in the
        -- suspended patch won't be reported, but in general such conflicts
        -- are not supported anyway.
        case (forall wA wB.
 (:>) (FL prim) prim wA wB -> Maybe ((:>) prim (FL prim) wA wB))
-> (:>) (FL prim) (FL prim) wZ wY
-> (:>) (FL prim) (FL prim :> FL prim) wZ wY
forall (q :: * -> * -> *) (p :: * -> * -> *) wX wY.
Commute q =>
(forall wA wB. (:>) p q wA wB -> Maybe ((:>) q p wA wB))
-> (:>) p (FL q) wX wY -> (:>) (FL q) (p :> FL q) wX wY
genCommuteWhatWeCanFL (CommuteFn prim prim
-> forall wA wB.
   (:>) (FL prim) prim wA wB -> Maybe ((:>) prim (FL prim) wA wB)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (FL p1) p2
commuterFLId CommuteFn prim prim
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute) (FL prim wZ wY
prims FL prim wZ wY -> FL prim wY wY -> (:>) (FL prim) (FL prim) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wY wY -> FL prim wY wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named prim wY wY
toedit) of
          FL prim wZ wZ
unconflicted :> FL prim wZ wZ
_ :> FL prim wZ wY
conflicted ->
            (forall wW wZ. prim wW wZ -> IsConflictedPrim prim)
-> FL prim wZ wZ -> [IsConflictedPrim prim]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ConflictState -> prim wW wZ -> IsConflictedPrim prim
forall (prim :: * -> * -> *) wX wY.
ConflictState -> prim wX wY -> IsConflictedPrim prim
IsC ConflictState
Okay) FL prim wZ wZ
unconflicted [IsConflictedPrim prim]
-> [IsConflictedPrim prim] -> [IsConflictedPrim prim]
forall a. [a] -> [a] -> [a]
++ (forall wW wZ. prim wW wZ -> IsConflictedPrim prim)
-> FL prim wZ wY -> [IsConflictedPrim prim]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ConflictState -> prim wW wZ -> IsConflictedPrim prim
forall (prim :: * -> * -> *) wX wY.
ConflictState -> prim wX wY -> IsConflictedPrim prim
IsC ConflictState
Conflicted) FL prim wZ wY
conflicted

instance (ShowPatchBasic prim, Invert prim, PatchListFormat prim)
  => ShowPatchBasic (RebaseChange prim) where
  showPatch :: ShowPatchFor -> RebaseChange prim wX wY -> Doc
showPatch ShowPatchFor
ForStorage (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) =
    String -> Doc
blueText String
"rebase-change"
      Doc -> Doc -> Doc
<+> String -> Doc
blueText String
"(" Doc -> Doc -> Doc
$$ ShowPatchFor -> FL (RebaseFixup prim) wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage FL (RebaseFixup prim) wX wY
fixups Doc -> Doc -> Doc
$$ String -> Doc
blueText String
")"
      Doc -> Doc -> Doc
$$ ShowPatchFor -> Named prim wY wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForStorage Named prim wY wY
toedit
  showPatch ShowPatchFor
ForDisplay p :: RebaseChange prim wX wY
p@(RC FL (RebaseFixup prim) wX wY
_ (NamedP PatchInfo
n [PatchInfo]
_ FL prim wY wY
_)) =
    PatchInfo -> Doc
displayPatchInfo PatchInfo
n Doc -> Doc -> Doc
$$ RebaseChange prim wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
(ShowPatchBasic prim, Invert prim) =>
RebaseChange prim wX wY -> Doc
rebaseChangeContent RebaseChange prim wX wY
p

rebaseChangeContent :: (ShowPatchBasic prim, Invert prim)
                   => RebaseChange prim wX wY -> Doc
rebaseChangeContent :: RebaseChange prim wX wY -> Doc
rebaseChangeContent (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
contents) =
  [Doc] -> Doc
vcat ((forall wW wZ. prim wW wZ -> Doc) -> FL prim wY wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ShowPatchFor -> prim wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForDisplay) (Named prim wY wY -> FL prim wY wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named prim wY wY
contents)) Doc -> Doc -> Doc
$+$
  if FL (RebaseFixup prim) wX wY -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL FL (RebaseFixup prim) wX wY
fixups
    then Doc
empty
    else String -> Doc
redText String
"conflicts:" Doc -> Doc -> Doc
$+$ [Doc] -> Doc
vcat ((forall wW wZ. RebaseFixup prim wW wZ -> Doc)
-> RL (RebaseFixup prim) wY wX -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ. RebaseFixup prim wW wZ -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
RebaseFixup p wX wY -> Doc
showFixup (FL (RebaseFixup prim) wX wY -> RL (RebaseFixup prim) wY wX
forall (p :: * -> * -> *) wX wY.
Invert p =>
FL p wX wY -> RL p wY wX
invertFL FL (RebaseFixup prim) wX wY
fixups))
  where
    showFixup :: RebaseFixup p wX wY -> Doc
showFixup (PrimFixup p wX wY
p) = p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch p wX wY
p
    showFixup (NameFixup RebaseName wX wY
n) = RebaseName wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RebaseName wX wY
n

instance PrimPatch prim => ShowPatch (RebaseChange prim) where
    -- This should really just call 'description' on the ToEdit patch,
    -- but that introduces a spurious dependency on Summary (PrimOf p),
    -- because of other methods in the Named instance, so we just inline
    -- the implementation from Named here.
    description :: RebaseChange prim wX wY -> Doc
description (RC FL (RebaseFixup prim) wX wY
_ (NamedP PatchInfo
n [PatchInfo]
_ FL prim wY wY
_)) = PatchInfo -> Doc
displayPatchInfo PatchInfo
n
    -- TODO report conflict indicating name fixups (i.e. dropped deps)
    summary :: RebaseChange prim wX wY -> Doc
summary p :: RebaseChange prim wX wY
p@(RC FL (RebaseFixup prim) wX wY
_ (NamedP PatchInfo
_ [PatchInfo]
ds FL prim wY wY
_)) =
      ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary [PatchInfo]
ds Doc -> Doc -> Doc
$$ RebaseChange prim wX wY -> Doc
forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
e wX wY -> Doc
plainSummary RebaseChange prim wX wY
p
    summaryFL :: FL (RebaseChange prim) wX wY -> Doc
summaryFL FL (RebaseChange prim) wX wY
ps =
      ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary (FL (RebaseChange prim) wX wY -> [PatchInfo]
forall wX wY. FL (RebaseChange prim) wX wY -> [PatchInfo]
getdepsFL FL (RebaseChange prim) wX wY
ps) Doc -> Doc -> Doc
$$ FL (RebaseChange prim) wX wY -> Doc
forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
FL e wX wY -> Doc
plainSummaryFL FL (RebaseChange prim) wX wY
ps
      where
        getdepsFL :: FL (RebaseChange prim) wX wY -> [PatchInfo]
getdepsFL = [PatchInfo] -> [PatchInfo]
forall a. Ord a => [a] -> [a]
nubSort ([PatchInfo] -> [PatchInfo])
-> (FL (RebaseChange prim) wX wY -> [PatchInfo])
-> FL (RebaseChange prim) wX wY
-> [PatchInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[PatchInfo]] -> [PatchInfo]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PatchInfo]] -> [PatchInfo])
-> (FL (RebaseChange prim) wX wY -> [[PatchInfo]])
-> FL (RebaseChange prim) wX wY
-> [PatchInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wZ. RebaseChange prim wW wZ -> [PatchInfo])
-> FL (RebaseChange prim) wX wY -> [[PatchInfo]]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wW wZ. RebaseChange prim wW wZ -> [PatchInfo]
forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps
    content :: RebaseChange prim wX wY -> Doc
content = RebaseChange prim wX wY -> Doc
forall (prim :: * -> * -> *) wX wY.
(ShowPatchBasic prim, Invert prim) =>
RebaseChange prim wX wY -> Doc
rebaseChangeContent

-- TODO this is a dummy instance that does not actually show context
instance (ShowPatchBasic prim, Invert prim, PatchListFormat prim)
  => ShowContextPatch (RebaseChange prim) where
    showContextPatch :: ShowPatchFor -> RebaseChange prim wX wY -> m Doc
showContextPatch ShowPatchFor
f RebaseChange prim wX wY
p = Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> m Doc) -> Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ ShowPatchFor -> RebaseChange prim wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f RebaseChange prim wX wY
p

instance (ReadPatch prim, PatchListFormat prim) => ReadPatch (RebaseChange prim) where
  readPatch' :: Parser (Sealed (RebaseChange prim wX))
readPatch' = do
    ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"rebase-change")
    ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"(")
    Sealed FL (RebaseFixup prim) wX wX
fixups <- Parser (Sealed (FL (RebaseFixup prim) wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
    ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
")")
    Sealed Named prim wX wX
contents <- Parser (Sealed (Named prim wX))
forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
    Sealed (RebaseChange prim wX)
-> Parser (Sealed (RebaseChange prim wX))
forall (m :: * -> *) a. Monad m => a -> m a
return (Sealed (RebaseChange prim wX)
 -> Parser (Sealed (RebaseChange prim wX)))
-> Sealed (RebaseChange prim wX)
-> Parser (Sealed (RebaseChange prim wX))
forall a b. (a -> b) -> a -> b
$ RebaseChange prim wX wX -> Sealed (RebaseChange prim wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (RebaseChange prim wX wX -> Sealed (RebaseChange prim wX))
-> RebaseChange prim wX wX -> Sealed (RebaseChange prim wX)
forall a b. (a -> b) -> a -> b
$ FL (RebaseFixup prim) wX wX
-> Named prim wX wX -> RebaseChange prim wX wX
forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup prim) wX wX
fixups Named prim wX wX
contents

toRebaseChanges
    :: FL (RebaseChange prim) wX wY
    -> FL (PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim)) wX wY
toRebaseChanges :: FL (RebaseChange prim) wX wY
-> FL
     (PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim)) wX wY
toRebaseChanges = (forall wW wY.
 RebaseChange prim wW wY
 -> PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim) wW wY)
-> FL (RebaseChange prim) wX wY
-> FL
     (PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim)) 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.
RebaseChange prim wW wY
-> PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim) wW wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia

instance Commute prim => Commute (RebaseChange prim) where
  commute :: (:>) (RebaseChange prim) (RebaseChange prim) wX wY
-> Maybe ((:>) (RebaseChange prim) (RebaseChange prim) wX wY)
commute (RC FL (RebaseFixup prim) wX wY
fixups1 Named prim wY wZ
edit1 :> RC FL (RebaseFixup prim) wZ wY
fixups2 Named prim wY wY
edit2) = do
    FL (RebaseFixup prim) wY wZ
fixups2' :> Named prim wZ wY
edit1' <- CommuteFn (Named prim) (RebaseFixup prim)
-> (:>) (Named prim) (FL (RebaseFixup prim)) wY wY
-> Maybe ((:>) (FL (RebaseFixup prim)) (Named prim) wY wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL CommuteFn (Named prim) (RebaseFixup prim)
forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>) (Named prim) (RebaseFixup prim) wX wY
-> Maybe ((:>) (RebaseFixup prim) (Named prim) wX wY)
commuteNamedFixup (Named prim wY wZ
edit1 Named prim wY wZ
-> FL (RebaseFixup prim) wZ wY
-> (:>) (Named prim) (FL (RebaseFixup prim)) wY wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wY
fixups2)
    Named prim wZ wZ
edit2' :> Named prim wZ wY
edit1'' <- (:>) (Named prim) (Named prim) wZ wY
-> Maybe ((:>) (Named prim) (Named prim) wZ wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Named prim wZ wY
edit1' Named prim wZ wY
-> Named prim wY wY -> (:>) (Named prim) (Named prim) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wY wY
edit2)
    FL (RebaseFixup prim) wX wZ
fixupsS :> (FL (RebaseFixup prim) wZ wZ
fixups2'' :> Named prim wZ wZ
edit2'') :> FL (RebaseFixup prim) wZ wZ
fixups1' <-
      (:>)
  (FL (RebaseFixup prim))
  ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
  wX
  wZ
-> Maybe
     ((:>)
        (FL (RebaseFixup prim))
        ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
        wX
        wZ)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>)
   (FL (RebaseFixup prim))
   ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
   wX
   wZ
 -> Maybe
      ((:>)
         (FL (RebaseFixup prim))
         ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
         wX
         wZ))
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wZ
-> Maybe
     ((:>)
        (FL (RebaseFixup prim))
        ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
        wX
        wZ)
forall a b. (a -> b) -> a -> b
$ (:>)
  (FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wX wZ
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wZ
forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>)
  (FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wX wY
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wY
pushThrough (FL (RebaseFixup prim) wX wY
fixups1 FL (RebaseFixup prim) wX wY
-> (:>) (FL (RebaseFixup prim)) (Named prim) wY wZ
-> (:>)
     (FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (FL (RebaseFixup prim) wY wZ
fixups2' FL (RebaseFixup prim) wY wZ
-> Named prim wZ wZ
-> (:>) (FL (RebaseFixup prim)) (Named prim) wY wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
edit2'))
    (:>) (RebaseChange prim) (RebaseChange prim) wX wY
-> Maybe ((:>) (RebaseChange prim) (RebaseChange prim) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (RebaseFixup prim) wX wZ
-> Named prim wZ wZ -> RebaseChange prim wX wZ
forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC (FL (RebaseFixup prim) wX wZ
fixupsS FL (RebaseFixup prim) wX wZ
-> FL (RebaseFixup prim) wZ wZ -> FL (RebaseFixup prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup prim) wZ wZ
fixups2'') Named prim wZ wZ
edit2'' RebaseChange prim wX wZ
-> RebaseChange prim wZ wY
-> (:>) (RebaseChange prim) (RebaseChange prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wZ
-> Named prim wZ wY -> RebaseChange prim wZ wY
forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup prim) wZ wZ
fixups1' Named prim wZ wY
edit1'')

instance PatchInspect prim => PatchInspect (RebaseChange prim) where
   listTouchedFiles :: RebaseChange prim wX wY -> [AnchoredPath]
listTouchedFiles (RC FL (RebaseFixup prim) wX wY
fixup Named prim wY wY
toedit) = [AnchoredPath] -> [AnchoredPath]
forall a. Ord a => [a] -> [a]
nubSort (FL (RebaseFixup prim) wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (RebaseFixup prim) wX wY
fixup [AnchoredPath] -> [AnchoredPath] -> [AnchoredPath]
forall a. [a] -> [a] -> [a]
++ Named prim wY wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles Named prim wY wY
toedit)
   hunkMatches :: (ByteString -> Bool) -> RebaseChange prim wX wY -> Bool
hunkMatches ByteString -> Bool
f (RC FL (RebaseFixup prim) wX wY
fixup Named prim wY wY
toedit) = (ByteString -> Bool) -> FL (RebaseFixup prim) wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f FL (RebaseFixup prim) wX wY
fixup Bool -> Bool -> Bool
|| (ByteString -> Bool) -> Named prim wY wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f Named prim wY wY
toedit

-- |Split a list of rebase patches into those that will
-- have conflicts if unsuspended and those that won't.
partitionUnconflicted
    :: Commute prim
    => FL (RebaseChange prim) wX wY
    -> (FL (RebaseChange prim) :> RL (RebaseChange prim)) wX wY
partitionUnconflicted :: FL (RebaseChange prim) wX wY
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wY
partitionUnconflicted = RL (RebaseChange prim) wX wX
-> FL (RebaseChange prim) wX wY
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wY
forall (prim :: * -> * -> *) wX wY wZ.
Commute prim =>
RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc RL (RebaseChange prim) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL

partitionUnconflictedAcc
  :: Commute prim
  => RL (RebaseChange prim) wX wY -> FL (RebaseChange prim) wY wZ
  -> (FL (RebaseChange prim) :> RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc :: RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc RL (RebaseChange prim) wX wY
right FL (RebaseChange prim) wY wZ
NilFL = FL (RebaseChange prim) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (RebaseChange prim) wX wX
-> RL (RebaseChange prim) wX wY
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (RebaseChange prim) wX wY
right
partitionUnconflictedAcc RL (RebaseChange prim) wX wY
right (RebaseChange prim wY wY
p :>: FL (RebaseChange prim) wY wZ
ps) =
   case (:>) (RL (RebaseChange prim)) (RebaseChange prim) wX wY
-> Maybe ((:>) (RebaseChange prim) (RL (RebaseChange prim)) wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteRL (RL (RebaseChange prim) wX wY
right RL (RebaseChange prim) wX wY
-> RebaseChange prim wY wY
-> (:>) (RL (RebaseChange prim)) (RebaseChange prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseChange prim wY wY
p) of
     Just (p' :: RebaseChange prim wX wZ
p'@(RC FL (RebaseFixup prim) wX wY
NilFL Named prim wY wZ
_) :> RL (RebaseChange prim) wZ wY
right')
       -> case RL (RebaseChange prim) wZ wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wZ wZ
forall (prim :: * -> * -> *) wX wY wZ.
Commute prim =>
RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc RL (RebaseChange prim) wZ wY
right' FL (RebaseChange prim) wY wZ
ps of
            FL (RebaseChange prim) wZ wZ
left' :> RL (RebaseChange prim) wZ wZ
right'' -> (RebaseChange prim wX wZ
p' RebaseChange prim wX wZ
-> FL (RebaseChange prim) wZ wZ -> FL (RebaseChange prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseChange prim) wZ wZ
left') FL (RebaseChange prim) wX wZ
-> RL (RebaseChange prim) wZ wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RL (RebaseChange prim) wZ wZ
right''
     Maybe ((:>) (RebaseChange prim) (RL (RebaseChange prim)) wX wY)
_ -> RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
forall (prim :: * -> * -> *) wX wY wZ.
Commute prim =>
RL (RebaseChange prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wZ
partitionUnconflictedAcc (RL (RebaseChange prim) wX wY
right RL (RebaseChange prim) wX wY
-> RebaseChange prim wY wY -> RL (RebaseChange prim) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RebaseChange prim wY wY
p) FL (RebaseChange prim) wY wZ
ps

-- | A patch, together with a list of patch names that it used to depend on,
-- but were lost during the rebasing process. The UI can use this information
-- to report them to the user.
data WithDroppedDeps p wX wY =
    WithDroppedDeps {
        WithDroppedDeps p wX wY -> p wX wY
wddPatch :: p wX wY,
        WithDroppedDeps p wX wY -> [PatchInfo]
wddDependedOn :: [PatchInfo]
    }

noDroppedDeps :: p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps :: p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps p wX wY
p = p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps p wX wY
p []

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

instance Effect p => Effect (WithDroppedDeps p) where
   effect :: WithDroppedDeps p wX wY -> FL (PrimOf (WithDroppedDeps p)) wX wY
effect = p wX wY -> FL (PrimOf p) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect (p wX wY -> FL (PrimOf p) wX wY)
-> (WithDroppedDeps p wX wY -> p wX wY)
-> WithDroppedDeps p wX wY
-> FL (PrimOf p) wX wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithDroppedDeps p wX wY -> p wX wY
forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch

-- |Given a list of rebase items, try to push a new fixup as far as possible into
-- the list as possible, using both commutation and coalescing. If the fixup
-- commutes past all the 'ToEdit' patches then it is dropped entirely.
simplifyPush
  :: PrimPatch prim
  => D.DiffAlgorithm
  -> RebaseFixup prim wX wY
  -> FL (RebaseChange prim) wY wZ
  -> Sealed (FL (RebaseChange prim) wX)
simplifyPush :: DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPush DiffAlgorithm
da RebaseFixup prim wX wY
fixup FL (RebaseChange prim) wY wZ
items = (:>) (FL (RebaseChange prim)) (Maybe2 (RebaseFixup prim)) wX wZ
-> Sealed (FL (RebaseChange prim) wX)
forall (item :: * -> * -> *) (fixup :: * -> * -> *) wX wY.
(:>) item fixup wX wY -> Sealed (item wX)
dropFixups ((:>) (FL (RebaseChange prim)) (Maybe2 (RebaseFixup prim)) wX wZ
 -> Sealed (FL (RebaseChange prim) wX))
-> (:>) (FL (RebaseChange prim)) (Maybe2 (RebaseFixup prim)) wX wZ
-> Sealed (FL (RebaseChange prim) wX)
forall a b. (a -> b) -> a -> b
$ DiffAlgorithm
-> (:>) (RebaseFixup prim) (FL (RebaseChange prim)) wX wZ
-> (:>) (FL (RebaseChange prim)) (Maybe2 (RebaseFixup prim)) wX wZ
forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (FL (RebaseChange prim))
     (FL (RebaseChange prim))
     (Maybe2 (RebaseFixup prim))
pushFixupChanges DiffAlgorithm
da (RebaseFixup prim wX wY
fixup RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> (:>) (RebaseFixup prim) (FL (RebaseChange prim)) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseChange prim) wY wZ
items)

-- |Like 'simplifyPush' but for a list of fixups.
simplifyPushes
  :: PrimPatch prim
  => D.DiffAlgorithm
  -> FL (RebaseFixup prim) wX wY
  -> FL (RebaseChange prim) wY wZ
  -> Sealed (FL (RebaseChange prim) wX)
simplifyPushes :: DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
_ FL (RebaseFixup prim) wX wY
NilFL FL (RebaseChange prim) wY wZ
ps = FL (RebaseChange prim) wY wZ -> Sealed (FL (RebaseChange prim) wY)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (RebaseChange prim) wY wZ
ps
simplifyPushes DiffAlgorithm
da (RebaseFixup prim wX wY
f :>: FL (RebaseFixup prim) wY wY
fs) FL (RebaseChange prim) wY wZ
ps = (forall wX.
 FL (RebaseChange prim) wY wX -> Sealed (FL (RebaseChange prim) wX))
-> Sealed (FL (RebaseChange prim) wY)
-> Sealed (FL (RebaseChange prim) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wX
-> Sealed (FL (RebaseChange prim) wX)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> RebaseFixup prim wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPush DiffAlgorithm
da RebaseFixup prim wX wY
f) (DiffAlgorithm
-> FL (RebaseFixup prim) wY wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wY)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da FL (RebaseFixup prim) wY wY
fs FL (RebaseChange prim) wY wZ
ps)

pushFixupChange
  :: PrimPatch prim
  => D.DiffAlgorithm
  -> PushFixupFn
       (RebaseFixup prim) (RebaseChange prim)
       (RebaseChange prim) (Maybe2 (RebaseFixup prim))
pushFixupChange :: DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (RebaseChange prim)
     (RebaseChange prim)
     (Maybe2 (RebaseFixup prim))
pushFixupChange DiffAlgorithm
da (RebaseFixup prim wX wZ
f1 :> RC FL (RebaseFixup prim) wZ wY
fs2 Named prim wY wY
e)
  = case PushFixupFn
  (RebaseFixup prim)
  (RebaseFixup prim)
  (FL (RebaseFixup prim))
  (Maybe2 (RebaseFixup prim))
-> (:>) (RebaseFixup prim) (FL (RebaseFixup prim)) wX wY
-> (:>) (FL (RebaseFixup prim)) (Maybe2 (RebaseFixup prim)) wX wY
forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item (FL item) (Maybe2 fixup)
-> PushFixupFn fixup (FL item) (FL item) (Maybe2 fixup)
pushFixupFLMB_FLFLMB (DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (RebaseFixup prim)
     (FL (RebaseFixup prim))
     (Maybe2 (RebaseFixup prim))
forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (RebaseFixup prim)
     (FL (RebaseFixup prim))
     (Maybe2 (RebaseFixup prim))
pushFixupFixup DiffAlgorithm
da) (RebaseFixup prim wX wZ
f1 RebaseFixup prim wX wZ
-> FL (RebaseFixup prim) wZ wY
-> (:>) (RebaseFixup prim) (FL (RebaseFixup prim)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wY
fs2) of
      FL (RebaseFixup prim) wX wZ
fs2' :> Maybe2 (RebaseFixup prim) wZ wY
Nothing2 -> FL (RebaseFixup prim) wX wZ
-> Named prim wZ wY -> RebaseChange prim wX wY
forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup prim) wX wZ
fs2' Named prim wY wY
Named prim wZ wY
e RebaseChange prim wX wY
-> Maybe2 (RebaseFixup prim) wY wY
-> (:>) (RebaseChange prim) (Maybe2 (RebaseFixup prim)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Maybe2 (RebaseFixup prim) wY wY
forall (p :: * -> * -> *) wX. Maybe2 p wX wX
Nothing2
      FL (RebaseFixup prim) wX wZ
fs2' :> Just2 RebaseFixup prim wZ wY
f1' ->
        case (:>) (RebaseFixup prim) (Named prim) wZ wY
-> Maybe ((:>) (Named prim) (RebaseFixup prim) wZ wY)
forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>) (RebaseFixup prim) (Named prim) wX wY
-> Maybe ((:>) (Named prim) (RebaseFixup prim) wX wY)
commuteFixupNamed (RebaseFixup prim wZ wY
f1' RebaseFixup prim wZ wY
-> Named prim wY wY -> (:>) (RebaseFixup prim) (Named prim) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wY wY
e) of
          -- The fixup is "stuck" so just attach it here
          Maybe ((:>) (Named prim) (RebaseFixup prim) wZ wY)
Nothing -> FL (RebaseFixup prim) wX wY
-> Named prim wY wY -> RebaseChange prim wX wY
forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC (FL (RebaseFixup prim) wX wZ
fs2' FL (RebaseFixup prim) wX wZ
-> FL (RebaseFixup prim) wZ wY -> FL (RebaseFixup prim) wX wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ RebaseFixup prim wZ wY
f1' RebaseFixup prim wZ wY
-> FL (RebaseFixup prim) wY wY -> FL (RebaseFixup prim) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup prim) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) Named prim wY wY
e RebaseChange prim wX wY
-> Maybe2 (RebaseFixup prim) wY wY
-> (:>) (RebaseChange prim) (Maybe2 (RebaseFixup prim)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Maybe2 (RebaseFixup prim) wY wY
forall (p :: * -> * -> *) wX. Maybe2 p wX wX
Nothing2
          Just (Named prim wZ wZ
e' :> RebaseFixup prim wZ wY
f1'') -> FL (RebaseFixup prim) wX wZ
-> Named prim wZ wZ -> RebaseChange prim wX wZ
forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup prim) wX wZ
fs2' Named prim wZ wZ
e' RebaseChange prim wX wZ
-> Maybe2 (RebaseFixup prim) wZ wY
-> (:>) (RebaseChange prim) (Maybe2 (RebaseFixup prim)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseFixup prim wZ wY -> Maybe2 (RebaseFixup prim) wZ wY
forall (p :: * -> * -> *) wX wY. p wX wY -> Maybe2 p wX wY
Just2 RebaseFixup prim wZ wY
f1''

pushFixupChanges
  :: PrimPatch prim
  =>  D.DiffAlgorithm
  -> PushFixupFn
       (RebaseFixup prim) (FL (RebaseChange prim))
       (FL (RebaseChange prim)) (Maybe2 (RebaseFixup prim))
pushFixupChanges :: DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (FL (RebaseChange prim))
     (FL (RebaseChange prim))
     (Maybe2 (RebaseFixup prim))
pushFixupChanges DiffAlgorithm
da = PushFixupFn
  (RebaseFixup prim)
  (RebaseChange prim)
  (RebaseChange prim)
  (Maybe2 (RebaseFixup prim))
-> PushFixupFn
     (RebaseFixup prim)
     (FL (RebaseChange prim))
     (FL (RebaseChange prim))
     (Maybe2 (RebaseFixup prim))
forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item item (Maybe2 fixup)
-> PushFixupFn fixup (FL item) (FL item) (Maybe2 fixup)
pushFixupIdMB_FLFLMB (DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (RebaseChange prim)
     (RebaseChange prim)
     (Maybe2 (RebaseFixup prim))
forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (RebaseChange prim)
     (RebaseChange prim)
     (Maybe2 (RebaseFixup prim))
pushFixupChange DiffAlgorithm
da)

pushFixupsChange
  :: PrimPatch prim
  => D.DiffAlgorithm
  -> PushFixupFn
       (FL (RebaseFixup prim)) (RebaseChange prim)
       (RebaseChange prim) (FL (RebaseFixup prim))
pushFixupsChange :: DiffAlgorithm
-> PushFixupFn
     (FL (RebaseFixup prim))
     (RebaseChange prim)
     (RebaseChange prim)
     (FL (RebaseFixup prim))
pushFixupsChange DiffAlgorithm
da = PushFixupFn
  (RebaseFixup prim)
  (RebaseChange prim)
  (RebaseChange prim)
  (Maybe2 (RebaseFixup prim))
-> PushFixupFn
     (FL (RebaseFixup prim))
     (RebaseChange prim)
     (RebaseChange prim)
     (FL (RebaseFixup prim))
forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item item (Maybe2 fixup)
-> PushFixupFn (FL fixup) item item (FL fixup)
pushFixupIdMB_FLIdFLFL (DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (RebaseChange prim)
     (RebaseChange prim)
     (Maybe2 (RebaseFixup prim))
forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (RebaseChange prim)
     (RebaseChange prim)
     (Maybe2 (RebaseFixup prim))
pushFixupChange DiffAlgorithm
da)


-- Note, this could probably be rewritten using a generalised commuteWhatWeCanFL from
-- Darcs.Patch.Permutations.
-- |@pushThrough (ps :> (qs :> te))@ tries to commute as much of @ps@ as possible through
-- both @qs@ and @te@, giving @psStuck :> (qs' :> te') :> psCommuted@.
-- Anything that can be commuted ends up in @psCommuted@ and anything that can't goes in
-- @psStuck@.
pushThrough
  :: Commute prim
  => (FL (RebaseFixup prim) :> (FL (RebaseFixup prim) :> Named prim)) wX wY
  -> (FL (RebaseFixup prim) :> (FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim)) wX wY
pushThrough :: (:>)
  (FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wX wY
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wY
pushThrough (FL (RebaseFixup prim) wX wZ
NilFL :> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v) = FL (RebaseFixup prim) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (RebaseFixup prim) wZ wZ
-> (:>)
     (FL (RebaseFixup prim) :> Named prim) (FL (RebaseFixup prim)) wZ wY
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wZ
     wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
-> FL (RebaseFixup prim) wY wY
-> (:>)
     (FL (RebaseFixup prim) :> Named prim) (FL (RebaseFixup prim)) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
pushThrough ((RebaseFixup prim wX wY
p :>: FL (RebaseFixup prim) wY wZ
ps) :> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v) =
  case (:>)
  (FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wY wY
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wY
     wY
forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>)
  (FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wX wY
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wY
pushThrough (FL (RebaseFixup prim) wY wZ
ps FL (RebaseFixup prim) wY wZ
-> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
-> (:>)
     (FL (RebaseFixup prim)) (FL (RebaseFixup prim) :> Named prim) wY wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v) of
   FL (RebaseFixup prim) wY wZ
psS :> v' :: (:>) (FL (RebaseFixup prim)) (Named prim) wZ wZ
v'@(FL (RebaseFixup prim) wZ wZ
qs:>Named prim wZ wZ
te) :> FL (RebaseFixup prim) wZ wY
ps' ->
     (:>)
  (FL (RebaseFixup prim))
  ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
  wX
  wY
-> Maybe
     ((:>)
        (FL (RebaseFixup prim))
        ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
        wX
        wY)
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wY
forall a. a -> Maybe a -> a
fromMaybe ((RebaseFixup prim wX wY
p RebaseFixup prim wX wY
-> FL (RebaseFixup prim) wY wZ -> FL (RebaseFixup prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup prim) wY wZ
psS) FL (RebaseFixup prim) wX wZ
-> (:>)
     (FL (RebaseFixup prim) :> Named prim) (FL (RebaseFixup prim)) wZ wY
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wZ
v' (:>) (FL (RebaseFixup prim)) (Named prim) wZ wZ
-> FL (RebaseFixup prim) wZ wY
-> (:>)
     (FL (RebaseFixup prim) :> Named prim) (FL (RebaseFixup prim)) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wY
ps') (Maybe
   ((:>)
      (FL (RebaseFixup prim))
      ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
      wX
      wY)
 -> (:>)
      (FL (RebaseFixup prim))
      ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
      wX
      wY)
-> Maybe
     ((:>)
        (FL (RebaseFixup prim))
        ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
        wX
        wY)
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wY
forall a b. (a -> b) -> a -> b
$ do
       FL (RebaseFixup prim) wX wZ
psS' :> RebaseFixup prim wZ wZ
p' <- (:>) (RebaseFixup prim) (FL (RebaseFixup prim)) wX wZ
-> Maybe ((:>) (FL (RebaseFixup prim)) (RebaseFixup prim) wX wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RebaseFixup prim wX wY
p RebaseFixup prim wX wY
-> FL (RebaseFixup prim) wY wZ
-> (:>) (RebaseFixup prim) (FL (RebaseFixup prim)) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wY wZ
psS)
       FL (RebaseFixup prim) wZ wZ
qs' :> RebaseFixup prim wZ wZ
p'' <- (:>) (RebaseFixup prim) (FL (RebaseFixup prim)) wZ wZ
-> Maybe ((:>) (FL (RebaseFixup prim)) (RebaseFixup prim) wZ wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RebaseFixup prim wZ wZ
p' RebaseFixup prim wZ wZ
-> FL (RebaseFixup prim) wZ wZ
-> (:>) (RebaseFixup prim) (FL (RebaseFixup prim)) wZ wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wZ
qs)
       Named prim wZ wZ
te' :> RebaseFixup prim wZ wZ
p''' <- (:>) (RebaseFixup prim) (Named prim) wZ wZ
-> Maybe ((:>) (Named prim) (RebaseFixup prim) wZ wZ)
forall (prim :: * -> * -> *) wX wY.
Commute prim =>
(:>) (RebaseFixup prim) (Named prim) wX wY
-> Maybe ((:>) (Named prim) (RebaseFixup prim) wX wY)
commuteFixupNamed (RebaseFixup prim wZ wZ
p'' RebaseFixup prim wZ wZ
-> Named prim wZ wZ -> (:>) (RebaseFixup prim) (Named prim) wZ wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
te)
       (:>)
  (FL (RebaseFixup prim))
  ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
  wX
  wY
-> Maybe
     ((:>)
        (FL (RebaseFixup prim))
        ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
        wX
        wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (RebaseFixup prim) wX wZ
psS' FL (RebaseFixup prim) wX wZ
-> (:>)
     (FL (RebaseFixup prim) :> Named prim) (FL (RebaseFixup prim)) wZ wY
-> (:>)
     (FL (RebaseFixup prim))
     ((FL (RebaseFixup prim) :> Named prim) :> FL (RebaseFixup prim))
     wX
     wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (FL (RebaseFixup prim) wZ wZ
qs' FL (RebaseFixup prim) wZ wZ
-> Named prim wZ wZ
-> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
te') (:>) (FL (RebaseFixup prim)) (Named prim) wZ wZ
-> FL (RebaseFixup prim) wZ wY
-> (:>)
     (FL (RebaseFixup prim) :> Named prim) (FL (RebaseFixup prim)) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (RebaseFixup prim wZ wZ
p''' RebaseFixup prim wZ wZ
-> FL (RebaseFixup prim) wZ wY -> FL (RebaseFixup prim) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup prim) wZ wY
ps'))

type WDDNamed p = WithDroppedDeps (Named p)

mergerIdWDD :: MergeFn p1 p2 -> MergeFn p1 (WithDroppedDeps p2)
mergerIdWDD :: MergeFn p1 p2 -> MergeFn p1 (WithDroppedDeps p2)
mergerIdWDD MergeFn p1 p2
merger (p1 wZ wX
p1 :\/: WithDroppedDeps p2 wZ wY
p2 [PatchInfo]
deps) =
   case (:\/:) p1 p2 wX wY -> (:/\:) p2 p1 wX wY
MergeFn p1 p2
merger (p1 wZ wX
p1 p1 wZ wX -> p2 wZ wY -> (:\/:) p1 p2 wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: p2 wZ wY
p2) of
     p2 wX wZ
p2' :/\: p1 wY wZ
p1' -> p2 wX wZ -> [PatchInfo] -> WithDroppedDeps p2 wX wZ
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps p2 wX wZ
p2' [PatchInfo]
deps WithDroppedDeps p2 wX wZ
-> p1 wY wZ -> (:/\:) (WithDroppedDeps p2) p1 wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: p1 wY wZ
p1'

commuterIdWDD :: CommuteFn p q -> CommuteFn p (WithDroppedDeps q)
commuterIdWDD :: CommuteFn p q -> CommuteFn p (WithDroppedDeps q)
commuterIdWDD CommuteFn p q
commuter (p wX wZ
p :> WithDroppedDeps q wZ wY
q [PatchInfo]
deps)
  = do -- no need to worry about names, because by definition a dropped dep
       -- is a name we no longer have
       -- TODO consistency checking?
       -- TODO consider inverse commutes, e.g. what happens if we wanted to
       -- commute (WithDroppedDeps ... [n] :> AddName n)?
       q wX wZ
q' :> p wZ wY
p' <- (:>) p q wX wY -> Maybe ((:>) q p wX wY)
CommuteFn p q
commuter (p wX wZ
p p wX wZ -> q wZ wY -> (:>) p q wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> q wZ wY
q)
       (:>) (WithDroppedDeps q) p wX wY
-> Maybe ((:>) (WithDroppedDeps q) p wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (q wX wZ -> [PatchInfo] -> WithDroppedDeps q wX wZ
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps q wX wZ
q' [PatchInfo]
deps WithDroppedDeps q wX wZ
-> p wZ wY -> (:>) (WithDroppedDeps q) p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY
p')

-- |Forcibly commute a 'RebaseName' with a patch, dropping any dependencies
-- if necessary and recording them in the patch
forceCommuteName :: (RebaseName :> WDDNamed p) wX wY -> (WDDNamed p :> RebaseName) wX wY
forceCommuteName :: (:>) RebaseName (WDDNamed p) wX wY
-> (:>) (WDDNamed p) RebaseName wX wY
forceCommuteName (AddName PatchInfo
an :> WithDroppedDeps (NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
body) [PatchInfo]
ddeps)
  | PatchInfo
an PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = String -> (:>) (WDDNamed p) RebaseName wX wY
forall a. HasCallStack => String -> a
error String
"impossible case"
  | Bool
otherwise =
      Named p wX Any -> [PatchInfo] -> WithDroppedDeps (Named p) wX Any
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps
        (PatchInfo -> [PatchInfo] -> FL p wX Any -> Named p wX Any
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pn ([PatchInfo]
deps [PatchInfo] -> [PatchInfo] -> [PatchInfo]
forall a. Eq a => [a] -> [a] -> [a]
\\ [PatchInfo
an]) (FL p wZ wY -> FL p wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL p wZ wY
body))
        (if PatchInfo
an PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps then PatchInfo
an PatchInfo -> [PatchInfo] -> [PatchInfo]
forall a. a -> [a] -> [a]
: [PatchInfo]
ddeps else [PatchInfo]
ddeps)
      WithDroppedDeps (Named p) wX Any
-> RebaseName Any wY -> (:>) (WDDNamed p) RebaseName wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:>
      PatchInfo -> RebaseName Any wY
forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
an
forceCommuteName (DelName PatchInfo
dn :> p :: WDDNamed p wZ wY
p@(WithDroppedDeps (NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
_body) [PatchInfo]
_ddeps))
  | PatchInfo
dn PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = String -> (:>) (WDDNamed p) RebaseName wX wY
forall a. HasCallStack => String -> a
error String
"impossible case"
  | PatchInfo
dn PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = String -> (:>) (WDDNamed p) RebaseName wX wY
forall a. HasCallStack => String -> a
error String
"impossible case"
  | Bool
otherwise = WDDNamed p wZ wY -> WithDroppedDeps (Named p) wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP WDDNamed p wZ wY
p WithDroppedDeps (Named p) wX Any
-> RebaseName Any wY -> (:>) (WDDNamed p) RebaseName wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfo -> RebaseName Any wY
forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
dn
forceCommuteName (Rename PatchInfo
old PatchInfo
new :> WithDroppedDeps (NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
body) [PatchInfo]
ddeps)
  | PatchInfo
old PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = String -> (:>) (WDDNamed p) RebaseName wX wY
forall a. HasCallStack => String -> a
error String
"impossible case"
  | PatchInfo
new PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = String -> (:>) (WDDNamed p) RebaseName wX wY
forall a. HasCallStack => String -> a
error String
"impossible case"
  | PatchInfo
old PatchInfo -> [PatchInfo] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = String -> (:>) (WDDNamed p) RebaseName wX wY
forall a. HasCallStack => String -> a
error String
"impossible case"
  | Bool
otherwise =
      let newdeps :: [PatchInfo]
newdeps = (PatchInfo -> PatchInfo) -> [PatchInfo] -> [PatchInfo]
forall a b. (a -> b) -> [a] -> [b]
map (\PatchInfo
dep -> if PatchInfo
new PatchInfo -> PatchInfo -> Bool
forall a. Eq a => a -> a -> Bool
== PatchInfo
dep then PatchInfo
old else PatchInfo
dep) [PatchInfo]
deps
      in Named p wX Any -> [PatchInfo] -> WithDroppedDeps (Named p) wX Any
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (PatchInfo -> [PatchInfo] -> FL p wX Any -> Named p wX Any
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pn [PatchInfo]
newdeps (FL p wZ wY -> FL p wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL p wZ wY
body)) [PatchInfo]
ddeps WithDroppedDeps (Named p) wX Any
-> RebaseName Any wY -> (:>) (WDDNamed p) RebaseName wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfo -> PatchInfo -> RebaseName Any wY
forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
old PatchInfo
new

forceCommutePrim :: RepoPatch p
                 => (PrimOf p :> WDDNamed p) wX wY
                 -> (WDDNamed p :> FL (PrimOf p)) wX wY
forceCommutePrim :: (:>) (PrimOf p) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (PrimOf p)) wX wY
forceCommutePrim (PrimOf p wX wZ
p :> WDDNamed p wZ wY
wq) =
    -- rp and irp are not inverses for RepoPatchV3, only their effects are inverse
    let rp :: p wX wZ
rp = PrimOf p wX wZ -> p wX wZ
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromAnonymousPrim PrimOf p wX wZ
p
        irp :: p wZ wX
irp = PrimOf p wZ wX -> p wZ wX
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromAnonymousPrim (PrimOf p wX wZ -> PrimOf p wZ wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimOf p wX wZ
p)
    in case MergeFn p (Named p)
-> (:\/:) p (WDDNamed p) wX wY -> (:/\:) (WDDNamed p) p wX wY
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (WithDroppedDeps p2)
mergerIdWDD (MergeFn p p -> MergeFn p (Named p)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (Named p2)
mergerIdNamed MergeFn p p
forall (p :: * -> * -> *). Merge p => MergeFn p p
selfMerger) (p wZ wX
irp p wZ wX -> WDDNamed p wZ wY -> (:\/:) p (WDDNamed p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: WDDNamed p wZ wY
wq) of
        WithDroppedDeps (Named p) wX wZ
wq' :/\: p wY wZ
irp' -> FL p wX wX
-> WithDroppedDeps (Named p) wX wZ
-> WithDroppedDeps (Named p) wX wZ
forall (p :: * -> * -> *) wX wY wY.
FL p wX wY
-> WithDroppedDeps (Named p) wY wY
-> WithDroppedDeps (Named p) wX wY
prefixWith (p wX wZ
rp p wX wZ -> FL p wZ wX -> FL p wX wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: p wZ wX
irp p wZ wX -> FL p wX wX -> FL p wZ wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) WithDroppedDeps (Named p) wX wZ
wq' WithDroppedDeps (Named p) wX wZ
-> FL (PrimOf p) wZ wY -> (:>) (WDDNamed p) (FL (PrimOf p)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimOf p) wY wZ -> FL (PrimOf p) wZ wY
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (p wY wZ -> FL (PrimOf p) wY wZ
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect p wY wZ
irp')
    where
      -- TODO [V3INTEGRATION]:
      -- This is a hack to adapt forceCommutePrim to the stricter assumptions
      -- made by RepoPatchV3, for which resolveConflicts expects that we can
      -- find each patch we conflict with somewhere in the context.
      -- Force-commuting the fixups with the patch to be edited violates that
      -- assumption. It works for RepoPatchV1/2 because their conflictors are
      -- self-contained i.e. they contain the transitive set of conflicts in
      -- their representation, which is no longer true for RepoPatchV3.
      -- To restore the assumption for RepoPatchV3 we prefix the patches
      -- contained in the 'Named' patch with (rp;irp). The conflictor wq' can
      -- now refer to irp, and the effect of rp will cancel with that of irp
      -- on unsuspend.
      prefixWith :: FL p wX wY
-> WithDroppedDeps (Named p) wY wY
-> WithDroppedDeps (Named p) wX wY
prefixWith FL p wX wY
xs (WithDroppedDeps (NamedP PatchInfo
i [PatchInfo]
ds FL p wY wY
ps) [PatchInfo]
dds) =
          Named p wX wY -> [PatchInfo] -> WithDroppedDeps (Named p) wX wY
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
ds (FL p wX wY
xs 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
ps)) [PatchInfo]
dds

forceCommutes :: RepoPatch p
              => (FL (RebaseFixup (PrimOf p)) :> WDDNamed p) wX wY
              -> (WDDNamed p :> FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes :: (:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes (FL (RebaseFixup (PrimOf p)) wX wZ
NilFL :> WDDNamed p wZ wY
q) = WDDNamed p wZ wY
q WDDNamed p wZ wY
-> FL (RebaseFixup (PrimOf p)) wY wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup (PrimOf p)) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
forceCommutes ((NameFixup RebaseName wX wY
n :>: FL (RebaseFixup (PrimOf p)) wY wZ
ps) :> WDDNamed p wZ wY
q) =
    case (:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wY wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wY wY
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes (FL (RebaseFixup (PrimOf p)) wY wZ
ps FL (RebaseFixup (PrimOf p)) wY wZ
-> WDDNamed p wZ wY
-> (:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wY wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> WDDNamed p wZ wY
q) of
        WDDNamed p wY wZ
q' :> FL (RebaseFixup (PrimOf p)) wZ wY
ps' ->
            case (:>) RebaseName (WDDNamed p) wX wZ
-> (:>) (WDDNamed p) RebaseName wX wZ
forall (p :: * -> * -> *) wX wY.
(:>) RebaseName (WDDNamed p) wX wY
-> (:>) (WDDNamed p) RebaseName wX wY
forceCommuteName (RebaseName wX wY
n RebaseName wX wY
-> WDDNamed p wY wZ -> (:>) RebaseName (WDDNamed p) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> WDDNamed p wY wZ
q') of
                WDDNamed p wX wZ
q'' :> RebaseName wZ wZ
n' -> WDDNamed p wX wZ
q'' WDDNamed p wX wZ
-> FL (RebaseFixup (PrimOf p)) wZ wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (RebaseName wZ wZ -> RebaseFixup (PrimOf p) wZ wZ
forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup RebaseName wZ wZ
n' RebaseFixup (PrimOf p) wZ wZ
-> FL (RebaseFixup (PrimOf p)) wZ wY
-> FL (RebaseFixup (PrimOf p)) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup (PrimOf p)) wZ wY
ps')
forceCommutes ((PrimFixup PrimOf p wX wY
p :>: FL (RebaseFixup (PrimOf p)) wY wZ
ps) :> WDDNamed p wZ wY
q) =
    case (:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wY wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wY wY
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes (FL (RebaseFixup (PrimOf p)) wY wZ
ps FL (RebaseFixup (PrimOf p)) wY wZ
-> WDDNamed p wZ wY
-> (:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wY wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> WDDNamed p wZ wY
q) of
        WDDNamed p wY wZ
q' :> FL (RebaseFixup (PrimOf p)) wZ wY
ps' ->
            case (:>) (PrimOf p) (WDDNamed p) wX wZ
-> (:>) (WDDNamed p) (FL (PrimOf p)) wX wZ
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (PrimOf p) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (PrimOf p)) wX wY
forceCommutePrim (PrimOf p wX wY
p PrimOf p wX wY
-> WDDNamed p wY wZ -> (:>) (PrimOf p) (WDDNamed p) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> WDDNamed p wY wZ
q') of
                WDDNamed p wX wZ
qs'' :> FL (PrimOf p) wZ wZ
p' -> WDDNamed p wX wZ
qs'' WDDNamed p wX wZ
-> FL (RebaseFixup (PrimOf p)) wZ wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> ((forall wW wY. PrimOf p wW wY -> RebaseFixup (PrimOf p) wW wY)
-> FL (PrimOf p) wZ wZ -> FL (RebaseFixup (PrimOf p)) wZ wZ
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. PrimOf p wW wY -> RebaseFixup (PrimOf p) wW wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup FL (PrimOf p) wZ wZ
p' FL (RebaseFixup (PrimOf p)) wZ wZ
-> FL (RebaseFixup (PrimOf p)) wZ wY
-> FL (RebaseFixup (PrimOf p)) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup (PrimOf p)) wZ wY
ps')

fromPrimNamed :: FromPrim p => Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed :: Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed (NamedP PatchInfo
n [PatchInfo]
deps FL (PrimOf p) wX wY
ps) = PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
deps (PatchInfo -> FL (PrimOf p) wX wY -> FL p wX wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> FL p wX wY
fromPrims PatchInfo
n FL (PrimOf p) wX wY
ps)

-- |Turn a selected rebase patch back into a patch we can apply to
-- the main repository, together with residual fixups that need
-- to go back into the rebase state (unless the rebase is now finished).
-- Any fixups associated with the patch will turn into conflicts.
extractRebaseChange
  :: forall p wX wY
   . RepoPatch p
  => D.DiffAlgorithm
  -> FL (RebaseChange (PrimOf p)) wX wY
  -> (FL (WDDNamed p) :> FL (RebaseFixup (PrimOf p))) wX wY
extractRebaseChange :: DiffAlgorithm
-> FL (RebaseChange (PrimOf p)) wX wY
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY
extractRebaseChange DiffAlgorithm
da FL (RebaseChange (PrimOf p)) wX wY
rcs = (:>)
  (FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wX wY
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY
forall wA wB.
(:>)
  (FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wA wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wB
go (FL (RebaseFixup (PrimOf p)) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (RebaseFixup (PrimOf p)) wX wX
-> FL (RebaseChange (PrimOf p)) wX wY
-> (:>)
     (FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseChange (PrimOf p)) wX wY
rcs)
  where
    go
      :: forall wA wB
       . (FL (RebaseFixup (PrimOf p)) :> FL (RebaseChange (PrimOf p))) wA wB
      -> (FL (WDDNamed p) :> FL (RebaseFixup (PrimOf p))) wA wB
    go :: (:>)
  (FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wA wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wB
go (FL (RebaseFixup (PrimOf p)) wA wZ
fixupsIn :> FL (RebaseChange (PrimOf p)) wZ wB
NilFL) = FL (WDDNamed p) wA wA
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (WDDNamed p) wA wA
-> FL (RebaseFixup (PrimOf p)) wA wZ
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup (PrimOf p)) wA wZ
fixupsIn
    go (FL (RebaseFixup (PrimOf p)) wA wZ
fixupsIn :> RebaseChange (PrimOf p) wZ wY
rc :>: FL (RebaseChange (PrimOf p)) wY wB
rest) =
      -- First simplify any fixups coming from previous extract operations.
      -- Note that it's important to start at the front of the list so that
      -- we can do this, as it minimises the conflicts we end up with.
      case DiffAlgorithm
-> (:>)
     (FL (RebaseFixup (PrimOf p))) (RebaseChange (PrimOf p)) wA wY
-> (:>)
     (RebaseChange (PrimOf p)) (FL (RebaseFixup (PrimOf p))) wA wY
forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
     (FL (RebaseFixup prim))
     (RebaseChange prim)
     (RebaseChange prim)
     (FL (RebaseFixup prim))
pushFixupsChange DiffAlgorithm
da (FL (RebaseFixup (PrimOf p)) wA wZ
fixupsIn FL (RebaseFixup (PrimOf p)) wA wZ
-> RebaseChange (PrimOf p) wZ wY
-> (:>)
     (FL (RebaseFixup (PrimOf p))) (RebaseChange (PrimOf p)) wA wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseChange (PrimOf p) wZ wY
rc) of
        -- Now use 'fromPrimNamed' to change the toedit patch from
        -- Named (PrimOf p) that we store in the rebase to Named p
        -- that we store in the repository. Then, wrap it in WithDroppedDeps
        -- so we can track any explicit dependencies that were lost, and
        -- finally force-commute the fixups with this and any other patches we are
        -- unsuspending.
        RC FL (RebaseFixup (PrimOf p)) wA wY
fixups Named (PrimOf p) wY wZ
toedit :> FL (RebaseFixup (PrimOf p)) wZ wY
fixupsOut2 ->
          case (:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wA wZ
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wA wZ
forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wX wY
-> (:>) (WDDNamed p) (FL (RebaseFixup (PrimOf p))) wX wY
forceCommutes (FL (RebaseFixup (PrimOf p)) wA wY
fixups FL (RebaseFixup (PrimOf p)) wA wY
-> WithDroppedDeps (Named p) wY wZ
-> (:>) (FL (RebaseFixup (PrimOf p))) (WDDNamed p) wA wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named p wY wZ -> [PatchInfo] -> WithDroppedDeps (Named p) wY wZ
forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (Named (PrimOf p) wY wZ -> Named p wY wZ
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed Named (PrimOf p) wY wZ
toedit) []) of
            WDDNamed p wA wZ
toedit' :> FL (RebaseFixup (PrimOf p)) wZ wZ
fixupsOut1 ->
              case (:>)
  (FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wZ wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wZ wB
forall wA wB.
(:>)
  (FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wA wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wB
go (FL (RebaseFixup (PrimOf p)) wZ wZ
fixupsOut1 FL (RebaseFixup (PrimOf p)) wZ wZ
-> FL (RebaseFixup (PrimOf p)) wZ wY
-> FL (RebaseFixup (PrimOf p)) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup (PrimOf p)) wZ wY
fixupsOut2 FL (RebaseFixup (PrimOf p)) wZ wY
-> FL (RebaseChange (PrimOf p)) wY wB
-> (:>)
     (FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wZ wB
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseChange (PrimOf p)) wY wB
rest) of
                FL (WDDNamed p) wZ wZ
toedits' :> FL (RebaseFixup (PrimOf p)) wZ wB
fixupsOut -> WDDNamed p wA wZ
toedit' WDDNamed p wA wZ -> FL (WDDNamed p) wZ wZ -> FL (WDDNamed p) wA wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (WDDNamed p) wZ wZ
toedits' FL (WDDNamed p) wA wZ
-> FL (RebaseFixup (PrimOf p)) wZ wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wB
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup (PrimOf p)) wZ wB
fixupsOut

-- signature to be compatible with extractRebaseChange
-- | Like 'extractRebaseChange', but any fixups are "reified" into a separate patch.
reifyRebaseChange
  :: FromPrim p
  => String
  -> FL (RebaseChange (PrimOf p)) wX wY
  -> IO ((FL (WDDNamed p) :> FL (RebaseFixup (PrimOf p))) wX wY)
reifyRebaseChange :: String
-> FL (RebaseChange (PrimOf p)) wX wY
-> IO ((:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY)
reifyRebaseChange String
author FL (RebaseChange (PrimOf p)) wX wY
rs = do
    FL (WDDNamed p) wX wY
res <- FL (FL (WDDNamed p)) wX wY -> FL (WDDNamed p) wX wY
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL (WDDNamed p)) wX wY -> FL (WDDNamed p) wX wY)
-> IO (FL (FL (WDDNamed p)) wX wY) -> IO (FL (WDDNamed p) wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall wW wY.
 RebaseChange (PrimOf p) wW wY -> IO (FL (WDDNamed p) wW wY))
-> FL (RebaseChange (PrimOf p)) wX wY
-> IO (FL (FL (WDDNamed p)) wX wY)
forall (m :: * -> *) (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
Monad m =>
(forall wW wY. a wW wY -> m (b wW wY))
-> FL a wX wZ -> m (FL b wX wZ)
mapFL_FL_M forall wW wY.
RebaseChange (PrimOf p) wW wY -> IO (FL (WDDNamed p) wW wY)
forall (p :: * -> * -> *) wA wB.
FromPrim p =>
RebaseChange (PrimOf p) wA wB -> IO (FL (WDDNamed p) wA wB)
reifyOne FL (RebaseChange (PrimOf p)) wX wY
rs
    (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY
-> IO ((:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (WDDNamed p) wX wY
res FL (WDDNamed p) wX wY
-> FL (RebaseFixup (PrimOf p)) wY wY
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup (PrimOf p)) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
  where
    reifyOne :: FromPrim p => RebaseChange (PrimOf p) wA wB -> IO (FL (WDDNamed p) wA wB)
    reifyOne :: RebaseChange (PrimOf p) wA wB -> IO (FL (WDDNamed p) wA wB)
reifyOne (RC FL (RebaseFixup (PrimOf p)) wA wY
fixups Named (PrimOf p) wY wB
toedit) =
      case FL (RebaseFixup (PrimOf p)) wA wY
-> (:>) (FL RebaseName) (FL (PrimOf p)) wA wY
forall (prim :: * -> * -> *) wX wY.
FL (RebaseFixup prim) wX wY -> (:>) (FL RebaseName) (FL prim) wX wY
flToNamesPrims FL (RebaseFixup (PrimOf p)) wA wY
fixups of
        FL RebaseName wA wZ
names :> FL (PrimOf p) wZ wY
NilFL ->
          FL (WDDNamed p) wA wB -> IO (FL (WDDNamed p) wA wB)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (WDDNamed p) wA wB -> IO (FL (WDDNamed p) wA wB))
-> FL (WDDNamed p) wA wB -> IO (FL (WDDNamed p) wA wB)
forall a b. (a -> b) -> a -> b
$
            (forall wW wY. RebaseName wW wY -> WithDroppedDeps (Named p) wW wY)
-> FL RebaseName wA wZ -> FL (WDDNamed p) wA wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (Named p wW wY -> WithDroppedDeps (Named p) wW wY
forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps (Named p wW wY -> WithDroppedDeps (Named p) wW wY)
-> (RebaseName wW wY -> Named p wW wY)
-> RebaseName wW wY
-> WithDroppedDeps (Named p) wW wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RebaseName wW wY -> Named p wW wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
RebaseName wX wY -> Named p wX wY
mkDummy) FL RebaseName wA wZ
names FL (WDDNamed p) wA wZ
-> FL (WDDNamed p) wZ wB -> FL (WDDNamed p) wA wB
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+
            Named p wY wB -> WithDroppedDeps (Named p) wY wB
forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps (Named (PrimOf p) wY wB -> Named p wY wB
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed Named (PrimOf p) wY wB
toedit) WithDroppedDeps (Named p) wY wB
-> FL (WDDNamed p) wB wB -> FL (WDDNamed p) wY wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
            FL (WDDNamed p) wB wB
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
        FL RebaseName wA wZ
names :> FL (PrimOf p) wZ wY
prims -> do
          Named p wZ wY
n <- String -> FL (PrimOf p) wZ wY -> IO (Named p wZ wY)
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
String -> FL (PrimOf p) wX wY -> IO (Named p wX wY)
mkReified String
author FL (PrimOf p) wZ wY
prims
          FL (WDDNamed p) wA wB -> IO (FL (WDDNamed p) wA wB)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (WDDNamed p) wA wB -> IO (FL (WDDNamed p) wA wB))
-> FL (WDDNamed p) wA wB -> IO (FL (WDDNamed p) wA wB)
forall a b. (a -> b) -> a -> b
$
            (forall wW wY. RebaseName wW wY -> WithDroppedDeps (Named p) wW wY)
-> FL RebaseName wA wZ -> FL (WDDNamed p) wA wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (Named p wW wY -> WithDroppedDeps (Named p) wW wY
forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps (Named p wW wY -> WithDroppedDeps (Named p) wW wY)
-> (RebaseName wW wY -> Named p wW wY)
-> RebaseName wW wY
-> WithDroppedDeps (Named p) wW wY
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RebaseName wW wY -> Named p wW wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
RebaseName wX wY -> Named p wX wY
mkDummy) FL RebaseName wA wZ
names FL (WDDNamed p) wA wZ
-> FL (WDDNamed p) wZ wB -> FL (WDDNamed p) wA wB
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ Named p wZ wY -> WithDroppedDeps (Named p) wZ wY
forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps Named p wZ wY
n WithDroppedDeps (Named p) wZ wY
-> FL (WDDNamed p) wY wB -> FL (WDDNamed p) wZ wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
            Named p wY wB -> WithDroppedDeps (Named p) wY wB
forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps (Named (PrimOf p) wY wB -> Named p wY wB
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed Named (PrimOf p) wY wB
toedit) WithDroppedDeps (Named p) wY wB
-> FL (WDDNamed p) wB wB -> FL (WDDNamed p) wY wB
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
            FL (WDDNamed p) wB wB
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

mkReified :: FromPrim p => String -> FL (PrimOf p) wX wY -> IO (Named p wX wY)
mkReified :: String -> FL (PrimOf p) wX wY -> IO (Named p wX wY)
mkReified String
author FL (PrimOf p) wX wY
ps = do
     let name :: String
name = String
"Reified fixup patch"
     let desc :: [a]
desc = []
     String
date <- IO String
getIsoDateTime
     PatchInfo
info <- String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
name String
author [String]
forall a. [a]
desc
     Named p wX wY -> IO (Named p wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Named p wX wY -> IO (Named p wX wY))
-> Named p wX wY -> IO (Named p wX wY)
forall a b. (a -> b) -> a -> b
$ PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
info FL (PrimOf p) wX wY
ps

mkDummy :: FromPrim p => RebaseName wX wY -> Named p wX wY
mkDummy :: RebaseName wX wY -> Named p wX wY
mkDummy (AddName PatchInfo
pi) = PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
pi (FL (PrimOf p) Any Any -> FL (PrimOf p) wX wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL (PrimOf p) Any Any
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
mkDummy (DelName PatchInfo
_) = String -> Named p wX wY
forall a. HasCallStack => String -> a
error String
"internal error: can't make a dummy patch from a delete"
mkDummy (Rename PatchInfo
_ PatchInfo
_) = String -> Named p wX wY
forall a. HasCallStack => String -> a
error String
"internal error: can't make a dummy patch from a rename"

instance IsHunk (RebaseChange prim) where
    -- RebaseChange is a compound patch, so it doesn't really make sense to
    -- ask whether it's a hunk. TODO: get rid of the need for this.
    isHunk :: RebaseChange prim wX wY -> Maybe (FileHunk wX wY)
isHunk RebaseChange prim wX wY
_ = Maybe (FileHunk wX wY)
forall a. Maybe a
Nothing

instance PatchListFormat (RebaseChange prim)

addNamedToRebase
  :: RepoPatch p
  => D.DiffAlgorithm
  -> Named p wX wY
  -> FL (RebaseChange (PrimOf p)) wY wZ
  -> Sealed (FL (RebaseChange (PrimOf p)) wX)
addNamedToRebase :: DiffAlgorithm
-> Named p wX wY
-> FL (RebaseChange (PrimOf p)) wY wZ
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
addNamedToRebase DiffAlgorithm
da named :: Named p wX wY
named@(NamedP PatchInfo
n [PatchInfo]
deps FL p wX wY
_) =
  case Named p wX wY -> Unwound (PrimOf (Named p)) wX wY
forall (p :: * -> * -> *) wX wY.
Unwind p =>
p wX wY -> Unwound (PrimOf p) wX wY
fullUnwind Named p wX wY
named of
    Unwound FL (PrimOf (Named p)) wX wB
before FL (PrimOf (Named p)) wB wC
underlying RL (PrimOf (Named p)) wC wY
after ->
      (forall wX.
 FL (RebaseChange (PrimOf p)) wB wX
 -> Sealed (FL (RebaseChange (PrimOf p)) wX))
-> Sealed (FL (RebaseChange (PrimOf p)) wB)
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wX wB
-> FL (RebaseChange (PrimOf p)) wB wX
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da ((forall wW wY. PrimOf p wW wY -> RebaseFixup (PrimOf p) wW wY)
-> FL (PrimOf p) wX wB -> FL (RebaseFixup (PrimOf p)) wX wB
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. PrimOf p wW wY -> RebaseFixup (PrimOf p) wW wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup FL (PrimOf p) wX wB
FL (PrimOf (Named p)) wX wB
before)) (Sealed (FL (RebaseChange (PrimOf p)) wB)
 -> Sealed (FL (RebaseChange (PrimOf p)) wX))
-> (FL (RebaseChange (PrimOf p)) wY wZ
    -> Sealed (FL (RebaseChange (PrimOf p)) wB))
-> FL (RebaseChange (PrimOf p)) wY wZ
-> Sealed (FL (RebaseChange (PrimOf p)) wX)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (forall wX.
 FL (RebaseChange (PrimOf p)) wC wX
 -> FL (RebaseChange (PrimOf p)) wB wX)
-> Sealed (FL (RebaseChange (PrimOf p)) wC)
-> Sealed (FL (RebaseChange (PrimOf p)) wB)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal ((FL (RebaseFixup (PrimOf p)) wB wB
-> Named (PrimOf p) wB wC -> RebaseChange (PrimOf p) wB wC
forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC FL (RebaseFixup (PrimOf p)) wB wB
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL (PatchInfo
-> [PatchInfo] -> FL (PrimOf p) wB wC -> Named (PrimOf p) wB wC
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
deps FL (PrimOf p) wB wC
FL (PrimOf (Named p)) wB wC
underlying) RebaseChange (PrimOf p) wB wC
-> FL (RebaseChange (PrimOf p)) wC wX
-> FL (RebaseChange (PrimOf p)) wB wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:)) (Sealed (FL (RebaseChange (PrimOf p)) wC)
 -> Sealed (FL (RebaseChange (PrimOf p)) wB))
-> (FL (RebaseChange (PrimOf p)) wY wZ
    -> Sealed (FL (RebaseChange (PrimOf p)) wC))
-> FL (RebaseChange (PrimOf p)) wY wZ
-> Sealed (FL (RebaseChange (PrimOf p)) wB)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      DiffAlgorithm
-> FL (RebaseFixup (PrimOf p)) wC wY
-> FL (RebaseChange (PrimOf p)) wY wZ
-> Sealed (FL (RebaseChange (PrimOf p)) wC)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
DiffAlgorithm
-> FL (RebaseFixup prim) wX wY
-> FL (RebaseChange prim) wY wZ
-> Sealed (FL (RebaseChange prim) wX)
simplifyPushes DiffAlgorithm
da ((forall wW wY. PrimOf p wW wY -> RebaseFixup (PrimOf p) wW wY)
-> FL (PrimOf p) wC wY -> FL (RebaseFixup (PrimOf p)) wC 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. PrimOf p wW wY -> RebaseFixup (PrimOf p) wW wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup (RL (PrimOf p) wC wY -> FL (PrimOf p) wC wY
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PrimOf p) wC wY
RL (PrimOf (Named p)) wC wY
after))