{-# LANGUAGE UndecidableInstances #-}
module Darcs.Patch.Rebase.Fixup
( RebaseFixup(..)
, commuteNamedFixup, commuteFixupNamed, commuteNamedFixups
, flToNamesPrims, namedToFixups
) where
import Prelude ()
import Darcs.Prelude
import Darcs.Patch.Apply ( Apply(..) )
import Darcs.Patch.Commute ( Commute(..), selfCommuter )
import Darcs.Patch.CommuteFn ( totalCommuterIdFL )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.Prim ( FromPrim(..) )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Named ( Named(..), commuterNamedId, commuterIdNamed )
import Darcs.Patch.Prim ( PrimPatchBase(..), PrimPatch )
import Darcs.Patch.Rebase.Name
( RebaseName(..)
, commuteNamedName, commuteNameNamed
, commutePrimName, commuteNamePrim
)
import Darcs.Patch.Witnesses.Eq ( Eq2(..) )
import Darcs.Patch.Witnesses.Ordered
( FL(..), mapFL_FL, (:>)(..), (+>+) )
import Darcs.Patch.Witnesses.Show
( Show1(..), Show2(..), showsPrec2
, ShowDict(ShowDictClass), appPrec
)
data RebaseFixup p wX wY where
PrimFixup :: PrimPatch (PrimOf p) => PrimOf p wX wY -> RebaseFixup p wX wY
NameFixup :: RebaseName p wX wY -> RebaseFixup p wX wY
namedToFixups :: (PrimPatch (PrimOf p), Effect p) => Named p wX wY -> FL (RebaseFixup p) wX wY
namedToFixups :: Named p wX wY -> FL (RebaseFixup p) wX wY
namedToFixups (NamedP p :: PatchInfo
p _ contents :: FL p wX wY
contents) = RebaseName p wX wX -> RebaseFixup p wX wX
forall (p :: * -> * -> *) wX wY.
RebaseName p wX wY -> RebaseFixup p wX wY
NameFixup (PatchInfo -> RebaseName p wX wX
forall (p :: * -> * -> *) wX wY. PatchInfo -> RebaseName p wX wY
AddName PatchInfo
p) RebaseFixup p wX wX
-> FL (RebaseFixup p) wX wY -> FL (RebaseFixup p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: (forall wW wY. PrimOf p wW wY -> RebaseFixup p wW wY)
-> FL (PrimOf p) wX wY -> FL (RebaseFixup 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. PrimOf p wW wY -> RebaseFixup p wW wY
forall (p :: * -> * -> *) wX wY.
PrimPatch (PrimOf p) =>
PrimOf p wX wY -> RebaseFixup p wX wY
PrimFixup (FL p wX wY -> FL (PrimOf (FL p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL p wX wY
contents)
instance Show2 (PrimOf p) => Show (RebaseFixup p wX wY) where
showsPrec :: Int -> RebaseFixup p wX wY -> ShowS
showsPrec d :: Int
d (PrimFixup p :: PrimOf p wX wY
p) =
Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "PrimFixup " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> PrimOf p wX wY -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) PrimOf p wX wY
p
showsPrec d :: Int
d (NameFixup p :: RebaseName p wX wY
p) =
Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "NameFixup " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> RebaseName p wX wY -> ShowS
forall (a :: * -> * -> *) wX wY. Show2 a => Int -> a wX wY -> ShowS
showsPrec2 (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) RebaseName p wX wY
p
instance Show2 (PrimOf p) => Show1 (RebaseFixup p wX) where
showDict1 :: ShowDict (RebaseFixup p wX wX)
showDict1 = ShowDict (RebaseFixup p wX wX)
forall a. Show a => ShowDict a
ShowDictClass
instance Show2 (PrimOf p) => Show2 (RebaseFixup p) where
showDict2 :: ShowDict (RebaseFixup p wX wY)
showDict2 = ShowDict (RebaseFixup p wX wY)
forall a. Show a => ShowDict a
ShowDictClass
instance PrimPatchBase p => PrimPatchBase (RebaseFixup p) where
type PrimOf (RebaseFixup p) = PrimOf p
instance (PrimPatchBase p, ApplyState p ~ ApplyState (PrimOf p)) => Apply (RebaseFixup p) where
type ApplyState (RebaseFixup p) = ApplyState p
apply :: RebaseFixup p wX wY -> m ()
apply (PrimFixup p :: PrimOf p wX wY
p) = PrimOf p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply PrimOf p wX wY
p
apply (NameFixup p :: RebaseName p wX wY
p) = RebaseName p wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply RebaseName p wX wY
p
instance Effect (RebaseFixup p) where
effect :: RebaseFixup p wX wY -> FL (PrimOf (RebaseFixup p)) wX wY
effect (PrimFixup p :: PrimOf p wX wY
p) = PrimOf p wX wY
p PrimOf p wX wY -> FL (PrimOf p) wY wY -> FL (PrimOf p) wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PrimOf p) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
effect (NameFixup p :: RebaseName p wX wY
p) = RebaseName p wX wY -> FL (PrimOf (RebaseName p)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RebaseName p wX wY
p
instance Eq2 (PrimOf p) => Eq2 (RebaseFixup p) where
PrimFixup p1 :: PrimOf p wA wB
p1 unsafeCompare :: RebaseFixup p wA wB -> RebaseFixup p wC wD -> Bool
`unsafeCompare` PrimFixup p2 :: PrimOf p wC wD
p2 = PrimOf p wA wB
p1 PrimOf p wA wB -> PrimOf p wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` PrimOf p wC wD
p2
PrimFixup _ `unsafeCompare` _ = Bool
False
_ `unsafeCompare` PrimFixup _ = Bool
False
NameFixup n1 :: RebaseName p wA wB
n1 `unsafeCompare` NameFixup n2 :: RebaseName p wC wD
n2 = RebaseName p wA wB
n1 RebaseName p wA wB -> RebaseName p wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RebaseName p wC wD
n2
instance Invert (PrimOf p) => Invert (RebaseFixup p) where
invert :: RebaseFixup p wX wY -> RebaseFixup p wY wX
invert (PrimFixup p :: PrimOf p wX wY
p) = PrimOf p wY wX -> RebaseFixup p wY wX
forall (p :: * -> * -> *) wX wY.
PrimPatch (PrimOf p) =>
PrimOf p wX wY -> RebaseFixup p wX wY
PrimFixup (PrimOf p wX wY -> PrimOf p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert PrimOf p wX wY
p)
invert (NameFixup n :: RebaseName p wX wY
n) = RebaseName p wY wX -> RebaseFixup p wY wX
forall (p :: * -> * -> *) wX wY.
RebaseName p wX wY -> RebaseFixup p wX wY
NameFixup (RebaseName p wX wY -> RebaseName p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RebaseName p wX wY
n)
instance PatchInspect (PrimOf p) => PatchInspect (RebaseFixup p) where
listTouchedFiles :: RebaseFixup p wX wY -> [String]
listTouchedFiles (PrimFixup p :: PrimOf p wX wY
p) = PrimOf p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles PrimOf p wX wY
p
listTouchedFiles (NameFixup n :: RebaseName p wX wY
n) = RebaseName p wX wY -> [String]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [String]
listTouchedFiles RebaseName p wX wY
n
hunkMatches :: (ByteString -> Bool) -> RebaseFixup p wX wY -> Bool
hunkMatches f :: ByteString -> Bool
f (PrimFixup p :: PrimOf p wX wY
p) = (ByteString -> Bool) -> PrimOf p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f PrimOf p wX wY
p
hunkMatches f :: ByteString -> Bool
f (NameFixup n :: RebaseName p wX wY
n) = (ByteString -> Bool) -> RebaseName p wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f RebaseName p wX wY
n
instance PrimPatchBase p => Commute (RebaseFixup p) where
commute :: (:>) (RebaseFixup p) (RebaseFixup p) wX wY
-> Maybe ((:>) (RebaseFixup p) (RebaseFixup p) wX wY)
commute (PrimFixup p :: PrimOf p wX wZ
p :> PrimFixup q :: PrimOf p wZ wY
q) = do
q' :: PrimOf p wX wZ
q' :> p' :: PrimOf p wZ wY
p' <- (:>) (PrimOf p) (PrimOf p) wX wY
-> Maybe ((:>) (PrimOf p) (PrimOf p) wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (PrimOf p wX wZ
p PrimOf p wX wZ
-> PrimOf p wZ wY -> (:>) (PrimOf p) (PrimOf p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PrimOf p wZ wY
q)
(:>) (RebaseFixup p) (RebaseFixup p) wX wY
-> Maybe ((:>) (RebaseFixup p) (RebaseFixup p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimOf p wX wZ -> RebaseFixup p wX wZ
forall (p :: * -> * -> *) wX wY.
PrimPatch (PrimOf p) =>
PrimOf p wX wY -> RebaseFixup p wX wY
PrimFixup PrimOf p wX wZ
q' RebaseFixup p wX wZ
-> RebaseFixup p wZ wY
-> (:>) (RebaseFixup p) (RebaseFixup p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PrimOf p wZ wY -> RebaseFixup p wZ wY
forall (p :: * -> * -> *) wX wY.
PrimPatch (PrimOf p) =>
PrimOf p wX wY -> RebaseFixup p wX wY
PrimFixup PrimOf p wZ wY
p')
commute (NameFixup p :: RebaseName p wX wZ
p :> NameFixup q :: RebaseName p wZ wY
q) = do
q' :: RebaseName p wX wZ
q' :> p' :: RebaseName p wZ wY
p' <- (:>) (RebaseName p) (RebaseName p) wX wY
-> Maybe ((:>) (RebaseName p) (RebaseName p) wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RebaseName p wX wZ
p RebaseName p wX wZ
-> RebaseName p wZ wY -> (:>) (RebaseName p) (RebaseName p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseName p wZ wY
q)
(:>) (RebaseFixup p) (RebaseFixup p) wX wY
-> Maybe ((:>) (RebaseFixup p) (RebaseFixup p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (RebaseName p wX wZ -> RebaseFixup p wX wZ
forall (p :: * -> * -> *) wX wY.
RebaseName p wX wY -> RebaseFixup p wX wY
NameFixup RebaseName p wX wZ
q' RebaseFixup p wX wZ
-> RebaseFixup p wZ wY
-> (:>) (RebaseFixup p) (RebaseFixup p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseName p wZ wY -> RebaseFixup p wZ wY
forall (p :: * -> * -> *) wX wY.
RebaseName p wX wY -> RebaseFixup p wX wY
NameFixup RebaseName p wZ wY
p')
commute (PrimFixup p :: PrimOf p wX wZ
p :> NameFixup q :: RebaseName p wZ wY
q) = do
q' :: RebaseName p wX wZ
q' :> p' :: PrimOf p wZ wY
p' <- (:>) (RebaseName p) (PrimOf p) wX wY
-> Maybe ((:>) (RebaseName p) (PrimOf p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (RebaseName p) (PrimOf p) wX wY
-> Maybe ((:>) (RebaseName p) (PrimOf p) wX wY))
-> (:>) (RebaseName p) (PrimOf p) wX wY
-> Maybe ((:>) (RebaseName p) (PrimOf p) wX wY)
forall a b. (a -> b) -> a -> b
$ (:>) (PrimOf p) (RebaseName p) wX wY
-> (:>) (RebaseName p) (PrimOf p) wX wY
forall (p :: * -> * -> *) wX wY.
(:>) (PrimOf p) (RebaseName p) wX wY
-> (:>) (RebaseName p) (PrimOf p) wX wY
commutePrimName (PrimOf p wX wZ
p PrimOf p wX wZ
-> RebaseName p wZ wY -> (:>) (PrimOf p) (RebaseName p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseName p wZ wY
q)
(:>) (RebaseFixup p) (RebaseFixup p) wX wY
-> Maybe ((:>) (RebaseFixup p) (RebaseFixup p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (RebaseName p wX wZ -> RebaseFixup p wX wZ
forall (p :: * -> * -> *) wX wY.
RebaseName p wX wY -> RebaseFixup p wX wY
NameFixup RebaseName p wX wZ
q' RebaseFixup p wX wZ
-> RebaseFixup p wZ wY
-> (:>) (RebaseFixup p) (RebaseFixup p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PrimOf p wZ wY -> RebaseFixup p wZ wY
forall (p :: * -> * -> *) wX wY.
PrimPatch (PrimOf p) =>
PrimOf p wX wY -> RebaseFixup p wX wY
PrimFixup PrimOf p wZ wY
p')
commute (NameFixup p :: RebaseName p wX wZ
p :> PrimFixup q :: PrimOf p wZ wY
q) = do
q' :: PrimOf p wX wZ
q' :> p' :: RebaseName p wZ wY
p' <- (:>) (PrimOf p) (RebaseName p) wX wY
-> Maybe ((:>) (PrimOf p) (RebaseName p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((:>) (PrimOf p) (RebaseName p) wX wY
-> Maybe ((:>) (PrimOf p) (RebaseName p) wX wY))
-> (:>) (PrimOf p) (RebaseName p) wX wY
-> Maybe ((:>) (PrimOf p) (RebaseName p) wX wY)
forall a b. (a -> b) -> a -> b
$ (:>) (RebaseName p) (PrimOf p) wX wY
-> (:>) (PrimOf p) (RebaseName p) wX wY
forall (p :: * -> * -> *) wX wY.
(:>) (RebaseName p) (PrimOf p) wX wY
-> (:>) (PrimOf p) (RebaseName p) wX wY
commuteNamePrim (RebaseName p wX wZ
p RebaseName p wX wZ
-> PrimOf p wZ wY -> (:>) (RebaseName p) (PrimOf p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PrimOf p wZ wY
q)
(:>) (RebaseFixup p) (RebaseFixup p) wX wY
-> Maybe ((:>) (RebaseFixup p) (RebaseFixup p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimOf p wX wZ -> RebaseFixup p wX wZ
forall (p :: * -> * -> *) wX wY.
PrimPatch (PrimOf p) =>
PrimOf p wX wY -> RebaseFixup p wX wY
PrimFixup PrimOf p wX wZ
q' RebaseFixup p wX wZ
-> RebaseFixup p wZ wY
-> (:>) (RebaseFixup p) (RebaseFixup p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseName p wZ wY -> RebaseFixup p wZ wY
forall (p :: * -> * -> *) wX wY.
RebaseName p wX wY -> RebaseFixup p wX wY
NameFixup RebaseName p wZ wY
p')
flToNamesPrims :: PrimPatchBase p
=> FL (RebaseFixup p) wX wY
-> (FL (RebaseName p) :> FL (PrimOf p)) wX wY
flToNamesPrims :: FL (RebaseFixup p) wX wY
-> (:>) (FL (RebaseName p)) (FL (PrimOf p)) wX wY
flToNamesPrims NilFL = FL (RebaseName p) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (RebaseName p) wX wX
-> FL (PrimOf p) wX wX
-> (:>) (FL (RebaseName p)) (FL (PrimOf p)) wX wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimOf p) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
flToNamesPrims (NameFixup n :: RebaseName p wX wY
n :>: fs :: FL (RebaseFixup p) wY wY
fs) =
case FL (RebaseFixup p) wY wY
-> (:>) (FL (RebaseName p)) (FL (PrimOf p)) wY wY
forall (p :: * -> * -> *) wX wY.
PrimPatchBase p =>
FL (RebaseFixup p) wX wY
-> (:>) (FL (RebaseName p)) (FL (PrimOf p)) wX wY
flToNamesPrims FL (RebaseFixup p) wY wY
fs of
names :: FL (RebaseName p) wY wZ
names :> prims :: FL (PrimOf p) wZ wY
prims -> (RebaseName p wX wY
n RebaseName p wX wY
-> FL (RebaseName p) wY wZ -> FL (RebaseName p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseName p) wY wZ
names) FL (RebaseName p) wX wZ
-> FL (PrimOf p) wZ wY
-> (:>) (FL (RebaseName p)) (FL (PrimOf p)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (PrimOf p) wZ wY
prims
flToNamesPrims (PrimFixup p :: PrimOf p wX wY
p :>: fs :: FL (RebaseFixup p) wY wY
fs) =
case FL (RebaseFixup p) wY wY
-> (:>) (FL (RebaseName p)) (FL (PrimOf p)) wY wY
forall (p :: * -> * -> *) wX wY.
PrimPatchBase p =>
FL (RebaseFixup p) wX wY
-> (:>) (FL (RebaseName p)) (FL (PrimOf p)) wX wY
flToNamesPrims FL (RebaseFixup p) wY wY
fs of
names :: FL (RebaseName p) wY wZ
names :> prims :: FL (PrimOf p) wZ wY
prims ->
case TotalCommuteFn (PrimOf p) (RebaseName p)
-> (:>) (PrimOf p) (FL (RebaseName p)) wX wZ
-> (:>) (FL (RebaseName p)) (PrimOf p) wX wZ
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
TotalCommuteFn p1 p2 -> TotalCommuteFn p1 (FL p2)
totalCommuterIdFL TotalCommuteFn (PrimOf p) (RebaseName p)
forall (p :: * -> * -> *) wX wY.
(:>) (PrimOf p) (RebaseName p) wX wY
-> (:>) (RebaseName p) (PrimOf p) wX wY
commutePrimName (PrimOf p wX wY
p PrimOf p wX wY
-> FL (RebaseName p) wY wZ
-> (:>) (PrimOf p) (FL (RebaseName p)) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseName p) wY wZ
names) of
names' :: FL (RebaseName p) wX wZ
names' :> p' :: PrimOf p wZ wZ
p' -> FL (RebaseName p) wX wZ
names' FL (RebaseName p) wX wZ
-> FL (PrimOf p) wZ wY
-> (:>) (FL (RebaseName p)) (FL (PrimOf p)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (PrimOf p wZ wZ
p' PrimOf p wZ wZ -> FL (PrimOf p) wZ wY -> FL (PrimOf p) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (PrimOf p) wZ wY
prims)
commuteNamedPrim :: (FromPrim p, Effect p, Commute p)
=> (Named p :> PrimOf p) wX wY
-> Maybe ((FL (PrimOf p) :> Named p) wX wY)
commuteNamedPrim :: (:>) (Named p) (PrimOf p) wX wY
-> Maybe ((:>) (FL (PrimOf p)) (Named p) wX wY)
commuteNamedPrim (p :: Named p wX wZ
p :> q :: PrimOf p wZ wY
q) = do
q' :: p wX wZ
q' :> p' :: Named p wZ wY
p' <- CommuteFn p p
-> (:>) (Named p) p wX wY -> Maybe ((:>) p (Named p) wX wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (Named p1) p2
commuterNamedId CommuteFn p p
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
selfCommuter (Named p wX wZ
p Named p wX wZ -> p wZ wY -> (:>) (Named p) p wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PrimOf p wZ wY -> p wZ wY
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromPrim PrimOf p wZ wY
q)
(:>) (FL (PrimOf p)) (Named p) wX wY
-> Maybe ((:>) (FL (PrimOf p)) (Named p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (p wX wZ -> FL (PrimOf p) wX wZ
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect p wX wZ
q' FL (PrimOf p) wX wZ
-> Named p wZ wY -> (:>) (FL (PrimOf 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
p')
commutePrimNamed :: (FromPrim p, Effect p, Commute p)
=> (PrimOf p :> Named p) wX wY
-> Maybe ((Named p :> FL (PrimOf p)) wX wY)
commutePrimNamed :: (:>) (PrimOf p) (Named p) wX wY
-> Maybe ((:>) (Named p) (FL (PrimOf p)) wX wY)
commutePrimNamed (p :: PrimOf p wX wZ
p :> q :: Named p wZ wY
q) = do
q' :: Named p wX wZ
q' :> p' :: p wZ wY
p' <- CommuteFn p p
-> (:>) p (Named p) wX wY -> Maybe ((:>) (Named p) p wX wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (Named p2)
commuterIdNamed CommuteFn p p
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
selfCommuter (PrimOf p wX wZ -> p wX wZ
forall (p :: * -> * -> *) wX wY.
FromPrim p =>
PrimOf p wX wY -> p wX wY
fromPrim PrimOf p wX wZ
p p wX wZ -> Named p wZ wY -> (:>) 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
q)
(:>) (Named p) (FL (PrimOf p)) wX wY
-> Maybe ((:>) (Named p) (FL (PrimOf p)) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Named p wX wZ
q' Named p wX wZ
-> FL (PrimOf p) wZ wY -> (:>) (Named p) (FL (PrimOf p)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p wZ wY -> FL (PrimOf p) wZ wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect p wZ wY
p')
commuteNamedFixup :: (FromPrim p, Effect p, Commute p, Invert p)
=> (Named p :> RebaseFixup p) wX wY
-> Maybe ((FL (RebaseFixup p) :> Named p) wX wY)
commuteNamedFixup :: (:>) (Named p) (RebaseFixup p) wX wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wY)
commuteNamedFixup (p :: Named p wX wZ
p :> PrimFixup q :: PrimOf p wZ wY
q) = do
qs' :: FL (PrimOf p) wX wZ
qs' :> p' :: Named p wZ wY
p' <- (:>) (Named p) (PrimOf p) wX wY
-> Maybe ((:>) (FL (PrimOf p)) (Named p) wX wY)
forall (p :: * -> * -> *) wX wY.
(FromPrim p, Effect p, Commute p) =>
(:>) (Named p) (PrimOf p) wX wY
-> Maybe ((:>) (FL (PrimOf p)) (Named p) wX wY)
commuteNamedPrim (Named p wX wZ
p Named p wX wZ -> PrimOf p wZ wY -> (:>) (Named p) (PrimOf p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> PrimOf p wZ wY
q)
(:>) (FL (RebaseFixup p)) (Named p) wX wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((forall wW wY. PrimOf p wW wY -> RebaseFixup p wW wY)
-> FL (PrimOf p) wX wZ -> FL (RebaseFixup p) wX wZ
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. PrimOf p wW wY -> RebaseFixup p wW wY
forall (p :: * -> * -> *) wX wY.
PrimPatch (PrimOf p) =>
PrimOf p wX wY -> RebaseFixup p wX wY
PrimFixup FL (PrimOf p) wX wZ
qs' FL (RebaseFixup p) wX wZ
-> Named p wZ wY -> (:>) (FL (RebaseFixup 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
p')
commuteNamedFixup (p :: Named p wX wZ
p :> NameFixup n :: RebaseName p wZ wY
n) = do
n' :: RebaseName p wX wZ
n' :> p' :: Named p wZ wY
p' <- (:>) (Named p) (RebaseName p) wX wY
-> Maybe ((:>) (RebaseName p) (Named p) wX wY)
forall (p :: * -> * -> *).
Invert p =>
CommuteFn (Named p) (RebaseName p)
commuteNamedName (Named p wX wZ
p Named p wX wZ
-> RebaseName p wZ wY -> (:>) (Named p) (RebaseName p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseName p wZ wY
n)
(:>) (FL (RebaseFixup p)) (Named p) wX wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((RebaseName p wX wZ -> RebaseFixup p wX wZ
forall (p :: * -> * -> *) wX wY.
RebaseName p wX wY -> RebaseFixup p wX wY
NameFixup RebaseName p wX wZ
n' RebaseFixup p wX wZ
-> FL (RebaseFixup p) wZ wZ -> FL (RebaseFixup p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup p) wZ wZ
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) FL (RebaseFixup p) wX wZ
-> Named p wZ wY -> (:>) (FL (RebaseFixup 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
p')
commuteNamedFixups :: (FromPrim p, Effect p, Commute p, Invert p)
=> (Named p :> FL (RebaseFixup p)) wX wY
-> Maybe ((FL (RebaseFixup p) :> Named p) wX wY)
commuteNamedFixups :: (:>) (Named p) (FL (RebaseFixup p)) wX wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wY)
commuteNamedFixups (p :: Named p wX wZ
p :> NilFL) = (:>) (FL (RebaseFixup p)) (Named p) wX wZ
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wZ)
forall (m :: * -> *) a. Monad m => a -> m a
return (FL (RebaseFixup p) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL FL (RebaseFixup p) wX wX
-> Named p wX wZ -> (:>) (FL (RebaseFixup p)) (Named p) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Named p wX wZ
p)
commuteNamedFixups (p :: Named p wX wZ
p :> (q :: RebaseFixup p wZ wY
q :>: rs :: FL (RebaseFixup p) wY wY
rs)) = do
qs' :: FL (RebaseFixup p) wX wZ
qs' :> p' :: Named p wZ wY
p' <- (:>) (Named p) (RebaseFixup p) wX wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wY)
forall (p :: * -> * -> *) wX wY.
(FromPrim p, Effect p, Commute p, Invert p) =>
(:>) (Named p) (RebaseFixup p) wX wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wY)
commuteNamedFixup (Named p wX wZ
p Named p wX wZ
-> RebaseFixup p wZ wY -> (:>) (Named p) (RebaseFixup p) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseFixup p wZ wY
q)
rs' :: FL (RebaseFixup p) wZ wZ
rs' :> p'' :: Named p wZ wY
p'' <- (:>) (Named p) (FL (RebaseFixup p)) wZ wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wZ wY)
forall (p :: * -> * -> *) wX wY.
(FromPrim p, Effect p, Commute p, Invert p) =>
(:>) (Named p) (FL (RebaseFixup p)) wX wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wY)
commuteNamedFixups (Named p wZ wY
p' Named p wZ wY
-> FL (RebaseFixup p) wY wY
-> (:>) (Named p) (FL (RebaseFixup p)) wZ wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RebaseFixup p) wY wY
rs)
(:>) (FL (RebaseFixup p)) (Named p) wX wY
-> Maybe ((:>) (FL (RebaseFixup p)) (Named p) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return ((FL (RebaseFixup p) wX wZ
qs' FL (RebaseFixup p) wX wZ
-> FL (RebaseFixup p) wZ wZ -> FL (RebaseFixup p) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RebaseFixup p) wZ wZ
rs') FL (RebaseFixup p) wX wZ
-> Named p wZ wY -> (:>) (FL (RebaseFixup 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
p'')
commuteFixupNamed :: (FromPrim p, Effect p, Commute p, Invert p)
=> (RebaseFixup p :> Named p) wX wY
-> Maybe ((Named p :> FL (RebaseFixup p)) wX wY)
commuteFixupNamed :: (:>) (RebaseFixup p) (Named p) wX wY
-> Maybe ((:>) (Named p) (FL (RebaseFixup p)) wX wY)
commuteFixupNamed (PrimFixup p :: PrimOf p wX wZ
p :> q :: Named p wZ wY
q) = do
q' :: Named p wX wZ
q' :> ps' :: FL (PrimOf p) wZ wY
ps' <- (:>) (PrimOf p) (Named p) wX wY
-> Maybe ((:>) (Named p) (FL (PrimOf p)) wX wY)
forall (p :: * -> * -> *) wX wY.
(FromPrim p, Effect p, Commute p) =>
(:>) (PrimOf p) (Named p) wX wY
-> Maybe ((:>) (Named p) (FL (PrimOf p)) wX wY)
commutePrimNamed (PrimOf p wX wZ
p PrimOf p wX wZ -> Named p wZ wY -> (:>) (PrimOf 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
q)
(:>) (Named p) (FL (RebaseFixup p)) wX wY
-> Maybe ((:>) (Named p) (FL (RebaseFixup p)) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Named p wX wZ
q' Named p wX wZ
-> FL (RebaseFixup p) wZ wY
-> (:>) (Named p) (FL (RebaseFixup p)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (forall wW wY. PrimOf p wW wY -> RebaseFixup p wW wY)
-> FL (PrimOf p) wZ wY -> FL (RebaseFixup p) wZ wY
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wW wY. PrimOf p wW wY -> RebaseFixup p wW wY
forall (p :: * -> * -> *) wX wY.
PrimPatch (PrimOf p) =>
PrimOf p wX wY -> RebaseFixup p wX wY
PrimFixup FL (PrimOf p) wZ wY
ps')
commuteFixupNamed (NameFixup n :: RebaseName p wX wZ
n :> q :: Named p wZ wY
q) = do
q' :: Named p wX wZ
q' :> n' :: RebaseName p wZ wY
n' <- (:>) (RebaseName p) (Named p) wX wY
-> Maybe ((:>) (Named p) (RebaseName p) wX wY)
forall (p :: * -> * -> *).
Invert p =>
CommuteFn (RebaseName p) (Named p)
commuteNameNamed (RebaseName p wX wZ
n RebaseName p wX wZ
-> Named p wZ wY -> (:>) (RebaseName 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
q)
(:>) (Named p) (FL (RebaseFixup p)) wX wY
-> Maybe ((:>) (Named p) (FL (RebaseFixup p)) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (Named p wX wZ
q' Named p wX wZ
-> FL (RebaseFixup p) wZ wY
-> (:>) (Named p) (FL (RebaseFixup p)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> (RebaseName p wZ wY -> RebaseFixup p wZ wY
forall (p :: * -> * -> *) wX wY.
RebaseName p wX wY -> RebaseFixup p wX wY
NameFixup RebaseName p wZ wY
n' RebaseFixup p wZ wY
-> FL (RebaseFixup p) wY wY -> FL (RebaseFixup p) wZ wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RebaseFixup p) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL))