-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
module Development.IDE.Core.PositionMapping
  ( PositionMapping(..)
  , PositionResult(..)
  , lowerRange
  , upperRange
  , positionResultToMaybe
  , fromCurrentPosition
  , toCurrentPosition
  , PositionDelta(..)
  , addOldDelta
  , idDelta
  , composeDelta
  , mkDelta
  , toCurrentRange
  , fromCurrentRange
  , applyChange
  , zeroMapping
  , deltaFromDiff
  -- toCurrent and fromCurrent are mainly exposed for testing
  , toCurrent
  , fromCurrent
  ) where

import           Control.DeepSeq
import           Control.Lens                ((^.))
import           Control.Monad
import           Data.Algorithm.Diff
import           Data.Bifunctor
import           Data.List
import qualified Data.Text                   as T
import qualified Data.Vector.Unboxed         as V
import qualified Language.LSP.Protocol.Lens  as L
import           Language.LSP.Protocol.Types (Position (Position),
                                              Range (Range),
                                              TextDocumentContentChangeEvent (TextDocumentContentChangeEvent),
                                              UInt, type (|?) (InL))

-- | Either an exact position, or the range of text that was substituted
data PositionResult a
  = PositionRange -- ^ Fields need to be non-strict otherwise bind is exponential
  { forall a. PositionResult a -> a
unsafeLowerRange :: a
  , forall a. PositionResult a -> a
unsafeUpperRange :: a }
  | PositionExact !a
  deriving (PositionResult a -> PositionResult a -> Bool
(PositionResult a -> PositionResult a -> Bool)
-> (PositionResult a -> PositionResult a -> Bool)
-> Eq (PositionResult a)
forall a. Eq a => PositionResult a -> PositionResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PositionResult a -> PositionResult a -> Bool
== :: PositionResult a -> PositionResult a -> Bool
$c/= :: forall a. Eq a => PositionResult a -> PositionResult a -> Bool
/= :: PositionResult a -> PositionResult a -> Bool
Eq,Eq (PositionResult a)
Eq (PositionResult a) =>
(PositionResult a -> PositionResult a -> Ordering)
-> (PositionResult a -> PositionResult a -> Bool)
-> (PositionResult a -> PositionResult a -> Bool)
-> (PositionResult a -> PositionResult a -> Bool)
-> (PositionResult a -> PositionResult a -> Bool)
-> (PositionResult a -> PositionResult a -> PositionResult a)
-> (PositionResult a -> PositionResult a -> PositionResult a)
-> Ord (PositionResult a)
PositionResult a -> PositionResult a -> Bool
PositionResult a -> PositionResult a -> Ordering
PositionResult a -> PositionResult a -> PositionResult a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (PositionResult a)
forall a. Ord a => PositionResult a -> PositionResult a -> Bool
forall a. Ord a => PositionResult a -> PositionResult a -> Ordering
forall a.
Ord a =>
PositionResult a -> PositionResult a -> PositionResult a
$ccompare :: forall a. Ord a => PositionResult a -> PositionResult a -> Ordering
compare :: PositionResult a -> PositionResult a -> Ordering
$c< :: forall a. Ord a => PositionResult a -> PositionResult a -> Bool
< :: PositionResult a -> PositionResult a -> Bool
$c<= :: forall a. Ord a => PositionResult a -> PositionResult a -> Bool
<= :: PositionResult a -> PositionResult a -> Bool
$c> :: forall a. Ord a => PositionResult a -> PositionResult a -> Bool
> :: PositionResult a -> PositionResult a -> Bool
$c>= :: forall a. Ord a => PositionResult a -> PositionResult a -> Bool
>= :: PositionResult a -> PositionResult a -> Bool
$cmax :: forall a.
Ord a =>
PositionResult a -> PositionResult a -> PositionResult a
max :: PositionResult a -> PositionResult a -> PositionResult a
$cmin :: forall a.
Ord a =>
PositionResult a -> PositionResult a -> PositionResult a
min :: PositionResult a -> PositionResult a -> PositionResult a
Ord,Int -> PositionResult a -> ShowS
[PositionResult a] -> ShowS
PositionResult a -> String
(Int -> PositionResult a -> ShowS)
-> (PositionResult a -> String)
-> ([PositionResult a] -> ShowS)
-> Show (PositionResult a)
forall a. Show a => Int -> PositionResult a -> ShowS
forall a. Show a => [PositionResult a] -> ShowS
forall a. Show a => PositionResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PositionResult a -> ShowS
showsPrec :: Int -> PositionResult a -> ShowS
$cshow :: forall a. Show a => PositionResult a -> String
show :: PositionResult a -> String
$cshowList :: forall a. Show a => [PositionResult a] -> ShowS
showList :: [PositionResult a] -> ShowS
Show,(forall a b. (a -> b) -> PositionResult a -> PositionResult b)
-> (forall a b. a -> PositionResult b -> PositionResult a)
-> Functor PositionResult
forall a b. a -> PositionResult b -> PositionResult a
forall a b. (a -> b) -> PositionResult a -> PositionResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PositionResult a -> PositionResult b
fmap :: forall a b. (a -> b) -> PositionResult a -> PositionResult b
$c<$ :: forall a b. a -> PositionResult b -> PositionResult a
<$ :: forall a b. a -> PositionResult b -> PositionResult a
Functor)

