{-# OPTIONS_GHC -fno-warn-orphans #-} module Darcs.Patch.Prim.FileUUID.Commute () where import Prelude () 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.Permutations () -- for Invert instance of FL -- For FileUUID it is easier to list the cases that do /not/ commute depends :: (Prim :> Prim) wX wY -> Bool depends (Manifest i1 l1 :> Demanifest i2 l2) -- cannot commute add with remove of same object, regardless of location | i1 == i2 = True -- cannot commute add with remove of any two things at the same location | l1 == l2 = True depends (Demanifest i1 l1 :> Manifest i2 l2) -- cannot commute remove with add of same object, regardless of location | i1 == i2 = True -- cannot commute remove with add of any two things at the same location | l1 == l2 = True depends (_ :> _) = False instance Commute Prim where commute pair | depends pair = Nothing commute (Hunk f1 h1 :> Hunk f2 h2) | f1 == f2 = case commuteHunk (h1 :> h2) of Just (h2' :> h1') -> Just (Hunk f2 h2' :> Hunk f1 h1') Nothing -> Nothing commute (a :> b) = Just (unsafeCoerceP b :> unsafeCoerceP a) commuteHunk :: (Hunk :> Hunk) wX wY -> Maybe ((Hunk :> Hunk) wX wY) commuteHunk (H off1 old1 new1 :> H off2 old2 new2) | off1 + len_new1 < off2 = yes (off2 - len_new1 + len_old1, off1) | off2 + len_old2 < off1 = yes (off2, off1 + len_new2 - len_old2) | len_old2 /= 0 , len_old1 /= 0 , len_new2 /= 0 , len_new1 /= 0 , off1 + len_new1 == off2 = yes (off2 - len_new1 + len_old1, off1) | len_old2 /= 0 , len_old1 /= 0 , len_new2 /= 0 , len_new1 /= 0 , off2 + len_old2 == off1 = yes (off2, off1 + len_new2 - len_old2) | otherwise = no where len_old1 = B.length old1 len_new1 = B.length new1 len_old2 = B.length old2 len_new2 = B.length new2 yes (off2', off1') = Just (H off2' old2 new2 :> H off1' old1 new1) no = Nothing