--  Copyright (C) 2011-2 Ganesh Sittampalam
--
--  BSD3

module Darcs.Patch.Rebase.Name
    ( RebaseName(..)
    , commuteNamePrim, commutePrimName
    , commuterIdNamed, commuterNamedId
    , commuteNameNamed, commuteNamedName
    , pushFixupName
    ) where

import Darcs.Prelude

import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.CommuteFn ( CommuteFn, commuterIdFL, commuterFLId )
import Darcs.Patch.Info ( PatchInfo, showPatchInfo, readPatchInfo )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Named ( Named(..) )
import Darcs.Patch.Read ( ReadPatch(..) )
import Darcs.Patch.Show ( ShowPatchBasic(..), ShowPatch(..) )
import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) )
import Darcs.Patch.Witnesses.Maybe ( Maybe2(..) )
import Darcs.Patch.Witnesses.Ordered ( (:>)(..), FL(..) )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..) )
import Darcs.Patch.Witnesses.Show ( Show1, Show2 )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP, unsafeCoercePEnd )

import Darcs.Patch.Rebase.PushFixup ( PushFixupFn )

import Darcs.Util.Parser ( lexString )
import Darcs.Util.Printer ( empty, blueText, ($$) )

import Control.Applicative ( (<|>) )
import qualified Data.ByteString.Char8 as BC ( pack )

-- Note: in principle this is a general concept not limited to
-- rebase, and we might be able to generalise this type and
-- refactor named patches to use it too.

-- | A 'RebaseName' encapsulates the concept of the name of a patch,
-- without any contents. This allows us to track explicit dependencies
-- in the rebase state, changing them to follow uses of amend-record
-- or unsuspend on a depended-on patch, and warning the user if any
-- are lost entirely.
data RebaseName wX wY where
  AddName :: PatchInfo -> RebaseName wX wY
  DelName :: PatchInfo -> RebaseName wX wY
  Rename :: PatchInfo -> PatchInfo -> RebaseName wX wY
    deriving (RebaseName wX wY -> RebaseName wX wY -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall wX wY. RebaseName wX wY -> RebaseName wX wY -> Bool
/= :: RebaseName wX wY -> RebaseName wX wY -> Bool
$c/= :: forall wX wY. RebaseName wX wY -> RebaseName wX wY -> Bool
== :: RebaseName wX wY -> RebaseName wX wY -> Bool
$c== :: forall wX wY. RebaseName wX wY -> RebaseName wX wY -> Bool
Eq, Int -> RebaseName wX wY -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall wX wY. Int -> RebaseName wX wY -> ShowS
forall wX wY. [RebaseName wX wY] -> ShowS
forall wX wY. RebaseName wX wY -> String
showList :: [RebaseName wX wY] -> ShowS
$cshowList :: forall wX wY. [RebaseName wX wY] -> ShowS
show :: RebaseName wX wY -> String
$cshow :: forall wX wY. RebaseName wX wY -> String
showsPrec :: Int -> RebaseName wX wY -> ShowS
$cshowsPrec :: forall wX wY. Int -> RebaseName wX wY -> ShowS
Show)

instance Show1 (RebaseName wX)

instance Show2 RebaseName

instance ShowPatchBasic RebaseName where
   showPatch :: forall wX wY. ShowPatchFor -> RebaseName wX wY -> Doc
showPatch ShowPatchFor
f (AddName PatchInfo
n) = String -> Doc
blueText String
"addname" Doc -> Doc -> Doc
$$ ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n
   showPatch ShowPatchFor
f (DelName PatchInfo
n) = String -> Doc
blueText String
"delname" Doc -> Doc -> Doc
$$ ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
n
   showPatch ShowPatchFor
f (Rename PatchInfo
old PatchInfo
new) = String -> Doc
blueText String
"rename" Doc -> Doc -> Doc
$$ ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
old Doc -> Doc -> Doc
$$ ShowPatchFor -> PatchInfo -> Doc
showPatchInfo ShowPatchFor
f PatchInfo
new

instance ShowPatch RebaseName where
   summary :: forall wX wY. RebaseName wX wY -> Doc
summary RebaseName wX wY
_ = Doc
empty -- TODO improve this?
   summaryFL :: forall wX wY. FL RebaseName wX wY -> Doc
summaryFL FL RebaseName wX wY
_ = Doc
empty

instance ReadPatch RebaseName where
   readPatch' :: forall wX. Parser (Sealed (RebaseName wX))
readPatch' = forall wX. Parser (Sealed (RebaseName wX))
readAddName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall wX. Parser (Sealed (RebaseName wX))
readDelName forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall wX. Parser (Sealed (RebaseName wX))
readRename
     where
       readAddName :: Parser ByteString (Sealed (RebaseName wX))