lowerRange :: PositionResult a -> a
lowerRange :: forall a. PositionResult a -> a
lowerRange (PositionExact a
a)       = a
a
lowerRange (PositionRange a
lower a
_) = a
lower

upperRange :: PositionResult a -> a
upperRange :: forall a. PositionResult a -> a
upperRange (PositionExact a
a)       = a
a
upperRange (PositionRange a
_ a
upper) = a
upper

positionResultToMaybe :: PositionResult a -> Maybe a
positionResultToMaybe :: forall a. PositionResult a -> Maybe a
positionResultToMaybe (PositionExact a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
positionResultToMaybe PositionResult a
_                 = Maybe a
forall a. Maybe a
Nothing

instance Applicative PositionResult where
  pure :: forall a. a -> PositionResult a
pure = a -> PositionResult a
forall a. a -> PositionResult a
PositionExact
  (PositionExact a -> b
f) <*> :: forall a b.
PositionResult (a -> b) -> PositionResult a -> PositionResult b
<*> PositionResult a
a = (a -> b) -> PositionResult a -> PositionResult b
forall a b. (a -> b) -> PositionResult a -> PositionResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f PositionResult a
a
  (PositionRange a -> b
f a -> b
g) <*> (PositionExact a
a) = b -> b -> PositionResult b
forall a. a -> a -> PositionResult a
PositionRange (a -> b
f a
a) (a -> b
g a
a)
  (PositionRange a -> b
f a -> b
g) <*> (PositionRange a
lower a
upper) = b -> b -> PositionResult b
forall a. a -> a -> PositionResult a
PositionRange (a -> b
f a
lower) (a -> b
g a
upper)

instance Monad PositionResult where
  (PositionExact a
a) >>= :: forall a b.
PositionResult a -> (a -> PositionResult b) -> PositionResult b
>>= a -> PositionResult b
f = a -> PositionResult b
f a
a
  (PositionRange a
lower a
upper) >>= a -> PositionResult b
f = b -> b -> PositionResult b
forall a. a -> a -> PositionResult a
PositionRange b
lower' b
upper'
    where
      lower' :: b
lower' = PositionResult b -> b
forall a. PositionResult a -> a
lowerRange (PositionResult b -> b) -> PositionResult b -> b
forall a b. (a -> b) -> a -> b
$ a -> PositionResult b
f a
lower
      upper' :: b
upper' = PositionResult b -> b
forall a. PositionResult a -> a
upperRange (PositionResult b -> b) -> PositionResult b -> b
forall a b. (a -> b) -> a -> b
$ a -> PositionResult b
f a
upper

-- The position delta is the difference between two versions
data PositionDelta = PositionDelta
  { PositionDelta -> Position -> PositionResult Position
toDelta   :: !(Position -> PositionResult Position)
  , PositionDelta -> Position -> PositionResult Position
fromDelta :: !(Position -> PositionResult Position)
  }

instance Show PositionDelta where
  show :: PositionDelta -> String
show PositionDelta{} = String
"PositionDelta{..}"

instance NFData PositionDelta where
  rnf :: PositionDelta -> ()
rnf (PositionDelta Position -> PositionResult Position
a Position -> PositionResult Position
b) = Position -> PositionResult Position
a (Position -> PositionResult Position) -> () -> ()
forall a b. a -> b -> b
`seq` Position -> PositionResult Position
b (Position -> PositionResult Position) -> () -> ()
forall a b. a -> b -> b
`seq` ()

fromCurrentPosition :: PositionMapping -> Position -> Maybe Position
fromCurrentPosition :: PositionMapping -> Position -> Maybe Position
fromCurrentPosition (PositionMapping PositionDelta
pm) = PositionResult Position -> Maybe Position
forall a. PositionResult a -> Maybe a
positionResultToMaybe (PositionResult Position -> Maybe Position)
-> (Position -> PositionResult Position)
-> Position
-> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionDelta -> Position -> PositionResult Position
fromDelta PositionDelta
pm

toCurrentPosition :: PositionMapping -> Position -> Maybe Position
toCurrentPosition :: PositionMapping -> Position -> Maybe Position
toCurrentPosition (PositionMapping PositionDelta
pm) = PositionResult Position -> Maybe Position
forall a. PositionResult a -> Maybe a
positionResultToMaybe (PositionResult Position -> Maybe Position)
-> (Position -> PositionResult Position)
-> Position
-> Maybe Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionDelta -> Position -> PositionResult Position
toDelta PositionDelta
pm

-- A position mapping is the difference from the current version to
-- a specific version
newtype PositionMapping = PositionMapping PositionDelta

toCurrentRange :: PositionMapping -> Range -> Maybe Range
toCurrentRange :: PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
mapping (Range Position
a Position
b) =
    Position -> Position -> Range
Range (Position -> Position -> Range)
-> Maybe Position -> Maybe (Position -> Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping -> Position -> Maybe Position
toCurrentPosition PositionMapping
mapping Position
a Maybe (Position -> Range) -> Maybe Position -> Maybe Range
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PositionMapping -> Position -> Maybe Position
toCurrentPosition PositionMapping
mapping Position
b

fromCurrentRange :: PositionMapping -> Range -> Maybe Range
fromCurrentRange :: PositionMapping -> Range -> Maybe Range
fromCurrentRange PositionMapping
mapping (Range Position
a Position
b) =
    Position -> Position -> Range
Range (Position -> Position -> Range)
-> Maybe Position -> Maybe (Position -> Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
a Maybe (Position -> Range) -> Maybe Position -> Maybe Range
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
b

zeroMapping :: PositionMapping
zeroMapping :: PositionMapping
zeroMapping = PositionDelta -> PositionMapping
PositionMapping PositionDelta
idDelta

-- | Compose two position mappings. Composes in the same way as function
-- composition (ie the second argument is applied to the position first).
composeDelta :: PositionDelta
                -> PositionDelta
                -> PositionDelta
composeDelta :: PositionDelta -> PositionDelta -> PositionDelta
composeDelta (PositionDelta Position -> PositionResult Position
to1 Position -> PositionResult Position
from1) (PositionDelta Position -> PositionResult Position
to2 Position -> PositionResult Position
from2) =
  (Position -> PositionResult Position)
-> (Position -> PositionResult Position) -> PositionDelta
PositionDelta (Position -> PositionResult Position
to1 (Position -> PositionResult Position)
-> (Position -> PositionResult Position)
-> Position
-> PositionResult Position
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Position -> PositionResult Position
to2)
                (Position -> PositionResult Position
from1 (Position -> PositionResult Position)
-> (Position -> PositionResult Position)
-> Position
-> PositionResult Position
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Position -> PositionResult Position
from2)

idDelta :: PositionDelta
idDelta :: PositionDelta
idDelta = (Position -> PositionResult Position)
-> (Position -> PositionResult Position) -> PositionDelta
PositionDelta Position -> PositionResult Position
forall a. a -> PositionResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Position -> PositionResult Position
forall a. a -> PositionResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Convert a set of changes into a delta from k  to k + 1
mkDelta :: [TextDocumentContentChangeEvent] -> PositionDelta
mkDelta :: [TextDocumentContentChangeEvent] -> PositionDelta
mkDelta [TextDocumentContentChangeEvent]
cs = (PositionDelta -> TextDocumentContentChangeEvent -> PositionDelta)
-> PositionDelta
-> [TextDocumentContentChangeEvent]
-> PositionDelta
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' PositionDelta -> TextDocumentContentChangeEvent -> PositionDelta
applyChange PositionDelta
idDelta [TextDocumentContentChangeEvent]
cs

-- | addOldDelta
-- Add a old delta onto a Mapping k n to make a Mapping (k - 1) n
addOldDelta ::
    PositionDelta -- ^ delta from version k - 1 to version k
    -> PositionMapping -- ^ The input mapping is from version k to version n
    -> PositionMapping -- ^ The output mapping is from version k - 1 to version n
addOldDelta :: PositionDelta -> PositionMapping -> PositionMapping
addOldDelta PositionDelta
delta (PositionMapping PositionDelta
pm) = PositionDelta -> PositionMapping
PositionMapping (PositionDelta -> PositionDelta -> PositionDelta
composeDelta PositionDelta
pm PositionDelta
delta)

-- TODO: We currently ignore the right hand side (if there is only text), as
-- that was what was done with lsp* 1.6 packages
applyChange :: PositionDelta -> TextDocumentContentChangeEvent -> PositionDelta
applyChange :: PositionDelta -> TextDocumentContentChangeEvent -> PositionDelta
applyChange PositionDelta{Position -> PositionResult Position
toDelta :: PositionDelta -> Position -> PositionResult Position
fromDelta :: PositionDelta -> Position -> PositionResult Position
toDelta :: Position -> PositionResult Position
fromDelta :: Position -> PositionResult Position
..} (TextDocumentContentChangeEvent (InL TextDocumentContentChangePartial
x)) = PositionDelta
    { toDelta :: Position -> PositionResult Position
toDelta = Range -> Text -> Position -> PositionResult Position
toCurrent (TextDocumentContentChangePartial
x TextDocumentContentChangePartial
-> Getting Range TextDocumentContentChangePartial Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range TextDocumentContentChangePartial Range
forall s a. HasRange s a => Lens' s a
Lens' TextDocumentContentChangePartial Range
L.range) (TextDocumentContentChangePartial
x TextDocumentContentChangePartial
-> Getting Text TextDocumentContentChangePartial Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextDocumentContentChangePartial Text
forall s a. HasText s a => Lens' s a
Lens' TextDocumentContentChangePartial Text
L.text) (Position -> PositionResult Position)
-> (Position -> PositionResult Position)
-> Position
-> PositionResult Position
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Position -> PositionResult Position
toDelta
    , fromDelta :: Position -> PositionResult Position
fromDelta = Position -> PositionResult Position
fromDelta (Position -> PositionResult Position)
-> (Position -> PositionResult Position)
-> Position
-> PositionResult Position
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Range -> Text -> Position -> PositionResult Position
fromCurrent (TextDocumentContentChangePartial
x TextDocumentContentChangePartial
-> Getting Range TextDocumentContentChangePartial Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range TextDocumentContentChangePartial Range
forall s a. HasRange s a => Lens' s a
Lens' TextDocumentContentChangePartial Range
L.range) (TextDocumentContentChangePartial
x TextDocumentContentChangePartial
-> Getting Text TextDocumentContentChangePartial Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextDocumentContentChangePartial Text
forall s a. HasText s a => Lens' s a
Lens' TextDocumentContentChangePartial Text
L.text)
    }
applyChange PositionDelta
posMapping TextDocumentContentChangeEvent
_ = PositionDelta
posMapping

toCurrent :: Range -> T.Text -> Position -> PositionResult Position
toCurrent :: Range -> Text -> Position -> PositionResult Position
toCurrent (Range start :: Position
start@(Position UInt
startLine UInt
startColumn) end :: Position
end@(Position UInt
endLine UInt
endColumn)) Text
t (Position UInt
line UInt
column)
    | UInt
line UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
< UInt
startLine Bool -> Bool -> Bool
|| UInt
line UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
startLine Bool -> Bool -> Bool
&& UInt
column UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
< UInt
startColumn =
      -- Position is before the change and thereby unchanged.
      Position -> PositionResult Position
forall a. a -> PositionResult a
PositionExact (Position -> PositionResult Position)
-> Position -> PositionResult Position
forall a b. (a -> b) -> a -> b
$ UInt -> UInt -> Position
Position UInt
line UInt
column
    | UInt
line UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
> UInt
endLine Bool -> Bool -> Bool
|| UInt
line UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
endLine Bool -> Bool -> Bool
&& UInt
column UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
>= UInt
endColumn =
      -- Position is after the change so increase line and column number
      -- as necessary.
      Position -> PositionResult Position
forall a. a -> PositionResult a
PositionExact (Position -> PositionResult Position)
-> Position -> PositionResult Position
forall a b. (a -> b) -> a -> b
$ UInt
newLine UInt -> Position -> Position
forall a b. a -> b -> b
`seq` UInt
newColumn UInt -> Position -> Position
forall a b. a -> b -> b
`seq` UInt -> UInt -> Position
Position UInt
newLine UInt
newColumn
    | Bool
otherwise = Position -> Position -> PositionResult Position
forall a. a -> a -> PositionResult a
PositionRange Position
start Position
end
    -- Position is in the region that was changed.
    where
        lineDiff :: Int
lineDiff = Int
linesNew Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
linesOld
        linesNew :: Int
linesNew = HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
"\n" Text
t
        linesOld :: Int
linesOld = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startLine
        newEndColumn :: UInt
        newEndColumn :: UInt
newEndColumn
          | Int
linesNew Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startColumn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t
          | Bool
otherwise = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
t
        newColumn :: UInt
        newColumn :: UInt
newColumn
          | UInt
line UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
endLine = UInt -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> UInt) -> UInt -> UInt
forall a b. (a -> b) -> a -> b
$ (UInt -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
column UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
newEndColumn) UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endColumn
          | Bool
otherwise = UInt
column
        newLine :: UInt
        newLine :: UInt
newLine = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lineDiff

fromCurrent :: Range -> T.Text -> Position -> PositionResult Position
fromCurrent :: Range -> Text -> Position -> PositionResult Position
fromCurrent (Range start :: Position
start@(Position UInt
startLine UInt
startColumn) end :: Position
end@(Position UInt
endLine UInt
endColumn)) Text
t (Position UInt
line UInt
column)
    | UInt
line UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
< UInt
startLine Bool -> Bool -> Bool
|| UInt
line UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
startLine Bool -> Bool -> Bool
&& UInt
column UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
< UInt
startColumn =
      -- Position is before the change and thereby unchanged
      Position -> PositionResult Position
forall a. a -> PositionResult a
PositionExact (Position -> PositionResult Position)
-> Position -> PositionResult Position
forall a b. (a -> b) -> a -> b
$ UInt -> UInt -> Position
Position UInt
line UInt
column
    | UInt
line UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
> UInt
newEndLine Bool -> Bool -> Bool
|| UInt
line UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
newEndLine Bool -> Bool -> Bool
&& UInt
column UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
>= UInt
newEndColumn =
      -- Position is after the change so increase line and column number
      -- as necessary.
      Position -> PositionResult Position
forall a. a -> PositionResult a
PositionExact (Position -> PositionResult Position)
-> Position -> PositionResult Position
forall a b. (a -> b) -> a -> b
$ UInt
newLine UInt -> Position -> Position
forall a b. a -> b -> b
`seq` UInt
newColumn UInt -> Position -> Position
forall a b. a -> b -> b
`seq` UInt -> UInt -> Position
Position UInt
newLine UInt
newColumn
    | Bool
otherwise = Position -> Position -> PositionResult Position
forall a. a -> a -> PositionResult a
PositionRange Position
start Position
end
    -- Position is in the region that was changed.
    where
        lineDiff :: Int
lineDiff = Int
linesNew Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
linesOld
        linesNew :: Int
linesNew = HasCallStack => Text -> Text -> Int
Text -> Text -> Int
T.count Text
"\n" Text
t
        linesOld :: Int
linesOld = UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startLine
        newEndLine :: UInt
        newEndLine :: UInt
newEndLine = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lineDiff
        newEndColumn :: UInt
        newEndColumn :: UInt
newEndColumn
          | Int
linesNew Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startColumn Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t
          | Bool
otherwise = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Text -> Int) -> Text -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
t
        newColumn :: UInt
        newColumn :: UInt
newColumn
          | UInt
line UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
newEndLine = UInt -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> UInt) -> UInt -> UInt
forall a b. (a -> b) -> a -> b
$ (UInt -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
column UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endColumn) UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
newEndColumn
          | Bool
