{-# LANGUAGE OverloadedLabels #-}
-- 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(..)
  , addDelta
  , idDelta
  , composeDelta
  , mkDelta
  , toCurrentRange
  , fromCurrentRange
  , applyChange
  , zeroMapping
  , deltaFromDiff
  -- toCurrent and fromCurrent are mainly exposed for testing
  , toCurrent
  , fromCurrent
  ) where

import           Control.DeepSeq
import           Control.Monad
import           Data.Algorithm.Diff
import           Data.Bifunctor
import           Data.List
import           Data.Row
import qualified Data.Text                   as T
import qualified Data.Vector.Unboxed         as V
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
forall a. Eq a => PositionResult a -> PositionResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PositionResult a -> PositionResult a -> Bool
$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
Eq,PositionResult a -> PositionResult a -> Bool
PositionResult a -> PositionResult a -> Ordering
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
min :: PositionResult a -> PositionResult a -> PositionResult a
$cmin :: forall a.
Ord a =>
PositionResult a -> PositionResult a -> PositionResult a
max :: PositionResult a -> PositionResult a -> PositionResult a
$cmax :: forall a.
Ord a =>
PositionResult a -> PositionResult a -> PositionResult a
>= :: 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
$c< :: forall a. Ord a => PositionResult a -> PositionResult a -> Bool
compare :: PositionResult a -> PositionResult a -> Ordering
$ccompare :: forall a. Ord a => PositionResult a -> PositionResult a -> Ordering
Ord,Int -> PositionResult a -> ShowS
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
showList :: [PositionResult a] -> ShowS
$cshowList :: forall a. Show a => [PositionResult a] -> ShowS
show :: PositionResult a -> String
$cshow :: forall a. Show a => PositionResult a -> String
showsPrec :: Int -> PositionResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PositionResult a -> ShowS
Show,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
<$ :: forall a b. a -> PositionResult b -> PositionResult a
$c<$ :: forall a b. a -> PositionResult b -> PositionResult a
fmap :: forall a b. (a -> b) -> PositionResult a -> PositionResult b
$cfmap :: forall a b. (a -> b) -> PositionResult a -> PositionResult b
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) = forall a. a -> Maybe a
Just a
a
positionResultToMaybe PositionResult a
_                 = forall a. Maybe a
Nothing

instance Applicative PositionResult where
  pure :: forall a. a -> PositionResult a
pure = forall a. a -> PositionResult a
PositionExact
  (PositionExact a -> b
f) <*> :: forall a b.
PositionResult (a -> b) -> PositionResult a -> PositionResult b
<*> PositionResult a
a = 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) = 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) = 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 = forall a. a -> a -> PositionResult a
PositionRange b
lower' b
upper'
    where
      lower' :: b
lower' = forall a. PositionResult a -> a
lowerRange forall a b. (a -> b) -> a -> b
$ a -> PositionResult b
f a
lower
      upper' :: b
upper' = forall a. PositionResult a -> a
upperRange 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 seq :: forall a b. a -> b -> b
`seq` Position -> PositionResult Position
b seq :: forall a b. a -> b -> b
`seq` ()

fromCurrentPosition :: PositionMapping -> Position -> Maybe Position
fromCurrentPosition :: PositionMapping -> Position -> Maybe Position
fromCurrentPosition (PositionMapping PositionDelta
pm) = forall a. PositionResult a -> Maybe a
positionResultToMaybe 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) = forall a. PositionResult a -> Maybe a
positionResultToMaybe 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping -> Position -> Maybe Position
toCurrentPosition PositionMapping
mapping Position
a 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
a 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 forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Position -> PositionResult Position
to2)
                (Position -> PositionResult Position
from1 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' PositionDelta -> TextDocumentContentChangeEvent -> PositionDelta
applyChange PositionDelta
idDelta [TextDocumentContentChangeEvent]
cs

-- | Add a new delta onto a Mapping k n to make a Mapping (k - 1) n
addDelta :: PositionDelta -> PositionMapping -> PositionMapping
addDelta :: PositionDelta -> PositionMapping -> PositionMapping
addDelta PositionDelta
delta (PositionMapping PositionDelta
pm) = PositionDelta -> PositionMapping
PositionMapping (PositionDelta -> PositionDelta -> PositionDelta
composeDelta PositionDelta
delta PositionDelta
pm)

-- 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
fromDelta :: Position -> PositionResult Position
toDelta :: Position -> PositionResult Position
fromDelta :: PositionDelta -> Position -> PositionResult Position
toDelta :: PositionDelta -> Position -> PositionResult Position
..} (TextDocumentContentChangeEvent (InL Rec
  (("range" .== Range)
   .+ (("rangeLength" .== Maybe UInt)
       .+ (("text" .== Text) .+ Empty)))
x)) = PositionDelta
    { toDelta :: Position -> PositionResult Position
toDelta = Range -> Text -> Position -> PositionResult Position
toCurrent (Rec
  (("range" .== Range)
   .+ (("rangeLength" .== Maybe UInt)
       .+ (("text" .== Text) .+ Empty)))
x forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! forall a. IsLabel "range" a => a
#range) (Rec
  (("range" .== Range)
   .+ (("rangeLength" .== Maybe UInt)
       .+ (("text" .== Text) .+ Empty)))
x forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! forall a. IsLabel "text" a => a
#text) 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 forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Range -> Text -> Position -> PositionResult Position
fromCurrent (Rec
  (("range" .== Range)
   .+ (("rangeLength" .== Maybe UInt)
       .+ (("text" .== Text) .+ Empty)))
x forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! forall a. IsLabel "range" a => a
#range) (Rec
  (("range" .== Range)
   .+ (("rangeLength" .== Maybe UInt)
       .+ (("text" .== Text) .+ Empty)))
x forall (l :: Symbol) (r :: Row (*)).
KnownSymbol l =>
Rec r -> Label l -> r .! l
.! forall a. IsLabel "text" a => a
#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 forall a. Ord a => a -> a -> Bool
< UInt
startLine Bool -> Bool -> Bool
|| UInt
line forall a. Eq a => a -> a -> Bool
== UInt
startLine Bool -> Bool -> Bool
&& UInt
column forall a. Ord a => a -> a -> Bool
< UInt
startColumn =
      -- Position is before the change and thereby unchanged.
      forall a. a -> PositionResult a
PositionExact forall a b. (a -> b) -> a -> b
$ UInt -> UInt -> Position
Position UInt
line UInt
column
    | UInt
line forall a. Ord a => a -> a -> Bool
> UInt
endLine Bool -> Bool -> Bool
|| UInt
line forall a. Eq a => a -> a -> Bool
== UInt
endLine Bool -> Bool -> Bool
&& UInt
column forall a. Ord a => a -> a -> Bool
>= UInt
endColumn =
      -- Position is after the change so increase line and column number
      -- as necessary.
      forall a. a -> PositionResult a
PositionExact forall a b. (a -> b) -> a -> b
$ UInt
newLine seq :: forall a b. a -> b -> b
`seq` UInt
newColumn seq :: forall a b. a -> b -> b
`seq` UInt -> UInt -> Position
Position UInt
newLine UInt
newColumn
    | Bool
otherwise = 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 forall a. Num a => a -> a -> a
- Int
linesOld
        linesNew :: Int
linesNew = Text -> Text -> Int
T.count Text
"\n" Text
t
        linesOld :: Int
linesOld = forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endLine forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startLine
        newEndColumn :: UInt
        newEndColumn :: UInt
newEndColumn
          | Int
linesNew forall a. Eq a => a -> a -> Bool
== Int
0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startColumn forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t
          | Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
t
        newColumn :: UInt
        newColumn :: UInt
newColumn
          | UInt
line forall a. Eq a => a -> a -> Bool
== UInt
endLine = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
column forall a. Num a => a -> a -> a
+ UInt
newEndColumn) forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endColumn
          | Bool
otherwise = UInt
column
        newLine :: UInt
        newLine :: UInt
newLine = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line 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 forall a. Ord a => a -> a -> Bool
< UInt
startLine Bool -> Bool -> Bool
|| UInt
line forall a. Eq a => a -> a -> Bool
== UInt
startLine Bool -> Bool -> Bool
&& UInt
column forall a. Ord a => a -> a -> Bool
< UInt
startColumn =
      -- Position is before the change and thereby unchanged
      forall a. a -> PositionResult a
PositionExact forall a b. (a -> b) -> a -> b
$ UInt -> UInt -> Position
Position UInt
line UInt
column
    | UInt
line forall a. Ord a => a -> a -> Bool
> UInt
newEndLine Bool -> Bool -> Bool
|| UInt
line forall a. Eq a => a -> a -> Bool
== UInt
newEndLine Bool -> Bool -> Bool
&& UInt
column forall a. Ord a => a -> a -> Bool
>= UInt
newEndColumn =
      -- Position is after the change so increase line and column number
      -- as necessary.
      forall a. a -> PositionResult a
PositionExact forall a b. (a -> b) -> a -> b
$ UInt
newLine seq :: forall a b. a -> b -> b
`seq` UInt
newColumn seq :: forall a b. a -> b -> b
`seq` UInt -> UInt -> Position
Position UInt
newLine UInt
newColumn
    | Bool
otherwise = 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 forall a. Num a => a -> a -> a
- Int
linesOld
        linesNew :: Int
linesNew = Text -> Text -> Int
T.count Text
"\n" Text
t
        linesOld :: Int
linesOld = forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endLine forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startLine
        newEndLine :: UInt
        newEndLine :: UInt
newEndLine = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endLine forall a. Num a => a -> a -> a
+ Int
lineDiff
        newEndColumn :: UInt
        newEndColumn :: UInt
newEndColumn
          | Int
linesNew forall a. Eq a => a -> a -> Bool
== Int
0 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startColumn forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
t
          | Bool
otherwise = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.takeWhileEnd (forall a. Eq a => a -> a -> Bool
/= Char
'\n') Text
t
        newColumn :: UInt
        newColumn :: UInt
newColumn
          | UInt
line forall a. Eq a => a -> a -> Bool
== UInt
newEndLine = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
column forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
endColumn) forall a. Num a => a -> a -> a
- UInt
newEndColumn
          | Bool
otherwise = UInt
column
        newLine :: UInt
        newLine :: UInt
newLine = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line 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 (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 (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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
new
    !lold :: Int
lold = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
old

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

    (forall a. Unbox a => [a] -> Vector a
V.fromList -> !Vector Int
old2new, 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 = 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 = forall a b.
(Unbox a, Unbox b) =>
(a -> b -> b) -> b -> Vector a -> Vector b
V.prescanr' (forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
f) Int
lnew Vector Int
old2new

    !n2oPrevs :: Vector Int
n2oPrevs = 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 = forall a b.
(Unbox a, Unbox b) =>
(a -> b -> b) -> b -> Vector a -> Vector b
V.prescanr' (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 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 forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Unbox a => Vector a -> Int
V.length Vector Int
xs) = 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 forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector Int
xs (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 forall a. Num a => a -> a -> a
+ forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector Int
prevs (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line)
                !next :: Int
next = forall a. Unbox a => Vector a -> Int -> a
V.unsafeIndex Vector Int
nexts (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
line)
              in forall a. a -> a -> PositionResult a
PositionRange (UInt -> UInt -> Position
Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
prev) UInt
0) (UInt -> UInt -> Position
Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
next) UInt
0)
          Int
line' -> forall a. a -> PositionResult a
PositionExact (UInt -> UInt -> Position
Position (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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap  (Int
glnew forall a. a -> [a] -> [a]
:) (Int
glold forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
go [Diff Text]
xs (Int
gloldforall a. Num a => a -> a -> a
+Int
1) (Int
glnewforall a. Num a => a -> a -> a
+Int
1)
    go (First Text
_  : [Diff Text]
xs) !Int
glold !Int
glnew = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first  (-Int
1   forall a. a -> [a] -> [a]
:)          forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
go [Diff Text]
xs (Int
gloldforall a. Num a => a -> a -> a
+Int
1) Int
glnew
    go (Second Text
_ : [Diff Text]
xs) !Int
glold !Int
glnew = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second          (-Int
1   forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
go [Diff Text]
xs Int
glold     (Int
glnewforall a. Num a => a -> a -> a
+Int
1)