{-# 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 :: (:>) 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 UUID -> UUID -> Bool
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 Location -> Location -> Bool
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 UUID -> UUID -> Bool
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 Location -> Location -> Bool
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 :: (:>) Prim Prim wX wY -> Maybe ((:>) Prim Prim wX wY)
commute (:>) Prim Prim wX wY
pair
    | (:>) Prim Prim wX wY -> Bool
forall wX wY. (:>) Prim Prim wX wY -> Bool
depends (:>) Prim Prim wX wY
pair = Maybe ((:>) Prim Prim wX wY)
forall a. Maybe a
Nothing
  commute (Hunk UUID
f1 Hunk wX wZ
h1 :> Hunk UUID
f2 Hunk wZ wY
h2)
    | UUID
f1 UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
f2 =
        case (:>) Hunk Hunk wX wY -> Maybe ((:>) Hunk Hunk wX wY)
forall wX wY. (:>) Hunk Hunk wX wY -> Maybe ((:>) Hunk Hunk wX wY)
commuteHunk (Hunk wX wZ
h1 Hunk wX wZ -> Hunk wZ wY -> (:>) Hunk Hunk wX wY
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') -> (:>) Prim Prim wX wY -> Maybe ((:>) Prim Prim wX wY)
forall a. a -> Maybe a
Just (UUID -> Hunk wX wZ -> Prim wX wZ
forall wX wY. UUID -> Hunk wX wY -> Prim wX wY
Hunk UUID
f2 Hunk wX wZ
h2' 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
:> UUID -> Hunk wZ wY -> Prim wZ wY
forall wX wY. UUID -> Hunk wX wY -> Prim wX wY
Hunk UUID
f1 Hunk wZ wY
h1')
          Maybe ((:>) Hunk Hunk wX wY)
Nothing -> Maybe ((:>) Prim Prim wX wY)
forall a. Maybe a
Nothing
  commute (Prim wX wZ
a :> Prim wZ wY
b) =
    (:>) Prim Prim wX wY -> Maybe ((:>) Prim Prim wX wY)
forall a. a -> Maybe a
Just (Prim wZ wY -> Prim wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Prim wZ wY
b Prim wX Any -> Prim Any wY -> (:>) Prim Prim wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Prim wX wZ -> Prim Any 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 :: (:>) 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_new1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
off2  = (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
forall wX wY. (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len_new1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_old1, Int
off1)
  | Int
off2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_old2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
off1  = (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
forall wX wY. (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2, Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_new2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len_old2)
  | Int
len_old2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_old1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_new2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_new1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_new1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
off2 = (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
forall wX wY. (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len_new1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_old1, Int
off1)
  | Int
len_old2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_old1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_new2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
len_new1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
off2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_old2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
off1 = (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
forall wX wY. (Int, Int) -> Maybe ((:>) Hunk Hunk wX wY)
yes (Int
off2, Int
off1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_new2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len_old2)
  | Bool
otherwise               = Maybe ((:>) Hunk Hunk wX wY)
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') = (:>) Hunk Hunk wX wY -> Maybe ((:>) Hunk Hunk wX wY)
forall a. a -> Maybe a
Just (Int -> FileContent -> FileContent -> Hunk wX Any
forall wX wY. Int -> FileContent -> FileContent -> Hunk wX wY
H Int
off2' FileContent
old2 FileContent
new2 Hunk wX Any -> Hunk Any wY -> (:>) Hunk Hunk wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Int -> FileContent -> FileContent -> Hunk Any wY
forall wX wY. Int -> FileContent -> FileContent -> Hunk wX wY
H Int
off1' FileContent
old1 FileContent
new1)
    no :: Maybe a
no = Maybe a
forall a. Maybe a
Nothing

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