{-# LANGUAGE StandaloneDeriving, TypeOperators #-}
module Darcs.Patch.Named.Wrapped
  ( WrappedNamed(..)
  , patch2patchinfo, activecontents
  , infopatch, namepatch, anonymous
  , getdeps, adddeps
  , mkRebase, toRebasing, fromRebasing
  , runInternalChecker, namedInternalChecker, namedIsInternal, removeInternalFL
  , fmapFL_WrappedNamed, (:~:)(..), (:~~:)(..)
  , generaliseRepoTypeWrapped
  ) where

import Prelude ()
import Darcs.Prelude
import Data.Coerce ( coerce )

import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Conflict ( Conflict(..), CommuteNoConflicts(..) )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Format ( PatchListFormat(..), ListFormat )
import Darcs.Patch.Info
  ( PatchInfo, showPatchInfo, displayPatchInfo, patchinfo
  )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Named ( Named(..), fmapFL_Named )
import qualified Darcs.Patch.Named as Base
  ( patch2patchinfo, patchcontents
  , infopatch, namepatch, anonymous
  , getdeps, adddeps
  )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Merge ( Merge(..) )
import Darcs.Patch.Prim ( FromPrim )
import Darcs.Patch.Prim.Class ( PrimPatchBase(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import qualified Darcs.Patch.Rebase.Container as Rebase
  ( Suspended(..)
  , addFixupsToSuspended, removeFixupsFromSuspended
  )
import Darcs.Patch.Repair ( mapMaybeSnd, Repair(..), RepairToFL(..), Check(..) )
import Darcs.Patch.RepoType
  ( RepoType(..), IsRepoType(..), SRepoType(..)
  , RebaseType(..), RebaseTypeOf, SRebaseType(..)
  )
import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatch(..), ShowContextPatch(..), ShowPatchFor(..) )

import Darcs.Patch.Witnesses.Eq ( EqCheck(..) )
import Darcs.Patch.Witnesses.Sealed ( mapSeal )
import Darcs.Patch.Witnesses.Show ( ShowDict(..), Show1(..), Show2(..) )
import Darcs.Patch.Witnesses.Ordered
  ( FL(..), mapFL_FL, mapFL, (:>)(..)
  , (:\/:)(..), (:/\:)(..)
  )

import Darcs.Util.IsoDate ( getIsoDateTime )
import Darcs.Util.Text ( formatParas )
import Darcs.Util.Printer ( ($$), vcat, prefix )

import Control.Applicative ( (<|>) )

-- |A layer inbetween the 'Named p' type and 'PatchInfoAnd p'
-- design for holding "internal" patches such as the rebase
-- container. Ideally these patches would be stored at the
-- repository level but this would require some significant
-- refactoring/cleaning up of that code.
data WrappedNamed (rt :: RepoType) p wX wY where
  NormalP :: !(Named p wX wY) -> WrappedNamed rt p wX wY
  RebaseP
    :: (PrimPatchBase p, FromPrim p, Effect p)
    => !PatchInfo -- TODO: this should always be the "internal implementation detail" rebase
                  -- patch description, so could be replaced by just the Ignore-this and Date fields
    -> !(Rebase.Suspended p wX wX)
    -> WrappedNamed ('RepoType 'IsRebase) p wX wX


deriving instance Show2 p => Show (WrappedNamed rt p wX wY)

instance Show2 p => Show1 (WrappedNamed rt p wX) where
  showDict1 :: ShowDict (WrappedNamed rt p wX wX)
showDict1 = ShowDict (WrappedNamed rt p wX wX)
forall a. Show a => ShowDict a
ShowDictClass

instance Show2 p => Show2 (WrappedNamed rt p) where
  showDict2 :: ShowDict (WrappedNamed rt p wX wY)
showDict2 = ShowDict (WrappedNamed rt p wX wY)
forall a. Show a => ShowDict a
ShowDictClass

-- TODO use Data.Type.Equality and PolyKinds from GHC 7.8/base 4.7
data (a :: * -> * -> *) :~: b where
    ReflPatch :: a :~: a

data (a :: RebaseType) :~~: b where
    ReflRebaseType :: a :~~: a

-- |lift a function over an 'FL' of patches to one over
-- a 'WrappedNamed rt'.
-- The function is only applied to "normal" patches,
-- and any rebase container patch is left alone.
fmapFL_WrappedNamed
  :: (FL p wA wB -> FL q wA wB)
  -> (RebaseTypeOf rt :~~: 'IsRebase -> p :~: q)
     -- ^If the patch might be a rebase container patch,
     -- then 'p' and 'q' must be the same type, as no
     -- transformation is applied. This function provides
     -- a witness to this requirement: if 'RebaseTypeOf rt'
     -- might be 'IsRebase', then it must be able to return
     -- a proof that 'p' and 'q' are equal. If 'RebaseTypeOf rt'
     -- must be 'NoRebase', then this function can never be called
     -- with a valid value.
  -> WrappedNamed rt p wA wB
  -> WrappedNamed rt q wA wB
fmapFL_WrappedNamed :: (FL p wA wB -> FL q wA wB)
-> ((RebaseTypeOf rt :~~: 'IsRebase) -> p :~: q)
-> WrappedNamed rt p wA wB
-> WrappedNamed rt q wA wB
fmapFL_WrappedNamed f :: FL p wA wB -> FL q wA wB
f _ (NormalP n :: Named p wA wB
n) = Named q wA wB -> WrappedNamed rt q wA wB
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP ((FL p wA wB -> FL q wA wB) -> Named p wA wB -> Named q wA wB
forall (p :: * -> * -> *) wA wB (q :: * -> * -> *) wC wD.
(FL p wA wB -> FL q wC wD) -> Named p wA wB -> Named q wC wD
fmapFL_Named FL p wA wB -> FL q wA wB
f Named p wA wB
n)
fmapFL_WrappedNamed _ whenRebase :: (RebaseTypeOf rt :~~: 'IsRebase) -> p :~: q
whenRebase (RebaseP n :: PatchInfo
n s :: Suspended p wA wA
s) =
  case (RebaseTypeOf rt :~~: 'IsRebase) -> p :~: q
whenRebase RebaseTypeOf rt :~~: 'IsRebase
forall (a :: RebaseType). a :~~: a
ReflRebaseType of
    ReflPatch -> PatchInfo
-> Suspended p wA wA -> WrappedNamed ('RepoType 'IsRebase) p wA wA
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
n Suspended p wA wA
s

patch2patchinfo :: WrappedNamed rt p wX wY -> PatchInfo
patch2patchinfo :: WrappedNamed rt p wX wY -> PatchInfo
patch2patchinfo (NormalP p :: Named p wX wY
p) = Named p wX wY -> PatchInfo
forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
Base.patch2patchinfo Named p wX wY
p
patch2patchinfo (RebaseP name :: PatchInfo
name _) = PatchInfo
name

namepatch :: String -> String -> String -> [String] -> FL p wX wY -> IO (WrappedNamed rt p wX wY)
namepatch :: String
-> String
-> String
-> [String]
-> FL p wX wY
-> IO (WrappedNamed rt p wX wY)
namepatch date :: String
date name :: String
name author :: String
author desc :: [String]
desc p :: FL p wX wY
p = (Named p wX wY -> WrappedNamed rt p wX wY)
-> IO (Named p wX wY) -> IO (WrappedNamed rt p wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Named p wX wY -> WrappedNamed rt p wX wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP (String
-> String -> String -> [String] -> FL p wX wY -> IO (Named p wX wY)
forall (p :: * -> * -> *) wX wY.
String
-> String -> String -> [String] -> FL p wX wY -> IO (Named p wX wY)
Base.namepatch String
date String
name String
author [String]
desc FL p wX wY
p)

anonymous :: FL p wX wY -> IO (WrappedNamed rt p wX wY)
anonymous :: FL p wX wY -> IO (WrappedNamed rt p wX wY)
anonymous p :: FL p wX wY
p = (Named p wX wY -> WrappedNamed rt p wX wY)
-> IO (Named p wX wY) -> IO (WrappedNamed rt p wX wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Named p wX wY -> WrappedNamed rt p wX wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP (FL p wX wY -> IO (Named p wX wY)
forall (p :: * -> * -> *) wX wY. FL p wX wY -> IO (Named p wX wY)
Base.anonymous FL p wX wY
p)

infopatch :: PatchInfo -> FL p wX wY -> WrappedNamed rt p wX wY
infopatch :: PatchInfo -> FL p wX wY -> WrappedNamed rt p wX wY
infopatch i :: PatchInfo
i ps :: FL p wX wY
ps = Named p wX wY -> WrappedNamed rt p wX wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP (PatchInfo -> FL p wX wY -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
PatchInfo -> FL p wX wY -> Named p wX wY
Base.infopatch PatchInfo
i FL p wX wY
ps)

-- |Return a list of the underlying patches that are actually
-- 'active' in the repository, i.e. not suspended as part of a rebase
activecontents :: WrappedNamed rt p wX wY -> FL p wX wY
activecontents :: WrappedNamed rt p wX wY -> FL p wX wY
activecontents (NormalP p :: Named p wX wY
p) = Named p wX wY -> FL p wX wY
forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
Base.patchcontents Named p wX wY
p
activecontents (RebaseP {}) = FL p wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

adddeps :: WrappedNamed rt p wX wY -> [PatchInfo] -> WrappedNamed rt p wX wY
adddeps :: WrappedNamed rt p wX wY -> [PatchInfo] -> WrappedNamed rt p wX wY
adddeps (NormalP n :: Named p wX wY
n) pis :: [PatchInfo]
pis = Named p wX wY -> WrappedNamed rt p wX wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP (Named p wX wY -> [PatchInfo] -> Named p wX wY
forall (p :: * -> * -> *) wX wY.
Named p wX wY -> [PatchInfo] -> Named p wX wY
Base.adddeps Named p wX wY
n [PatchInfo]
pis)
adddeps (RebaseP {}) _ = String -> WrappedNamed rt p wX wY
forall a. HasCallStack => String -> a
error "Internal error: can't add dependencies to a rebase internal patch"

getdeps :: WrappedNamed rt p wX wY -> [PatchInfo]
getdeps :: WrappedNamed rt p wX wY -> [PatchInfo]
getdeps (NormalP n :: Named p wX wY
n) = Named p wX wY -> [PatchInfo]
forall (p :: * -> * -> *) wX wY. Named p wX wY -> [PatchInfo]
Base.getdeps Named p wX wY
n
getdeps (RebaseP {}) = []

mkRebase :: (PrimPatchBase p, FromPrim p, Effect p)
         => Rebase.Suspended p wX wX
         -> IO (WrappedNamed ('RepoType 'IsRebase) p wX wX)
mkRebase :: Suspended p wX wX
-> IO (WrappedNamed ('RepoType 'IsRebase) p wX wX)
mkRebase s :: Suspended p wX wX
s = do
     let name :: String
name = "DO NOT TOUCH: Rebase patch"
     let desc :: [String]
desc = Int -> [String] -> [String]
formatParas 72
                ["This patch is an internal implementation detail of rebase, used to store suspended patches, " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                 "and should not be visible in the user interface. Please report a bug if a darcs " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                 "command is showing you this patch."]
     String
date <- IO String
getIsoDateTime
     let author :: String
author = "Invalid <invalid@invalid>"
     PatchInfo
info <- String -> String -> String -> [String] -> IO PatchInfo
patchinfo String
date String
name String
author [String]
desc
     WrappedNamed ('RepoType 'IsRebase) p wX wX
-> IO (WrappedNamed ('RepoType 'IsRebase) p wX wX)
forall (m :: * -> *) a. Monad m => a -> m a
return (WrappedNamed ('RepoType 'IsRebase) p wX wX
 -> IO (WrappedNamed ('RepoType 'IsRebase) p wX wX))
-> WrappedNamed ('RepoType 'IsRebase) p wX wX
-> IO (WrappedNamed ('RepoType 'IsRebase) p wX wX)
forall a b. (a -> b) -> a -> b
$ PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
info Suspended p wX wX
s

toRebasing :: Named p wX wY -> WrappedNamed ('RepoType 'IsRebase) p wX wY
toRebasing :: Named p wX wY -> WrappedNamed ('RepoType 'IsRebase) p wX wY
toRebasing n :: Named p wX wY
n = Named p wX wY -> WrappedNamed ('RepoType 'IsRebase) p wX wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wX wY
n

fromRebasing :: WrappedNamed ('RepoType 'IsRebase) p wX wY -> Named p wX wY
fromRebasing :: WrappedNamed ('RepoType 'IsRebase) p wX wY -> Named p wX wY
fromRebasing (NormalP n :: Named p wX wY
n) = Named p wX wY
n
fromRebasing (RebaseP {}) = String -> Named p wX wY
forall a. HasCallStack => String -> a
error "internal error: found rebasing internal patch"

generaliseRepoTypeWrapped
  :: WrappedNamed ('RepoType 'NoRebase) p wA wB
  -> WrappedNamed rt p wA wB
generaliseRepoTypeWrapped :: WrappedNamed ('RepoType 'NoRebase) p wA wB
-> WrappedNamed rt p wA wB
generaliseRepoTypeWrapped (NormalP p :: Named p wA wB
p) = Named p wA wB -> WrappedNamed rt p wA wB
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wA wB
p

-- Note: the EqCheck result could be replaced by a Bool if clients were changed to commute the patch
-- out if necessary.
newtype InternalChecker p =
  InternalChecker { InternalChecker p -> forall wX wY. p wX wY -> EqCheck wX wY
runInternalChecker :: forall wX wY . p wX wY -> EqCheck wX wY }

-- |Is the given 'WrappedNamed' patch an internal implementation detail
-- that shouldn't be visible in the UI or included in tags/matchers etc?
-- Two-level checker for efficiency: if the value of this is 'Nothing' for a given
-- patch type then there's no need to inspect patches of this type at all,
-- as none of them can be internal.
namedInternalChecker :: forall rt p . IsRepoType rt => Maybe (InternalChecker (WrappedNamed rt p))
namedInternalChecker :: Maybe (InternalChecker (WrappedNamed rt p))
namedInternalChecker =
  case SRepoType rt
forall (rt :: RepoType). IsRepoType rt => SRepoType rt
singletonRepoType :: SRepoType rt of
    SRepoType SNoRebase -> Maybe (InternalChecker (WrappedNamed rt p))
forall a. Maybe a
Nothing
    SRepoType SIsRebase ->
      let
        isInternal :: WrappedNamed rt p wX wY -> EqCheck wX wY
        isInternal :: WrappedNamed rt p wX wY -> EqCheck wX wY
isInternal (NormalP {}) = EqCheck wX wY
forall wA wB. EqCheck wA wB
NotEq
        isInternal (RebaseP {}) = EqCheck wX wY
forall wA. EqCheck wA wA
IsEq
      in InternalChecker (WrappedNamed rt p)
-> Maybe (InternalChecker (WrappedNamed rt p))
forall a. a -> Maybe a
Just ((forall wX wY. WrappedNamed rt p wX wY -> EqCheck wX wY)
-> InternalChecker (WrappedNamed rt p)
forall (p :: * -> * -> *).
(forall wX wY. p wX wY -> EqCheck wX wY) -> InternalChecker p
InternalChecker forall wX wY. WrappedNamed rt p wX wY -> EqCheck wX wY
isInternal)

-- |Is the given 'WrappedNamed' patch an internal implementation detail
-- that shouldn't be visible in the UI or included in tags/matchers etc?
namedIsInternal :: IsRepoType rt => WrappedNamed rt p wX wY -> EqCheck wX wY
namedIsInternal :: WrappedNamed rt p wX wY -> EqCheck wX wY
namedIsInternal = (WrappedNamed rt p wX wY -> EqCheck wX wY)
-> (InternalChecker (WrappedNamed rt p)
    -> WrappedNamed rt p wX wY -> EqCheck wX wY)
-> Maybe (InternalChecker (WrappedNamed rt p))
-> WrappedNamed rt p wX wY
-> EqCheck wX wY
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EqCheck wX wY -> WrappedNamed rt p wX wY -> EqCheck wX wY
forall a b. a -> b -> a
const EqCheck wX wY
forall wA wB. EqCheck wA wB
NotEq) InternalChecker (WrappedNamed rt p)
-> WrappedNamed rt p wX wY -> EqCheck wX wY
forall (p :: * -> * -> *).
InternalChecker p -> forall wX wY. p wX wY -> EqCheck wX wY
runInternalChecker Maybe (InternalChecker (WrappedNamed rt p))
forall (rt :: RepoType) (p :: * -> * -> *).
IsRepoType rt =>
Maybe (InternalChecker (WrappedNamed rt p))
namedInternalChecker

removeInternalFL :: IsRepoType rt => FL (WrappedNamed rt p) wX wY -> FL (Named p) wX wY
removeInternalFL :: FL (WrappedNamed rt p) wX wY -> FL (Named p) wX wY
removeInternalFL NilFL = FL (Named p) wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
removeInternalFL (NormalP n :: Named p wX wY
n :>: ps :: FL (WrappedNamed rt p) wY wY
ps) = Named p wX wY
n Named p wX wY -> FL (Named p) wY wY -> FL (Named p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (WrappedNamed rt p) wY wY -> FL (Named p) wY wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
FL (WrappedNamed rt p) wX wY -> FL (Named p) wX wY
removeInternalFL FL (WrappedNamed rt p) wY wY
ps
removeInternalFL (RebaseP {} :>: ps :: FL (WrappedNamed rt p) wY wY
ps) = FL (WrappedNamed rt p) wY wY -> FL (Named p) wY wY
forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
IsRepoType rt =>
FL (WrappedNamed rt p) wX wY -> FL (Named p) wX wY
removeInternalFL FL (WrappedNamed rt p) wY wY
ps

instance PrimPatchBase p => PrimPatchBase (WrappedNamed rt p) where
  type PrimOf (WrappedNamed rt p) = PrimOf p

instance Invert p => Invert (WrappedNamed rt p) where
  invert :: WrappedNamed rt p wX wY -> WrappedNamed rt p wY wX
invert (NormalP n :: Named p wX wY
n) = Named p wY wX -> WrappedNamed rt p wY wX
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP (Named p wX wY -> Named p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Named p wX wY
n)
  invert (RebaseP i :: PatchInfo
i s :: Suspended p wX wX
s) = PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i Suspended p wX wX
s -- TODO is this sensible?

instance PatchListFormat (WrappedNamed rt p)

instance IsHunk (WrappedNamed rt p) where
  isHunk :: WrappedNamed rt p wX wY -> Maybe (FileHunk wX wY)
isHunk _ = Maybe (FileHunk wX wY)
forall a. Maybe a
Nothing

instance (ShowPatchBasic p, PatchListFormat p)
  => ShowPatchBasic (WrappedNamed rt p) where

  showPatch :: ShowPatchFor -> WrappedNamed rt p wX wY -> Doc
showPatch f :: ShowPatchFor
f (NormalP n :: Named p wX wY
n) = ShowPatchFor -> Named p wX wY -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f Named p wX wY
n
  showPatch f :: ShowPatchFor
f (RebaseP i :: PatchInfo
i s :: Suspended p wX wX
s) = ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ShowPatchFor -> Suspended p wX wX -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f Suspended p wX wX
s

instance ( ShowContextPatch p, PatchListFormat p, Apply p
         , PrimPatchBase p, IsHunk p
         )
  => ShowContextPatch (WrappedNamed rt p) where

  showContextPatch :: ShowPatchFor -> WrappedNamed rt p wX wY -> m Doc
showContextPatch f :: ShowPatchFor
f (NormalP n :: Named p wX wY
n) = ShowPatchFor -> Named p wX wY -> m Doc
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(ShowContextPatch p, ApplyMonad (ApplyState p) m) =>
ShowPatchFor -> p wX wY -> m Doc
showContextPatch ShowPatchFor
f Named p wX wY
n
  showContextPatch f :: ShowPatchFor
f@ShowPatchFor
ForDisplay (RebaseP i :: PatchInfo
i s :: Suspended p wX wX
s) =
    (Doc -> Doc) -> m Doc -> m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
i Doc -> Doc -> Doc
$$) (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowPatchFor -> Suspended p wX wX -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f Suspended p wX wX
s)
  showContextPatch f :: ShowPatchFor
f@ShowPatchFor
ForStorage (RebaseP i :: PatchInfo
i s :: Suspended p wX wX
s) =
    (Doc -> Doc) -> m Doc -> m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
i Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (m Doc -> m Doc) -> m Doc -> m Doc
forall a b. (a -> b) -> a -> b
$ Doc -> m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowPatchFor -> Suspended p wX wX -> Doc
forall (p :: * -> * -> *) wX wY.
ShowPatchBasic p =>
ShowPatchFor -> p wX wY -> Doc
showPatch ShowPatchFor
f Suspended p wX wX
s)

instance ( ShowPatch p, PatchListFormat p, Apply p
         , PrimPatchBase p, IsHunk p, Conflict p, CommuteNoConflicts p
         )
  => ShowPatch (WrappedNamed rt p) where

  description :: WrappedNamed rt p wX wY -> Doc
description (NormalP n :: Named p wX wY
n) = Named p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
description Named p wX wY
n
  description (RebaseP i :: PatchInfo
i _) = PatchInfo -> Doc
displayPatchInfo PatchInfo
i

  summary :: WrappedNamed rt p wX wY -> Doc
summary (NormalP n :: Named p wX wY
n) = Named p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
summary Named p wX wY
n
  summary (RebaseP i :: PatchInfo
i _) = PatchInfo -> Doc
displayPatchInfo PatchInfo
i

  summaryFL :: FL (WrappedNamed rt p) wX wY -> Doc
summaryFL = [Doc] -> Doc
vcat ([Doc] -> Doc)
-> (FL (WrappedNamed rt p) wX wY -> [Doc])
-> FL (WrappedNamed rt p) wX wY
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wX wY. WrappedNamed rt p wX wY -> Doc)
-> FL (WrappedNamed rt p) wX wY -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL forall wX wY. WrappedNamed rt p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
summary

  showNicely :: WrappedNamed rt p wX wY -> Doc
showNicely (NormalP n :: Named p wX wY
n) = Named p wX wY -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
showNicely Named p wX wY
n
  showNicely (RebaseP i :: PatchInfo
i s :: Suspended p wX wX
s) = PatchInfo -> Doc
displayPatchInfo PatchInfo
i Doc -> Doc -> Doc
$$
                             String -> Doc -> Doc
prefix "    " (Suspended p wX wX -> Doc
forall (p :: * -> * -> *) wX wY. ShowPatch p => p wX wY -> Doc
showNicely Suspended p wX wX
s)

instance PatchInspect p => PatchInspect (WrappedNamed rt p) where
  listTouchedFiles :: WrappedNamed rt p wX wY -> [String]
listTouchedFiles (NormalP n :: Named p wX wY
n) = Named p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles Named p wX wY
n
  listTouchedFiles (RebaseP _ s :: Suspended p wX wX
s) = Suspended p wX wX -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles Suspended p wX wX
s

  hunkMatches :: (ByteString -> Bool) -> WrappedNamed rt p wX wY -> Bool
hunkMatches f :: ByteString -> Bool
f (NormalP n :: Named p wX wY
n) = (ByteString -> Bool) -> Named p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f Named p wX wY
n
  hunkMatches f :: ByteString -> Bool
f (RebaseP _ s :: Suspended p wX wX
s) = (ByteString -> Bool) -> Suspended p wX wX -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f Suspended p wX wX
s

instance RepairToFL p => Repair (WrappedNamed rt p) where
  applyAndTryToFix :: WrappedNamed rt p wX wY
-> m (Maybe (String, WrappedNamed rt p wX wY))
applyAndTryToFix (NormalP n :: Named p wX wY
n) = (Maybe (String, Named p wX wY)
 -> Maybe (String, WrappedNamed rt p wX wY))
-> m (Maybe (String, Named p wX wY))
-> m (Maybe (String, WrappedNamed rt p wX wY))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Named p wX wY -> WrappedNamed rt p wX wY)
-> Maybe (String, Named p wX wY)
-> Maybe (String, WrappedNamed rt p wX wY)
forall a b c. (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd Named p wX wY -> WrappedNamed rt p wX wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP) (m (Maybe (String, Named p wX wY))
 -> m (Maybe (String, WrappedNamed rt p wX wY)))
-> m (Maybe (String, Named p wX wY))
-> m (Maybe (String, WrappedNamed rt p wX wY))
forall a b. (a -> b) -> a -> b
$ Named p wX wY -> m (Maybe (String, Named p wX wY))
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Repair p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, p wX wY))
applyAndTryToFix Named p wX wY
n
  applyAndTryToFix (RebaseP i :: PatchInfo
i s :: Suspended p wX wX
s) = (Maybe (String, Suspended p wX wX)
 -> Maybe (String, WrappedNamed ('RepoType 'IsRebase) p wX wX))
-> m (Maybe (String, Suspended p wX wX))
-> m (Maybe (String, WrappedNamed ('RepoType 'IsRebase) p wX wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX)
-> Maybe (String, Suspended p wX wX)
-> Maybe (String, WrappedNamed ('RepoType 'IsRebase) p wX wX)
forall a b c. (a -> b) -> Maybe (c, a) -> Maybe (c, b)
mapMaybeSnd (PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i)) (m (Maybe (String, Suspended p wX wX))
 -> m (Maybe (String, WrappedNamed rt p wX wY)))
-> m (Maybe (String, Suspended p wX wX))
-> m (Maybe (String, WrappedNamed rt p wX wY))
forall a b. (a -> b) -> a -> b
$ Suspended p wX wX -> m (Maybe (String, Suspended p wX wX))
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Repair p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m (Maybe (String, p wX wY))
applyAndTryToFix Suspended p wX wX
s

-- This is a local hack to maintain backwards compatibility with
-- the on-disk format for rebases. Previously the rebase container
-- was internally represented via a 'Rebasing' type that sat *inside*
-- a 'Named', and so the rebase container patch had the structure
-- 'NamedP i [] (Suspendended s :>: NilFL)'. This structure was reflected
-- in the way it was saved on disk.
-- The easiest to read this structure is to use an intermediate type
-- that reflects the old structure.
-- TODO: switch to a more natural on-disk structure that directly
-- saves/reads 'RebaseP'.
data ReadRebasing p wX wY where
  ReadNormal    :: p wX wY -> ReadRebasing p wX wY
  ReadSuspended :: Rebase.Suspended p wX wX -> ReadRebasing p wX wX

instance ( ReadPatch p, PrimPatchBase p, FromPrim p, Effect p, PatchListFormat p
         , IsRepoType rt
         ) => ReadPatch (WrappedNamed rt p) where
  readPatch' :: m (Sealed (WrappedNamed rt p wX))
readPatch' =
    case SRepoType rt
forall (rt :: RepoType). IsRepoType rt => SRepoType rt
singletonRepoType :: SRepoType rt of
      SRepoType SIsRebase ->
        let wrapNamed :: Named (ReadRebasing p) wX wY -> WrappedNamed rt p wX wY
            wrapNamed :: Named (ReadRebasing p) wX wY -> WrappedNamed rt p wX wY
wrapNamed (NamedP i :: PatchInfo
i [] (ReadSuspended s :: Suspended p wX wX
s :>: NilFL))
               = PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i Suspended p wX wX
s
            wrapNamed (NamedP i :: PatchInfo
i deps :: [PatchInfo]
deps ps :: FL (ReadRebasing p) wX wY
ps) = Named p wX wY -> WrappedNamed rt p wX wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP (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]
deps ((forall wW wY. ReadRebasing p wW wY -> p wW wY)
-> FL (ReadRebasing p) wX wY -> FL p wX wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. ReadRebasing p wW wY -> p wW wY
forall (p :: * -> * -> *) wX wY. ReadRebasing p wX wY -> p wX wY
unRead FL (ReadRebasing p) wX wY
ps))

            unRead :: ReadRebasing p wX wY -> p wX wY
unRead (ReadNormal p :: p wX wY
p) = p wX wY
p
            unRead (ReadSuspended _) = String -> p wX wY
forall a. HasCallStack => String -> a
error "unexpected suspended patch"

        in (Sealed (Named (ReadRebasing p) wX)
 -> Sealed (WrappedNamed rt p wX))
-> m (Sealed (Named (ReadRebasing p) wX))
-> m (Sealed (WrappedNamed rt p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall wX.
 Named (ReadRebasing p) wX wX -> WrappedNamed rt p wX wX)
-> Sealed (Named (ReadRebasing p) wX)
-> Sealed (WrappedNamed rt p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. Named (ReadRebasing p) wX wX -> WrappedNamed rt p wX wX
forall wX wY.
Named (ReadRebasing p) wX wY -> WrappedNamed rt p wX wY
wrapNamed) m (Sealed (Named (ReadRebasing p) wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'

      _ -> (Sealed (Named p wX) -> Sealed (WrappedNamed rt p wX))
-> m (Sealed (Named p wX)) -> m (Sealed (WrappedNamed rt p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall wX. Named p wX wX -> WrappedNamed rt p wX wX)
-> Sealed (Named p wX) -> Sealed (WrappedNamed rt p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. Named p wX wX -> WrappedNamed rt p wX wX
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP) m (Sealed (Named p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'

instance PatchListFormat p => PatchListFormat (ReadRebasing p) where
  patchListFormat :: ListFormat (ReadRebasing p)
patchListFormat = ListFormat p -> ListFormat (ReadRebasing p)
forall a b. Coercible a b => a -> b
coerce (ListFormat p
forall (p :: * -> * -> *). PatchListFormat p => ListFormat p
patchListFormat :: ListFormat p)

instance (ReadPatch p, PatchListFormat p, PrimPatchBase p) => ReadPatch (ReadRebasing p) where
  readPatch' :: m (Sealed (ReadRebasing p wX))
readPatch' =
       (forall wX. Suspended p wX wX -> ReadRebasing p wX wX)
-> Sealed (Suspended p wX) -> Sealed (ReadRebasing p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. Suspended p wX wX -> ReadRebasing p wX wX
forall wX wY. Suspended p wX wY -> ReadRebasing p wX wY
toSuspended (Sealed (Suspended p wX) -> Sealed (ReadRebasing p wX))
-> m (Sealed (Suspended p wX)) -> m (Sealed (ReadRebasing p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Sealed (Suspended p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
    m (Sealed (ReadRebasing p wX))
-> m (Sealed (ReadRebasing p wX)) -> m (Sealed (ReadRebasing p wX))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall wX. p wX wX -> ReadRebasing p wX wX)
-> Sealed (p wX) -> Sealed (ReadRebasing p wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. p wX wX -> ReadRebasing p wX wX
forall (p :: * -> * -> *) wX wY. p wX wY -> ReadRebasing p wX wY
ReadNormal (Sealed (p wX) -> Sealed (ReadRebasing p wX))
-> m (Sealed (p wX)) -> m (Sealed (ReadRebasing p wX))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Sealed (p wX))
forall (p :: * -> * -> *) (m :: * -> *) wX.
(ReadPatch p, ParserM m) =>
m (Sealed (p wX))
readPatch'
      where -- needed to get a suitably polymorphic type
            toSuspended :: Rebase.Suspended p wX wY -> ReadRebasing p wX wY
            toSuspended :: Suspended p wX wY -> ReadRebasing p wX wY
toSuspended (Rebase.Items ps :: FL (RebaseItem p) wX wY
ps) = Suspended p wX wX -> ReadRebasing p wX wX
forall (p :: * -> * -> *) wX.
Suspended p wX wX -> ReadRebasing p wX wX
ReadSuspended (FL (RebaseItem p) wX wY -> Suspended p wX wX
forall (p :: * -> * -> *) wX wY.
FL (RebaseItem p) wX wY -> Suspended p wX wX
Rebase.Items FL (RebaseItem p) wX wY
ps)

instance (CommuteNoConflicts p, Conflict p) => Conflict (WrappedNamed rt p) where
  resolveConflicts :: WrappedNamed rt p wX wY
-> [[Sealed (FL (PrimOf (WrappedNamed rt p)) wY)]]
resolveConflicts (NormalP n :: Named p wX wY
n) = Named p wX wY -> [[Sealed (FL (PrimOf (Named p)) wY)]]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
resolveConflicts Named p wX wY
n
  resolveConflicts (RebaseP _ s :: Suspended p wX wX
s) = Suspended p wX wX -> [[Sealed (FL (PrimOf (Suspended p)) wX)]]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [[Sealed (FL (PrimOf p) wY)]]
resolveConflicts Suspended p wX wX
s

  conflictedEffect :: WrappedNamed rt p wX wY
-> [IsConflictedPrim (PrimOf (WrappedNamed rt p))]
conflictedEffect (NormalP n :: Named p wX wY
n) = Named p wX wY -> [IsConflictedPrim (PrimOf (Named p))]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect Named p wX wY
n
  conflictedEffect (RebaseP _ s :: Suspended p wX wX
s) = Suspended p wX wX -> [IsConflictedPrim (PrimOf (Suspended p))]
forall (p :: * -> * -> *) wX wY.
Conflict p =>
p wX wY -> [IsConflictedPrim (PrimOf p)]
conflictedEffect Suspended p wX wX
s

instance Check p => Check (WrappedNamed rt p) where
  isInconsistent :: WrappedNamed rt p wX wY -> Maybe Doc
isInconsistent (NormalP n :: Named p wX wY
n) = Named p wX wY -> Maybe Doc
forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent Named p wX wY
n
  isInconsistent (RebaseP _ s :: Suspended p wX wX
s) = Suspended p wX wX -> Maybe Doc
forall (p :: * -> * -> *) wX wY. Check p => p wX wY -> Maybe Doc
isInconsistent Suspended p wX wX
s

instance Apply p => Apply (WrappedNamed rt p) where
  type ApplyState (WrappedNamed rt p) = ApplyState p
  apply :: WrappedNamed rt p wX wY -> m ()
apply (NormalP n :: Named p wX wY
n) = Named p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Named p wX wY
n
  apply (RebaseP _ s :: Suspended p wX wX
s) = Suspended p wX wX -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply Suspended p wX wX
s

instance Effect p => Effect (WrappedNamed rt p) where
  effect :: WrappedNamed rt p wX wY -> FL (PrimOf (WrappedNamed rt p)) wX wY
effect (NormalP n :: Named p wX wY
n) = Named p wX wY -> FL (PrimOf (Named p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect Named p wX wY
n
  effect (RebaseP _ s :: Suspended p wX wX
s) = Suspended p wX wX -> FL (PrimOf (Suspended p)) wX wX
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect Suspended p wX wX
s

  effectRL :: WrappedNamed rt p wX wY -> RL (PrimOf (WrappedNamed rt p)) wX wY
effectRL (NormalP n :: Named p wX wY
n) = Named p wX wY -> RL (PrimOf (Named p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> RL (PrimOf p) wX wY
effectRL Named p wX wY
n
  effectRL (RebaseP _ s :: Suspended p wX wX
s) = Suspended p wX wX -> RL (PrimOf (Suspended p)) wX wX
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> RL (PrimOf p) wX wY
effectRL Suspended p wX wX
s

instance Commute p => Commute (WrappedNamed rt p) where
  commute :: (:>) (WrappedNamed rt p) (WrappedNamed rt p) wX wY
-> Maybe ((:>) (WrappedNamed rt p) (WrappedNamed rt p) wX wY)
commute (NormalP n1 :: Named p wX wZ
n1 :> NormalP n2 :: Named p wZ wY
n2) = do
    n2' :: Named p wX wZ
n2' :> n1' :: Named p wZ wY
n1' <- (:>) (Named p) (Named p) wX wY
-> Maybe ((:>) (Named p) (Named p) wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (Named p wX wZ
n1 Named p wX wZ -> Named p wZ wY -> (:>) (Named p) (Named p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named p wZ wY
n2)
    (:>) (WrappedNamed rt p) (WrappedNamed rt p) wX wY
-> Maybe ((:>) (WrappedNamed rt p) (WrappedNamed rt p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Named p wX wZ -> WrappedNamed rt p wX wZ
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wX wZ
n2' WrappedNamed rt p wX wZ
-> WrappedNamed rt p wZ wY
-> (:>) (WrappedNamed rt p) (WrappedNamed rt p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named p wZ wY -> WrappedNamed rt p wZ wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wZ wY
n1')

  commute (RebaseP i1 :: PatchInfo
i1 s1 :: Suspended p wX wX
s1 :> RebaseP i2 :: PatchInfo
i2 s2 :: Suspended p wZ wZ
s2) =
    -- Two rebases in sequence must have the same starting context,
    -- so they should trivially commute.
    -- This case shouldn't actually happen since each repo only has
    -- a single Suspended patch.
    (:>)
  (WrappedNamed ('RepoType 'IsRebase) p)
  (WrappedNamed ('RepoType 'IsRebase) p)
  wZ
  wX
-> Maybe
     ((:>)
        (WrappedNamed ('RepoType 'IsRebase) p)
        (WrappedNamed ('RepoType 'IsRebase) p)
        wZ
        wX)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
-> Suspended p wZ wZ -> WrappedNamed ('RepoType 'IsRebase) p wZ wZ
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i2 Suspended p wZ wZ
s2 WrappedNamed ('RepoType 'IsRebase) p wZ wZ
-> WrappedNamed ('RepoType 'IsRebase) p wZ wX
-> (:>)
     (WrappedNamed ('RepoType 'IsRebase) p)
     (WrappedNamed ('RepoType 'IsRebase) p)
     wZ
     wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i1 Suspended p wX wX
s1)

  commute (NormalP n1 :: Named p wX wZ
n1 :> RebaseP i2 :: PatchInfo
i2 s2 :: Suspended p wZ wZ
s2) =
    (:>)
  (WrappedNamed ('RepoType 'IsRebase) p) (WrappedNamed rt p) wX wZ
-> Maybe
     ((:>)
        (WrappedNamed ('RepoType 'IsRebase) p) (WrappedNamed rt p) wX wZ)
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i2 (Named p wX wZ -> Suspended p wZ wZ -> Suspended p wX wX
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wY wY -> Suspended p wX wX
Rebase.addFixupsToSuspended Named p wX wZ
n1 Suspended p wZ wZ
s2) WrappedNamed ('RepoType 'IsRebase) p wX wX
-> WrappedNamed rt p wX wZ
-> (:>)
     (WrappedNamed ('RepoType 'IsRebase) p) (WrappedNamed rt p) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named p wX wZ -> WrappedNamed rt p wX wZ
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wX wZ
n1)

  commute (RebaseP i1 :: PatchInfo
i1 s1 :: Suspended p wX wX
s1 :> NormalP n2 :: Named p wZ wY
n2) =
    (:>)
  (WrappedNamed rt p) (WrappedNamed ('RepoType 'IsRebase) p) wZ wY
-> Maybe
     ((:>)
        (WrappedNamed rt p) (WrappedNamed ('RepoType 'IsRebase) p) wZ wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Named p wZ wY -> WrappedNamed rt p wZ wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wZ wY
n2 WrappedNamed rt p wZ wY
-> WrappedNamed ('RepoType 'IsRebase) p wY wY
-> (:>)
     (WrappedNamed rt p) (WrappedNamed ('RepoType 'IsRebase) p) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PatchInfo
-> Suspended p wY wY -> WrappedNamed ('RepoType 'IsRebase) p wY wY
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i1 (Named p wZ wY -> Suspended p wZ wZ -> Suspended p wY wY
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wX wX -> Suspended p wY wY
Rebase.removeFixupsFromSuspended Named p wZ wY
n2 Suspended p wX wX
Suspended p wZ wZ
s1))

instance Merge p => Merge (WrappedNamed rt p) where
  merge :: (:\/:) (WrappedNamed rt p) (WrappedNamed rt p) wX wY
-> (:/\:) (WrappedNamed rt p) (WrappedNamed rt p) wX wY
merge (NormalP n1 :: Named p wZ wX
n1 :\/: NormalP n2 :: Named p wZ wY
n2) =
    case (:\/:) (Named p) (Named p) wX wY
-> (:/\:) (Named p) (Named p) wX wY
forall (p :: * -> * -> *) wX wY.
Merge p =>
(:\/:) p p wX wY -> (:/\:) p p wX wY
merge (Named p wZ wX
n1 Named p wZ wX -> Named p wZ wY -> (:\/:) (Named p) (Named p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: Named p wZ wY
n2) of
      n2' :: Named p wX wZ
n2' :/\: n1' :: Named p wY wZ
n1' -> Named p wX wZ -> WrappedNamed rt p wX wZ
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wX wZ
n2' WrappedNamed rt p wX wZ
-> WrappedNamed rt p wY wZ
-> (:/\:) (WrappedNamed rt p) (WrappedNamed rt p) wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: Named p wY wZ -> WrappedNamed rt p wY wZ
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wY wZ
n1'

  -- shouldn't happen as each repo only has a single Suspended patch
  merge (RebaseP i1 :: PatchInfo
i1 items1 :: Suspended p wZ wZ
items1 :\/: RebaseP i2 :: PatchInfo
i2 items2 :: Suspended p wZ wZ
items2) =
    PatchInfo
-> Suspended p wZ wZ -> WrappedNamed ('RepoType 'IsRebase) p wZ wZ
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i2 Suspended p wZ wZ
items2 WrappedNamed ('RepoType 'IsRebase) p wZ wZ
-> WrappedNamed ('RepoType 'IsRebase) p wZ wZ
-> (:/\:)
     (WrappedNamed ('RepoType 'IsRebase) p)
     (WrappedNamed ('RepoType 'IsRebase) p)
     wZ
     wZ
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: PatchInfo
-> Suspended p wZ wZ -> WrappedNamed ('RepoType 'IsRebase) p wZ wZ
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i1 Suspended p wZ wZ
items1

  merge (NormalP n1 :: Named p wZ wX
n1 :\/: RebaseP i2 :: PatchInfo
i2 s2 :: Suspended p wZ wZ
s2) =
    PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i2 (Named p wZ wX -> Suspended p wZ wZ -> Suspended p wX wX
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wX wX -> Suspended p wY wY
Rebase.removeFixupsFromSuspended Named p wZ wX
n1 Suspended p wZ wZ
s2) WrappedNamed ('RepoType 'IsRebase) p wX wX
-> WrappedNamed rt p wZ wX
-> (:/\:)
     (WrappedNamed ('RepoType 'IsRebase) p) (WrappedNamed rt p) wX wZ
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: Named p wZ wX -> WrappedNamed rt p wZ wX
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wZ wX
n1

  merge (RebaseP i1 :: PatchInfo
i1 s1 :: Suspended p wZ wZ
s1 :\/: NormalP n2 :: Named p wZ wY
n2) =
    Named p wZ wY -> WrappedNamed rt p wZ wY
forall (p :: * -> * -> *) wX wY (rt :: RepoType).
Named p wX wY -> WrappedNamed rt p wX wY
NormalP Named p wZ wY
n2 WrappedNamed rt p wZ wY
-> WrappedNamed ('RepoType 'IsRebase) p wY wY
-> (:/\:)
     (WrappedNamed rt p) (WrappedNamed ('RepoType 'IsRebase) p) wZ wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: PatchInfo
-> Suspended p wY wY -> WrappedNamed ('RepoType 'IsRebase) p wY wY
forall (p :: * -> * -> *) wX.
(PrimPatchBase p, FromPrim p, Effect p) =>
PatchInfo
-> Suspended p wX wX -> WrappedNamed ('RepoType 'IsRebase) p wX wX
RebaseP PatchInfo
i1 (Named p wZ wY -> Suspended p wZ wZ -> Suspended p wY wY
forall (p :: * -> * -> *) wX wY.
(PrimPatchBase p, Commute p, FromPrim p, Effect p) =>
Named p wX wY -> Suspended p wX wX -> Suspended p wY wY
Rebase.removeFixupsFromSuspended Named p wZ wY
n2 Suspended p wZ wZ
s1)