{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.Prim.V1.Commute
    ( Perhaps(..)
    , toPerhaps
    , CommuteFunction
    , speedyCommute
    , cleverCommute
    , commuteFiledir
    , commuteFilepatches
    ) where

import Darcs.Prelude

import Control.Monad ( MonadPlus, msum, mzero, mplus )
import Control.Applicative ( Alternative(..) )

import qualified Data.ByteString as B ( ByteString )
import qualified Data.ByteString.Char8 as BC ( pack )

import Darcs.Util.Path ( AnchoredPath, movedirfilename, isPrefix )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Patch.Witnesses.Ordered ( (:>)(..) )
import Darcs.Patch.Prim.V1.Core
     ( Prim(..), FilePatchType(..) )
import Darcs.Patch.Invert ( Invert(..) )
import Darcs.Patch.Merge ( CleanMerge(..) )
import Darcs.Patch.Commute ( Commute(..) )
import Darcs.Patch.Permutations () -- for Invert instance of FL
import Darcs.Patch.Prim.Class ( primCleanMerge )
import Darcs.Patch.TokenReplace ( tryTokReplace )

isSuperdir :: AnchoredPath -> AnchoredPath -> Bool
isSuperdir :: AnchoredPath -> AnchoredPath -> Bool
isSuperdir AnchoredPath
d1 AnchoredPath
d2 = AnchoredPath -> AnchoredPath -> Bool
isPrefix AnchoredPath
d1 AnchoredPath
d2 Bool -> Bool -> Bool
&& AnchoredPath
d1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
/= AnchoredPath
d2

{-
This is the original definition.
Note that it explicitly excludes equality:

isSuperdir d1 d2 = isd (fn2fp d1) (fn2fp d2)
  where
    isd s1 s2 =
      length s2 >= length s1 + 1 && take (length s1 + 1) s2 == s1 ++ "/"
-}

isInDirectory :: AnchoredPath -> AnchoredPath -> Bool
isInDirectory :: AnchoredPath -> AnchoredPath -> Bool
isInDirectory = AnchoredPath -> AnchoredPath -> Bool
isPrefix
{-
Again, here is the orginial definition:
isInDirectory d f = iid (fn2fp d) (fn2fp f)
    where iid (cd:cds) (cf:cfs)
              | cd /= cf = False
              | otherwise = iid cds cfs
          iid [] ('/':_) = True
          iid [] [] = True -- Count directory itself as being in directory...
          iid _ _ = False
-}

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 :: CommuteFunction -> CommuteFunction
cleverCommute :: CommuteFunction -> CommuteFunction
cleverCommute CommuteFunction
c (Prim wX wZ
p1:>Prim wZ wY
p2) =
    case (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
CommuteFunction
c (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) of
    Succeeded (:>) Prim Prim wX wY
x -> (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (:>) Prim Prim wX wY
x
    Perhaps ((:>) Prim Prim wX wY)
Failed -> Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    Perhaps ((:>) Prim Prim wX wY)
Unknown -> case (:>) Prim Prim wY wX -> Perhaps ((:>) Prim Prim wY wX)
CommuteFunction
c (Prim wZ wY -> Prim wY wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wZ wY
p2 Prim wY wZ -> Prim wZ wX -> (:>) Prim Prim wY wX
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> Prim wX wZ -> Prim wZ wX
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wX wZ
p1) of
               Succeeded (Prim wY wZ
p1' :> Prim wZ wX
p2') -> (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (Prim wZ wX -> Prim wX wZ
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wZ wX
p2' 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 wY wZ -> Prim wZ wY
forall (p :: * -> * -> *) wX wY. Invert p => p wX wY -> p wY wX
invert Prim wY wZ
p1')
               Perhaps ((:>) Prim Prim wY wX)
Failed -> Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
               Perhaps ((:>) Prim Prim wY wX)
Unknown -> Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Unknown
--cleverCommute c (p1,p2) = c (p1,p2) `mplus`
--    (case c (invert p2,invert p1) of
--     Succeeded (p1', p2') -> Succeeded (invert p2', invert p1')
--     Failed -> Failed
--     Unknown -> Unknown)

speedyCommute :: CommuteFunction  -- Deal with common cases quickly!
    -- Two file-patches modifying different files trivially commute.
speedyCommute :: (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
speedyCommute (p1 :: Prim wX wZ
p1@(FP AnchoredPath
f1 FilePatchType wX wZ
_) :> p2 :: Prim wZ wY
p2@(FP AnchoredPath
f2 FilePatchType wZ wY
_))
  | AnchoredPath
f1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
/= AnchoredPath
f2 = (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (Prim wZ wY -> Prim wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Prim wZ wY
p2 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
p1)
speedyCommute (:>) Prim Prim wX wY
_other = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Unknown

everythingElseCommute :: CommuteFunction
everythingElseCommute :: (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
everythingElseCommute = (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
CommuteFunction
eec
  where
    eec :: CommuteFunction
    eec :: (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
eec (Prim wX wZ
p1 :> ChangePref String
p String
f String
t) = (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (String -> String -> String -> Prim wX Any
forall wX wY. String -> String -> String -> Prim wX wY
ChangePref String
p String
f String
t 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
p1)
    eec (ChangePref String
p String
f String
t :> Prim wZ wY
p2) = (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (Prim wZ wY -> Prim wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP Prim wZ wY
p2 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
:> String -> String -> String -> Prim Any wY
forall wX wY. String -> String -> String -> Prim wX wY
ChangePref String
p String
f String
t)
    eec (:>) Prim Prim wX wY
xx = CommuteFunction
-> (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
CommuteFunction -> CommuteFunction
cleverCommute CommuteFunction
commuteFiledir (:>) Prim Prim wX wY
xx

{-
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)
-}

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

commuteFiledir :: CommuteFunction
commuteFiledir :: (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
commuteFiledir (FP AnchoredPath
f1 FilePatchType wX wZ
p1 :> FP AnchoredPath
f2 FilePatchType wZ wY
p2) =
  if AnchoredPath
f1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
/= AnchoredPath
f2 then (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded ( AnchoredPath -> FilePatchType wX Any -> Prim wX Any
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f2 (FilePatchType wZ wY -> FilePatchType wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FilePatchType wZ wY
p2) 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
:> AnchoredPath -> FilePatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f1 (FilePatchType wX wZ -> FilePatchType Any wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FilePatchType wX wZ
p1) )
  else AnchoredPath
-> (:>) FilePatchType FilePatchType wX wY
-> Perhaps ((:>) Prim Prim wX wY)
forall wX wY.
AnchoredPath
-> (:>) FilePatchType FilePatchType wX wY
-> Perhaps ((:>) Prim Prim wX wY)
commuteFP AnchoredPath
f1 (FilePatchType wX wZ
p1 FilePatchType wX wZ
-> FilePatchType wZ wY -> (:>) FilePatchType FilePatchType wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FilePatchType wZ wY
p2)
commuteFiledir (DP AnchoredPath
d1 DirPatchType wX wZ
p1 :> DP AnchoredPath
d2 DirPatchType wZ wY
p2) =
  if Bool -> Bool
not (AnchoredPath -> AnchoredPath -> Bool
isInDirectory AnchoredPath
d1 AnchoredPath
d2 Bool -> Bool -> Bool
|| AnchoredPath -> AnchoredPath -> Bool
isInDirectory AnchoredPath
d2 AnchoredPath
d1) Bool -> Bool -> Bool
&& AnchoredPath
d1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
/= AnchoredPath
d2
  then (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded ( AnchoredPath -> DirPatchType wX Any -> Prim wX Any
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
d2 (DirPatchType wZ wY -> DirPatchType wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP DirPatchType wZ wY
p2) 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
:> AnchoredPath -> DirPatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
d1 (DirPatchType wX wZ -> DirPatchType Any wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP DirPatchType wX wZ
p1) )
  else Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
commuteFiledir (FP AnchoredPath
f FilePatchType wX wZ
fp :> DP AnchoredPath
d DirPatchType wZ wY
dp) =
    if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ AnchoredPath -> AnchoredPath -> Bool
isInDirectory AnchoredPath
d AnchoredPath
f
    then (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> DirPatchType wX Any -> Prim wX Any
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP AnchoredPath
d (DirPatchType wZ wY -> DirPatchType wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP DirPatchType wZ wY
dp) 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
:> AnchoredPath -> FilePatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (FilePatchType wX wZ -> FilePatchType Any wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FilePatchType wX wZ
fp))
    else Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed

-- FIXME using isSuperdir here makes no sense, should use just isPrefix

commuteFiledir (FP AnchoredPath
f1 FilePatchType wX wZ
p1 :> Move AnchoredPath
d AnchoredPath
d')
    | AnchoredPath
f1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
d' = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | (FilePatchType wX wZ
p1 FilePatchType wX wZ -> FilePatchType wX wZ -> Bool
forall a. Eq a => a -> a -> Bool
== FilePatchType wX wZ
forall wX wY. FilePatchType wX wY
AddFile Bool -> Bool -> Bool
|| FilePatchType wX wZ
p1 FilePatchType wX wZ -> FilePatchType wX wZ -> Bool
forall a. Eq a => a -> a -> Bool
== FilePatchType wX wZ
forall wX wY. FilePatchType wX wY
RmFile) Bool -> Bool -> Bool
&& AnchoredPath
d AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
f1 = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | Bool
otherwise = (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> AnchoredPath -> Prim wX Any
forall wX wY. AnchoredPath -> AnchoredPath -> Prim wX wY
Move AnchoredPath
d AnchoredPath
d' 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
:> AnchoredPath -> FilePatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
d AnchoredPath
d' AnchoredPath
f1) (FilePatchType wX wZ -> FilePatchType Any wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FilePatchType wX wZ
p1))
commuteFiledir (DP AnchoredPath
d1 DirPatchType wX wZ
p1 :> Move AnchoredPath
d AnchoredPath
d')
    | AnchoredPath -> AnchoredPath -> Bool
isSuperdir AnchoredPath
d1 AnchoredPath
d' Bool -> Bool -> Bool
|| AnchoredPath -> AnchoredPath -> Bool
isSuperdir AnchoredPath
d1 AnchoredPath
d = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | AnchoredPath
d AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
d1 = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed  -- The exact guard is p1 == AddDir && d == d1
                        -- but note d == d1 suffices because we know p1 != RmDir
                        -- (and hence p1 == AddDir) since patches must be sequential.
    | AnchoredPath
d1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
d' = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | Bool
otherwise = (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> AnchoredPath -> Prim wX Any
forall wX wY. AnchoredPath -> AnchoredPath -> Prim wX wY
Move AnchoredPath
d AnchoredPath
d' 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
:> AnchoredPath -> DirPatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> DirPatchType wX wY -> Prim wX wY
DP (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
d AnchoredPath
d' AnchoredPath
d1) (DirPatchType wX wZ -> DirPatchType Any wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP DirPatchType wX wZ
p1))
commuteFiledir (Move AnchoredPath
f AnchoredPath
f' :> Move AnchoredPath
d AnchoredPath
d')
    | AnchoredPath
f AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
d' Bool -> Bool -> Bool
|| AnchoredPath
f' AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
d = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | AnchoredPath
f AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
d Bool -> Bool -> Bool
|| AnchoredPath
f' AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
d' = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | AnchoredPath
d AnchoredPath -> AnchoredPath -> Bool
`isSuperdir` AnchoredPath
f Bool -> Bool -> Bool
&& AnchoredPath
f' AnchoredPath -> AnchoredPath -> Bool
`isSuperdir` AnchoredPath
d' = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | Bool
otherwise =
        (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> AnchoredPath -> Prim wX Any
forall wX wY. AnchoredPath -> AnchoredPath -> Prim wX wY
Move (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
f' AnchoredPath
f AnchoredPath
d) (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
f' AnchoredPath
f AnchoredPath
d') 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
:>
                   AnchoredPath -> AnchoredPath -> Prim Any wY
forall wX wY. AnchoredPath -> AnchoredPath -> Prim wX wY
Move (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
d AnchoredPath
d' AnchoredPath
f) (AnchoredPath -> AnchoredPath -> AnchoredPath -> AnchoredPath
movedirfilename AnchoredPath
d AnchoredPath
d' AnchoredPath
f'))

commuteFiledir (:>) Prim Prim wX wY
_ = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Unknown

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

commuteFilepatches :: CommuteFunction
commuteFilepatches :: (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
commuteFilepatches (FP AnchoredPath
f1 FilePatchType wX wZ
p1 :> FP AnchoredPath
f2 FilePatchType wZ wY
p2) | AnchoredPath
f1 AnchoredPath -> AnchoredPath -> Bool
forall a. Eq a => a -> a -> Bool
== AnchoredPath
f2 = AnchoredPath
-> (:>) FilePatchType FilePatchType wX wY
-> Perhaps ((:>) Prim Prim wX wY)
forall wX wY.
AnchoredPath
-> (:>) FilePatchType FilePatchType wX wY
-> Perhaps ((:>) Prim Prim wX wY)
commuteFP AnchoredPath
f1 (FilePatchType wX wZ
p1 FilePatchType wX wZ
-> FilePatchType wZ wY -> (:>) FilePatchType FilePatchType wX wY
forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FilePatchType wZ wY
p2)
commuteFilepatches (:>) Prim Prim wX wY
_ = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Unknown

commuteFP :: AnchoredPath -> (FilePatchType :> FilePatchType) wX wY
          -> Perhaps ((Prim :> Prim) wX wY)
commuteFP :: AnchoredPath
-> (:>) FilePatchType FilePatchType wX wY
-> Perhaps ((:>) Prim Prim wX wY)
commuteFP AnchoredPath
f (FilePatchType wX wZ
p1 :> Hunk Int
line1 [] []) =
    (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> FilePatchType wX Any -> Prim wX Any
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType wX Any
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line1 [] []) 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
:> AnchoredPath -> FilePatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (FilePatchType wX wZ -> FilePatchType Any wY
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FilePatchType wX wZ
p1))
commuteFP AnchoredPath
f (Hunk Int
line1 [] [] :> FilePatchType wZ wY
p2) =
    (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> FilePatchType wX Any -> Prim wX Any
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (FilePatchType wZ wY -> FilePatchType wX Any
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FilePatchType wZ wY
p2) 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
:> AnchoredPath -> FilePatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType Any wY
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line1 [] []))
commuteFP AnchoredPath
f (Hunk Int
line1 [ByteString]
old1 [ByteString]
new1 :> Hunk Int
line2 [ByteString]
old2 [ByteString]
new2) =
    case Int -> Int -> Int -> Int -> Int -> Int -> Maybe (Int, Int)
commuteHunkLines Int
line1 ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
old1) ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
new1) Int
line2 ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
old2) ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
new2) of
      Just (Int
line2', Int
line1') ->
        (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> FilePatchType wX Any -> Prim wX Any
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType wX Any
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line2' [ByteString]
old2 [ByteString]
new2) 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
:> AnchoredPath -> FilePatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType Any wY
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line1' [ByteString]
old1 [ByteString]
new1))
      Maybe (Int, Int)
Nothing -> Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
commuteFP AnchoredPath
f (Hunk Int
line1 [ByteString]
old1 [ByteString]
new1 :> TokReplace String
t String
o String
n) =
    let po :: ByteString
po = String -> ByteString
BC.pack String
o; pn :: ByteString
pn = String -> ByteString
BC.pack String
n in
    case String
-> ByteString -> ByteString -> [ByteString] -> Maybe [ByteString]
tryTokReplaces String
t ByteString
po ByteString
pn [ByteString]
old1 of
    Maybe [ByteString]
Nothing -> Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    Just [ByteString]
old1' ->
      case String
-> ByteString -> ByteString -> [ByteString] -> Maybe [ByteString]
tryTokReplaces String
t ByteString
po ByteString
pn [ByteString]
new1 of
        Maybe [ByteString]
Nothing -> Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
        Just [ByteString]
new1' -> (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> FilePatchType wX Any -> Prim wX Any
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (String -> String -> String -> FilePatchType wX Any
forall wX wY. String -> String -> String -> FilePatchType wX wY
TokReplace String
t String
o String
n) 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
:>
                                 AnchoredPath -> FilePatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (Int -> [ByteString] -> [ByteString] -> FilePatchType Any wY
forall wX wY.
Int -> [ByteString] -> [ByteString] -> FilePatchType wX wY
Hunk Int
line1 [ByteString]
old1' [ByteString]
new1'))
commuteFP AnchoredPath
f (TokReplace String
t1 String
o1 String
n1 :> TokReplace String
t2 String
o2 String
n2)
    | String
t1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
t2 = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | String
o1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
o2 = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
o2 = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | String
o1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2 = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | String
n1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n2 = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Failed
    | Bool
otherwise = (:>) Prim Prim wX wY -> Perhaps ((:>) Prim Prim wX wY)
forall a. a -> Perhaps a
Succeeded (AnchoredPath -> FilePatchType wX Any -> Prim wX Any
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (String -> String -> String -> FilePatchType wX Any
forall wX wY. String -> String -> String -> FilePatchType wX wY
TokReplace String
t2 String
o2 String
n2) 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
:>
                             AnchoredPath -> FilePatchType Any wY -> Prim Any wY
forall wX wY. AnchoredPath -> FilePatchType wX wY -> Prim wX wY
FP AnchoredPath
f (String -> String -> String -> FilePatchType Any wY
forall wX wY. String -> String -> String -> FilePatchType wX wY
TokReplace String
t1 String
o1 String
n1))
commuteFP AnchoredPath
_ (:>) FilePatchType FilePatchType wX wY
_ = Perhaps ((:>) Prim Prim wX wY)
forall a. Perhaps a
Unknown

commuteHunkLines :: Int -> Int -> Int -> Int -> Int -> Int
                 -> Maybe (Int, Int)
commuteHunkLines :: Int -> Int -> Int -> Int -> Int -> Int -> Maybe (Int, Int)
commuteHunkLines Int
line1 Int
len_old1 Int
len_new1 Int
line2 Int
len_old2 Int
len_new2
  | Int
line1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_new1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
line2  = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
line2 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
line1)
  | Int
line2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_old2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
line1  = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
line2, Int
line1 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
line1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_new1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2 = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
line2 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
line1)
  | 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
line2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len_old2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line1 = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
line2, Int
line1 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 (Int, Int)
forall a. Maybe a
Nothing

tryTokReplaces :: String -> B.ByteString -> B.ByteString
               -> [B.ByteString] -> Maybe [B.ByteString]
tryTokReplaces :: String
-> ByteString -> ByteString -> [ByteString] -> Maybe [ByteString]
tryTokReplaces String
t ByteString
o ByteString
n = (ByteString -> Maybe ByteString)
-> [ByteString] -> Maybe [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String
-> ByteString -> ByteString -> ByteString -> Maybe ByteString
tryTokReplace String
t ByteString
o ByteString
n)

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