readAddName = do ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"addname")
                        PatchInfo
n <- Parser PatchInfo
readPatchInfo
                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wY. a wY -> Sealed a
Sealed (forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
n))
       readDelName :: Parser ByteString (Sealed (RebaseName wX))
readDelName = do ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"delname")
                        PatchInfo
n <- Parser PatchInfo
readPatchInfo
                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wY. a wY -> Sealed a
Sealed (forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
n))
       readRename :: Parser ByteString (Sealed (RebaseName wX))
readRename  = do ByteString -> Parser ()
lexString (String -> ByteString
BC.pack String
"rename")
                        PatchInfo
old <- Parser PatchInfo
readPatchInfo
                        PatchInfo
new <- Parser PatchInfo
readPatchInfo
                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall (a :: * -> *) wY. a wY -> Sealed a
Sealed (forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
old PatchInfo
new))

instance Commute RebaseName where
   commute :: forall wX wY.
(:>) RebaseName RebaseName wX wY
-> Maybe ((:>) RebaseName RebaseName wX wY)
commute (AddName PatchInfo
n1 :> AddName PatchInfo
n2)
      | PatchInfo
n1 forall a. Eq a => a -> a -> Bool
== PatchInfo
n2 = forall a. HasCallStack => String -> a
error String
"impossible case"
      | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
n2 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
n1)
   commute (DelName PatchInfo
n1 :> DelName PatchInfo
n2)
      | PatchInfo
n1 forall a. Eq a => a -> a -> Bool
== PatchInfo
n2 = forall a. HasCallStack => String -> a
error String
"impossible case"
      | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
n2 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
n1)
   commute (AddName PatchInfo
n1 :> DelName PatchInfo
n2)
      | PatchInfo
n1 forall a. Eq a => a -> a -> Bool
/= PatchInfo
n2 = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
n2 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
n1)
      | Bool
otherwise = forall a. Maybe a
Nothing
   commute (DelName PatchInfo
n1 :> AddName PatchInfo
n2)
      | PatchInfo
n1 forall a. Eq a => a -> a -> Bool
/= PatchInfo
n2 = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
n2 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
n1)
      | Bool
otherwise = forall a. Maybe a
Nothing
   commute (Rename PatchInfo
old PatchInfo
new :> AddName PatchInfo
n)
      | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
old = forall a. Maybe a
Nothing
      | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
new = forall a. HasCallStack => String -> a
error String
"impossible case" -- precondition of Add is that n doesn't exist
      | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
n 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)
   commute (AddName PatchInfo
n :> Rename PatchInfo
old PatchInfo
new)
      | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
old = forall a. Maybe a
Nothing
      | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
new = forall a. HasCallStack => String -> a
error String
"impossible case" -- precondition of Rename is that new doesn't exist
      | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
old PatchInfo
new 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
n)
   commute (Rename PatchInfo
old PatchInfo
new :> DelName PatchInfo
n)
      | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
old = forall a. HasCallStack => String -> a
error String
"impossible case" -- precondition of Del is that n does exist
      | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
new = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
n 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)
   commute (DelName PatchInfo
n :> Rename PatchInfo
old PatchInfo
new)
      | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
old = forall a. HasCallStack => String -> a
error String
"impossible case" -- precondition of Rename is that old does exist
      | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
new = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
old PatchInfo
new 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
n)
   commute (Rename PatchInfo
old1 PatchInfo
new1 :> Rename PatchInfo
old2 PatchInfo
new2)
      | PatchInfo
old1 forall a. Eq a => a -> a -> Bool
== PatchInfo
old2 = forall a. HasCallStack => String -> a
error String
"impossible case"
      | PatchInfo
new1 forall a. Eq a => a -> a -> Bool
== PatchInfo
new2 = forall a. HasCallStack => String -> a
error String
"impossible case"
      | PatchInfo
old1 forall a. Eq a => a -> a -> Bool
== PatchInfo
new2 = forall a. Maybe a
Nothing
      | PatchInfo
new1 forall a. Eq a => a -> a -> Bool
== PatchInfo
old2 = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
old2 PatchInfo
new2 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
old1 PatchInfo
new1)

instance Invert RebaseName where
   invert :: forall wX wY. RebaseName wX wY -> RebaseName wY wX
invert (AddName PatchInfo
n) = forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
n
   invert (DelName PatchInfo
n) = forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
n
   invert (Rename PatchInfo
old PatchInfo
new) = forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
new PatchInfo
old

instance PatchInspect RebaseName where
    listTouchedFiles :: forall wX wY. RebaseName wX wY -> [AnchoredPath]
