module Development.IDE.Core.PositionMapping
( PositionMapping(..)
, PositionResult(..)
, lowerRange
, upperRange
, positionResultToMaybe
, fromCurrentPosition
, toCurrentPosition
, PositionDelta(..)
, addOldDelta
, idDelta
, composeDelta
, mkDelta
, toCurrentRange
, fromCurrentRange
, applyChange
, zeroMapping
, deltaFromDiff
, 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))
data PositionResult a
= PositionRange
{ 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
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
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
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
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 ::
PositionDelta
-> PositionMapping
-> PositionMapping
addOldDelta :: PositionDelta -> PositionMapping -> PositionMapping
addOldDelta PositionDelta
delta (PositionMapping PositionDelta
pm) = PositionDelta -> PositionMapping
PositionMapping (PositionDelta -> PositionDelta -> PositionDelta
composeDelta PositionDelta
pm PositionDelta
delta)
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 -> 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 -> 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
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 -> 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 -> 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
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
!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 ->
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)
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)