--  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 :: forall (prim :: * -> * -> *) wX wY.
RebaseChange prim wX wY
-> Sealed2 (PatchInfoAnd ('RepoType 'NoRebase) prim)
rcToPia (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toEdit) = forall (a :: * -> * -> *) wY wY. a wY wY -> Sealed2 a
Sealed2 (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 :: forall wX wY. RebaseChange prim wX wY -> [PatchInfo]
getdeps (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toedit) = 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 :: forall wX wY.
RebaseChange prim wX wY -> PatchId (RebaseChange prim)
ident (RC FL (RebaseFixup prim) wX wY
_ Named prim wY wY
toedit) = 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 :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RebaseChange prim)) m =>
RebaseChange prim wX wY -> m ()
apply (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply FL (RebaseFixup prim) wX wY
fixups forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Named prim wY wY
toedit
   unapply :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RebaseChange prim)) m =>
RebaseChange prim wX wY -> m ()
unapply (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) = forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
unapply Named prim wY wY
toedit forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 :: forall wX wY.
RebaseChange prim wX wY
-> [IsConflictedPrim (PrimOf (RebaseChange prim))]
conflictedEffect (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
toedit) =
    case 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 (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 (forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (FL p1) p2
commuterFLId forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute) (FL prim wZ wY
prims forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (prim :: * -> * -> *) wY wY.
ConflictState -> prim wY wY -> IsConflictedPrim prim
IsC ConflictState
Okay) FL prim wZ wZ
unconflicted forall a. [a] -> [a] -> [a]
++ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (prim :: * -> * -> *) wY wY.
ConflictState -> prim wY wY -> IsConflictedPrim prim
IsC ConflictState
Conflicted) FL prim wZ wY
conflicted

instance (ShowPatchBasic prim, Invert prim, PatchListFormat prim)
  => ShowPatchBasic (RebaseChange prim) where
  showPatch :: forall wX wY. 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
$$ 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
$$ 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
$$ 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 :: forall (prim :: * -> * -> *) wX wY.
(ShowPatchBasic prim, Invert prim) =>
RebaseChange prim wX wY -> Doc
rebaseChangeContent (RC FL (RebaseFixup prim) wX wY
fixups Named prim wY wY
contents) =
  [Doc] -> Doc
vcat (forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
ForDisplay) (forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named prim wY wY
contents)) Doc -> Doc -> Doc
$+$
  if 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 (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall {p :: * -> * -> *} {wX} {wY}.
ShowPatchBasic p =>
RebaseFixup p wX wY -> Doc
showFixup (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) = forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch p wX wY
p
    showFixup (NameFixup RebaseName wX wY
n) = 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 :: forall wX wY. 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 :: forall wX wY. 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
$$ forall (e :: * -> * -> *) wX wY.
(Summary e, PrimDetails (PrimOf e)) =>
e wX wY -> Doc
plainSummary RebaseChange prim wX wY
p
    summaryFL :: forall wX wY. FL (RebaseChange prim) wX wY -> Doc
summaryFL FL (RebaseChange prim) wX wY
ps =
      ShowDepsFormat -> [PatchInfo] -> Doc
showDependencies ShowDepsFormat
ShowDepsSummary (forall {wX} {wY}. FL (RebaseChange prim) wX wY -> [PatchInfo]
getdepsFL FL (RebaseChange prim) wX wY
ps) Doc -> Doc -> 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 = forall a. Ord a => [a] -> [a]
nubSort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps
    content :: forall wX wY. RebaseChange prim wX wY -> Doc
content = 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 :: forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (RebaseChange prim)) m =>
ShowPatchFor -> RebaseChange prim wX wY -> m Doc
showContextPatch ShowPatchFor
f RebaseChange prim wX wY
p = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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' :: forall wX. 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 <- forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
    ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
")")
    Sealed Named prim wX wX
contents <- forall (p :: * -> * -> *) wX. ReadPatch p => Parser (Sealed (p wX))
readPatch'
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: * -> *) wY. a wY -> Sealed a
Sealed forall a b. (a -> b) -> a -> b
$ 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 :: forall (prim :: * -> * -> *) wX wY.
FL (RebaseChange prim) wX wY
-> FL
     (PatchInfoAndG ('RepoType 'IsRebase) (RebaseChange prim)) wX wY