listTouchedFiles RebaseName wX wY
_ = []
    hunkMatches :: forall wX wY. (ByteString -> Bool) -> RebaseName wX wY -> Bool
hunkMatches ByteString -> Bool
_ RebaseName wX wY
_ = Bool
False

instance Eq2 RebaseName where
   RebaseName wA wB
p1 =\/= :: forall wA wB wC.
RebaseName wA wB -> RebaseName wA wC -> EqCheck wB wC
=\/= RebaseName wA wC
p2
      | RebaseName wA wB
p1 forall a. Eq a => a -> a -> Bool
== forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd RebaseName wA wC
p2 = forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd forall wA. EqCheck wA wA
IsEq
      | Bool
otherwise = forall wA wB. EqCheck wA wB
NotEq

-- |Commute a 'RebaseName' and a primitive patch. They trivially
-- commute so this just involves changing the witnesses.
-- This is unsafe if the patch being commuted actually has a
-- name (e.g. Named or PatchInfo - PrimWithName is ok),
commuteNamePrim :: (RebaseName :> prim) wX wY -> (prim :> RebaseName) wX wY
commuteNamePrim :: forall (prim :: * -> * -> *) wX wY.
(:>) RebaseName prim wX wY -> (:>) prim RebaseName wX wY
commuteNamePrim (RebaseName wX wZ
n :> prim wZ wY
f) = forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP prim wZ wY
f forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RebaseName wX wZ
n

-- |Commute a primitive patch and a 'RebaseName'. They trivially
-- commute so this just involves changing the witnesses.
-- This is unsafe if the patch being commuted actually has a
-- name (e.g. Named or PatchInfo - PrimWithName is ok),
commutePrimName :: (prim :> RebaseName) wX wY -> (RebaseName :> prim) wX wY
commutePrimName :: forall (prim :: * -> * -> *) wX wY.
(:>) prim RebaseName wX wY -> (:>) RebaseName prim wX wY
commutePrimName (prim wX wZ
f :> RebaseName wZ wY
n) = forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RebaseName wZ wY
n forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP prim wX wZ
f

-- commuterIdNamed and commuterNamedId are defined here rather than in
-- Named given that they are unsafe, to reduce the chances of them
-- being used inappropriately.

-- |Commute an unnamed patch with a named patch. This is unsafe if the
-- second patch actually does have a name (e.g. Named, PatchInfoAnd, etc),
-- as it won't check the explicit dependencies.
commuterIdNamed :: CommuteFn p1 p2 -> CommuteFn p1 (Named p2)
commuterIdNamed :: forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (Named p2)
commuterIdNamed CommuteFn p1 p2
commuter (p1 wX wZ
p1 :> NamedP PatchInfo
n2 [PatchInfo]
d2 FL p2 wZ wY
p2) =
   do FL p2 wX wZ
p2' :> p1 wZ wY
p1' <- forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL CommuteFn p1 p2
commuter (p1 wX wZ
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL p2 wZ wY
p2)
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n2 [PatchInfo]
d2 FL p2 wX wZ
p2' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p1 wZ wY
p1')

-- |Commute an unnamed patch with a named patch. This is unsafe if the
-- first patch actually does have a name (e.g. Named, PatchInfoAnd, etc),
-- as it won't check the explicit dependencies.
commuterNamedId :: CommuteFn p1 p2 -> CommuteFn (Named p1) p2
commuterNamedId :: forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (Named p1) p2
commuterNamedId CommuteFn p1 p2
commuter (NamedP PatchInfo
n1 [PatchInfo]
d1 FL p1 wX wZ
p1 :> p2 wZ wY
p2) =
   do p2 wX wZ
p2' :> FL p1 wZ wY
p1' <- forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (FL p1) p2
commuterFLId CommuteFn p1 p2
commuter (FL p1 wX wZ
p1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> p2 wZ wY
p2)
      forall (m :: * -> *) a. Monad m => a -> m a
return (p2 wX wZ
p2' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP PatchInfo
n1 [PatchInfo]
d1 FL p1 wZ wY
p1')

-- |Commute a name patch and a named patch. In most cases this is
-- trivial but we do need to check explicit dependencies.
commuteNameNamed :: CommuteFn RebaseName (Named p)
commuteNameNamed :: forall (p :: * -> * -> *). CommuteFn RebaseName (Named p)
commuteNameNamed (AddName PatchInfo
an :> p :: Named p wZ wY
p@(NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
_))
  | PatchInfo
an forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
  | PatchInfo
an forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Named 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
AddName PatchInfo
an)
commuteNameNamed (DelName PatchInfo
dn :> p :: Named p wZ wY
p@(NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
_))
  -- this case can arise if a patch is suspended then a fresh copy is pulled from another repo
  | PatchInfo