otherwise = UInt
column
        newLine :: UInt
        newLine :: UInt
newLine = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lineDiff

deltaFromDiff :: T.Text -> T.Text -> PositionDelta
deltaFromDiff :: Text -> Text -> PositionDelta
deltaFromDiff (Text -> [Text]
T.lines -> [Text]
old) (Text -> [Text]
T.lines -> [Text]
new) =
    (Position -> PositionResult Position)
-> (Position -> PositionResult Position) -> PositionDelta
PositionDelta (UInt
-> Vector Int
-> Vector Int
-> Vector Int
-> Position
-> PositionResult Position
lookupPos (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lnew) Vector Int
o2nPrevs Vector Int
o2nNexts Vector Int
old2new) (UInt
-> Vector Int
-> Vector Int
-> Vector Int
-> Position
-> PositionResult Position
lookupPos (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lold) Vector Int
n2oPrevs Vector Int
n2oNexts Vector Int
new2old)
  where
    !lnew :: Int
lnew = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
new
    !lold :: Int
lold = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
old

    diff :: [Diff Text]
diff = [Text] -> [Text] -> [Diff Text]
forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff [Text]
old [Text]
new

    ([Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
V.fromList -> !Vector Int
old2new, [Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
V.fromList -> !Vector Int
new2old) = [Diff Text] -> Int -> Int -> ([Int], [Int])
go [Diff Text]
diff Int
0 Int
0

    -- Compute previous and next lines that mapped successfully
    !o2nPrevs :: Vector Int
o2nPrevs = (Int -> Int -> Int) -> Int -> Vector Int -> Vector Int
forall a b.
(Unbox a, Unbox b) =>
(a -> b -> a) -> a -> Vector b -> Vector a
V.prescanl' Int -> Int -> Int
f        (-Int
1) Vector Int
old2new
    !o2nNexts :: Vector Int
o2nNexts = (Int -> Int -> Int) -> Int -> Vector Int -> Vector Int
forall a b.
(Unbox a, Unbox b) =>
(a -> b -> b) -> b -> Vector a -> Vector b
V.prescanr' ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
f) Int
lnew Vector Int
old2new

    !n2oPrevs :: Vector Int
n2oPrevs = (Int -> Int -> Int) -> Int -> Vector Int -> Vector Int
forall a b.
(Unbox a, Unbox b) =>
(a -> b -> a) -> a -> Vector b -> Vector a
V.prescanl' Int -> Int -> Int
f        (-Int
1) Vector Int
new2old
    !n2oNexts :: Vector Int
n2oNexts = (Int -> Int -> Int) -> Int -> Vector Int -> Vector Int
forall a b.
(Unbox a, Unbox b) =>
(a -> b -> b) -> b -> Vector a -> Vector b
V.prescanr' ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
f) Int
lold Vector Int
new2old

    f :: Int -> Int -> Int
    f :: Int -> Int -> Int
