--  Copyright (C) 2002-2003 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Darcs.Patch.V1.Commute
    (
      merge,
      merger, unravel,
      publicUnravel,
    )
       where

import Darcs.Prelude

import Control.Monad ( MonadPlus, mplus, msum, mzero, guard )
import Control.Applicative ( Alternative(..) )
import Data.Maybe ( fromMaybe )

import Darcs.Patch.Commute ( selfCommuter )
import Darcs.Patch.CommuteFn ( commuterIdFL, commuterFLId )
import Darcs.Util.Path ( AnchoredPath )
import Darcs.Patch.Invert ( invertRL )
import Darcs.Patch.Merge ( CleanMerge(..), Merge(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Inspect ( PatchInspect(..) )
import Darcs.Patch.V1.Core ( RepoPatchV1(..),
                             isMerger,
                             mergerUndo )
import Darcs.Patch.CommuteNoConflicts
    ( CommuteNoConflicts(..)
    , mergeNoConflicts
    )
import Darcs.Patch.Conflict
  ( Conflict(..), combineConflicts, mangleOrFail
  )
import Darcs.Patch.Unwind ( Unwind(..), Unwound(..), mkUnwound )
import Darcs.Patch.Effect ( Effect(..) )
import Darcs.Patch.FileHunk ( IsHunk(..) )
import Darcs.Patch.Prim ( PrimPatch, is_filepatch )
import Darcs.Patch.Permutations
    ( headPermutationsRL
    , simpleHeadPermutationsFL
    , removeFL
    )
import Darcs.Util.Printer ( renderString, text, vcat, ($$) )
import Darcs.Patch.V1.Show ( showPatch_ )
import Data.List ( nub )
import Data.List.Ordered ( nubSort )
import Darcs.Patch.Summary
    ( Summary(..)
    , ConflictState(..)
    , IsConflictedPrim(..)
    )
import Darcs.Patch.Witnesses.Sealed
    ( Sealed(..) , mapSeal, unseal
    , FlippedSeal(..), mapFlipped, unsealFlipped
    )
import Darcs.Patch.Witnesses.Eq ( EqCheck(..), Eq2(..) )
import Darcs.Patch.Witnesses.Unsafe
    ( unsafeCoerceP, unsafeCoercePStart
    , unsafeCoercePEnd )
import Darcs.Patch.Witnesses.Ordered
    ( mapFL_FL, mapFL,
    FL(..), RL(..), (+>+),
    (:/\:)(..), (:\/:)(..), (:>)(..),
    lengthFL, mapRL,
    reverseFL, reverseRL, concatFL
    )

data Perhaps a = Unknown | Failed | Succeeded a

instance Functor Perhaps where
    fmap :: (a -> b) -> Perhaps a -> Perhaps b
fmap a -> b
_ Perhaps a
Unknown = Perhaps b
forall a. Perhaps a
Unknown
    fmap a -> b
_ Perhaps a
Failed = Perhaps b
forall a. Perhaps a
Failed
    fmap a -> b
f (Succeeded a
x) = b -> Perhaps b
forall a. a -> Perhaps a
Succeeded (a -> b
f a
x)

instance Applicative Perhaps where
    pure :: a -> Perhaps a
pure = a -> Perhaps a
forall a. a -> Perhaps a
Succeeded
    Perhaps (a -> b)
_ <*> :: Perhaps (a -> b) -> Perhaps a -> Perhaps b
<*> Perhaps a
Failed = Perhaps b
forall a. Perhaps a
Failed
    Perhaps (a -> b)
_ <*> Perhaps a
Unknown = Perhaps b
forall a. Perhaps a
Unknown
    Perhaps (a -> b)
Failed <*> Perhaps a
_ = Perhaps b
forall a. Perhaps a
Failed
    Perhaps (a -> b)
Unknown <*> Perhaps a
_ = Perhaps b
forall a. Perhaps a
Unknown
    Succeeded a -> b
f <*> Succeeded a
x = b -> Perhaps b
forall a. a -> Perhaps a
Succeeded (a -> b
f a
x)

instance  Monad Perhaps where
    (Succeeded a
x) >>= :: Perhaps a -> (a -> Perhaps b) -> Perhaps b
>>= a -> Perhaps b
k =  a -> Perhaps b
k a
x
    Perhaps a
Failed   >>= a -> Perhaps b
_      =  Perhaps b
forall a. Perhaps a
Failed
    Perhaps a
Unknown  >>= a -> Perhaps b
_      =  Perhaps b
forall a. Perhaps a
Unknown
    return :: a -> Perhaps a
return              =  a -> Perhaps a
forall a. a -> Perhaps a
Succeeded

instance Alternative Perhaps where
    empty :: Perhaps a
empty = Perhaps a
forall a. Perhaps a
Unknown
    Perhaps a
Unknown <|> :: Perhaps a -> Perhaps a -> Perhaps a
<|> Perhaps a
ys    = Perhaps a
ys
    Perhaps a
Failed  <|> Perhaps a
_     = Perhaps a
forall a. Perhaps a
Failed
    (Succeeded a
x) <|> Perhaps a
_ = a -> Perhaps a
forall a. a -> Perhaps a
Succeeded a
x

instance  MonadPlus Perhaps where
    mzero :: Perhaps a
mzero = Perhaps a
forall a. Perhaps a
Unknown
    mplus :: Perhaps a -> Perhaps a -> Perhaps a
mplus = Perhaps a -> Perhaps a -> Perhaps a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

toMaybe :: Perhaps a -> Maybe a
toMaybe :: Perhaps a -> Maybe a
toMaybe (Succeeded a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
toMaybe Perhaps a
_ = Maybe a
forall a. Maybe a
Nothing

toPerhaps :: Maybe a -> Perhaps a
toPerhaps :: Maybe a -> Perhaps a
toPerhaps (Just a
x) = a -> Perhaps a
forall a. a -> Perhaps a
Succeeded a
x
toPerhaps Maybe a
Nothing = Perhaps a
forall a. Perhaps a
Failed

-- | 'cleverCommute' attempts to commute two patches @p1@ and @p2@, in their
-- original order, with the given commute function. If the commute function
-- doesn't know how to handle the patches (i.e. it returns Unknown as a
-- result), then we try again with @invert p2@ and @invert p1@ (inverting the
-- results, if succesful).
--
-- TODO: when can the first attempt fail, but the second not? What's so clever
-- in this function?
cleverCommute :: Invert prim => CommuteFunction prim -> CommuteFunction prim
cleverCommute :: CommuteFunction prim -> CommuteFunction prim
cleverCommute CommuteFunction prim
c (RepoPatchV1 prim wX wZ
p1 :> RepoPatchV1 prim wZ wY
p2) = case (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
CommuteFunction prim
c (RepoPatchV1 prim wX wZ
p1 RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wZ wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wY
p2) of
    Succeeded (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x -> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. a -> Perhaps a
Succeeded (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x
    Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
Failed -> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a
Failed
    Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
Unknown -> case (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wY wX
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wY wX)
CommuteFunction prim
c (RepoPatchV1 prim wZ wY -> RepoPatchV1 prim wY wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wZ wY
p2 RepoPatchV1 prim wY wZ
-> RepoPatchV1 prim wZ wX
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wY wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wX wZ -> RepoPatchV1 prim wZ wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wX wZ
p1) of
                 Succeeded (RepoPatchV1 prim wY wZ
ip1' :> RepoPatchV1 prim wZ wX
ip2') -> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. a -> Perhaps a
Succeeded (RepoPatchV1 prim wZ wX -> RepoPatchV1 prim wX wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wZ wX
ip2' RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wZ wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wY wZ -> RepoPatchV1 prim wZ wY
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wY wZ
ip1')
                 Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wY wX)
Failed -> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a
Failed
                 Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wY wX)
Unknown -> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a
Unknown

-- | If we have two Filepatches which modify different files, we can return a
-- result early, since the patches trivially commute.
speedyCommute :: PrimPatch prim => CommuteFunction prim
speedyCommute :: CommuteFunction prim
speedyCommute (RepoPatchV1 prim wX wZ
p1 :> RepoPatchV1 prim wZ wY
p2)
    | Just AnchoredPath
m1 <- RepoPatchV1 prim wX wZ -> Maybe AnchoredPath
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> Maybe AnchoredPath
isFilepatchMerger RepoPatchV1 prim wX wZ
p1
    , Just AnchoredPath
m2 <- RepoPatchV1 prim wZ wY -> Maybe AnchoredPath
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> Maybe AnchoredPath
isFilepatchMerger RepoPatchV1 prim wZ wY
p2
    , AnchoredPath
m1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
/= AnchoredPath
m2 = (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. a -> Perhaps a
Succeeded (RepoPatchV1 prim wZ wY -> RepoPatchV1 prim wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RepoPatchV1 prim wZ wY
p2 RepoPatchV1 prim wX Any
-> RepoPatchV1 prim Any wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wX wZ -> RepoPatchV1 prim Any wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RepoPatchV1 prim wX wZ
p1)
    | Bool
otherwise = Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a
Unknown

everythingElseCommute :: forall prim . PrimPatch prim => CommuteFunction prim
everythingElseCommute :: CommuteFunction prim
everythingElseCommute (PP prim wX wZ
p1 :> PP prim wZ wY
p2) = Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Maybe a -> Perhaps a
toPerhaps (Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
 -> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY))
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a b. (a -> b) -> a -> b
$ do
    prim wX wZ
p2' :> prim wZ wY
p1' <- (:>) prim prim wX wY -> Maybe ((:>) prim prim wX wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (prim wX wZ
p1 prim wX wZ -> prim wZ wY -> (:>) prim prim wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> prim wZ wY
p2)
    (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (prim wX wZ -> RepoPatchV1 prim wX wZ
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV1 prim wX wY
PP prim wX wZ
p2' RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wZ wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> prim wZ wY -> RepoPatchV1 prim wZ wY
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV1 prim wX wY
PP prim wZ wY
p1')
everythingElseCommute (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
ps =
    [Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)]
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ CommuteFunction prim
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (prim :: * -> * -> *).
Invert prim =>
CommuteFunction prim -> CommuteFunction prim
cleverCommute CommuteFunction prim
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
(:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
commuteRecursiveMerger      (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
ps
         , CommuteFunction prim
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (prim :: * -> * -> *).
Invert prim =>
CommuteFunction prim -> CommuteFunction prim
cleverCommute CommuteFunction prim
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
(:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
otherCommuteRecursiveMerger (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
ps
         ]

{-
Note that it must be true that

commutex (A^-1 A, P) = Just (P, A'^-1 A')

and

if commutex (A, B) == Just (B', A')
then commutex (B^-1, A^-1) == Just (A'^-1, B'^-1)
-}

unsafeMerger :: PrimPatch prim => String -> RepoPatchV1 prim wX wY -> RepoPatchV1 prim wX wZ -> RepoPatchV1 prim wA wB
unsafeMerger :: String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
x RepoPatchV1 prim wX wY
p1 RepoPatchV1 prim wX wZ
p2 = (forall wX. RepoPatchV1 prim wY wX -> RepoPatchV1 prim wA wB)
-> Sealed (RepoPatchV1 prim wY) -> RepoPatchV1 prim wA wB
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal forall wX. RepoPatchV1 prim wY wX -> RepoPatchV1 prim wA wB
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP (Sealed (RepoPatchV1 prim wY) -> RepoPatchV1 prim wA wB)
-> Sealed (RepoPatchV1 prim wY) -> RepoPatchV1 prim wA wB
forall a b. (a -> b) -> a -> b
$ String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> Sealed (RepoPatchV1 prim wY)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> Sealed (RepoPatchV1 prim wY)
merger String
x RepoPatchV1 prim wX wY
p1 RepoPatchV1 prim wX wZ
p2

-- | Attempt to commute two patches, the first of which is a Merger patch.
mergerCommute :: PrimPatch prim
              => (RepoPatchV1 prim :> RepoPatchV1 prim) wX wY -> Perhaps ((RepoPatchV1 prim :> RepoPatchV1 prim) wX wY)
mergerCommute :: (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
mergerCommute (RepoPatchV1 prim wX wZ
pA :> Merger FL (RepoPatchV1 prim) wZ wY
_ RL (RepoPatchV1 prim) wZ wB
_ RepoPatchV1 prim wC wZ
p1 RepoPatchV1 prim wC wD
p2)
    | RepoPatchV1 prim wX wZ -> RepoPatchV1 prim wC wZ -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare RepoPatchV1 prim wX wZ
pA RepoPatchV1 prim wC wZ
p1 = (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. a -> Perhaps a
Succeeded (RepoPatchV1 prim wC wD -> RepoPatchV1 prim wX wD
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart RepoPatchV1 prim wC wD
p2 RepoPatchV1 prim wX wD
-> RepoPatchV1 prim wD wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> String
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wC wZ
-> RepoPatchV1 prim wD wY
forall (prim :: * -> * -> *) wX wY wZ wA wB.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
"0.0" RepoPatchV1 prim wC wD
p2 RepoPatchV1 prim wC wZ
p1)
    | RepoPatchV1 prim wX wZ -> RepoPatchV1 prim Any Any -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare RepoPatchV1 prim wX wZ
pA (RepoPatchV1 prim Any Any -> RepoPatchV1 prim Any Any
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (String
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wC wZ
-> RepoPatchV1 prim Any Any
forall (prim :: * -> * -> *) wX wY wZ wA wB.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
"0.0" RepoPatchV1 prim wC wD
p2 RepoPatchV1 prim wC wZ
p1)) = Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a
Failed
mergerCommute (Merger FL (RepoPatchV1 prim) wX wZ
_ RL (RepoPatchV1 prim) wX wB
_ RepoPatchV1 prim wC wX
b' RepoPatchV1 prim wC wD
c'' :> Merger FL (RepoPatchV1 prim) wZ wY
_ RL (RepoPatchV1 prim) wZ wB
_ (Merger FL (RepoPatchV1 prim) wC wZ
_ RL (RepoPatchV1 prim) wC wB
_ RepoPatchV1 prim wC wC
c RepoPatchV1 prim wC wD
b) (Merger FL (RepoPatchV1 prim) wC wD
_ RL (RepoPatchV1 prim) wC wB
_ RepoPatchV1 prim wC wC
c' RepoPatchV1 prim wC wD
a))
    | RepoPatchV1 prim wC wX -> RepoPatchV1 prim wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare RepoPatchV1 prim wC wX
b' RepoPatchV1 prim wC wD
b Bool -> Bool -> Bool
&& RepoPatchV1 prim wC wC -> RepoPatchV1 prim wC wC -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare RepoPatchV1 prim wC wC
c RepoPatchV1 prim wC wC
c' Bool -> Bool -> Bool
&& RepoPatchV1 prim wC wC -> RepoPatchV1 prim wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare RepoPatchV1 prim wC wC
c RepoPatchV1 prim wC wD
c'' =
        (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. a -> Perhaps a
Succeeded ( String
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wX Any
forall (prim :: * -> * -> *) wX wY wZ wA wB.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
"0.0" RepoPatchV1 prim wC wD
b (RepoPatchV1 prim wC wD -> RepoPatchV1 prim wC wD
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart RepoPatchV1 prim wC wD
a) RepoPatchV1 prim wX Any
-> RepoPatchV1 prim Any wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:>
                    String
-> RepoPatchV1 prim Any Any
-> RepoPatchV1 prim Any Any
-> RepoPatchV1 prim Any wY
forall (prim :: * -> * -> *) wX wY wZ wA wB.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
"0.0" (String
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim Any Any
forall (prim :: * -> * -> *) wX wY wZ wA wB.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
"0.0" RepoPatchV1 prim wC wD
b (RepoPatchV1 prim wC wD -> RepoPatchV1 prim wC wD
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart RepoPatchV1 prim wC wD
a)) (String
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wC wC
-> RepoPatchV1 prim Any Any
forall (prim :: * -> * -> *) wX wY wZ wA wB.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
"0.0" RepoPatchV1 prim wC wD
b RepoPatchV1 prim wC wC
c)
                  )
mergerCommute (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
_ = Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a
Unknown

instance PrimPatch prim => CleanMerge (RepoPatchV1 prim) where
    cleanMerge :: (:\/:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Maybe ((:/\:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
cleanMerge = (:\/:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Maybe ((:/\:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (p :: * -> * -> *) wX wY.
(Invert p, CommuteNoConflicts p) =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
mergeNoConflicts

instance PrimPatch prim => Merge (RepoPatchV1 prim) where
    merge :: (:\/:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> (:/\:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
merge (RepoPatchV1 prim wZ wX
p1 :\/: RepoPatchV1 prim wZ wY
p2) =
        case (:\/:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Maybe ((:/\:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (p :: * -> * -> *) wX wY.
(Invert p, CommuteNoConflicts p) =>
(:\/:) p p wX wY -> Maybe ((:/\:) p p wX wY)
mergeNoConflicts (RepoPatchV1 prim wZ wX
p1 RepoPatchV1 prim wZ wX
-> RepoPatchV1 prim wZ wY
-> (:\/:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wZ wX -> a2 wZ wY -> (:\/:) a1 a2 wX wY
:\/: RepoPatchV1 prim wZ wY
p2) of
            Just (:/\:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
r -> (:/\:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
r
            Maybe ((:/\:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
Nothing ->
                case String
-> RepoPatchV1 prim wZ wX
-> RepoPatchV1 prim wZ wY
-> Sealed (RepoPatchV1 prim wX)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> Sealed (RepoPatchV1 prim wY)
merger String
"0.0" RepoPatchV1 prim wZ wX
p1 RepoPatchV1 prim wZ wY
p2 of
                    Sealed RepoPatchV1 prim wX wX
p2' ->
                        case String
-> RepoPatchV1 prim wZ wY
-> RepoPatchV1 prim wZ wX
-> Sealed (RepoPatchV1 prim wY)
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> Sealed (RepoPatchV1 prim wY)
merger String
"0.0" RepoPatchV1 prim wZ wY
p2 RepoPatchV1 prim wZ wX
p1 of
                            Sealed RepoPatchV1 prim wY wX
p1' -> RepoPatchV1 prim wX wX -> RepoPatchV1 prim wX Any
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd RepoPatchV1 prim wX wX
p2' RepoPatchV1 prim wX Any
-> RepoPatchV1 prim wY Any
-> (:/\:) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a3 :: * -> * -> *) (a4 :: * -> * -> *) wX wY wZ.
a3 wX wZ -> a4 wY wZ -> (:/\:) a3 a4 wX wY
:/\: RepoPatchV1 prim wY wX -> RepoPatchV1 prim wY Any
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd RepoPatchV1 prim wY wX
p1'

instance PrimPatch prim => Commute (RepoPatchV1 prim) where
    commute :: (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
commute (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x = Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a -> Maybe a
toMaybe (Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
 -> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY))
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a b. (a -> b) -> a -> b
$ [Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)]
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
                  [(:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (prim :: * -> * -> *).
PrimPatch prim =>
CommuteFunction prim
speedyCommute (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x,
                   (CommuteFunction prim
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (prim :: * -> * -> *).
Invert prim =>
CommuteFunction prim -> CommuteFunction prim
cleverCommute CommuteFunction prim
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
(:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
mergerCommute) (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x,
                   (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (prim :: * -> * -> *).
PrimPatch prim =>
CommuteFunction prim
everythingElseCommute (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x
                  ]

instance PrimPatch prim => PatchInspect (RepoPatchV1 prim) where
    -- Recurse on everything, these are potentially spoofed patches
    listTouchedFiles :: RepoPatchV1 prim wX wY -> [AnchoredPath]
listTouchedFiles (Merger FL (RepoPatchV1 prim) wX wY
_ RL (RepoPatchV1 prim) wX wB
_ RepoPatchV1 prim wC wX
p1 RepoPatchV1 prim wC wD
p2) = [AnchoredPath] -> [AnchoredPath]
forall a. Ord a => [a] -> [a]
nubSort ([AnchoredPath] -> [AnchoredPath])
-> [AnchoredPath] -> [AnchoredPath]
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wC wX -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles RepoPatchV1 prim wC wX
p1
                                            [AnchoredPath] -> [AnchoredPath] -> [AnchoredPath]
forall a. [a] -> [a] -> [a]
++ RepoPatchV1 prim wC wD -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles RepoPatchV1 prim wC wD
p2
    listTouchedFiles c :: RepoPatchV1 prim wX wY
c@(Regrem{}) = RepoPatchV1 prim wY wX -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles (RepoPatchV1 prim wY wX -> [AnchoredPath])
-> RepoPatchV1 prim wY wX -> [AnchoredPath]
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> RepoPatchV1 prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wX wY
c
    listTouchedFiles (PP prim wX wY
p) = prim wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles prim wX wY
p

    hunkMatches :: (ByteString -> Bool) -> RepoPatchV1 prim wX wY -> Bool
hunkMatches ByteString -> Bool
f (Merger FL (RepoPatchV1 prim) wX wY
_ RL (RepoPatchV1 prim) wX wB
_ RepoPatchV1 prim wC wX
p1 RepoPatchV1 prim wC wD
p2) = (ByteString -> Bool) -> RepoPatchV1 prim wC wX -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f RepoPatchV1 prim wC wX
p1 Bool -> Bool -> Bool
|| (ByteString -> Bool) -> RepoPatchV1 prim wC wD -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f RepoPatchV1 prim wC wD
p2
    hunkMatches ByteString -> Bool
f c :: RepoPatchV1 prim wX wY
c@(Regrem{}) = (ByteString -> Bool) -> RepoPatchV1 prim wY wX -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f (RepoPatchV1 prim wY wX -> Bool) -> RepoPatchV1 prim wY wX -> Bool
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> RepoPatchV1 prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wX wY
c
    hunkMatches ByteString -> Bool
f (PP prim wX wY
p) = (ByteString -> Bool) -> prim wX wY -> Bool
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
(ByteString -> Bool) -> p wX wY -> Bool
hunkMatches ByteString -> Bool
f prim wX wY
p

isFilepatchMerger :: PrimPatch prim => RepoPatchV1 prim wX wY -> Maybe AnchoredPath
isFilepatchMerger :: RepoPatchV1 prim wX wY -> Maybe AnchoredPath
isFilepatchMerger (PP prim wX wY
p) = prim wX wY -> Maybe AnchoredPath
forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Maybe AnchoredPath
is_filepatch prim wX wY
p
isFilepatchMerger (Merger FL (RepoPatchV1 prim) wX wY
_ RL (RepoPatchV1 prim) wX wB
_ RepoPatchV1 prim wC wX
p1 RepoPatchV1 prim wC wD
p2) = do
     AnchoredPath
f1 <- RepoPatchV1 prim wC wX -> Maybe AnchoredPath
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> Maybe AnchoredPath
isFilepatchMerger RepoPatchV1 prim wC wX
p1
     AnchoredPath
f2 <- RepoPatchV1 prim wC wD -> Maybe AnchoredPath
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> Maybe AnchoredPath
isFilepatchMerger RepoPatchV1 prim wC wD
p2
     if AnchoredPath
f1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
f2 then AnchoredPath -> Maybe AnchoredPath
forall (m :: * -> *) a. Monad m => a -> m a
return AnchoredPath
f1 else Maybe AnchoredPath
forall a. Maybe a
Nothing
isFilepatchMerger (Regrem FL (RepoPatchV1 prim) wY wX
und RL (RepoPatchV1 prim) wY wB
unw RepoPatchV1 prim wC wY
p1 RepoPatchV1 prim wC wD
p2)
    = RepoPatchV1 prim wY wX -> Maybe AnchoredPath
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> Maybe AnchoredPath
isFilepatchMerger (FL (RepoPatchV1 prim) wY wX
-> RL (RepoPatchV1 prim) wY wB
-> RepoPatchV1 prim wC wY
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wY wX
forall (prim :: * -> * -> *) wX wY wB wC wD.
FL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wX wB
-> RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wX wY
Merger FL (RepoPatchV1 prim) wY wX
und RL (RepoPatchV1 prim) wY wB
unw RepoPatchV1 prim wC wY
p1 RepoPatchV1 prim wC wD
p2)

commuteRecursiveMerger :: PrimPatch prim
    => (RepoPatchV1 prim :> RepoPatchV1 prim) wX wY -> Perhaps ((RepoPatchV1 prim :> RepoPatchV1 prim) wX wY)
commuteRecursiveMerger :: (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
commuteRecursiveMerger (RepoPatchV1 prim wX wZ
pA :> p :: RepoPatchV1 prim wZ wY
p@(Merger FL (RepoPatchV1 prim) wZ wY
_ RL (RepoPatchV1 prim) wZ wB
_ RepoPatchV1 prim wC wZ
p1 RepoPatchV1 prim wC wD
p2)) = Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Maybe a -> Perhaps a
toPerhaps (Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
 -> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY))
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a b. (a -> b) -> a -> b
$
  do (FL (RepoPatchV1 prim) wX wZ
_ :> RepoPatchV1 prim wZ wY
pA') <- CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
-> (:>) (RepoPatchV1 prim) (FL (RepoPatchV1 prim)) wX wY
-> Maybe ((:>) (FL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
selfCommuter (RepoPatchV1 prim wX wZ
pA RepoPatchV1 prim wX wZ
-> FL (RepoPatchV1 prim) wZ wY
-> (:>) (RepoPatchV1 prim) (FL (RepoPatchV1 prim)) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RepoPatchV1 prim) wZ wY
undo)
     (:>) (FL (RepoPatchV1 prim)) (RepoPatchV1 prim) wZ wZ
_ <- CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
-> (:>) (RepoPatchV1 prim) (FL (RepoPatchV1 prim)) wZ wZ
-> Maybe ((:>) (FL (RepoPatchV1 prim)) (RepoPatchV1 prim) wZ wZ)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
selfCommuter (RepoPatchV1 prim wZ wY
pA' RepoPatchV1 prim wZ wY
-> FL (RepoPatchV1 prim) wY wZ
-> (:>) (RepoPatchV1 prim) (FL (RepoPatchV1 prim)) wZ wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RepoPatchV1 prim) wZ wY -> FL (RepoPatchV1 prim) wY wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL (RepoPatchV1 prim) wZ wY
undo)
     (RepoPatchV1 prim wX wZ
_ :> RepoPatchV1 prim wZ wC
pAmid) <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wC
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wC)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wX wZ
pA RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wZ wC
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wC
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wC -> RepoPatchV1 prim wZ wC
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart (RepoPatchV1 prim wC wZ -> RepoPatchV1 prim wZ wC
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wC wZ
p1))
     (RepoPatchV1 prim wZ wZ
p1' :> RepoPatchV1 prim wZ wZ
pAx) <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wZ
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wZ wC
pAmid RepoPatchV1 prim wZ wC
-> RepoPatchV1 prim wC wZ
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wC wZ
p1)
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RepoPatchV1 prim wZ wZ
pAx RepoPatchV1 prim wZ wZ -> RepoPatchV1 prim wX wZ -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wX wZ
pA)
     (RepoPatchV1 prim wZ wZ
p2' :> RepoPatchV1 prim wZ wD
_) <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wD
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wD)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wZ wC
pAmid RepoPatchV1 prim wZ wC
-> RepoPatchV1 prim wC wD
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wD
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wC wD
p2)
     (RepoPatchV1 prim wC wZ
p2o :> RepoPatchV1 prim wZ wZ
_) <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wZ wC -> RepoPatchV1 prim wC wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wZ wC
pAmid RepoPatchV1 prim wC wZ
-> RepoPatchV1 prim wZ wZ
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wZ
p2')
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RepoPatchV1 prim wC wZ
p2o RepoPatchV1 prim wC wZ -> RepoPatchV1 prim wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wC wD
p2)
     let p' :: RepoPatchV1 prim wB wC
p' = if RepoPatchV1 prim wZ wZ -> RepoPatchV1 prim wC wZ -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare RepoPatchV1 prim wZ wZ
p1' RepoPatchV1 prim wC wZ
p1 Bool -> Bool -> Bool
&& RepoPatchV1 prim wZ wZ -> RepoPatchV1 prim wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare RepoPatchV1 prim wZ wZ
p2' RepoPatchV1 prim wC wD
p2
              then RepoPatchV1 prim wZ wY -> RepoPatchV1 prim wB wC
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RepoPatchV1 prim wZ wY
p
              else String
-> RepoPatchV1 prim wZ wZ
-> RepoPatchV1 prim wZ wZ
-> RepoPatchV1 prim wB wC
forall (prim :: * -> * -> *) wX wY wZ wA wB.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
"0.0" RepoPatchV1 prim wZ wZ
p1' RepoPatchV1 prim wZ wZ
p2'
         undo' :: FL (RepoPatchV1 prim) wX wY
undo' = RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
mergerUndo RepoPatchV1 prim wX wY
forall wB wC. RepoPatchV1 prim wB wC
p'
     (RepoPatchV1 prim Any wZ
pAo :> FL (RepoPatchV1 prim) wZ wY
_) <- CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
-> (:>) (FL (RepoPatchV1 prim)) (RepoPatchV1 prim) Any wY
-> Maybe ((:>) (RepoPatchV1 prim) (FL (RepoPatchV1 prim)) Any wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (FL p1) p2
commuterFLId CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
selfCommuter (FL (RepoPatchV1 prim) Any wZ
forall wX wY. FL (RepoPatchV1 prim) wX wY
undo' FL (RepoPatchV1 prim) Any wZ
-> RepoPatchV1 prim wZ wY
-> (:>) (FL (RepoPatchV1 prim)) (RepoPatchV1 prim) Any wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wY
pA')
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RepoPatchV1 prim Any wZ
pAo RepoPatchV1 prim Any wZ -> RepoPatchV1 prim wX wZ -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wX wZ
pA)
     (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoPatchV1 prim wX wZ
forall wB wC. RepoPatchV1 prim wB wC
p' RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wZ wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wY
pA')
    where undo :: FL (RepoPatchV1 prim) wZ wY
undo = RepoPatchV1 prim wZ wY -> FL (RepoPatchV1 prim) wZ wY
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
mergerUndo RepoPatchV1 prim wZ wY
p
commuteRecursiveMerger (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
_ = Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a
Unknown

otherCommuteRecursiveMerger :: PrimPatch prim
    => (RepoPatchV1 prim :> RepoPatchV1 prim) wX wY -> Perhaps ((RepoPatchV1 prim :> RepoPatchV1 prim) wX wY)
otherCommuteRecursiveMerger :: (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
otherCommuteRecursiveMerger (p_old :: RepoPatchV1 prim wX wZ
p_old@(Merger FL (RepoPatchV1 prim) wX wZ
_ RL (RepoPatchV1 prim) wX wB
_ RepoPatchV1 prim wC wX
p1' RepoPatchV1 prim wC wD
p2') :> RepoPatchV1 prim wZ wY
pA') = Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Maybe a -> Perhaps a
toPerhaps (Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
 -> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY))
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a b. (a -> b) -> a -> b
$
  do (RepoPatchV1 prim wX wZ
pA :> FL (RepoPatchV1 prim) wZ wY
_) <- CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
-> (:>) (FL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX wY
-> Maybe ((:>) (RepoPatchV1 prim) (FL (RepoPatchV1 prim)) wX wY)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn (FL p1) p2
commuterFLId CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
selfCommuter (RepoPatchV1 prim wX wZ -> FL (RepoPatchV1 prim) wX wZ
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
mergerUndo RepoPatchV1 prim wX wZ
p_old FL (RepoPatchV1 prim) wX wZ
-> RepoPatchV1 prim wZ wY
-> (:>) (FL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wY
pA')
     (RepoPatchV1 prim wC wZ
pAmid :> RepoPatchV1 prim wZ wZ
p1) <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wC wX -> RepoPatchV1 prim wC wX
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd RepoPatchV1 prim wC wX
p1' RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wX wZ
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wX wZ
pA)
     (RepoPatchV1 prim wX wZ
_ :> RepoPatchV1 prim wZ wZ
pAmido) <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wZ
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wX wZ
pA RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wZ wZ
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wZ -> RepoPatchV1 prim wZ wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wZ wZ
p1)
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RepoPatchV1 prim wZ wZ
pAmido RepoPatchV1 prim wZ wZ -> RepoPatchV1 prim wC wZ -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wC wZ
pAmid)
     (RepoPatchV1 prim wZ wZ
p2 :> RepoPatchV1 prim wZ wD
_) <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wD
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wD)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wC wZ -> RepoPatchV1 prim wZ wC
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wC wZ
pAmid RepoPatchV1 prim wZ wC
-> RepoPatchV1 prim wC wD
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wD
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wC wD
p2')
     (RepoPatchV1 prim wC wZ
p2o' :> RepoPatchV1 prim wZ wZ
_) <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wC wZ
pAmid RepoPatchV1 prim wC wZ
-> RepoPatchV1 prim wZ wZ
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wC wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wZ
p2)
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RepoPatchV1 prim wC wZ
p2o' RepoPatchV1 prim wC wZ -> RepoPatchV1 prim wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wC wD
p2')
     let p :: RepoPatchV1 prim wB wC
p = if RepoPatchV1 prim wZ wZ
p1 RepoPatchV1 prim wZ wZ -> RepoPatchV1 prim wC wX -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wC wX
p1' Bool -> Bool -> Bool
&& RepoPatchV1 prim wZ wZ
p2 RepoPatchV1 prim wZ wZ -> RepoPatchV1 prim wC wD -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wC wD
p2'
             then RepoPatchV1 prim wX wZ -> RepoPatchV1 prim wB wC
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RepoPatchV1 prim wX wZ
p_old
             else String
-> RepoPatchV1 prim wZ wZ
-> RepoPatchV1 prim wZ wZ
-> RepoPatchV1 prim wB wC
forall (prim :: * -> * -> *) wX wY wZ wA wB.
PrimPatch prim =>
String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wA wB
unsafeMerger String
"0.0" RepoPatchV1 prim wZ wZ
p1 RepoPatchV1 prim wZ wZ
p2
         undo :: FL (RepoPatchV1 prim) wX wY
undo = RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
mergerUndo RepoPatchV1 prim wX wY
forall wB wC. RepoPatchV1 prim wB wC
p
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wZ
pA RepoPatchV1 prim wX wZ -> RepoPatchV1 prim wZ wZ -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wZ wZ
p1) -- special case here...
     (FL (RepoPatchV1 prim) wX wZ
_ :> RepoPatchV1 prim wZ Any
pAo') <- CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
-> (:>) (RepoPatchV1 prim) (FL (RepoPatchV1 prim)) wX Any
-> Maybe ((:>) (FL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX Any)
forall (p1 :: * -> * -> *) (p2 :: * -> * -> *).
CommuteFn p1 p2 -> CommuteFn p1 (FL p2)
commuterIdFL CommuteFn (RepoPatchV1 prim) (RepoPatchV1 prim)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
selfCommuter (RepoPatchV1 prim wX wZ
pA RepoPatchV1 prim wX wZ
-> FL (RepoPatchV1 prim) wZ Any
-> (:>) (RepoPatchV1 prim) (FL (RepoPatchV1 prim)) wX Any
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL (RepoPatchV1 prim) wZ Any
forall wX wY. FL (RepoPatchV1 prim) wX wY
undo)
     Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (RepoPatchV1 prim wZ Any
pAo' RepoPatchV1 prim wZ Any -> RepoPatchV1 prim wZ wY -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wZ wY
pA')
     (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoPatchV1 prim wX wZ
pA RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wZ wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wZ wY
forall wB wC. RepoPatchV1 prim wB wC
p)
otherCommuteRecursiveMerger (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
_ = Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a
Unknown

type CommuteFunction prim = forall wX wY . (RepoPatchV1 prim :> RepoPatchV1 prim) wX wY -> Perhaps ((RepoPatchV1 prim :> RepoPatchV1 prim) wX wY)

{-
A note about mergers and type witnesses
---------------------------------------

The merger code predates the introduction of type witnesses, and because
of its complexity has proved the hardest part of the codebase to retrofit.
Attempting to do this has exposed various places where the code behaves
oddly (e.g. 'putBefore' below); these are likely to be bugs but fixing
them would be potentially disruptive and dangerous as it might change
the existing merge behaviour and thus break existing repositories.

As a result the addition of witnesses to this code has required the
liberal use of unsafe operators. In effect, witnesses bring no safety
in this area; the sole purpose of adding them here was to allow this
code to run as part of a codebase that uses witnesses everywhere else.

A key problem point is the type of the 'Merger' and 'Regrem' constructors
of Patch, where the witnesses seem odd. It is likely that some or many
of the unsafe operations could be removed by finding a better type for
these constructors.
-}


-- Recreates a patch history in reverse.
unwind :: RepoPatchV1 prim wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
unwind :: RepoPatchV1 prim wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
unwind (Merger FL (RepoPatchV1 prim) wX wY
_ RL (RepoPatchV1 prim) wX wB
unwindings RepoPatchV1 prim wC wX
_ RepoPatchV1 prim wC wD
_) = RL (RepoPatchV1 prim) wX wB -> Sealed (RL (RepoPatchV1 prim) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed RL (RepoPatchV1 prim) wX wB
unwindings
unwind RepoPatchV1 prim wX wY
p = RL (RepoPatchV1 prim) wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (RL (RepoPatchV1 prim) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RL (RepoPatchV1 prim) wX wX
-> RepoPatchV1 prim wX wY -> RL (RepoPatchV1 prim) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RepoPatchV1 prim wX wY
p)

-- Recreates a patch history in reverse. The patch being unwound is always at
-- the start of the list of patches.
trueUnwind :: PrimPatch prim
    => RepoPatchV1 prim wC wX -> RepoPatchV1 prim wC wD -> Sealed ((RL (RepoPatchV1 prim) :> RepoPatchV1 prim) wX)
trueUnwind :: RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> Sealed ((:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX)
trueUnwind RepoPatchV1 prim wC wX
p1 RepoPatchV1 prim wC wD
p2 =
  let fake_p :: RepoPatchV1 prim wX wX
fake_p = FL (RepoPatchV1 prim) wX wX
-> RL (RepoPatchV1 prim) wX wX
-> RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wX wX
forall (prim :: * -> * -> *) wX wY wB wC wD.
FL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wX wB
-> RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wX wY
Merger FL (RepoPatchV1 prim) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL RL (RepoPatchV1 prim) wX wX
forall (a :: * -> * -> *) wX. RL a wX wX
NilRL RepoPatchV1 prim wC wX
p1 RepoPatchV1 prim wC wD
p2
  in
  case (RepoPatchV1 prim wC wX -> Sealed (RL (RepoPatchV1 prim) wC)
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
unwind RepoPatchV1 prim wC wX
p1, RepoPatchV1 prim wC wD -> Sealed (RL (RepoPatchV1 prim) wC)
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
unwind RepoPatchV1 prim wC wD
p2) of
    (Sealed (RL (RepoPatchV1 prim) wC wY
p1s:<:RepoPatchV1 prim wY wX
_),Sealed (RL (RepoPatchV1 prim) wC wY
p2s:<:RepoPatchV1 prim wY wX
_)) ->
         (:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX wX
-> Sealed ((:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed ((forall wX wY.
 RL (RepoPatchV1 prim) wX wY -> RL (RepoPatchV1 prim) wX Any)
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
-> RL (RepoPatchV1 prim) wX Any
forall (a :: * -> * -> *) b wZ.
(forall wX wY. a wX wY -> b) -> FlippedSeal a wZ -> b
unsealFlipped forall wX wY.
RL (RepoPatchV1 prim) wX wY -> RL (RepoPatchV1 prim) wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP (RepoPatchV1 prim wX wX
-> RL (RepoPatchV1 prim) wC wY
-> RL (RepoPatchV1 prim) wC wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
forall (prim :: * -> * -> *) wA wB wX wZ wY.
PrimPatch prim =>
RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wZ
-> RL (RepoPatchV1 prim) wY wZ
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
reconcileUnwindings RepoPatchV1 prim wX wX
fake_p RL (RepoPatchV1 prim) wC wY
p1s (RL (RepoPatchV1 prim) wC wY -> RL (RepoPatchV1 prim) wC wY
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd RL (RepoPatchV1 prim) wC wY
p2s)) RL (RepoPatchV1 prim) wX Any
-> RepoPatchV1 prim Any wX -> RL (RepoPatchV1 prim) wX wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RepoPatchV1 prim wC wX -> RepoPatchV1 prim Any wX
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RepoPatchV1 prim wC wX
p1 RL (RepoPatchV1 prim) wX wX
-> RepoPatchV1 prim wX wX
-> (:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wX wX
fake_p)
    (Sealed (RL (RepoPatchV1 prim) wC),
 Sealed (RL (RepoPatchV1 prim) wC))
_ -> String
-> Sealed ((:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX)
forall a. HasCallStack => String -> a
error String
"impossible case"

reconcileUnwindings :: PrimPatch prim
    => RepoPatchV1 prim wA wB -> RL (RepoPatchV1 prim) wX wZ -> RL (RepoPatchV1 prim) wY wZ -> FlippedSeal (RL (RepoPatchV1 prim)) wZ
reconcileUnwindings :: RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wZ
-> RL (RepoPatchV1 prim) wY wZ
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
reconcileUnwindings RepoPatchV1 prim wA wB
_ RL (RepoPatchV1 prim) wX wZ
NilRL RL (RepoPatchV1 prim) wY wZ
p2s = RL (RepoPatchV1 prim) wY wZ
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
FlippedSeal RL (RepoPatchV1 prim) wY wZ
p2s
reconcileUnwindings RepoPatchV1 prim wA wB
_ RL (RepoPatchV1 prim) wX wZ
p1s RL (RepoPatchV1 prim) wY wZ
NilRL = RL (RepoPatchV1 prim) wX wZ
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
FlippedSeal RL (RepoPatchV1 prim) wX wZ
p1s
reconcileUnwindings RepoPatchV1 prim wA wB
p (RL (RepoPatchV1 prim) wX wY
p1s:<:RepoPatchV1 prim wY wZ
p1) p2s :: RL (RepoPatchV1 prim) wY wZ
p2s@(RL (RepoPatchV1 prim) wY wY
tp2s:<:RepoPatchV1 prim wY wZ
p2) =
    case [(RL (RepoPatchV1 prim) wX wZ
p1s', RL (RepoPatchV1 prim) wY wZ
p2s')|
          p1s' :: RL (RepoPatchV1 prim) wX wZ
p1s'@(RL (RepoPatchV1 prim) wX wY
_:<:RepoPatchV1 prim wY wZ
hp1s') <- RL (RepoPatchV1 prim) wX wZ -> [RL (RepoPatchV1 prim) wX wZ]
forall (p :: * -> * -> *) wX wY.
Commute p =>
RL p wX wY -> [RL p wX wY]
headPermutationsRL (RL (RepoPatchV1 prim) wX wY
p1sRL (RepoPatchV1 prim) wX wY
-> RepoPatchV1 prim wY wZ -> RL (RepoPatchV1 prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:RepoPatchV1 prim wY wZ
p1),
          p2s' :: RL (RepoPatchV1 prim) wY wZ
p2s'@(RL (RepoPatchV1 prim) wY wY
_:<:RepoPatchV1 prim wY wZ
hp2s') <- RL (RepoPatchV1 prim) wY wZ -> [RL (RepoPatchV1 prim) wY wZ]
forall (p :: * -> * -> *) wX wY.
Commute p =>
RL p wX wY -> [RL p wX wY]
headPermutationsRL RL (RepoPatchV1 prim) wY wZ
p2s,
          RepoPatchV1 prim wY wZ
hp1s' RepoPatchV1 prim wY wZ -> RepoPatchV1 prim wY wZ -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wY wZ
hp2s'] of
    ((RL (RepoPatchV1 prim) wX wY
p1s':<:RepoPatchV1 prim wY wZ
p1', p2s':<:_):[(RL (RepoPatchV1 prim) wX wZ, RL (RepoPatchV1 prim) wY wZ)]
_) ->
        (forall wX.
 RL (RepoPatchV1 prim) wX wY -> RL (RepoPatchV1 prim) wX wZ)
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall (a :: * -> * -> *) wY (b :: * -> * -> *) wZ.
(forall wX. a wX wY -> b wX wZ)
-> FlippedSeal a wY -> FlippedSeal b wZ
mapFlipped (RL (RepoPatchV1 prim) wX wY
-> RepoPatchV1 prim wY wZ -> RL (RepoPatchV1 prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:RepoPatchV1 prim wY wZ
p1') (FlippedSeal (RL (RepoPatchV1 prim)) wY
 -> FlippedSeal (RL (RepoPatchV1 prim)) wZ)
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wY wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
forall (prim :: * -> * -> *) wA wB wX wZ wY.
PrimPatch prim =>
RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wZ
-> RL (RepoPatchV1 prim) wY wZ
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
reconcileUnwindings RepoPatchV1 prim wA wB
p RL (RepoPatchV1 prim) wX wY
p1s' (RL (RepoPatchV1 prim) wY wY -> RL (RepoPatchV1 prim) wY wY
forall (a :: * -> * -> *) wX wY1 wY2. a wX wY1 -> a wX wY2
unsafeCoercePEnd RL (RepoPatchV1 prim) wY wY
p2s')
    [] -> case FL (RepoPatchV1 prim) wY wY -> RL (RepoPatchV1 prim) wY wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL (FL (RepoPatchV1 prim) wY wY -> RL (RepoPatchV1 prim) wY wY)
-> Maybe (FL (RepoPatchV1 prim) wY wY)
-> Maybe (RL (RepoPatchV1 prim) wY wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` RepoPatchV1 prim wY wZ
-> FL (RepoPatchV1 prim) wY wZ
-> Maybe (FL (RepoPatchV1 prim) wY wY)
forall (prim :: * -> * -> *) wY wZ wX wW.
PrimPatch prim =>
RepoPatchV1 prim wY wZ
-> FL (RepoPatchV1 prim) wX wZ
-> Maybe (FL (RepoPatchV1 prim) wY wW)
putBefore RepoPatchV1 prim wY wZ
p1 (RL (RepoPatchV1 prim) wY wZ -> FL (RepoPatchV1 prim) wY wZ
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL RL (RepoPatchV1 prim) wY wZ
p2s) of
          Just RL (RepoPatchV1 prim) wY wY
p2s' -> (forall wX.
 RL (RepoPatchV1 prim) wX wY -> RL (RepoPatchV1 prim) wX wZ)
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall (a :: * -> * -> *) wY (b :: * -> * -> *) wZ.
(forall wX. a wX wY -> b wX wZ)
-> FlippedSeal a wY -> FlippedSeal b wZ
mapFlipped (RL (RepoPatchV1 prim) wX wY
-> RepoPatchV1 prim wY wZ -> RL (RepoPatchV1 prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:RepoPatchV1 prim wY wZ
p1) (FlippedSeal (RL (RepoPatchV1 prim)) wY
 -> FlippedSeal (RL (RepoPatchV1 prim)) wZ)
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wY wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
forall (prim :: * -> * -> *) wA wB wX wZ wY.
PrimPatch prim =>
RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wZ
-> RL (RepoPatchV1 prim) wY wZ
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
reconcileUnwindings RepoPatchV1 prim wA wB
p RL (RepoPatchV1 prim) wX wY
p1s RL (RepoPatchV1 prim) wY wY
p2s'
          Maybe (RL (RepoPatchV1 prim) wY wY)
Nothing ->
              case (FL (RepoPatchV1 prim) wY wY -> RL (RepoPatchV1 prim) wY wY)
-> Maybe (FL (RepoPatchV1 prim) wY wY)
-> Maybe (RL (RepoPatchV1 prim) wY wY)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FL (RepoPatchV1 prim) wY wY -> RL (RepoPatchV1 prim) wY wY
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL (Maybe (FL (RepoPatchV1 prim) wY wY)
 -> Maybe (RL (RepoPatchV1 prim) wY wY))
-> Maybe (FL (RepoPatchV1 prim) wY wY)
-> Maybe (RL (RepoPatchV1 prim) wY wY)
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wY wZ
-> FL (RepoPatchV1 prim) wX wZ
-> Maybe (FL (RepoPatchV1 prim) wY wY)
forall (prim :: * -> * -> *) wY wZ wX wW.
PrimPatch prim =>
RepoPatchV1 prim wY wZ
-> FL (RepoPatchV1 prim) wX wZ
-> Maybe (FL (RepoPatchV1 prim) wY wW)
putBefore RepoPatchV1 prim wY wZ
p2 (FL (RepoPatchV1 prim) wX wZ
 -> Maybe (FL (RepoPatchV1 prim) wY wY))
-> FL (RepoPatchV1 prim) wX wZ
-> Maybe (FL (RepoPatchV1 prim) wY wY)
forall a b. (a -> b) -> a -> b
$
                   RL (RepoPatchV1 prim) wX wZ -> FL (RepoPatchV1 prim) wX wZ
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL (RL (RepoPatchV1 prim) wX wY
p1sRL (RepoPatchV1 prim) wX wY
-> RepoPatchV1 prim wY wZ -> RL (RepoPatchV1 prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:RepoPatchV1 prim wY wZ
p1) of
              Just RL (RepoPatchV1 prim) wY wY
p1s' -> (forall wX.
 RL (RepoPatchV1 prim) wX wY -> RL (RepoPatchV1 prim) wX wZ)
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall (a :: * -> * -> *) wY (b :: * -> * -> *) wZ.
(forall wX. a wX wY -> b wX wZ)
-> FlippedSeal a wY -> FlippedSeal b wZ
mapFlipped (RL (RepoPatchV1 prim) wX wY
-> RepoPatchV1 prim wY wZ -> RL (RepoPatchV1 prim) wX wZ
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:RepoPatchV1 prim wY wZ
p2) (FlippedSeal (RL (RepoPatchV1 prim)) wY
 -> FlippedSeal (RL (RepoPatchV1 prim)) wZ)
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall a b. (a -> b) -> a -> b
$
                           RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wY wY
-> RL (RepoPatchV1 prim) wY wY
-> FlippedSeal (RL (RepoPatchV1 prim)) wY
forall (prim :: * -> * -> *) wA wB wX wZ wY.
PrimPatch prim =>
RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wZ
-> RL (RepoPatchV1 prim) wY wZ
-> FlippedSeal (RL (RepoPatchV1 prim)) wZ
reconcileUnwindings RepoPatchV1 prim wA wB
p RL (RepoPatchV1 prim) wY wY
p1s' RL (RepoPatchV1 prim) wY wY
tp2s
              Maybe (RL (RepoPatchV1 prim) wY wY)
Nothing ->
                String -> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall a. HasCallStack => String -> a
error (String -> FlippedSeal (RL (RepoPatchV1 prim)) wZ)
-> String -> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall a b. (a -> b) -> a -> b
$ Doc -> String
renderString
                  (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"in function reconcileUnwindings"
                  Doc -> Doc -> Doc
$$ String -> Doc
text String
"Original patch:"
                  Doc -> Doc -> Doc
$$ RepoPatchV1 prim wA wB -> Doc
forall (prim :: * -> * -> *) wX wY.
ShowPatchBasic prim =>
prim wX wY -> Doc
showPatch_ RepoPatchV1 prim wA wB
p
    [(RL (RepoPatchV1 prim) wX wZ, RL (RepoPatchV1 prim) wY wZ)]
_ -> String -> FlippedSeal (RL (RepoPatchV1 prim)) wZ
forall a. HasCallStack => String -> a
error String
"in reconcileUnwindings"

-- This code seems wrong, shouldn't the commute be invert p1 :> p2 ? And why isn't p1' re-inverted?
-- it seems to have been this way forever:
-- Fri May 23 10:27:04 BST 2003  droundy@abridgegame.org
--    * fix bug in unwind and add docs on unwind algorithm.
putBefore :: PrimPatch prim
    => RepoPatchV1 prim wY wZ -> FL (RepoPatchV1 prim) wX wZ -> Maybe (FL (RepoPatchV1 prim) wY wW)
putBefore :: RepoPatchV1 prim wY wZ
-> FL (RepoPatchV1 prim) wX wZ
-> Maybe (FL (RepoPatchV1 prim) wY wW)
putBefore RepoPatchV1 prim wY wZ
p1 (RepoPatchV1 prim wX wY
p2:>:FL (RepoPatchV1 prim) wY wZ
p2s) =
    do RepoPatchV1 prim Any wZ
p1' :> RepoPatchV1 prim wZ wY
p2' <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) Any wY
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) Any wY)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wX wY -> RepoPatchV1 prim Any wZ
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RepoPatchV1 prim wX wY
p2 RepoPatchV1 prim Any wZ
-> RepoPatchV1 prim wZ wY
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) Any wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wY wZ -> RepoPatchV1 prim wZ wY
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wY wZ
p1)
       (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wZ
_ <- (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wZ
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wZ)
forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p p wX wY -> Maybe ((:>) p p wX wY)
commute (RepoPatchV1 prim wZ wY
p2' RepoPatchV1 prim wZ wY
-> RepoPatchV1 prim wY wZ
-> (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wZ wZ
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> RepoPatchV1 prim wY wZ
p1)
       (RepoPatchV1 prim wZ wY -> RepoPatchV1 prim wY Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP RepoPatchV1 prim wZ wY
p2' RepoPatchV1 prim wY Any
-> FL (RepoPatchV1 prim) Any wW -> FL (RepoPatchV1 prim) wY wW
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>:) (FL (RepoPatchV1 prim) Any wW -> FL (RepoPatchV1 prim) wY wW)
-> Maybe (FL (RepoPatchV1 prim) Any wW)
-> Maybe (FL (RepoPatchV1 prim) wY wW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` RepoPatchV1 prim Any wZ
-> FL (RepoPatchV1 prim) Any wZ
-> Maybe (FL (RepoPatchV1 prim) Any wW)
forall (prim :: * -> * -> *) wY wZ wX wW.
PrimPatch prim =>
RepoPatchV1 prim wY wZ
-> FL (RepoPatchV1 prim) wX wZ
-> Maybe (FL (RepoPatchV1 prim) wY wW)
putBefore RepoPatchV1 prim Any wZ
p1' (FL (RepoPatchV1 prim) wY wZ -> FL (RepoPatchV1 prim) Any wZ
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL (RepoPatchV1 prim) wY wZ
p2s)
putBefore RepoPatchV1 prim wY wZ
_ FL (RepoPatchV1 prim) wX wZ
NilFL = FL (RepoPatchV1 prim) wY wW -> Maybe (FL (RepoPatchV1 prim) wY wW)
forall a. a -> Maybe a
Just (FL (RepoPatchV1 prim) Any Any -> FL (RepoPatchV1 prim) wY wW
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FL (RepoPatchV1 prim) Any Any
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)

instance PrimPatch prim => CommuteNoConflicts (RepoPatchV1 prim) where
  commuteNoConflicts :: (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
commuteNoConflicts (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x =
    Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a. Perhaps a -> Maybe a
toMaybe (Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
 -> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY))
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
-> Maybe ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall a b. (a -> b) -> a -> b
$ [Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)]
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (prim :: * -> * -> *).
PrimPatch prim =>
CommuteFunction prim
speedyCommute (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x
                   , (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
-> Perhaps ((:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY)
forall (prim :: * -> * -> *).
PrimPatch prim =>
CommuteFunction prim
everythingElseCommute (:>) (RepoPatchV1 prim) (RepoPatchV1 prim) wX wY
x
                   ]

instance PrimPatch prim => Conflict (RepoPatchV1 prim) where
  resolveConflicts :: RL (RepoPatchV1 prim) wO wX
-> RL (RepoPatchV1 prim) wX wY
-> [ConflictDetails (PrimOf (RepoPatchV1 prim)) wY]
resolveConflicts RL (RepoPatchV1 prim) wO wX
_ = (Unravelled prim wY -> ConflictDetails prim wY)
-> [Unravelled prim wY] -> [ConflictDetails prim wY]
forall a b. (a -> b) -> [a] -> [b]
map Unravelled prim wY -> ConflictDetails prim wY
forall (prim :: * -> * -> *) wX.
PrimMangleUnravelled prim =>
Unravelled prim wX -> ConflictDetails prim wX
mangleOrFail ([Unravelled prim wY] -> [ConflictDetails prim wY])
-> (RL (RepoPatchV1 prim) wX wY -> [Unravelled prim wY])
-> RL (RepoPatchV1 prim) wX wY
-> [ConflictDetails prim wY]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wA wB.
 RepoPatchV1 prim wA wB
 -> [Unravelled (PrimOf (RepoPatchV1 prim)) wB])
-> RL (RepoPatchV1 prim) wX wY
-> [Unravelled (PrimOf (RepoPatchV1 prim)) wY]
forall (p :: * -> * -> *) wX wY.
CommuteNoConflicts p =>
(forall wA wB. p wA wB -> [Unravelled (PrimOf p) wB])
-> RL p wX wY -> [Unravelled (PrimOf p) wY]
combineConflicts forall wA wB.
RepoPatchV1 prim wA wB
-> [Unravelled (PrimOf (RepoPatchV1 prim)) wB]
forall (prim :: * -> * -> *) wX wY.
(CleanMerge prim, Commute prim, Invert prim, Eq2 prim, IsHunk prim,
 PatchInspect prim, RepairToFL prim, Show2 prim, PrimConstruct prim,
 PrimCanonize prim, PrimClassify prim, PrimDetails prim,
 PrimApply prim, PrimSift prim, PrimMangleUnravelled prim,
 ReadPatch prim, ShowPatch prim, ShowContextPatch prim,
 PatchListFormat prim) =>
RepoPatchV1 prim wX wY -> [[Sealed (FL prim wY)]]
resolveOne
    where
      resolveOne :: RepoPatchV1 prim wX wY -> [[Sealed (FL prim wY)]]
resolveOne RepoPatchV1 prim wX wY
p | RepoPatchV1 prim wX wY -> Bool
forall (prim :: * -> * -> *) wA wB. RepoPatchV1 prim wA wB -> Bool
isMerger RepoPatchV1 prim wX wY
p = [RepoPatchV1 prim wX wY -> [Sealed (FL prim wY)]
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> [Sealed (FL prim wY)]
publicUnravel RepoPatchV1 prim wX wY
p]
      resolveOne RepoPatchV1 prim wX wY
_ = []

instance PrimPatch prim => Unwind (RepoPatchV1 prim) where
  fullUnwind :: RepoPatchV1 prim wX wY -> Unwound (PrimOf (RepoPatchV1 prim)) wX wY
fullUnwind (PP prim wX wY
prim) = FL prim wX wX
-> FL prim wX wY -> FL prim wY wY -> Unwound prim wX wY
forall (prim :: * -> * -> *) wA wB wC wD.
(Commute prim, Invert prim, Eq2 prim) =>
FL prim wA wB
-> FL prim wB wC -> FL prim wC wD -> Unwound prim wA wD
mkUnwound FL prim wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL (prim wX wY
prim prim wX wY -> FL prim wY wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL) FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
  fullUnwind (Merger FL (RepoPatchV1 prim) wX wY
a RL (RepoPatchV1 prim) wX wB
_ RepoPatchV1 prim wC wX
c RepoPatchV1 prim wC wD
d) =
    case RepoPatchV1 prim wC wD -> Unwound (PrimOf (RepoPatchV1 prim)) wC wD
forall (p :: * -> * -> *) wX wY.
Unwind p =>
p wX wY -> Unwound (PrimOf p) wX wY
fullUnwind RepoPatchV1 prim wC wD
d of
      Unwound FL (PrimOf (RepoPatchV1 prim)) wC wB
before FL (PrimOf (RepoPatchV1 prim)) wB wC
prim RL (PrimOf (RepoPatchV1 prim)) wC wD
_after ->
        FL prim wX wB
-> FL prim wB wC -> FL prim wC wY -> Unwound prim wX wY
forall (prim :: * -> * -> *) wA wB wC wD.
(Commute prim, Invert prim, Eq2 prim) =>
FL prim wA wB
-> FL prim wB wC -> FL prim wC wD -> Unwound prim wA wD
mkUnwound
          (FL prim wC wX -> FL prim wX wC
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (RepoPatchV1 prim wC wX -> FL (PrimOf (RepoPatchV1 prim)) wC wX
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV1 prim wC wX
c) FL prim wX wC -> FL prim wC wB -> FL prim wX wB
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL prim wC wB
FL (PrimOf (RepoPatchV1 prim)) wC wB
before)
          FL prim wB wC
FL (PrimOf (RepoPatchV1 prim)) wB wC
prim
          (FL prim wB wC -> FL prim wC wB
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL prim wB wC
FL (PrimOf (RepoPatchV1 prim)) wB wC
prim FL prim wC wB -> FL prim wB wY -> FL prim wC wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL prim wC wB -> FL prim wB wC
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert FL prim wC wB
FL (PrimOf (RepoPatchV1 prim)) wC wB
before FL prim wB wC -> FL prim wC wY -> FL prim wB wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ RepoPatchV1 prim wC wX -> FL (PrimOf (RepoPatchV1 prim)) wC wX
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV1 prim wC wX
c FL prim wC wX -> FL prim wX wY -> FL prim wC wY
forall (a :: * -> * -> *) wX wY wZ.
FL a wX wY -> FL a wY wZ -> FL a wX wZ
+>+ FL (RepoPatchV1 prim) wX wY
-> FL (PrimOf (FL (RepoPatchV1 prim))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect FL (RepoPatchV1 prim) wX wY
a)
  fullUnwind (Regrem FL (RepoPatchV1 prim) wY wX
a RL (RepoPatchV1 prim) wY wB
b RepoPatchV1 prim wC wY
c RepoPatchV1 prim wC wD
d) = Unwound prim wY wX -> Unwound prim wX wY
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (RepoPatchV1 prim wY wX -> Unwound (PrimOf (RepoPatchV1 prim)) wY wX
forall (p :: * -> * -> *) wX wY.
Unwind p =>
p wX wY -> Unwound (PrimOf p) wX wY
fullUnwind (FL (RepoPatchV1 prim) wY wX
-> RL (RepoPatchV1 prim) wY wB
-> RepoPatchV1 prim wC wY
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wY wX
forall (prim :: * -> * -> *) wX wY wB wC wD.
FL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wX wB
-> RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wX wY
Merger FL (RepoPatchV1 prim) wY wX
a RL (RepoPatchV1 prim) wY wB
b RepoPatchV1 prim wC wY
c RepoPatchV1 prim wC wD
d))

instance PrimPatch prim => Summary (RepoPatchV1 prim) where
  conflictedEffect :: RepoPatchV1 prim wX wY
-> [IsConflictedPrim (PrimOf (RepoPatchV1 prim))]
conflictedEffect RepoPatchV1 prim wX wY
x
    | RepoPatchV1 prim wX wY -> Bool
forall (prim :: * -> * -> *) wA wB. RepoPatchV1 prim wA wB -> Bool
isMerger RepoPatchV1 prim wX wY
x = (forall wW wZ. prim wW wZ -> IsConflictedPrim prim)
-> FL prim wX wY -> [IsConflictedPrim prim]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ConflictState -> prim wW wZ -> IsConflictedPrim prim
forall (prim :: * -> * -> *) wX wY.
ConflictState -> prim wX wY -> IsConflictedPrim prim
IsC ConflictState
Conflicted) (FL prim wX wY -> [IsConflictedPrim prim])
-> FL prim wX wY -> [IsConflictedPrim prim]
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> FL (PrimOf (RepoPatchV1 prim)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV1 prim wX wY
x
    | Bool
otherwise = (forall wW wZ. prim wW wZ -> IsConflictedPrim prim)
-> FL prim wX wY -> [IsConflictedPrim prim]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> FL a wX wY -> [b]
mapFL (ConflictState -> prim wW wZ -> IsConflictedPrim prim
forall (prim :: * -> * -> *) wX wY.
ConflictState -> prim wX wY -> IsConflictedPrim prim
IsC ConflictState
Okay) (FL prim wX wY -> [IsConflictedPrim prim])
-> FL prim wX wY -> [IsConflictedPrim prim]
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> FL (PrimOf (RepoPatchV1 prim)) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV1 prim wX wY
x

-- This type seems wrong - the most natural type for the result would seem to be
-- [Sealed (FL prim wX)], given the type of unwind.
-- However downstream code in darcs convert assumes the wY type, and I was unable
-- to figure out whether this could/should reasonably be changed -- Ganesh 13/4/10
--
-- bf says: the type here is correct, those of unwind and unravel are wrong,
-- because conflict resolution applies to the end of the repo.
publicUnravel :: PrimPatch prim => RepoPatchV1 prim wX wY -> [Sealed (FL prim wY)]
publicUnravel :: RepoPatchV1 prim wX wY -> [Sealed (FL prim wY)]
publicUnravel = (Sealed (FL prim wX) -> Sealed (FL prim wY))
-> [Sealed (FL prim wX)] -> [Sealed (FL prim wY)]
forall a b. (a -> b) -> [a] -> [b]
map ((forall wX. FL prim wX wX -> FL prim wY wX)
-> Sealed (FL prim wX) -> Sealed (FL prim wY)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX. FL prim wX wX -> FL prim wY wX
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart) ([Sealed (FL prim wX)] -> [Sealed (FL prim wY)])
-> (RepoPatchV1 prim wX wY -> [Sealed (FL prim wX)])
-> RepoPatchV1 prim wX wY
-> [Sealed (FL prim wY)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoPatchV1 prim wX wY -> [Sealed (FL prim wX)]
forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> [Sealed (FL prim wX)]
unravel

dropAllInverses :: (Commute p, Invert p, Eq2 p) => FL p wX wY -> FL p wX wY
dropAllInverses :: FL p wX wY -> FL p wX wY
dropAllInverses FL p wX wY
NilFL = FL p wX wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
dropAllInverses (p wX wY
p :>: FL p wY wY
ps) =
  let ps' :: FL p wY wY
ps' = FL p wY wY -> FL p wY wY
forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Eq2 p) =>
FL p wX wY -> FL p wX wY
dropAllInverses FL p wY wY
ps in
  FL p wX wY -> Maybe (FL p wX wY) -> FL p wX wY
forall a. a -> Maybe a -> a
fromMaybe (p wX wY
p p wX wY -> FL p wY wY -> FL p wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL p wY wY
ps') (Maybe (FL p wX wY) -> FL p wX wY)
-> Maybe (FL p wX wY) -> FL p wX wY
forall a b. (a -> b) -> a -> b
$ p wY wX -> FL p wY wY -> Maybe (FL p wX wY)
forall (p :: * -> * -> *) wX wY wZ.
(Eq2 p, Commute p) =>
p wX wY -> FL p wX wZ -> Maybe (FL p wY wZ)
removeFL (p wX wY -> p wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert p wX wY
p) FL p wY wY
ps'

unravel :: PrimPatch prim => RepoPatchV1 prim wX wY -> [Sealed (FL prim wX)]
unravel :: RepoPatchV1 prim wX wY -> [Sealed (FL prim wX)]
unravel RepoPatchV1 prim wX wY
p = [Sealed (FL prim wX)] -> [Sealed (FL prim wX)]
forall a. Eq a => [a] -> [a]
nub ([Sealed (FL prim wX)] -> [Sealed (FL prim wX)])
-> [Sealed (FL prim wX)] -> [Sealed (FL prim wX)]
forall a b. (a -> b) -> a -> b
$ (Sealed (FL (RepoPatchV1 prim) wX) -> Sealed (FL prim wX))
-> [Sealed (FL (RepoPatchV1 prim) wX)] -> [Sealed (FL prim wX)]
forall a b. (a -> b) -> [a] -> [b]
map ((forall wX. FL (RepoPatchV1 prim) wX wX -> FL prim wX wX)
-> Sealed (FL (RepoPatchV1 prim) wX) -> Sealed (FL prim wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (FL prim wX wX -> FL prim wX wX
forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Eq2 p) =>
FL p wX wY -> FL p wX wY
dropAllInverses (FL prim wX wX -> FL prim wX wX)
-> (FL (RepoPatchV1 prim) wX wX -> FL prim wX wX)
-> FL (RepoPatchV1 prim) wX wX
-> FL prim wX wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FL (FL prim) wX wX -> FL prim wX wX
forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL (FL (FL prim) wX wX -> FL prim wX wX)
-> (FL (RepoPatchV1 prim) wX wX -> FL (FL prim) wX wX)
-> FL (RepoPatchV1 prim) wX wX
-> FL prim wX wX
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall wW wY. RepoPatchV1 prim wW wY -> FL prim wW wY)
-> FL (RepoPatchV1 prim) wX wX -> FL (FL prim) wX wX
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. RepoPatchV1 prim wW wY -> FL prim wW wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect)) ([Sealed (FL (RepoPatchV1 prim) wX)] -> [Sealed (FL prim wX)])
-> [Sealed (FL (RepoPatchV1 prim) wX)] -> [Sealed (FL prim wX)]
forall a b. (a -> b) -> a -> b
$
            [Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
getSupers ([Sealed (FL (RepoPatchV1 prim) wX)]
 -> [Sealed (FL (RepoPatchV1 prim) wX)])
-> [Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
forall a b. (a -> b) -> a -> b
$ (Sealed (RL (RepoPatchV1 prim) wX)
 -> Sealed (FL (RepoPatchV1 prim) wX))
-> [Sealed (RL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
forall a b. (a -> b) -> [a] -> [b]
map ((forall wX.
 RL (RepoPatchV1 prim) wX wX -> FL (RepoPatchV1 prim) wX wX)
-> Sealed (RL (RepoPatchV1 prim) wX)
-> Sealed (FL (RepoPatchV1 prim) wX)
forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal forall wX.
RL (RepoPatchV1 prim) wX wX -> FL (RepoPatchV1 prim) wX wX
forall (a :: * -> * -> *) wX wZ. RL a wX wZ -> FL a wX wZ
reverseRL) ([Sealed (RL (RepoPatchV1 prim) wX)]
 -> [Sealed (FL (RepoPatchV1 prim) wX)])
-> [Sealed (RL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
forall a b. (a -> b) -> a -> b
$ (forall wX.
 RL (RepoPatchV1 prim) wX wX -> [Sealed (RL (RepoPatchV1 prim) wX)])
-> Sealed (RL (RepoPatchV1 prim) wX)
-> [Sealed (RL (RepoPatchV1 prim) wX)]
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal (RepoPatchV1 prim wX wY
-> RL (RepoPatchV1 prim) wX wX
-> [Sealed (RL (RepoPatchV1 prim) wX)]
forall (prim :: * -> * -> *) wA wB wX wY.
PrimPatch prim =>
RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> [Sealed (RL (RepoPatchV1 prim) wX)]
newUr RepoPatchV1 prim wX wY
p) (Sealed (RL (RepoPatchV1 prim) wX)
 -> [Sealed (RL (RepoPatchV1 prim) wX)])
-> Sealed (RL (RepoPatchV1 prim) wX)
-> [Sealed (RL (RepoPatchV1 prim) wX)]
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
unwind RepoPatchV1 prim wX wY
p

getSupers :: PrimPatch prim
    => [Sealed (FL (RepoPatchV1 prim) wX)] -> [Sealed (FL (RepoPatchV1 prim) wX)]
getSupers :: [Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
getSupers (Sealed (FL (RepoPatchV1 prim) wX)
x:[Sealed (FL (RepoPatchV1 prim) wX)]
xs) =
    case (Sealed (FL (RepoPatchV1 prim) wX) -> Bool)
-> [Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not(Bool -> Bool)
-> (Sealed (FL (RepoPatchV1 prim) wX) -> Bool)
-> Sealed (FL (RepoPatchV1 prim) wX)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Sealed (FL (RepoPatchV1 prim) wX)
x Sealed (FL (RepoPatchV1 prim) wX)
-> Sealed (FL (RepoPatchV1 prim) wX) -> Bool
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Sealed (FL (RepoPatchV1 prim) wX)
-> Sealed (FL (RepoPatchV1 prim) wX) -> Bool
`isSuperpatchOf`)) [Sealed (FL (RepoPatchV1 prim) wX)]
xs of
    [Sealed (FL (RepoPatchV1 prim) wX)]
xs' -> if (Sealed (FL (RepoPatchV1 prim) wX) -> Bool)
-> [Sealed (FL (RepoPatchV1 prim) wX)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Sealed (FL (RepoPatchV1 prim) wX)
-> Sealed (FL (RepoPatchV1 prim) wX) -> Bool
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
Sealed (FL (RepoPatchV1 prim) wX)
-> Sealed (FL (RepoPatchV1 prim) wX) -> Bool
`isSuperpatchOf` Sealed (FL (RepoPatchV1 prim) wX)
x) [Sealed (FL (RepoPatchV1 prim) wX)]
xs'
           then [Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
getSupers [Sealed (FL (RepoPatchV1 prim) wX)]
xs'
           else Sealed (FL (RepoPatchV1 prim) wX)
x Sealed (FL (RepoPatchV1 prim) wX)
-> [Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
forall a. a -> [a] -> [a]
: [Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL (RepoPatchV1 prim) wX)]
-> [Sealed (FL (RepoPatchV1 prim) wX)]
getSupers [Sealed (FL (RepoPatchV1 prim) wX)]
xs'
getSupers [] = []

isSuperpatchOf :: PrimPatch prim
    => Sealed (FL (RepoPatchV1 prim) wX) -> Sealed (FL (RepoPatchV1 prim) wX) -> Bool
Sealed FL (RepoPatchV1 prim) wX wX
x isSuperpatchOf :: Sealed (FL (RepoPatchV1 prim) wX)
-> Sealed (FL (RepoPatchV1 prim) wX) -> Bool
`isSuperpatchOf` Sealed FL (RepoPatchV1 prim) wX wX
y | FL (RepoPatchV1 prim) wX wX -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (RepoPatchV1 prim) wX wX
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> FL (RepoPatchV1 prim) wX wX -> Int
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL (RepoPatchV1 prim) wX wX
x = Bool
False -- should be just an optimisation
Sealed FL (RepoPatchV1 prim) wX wX
x `isSuperpatchOf` Sealed FL (RepoPatchV1 prim) wX wX
y = FL (RepoPatchV1 prim) wX wX
x FL (RepoPatchV1 prim) wX wX -> FL (RepoPatchV1 prim) wX wX -> Bool
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
FL (RepoPatchV1 prim) wX wY -> FL (RepoPatchV1 prim) wX wZ -> Bool
`iso` FL (RepoPatchV1 prim) wX wX
y
    where iso :: PrimPatch prim => FL (RepoPatchV1 prim) wX wY -> FL (RepoPatchV1 prim) wX wZ -> Bool
          FL (RepoPatchV1 prim) wX wY
_ iso :: FL (RepoPatchV1 prim) wX wY -> FL (RepoPatchV1 prim) wX wZ -> Bool
`iso` FL (RepoPatchV1 prim) wX wZ
NilFL = Bool
True
          FL (RepoPatchV1 prim) wX wY
NilFL `iso` FL (RepoPatchV1 prim) wX wZ
_ = Bool
False
          FL (RepoPatchV1 prim) wX wY
a `iso` (RepoPatchV1 prim wX wY
b:>:FL (RepoPatchV1 prim) wY wZ
bs) =
              [Bool] -> Bool
forall a. [a] -> a
head ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ ([FL (RepoPatchV1 prim) wY wY
as FL (RepoPatchV1 prim) wY wY -> FL (RepoPatchV1 prim) wY wZ -> Bool
forall (prim :: * -> * -> *) wX wY wZ.
PrimPatch prim =>
FL (RepoPatchV1 prim) wX wY -> FL (RepoPatchV1 prim) wX wZ -> Bool
`iso` FL (RepoPatchV1 prim) wY wZ
FL (RepoPatchV1 prim) wY wZ
bs | (RepoPatchV1 prim wX wY
ah :>: FL (RepoPatchV1 prim) wY wY
as) <- FL (RepoPatchV1 prim) wX wY -> [FL (RepoPatchV1 prim) wX wY]
forall (p :: * -> * -> *) wX wY.
Commute p =>
FL p wX wY -> [FL p wX wY]
simpleHeadPermutationsFL FL (RepoPatchV1 prim) wX wY
a, EqCheck wY wY
IsEq <- [RepoPatchV1 prim wX wY
ah RepoPatchV1 prim wX wY -> RepoPatchV1 prim wX wY -> EqCheck wY wY
forall (p :: * -> * -> *) wA wB wC.
Eq2 p =>
p wA wB -> p wA wC -> EqCheck wB wC
=\/= RepoPatchV1 prim wX wY
b]] :: [Bool]) [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ [Bool
False]

-- | merger takes two patches, (which have been determined to conflict) and
-- constructs a Merger patch to represent the conflict. @p1@ is considered to
-- be conflicting with @p2@ (@p1@ is the "first" patch in the repo ordering),
-- the resulting Merger is therefore a representation of @p2@.
merger :: PrimPatch prim
    => String -> RepoPatchV1 prim wX wY -> RepoPatchV1 prim wX wZ -> Sealed (RepoPatchV1 prim wY)
merger :: String
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> Sealed (RepoPatchV1 prim wY)
merger String
"0.0" RepoPatchV1 prim wX wY
p1 RepoPatchV1 prim wX wZ
p2 = Sealed (RepoPatchV1 prim wY)
final_p
    where
          sealed_unwindings :: Sealed ((:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wY)
sealed_unwindings = RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> Sealed ((:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wY)
forall (prim :: * -> * -> *) wC wX wD.
PrimPatch prim =>
RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> Sealed ((:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wX)
trueUnwind RepoPatchV1 prim wX wY
p1 RepoPatchV1 prim wX wZ
p2
          final_p :: Sealed (RepoPatchV1 prim wY)
final_p =
            case (Sealed (FL (RepoPatchV1 prim) wY)
sealed_undoit, Sealed ((:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wY)
sealed_unwindings) of
              (Sealed FL (RepoPatchV1 prim) wY wX
undoit, Sealed (:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wY wX
unwindings)
                -> RepoPatchV1 prim wY wX -> Sealed (RepoPatchV1 prim wY)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (RepoPatchV1 prim wY wX -> Sealed (RepoPatchV1 prim wY))
-> RepoPatchV1 prim wY wX -> Sealed (RepoPatchV1 prim wY)
forall a b. (a -> b) -> a -> b
$ FL (RepoPatchV1 prim) wY wX
-> RL (RepoPatchV1 prim) wY wX
-> RepoPatchV1 prim wX wY
-> RepoPatchV1 prim wX wZ
-> RepoPatchV1 prim wY wX
forall (prim :: * -> * -> *) wX wY wB wC wD.
FL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wX wB
-> RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wX wY
Merger FL (RepoPatchV1 prim) wY wX
undoit ((\(RL (RepoPatchV1 prim) wY wZ
a :> RepoPatchV1 prim wZ wX
b) -> (RL (RepoPatchV1 prim) wY wZ
a RL (RepoPatchV1 prim) wY wZ
-> RepoPatchV1 prim wZ wX -> RL (RepoPatchV1 prim) wY wX
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<: RepoPatchV1 prim wZ wX
b)) (:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wY wX
unwindings) RepoPatchV1 prim wX wY
p1 RepoPatchV1 prim wX wZ
p2
          sealed_undoit :: Sealed (FL (RepoPatchV1 prim) wY)
sealed_undoit =
              case (RepoPatchV1 prim wX wY -> Bool
forall (prim :: * -> * -> *) wA wB. RepoPatchV1 prim wA wB -> Bool
isMerger RepoPatchV1 prim wX wY
p1, RepoPatchV1 prim wX wZ -> Bool
forall (prim :: * -> * -> *) wA wB. RepoPatchV1 prim wA wB -> Bool
isMerger RepoPatchV1 prim wX wZ
p2) of
              (Bool
True ,Bool
True ) -> case Sealed ((:>) (RL (RepoPatchV1 prim)) (RepoPatchV1 prim) wY)
sealed_unwindings of
                                 Sealed (RL (RepoPatchV1 prim) wY wZ
t :> RepoPatchV1 prim wZ wX
_) -> FL (RepoPatchV1 prim) wY wY -> Sealed (FL (RepoPatchV1 prim) wY)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (FL (RepoPatchV1 prim) wY wY -> Sealed (FL (RepoPatchV1 prim) wY))
-> FL (RepoPatchV1 prim) wY wY -> Sealed (FL (RepoPatchV1 prim) wY)
forall a b. (a -> b) -> a -> b
$ FL (RepoPatchV1 prim) wZ wY -> FL (RepoPatchV1 prim) wY wY
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart (FL (RepoPatchV1 prim) wZ wY -> FL (RepoPatchV1 prim) wY wY)
-> FL (RepoPatchV1 prim) wZ wY -> FL (RepoPatchV1 prim) wY wY
forall a b. (a -> b) -> a -> b
$ RL (RepoPatchV1 prim) wY wZ -> FL (RepoPatchV1 prim) wZ wY
forall (p :: * -> * -> *) wX wY.
Invert p =>
RL p wX wY -> FL p wY wX
invertRL RL (RepoPatchV1 prim) wY wZ
t
              (Bool
False,Bool
False) -> FL (RepoPatchV1 prim) wY wX -> Sealed (FL (RepoPatchV1 prim) wY)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (FL (RepoPatchV1 prim) wY wX -> Sealed (FL (RepoPatchV1 prim) wY))
-> FL (RepoPatchV1 prim) wY wX -> Sealed (FL (RepoPatchV1 prim) wY)
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> RepoPatchV1 prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wX wY
p1 RepoPatchV1 prim wY wX
-> FL (RepoPatchV1 prim) wX wX -> FL (RepoPatchV1 prim) wY wX
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL (RepoPatchV1 prim) wX wX
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
              (Bool
True ,Bool
False) -> FL (RepoPatchV1 prim) wY wY -> Sealed (FL (RepoPatchV1 prim) wY)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed FL (RepoPatchV1 prim) wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
              (Bool
False,Bool
True ) -> FL (RepoPatchV1 prim) wY wZ -> Sealed (FL (RepoPatchV1 prim) wY)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed (FL (RepoPatchV1 prim) wY wZ -> Sealed (FL (RepoPatchV1 prim) wY))
-> FL (RepoPatchV1 prim) wY wZ -> Sealed (FL (RepoPatchV1 prim) wY)
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> RepoPatchV1 prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wX wY
p1 RepoPatchV1 prim wY wX
-> FL (RepoPatchV1 prim) wX wZ -> FL (RepoPatchV1 prim) wY wZ
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: RepoPatchV1 prim wX wZ -> FL (RepoPatchV1 prim) wX wZ
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
mergerUndo RepoPatchV1 prim wX wZ
p2
merger String
g RepoPatchV1 prim wX wY
_ RepoPatchV1 prim wX wZ
_ =
    String -> Sealed (RepoPatchV1 prim wY)
forall a. HasCallStack => String -> a
error (String -> Sealed (RepoPatchV1 prim wY))
-> String -> Sealed (RepoPatchV1 prim wY)
forall a b. (a -> b) -> a -> b
$ String
"Cannot handle mergers other than version 0.0\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
g
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nPlease use darcs optimize --modernize with an older darcs."

instance PrimPatch prim => Effect (RepoPatchV1 prim) where
    effect :: RepoPatchV1 prim wX wY -> FL (PrimOf (RepoPatchV1 prim)) wX wY
effect p :: RepoPatchV1 prim wX wY
p@(Merger{}) = FL prim wX wY -> FL prim wX wY
forall (p :: * -> * -> *) wX wY.
(Commute p, Invert p, Eq2 p) =>
FL p wX wY -> FL p wX wY
dropAllInverses (FL prim wX wY -> FL prim wX wY) -> FL prim wX wY -> FL prim wX wY
forall a b. (a -> b) -> a -> b
$ FL (RepoPatchV1 prim) wX wY
-> FL (PrimOf (FL (RepoPatchV1 prim))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect (FL (RepoPatchV1 prim) wX wY
 -> FL (PrimOf (FL (RepoPatchV1 prim))) wX wY)
-> FL (RepoPatchV1 prim) wX wY
-> FL (PrimOf (FL (RepoPatchV1 prim))) wX wY
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> FL (RepoPatchV1 prim) wX wY
mergerUndo RepoPatchV1 prim wX wY
p
    effect p :: RepoPatchV1 prim wX wY
p@(Regrem{}) = FL prim wY wX -> FL prim wX wY
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert (FL prim wY wX -> FL prim wX wY) -> FL prim wY wX -> FL prim wX wY
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wY wX -> FL (PrimOf (RepoPatchV1 prim)) wY wX
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect (RepoPatchV1 prim wY wX -> FL (PrimOf (RepoPatchV1 prim)) wY wX)
-> RepoPatchV1 prim wY wX -> FL (PrimOf (RepoPatchV1 prim)) wY wX
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wX wY -> RepoPatchV1 prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert RepoPatchV1 prim wX wY
p
    effect (PP prim wX wY
p) = prim wX wY
p prim wX wY -> FL prim wY wY -> FL prim wX wY
forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wY wY
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL

instance IsHunk prim => IsHunk (RepoPatchV1 prim) where
    isHunk :: RepoPatchV1 prim wX wY -> Maybe (FileHunk wX wY)
isHunk RepoPatchV1 prim wX wY
p = do PP prim wX wY
p' <- RepoPatchV1 prim wX wY -> Maybe (RepoPatchV1 prim wX wY)
forall (m :: * -> *) a. Monad m => a -> m a
return RepoPatchV1 prim wX wY
p
                  prim wX wY -> Maybe (FileHunk wX wY)
forall (p :: * -> * -> *) wX wY.
IsHunk p =>
p wX wY -> Maybe (FileHunk wX wY)
isHunk prim wX wY
p'

newUr :: PrimPatch prim
    => RepoPatchV1 prim wA wB -> RL (RepoPatchV1 prim) wX wY -> [Sealed (RL (RepoPatchV1 prim) wX)]
newUr :: RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> [Sealed (RL (RepoPatchV1 prim) wX)]
newUr RepoPatchV1 prim wA wB
p (RL (RepoPatchV1 prim) wX wY
ps :<: Merger FL (RepoPatchV1 prim) wY wY
_ RL (RepoPatchV1 prim) wY wB
_ RepoPatchV1 prim wC wY
p1 RepoPatchV1 prim wC wD
p2) =
   case (RL (RepoPatchV1 prim) wX wY -> Bool)
-> [RL (RepoPatchV1 prim) wX wY] -> [RL (RepoPatchV1 prim) wX wY]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(RL (RepoPatchV1 prim) wX wY
_:<:RepoPatchV1 prim wY wY
pp) -> RepoPatchV1 prim wY wY
pp RepoPatchV1 prim wY wY -> RepoPatchV1 prim wC wY -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
`unsafeCompare` RepoPatchV1 prim wC wY
p1) ([RL (RepoPatchV1 prim) wX wY] -> [RL (RepoPatchV1 prim) wX wY])
-> [RL (RepoPatchV1 prim) wX wY] -> [RL (RepoPatchV1 prim) wX wY]
forall a b. (a -> b) -> a -> b
$ RL (RepoPatchV1 prim) wX wY -> [RL (RepoPatchV1 prim) wX wY]
forall (p :: * -> * -> *) wX wY.
Commute p =>
RL p wX wY -> [RL p wX wY]
headPermutationsRL RL (RepoPatchV1 prim) wX wY
ps of
   ((RL (RepoPatchV1 prim) wX wY
ps':<:RepoPatchV1 prim wY wY
_):[RL (RepoPatchV1 prim) wX wY]
_) -> RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> [Sealed (RL (RepoPatchV1 prim) wX)]
forall (prim :: * -> * -> *) wA wB wX wY.
PrimPatch prim =>
RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> [Sealed (RL (RepoPatchV1 prim) wX)]
newUr RepoPatchV1 prim wA wB
p (RL (RepoPatchV1 prim) wX wY
ps'RL (RepoPatchV1 prim) wX wY
-> RepoPatchV1 prim wY wY -> RL (RepoPatchV1 prim) wX wY
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:RepoPatchV1 prim wC wY -> RepoPatchV1 prim wY wY
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart RepoPatchV1 prim wC wY
p1) [Sealed (RL (RepoPatchV1 prim) wX)]
-> [Sealed (RL (RepoPatchV1 prim) wX)]
-> [Sealed (RL (RepoPatchV1 prim) wX)]
forall a. [a] -> [a] -> [a]
++ RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wD
-> [Sealed (RL (RepoPatchV1 prim) wX)]
forall (prim :: * -> * -> *) wA wB wX wY.
PrimPatch prim =>
RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> [Sealed (RL (RepoPatchV1 prim) wX)]
newUr RepoPatchV1 prim wA wB
p (RL (RepoPatchV1 prim) wX wY
ps'RL (RepoPatchV1 prim) wX wY
-> RepoPatchV1 prim wY wD -> RL (RepoPatchV1 prim) wX wD
forall (a :: * -> * -> *) wX wY wZ.
RL a wX wY -> a wY wZ -> RL a wX wZ
:<:RepoPatchV1 prim wC wD -> RepoPatchV1 prim wY wD
forall (a :: * -> * -> *) wX1 wY wX2. a wX1 wY -> a wX2 wY
unsafeCoercePStart RepoPatchV1 prim wC wD
p2)
   [RL (RepoPatchV1 prim) wX wY]
_ -> String -> [Sealed (RL (RepoPatchV1 prim) wX)]
forall a. HasCallStack => String -> a
error (String -> [Sealed (RL (RepoPatchV1 prim) wX)])
-> String -> [Sealed (RL (RepoPatchV1 prim) wX)]
forall a b. (a -> b) -> a -> b
$ Doc -> String
renderString (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"in function newUr"
                 Doc -> Doc -> Doc
$$ String -> Doc
text String
"Original patch:"
                 Doc -> Doc -> Doc
$$ RepoPatchV1 prim wA wB -> Doc
forall (prim :: * -> * -> *) wX wY.
ShowPatchBasic prim =>
prim wX wY -> Doc
showPatch_ RepoPatchV1 prim wA wB
p
                 Doc -> Doc -> Doc
$$ String -> Doc
text String
"Unwound:"
                 Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((forall wX. RL (RepoPatchV1 prim) wA wX -> [Doc])
-> Sealed (RL (RepoPatchV1 prim) wA) -> [Doc]
forall (a :: * -> *) b. (forall wX. a wX -> b) -> Sealed a -> b
unseal ((forall wW wZ. RepoPatchV1 prim wW wZ -> Doc)
-> RL (RepoPatchV1 prim) wA wX -> [Doc]
forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall wW wZ. RepoPatchV1 prim wW wZ -> Doc
forall (prim :: * -> * -> *) wX wY.
ShowPatchBasic prim =>
prim wX wY -> Doc
showPatch_) (Sealed (RL (RepoPatchV1 prim) wA) -> [Doc])
-> Sealed (RL (RepoPatchV1 prim) wA) -> [Doc]
forall a b. (a -> b) -> a -> b
$ RepoPatchV1 prim wA wB -> Sealed (RL (RepoPatchV1 prim) wA)
forall (prim :: * -> * -> *) wX wY.
RepoPatchV1 prim wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
unwind RepoPatchV1 prim wA wB
p)

newUr RepoPatchV1 prim wA wB
op RL (RepoPatchV1 prim) wX wY
ps =
    case (RL (RepoPatchV1 prim) wX wY -> Bool)
-> [RL (RepoPatchV1 prim) wX wY] -> [RL (RepoPatchV1 prim) wX wY]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(RL (RepoPatchV1 prim) wX wY
_:<:RepoPatchV1 prim wY wY
p) -> RepoPatchV1 prim wY wY -> Bool
forall (prim :: * -> * -> *) wA wB. RepoPatchV1 prim wA wB -> Bool
isMerger RepoPatchV1 prim wY wY
p) ([RL (RepoPatchV1 prim) wX wY] -> [RL (RepoPatchV1 prim) wX wY])
-> [RL (RepoPatchV1 prim) wX wY] -> [RL (RepoPatchV1 prim) wX wY]
forall a b. (a -> b) -> a -> b
$ RL (RepoPatchV1 prim) wX wY -> [RL (RepoPatchV1 prim) wX wY]
forall (p :: * -> * -> *) wX wY.
Commute p =>
RL p wX wY -> [RL p wX wY]
headPermutationsRL RL (RepoPatchV1 prim) wX wY
ps of
    [] -> [RL (RepoPatchV1 prim) wX wY -> Sealed (RL (RepoPatchV1 prim) wX)
forall (a :: * -> *) wX. a wX -> Sealed a
Sealed RL (RepoPatchV1 prim) wX wY
ps]
    (RL (RepoPatchV1 prim) wX wY
ps':[RL (RepoPatchV1 prim) wX wY]
_) -> RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> [Sealed (RL (RepoPatchV1 prim) wX)]
forall (prim :: * -> * -> *) wA wB wX wY.
PrimPatch prim =>
RepoPatchV1 prim wA wB
-> RL (RepoPatchV1 prim) wX wY
-> [Sealed (RL (RepoPatchV1 prim) wX)]
newUr RepoPatchV1 prim wA wB
op RL (RepoPatchV1 prim) wX wY
ps'

instance Invert prim => Invert (RepoPatchV1 prim) where
    invert :: RepoPatchV1 prim wX wY -> RepoPatchV1 prim wY wX
invert (Merger FL (RepoPatchV1 prim) wX wY
undo RL (RepoPatchV1 prim) wX wB
unwindings RepoPatchV1 prim wC wX
p1 RepoPatchV1 prim wC wD
p2)
        = FL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wX wB
-> RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wY wX
forall (prim :: * -> * -> *) wX wY wB wC wD.
FL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wX wB
-> RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wY wX
Regrem FL (RepoPatchV1 prim) wX wY
undo RL (RepoPatchV1 prim) wX wB
unwindings RepoPatchV1 prim wC wX
p1 RepoPatchV1 prim wC wD
p2
    invert (Regrem FL (RepoPatchV1 prim) wY wX
undo RL (RepoPatchV1 prim) wY wB
unwindings RepoPatchV1 prim wC wY
p1 RepoPatchV1 prim wC wD
p2)
        = FL (RepoPatchV1 prim) wY wX
-> RL (RepoPatchV1 prim) wY wB
-> RepoPatchV1 prim wC wY
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wY wX
forall (prim :: * -> * -> *) wX wY wB wC wD.
FL (RepoPatchV1 prim) wX wY
-> RL (RepoPatchV1 prim) wX wB
-> RepoPatchV1 prim wC wX
-> RepoPatchV1 prim wC wD
-> RepoPatchV1 prim wX wY
Merger FL (RepoPatchV1 prim) wY wX
undo RL (RepoPatchV1 prim) wY wB
unwindings RepoPatchV1 prim wC wY
p1 RepoPatchV1 prim wC wD
p2
    invert (PP prim wX wY
p) = prim wY wX -> RepoPatchV1 prim wY wX
forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV1 prim wX wY
PP (prim wX wY -> prim wY wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert prim wX wY
p)

instance Eq2 prim => Eq2 (RepoPatchV1 prim) where
    unsafeCompare :: RepoPatchV1 prim wA wB -> RepoPatchV1 prim wC wD -> Bool
unsafeCompare = RepoPatchV1 prim wA wB -> RepoPatchV1 prim wC wD -> Bool
forall (prim :: * -> * -> *) wX wY wW wZ.
Eq2 prim =>
RepoPatchV1 prim wX wY -> RepoPatchV1 prim wW wZ -> Bool
eqPatches

instance Eq2 prim => Eq (RepoPatchV1 prim wX wY) where
    == :: RepoPatchV1 prim wX wY -> RepoPatchV1 prim wX wY -> Bool
(==) = RepoPatchV1 prim wX wY -> RepoPatchV1 prim wX wY -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare

eqPatches :: Eq2 prim => RepoPatchV1 prim wX wY -> RepoPatchV1 prim wW wZ -> Bool
eqPatches :: RepoPatchV1 prim wX wY -> RepoPatchV1 prim wW wZ -> Bool
eqPatches (PP prim wX wY
p1) (PP prim wW wZ
p2) = prim wX wY -> prim wW wZ -> Bool
forall (p :: * -> * -> *) wA wB wC wD.
Eq2 p =>
p wA wB -> p wC wD -> Bool
unsafeCompare prim wX wY
p1 prim wW wZ
p2
eqPatches (Merger FL (RepoPatchV1 prim) wX wY
_ RL (RepoPatchV1 prim) wX wB
_ RepoPatchV1 prim wC wX
p1a RepoPatchV1 prim wC wD
p1b) (Merger FL (RepoPatchV1 prim) wW wZ
_ RL (RepoPatchV1 prim) wW wB
_ RepoPatchV1 prim wC wW
p2a RepoPatchV1 prim wC wD
p2b)
 = RepoPatchV1 prim wC wX -> RepoPatchV1 prim wC wW -> Bool
forall (prim :: * -> * -> *) wX wY wW wZ.
Eq2 prim =>
RepoPatchV1 prim wX wY -> RepoPatchV1 prim wW wZ -> Bool
eqPatches RepoPatchV1 prim wC wX
p1a RepoPatchV1 prim wC wW
p2a Bool -> Bool -> Bool
&&
   RepoPatchV1 prim wC wD -> RepoPatchV1 prim wC wD -> Bool
forall (prim :: * -> * -> *) wX wY wW wZ.
Eq2 prim =>
RepoPatchV1 prim wX wY -> RepoPatchV1 prim wW wZ -> Bool
eqPatches RepoPatchV1 prim wC wD
p1b RepoPatchV1 prim wC wD
p2b
eqPatches (Regrem FL (RepoPatchV1 prim) wY wX
_ RL (RepoPatchV1 prim) wY wB
_ RepoPatchV1 prim wC wY
p1a RepoPatchV1 prim wC wD
p1b) (Regrem FL (RepoPatchV1 prim) wZ wW
_ RL (RepoPatchV1 prim) wZ wB
_ RepoPatchV1 prim wC wZ
p2a RepoPatchV1 prim wC wD
p2b)
 = RepoPatchV1 prim wC wY -> RepoPatchV1 prim wC wZ -> Bool
forall (prim :: * -> * -> *) wX wY wW wZ.
Eq2 prim =>
RepoPatchV1 prim wX wY -> RepoPatchV1 prim wW wZ -> Bool
eqPatches RepoPatchV1 prim wC wY
p1a RepoPatchV1 prim wC wZ
p2a Bool -> Bool -> Bool
&&
   RepoPatchV1 prim wC wD -> RepoPatchV1 prim wC wD -> Bool
forall (prim :: * -> * -> *) wX wY wW wZ.
Eq2 prim =>
RepoPatchV1 prim wX wY -> RepoPatchV1 prim wW wZ -> Bool
eqPatches RepoPatchV1 prim wC wD
p1b RepoPatchV1 prim wC wD
p2b
eqPatches RepoPatchV1 prim wX wY
_ RepoPatchV1 prim wW wZ
_ = Bool
False