{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.Prim.FileUUID.Commute () where

import Darcs.Prelude

import qualified Data.ByteString as B (length)

import Darcs.Patch.Witnesses.Ordered ( (:>)(..) )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Patch.Prim.FileUUID.Core ( Prim(..), Hunk(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Merge ( CleanMerge(..) )
import Darcs.Patch.Permutations () -- for Invert instance of FL
import Darcs.Patch.Prim.Class ( primCleanMerge )

-- For FileUUID it is easier to list the cases that do /not/ commute
depends :: (Prim :> Prim) wX wY -> Bool
depends :: forall wX wY. (:>) Prim Prim wX wY -> Bool
depends (Manifest UUID
i1 Location
l1 :> Demanifest UUID
i2 Location
l2)
  -- cannot commute add with remove of same object, regardless of location
  | UUID
i1 forall a. Eq a => a -> a -> Bool
== UUID
i2 = Bool
True
  -- cannot commute add with remove of any two things at the same location
  | Location
l1 forall a. Eq a => a -> a -> Bool
== Location
l2 = Bool
True
depends (Demanifest UUID
i1 Location
l1 :> Manifest UUID
i2 Location
l2)
  -- cannot commute remove with add of same object, regardless of location
  | UUID
i1 forall a. Eq a => a -> a -> Bool
== UUID
i2 = Bool
True
  -- cannot commute remove with add of any two things at the same location
  | Location
l1 forall a. Eq a => a -> a -> Bool
== Location
l2 = Bool
True
depends (Prim wX wZ
_ :> Prim wZ wY
_) = Bool
False

instance Commute Prim where
  commute :: forall wX wY. (:>) Prim Prim wX wY -> Maybe ((:>) Prim Prim wX wY)
commute (:>) Prim Prim wX wY
pair
    | forall wX wY. (:>) Prim Prim wX wY -> Bool
depends (:>) Prim Prim wX wY
pair = forall a. Maybe a
Nothing
  commute (Hunk UUID
f1 Hunk wX wZ
h1 :> Hunk UUID
f2 Hunk wZ wY
h2)
    | UUID
f1 forall a. Eq a => a -> a -> Bool
== UUID
f2 =
        case forall wX wY. (:>) Hunk Hunk wX wY -> Maybe ((:>) Hunk Hunk wX wY)
commuteHunk (Hunk wX wZ
h1 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Hunk wZ wY
h2) of
          Just (Hunk wX wZ
h2' :> Hunk wZ wY
h1') -> forall a. a -> Maybe a
Just (forall wX wY. UUID -> Hunk wX wY -> Prim wX wY
Hunk UUID
f2 Hunk wX wZ
h2' forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall wX wY. UUID -> Hunk wX wY -> Prim wX wY
Hunk UUID
f1 Hunk wZ wY
h1')
          Maybe ((:>) Hunk Hunk wX wY)
Nothing -> forall a. Maybe a
Nothing
  commute (Prim wX wZ
a :> Prim wZ wY
b) =
    forall a. a -> Maybe a
Just (forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Prim wZ wY
b forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Prim wX wZ
a)

commuteHunk :: (Hunk :> Hunk) wX wY -> Maybe ((Hunk :> Hunk) wX wY)
commuteHunk :: forall wX wY. (:>) Hunk Hunk wX wY -> Maybe ((:>) Hunk Hunk wX wY)
commuteHunk (H Int
off1 FileContent
old1 FileContent
new1 :> H Int
off2 FileContent
old2 FileContent
new2)
  | Int
off1 forall a. Num a => a -> a -> a
+ Int
len_new1 forall a. Ord a => a -> a -> Bool
< Int
off2  = forall {wX} {wY}. (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2 forall a. Num a => a -> a -> a
- Int
len_new1 forall a. Num a => a -> a -> a
+ Int
len_old1, Int
off1)
  | Int
off2 forall a. Num a => a -> a -> a
+ Int
len_old2 forall a. Ord a => a -> a -> Bool
< Int
off1  = forall {wX} {wY}. (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2, Int
off1 forall a. Num a => a -> a -> a
+ Int
len_new2 forall a. Num a => a -> a -> a
- Int
len_old2)
  | Int
len_old2 forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_old1 forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_new2 forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_new1 forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
off1 forall a. Num a => a -> a -> a
+ Int
len_new1 forall a. Eq a => a -> a -> Bool
== Int
off2 = forall {wX} {wY}. (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2 forall a. Num a => a -> a -> a
- Int
len_new1 forall a. Num a => a -> a -> a
+ Int
len_old1, Int
off1)
  | Int
len_old2 forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_old1 forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_new2 forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_new1 forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
off2 forall a. Num a => a -> a -> a
+ Int
len_old2 forall a. Eq a => a -> a -> Bool
== Int
off1 = forall {wX} {wY}. (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2, Int
off1 forall a. Num a => a -> a -> a
+ Int
len_new2 forall a. Num a => a -> a -> a
- Int
len_old2)
  | Bool
otherwise               = forall a. Maybe a
no
  where
    len_old1 :: Int
len_old1 = FileContent -> Int
B.length FileContent
old1
    len_new1 :: Int
len_new1 = FileContent -> Int
B.length FileContent
new1
    len_old2 :: Int
len_old2 = FileContent -> Int
B.length FileContent
old2
    len_new2 :: Int
len_new2 = FileContent -> Int
B.length FileContent
new2
    yes :: (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2', Int
off1') = forall a. a -> Maybe a
Just (forall wX wY. Int -> FileContent -> FileContent -> Hunk wX wY
H Int
off2' FileContent
old2 FileContent
new2 forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> forall wX wY. Int -> FileContent -> FileContent -> Hunk wX wY
H Int
off1' FileContent
old1 FileContent
new1)
    no :: Maybe a
no = forall a. Maybe a
Nothing

instance CleanMerge Prim where
  cleanMerge :: forall wX wY.
(:\/:) Prim Prim wX wY -> Maybe ((:/\:) Prim Prim wX wY)
cleanMerge = forall (prim :: * -> * -> *).
(Commute prim, Invert prim) =>
PartialMergeFn prim prim
primCleanMerge