f !Int
a !Int
b = if Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 then Int
a else Int
b

    lookupPos :: UInt -> V.Vector Int -> V.Vector Int -> V.Vector Int -> Position -> PositionResult Position
    lookupPos :: UInt
-> Vector Int
-> Vector Int
-> Vector Int
-> Position
-> PositionResult Position
lookupPos UInt
end Vector Int
prevs Vector Int
nexts Vector Int
xs (Position UInt
line UInt
col)
      | UInt
line UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Int -> Int
forall a. Unbox a => Vector a -> Int
V.length Vector Int
xs) = Position -> Position -> PositionResult Position
forall a. a -> a -> PositionResult a
PositionRange (UInt -> UInt -> Position
Position UInt
end UInt
0) (UInt -> UInt -> Position
Position UInt
end UInt
0)
      | Bool
otherwise           = case Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector Int
xs (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line) of
          -1 ->
            -- look for the previous and next lines that mapped successfully
            let !prev :: Int
prev = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector Int
prevs (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line)
                !next :: Int
next = Vector Int -> Int -> Int
forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector Int
nexts (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line)
              in Position -> Position -> PositionResult Position
forall a. a -> a -> PositionResult a
PositionRange (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
prev) UInt
0) (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
next) UInt
0)
          Int
line' -> Position -> PositionResult Position
forall a. a -> PositionResult a
PositionExact (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
line') UInt
col)

    -- Construct a mapping between lines in the diff
    -- -1 for unsuccessful mapping
    go :: [Diff T.Text] -> Int -> Int -> ([Int], [Int])
    go :: [Diff Text] -> Int -> Int -> ([Int], [Int])
go [] Int
_ Int
_ = ([],[])
    go (Both Text
_ Text
_ : [Diff Text]
xs) !Int
glold !Int
glnew = ([Int] -> [Int])
-> ([Int] -> [Int]) -> ([Int], [Int]) -> ([Int], [Int])
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap  (Int
glnew :) (Int
glold :) (([Int], [Int]) -> ([Int], [Int]))
-> ([Int], [Int]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
go [Diff Text]
xs (Int
gloldInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
glnewInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    go (First Text
_  : [Diff Text]
xs) !Int
glold !Int
glnew = ([Int] -> [Int]) -> ([Int], [Int]) -> ([Int], [Int])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first  (-Int
1   :)          (([Int], [Int]) -> ([Int], [Int]))
-> ([Int], [Int]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
go [Diff Text]
xs (Int
gloldInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
glnew
    go (Second Text
_ : [Diff Text]
xs) !Int
glold !Int
glnew = ([Int] -> [Int]) -> ([Int], [Int]) -> ([Int], [Int])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second          (-Int
1   :) (([Int], [Int]) -> ([Int], [Int]))
-> ([Int], [Int]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
go [Diff Text]
xs Int
glold     (Int
glnewInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)