-- | Provide mapping between position in stale content and current.
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)

-- | A mapping between current file content and the stale (last successful compiled) file content.
-- Currently, only supports entire line mapping,
-- more detailed mapping might be achieved via referring to haskell-language-server@efb4b94
data PositionMapping = PositionMapping
  { -- | The mapping from stale position to current.
    -- e.g. staleToCurrent[2] = 4 means "line 2" in the stale file, corresponds to "line 4" in the current file.
    PositionMapping -> Vector Int
staleToCurrent :: V.Vector Int,
    -- | The mapping from current position to stale.
    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)

-- | Stale text document stored in state.
data StaleFile = StaleFile
  { -- | The last successfully compiled file content.
    -- Using VirtualFile for convenience, we can use anything with {version, content}
    StaleFile -> VirtualFile
staleContent :: VirtualFile,
    -- | PositionMapping between current and stale file content.
    -- Nothing if last type-check is successful.
    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)

-- | Compute PositionMapping using the diff between two texts.
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)

-- | Transform current Pos to the stale pos for query
-- Note: line and col in Pos is larger by one
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

-- some refactoring might be needed, same logic as toStalePos
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

-- | Transform stale Loc gotten from stale AST to current Loc.
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