toRebaseChanges = 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 (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 :: forall wX wY.
(:>) (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' <- forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL 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 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'' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Named prim wZ wY
edit1' 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' <-
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (FL (RebaseFixup prim) wY wZ
fixups2' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
edit2'))
    forall (m :: * -> *) a. Monad m => a -> m a
return (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 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'' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 :: forall wX wY. RebaseChange prim wX wY -> [AnchoredPath]
listTouchedFiles (RC FL (RebaseFixup prim) wX wY
fixup Named prim wY wY
toedit) = forall a. Ord a => [a] -> [a]
nubSort (forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles FL (RebaseFixup prim) wX wY
fixup forall a. [a] -> [a] -> [a]
++ forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles Named prim wY wY
toedit)
   hunkMatches :: forall wX wY.
(ByteString -> Bool) -> RebaseChange prim wX wY -> Bool
hunkMatches ByteString -> Bool
f (RC FL (RebaseFixup prim) wX wY
fixup Named prim wY wY
toedit) = 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
|| 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 :: forall (prim :: * -> * -> *) wX wY.
Commute prim =>
FL (RebaseChange prim) wX wY
-> (:>) (FL (RebaseChange prim)) (RL (RebaseChange prim)) wX wY
partitionUnconflicted = 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 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 :: 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 FL (RebaseChange prim) wY wZ
NilFL = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL 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 forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) (RL p) p wX wY -> Maybe ((:>) p (RL p) wX wY)
commuteRL (RL (RebaseChange prim) wX wY
right 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 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' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseChange prim) wZ wZ
left') 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)
_ -> 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 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 {
        forall (p :: * -> * -> *) wX wY. WithDroppedDeps p wX wY -> p wX wY
wddPatch :: p wX wY,
        forall (p :: * -> * -> *) wX wY.
WithDroppedDeps p wX wY -> [PatchInfo]
wddDependedOn :: [PatchInfo]
    }

noDroppedDeps :: p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps :: forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps p wX wY
p = 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 :: forall wX wY.
WithDroppedDeps p wX wY -> FL (PrimOf (WithDroppedDeps p)) wX wY
effect = forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: 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
fixup FL (RebaseChange prim) wY wZ
items = forall (item :: * -> * -> *) (fixup :: * -> * -> *) wX wY.
(:>) item fixup wX wY -> Sealed (item wX)
dropFixups forall a b. (a -> b) -> a -> b
$ 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 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 :: 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
_ FL (RebaseFixup prim) wX wY
NilFL FL (RebaseChange prim) wY wZ
ps = forall (a :: * -> *) wY. a wY -> 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 (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (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) (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 :: forall (prim :: * -> * -> *).
PrimPatch prim =>
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 forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item (FL item) (Maybe2 fixup)
-> PushFixupFn fixup (FL item) (FL item) (Maybe2 fixup)
pushFixupFLMB_FLFLMB (forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (RebaseFixup prim)
     (FL (RebaseFixup prim))
     (Maybe2 (RebaseFixup prim))
pushFixupFixup DiffAlgorithm
da) (RebaseFixup prim wX wZ
f1 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 -> 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
e forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX. Maybe2 p wX wX
Nothing2
      FL (RebaseFixup prim) wX wZ
fs2' :> Just2 RebaseFixup prim wZ wY
f1' ->
        case 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' 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 -> 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' forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ RebaseFixup prim wZ wY
f1' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) Named prim wY wY
e forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX. Maybe2 p wX wX
Nothing2
          Just (Named prim wZ wZ
e' :> RebaseFixup prim wZ wY
f1'') -> 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' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 :: forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
     (RebaseFixup prim)
     (FL (RebaseChange prim))
     (FL (RebaseChange prim))
     (Maybe2 (RebaseFixup prim))
pushFixupChanges DiffAlgorithm
da = forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item item (Maybe2 fixup)
-> PushFixupFn fixup (FL item) (FL item) (Maybe2 fixup)
pushFixupIdMB_FLFLMB (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 :: forall (prim :: * -> * -> *).
PrimPatch prim =>
DiffAlgorithm
-> PushFixupFn
     (FL (RebaseFixup prim))
     (RebaseChange prim)
     (RebaseChange prim)
     (FL (RebaseFixup prim))
pushFixupsChange DiffAlgorithm
da = forall (fixup :: * -> * -> *) (item :: * -> * -> *).
PushFixupFn fixup item item (Maybe2 fixup)
-> PushFixupFn (FL fixup) item item (FL fixup)
pushFixupIdMB_FLIdFLFL (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 :: 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 wZ
NilFL :> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v) = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wY
v forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 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 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' ->
     forall a. a -> Maybe a -> a
fromMaybe ((RebaseFixup prim wX wY
p forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup prim) wY wZ
psS) forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (:>) (FL (RebaseFixup prim)) (Named prim) wZ wZ
v' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup prim) wZ wY
ps') forall a b. (a -> b) -> a -> b
$ do
       FL (RebaseFixup prim) wX wZ
psS' :> RebaseFixup prim wZ wZ
p' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RebaseFixup prim wX wY
p 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'' <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (RebaseFixup prim wZ wZ
p' 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''' <- 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'' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
te)
       forall (m :: * -> *) a. Monad m => a -> m a
return (FL (RebaseFixup prim) wX wZ
psS' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (FL (RebaseFixup prim) wZ wZ
qs' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named prim wZ wZ
te') forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (RebaseFixup prim wZ wZ
p''' 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 :: forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (WithDroppedDeps p2)
mergerIdWDD MergeFn p1 p2
merger (p1 wZ wX
p1 :\/: WithDroppedDeps p2 wZ wY
p2 [PatchInfo]
deps) =
   case MergeFn p1 p2
merger (p1 wZ wX
p1 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' -> forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps p2 wX wZ
p2' [PatchInfo]
deps 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 :: forall (p :: * -> * -> *) (q :: * -> * -> *).
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' <- CommuteFn p q
commuter (p wX wZ
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> q wZ wY
q)
       forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps q wX wZ
q' [PatchInfo]
deps 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 :: forall (p :: * -> * -> *) wX wY.
(:>) 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 forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
  | Bool
otherwise =
      forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps
        (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pn ([PatchInfo]
deps forall a. Eq a => [a] -> [a] -> [a]
\\ [PatchInfo
an]) (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL p wZ wY
body))
        (if PatchInfo
an forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps then PatchInfo
an forall a. a -> [a] -> [a]
: [PatchInfo]
ddeps else [PatchInfo]
ddeps)
      forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
  | PatchInfo
dn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = forall a. HasCallStack => String -> a
error String
"impossible case"
  | Bool
otherwise = forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP WDDNamed p wZ wY
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
  | PatchInfo
new forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
  | PatchInfo
old forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = forall a. HasCallStack => String -> a
error String
"impossible case"
  | Bool
otherwise =
      let newdeps :: [PatchInfo]
newdeps = forall a b. (a -> b) -> [a] -> [b]
map (\PatchInfo
dep -> if PatchInfo
new forall a. Eq a => a -> a -> Bool
== PatchInfo
dep then PatchInfo
old else PatchInfo
dep) [PatchInfo]
deps
      in forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
pn [PatchInfo]
newdeps (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL p wZ wY
body)) [PatchInfo]
ddeps forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 :: forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
(:>) (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 = forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromAnonymousPrim PrimOf p wX wZ
p
        irp :: p wZ wX
irp = forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromAnonymousPrim (forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimOf p wX wZ
p)
    in case forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (WithDroppedDeps p2)
mergerIdWDD (forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
MergeFn p1 p2 -> MergeFn p1 (Named p2)
mergerIdNamed forall (p :: * -> * -> *). Merge p => MergeFn p p
selfMerger) (p wZ wX
irp 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' -> forall {p :: * -> * -> *} {wX} {wY} {wY}.
FL p wX wY
-> WithDroppedDeps (Named p) wY wY
-> WithDroppedDeps (Named p) wX wY
prefixWith (p wX wZ
rp forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: p wZ wX
irp forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) WithDroppedDeps (Named p) wX wZ
wq' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (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) =
          forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
i [PatchInfo]
ds (FL p wX wY
xs 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 :: 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)) wX wZ
NilFL :> WDDNamed p wZ wY
q) = WDDNamed p wZ wY
q forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 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 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 forall (p :: * -> * -> *) wX wY.
(:>) RebaseName (WDDNamed p) wX wY
-> (:>) (WDDNamed p) RebaseName wX wY
forceCommuteName (RebaseName wX wY
n 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'' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (forall wX wY (prim :: * -> * -> *).
RebaseName wX wY -> RebaseFixup prim wX wY
NameFixup RebaseName wZ wZ
n' 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 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 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 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 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'' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 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 (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup FL (PrimOf p) wZ wZ
p' 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 :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed (NamedP PatchInfo
n [PatchInfo]
deps FL (PrimOf p) wX wY
ps) = forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
deps (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 :: forall (p :: * -> * -> *) wX wY.
RepoPatch p =>
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 = forall wA wB.
(:>)
  (FL (RebaseFixup (PrimOf p))) (FL (RebaseChange (PrimOf p))) wA wB
-> (:>) (FL (WDDNamed p)) (FL (RebaseFixup (PrimOf p))) wA wB
go (forall (a :: * -> * -> *) wX. FL a wX wX
NilFL 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 :: 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)) wA wZ
fixupsIn :> FL (RebaseChange (PrimOf p)) wZ wB
NilFL) = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL 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 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 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 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 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY.
p wX wY -> [PatchInfo] -> WithDroppedDeps p wX wY
WithDroppedDeps (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 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 forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup (PrimOf p)) wZ wY
fixupsOut2 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' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (WDDNamed p) wZ wZ
toedits' 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 :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
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 <- forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (p :: * -> * -> *) wA wB.
FromPrim p =>
RebaseChange (PrimOf p) wA wB -> IO (FL (WDDNamed p) wA wB)
reifyOne FL (RebaseChange (PrimOf p)) wX wY
rs
    forall (m :: * -> *) a. Monad m => a -> m a
return (FL (WDDNamed p) wX wY
res forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX 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 :: forall (p :: * -> * -> *) wA wB.
FromPrim p =>
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 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 ->
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
            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 (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY.
FromPrim p =>
RebaseName wX wY -> Named p wX wY
mkDummy) FL RebaseName wA wZ
names forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+
            forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps (forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed Named (PrimOf p) wY wB
toedit) forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
            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 <- 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
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
            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 (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) wX wY.
FromPrim p =>
RebaseName wX wY -> Named p wX wY
mkDummy) FL RebaseName wA wZ
names forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps Named p wZ wY
n forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
            forall (p :: * -> * -> *) wX wY. p wX wY -> WithDroppedDeps p wX wY
noDroppedDeps (forall (p :: * -> * -> *) wX wY.
FromPrim p =>
Named (PrimOf p) wX wY -> Named p wX wY
fromPrimNamed Named (PrimOf p) wY wB
toedit) forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:
            forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

mkReified :: FromPrim p => String -> FL (PrimOf p) wX wY -> IO (Named p wX wY)
mkReified :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
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 forall a. [a]
desc
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall (p :: * -> * -> *) wX wY.
FromPrim p =>
RebaseName wX wY -> Named p wX wY
mkDummy (AddName PatchInfo
pi) = forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PatchInfo -> FL (PrimOf p) wX wY -> Named p wX wY
infopatch PatchInfo
pi (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
mkDummy (DelName PatchInfo
_) = forall a. HasCallStack => String -> a
error String
"internal error: can't make a dummy patch from a delete"
mkDummy (Rename PatchInfo
_ PatchInfo
_) = 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 :: forall wX wY. RebaseChange prim wX wY -> Maybe (FileHunk wX wY)
isHunk RebaseChange prim 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 :: forall (p :: * -> * -> *) wX wY wZ.
RepoPatch p =>
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 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 (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (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 (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup FL (PrimOf (Named p)) wX wB
before)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal ((forall (prim :: * -> * -> *) wX wY wZ.
FL (RebaseFixup prim) wX wY
-> Named prim wY wZ -> RebaseChange prim wX wZ
RC forall (a :: * -> * -> *) wX. FL a wX wX
NilFL (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n [PatchInfo]
deps FL (PrimOf (Named p)) wB wC
underlying) forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      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 (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RebaseFixup prim wX wY
PrimFixup (forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (PrimOf (Named p)) wC wY
after))