module Futhark.LSP.PositionMapping
( mappingFromDiff,
PositionMapping,
toStalePos,
toCurrentLoc,
StaleFile (..),
)
where
import Data.Algorithm.Diff (Diff, PolyDiff (Both, First, Second), getDiff)
import Data.Bifunctor (Bifunctor (bimap, first, second))
import qualified Data.Text as T
import qualified Data.Vector as V
import Futhark.Util.Loc (Loc (Loc), Pos (Pos))
import Language.LSP.VFS (VirtualFile)
data PositionMapping = PositionMapping
{
PositionMapping -> Vector Int
staleToCurrent :: V.Vector Int,
PositionMapping -> Vector Int
currentToStale :: V.Vector Int
}
deriving (Int -> PositionMapping -> ShowS
[PositionMapping] -> ShowS
PositionMapping -> String
(Int -> PositionMapping -> ShowS)
-> (PositionMapping -> String)
-> ([PositionMapping] -> ShowS)
-> Show PositionMapping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PositionMapping] -> ShowS
$cshowList :: [PositionMapping] -> ShowS
show :: PositionMapping -> String
$cshow :: PositionMapping -> String
showsPrec :: Int -> PositionMapping -> ShowS
$cshowsPrec :: Int -> PositionMapping -> ShowS
Show)
data StaleFile = StaleFile
{
StaleFile -> VirtualFile
staleContent :: VirtualFile,
StaleFile -> Maybe PositionMapping
staleMapping :: Maybe PositionMapping
}
deriving (Int -> StaleFile -> ShowS
[StaleFile] -> ShowS
StaleFile -> String
(Int -> StaleFile -> ShowS)
-> (StaleFile -> String)
-> ([StaleFile] -> ShowS)
-> Show StaleFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StaleFile] -> ShowS
$cshowList :: [StaleFile] -> ShowS
show :: StaleFile -> String
$cshow :: StaleFile -> String
showsPrec :: Int -> StaleFile -> ShowS
$cshowsPrec :: Int -> StaleFile -> ShowS
Show)
mappingFromDiff :: [T.Text] -> [T.Text] -> PositionMapping
mappingFromDiff :: [Text] -> [Text] -> PositionMapping
mappingFromDiff [Text]
stale [Text]
current = do
let ([Int]
stale_to_current, [Int]
current_to_stale) = [Diff Text] -> Int -> Int -> ([Int], [Int])
rawMapping ([Text] -> [Text] -> [Diff Text]
forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff [Text]
stale [Text]
current) Int
0 Int
0
Vector Int -> Vector Int -> PositionMapping
PositionMapping ([Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList [Int]
stale_to_current) ([Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList [Int]
current_to_stale)
where
rawMapping :: [Diff T.Text] -> Int -> Int -> ([Int], [Int])
rawMapping :: [Diff Text] -> Int -> Int -> ([Int], [Int])
rawMapping [] Int
_ Int
_ = ([], [])
rawMapping (Both Text
_ Text
_ : [Diff Text]
xs) Int
lold Int
lnew = ([Int] -> [Int])
-> ([Int] -> [Int]) -> ([Int], [Int]) -> ([Int], [Int])
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Int
lnew Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (Int
lold Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (([Int], [Int]) -> ([Int], [Int]))
-> ([Int], [Int]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
rawMapping [Diff Text]
xs (Int
lold Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
lnew Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
rawMapping (First Text
_ : [Diff Text]
xs) Int
lold Int
lnew = ([Int] -> [Int]) -> ([Int], [Int]) -> ([Int], [Int])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (-Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (([Int], [Int]) -> ([Int], [Int]))
-> ([Int], [Int]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
rawMapping [Diff Text]
xs (Int
lold Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
lnew
rawMapping (Second Text
_ : [Diff Text]
xs) Int
lold Int
lnew = ([Int] -> [Int]) -> ([Int], [Int]) -> ([Int], [Int])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (-Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) (([Int], [Int]) -> ([Int], [Int]))
-> ([Int], [Int]) -> ([Int], [Int])
forall a b. (a -> b) -> a -> b
$ [Diff Text] -> Int -> Int -> ([Int], [Int])
rawMapping [Diff Text]
xs Int
lold (Int
lnew Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
toStalePos :: Maybe PositionMapping -> Pos -> Maybe Pos
toStalePos :: Maybe PositionMapping -> Pos -> Maybe Pos
toStalePos (Just (PositionMapping Vector Int
_ Vector Int
current_to_stale)) Pos
pos =
if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector Int -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length Vector Int
current_to_stale
then Maybe Pos
forall a. Maybe a
Nothing
else Pos -> Maybe Pos
forall a. a -> Maybe a
Just (Pos -> Maybe Pos) -> Pos -> Maybe Pos
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Int -> Pos
Pos String
file (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
current_to_stale (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
c Int
o
where
Pos String
file Int
l Int
c Int
o = Pos
pos
toStalePos Maybe PositionMapping
Nothing Pos
pos = Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
pos
toCurrentPos :: Maybe PositionMapping -> Pos -> Maybe Pos
toCurrentPos :: Maybe PositionMapping -> Pos -> Maybe Pos
toCurrentPos (Just (PositionMapping Vector Int
stale_to_current Vector Int
_)) Pos
pos =
if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Vector Int -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length Vector Int
stale_to_current
then Maybe Pos
forall a. Maybe a
Nothing
else Pos -> Maybe Pos
forall a. a -> Maybe a
Just (Pos -> Maybe Pos) -> Pos -> Maybe Pos
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Int -> Pos
Pos String
file (Vector Int -> Int -> Int
forall a. Vector a -> Int -> a
V.unsafeIndex Vector Int
stale_to_current (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
c Int
o
where
Pos String
file Int
l Int
c Int
o = Pos
pos
toCurrentPos Maybe PositionMapping
Nothing Pos
pos = Pos -> Maybe Pos
forall a. a -> Maybe a
Just Pos
pos
toCurrentLoc :: Maybe PositionMapping -> Loc -> Maybe Loc
toCurrentLoc :: Maybe PositionMapping -> Loc -> Maybe Loc
toCurrentLoc Maybe PositionMapping
mapping Loc
loc = do
let Loc Pos
start Pos
end = Loc
loc
Pos
current_start <- Maybe PositionMapping -> Pos -> Maybe Pos
toCurrentPos Maybe PositionMapping
mapping Pos
start
Pos
current_end <- Maybe PositionMapping -> Pos -> Maybe Pos
toCurrentPos Maybe PositionMapping
mapping Pos
end
Loc -> Maybe Loc
forall a. a -> Maybe a
Just (Loc -> Maybe Loc) -> Loc -> Maybe Loc
forall a b. (a -> b) -> a -> b
$ Pos -> Pos -> Loc
Loc Pos
current_start Pos
current_end