{-# LANGUAGE
  FlexibleContexts,
  StandaloneDeriving,
  TypeFamilies,
  UndecidableInstances #-}

-- | 'Interval' implements 'Shift'.
module DiffLoc.Interval
  ( Interval(..)
  , isZeroLength
  , Replace(..)
  ) where

import Prelude hiding ((+))
import DiffLoc.Shift
import DiffLoc.Unsafe ((.-.))

-- $setup
-- >>> import DiffLoc
-- >>> import DiffLoc.Test
-- >>> import Test.QuickCheck

-- Nicer looking formulas this way.

infixl 6 +
(+) :: Semigroup a => a -> a -> a
+ :: forall a. Semigroup a => a -> a -> a
(+) = forall a. Semigroup a => a -> a -> a
(<>)

-- | @(i ':..' n)@ represents a span of text between index @i@ and index @i+n@.
--
-- The type of indices @p@ is expected to be an instance of 'Amor'.
--
-- The length @n@ in an interval @(i :.. n)@ may be zero.
--
-- The elements of the interval can be thought of as indexing the interstices
-- /between/ characters. A span of length zero is a single interstice between
-- two characters, where some chunk of text may be inserted.
--
-- Example: drawing of @1 :.. 2@ in "abcde".
--
-- >  a b c d e
-- > 0 1 2 3 4 5
-- >   ^b+c+ length = 2
-- >   ^
-- >   ^ start = 1
data Interval p = !p :.. !(Trans p)

infixl 3 :..

-- | Does the interval have length zero?
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

-- | A minimalistic representation of text replacements.
--
-- A replacement @'Replace' i n m@ is given by a start location @i@, the length
-- @n@ of the interval to replace (source) and the length @m@ of its
-- replacement (target).
-- This representation does not keep track of the actual data being inserted.
--
-- This may overapproximate the underlying text replacement,
-- with intervals being wider than necessary.
-- For example, the transformation from "abc" to "ac" could be represented
-- by @mkReplace 1 1 0@ (replace "b" with "" at location 1), and also by
-- @mkReplace 0 2 1@ (replace "ab" with "a" at location 0).
--
-- > source   abc   abc
-- >      -    b    ab
-- >      +         a
-- > target   a c   a c
--
-- Insertions are replacements with source intervals of length zero.
-- Deletions are replacements with target intervals of length zero.
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)

-- | The composition of two replacements @l <> r@ represents the replacement @r@
-- followed by @l@, as one replacement of an span that contains both @r@ and @l@.
--
-- The right-to-left order of composition has the nice property that when
-- @l `'precedes` r@, @l <> r@ can also be viewed intuitively as performing @l@ and
-- @r@ simultaneously.
--
-- === Properties
--
-- prop> (x <> y) <> z === x <> (y <> z :: Replace (Plain Int))
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
      -- Disjoint, l on the left.
      --
      -- Before:
      -- > |---l---|       |---r---|
      -- > li      li+ln   ri      ri+rn
      --
      -- After both replacements (r first),
      -- with ld = lm-ln
      --
      -- > |---l---|       |---r---|
      -- > li      li+lm   ri+ld   ri+rm+ld
      --
    = 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
      -- l straddles the left end of r
      --
      -- Note that the indices in l should be interpreted
      -- as indices after r.
      -- After replacing r, the replaced span r and the to-be-replaced
      -- span l look like this:
      --
      -- >       |------r----|
      -- > |----l-----|
      -- > li    ri   li+ln  ri+rm
      --
      -- or this:
      --
      -- >      |--r--|
      -- > |-------l----------|
      -- > li   ri    ri+rm   li+ln
      --
    = 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
      -- r straddles the left end of l
      --
      -- > |----r-----|
      -- >       |------l----|
      -- > ri    li   ri+rm  li+ln
      --
      -- or
      --
      -- > |-------r----------|
      -- >      |--l--|
      -- > ri   li    li+ln   ri+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
      --
      -- > |---r---|       |---l---|
      -- > ri      rm      li      ln
      --
    = 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