1-- Copyright (C) 2007 David Roundy 2-- 3-- This program is free software; you can redistribute it and/or modify 4-- it under the terms of the GNU General Public License as published by 5-- the Free Software Foundation; either version 2, or (at your option) 6-- any later version. 7-- 8-- This program is distributed in the hope that it will be useful, 9-- but WITHOUT ANY WARRANTY; without even the implied warranty of 10-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 11-- GNU General Public License for more details. 12-- 13-- You should have received a copy of the GNU General Public License 14-- along with this program; see the file COPYING. If not, write to 15-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 16-- Boston, MA 02110-1301, USA. 17 18{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-name-shadowing #-} 19 20module Darcs.Patch.V2.RepoPatch 21 ( RepoPatchV2(..) 22 , isConsistent 23 , isForward 24 , isDuplicate 25 , mergeUnravelled 26 ) where 27 28import Darcs.Prelude hiding ( (*>) ) 29 30import Control.Monad ( mplus, liftM ) 31import qualified Data.ByteString.Char8 as BC ( ByteString, pack ) 32import Data.Maybe ( fromMaybe ) 33import Data.List ( partition, nub ) 34import Data.List.Ordered ( nubSort ) 35 36import Darcs.Patch.Commute ( commuteFL, commuteRL 37 , commuteRLFL, Commute(..) ) 38import Darcs.Patch.CommuteFn ( CommuteFn, invertCommuter ) 39import Darcs.Patch.CommuteNoConflicts ( CommuteNoConflicts(..), mergeNoConflicts ) 40import Darcs.Patch.Conflict ( Conflict(..), combineConflicts, mangleOrFail ) 41import Darcs.Patch.Debug 42import Darcs.Patch.Effect ( Effect(..) ) 43import Darcs.Patch.FileHunk ( IsHunk(..) ) 44import Darcs.Patch.Format ( PatchListFormat(..), ListFormat(ListFormatV2) ) 45import Darcs.Patch.Ident ( PatchId ) 46import Darcs.Patch.Invert ( invertFL, invertRL, Invert(..) ) 47import Darcs.Patch.Merge ( CleanMerge(..), Merge(..), swapMerge ) 48import Darcs.Patch.FromPrim 49 ( FromPrim(..) 50 , ToPrim(..) 51 , PrimPatchBase(..) 52 ) 53import Darcs.Patch.Prim ( PrimPatch, applyPrimFL ) 54import Darcs.Patch.Read ( bracketedFL, ReadPatch(..) ) 55import Darcs.Util.Parser ( skipSpace, string, choice ) 56import Darcs.Patch.Repair ( mapMaybeSnd, RepairToFL(..), Check(..) ) 57import Darcs.Patch.Apply ( Apply(..) ) 58import Darcs.Patch.Inspect ( PatchInspect(..) ) 59import Darcs.Patch.Permutations ( commuteWhatWeCanFL, commuteWhatWeCanRL 60 , genCommuteWhatWeCanRL, removeRL, removeFL 61 , removeSubsequenceFL ) 62import Darcs.Patch.Show 63 ( ShowPatch(..), ShowPatchBasic(..), ShowContextPatch(..), ShowPatchFor(..) 64 , displayPatch ) 65import Darcs.Patch.Summary 66 ( Summary(..) 67 , ConflictState(..) 68 , IsConflictedPrim(..) 69 , plainSummary 70 ) 71import Darcs.Patch.Unwind ( Unwind(..), mkUnwound ) 72import Darcs.Patch.V2.Non ( Non(..), Nonable(..), unNon, showNons, showNon 73 , readNons, readNon, commutePrimsOrAddToCtx 74 , commuteOrAddToCtx, commuteOrAddToCtxRL 75 , commuteOrRemFromCtx, commuteOrRemFromCtxFL 76 , remNons, (*>), (>*), (*>>), (>>*) ) 77import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP ) 78import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) ) 79import Darcs.Patch.Witnesses.Ordered 80 ( FL(..), RL(..), Fork(..), (:>)(..), (+>+), (+<+) 81 , mapFL, mapFL_FL, reverseFL, (:\/:)(..), (:/\:)(..) 82 , reverseRL, lengthFL, lengthRL, nullFL, initsFL ) 83import Darcs.Patch.Witnesses.Sealed 84 ( FlippedSeal(..), Sealed(Sealed), mapSeal 85 , unseal ) 86import Darcs.Patch.Witnesses.Show ( Show1, Show2, showsPrec2, appPrec ) 87 88import Darcs.Util.Path ( AnchoredPath ) 89import Darcs.Util.Printer ( Doc, renderString, blueText, redText, (<+>), ($$), vcat ) 90 91-- |'RepoPatchV2' is used to represents prim patches that are duplicates of, or 92-- conflict with, another prim patch in the repository. 93-- 94-- @Normal prim@: A primitive patch 95-- 96-- @Duplicate x@: This patch has no effect since @x@ is already present in the 97-- repository. 98-- 99-- @Etacilpud x: invert (Duplicate x)@ 100-- 101-- @Conflictor ix xx x@: 102-- @ix@ is the set of patches: 103-- * that conflict with @x@ and also conflict with another patch in the 104-- repository. 105-- * that conflict with a patch that conflict with @x@ 106-- 107-- @xx@ is the sequence of patches that conflict *only* with @x@ 108-- 109-- @x@ is the original, conflicting patch. 110-- 111-- @ix@ and @x@ are stored as @Non@ objects, which include any necessary 112-- context to uniquely define the patch that is referred to. 113-- 114-- The intuition is that a Conflictor should have the effect of inverting any 115-- patches that 'x' conflicts with, that haven't already been undone by another 116-- Conflictor in the repository. 117-- Therefore, the effect of a Conflictor is @invert xx@. 118-- 119-- @InvConflictor ix xx x@: like @invert (Conflictor ix xx x)@ 120data RepoPatchV2 prim wX wY where 121 Duplicate :: Non (RepoPatchV2 prim) wX -> RepoPatchV2 prim wX wX 122 Etacilpud :: Non (RepoPatchV2 prim) wX -> RepoPatchV2 prim wX wX 123 Normal :: prim wX wY -> RepoPatchV2 prim wX wY 124 Conflictor :: [Non (RepoPatchV2 prim) wX] -> FL prim wX wY 125 -> Non (RepoPatchV2 prim) wX -> RepoPatchV2 prim wY wX 126 InvConflictor :: [Non (RepoPatchV2 prim) wX] -> FL prim wX wY 127 -> Non (RepoPatchV2 prim) wX -> RepoPatchV2 prim wX wY 128 129instance PrimPatch prim => PrimPatchBase (RepoPatchV2 prim) where 130 type PrimOf (RepoPatchV2 prim) = prim 131 132-- | 'isDuplicate' @p@ is @True@ if @p@ is either a 'Duplicate' or 'Etacilpud' 133-- patch. 134isDuplicate :: RepoPatchV2 prim wS wY -> Bool 135isDuplicate (Duplicate _) = True 136isDuplicate (Etacilpud _) = True 137isDuplicate _ = False 138 139-- | 'isForward' @p@ is @True@ if @p@ is either an 'InvConflictor' or 140-- 'Etacilpud'. 141isForward :: PrimPatch prim => RepoPatchV2 prim wS wY -> Maybe Doc 142isForward p = case p of 143 p@(InvConflictor{}) -> justRedP "An inverse conflictor" p 144 p@(Etacilpud _) -> justRedP "An inverse duplicate" p 145 _ -> Nothing 146 where 147 justRedP msg p = Just $ redText msg $$ displayPatch p 148 149-- |'mergeUnravelled' is used when converting from Darcs V1 patches (Mergers) 150-- to Darcs V2 patches (Conflictors). 151mergeUnravelled :: PrimPatch prim => [Sealed ((FL prim) wX)] 152 -> Maybe (FlippedSeal (RepoPatchV2 prim) wX) 153mergeUnravelled [] = Nothing 154mergeUnravelled [_] = Nothing 155mergeUnravelled ws = 156 case mergeUnravelled_private ws of 157 Nothing -> Nothing 158 Just NilRL -> error "found no patches in mergeUnravelled" 159 Just (_ :<: z) -> Just $ FlippedSeal z 160 where 161 notNullS :: Sealed ((FL prim) wX) -> Bool 162 notNullS (Sealed NilFL) = False 163 notNullS _ = True 164 165 mergeUnravelled_private :: PrimPatch prim => [Sealed (FL prim wX)] 166 -> Maybe (RL (RepoPatchV2 prim) wX wX) 167 mergeUnravelled_private xs = let nonNullXs = filter notNullS xs in 168 reverseFL `fmap` mergeConflictingNons (map sealed2non nonNullXs) 169 170 -- | 'sealed2non' @(Sealed xs)@ converts @xs@ to a 'Non'. 171 -- @xs@ must be non-empty since we split this list at the last patch, 172 -- taking @init xs@ as the context of @last xs@. 173 sealed2non :: Sealed ((FL prim) wX) -> Non (RepoPatchV2 prim) wX 174 sealed2non (Sealed xs) = 175 case reverseFL xs of 176 ys :<: y -> Non (mapFL_FL Normal $ reverseRL ys) y 177 NilRL -> error "NilFL encountered in sealed2non" 178 179mergeConflictingNons :: PrimPatch prim => [Non (RepoPatchV2 prim) wX] 180 -> Maybe (FL (RepoPatchV2 prim) wX wX) 181mergeConflictingNons ns = mcn $ map unNon ns 182 where mcn :: PrimPatch prim => [Sealed (FL (RepoPatchV2 prim) wX)] 183 -> Maybe (FL (RepoPatchV2 prim) wX wX) 184 mcn [] = Just NilFL 185 -- Apparently, the joinEffects call is a safety check "and could be 186 -- removed when we're sure of the code"! 187 mcn [Sealed p] = case joinEffects p of 188 NilFL -> Just p 189 _ -> Nothing 190 mcn (Sealed p1:Sealed p2:zs) = 191 case pullCommon p1 p2 of 192 Fork c ps qs -> 193 case merge (ps :\/: qs) of 194 qs' :/\: _ -> mcn (Sealed (c +>+ ps +>+ qs'):zs) 195 196joinEffects :: forall p wX wY . (Effect p, Invert (PrimOf p), 197 Commute (PrimOf p), Eq2 (PrimOf p)) => p wX wY 198 -> FL (PrimOf p) wX wY 199joinEffects = joinInverses . effect 200 where joinInverses :: FL (PrimOf p) wA wB -> FL (PrimOf p) wA wB 201 joinInverses NilFL = NilFL 202 joinInverses (p :>: ps) = 203 let ps' = joinInverses ps in 204 fromMaybe (p :>: ps') $ removeFL (invert p) ps' 205 206assertConsistent :: PrimPatch prim => RepoPatchV2 prim wX wY 207 -> RepoPatchV2 prim wX wY 208assertConsistent x = maybe x (error . renderString) $ do 209 e <- isConsistent x 210 Just (redText "Inconsistent patch:" $$ displayPatch x $$ e) 211 212-- | @mergeAfterConflicting@ takes as input a sequence of conflicting patches 213-- @xxx@ (which therefore have no effect) and a sequence of primitive patches 214-- @yyy@ that follow said sequence of conflicting patches, and may depend upon 215-- some of the conflicting patches (as a resolution). 216 217-- The output is two sequences of patches the first consisting of a set of 218-- mutually-conflicting patches, and the second having the same effect as the 219-- original primitive patch sequence in the input. 220 221-- So far as I can tell, the second output is always identical to @mapFL Normal 222-- yyy@ 223 224-- The first output is the set of patches from @xxx@ that are depended upon by 225-- @yyy@. 226mergeAfterConflicting :: PrimPatch prim => FL (RepoPatchV2 prim) wX wX 227 -> FL prim wX wY -> Maybe ( FL (RepoPatchV2 prim) wX wX 228 , FL (RepoPatchV2 prim) wX wY) 229mergeAfterConflicting xxx yyy = mac (reverseFL xxx) yyy NilFL 230 where 231 mac :: PrimPatch prim 232 => RL (RepoPatchV2 prim) wX wY -> FL prim wY wZ 233 -> FL (RepoPatchV2 prim) wZ wA 234 -> Maybe (FL (RepoPatchV2 prim) wX wX, FL (RepoPatchV2 prim) wX wA) 235 mac NilRL xs goneby = case joinEffects goneby of 236 NilFL -> Just (NilFL, mapFL_FL Normal xs) 237 _ -> Nothing 238 mac (ps :<: p) xs goneby = 239 case commuteFL (p :> mapFL_FL Normal xs) of 240 Nothing -> 241 case genCommuteWhatWeCanRL commuteNoConflicts (ps :> p) of 242 a :> p' :> b -> 243 do (b', xs') <- mac b xs goneby 244 let pa = joinEffects $ a :<: p' 245 NilFL <- return pa 246 return (reverseRL (a :<: p') +>+ b', xs') 247 `mplus` 248 do NilFL <- return goneby 249 NilFL <- return $ joinEffects (ps :<: p) 250 return (reverseRL (ps :<: p), mapFL_FL Normal xs) 251 Just (l :> p'') -> 252 case allNormal l of 253 Just xs'' -> mac ps xs'' (p'' :>: goneby) 254 Nothing -> 255 case genCommuteWhatWeCanRL commuteNoConflicts (ps :> p) of 256 a :> p' :> b -> 257 do (b', xs') <- mac b xs goneby 258 let pa = joinEffects $ a :<: p' 259 NilFL <- return pa 260 return (reverseRL (a :<: p') +>+ b', xs') 261 262geteff :: PrimPatch prim => [Non (RepoPatchV2 prim) wX] -> FL prim wX wY 263 -> ([Non (RepoPatchV2 prim) wX], FL (RepoPatchV2 prim) wX wY) 264geteff _ NilFL = ([], NilFL) 265geteff ix (x :>: xs) | Just ix' <- mapM (commuteOrRemFromCtx (Normal x)) ix = 266 case geteff ix' xs of 267 (ns, xs') -> ( non (Normal x) : map (commuteOrAddToCtx (Normal x)) ns 268 , Normal x :>: xs') 269geteff ix xx = 270 case mergeConflictingNons ix of 271 Nothing -> error $ renderString $ 272 redText "mergeConflictingNons failed in geteff: ix" $$ 273 displayNons ix $$ redText "xx" $$ displayPatch xx 274 Just rix -> 275 case mergeAfterConflicting rix xx of 276 Just (a, x) -> 277 ( map (commuteOrAddToCtxRL (reverseFL a)) $ toNons x 278 , a +>+ x) 279 Nothing -> 280 error $ renderString $ 281 redText "mergeAfterConflicting failed in geteff" $$ 282 redText "where ix" $$ displayNons ix $$ 283 redText "and xx" $$ displayPatch xx $$ 284 redText "and rix" $$ displayPatch rix 285 286xx2nons :: PrimPatch prim => [Non (RepoPatchV2 prim) wX] -> FL prim wX wY 287 -> [Non (RepoPatchV2 prim) wX] 288xx2nons ix xx = fst $ geteff ix xx 289 290xx2patches :: PrimPatch prim => [Non (RepoPatchV2 prim) wX] -> FL prim wX wY 291 -> FL (RepoPatchV2 prim) wX wY 292xx2patches ix xx = snd $ geteff ix xx 293 294-- | If @xs@ consists only of 'Normal' patches, 'allNormal' @xs@ returns 295-- @Just pxs@ those patches (so @lengthFL pxs == lengthFL xs@). 296-- Otherwise, it returns 'Nothing'. 297allNormal :: FL (RepoPatchV2 prim) wX wY -> Maybe (FL prim wX wY) 298allNormal (Normal x :>: xs) = (x :>: ) `fmap` allNormal xs 299allNormal NilFL = Just NilFL 300allNormal _ = Nothing 301 302-- | This is used for unit-testing and for internal sanity checks 303isConsistent :: PrimPatch prim => RepoPatchV2 prim wX wY -> Maybe Doc 304isConsistent (Normal _) = Nothing 305isConsistent (Duplicate _) = Nothing 306isConsistent (Etacilpud _) = Nothing 307isConsistent c@(InvConflictor{}) = isConsistent (invert c) 308isConsistent (Conflictor im mm m@(Non deps _)) 309 | not $ everyoneConflicts im = 310 Just $ redText "Someone doesn't conflict in im in isConsistent" 311 | Just _ <- commuteOrRemFromCtxFL rmm m, _ :>: _ <- mm = 312 Just $ redText "m doesn't conflict with mm in isConsistent" 313 | any (\x -> any (x `conflictsWith`) nmm) im = 314 Just $ redText "mm conflicts with im in isConsistent where nmm is" $$ 315 displayNons nmm 316 | Nothing <- (nmm ++ im) `minus` toNons deps = 317 Just $ redText "dependencies not in conflict:" $$ 318 displayNons (toNons deps) $$ 319 redText "compared with deps itself:" $$ 320 displayPatch deps 321 | otherwise = 322 case allConflictsWith m im of 323 (im1, []) | im1 `eqSet` im -> Nothing 324 (_, imnc) -> Just $ redText ("m doesn't conflict with im in " 325 ++ "isConsistent. unconflicting:") $$ 326 displayNons imnc 327 where (nmm, rmm) = geteff im mm 328 329everyoneConflicts :: PrimPatch prim => [Non (RepoPatchV2 prim) wX] -> Bool 330everyoneConflicts [] = True 331everyoneConflicts (x : xs) = case allConflictsWith x xs of 332 ([], _) -> False 333 (_, xs') -> everyoneConflicts xs' 334 335instance PatchDebug prim => PatchDebug (RepoPatchV2 prim) 336 337mergeWith :: PrimPatch prim => Non (RepoPatchV2 prim) wX 338 -> [Non (RepoPatchV2 prim) wX] -> Sealed (FL prim wX) 339mergeWith p [] = effect `mapSeal` unNon p 340mergeWith p xs = 341 mergeall . map unNon . (p :) . unconflicting_of $ nonDependsOrConflictsP xs 342 where 343 nonDependsOrConflictsP = 344 filter (\x -> not ((p `dependsUpon` x) || (p `conflictsWith` x))) 345 mergeall :: PrimPatch prim => [Sealed (FL (RepoPatchV2 prim) wX)] 346 -> Sealed (FL prim wX) 347 mergeall [Sealed x] = Sealed $ effect x 348 mergeall [] = Sealed NilFL 349 mergeall (Sealed x : Sealed y : rest) = 350 case merge (x :\/: y) of 351 y' :/\: _ -> mergeall (Sealed (x +>+ y') : rest) 352 unconflicting_of [] = [] 353 unconflicting_of (q : qs) = case allConflictsWith q qs of 354 ([], _) -> q : qs 355 (_, nc) -> unconflicting_of nc 356 357instance Summary (RepoPatchV2 prim) where 358 conflictedEffect (Duplicate (Non _ x)) = [IsC Duplicated x] 359 conflictedEffect (Etacilpud _) = error "impossible case" 360 conflictedEffect (Conflictor _ _ (Non _ x)) = [IsC Conflicted x] 361 conflictedEffect (InvConflictor{}) = error "impossible case" 362 conflictedEffect (Normal x) = [IsC Okay x] 363 364instance PrimPatch prim => Conflict (RepoPatchV2 prim) where 365 resolveConflicts _ = map mangleOrFail . combineConflicts resolveOne 366 where 367 resolveOne :: RepoPatchV2 prim wX wY -> [[Sealed (FL prim wY)]] 368 resolveOne (Conflictor ix xx x) = [unravelled] 369 where 370 unravelled = nub $ filter isCons $ map (`mergeWith` xIxNonXX) xIxNonXX 371 xIxNonXX = x : ix ++ nonxx 372 nonxx = nonxx_ (reverseFL $ xx2patches ix xx) 373 resolveOne _ = [] 374 -- |nonxx_ takes an RL of patches, and returns a singleton list 375 -- containing a Non, in the case where we have a Normal patch at the 376 -- end of the list (using the rest of the RL as context), and an empty 377 -- list otherwise. 378 nonxx_ :: RL (RepoPatchV2 prim) wX wY -> [Non (RepoPatchV2 prim) wX] 379 nonxx_ (qs :<: Normal q) = [Non (reverseRL qs) q] 380 nonxx_ _ = [] 381 isCons = unseal (not . nullFL) 382 383instance PrimPatch prim => Unwind (RepoPatchV2 prim) where 384 fullUnwind (Normal p) = 385 mkUnwound NilFL (p :>: NilFL) NilFL 386 fullUnwind (Duplicate (Non ps p)) = 387 mkUnwound (effect ps) (p :>: NilFL) (invert p :>: effect (invert ps)) 388 fullUnwind (Conflictor _ es (Non ps p)) = 389 mkUnwound (invert es +>+ effect ps) (p :>: NilFL) (invert p :>: effect (invert ps)) 390 fullUnwind (Etacilpud non) = 391 invert (fullUnwind (Duplicate non)) 392 fullUnwind (InvConflictor ix xx x) = 393 invert (fullUnwind (Conflictor ix xx x)) 394 395instance PrimPatch prim => CommuteNoConflicts (RepoPatchV2 prim) where 396 commuteNoConflicts (d1@(Duplicate _) :> d2@(Duplicate _)) = Just (d2 :> d1) 397 commuteNoConflicts (e@(Etacilpud _) :> d@(Duplicate _)) = Just (d :> e) 398 commuteNoConflicts (d@(Duplicate _) :> e@(Etacilpud _)) = Just (e :> d) 399 commuteNoConflicts (e1@(Etacilpud _) :> e2@(Etacilpud _)) = Just (e2 :> e1) 400 401 -- If the duplicate is @x@, as a 'Non', with @invert x@ as the context, 402 -- then it is the patch the duplicate @d@ represents, so commuting results 403 -- in the same two patches (since we'd make one a duplicate, and the other 404 -- would become @x@ as it would no longer be duplicated). 405 -- Otherwise, we commute past, or remove @invert x@ from the context of @d@ 406 -- to obtain a new Duplicate. 407 commuteNoConflicts orig@(x :> Duplicate d) = 408 if d == commuteOrAddToCtx (invert x) (non x) 409 then Just orig 410 else do d' <- commuteOrRemFromCtx (invert x) d 411 return (Duplicate d' :> x) 412 413 -- Commuting a Duplicate and any other patch simply places @invert x@ into 414 -- the context of the non @d@, by commuting past, or adding to the context. 415 commuteNoConflicts (Duplicate d :> x) = 416 Just (x :> Duplicate (commuteOrAddToCtx (invert x) d)) 417 418 -- handle Etacilpud cases by first inverting, then using the previous 419 -- definitions. 420 commuteNoConflicts c@(Etacilpud _ :> _) = invertCommuteNC c 421 commuteNoConflicts c@(_ :> Etacilpud _) = invertCommuteNC c 422 423 -- Two normal patches should be simply commuted (assuming the can). 424 commuteNoConflicts (Normal x :> Normal y) = do 425 y' :> x' <- commute (x :> y) 426 return (Normal y' :> Normal x') 427 428 -- Commuting a Normal patch past a Conflictor first commutes @x@ past the 429 -- effect of the Conflictor, then commutes the resulting @x'@ past the 430 -- conflicting patch and the already-undone patches. The commuting must be 431 -- done in this order to make the contexts match up (@iy@ and @y@ are made 432 -- in the context before @yy@ have their effect, so we need to commute past 433 -- the effect of @yy@ first). 434 commuteNoConflicts (Normal x :> Conflictor iy yy y) = do 435 iyy' :> x' <- commuteFL (x :> invert yy) 436 y' : iy' <- mapM (Normal x' >*) (y : iy) 437 return (Conflictor iy' (invert iyy') y' :> Normal x') 438 439 -- Handle via the previous case, using the inverting commuter. 440 commuteNoConflicts c@(InvConflictor{} :> Normal _) = invertCommuteNC c 441 442 -- Commuting a Conflictor past a Normal patch is the dual operation to 443 -- commuting a Normal patch past a Conflictor. 444 commuteNoConflicts (Conflictor iy yy y :> Normal x) = do 445 y' : iy' <- mapM (*> Normal x) (y : iy) 446 x' :> iyy' <- commuteRL (invertFL yy :> x) 447 return (Normal x' :> Conflictor iy' (invertRL iyy') y') 448 449 -- Handle via the previous case, using the inverting commuter. 450 commuteNoConflicts c@(Normal _ :> InvConflictor{}) = invertCommuteNC c 451 452 -- Commuting two Conflictors, c1 and c2, first commutes the Conflictors' 453 -- effects, then commutes the effect of c1 and c2 and the other's 454 -- already-undone, and conflicting patch, to bring the already-undone and 455 -- conflicting patch into the context of the commuted effects. 456 commuteNoConflicts (Conflictor ix xx x :> Conflictor iy yy y) = do 457 xx' :> yy' <- commute (yy :> xx) 458 x':ix' <- mapM (yy >>*) (x:ix) 459 y':iy' <- mapM (*>> xx') (y:iy) 460 False <- return $ any (conflictsWith y) (x':ix') 461 False <- return $ any (conflictsWith x') iy 462 return (Conflictor iy' yy' y' :> Conflictor ix' xx' x') 463 464 -- Handle via the previous case, using the inverting commuter. 465 commuteNoConflicts c@(InvConflictor{} :> InvConflictor{}) = 466 invertCommuteNC c 467 468 commuteNoConflicts (InvConflictor ix xx x :> Conflictor iy yy y) = do 469 iyy' :> xx' <- commute (xx :> invert yy) 470 y':iy' <- mapM (xx' >>*) (y:iy) 471 x':ix' <- mapM (invertFL iyy' >>*) (x:ix) 472 False <- return $ any (conflictsWith y') (x':ix') 473 False <- return $ any (conflictsWith x') iy' 474 return (Conflictor iy' (invert iyy') y' :> InvConflictor ix' xx' x') 475 476 commuteNoConflicts (Conflictor iy' yy' y' :> InvConflictor ix' xx' x') = do 477 xx :> iyy <- commute (invert yy' :> xx') 478 y:iy <- mapM (*>> xx') (y':iy') 479 x:ix <- mapM (*>> yy') (x':ix') 480 False <- return $ any (conflictsWith y') (x':ix') 481 False <- return $ any (conflictsWith x') iy' 482 return (InvConflictor ix xx x :> Conflictor iy (invert iyy) y) 483 484instance PrimPatch prim => Check (RepoPatchV2 prim) where 485 isInconsistent = isConsistent 486 487type instance PatchId (RepoPatchV2 prim) = () 488 489instance FromPrim (RepoPatchV2 prim) where 490 fromAnonymousPrim = Normal 491 492instance ToPrim (RepoPatchV2 prim) where 493 toPrim (Normal p) = Just p 494 toPrim _ = Nothing 495 496instance PrimPatch prim => Eq2 (RepoPatchV2 prim) where 497 (Duplicate x) =\/= (Duplicate y) | x == y = IsEq 498 (Etacilpud x) =\/= (Etacilpud y) | x == y = IsEq 499 (Normal x) =\/= (Normal y) = x =\/= y 500 (Conflictor cx xx x) =\/= (Conflictor cy yy y) 501 | map commuteOrAddIXX cx `eqSet` map commuteOrAddIYY cy 502 && commuteOrAddIXX x == commuteOrAddIYY y = xx =/\= yy 503 where 504 commuteOrAddIXX = commutePrimsOrAddToCtx (invertFL xx) 505 commuteOrAddIYY = commutePrimsOrAddToCtx (invertFL yy) 506 (InvConflictor cx xx x) =\/= (InvConflictor cy yy y) 507 | cx `eqSet` cy && x == y = xx =\/= yy 508 _ =\/= _ = NotEq 509 510eqSet :: Eq a => [a] -> [a] -> Bool 511eqSet [] [] = True 512eqSet (x:xs) xys | Just ys <- remove1 x xys = eqSet xs ys 513eqSet _ _ = False 514 515remove1 :: Eq a => a -> [a] -> Maybe [a] 516remove1 x (y : ys) = if x == y then Just ys else (y :) `fmap` remove1 x ys 517remove1 _ [] = Nothing 518 519minus :: Eq a => [a] -> [a] -> Maybe [a] 520minus xs [] = Just xs 521minus xs (y:ys) = do xs' <- remove1 y xs 522 xs' `minus` ys 523 524invertNon :: PrimPatch prim => Non (RepoPatchV2 prim) wX 525 -> Non (RepoPatchV2 prim) wX 526invertNon (Non c x) 527 | Just rc' <- removeRL nix (reverseFL c) = Non (reverseRL rc') (invert x) 528 | otherwise = commuteOrAddToCtxRL (reverseFL c :<: Normal x) $ non nix 529 where 530 nix = Normal $ invert x 531 532nonTouches :: PatchInspect prim => Non (RepoPatchV2 prim) wX -> [AnchoredPath] 533nonTouches (Non c x) = listTouchedFiles (c +>+ Normal x :>: NilFL) 534 535nonHunkMatches :: PatchInspect prim => (BC.ByteString -> Bool) 536 -> Non (RepoPatchV2 prim) wX -> Bool 537nonHunkMatches f (Non c x) = hunkMatches f c || hunkMatches f x 538 539toNons :: forall p wX wY . (Commute p, PatchListFormat p, 540 Nonable p, ShowPatchBasic (PrimOf p), ShowPatchBasic p) 541 => FL p wX wY -> [Non p wX] 542toNons xs = map lastNon $ initsFL xs 543 where lastNon :: Sealed ((p :> FL p) wX) -> Non p wX 544 lastNon (Sealed xxx) = 545 case lastNon_aux xxx of 546 deps :> p :> _ -> 547 case non p of 548 Non NilFL pp -> Non (reverseRL deps) pp 549 Non ds pp -> 550 error $ renderString $ 551 redText "Weird case in toNons" $$ 552 redText "please report this bug!" $$ 553 (case xxx of 554 z :> zs -> displayPatch (z :>: zs)) $$ 555 redText "ds are" $$ displayPatch ds $$ 556 redText "pp is" $$ displayPatch pp 557 558 reverseFoo :: (p :> FL p) wX wZ -> (RL p :> p) wX wZ 559 reverseFoo (p :> ps) = rf NilRL p ps 560 where 561 rf :: RL p wA wB -> p wB wC -> FL p wC wD 562 -> (RL p :> p) wA wD 563 rf rs l NilFL = rs :> l 564 rf rs x (y :>: ys) = rf (rs :<: x) y ys 565 566 lastNon_aux :: (p :> FL p) wX wZ -> (RL p :> p :> RL p) wX wZ 567 lastNon_aux = commuteWhatWeCanRL . reverseFoo 568 569filterConflictsFL :: PrimPatch prim => Non (RepoPatchV2 prim) wX 570 -> FL prim wX wY -> (FL prim :> FL prim) wX wY 571filterConflictsFL _ NilFL = NilFL :> NilFL 572filterConflictsFL n (p :>: ps) 573 | Just n' <- commuteOrRemFromCtx (Normal p) n = 574 case filterConflictsFL n' ps of 575 p1 :> p2 -> p :>: p1 :> p2 576 | otherwise = case commuteWhatWeCanFL (p :> ps) of 577 p1 :> p' :> p2 -> 578 case filterConflictsFL n p1 of 579 p1a :> p1b -> p1a :> p1b +>+ p' :>: p2 580 581instance Invert prim => Invert (RepoPatchV2 prim) where 582 invert (Duplicate d) = Etacilpud d 583 invert (Etacilpud d) = Duplicate d 584 invert (Normal p) = Normal (invert p) 585 invert (Conflictor x c p) = InvConflictor x c p 586 invert (InvConflictor x c p) = Conflictor x c p 587 588-- | Commute conflicting patches, i.e. one of them is the result of a 589-- conflicted 'merge' with the other. 590commuteConflicting :: PrimPatch prim 591 => CommuteFn (RepoPatchV2 prim) (RepoPatchV2 prim) 592commuteConflicting (Normal x :> Conflictor a1'nop2 n1'x p1') 593 | Just rn1' <- removeRL x (reverseFL n1'x) = do 594 let p2 : n1nons = reverse $ xx2nons a1'nop2 $ reverseRL (rn1' :<: x) 595 a2 = p1' : a1'nop2 ++ n1nons 596 case (a1'nop2, reverseRL rn1', p1') of 597 ([], NilFL, Non c y) | NilFL <- joinEffects c -> 598 Just (Normal y :> Conflictor a1'nop2 (y :>: NilFL) p2) 599 (a1, n1, _) -> 600 Just (Conflictor a1 n1 p1' :> Conflictor a2 NilFL p2) 601commuteConflicting c@(InvConflictor{} :> Normal _) = invertCommuteC c 602commuteConflicting (Conflictor a1 n1 p1 :> Conflictor a2 n2 p2) 603 | Just a2_minus_p1 <- remove1 p1' a2 604 , not (p2 `dependsUpon` p1') = do 605 let n1nons = map (commutePrimsOrAddToCtx n2) $ xx2nons a1 n1 606 n2nons = xx2nons a2 n2 607 Just a2_minus_p1n1 = a2_minus_p1 `minus` n1nons 608 n2n1 = n2 +>+ n1 609 a1' = map (commutePrimsOrAddToCtx n2) a1 610 p2ooo = remNons a1' p2 611 n1' :> n2' <- return $ filterConflictsFL p2ooo n2n1 612 let n1'n2'nons = xx2nons a2_minus_p1n1 (n1' +>+ n2') 613 n1'nons = take (lengthFL n1') n1'n2'nons 614 n2'nons = drop (lengthFL n1') n1'n2'nons 615 Just a1'nop2 = (a2 ++ n2nons) `minus` (p1' : n1'nons) 616 Just a2'o = 617 fst (allConflictsWith p2 $ a2_minus_p1 ++ n2nons) 618 `minus` n2'nons 619 Just a2' = 620 mapM (commuteOrRemFromCtxFL (xx2patches a1'nop2 n1')) a2'o 621 Just p2' = commuteOrRemFromCtxFL (xx2patches a1'nop2 n1') p2 622 case (a2', n2', p2') of 623 ([], NilFL, Non c x) -> 624 case joinEffects c of 625 NilFL -> let n1'x = n1' +>+ x :>: NilFL in 626 Just (Normal x :> Conflictor a1'nop2 n1'x p1') 627 _ -> error "impossible case" 628 _ -> Just (c1 :> c2) 629 where 630 c1 = Conflictor a2' n2' p2' 631 c2 = Conflictor (p2 : a1'nop2) n1' p1' 632 where (_, rpn2) = geteff a2 n2 633 p1' = commuteOrAddToCtxRL (reverseFL rpn2) p1 634commuteConflicting c@(InvConflictor{} :> InvConflictor{}) = invertCommuteC c 635commuteConflicting _ = Nothing 636 637instance PrimPatch prim => Commute (RepoPatchV2 prim) where 638 commute pair@(x :> y) = 639 commuteNoConflicts (assertConsistent x :> assertConsistent y) 640 `mplus` 641 commuteConflicting pair 642 643instance PrimPatch prim => CleanMerge (RepoPatchV2 prim) where 644 cleanMerge = mergeNoConflicts 645 646instance PrimPatch prim => Merge (RepoPatchV2 prim) where 647 merge (InvConflictor{} :\/: _) = error "impossible case" 648 merge (_ :\/: InvConflictor{}) = error "impossible case" 649 merge (Etacilpud _ :\/: _) = error "impossible case" 650 merge (_ :\/: Etacilpud _) = error "impossible case" 651 652 653 merge (Duplicate a :\/: Duplicate b) = Duplicate b :/\: Duplicate a 654 -- We had a FIXME comment on this case, why? 655 merge (Duplicate a :\/: b) = 656 b :/\: Duplicate (commuteOrAddToCtx (invert b) a) 657 658 -- Handle using the swap merge and the previous case. 659 merge m@(_ :\/: Duplicate _) = swapMerge m 660 661 merge (x :\/: y) 662 -- First try the non-conflicting merge. 663 | Just (y' :/\: x') <- 664 mergeNoConflicts ((assertConsistent x) :\/: (assertConsistent y)) 665 = assertConsistent y' :/\: assertConsistent x' 666 -- If we detect equal patches, we have a duplicate. 667 | IsEq <- x =\/= y 668 , n <- commuteOrAddToCtx (invert x) $ non x = 669 Duplicate n :/\: Duplicate n 670 671 -- We know that these two patches conflict, and aren't Duplicates, since we 672 -- failed the previous case. We therefore create basic Conflictors, which 673 -- undo the other patch. 674 merge (nx@(Normal x) :\/: ny@(Normal y)) = cy :/\: cx 675 where 676 cy = Conflictor [] (x :>: NilFL) (non ny) 677 cx = Conflictor [] (y :>: NilFL) (non nx) 678 679 -- If a Normal patch @x@ and a Conflictor @cy@ conflict, we add @x@ to the 680 -- effect of @cy@ on one side, and create a Conflictor that has no effect, 681 -- but has the already-undone and conflicted patch of @cy@ and some foos as 682 -- the already-undone on the other side. 683 -- 684 -- TODO: what is foo? 685 -- Why do we need nyy? I think @x'@ is @x@ in the context of @yy@. 686 merge (Normal x :\/: Conflictor iy yy y) = 687 Conflictor iy yyx y :/\: Conflictor (y : iy ++ nyy) NilFL x' 688 where yyx = yy +>+ x :>: NilFL 689 (x' : nyy) = reverse $ xx2nons iy yyx 690 691 -- Handle using the swap merge and the previous case. 692 merge m@(Conflictor{} :\/: Normal _) = swapMerge m 693 694 -- mH see also cH 695 merge (Conflictor ix xx x :\/: Conflictor iy yy y) = 696 case pullCommonRL (reverseFL xx) (reverseFL yy) of 697 CommonRL rxx1 ryy1 c -> 698 case commuteRLFL (ryy1 :> invertRL rxx1) of 699 Just (ixx' :> ryy') -> 700 let xx' = invert ixx' 701 yy' = reverseRL ryy' 702 y' : iy' = 703 map (commutePrimsOrAddToCtx xx') (y : iy) 704 x' : ix' = 705 map (commutePrimsOrAddToCtx ryy') (x : ix) 706 nyy' = xx2nons iy' yy' 707 nxx' = xx2nons ix' xx' 708 icx = drop (lengthRL rxx1) $ 709 xx2nons ix (reverseRL $ rxx1 +<+ c) 710 ic' = map (commutePrimsOrAddToCtx ryy') icx 711 -- +++ is a more efficient version of nub (iy' ++ 712 -- ix') given that we know each element shows up 713 -- only once in either list. 714 ixy' = ic' ++ (iy' +++ ix') 715 c1 = Conflictor (x' : ixy' ++ nxx') yy' y' 716 c2 = Conflictor (y' : ixy' ++ nyy') xx' x' in 717 c1 :/\: c2 718 Nothing -> error "impossible case" 719 720instance PatchInspect prim => PatchInspect (RepoPatchV2 prim) where 721 listTouchedFiles (Duplicate p) = nonTouches p 722 listTouchedFiles (Etacilpud p) = nonTouches p 723 listTouchedFiles (Normal p) = listTouchedFiles p 724 listTouchedFiles (Conflictor x c p) = 725 nubSort $ concatMap nonTouches x ++ listTouchedFiles c ++ nonTouches p 726 listTouchedFiles (InvConflictor x c p) = 727 nubSort $ concatMap nonTouches x ++ listTouchedFiles c ++ nonTouches p 728 729 hunkMatches f (Duplicate p) = nonHunkMatches f p 730 hunkMatches f (Etacilpud p) = nonHunkMatches f p 731 hunkMatches f (Normal p) = hunkMatches f p 732 hunkMatches f (Conflictor x c p) = 733 any (nonHunkMatches f) x || hunkMatches f c || nonHunkMatches f p 734 hunkMatches f (InvConflictor x c p) = 735 any (nonHunkMatches f) x || hunkMatches f c || nonHunkMatches f p 736 737-- | Split the rhs into those that /transitively/ conflict with the 738-- lhs and those that don't. 739allConflictsWith :: PrimPatch prim => Non (RepoPatchV2 prim) wX 740 -> [Non (RepoPatchV2 prim) wX] 741 -> ([Non (RepoPatchV2 prim) wX], [Non (RepoPatchV2 prim) wX]) 742allConflictsWith x ys = acw $ partition (conflictsWith x) ys 743 where 744 acw ([], nc) = ([], nc) 745 acw (c:cs, nc) = case allConflictsWith c nc of 746 (c1, nc1) -> case acw (cs, nc1) of 747 (xs', nc') -> (c : c1 ++ xs', nc') 748 749conflictsWith :: PrimPatch prim => Non (RepoPatchV2 prim) wX 750 -> Non (RepoPatchV2 prim) wX -> Bool 751conflictsWith x y | x `dependsUpon` y || y `dependsUpon` x = False 752conflictsWith x (Non cy y) = 753 case commuteOrRemFromCtxFL cy x of 754 Just (Non cx' x') -> 755 let iy = Normal $ invert y in 756 case commuteFL (iy :> cx' +>+ Normal x' :>: NilFL) of 757 Just _ -> False 758 Nothing -> True 759 Nothing -> True 760 761dependsUpon :: PrimPatch prim => Non (RepoPatchV2 prim) wX 762 -> Non (RepoPatchV2 prim) wX -> Bool 763dependsUpon (Non xs _) (Non ys y) = 764 case removeSubsequenceFL (ys +>+ Normal y :>: NilFL) xs of 765 Just _ -> True 766 Nothing -> False 767 768(+++) :: Eq a => [a] -> [a] -> [a] 769[] +++ x = x 770x +++ [] = x 771(x:xs) +++ xys | Just ys <- remove1 x xys = x : (xs +++ ys) 772 | otherwise = x : (xs +++ xys) 773 774invertCommuteC :: PrimPatch prim => CommuteFn (RepoPatchV2 prim) (RepoPatchV2 prim) 775invertCommuteC = invertCommuter commuteConflicting 776 777invertCommuteNC :: PrimPatch prim => CommuteFn (RepoPatchV2 prim) (RepoPatchV2 prim) 778invertCommuteNC = invertCommuter commuteNoConflicts 779 780-- | 'pullCommon' @xs ys@ returns the set of patches that can be commuted out 781-- of both @xs@ and @ys@ along with the remnants of both lists 782pullCommon :: (Commute p, Eq2 p) => FL p wO wX -> FL p wO wY -> Common p wO wX wY 783pullCommon NilFL ys = Fork NilFL NilFL ys 784pullCommon xs NilFL = Fork NilFL xs NilFL 785pullCommon (x :>: xs) xys | Just ys <- removeFL x xys = 786 case pullCommon xs ys of 787 Fork c xs' ys' -> Fork (x :>: c) xs' ys' 788pullCommon (x :>: xs) ys = 789 case commuteWhatWeCanFL (x :> xs) of 790 xs1 :> x' :> xs2 -> case pullCommon xs1 ys of 791 Fork c xs1' ys' -> Fork c (xs1' +>+ x' :>: xs2) ys' 792 793-- | 'Common' @cs xs ys@ represents two sequences of patches that have @cs@ in 794-- common, in other words @cs +>+ xs@ and @cs +>+ ys@ 795type Common p wO wX wY = Fork (FL p) (FL p) (FL p) wO wX wY 796 797-- | 'pullCommonRL' @xs ys@ returns the set of patches that can be commuted 798-- out of both @xs@ and @ys@ along with the remnants of both lists 799pullCommonRL :: (Commute p, Eq2 p) => RL p wX wO -> RL p wY wO -> CommonRL p wX wY wO 800pullCommonRL NilRL ys = CommonRL NilRL ys NilRL 801pullCommonRL xs NilRL = CommonRL xs NilRL NilRL 802pullCommonRL (xs :<: x) xys | Just ys <- removeRL x xys = 803 case pullCommonRL xs ys of 804 CommonRL xs' ys' c -> CommonRL xs' ys' (c :<: x) 805pullCommonRL (xs :<: x) ys = 806 case commuteWhatWeCanRL (xs :> x) of 807 xs1 :> x' :> xs2 -> 808 case pullCommonRL xs2 ys of 809 CommonRL xs2' ys' c -> CommonRL (xs1 :<: x' +<+ xs2') ys' c 810 811-- | 'CommonRL' @xs ys cs@' represents two sequences of patches that have @cs@ 812-- in common, in other words @xs +<+ cs@ and @ys +<+ cs@ 813data CommonRL p wX wY wF where 814 CommonRL :: RL p wX wI -> RL p wY wI -> RL p wI wF -> CommonRL p wX wY wF 815 816instance PrimPatch prim => Apply (RepoPatchV2 prim) where 817 type ApplyState (RepoPatchV2 prim) = ApplyState prim 818 apply p = applyPrimFL (effect p) 819 820instance PrimPatch prim => RepairToFL (RepoPatchV2 prim) where 821 applyAndTryToFixFL (Normal p) = 822 mapMaybeSnd (mapFL_FL Normal) `liftM` applyAndTryToFixFL p 823 applyAndTryToFixFL x = do apply x; return Nothing 824 825instance PatchListFormat (RepoPatchV2 prim) where 826 -- In principle we could use ListFormatDefault when prim /= V1 Prim patches, 827 -- as those are the only case where we need to support a legacy on-disk 828 -- format. In practice we don't expect RepoPatchV2 to be used with any other 829 -- argument anyway, so it doesn't matter. 830 patchListFormat = ListFormatV2 831 832duplicate, etacilpud, conflictor, rotcilfnoc :: String 833duplicate = "duplicate" 834etacilpud = "etacilpud" 835conflictor = "conflictor" 836rotcilfnoc = "rotcilfnoc" 837 838instance PrimPatch prim => ShowPatchBasic (RepoPatchV2 prim) where 839 showPatch f (Duplicate d) = blueText duplicate $$ showNon f d 840 showPatch f (Etacilpud d) = blueText etacilpud $$ showNon f d 841 showPatch f (Normal p) = showPatch f p 842 showPatch f (Conflictor i NilFL p) = 843 blueText conflictor <+> showNons f i <+> blueText "[]" $$ showNon f p 844 showPatch f (Conflictor i cs p) = 845 blueText conflictor <+> showNons f i <+> blueText "[" $$ 846 showFL f cs $$ 847 blueText "]" $$ 848 showNon f p 849 showPatch f (InvConflictor i NilFL p) = 850 blueText rotcilfnoc <+> showNons f i <+> blueText "[]" $$ showNon f p 851 showPatch f (InvConflictor i cs p) = 852 blueText rotcilfnoc <+> showNons f i <+> blueText "[" $$ 853 showFL f cs $$ 854 blueText "]" $$ 855 showNon f p 856 857instance PrimPatch prim => ShowContextPatch (RepoPatchV2 prim) where 858 showContextPatch f (Normal p) = showContextPatch f p 859 showContextPatch f p = return $ showPatch f p 860 861instance PrimPatch prim => ShowPatch (RepoPatchV2 prim) where 862 summary = plainSummary 863 summaryFL = plainSummary 864 thing _ = "change" 865 866instance PrimPatch prim => ReadPatch (RepoPatchV2 prim) where 867 readPatch' = do 868 skipSpace 869 let str = string . BC.pack 870 readConflictorPs = do 871 i <- readNons 872 ps <- bracketedFL readPatch' '[' ']' 873 p <- readNon 874 return (i, ps, p) 875 choice [ do str duplicate 876 p <- readNon 877 return $ Sealed $ Duplicate p 878 , do str etacilpud 879 p <- readNon 880 return $ Sealed $ Etacilpud p 881 , do str conflictor 882 (i, Sealed ps, p) <- readConflictorPs 883 return $ Sealed $ Conflictor i (unsafeCoerceP ps) p 884 , do str rotcilfnoc 885 (i, Sealed ps, p) <- readConflictorPs 886 return $ Sealed $ InvConflictor i ps p 887 , do Sealed p <- readPatch' 888 return $ Sealed $ Normal p 889 ] 890 891instance Show2 prim => Show (RepoPatchV2 prim wX wY) where 892 showsPrec d (Normal prim) = 893 showParen (d > appPrec) $ showString "Normal " . showsPrec2 (appPrec + 1) prim 894 895 showsPrec d (Duplicate x) = 896 showParen (d > appPrec) $ showString "Duplicate " . showsPrec (appPrec + 1) x 897 898 showsPrec d (Etacilpud x) = 899 showParen (d > appPrec) $ showString "Etacilpud " . showsPrec (appPrec + 1) x 900 901 showsPrec d (Conflictor ix xx x) = 902 showParen (d > appPrec) $ 903 showString "Conflictor " . showsPrec (appPrec + 1) ix . 904 showString " " . showsPrec (appPrec + 1) xx . 905 showString " " . showsPrec (appPrec + 1) x 906 907 showsPrec d (InvConflictor ix xx x) = 908 showParen (d > appPrec) $ 909 showString "InvConflictor " . showsPrec (appPrec + 1) ix . 910 showString " " . showsPrec (appPrec + 1) xx . 911 showString " " . showsPrec (appPrec + 1) x 912 913instance Show2 prim => Show1 (RepoPatchV2 prim wX) 914 915instance Show2 prim => Show2 (RepoPatchV2 prim) 916 917instance PrimPatch prim => Nonable (RepoPatchV2 prim) where 918 non (Duplicate d) = d 919 non (Etacilpud d) = invertNon d -- FIXME !!! ??? 920 non (Normal p) = Non NilFL p 921 non (Conflictor _ xx x) = commutePrimsOrAddToCtx (invertFL xx) x 922 non (InvConflictor _ _ n) = invertNon n 923 924instance PrimPatch prim => Effect (RepoPatchV2 prim) where 925 effect (Duplicate _) = NilFL 926 effect (Etacilpud _) = NilFL 927 effect (Normal p) = p :>: NilFL 928 effect (Conflictor _ e _) = invert e 929 effect (InvConflictor _ e _) = e 930 931instance IsHunk prim => IsHunk (RepoPatchV2 prim) where 932 isHunk rp = do Normal p <- return rp 933 isHunk p 934 935displayNons :: (PatchListFormat p, ShowPatchBasic p, PrimPatchBase p) => 936 [Non p wX] -> Doc 937displayNons p = showNons ForDisplay p 938 939showFL :: ShowPatchBasic p => ShowPatchFor -> FL p wX wY -> Doc 940showFL f = vcat . mapFL (showPatch f) 941