{-# OPTIONS_GHC -fno-warn-orphans #-}
module Darcs.Patch.Prim.V1 ( Prim ) where
import Darcs.Prelude
import Data.Maybe ( fromMaybe )
import Darcs.Patch.Prim.V1.Apply ()
import Darcs.Patch.Prim.V1.Coalesce ()
import Darcs.Patch.Prim.V1.Commute ()
import Darcs.Patch.Prim.V1.Core ( Prim )
import Darcs.Patch.Prim.V1.Details ()
import Darcs.Patch.Prim.V1.Mangle ()
import Darcs.Patch.Prim.V1.Read ()
import Darcs.Patch.Prim.V1.Show ()
import Darcs.Patch.Commute ( Commute(..), commuteFL )
import Darcs.Patch.Invert ( Invert(..), dropInverses )
import Darcs.Patch.Prim.Class
( PrimSift(..)
, PrimClassify
( primIsHunk
, primIsBinary
, primIsSetpref
, primIsAddfile
, primIsAdddir
)
, PrimCanonize(tryToShrink)
)
import Darcs.Patch.Witnesses.Eq ( Eq2(..), EqCheck(..) )
import Darcs.Patch.Witnesses.Ordered
( FL(..)
, RL(..)
, (:>)(..)
, allFL
, lengthFL
, reverseFL
, filterOutFLFL
)
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
instance PrimSift Prim where
siftForPending :: forall wX wY. FL Prim wX wY -> Sealed (FL Prim wX)
siftForPending = forall (prim :: * -> * -> *) wX wY.
(Commute prim, Invert prim, Eq2 prim, PrimCanonize prim,
PrimClassify prim) =>
FL prim wX wY -> Sealed (FL prim wX)
v1siftForPending where
crudeSift :: forall prim wX wY. PrimClassify prim
=> FL prim wX wY -> FL prim wX wY
crudeSift :: forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
FL prim wX wY -> FL prim wX wY
crudeSift FL prim wX wY
xs =
if forall {wW} {wZ}. FL prim wW wZ -> Bool
isSimple FL prim wX wY
xs
then forall (p :: * -> * -> *) wW wZ.
(forall wX wY. p wX wY -> EqCheck wX wY)
-> FL p wW wZ -> FL p wW wZ
filterOutFLFL forall wA wB. prim wA wB -> EqCheck wA wB
ishunkbinary FL prim wX wY
xs
else FL prim wX wY
xs
where
ishunkbinary :: prim wA wB -> EqCheck wA wB
ishunkbinary :: forall wA wB. prim wA wB -> EqCheck wA wB
ishunkbinary prim wA wB
x
| forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk prim wA wB
x Bool -> Bool -> Bool
|| forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsBinary prim wA wB
x = forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP forall wA. EqCheck wA wA
IsEq
| Bool
otherwise = forall wA wB. EqCheck wA wB
NotEq
isSimple :: FL prim wW wZ -> Bool
isSimple = forall (a :: * -> * -> *) wW wZ.
(forall wX wY. a wX wY -> Bool) -> FL a wW wZ -> Bool
allFL forall a b. (a -> b) -> a -> b
$ \prim wX wY
x -> forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk prim wX wY
x Bool -> Bool -> Bool
|| forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsBinary prim wX wY
x Bool -> Bool -> Bool
|| forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsSetpref prim wX wY
x
v1siftForPending
:: forall prim wX wY.
(Commute prim, Invert prim, Eq2 prim, PrimCanonize prim, PrimClassify prim)
=> FL prim wX wY
-> Sealed (FL prim wX)
v1siftForPending :: forall (prim :: * -> * -> *) wX wY.
(Commute prim, Invert prim, Eq2 prim, PrimCanonize prim,
PrimClassify prim) =>
FL prim wX wY -> Sealed (FL prim wX)
v1siftForPending FL prim wX wY
simple_ps
| forall (a :: * -> * -> *) wW wZ.
(forall wX wY. a wX wY -> Bool) -> FL a wW wZ -> Bool
allFL (\prim wX wY
p -> forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsAddfile prim wX wY
p Bool -> Bool -> Bool
|| forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsAdddir prim wX wY
p) FL prim wX wY
oldps = forall (a :: * -> *) wX. a wX -> Sealed a
seal FL prim wX wY
oldps
| Bool
otherwise =
case forall wA wB wC.
RL prim wA wB -> FL prim wB wC -> Sealed (FL prim wA)
sift (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> RL a wX wZ
reverseFL FL prim wX wY
oldps) forall (a :: * -> * -> *) wX. FL a wX wX
NilFL of
Sealed FL prim wX wX
x ->
let ps :: FL prim wX wX
ps = forall (prim :: * -> * -> *) wX wY.
PrimCanonize prim =>
FL prim wX wY -> FL prim wX wY
tryToShrink FL prim wX wX
x in
if (forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL prim wX wX
ps forall a. Ord a => a -> a -> Bool
< forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Int
lengthFL FL prim wX wY
oldps)
then forall (prim :: * -> * -> *) wX wY.
(Commute prim, Invert prim, Eq2 prim, PrimCanonize prim,
PrimClassify prim) =>
FL prim wX wY -> Sealed (FL prim wX)
v1siftForPending FL prim wX wX
ps
else forall (a :: * -> *) wX. a wX -> Sealed a
seal FL prim wX wX
ps
where
oldps :: FL prim wX wY
oldps = forall a. a -> Maybe a -> a
fromMaybe FL prim wX wY
simple_ps forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
(Invert p, Eq2 p) =>
FL p wX wY -> Maybe (FL p wX wY)
dropInverses forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
FL prim wX wY -> FL prim wX wY
crudeSift FL prim wX wY
simple_ps
sift :: RL prim wA wB -> FL prim wB wC -> Sealed (FL prim wA)
sift :: forall wA wB wC.
RL prim wA wB -> FL prim wB wC -> Sealed (FL prim wA)
sift RL prim wA wB
NilRL FL prim wB wC
sofar = forall (a :: * -> *) wX. a wX -> Sealed a
seal FL prim wB wC
sofar
sift (RL prim wA wY
ps :<: prim wY wB
p) FL prim wB wC
sofar
| forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsHunk prim wY wB
p Bool -> Bool -> Bool
|| forall (prim :: * -> * -> *) wX wY.
PrimClassify prim =>
prim wX wY -> Bool
primIsBinary prim wY wB
p
, Just (FL prim wY wZ
sofar' :> prim wZ wC
_) <- forall (p :: * -> * -> *) wX wY.
Commute p =>
(:>) p (FL p) wX wY -> Maybe ((:>) (FL p) p wX wY)
commuteFL (prim wY wB
p forall (a1 :: * -> * -> *) (a2 :: * -> * -> *) wX wY wZ.
a1 wX wZ -> a2 wZ wY -> (:>) a1 a2 wX wY
:> FL prim wB wC
sofar) = forall wA wB wC.
RL prim wA wB -> FL prim wB wC -> Sealed (FL prim wA)
sift RL prim wA wY
ps FL prim wY wZ
sofar'
| Bool
otherwise = forall wA wB wC.
RL prim wA wB -> FL prim wB wC -> Sealed (FL prim wA)
sift RL prim wA wY
ps (prim wY wB
p forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: FL prim wB wC
sofar)