{-# LANGUAGE
FlexibleContexts,
StandaloneDeriving,
TypeFamilies,
UndecidableInstances #-}
module DiffLoc.Interval
( Interval(..)
, isZeroLength
, Replace(..)
) where
import Prelude hiding ((+))
import DiffLoc.Shift
import DiffLoc.Unsafe ((.-.))
infixl 6 +
(+) :: Semigroup a => a -> a -> a
+ :: forall a. Semigroup a => a -> a -> a
(+) = forall a. Semigroup a => a -> a -> a
(<>)
data Interval p = !p :.. !(Trans p)
infixl 3 :..
isZeroLength :: (Eq (Trans p), Monoid (Trans p)) => Interval p -> Bool
isZeroLength :: forall p. (Eq (Trans p), Monoid (Trans p)) => Interval p -> Bool
isZeroLength (p
_ :.. Trans p
n) = Trans p
n forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty
deriving instance (Eq p, Eq (Trans p)) => Eq (Interval p)
deriving instance (Show p, Show (Trans p)) => Show (Interval p)
instance Amor p => BlockOrder (Interval p) where
precedes :: Interval p -> Interval p -> Bool
precedes (p
i :.. Trans p
n) (p
j :.. Trans p
_) = p
i forall p. Amor p => p -> Trans p -> p
.+ Trans p
n forall a. Ord a => a -> a -> Bool
<= p
j
distantlyPrecedes :: Interval p -> Interval p -> Bool
distantlyPrecedes (p
i :.. Trans p
n) (p
j :.. Trans p
_) = p
i forall p. Amor p => p -> Trans p -> p
.+ Trans p
n forall a. Ord a => a -> a -> Bool
< p
j
data Replace p = Replace !p !(Trans p) !(Trans p)
deriving instance (Eq p, Eq (Trans p)) => Eq (Replace p)
deriving instance (Show p, Show (Trans p)) => Show (Replace p)
instance Amor p => Semigroup (Replace p) where
Replace p
li Trans p
ln Trans p
lm <> :: Replace p -> Replace p -> Replace p
<> Replace p
ri Trans p
rn Trans p
rm
| p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
ln forall a. Ord a => a -> a -> Bool
<= p
ri
= forall p. p -> Trans p -> Trans p -> Replace p
Replace p
li ((p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rn) forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. p
li) (Trans p
lm forall a. Semigroup a => a -> a -> a
+ (p
ri forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. (p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
ln)) forall a. Semigroup a => a -> a -> a
+ Trans p
rm)
| p
li forall a. Ord a => a -> a -> Bool
<= p
ri
= let (Trans p
n, Trans p
m) = if p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
ln forall a. Ord a => a -> a -> Bool
< p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rm
then ((p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rn) forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. p
li, Trans p
lm forall a. Semigroup a => a -> a -> a
+ ((p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rm) forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. (p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
ln)))
else ((p
ri forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. p
li) forall a. Semigroup a => a -> a -> a
+ Trans p
rn forall a. Semigroup a => a -> a -> a
+ ((p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
ln) forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. (p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rm)), Trans p
lm)
in forall p. p -> Trans p -> Trans p -> Replace p
Replace p
li Trans p
n Trans p
m
| p
li forall a. Ord a => a -> a -> Bool
< p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rm
= let (Trans p
n, Trans p
m) = if p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rm forall a. Ord a => a -> a -> Bool
< p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
ln
then (Trans p
rn forall a. Semigroup a => a -> a -> a
+ ((p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
ln) forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. (p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rm)), (p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
lm) forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. p
ri)
else (Trans p
rn, (p
li forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. p
ri) forall a. Semigroup a => a -> a -> a
+ Trans p
lm forall a. Semigroup a => a -> a -> a
+ ((p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rm) forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. (p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
ln)))
in forall p. p -> Trans p -> Trans p -> Replace p
Replace p
ri Trans p
n Trans p
m
| Bool
otherwise
= forall p. p -> Trans p -> Trans p -> Replace p
Replace p
ri (Trans p
rn forall a. Semigroup a => a -> a -> a
+ (p
li forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. (p
ri forall p. Amor p => p -> Trans p -> p
.+ Trans p
rm)) forall a. Semigroup a => a -> a -> a
+ Trans p
ln) ((p
li forall p. Amor p => p -> Trans p -> p
.+ Trans p
lm) forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. p
ri)
instance Amor p => Shift (Replace p) where
type Block (Replace p) = Interval p
dual :: Replace p -> Replace p
dual (Replace p
i Trans p
n Trans p
m) = forall p. p -> Trans p -> Trans p -> Replace p
Replace p
i Trans p
m Trans p
n
src :: Replace p -> Block (Replace p)
src (Replace p
i Trans p
n Trans p
_) = p
i forall p. p -> Trans p -> Interval p
:.. Trans p
n
shiftBlock :: Replace p -> Block (Replace p) -> Maybe (Block (Replace p))
shiftBlock (Replace p
i Trans p
n Trans p
m) jp :: Block (Replace p)
jp@(p
j :.. Trans p
p)
| p
j forall p. Amor p => p -> Trans p -> p
.+ Trans p
p forall a. Ord a => a -> a -> Bool
<= p
i = forall a. a -> Maybe a
Just Block (Replace p)
jp
| p
i forall p. Amor p => p -> Trans p -> p
.+ Trans p
n forall a. Ord a => a -> a -> Bool
<= p
j = forall a. a -> Maybe a
Just (p
i forall p. Amor p => p -> Trans p -> p
.+ (Trans p
m forall a. Semigroup a => a -> a -> a
+ (p
j forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. (p
i forall p. Amor p => p -> Trans p -> p
.+ Trans p
n))) forall p. p -> Trans p -> Interval p
:.. Trans p
p)
| Bool
otherwise = forall a. Maybe a
Nothing
shiftR :: Replace p -> Replace p -> Maybe (Replace p)
shiftR (Replace p
i Trans p
n Trans p
m) jpq :: Replace p
jpq@(Replace p
j Trans p
p Trans p
q)
| p
j forall p. Amor p => p -> Trans p -> p
.+ Trans p
p forall a. Ord a => a -> a -> Bool
<= p
i = forall a. a -> Maybe a
Just Replace p
jpq
| p
i forall p. Amor p => p -> Trans p -> p
.+ Trans p
n forall a. Ord a => a -> a -> Bool
<= p
j = forall a. a -> Maybe a
Just (forall p. p -> Trans p -> Trans p -> Replace p
Replace (p
i forall p. Amor p => p -> Trans p -> p
.+ (Trans p
m forall a. Semigroup a => a -> a -> a
+ (p
j forall p. (HasCallStack, Amor p) => p -> p -> Trans p
.-. (p
i forall p. Amor p => p -> Trans p -> p
.+ Trans p
n)))) Trans p
p Trans p
q)
| Bool
otherwise = forall a. Maybe a
Nothing