dn forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. Maybe a
Nothing
  | 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. a -> Maybe a
Just (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Named 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)
commuteNameNamed (Rename PatchInfo
old PatchInfo
new :> NamedP PatchInfo
pn [PatchInfo]
deps FL p wZ wY
body)
  | 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 a. a -> Maybe a
Just (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) 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)

-- |Commute a named patch and a name patch. In most cases this is
-- trivial but we do need to check explicit dependencies.
commuteNamedName :: CommuteFn (Named p) RebaseName
commuteNamedName :: forall (p :: * -> * -> *). CommuteFn (Named p) RebaseName
commuteNamedName (p :: Named p wX wZ
p@(NamedP PatchInfo
pn [PatchInfo]
deps FL p wX wZ
_) :> AddName PatchInfo
an)
  | PatchInfo
an forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"  -- the NamedP introduces pn, then AddName introduces it again
  | PatchInfo
an forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = forall a. HasCallStack => String -> a
error String
"impossible case" -- the NamedP depends on an before it is introduced
  | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
an forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Named p wX wZ
p)
commuteNamedName (p :: Named p wX wZ
p@(NamedP PatchInfo
pn [PatchInfo]
deps FL p wX wZ
_) :> DelName PatchInfo
dn)
  | PatchInfo
dn forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. Maybe a
Nothing
  | PatchInfo
dn forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
deps = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
dn forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Named p wX wZ
p)
commuteNamedName (NamedP PatchInfo
pn [PatchInfo]
deps FL p wX wZ
body :> Rename PatchInfo
old PatchInfo
new)
  | PatchInfo
old forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. Maybe a
Nothing
  | PatchInfo
new forall a. Eq a => a -> a -> Bool
== PatchInfo
pn = forall a. HasCallStack => String -> a
error String
"impossible case"
  | PatchInfo
new 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
old forall a. Eq a => a -> a -> Bool
== PatchInfo
dep then PatchInfo
new else PatchInfo
dep) [PatchInfo]
deps
      in forall a. a -> Maybe a
Just (forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
old PatchInfo
new forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> 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 wX wZ
body))

canonizeNamePair :: (RebaseName :> RebaseName) wX wY -> FL RebaseName wX wY
canonizeNamePair :: forall wX wY.
(:>) RebaseName RebaseName wX wY -> FL RebaseName wX wY
canonizeNamePair (AddName PatchInfo
n :> Rename PatchInfo
old PatchInfo
new) | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
old = forall wX wY. PatchInfo -> RebaseName wX wY
AddName PatchInfo
new forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
canonizeNamePair (Rename PatchInfo
old PatchInfo
new :> DelName PatchInfo
n) | PatchInfo
n forall a. Eq a => a -> a -> Bool
== PatchInfo
new = forall wX wY. PatchInfo -> RebaseName wX wY
DelName PatchInfo
old forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
canonizeNamePair (Rename PatchInfo
old1 PatchInfo
new1 :> Rename PatchInfo
old2 PatchInfo
new2) | PatchInfo
new1 forall a. Eq a => a -> a -> Bool
== PatchInfo
old2 = forall wX wY. PatchInfo -> PatchInfo -> RebaseName wX wY
Rename PatchInfo
old1 PatchInfo
new2 forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
canonizeNamePair (RebaseName wX wZ
n1 :> RebaseName wZ wY
n2) = RebaseName wX wZ
n1 forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: RebaseName wZ wY
n2 forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

pushFixupName :: PushFixupFn RebaseName RebaseName (FL RebaseName) (Maybe2 RebaseName)
pushFixupName :: PushFixupFn
  RebaseName RebaseName (FL RebaseName) (Maybe2 RebaseName)
pushFixupName (RebaseName wX wZ
n1 :> RebaseName wZ wY
n2)
 | EqCheck wX wY
IsEq <- EqCheck wX wY
isInverse = forall (a :: * -> * -> *) wX. FL a wX wX
NilFL forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (p :: * -> * -> *) wX. Maybe2 p wX wX
Nothing2
 | Bool
otherwise
   = case forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RebaseName wX wZ
n1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseName wZ wY
n2) of
       Maybe ((:>) RebaseName RebaseName wX wY)
Nothing -> (forall wX wY.
(:>) RebaseName RebaseName wX wY -> FL RebaseName wX wY
canonizeNamePair (RebaseName wX wZ
n1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RebaseName wZ wY
n2)) 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 (RebaseName wX wZ
n2' :> RebaseName wZ wY
n1') -> (RebaseName wX wZ
n2' forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) 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 RebaseName wZ wY
n1'
  where isInverse :: EqCheck wX wY
isInverse = forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RebaseName wX wZ
n1 forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= RebaseName wZ wY
n2