module Futhark.LSP.Tool
( getHoverInfoFromState,
findDefinitionRange,
rangeFromSrcLoc,
rangeFromLoc,
posToUri,
computeMapping,
)
where
import Data.Text qualified as T
import Futhark.Compiler.Program (lpImports)
import Futhark.LSP.PositionMapping
( PositionMapping,
mappingFromDiff,
toCurrentLoc,
toStalePos,
)
import Futhark.LSP.State (State (..), getStaleContent, getStaleMapping)
import Futhark.Util.Loc (Loc (Loc, NoLoc), Pos (Pos), SrcLoc, locOf)
import Futhark.Util.Pretty (prettyText)
import Language.Futhark.Prop (isBuiltinLoc)
import Language.Futhark.Query
( AtPos (AtName),
BoundTo (..),
atPos,
boundLoc,
)
import Language.LSP.Protocol.Types
import Language.LSP.Server (LspM, getVirtualFile)
import Language.LSP.VFS (VirtualFile, virtualFileText, virtualFileVersion)
getHoverInfoFromState :: State -> Maybe FilePath -> Int -> Int -> Maybe Hover
getHoverInfoFromState :: State -> Maybe FilePath -> Int -> Int -> Maybe Hover
getHoverInfoFromState State
state (Just FilePath
path) Int
l Int
c = do
AtName QualName VName
_ (Just BoundTo
def) Loc
loc <- State -> Pos -> Maybe AtPos
queryAtPos State
state (Pos -> Maybe AtPos) -> Pos -> Maybe AtPos
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Int -> Int -> Pos
Pos FilePath
path Int
l Int
c Int
0
let msg :: Text
msg =
case BoundTo
def of
BoundTerm StructType
t Loc
_ -> StructType -> Text
forall a. Pretty a => a -> Text
prettyText StructType
t
BoundModule {} -> Text
"module"
BoundModuleType {} -> Text
"module type"
BoundType {} -> Text
"type"
ms :: MarkupContent
ms = MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_PlainText Text
msg
Hover -> Maybe Hover
forall a. a -> Maybe a
Just (Hover -> Maybe Hover) -> Hover -> Maybe Hover
forall a b. (a -> b) -> a -> b
$ (MarkupContent |? (MarkedString |? [MarkedString]))
-> Maybe Range -> Hover
Hover (MarkupContent -> MarkupContent |? (MarkedString |? [MarkedString])
forall a b. a -> a |? b
InL MarkupContent
ms) (Range -> Maybe Range
forall a. a -> Maybe a
Just (Loc -> Range
rangeFromLoc Loc
loc))
getHoverInfoFromState State
_ Maybe FilePath
_ Int
_ Int
_ = Maybe Hover
forall a. Maybe a
Nothing
findDefinitionRange :: State -> Maybe FilePath -> Int -> Int -> Maybe Location
findDefinitionRange :: State -> Maybe FilePath -> Int -> Int -> Maybe Location
findDefinitionRange State
state (Just FilePath
path) Int
l Int
c = do
AtName QualName VName
_qn (Just BoundTo
bound) Loc
_loc <- State -> Pos -> Maybe AtPos
queryAtPos State
state (Pos -> Maybe AtPos) -> Pos -> Maybe AtPos
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Int -> Int -> Pos
Pos FilePath
path Int
l Int
c Int
0
let loc :: Loc
loc = BoundTo -> Loc
boundLoc BoundTo
bound
Loc (Pos FilePath
file_path Int
_ Int
_ Int
_) Pos
_ = Loc
loc
if Loc -> Bool
forall a. Located a => a -> Bool
isBuiltinLoc Loc
loc
then Maybe Location
forall a. Maybe a
Nothing
else Location -> Maybe Location
forall a. a -> Maybe a
Just (Location -> Maybe Location) -> Location -> Maybe Location
forall a b. (a -> b) -> a -> b
$ Uri -> Range -> Location
Location (FilePath -> Uri
filePathToUri FilePath
file_path) (Loc -> Range
rangeFromLoc Loc
loc)
findDefinitionRange State
_ Maybe FilePath
_ Int
_ Int
_ = Maybe Location
forall a. Maybe a
Nothing
queryAtPos :: State -> Pos -> Maybe AtPos
queryAtPos :: State -> Pos -> Maybe AtPos
queryAtPos State
state Pos
pos = do
let Pos FilePath
path Int
_ Int
_ Int
_ = Pos
pos
mapping :: Maybe PositionMapping
mapping = State -> FilePath -> Maybe PositionMapping
getStaleMapping State
state FilePath
path
LoadedProg
loaded_prog <- State -> Maybe LoadedProg
stateProgram State
state
Pos
stale_pos <- Maybe PositionMapping -> Pos -> Maybe Pos
toStalePos Maybe PositionMapping
mapping Pos
pos
AtPos
query_result <- Imports -> Pos -> Maybe AtPos
atPos (LoadedProg -> Imports
lpImports LoadedProg
loaded_prog) Pos
stale_pos
Maybe PositionMapping -> AtPos -> Maybe AtPos
updateAtPos Maybe PositionMapping
mapping AtPos
query_result
where
updateAtPos :: Maybe PositionMapping -> AtPos -> Maybe AtPos
updateAtPos :: Maybe PositionMapping -> AtPos -> Maybe AtPos
updateAtPos Maybe PositionMapping
mapping (AtName QualName VName
qn (Just BoundTo
def) Loc
loc) = do
let def_loc :: Loc
def_loc = BoundTo -> Loc
boundLoc BoundTo
def
Loc (Pos FilePath
def_file Int
_ Int
_ Int
_) Pos
_ = Loc
def_loc
Pos FilePath
current_file Int
_ Int
_ Int
_ = Pos
pos
Loc
current_loc <- Maybe PositionMapping -> Loc -> Maybe Loc
toCurrentLoc Maybe PositionMapping
mapping Loc
loc
if FilePath
def_file FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
current_file
then do
Loc
current_def_loc <- Maybe PositionMapping -> Loc -> Maybe Loc
toCurrentLoc Maybe PositionMapping
mapping Loc
def_loc
AtPos -> Maybe AtPos
forall a. a -> Maybe a
Just (AtPos -> Maybe AtPos) -> AtPos -> Maybe AtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Maybe BoundTo -> Loc -> AtPos
AtName QualName VName
qn (BoundTo -> Maybe BoundTo
forall a. a -> Maybe a
Just (BoundTo -> Loc -> BoundTo
updateBoundLoc BoundTo
def Loc
current_def_loc)) Loc
current_loc
else do
let def_mapping :: Maybe PositionMapping
def_mapping = State -> FilePath -> Maybe PositionMapping
getStaleMapping State
state FilePath
def_file
Loc
current_def_loc <- Maybe PositionMapping -> Loc -> Maybe Loc
toCurrentLoc Maybe PositionMapping
def_mapping Loc
def_loc
AtPos -> Maybe AtPos
forall a. a -> Maybe a
Just (AtPos -> Maybe AtPos) -> AtPos -> Maybe AtPos
forall a b. (a -> b) -> a -> b
$ QualName VName -> Maybe BoundTo -> Loc -> AtPos
AtName QualName VName
qn (BoundTo -> Maybe BoundTo
forall a. a -> Maybe a
Just (BoundTo -> Loc -> BoundTo
updateBoundLoc BoundTo
def Loc
current_def_loc)) Loc
current_loc
updateAtPos Maybe PositionMapping
_ AtPos
_ = Maybe AtPos
forall a. Maybe a
Nothing
updateBoundLoc :: BoundTo -> Loc -> BoundTo
updateBoundLoc :: BoundTo -> Loc -> BoundTo
updateBoundLoc (BoundTerm StructType
t Loc
_loc) Loc
current_loc = StructType -> Loc -> BoundTo
BoundTerm StructType
t Loc
current_loc
updateBoundLoc (BoundModule Loc
_loc) Loc
current_loc = Loc -> BoundTo
BoundModule Loc
current_loc
updateBoundLoc (BoundModuleType Loc
_loc) Loc
current_loc = Loc -> BoundTo
BoundModuleType Loc
current_loc
updateBoundLoc (BoundType Loc
_loc) Loc
current_loc = Loc -> BoundTo
BoundType Loc
current_loc
computeMapping :: State -> Maybe FilePath -> LspM () (Maybe PositionMapping)
computeMapping :: State -> Maybe FilePath -> LspM () (Maybe PositionMapping)
computeMapping State
state (Just FilePath
file_path) = do
Maybe VirtualFile
virtual_file <- NormalizedUri -> LspT () IO (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile (NormalizedUri -> LspT () IO (Maybe VirtualFile))
-> NormalizedUri -> LspT () IO (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri (Uri -> NormalizedUri) -> Uri -> NormalizedUri
forall a b. (a -> b) -> a -> b
$ FilePath -> Uri
filePathToUri FilePath
file_path
Maybe PositionMapping -> LspM () (Maybe PositionMapping)
forall a. a -> LspT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PositionMapping -> LspM () (Maybe PositionMapping))
-> Maybe PositionMapping -> LspM () (Maybe PositionMapping)
forall a b. (a -> b) -> a -> b
$ Maybe VirtualFile -> Maybe VirtualFile -> Maybe PositionMapping
getMapping (State -> FilePath -> Maybe VirtualFile
getStaleContent State
state FilePath
file_path) Maybe VirtualFile
virtual_file
where
getMapping :: Maybe VirtualFile -> Maybe VirtualFile -> Maybe PositionMapping
getMapping :: Maybe VirtualFile -> Maybe VirtualFile -> Maybe PositionMapping
getMapping (Just VirtualFile
stale_file) (Just VirtualFile
current_file) =
if VirtualFile -> Int32
virtualFileVersion VirtualFile
stale_file Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== VirtualFile -> Int32
virtualFileVersion VirtualFile
current_file
then Maybe PositionMapping
forall a. Maybe a
Nothing
else PositionMapping -> Maybe PositionMapping
forall a. a -> Maybe a
Just (PositionMapping -> Maybe PositionMapping)
-> PositionMapping -> Maybe PositionMapping
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text] -> PositionMapping
mappingFromDiff (Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ VirtualFile -> Text
virtualFileText VirtualFile
stale_file) (Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ VirtualFile -> Text
virtualFileText VirtualFile
current_file)
getMapping Maybe VirtualFile
_ Maybe VirtualFile
_ = Maybe PositionMapping
forall a. Maybe a
Nothing
computeMapping State
_ Maybe FilePath
_ = Maybe PositionMapping -> LspM () (Maybe PositionMapping)
forall a. a -> LspT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PositionMapping
forall a. Maybe a
Nothing
posToUri :: Pos -> Uri
posToUri :: Pos -> Uri
posToUri (Pos FilePath
file Int
_ Int
_ Int
_) = FilePath -> Uri
filePathToUri FilePath
file
getStartPos :: Pos -> Position
getStartPos :: Pos -> Position
getStartPos (Pos FilePath
_ Int
l Int
c Int
_) =
UInt -> UInt -> Position
Position (Int -> UInt
forall a. Enum a => Int -> a
toEnum Int
l UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1) (Int -> UInt
forall a. Enum a => Int -> a
toEnum Int
c UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1)
getEndPos :: Pos -> Position
getEndPos :: Pos -> Position
getEndPos (Pos FilePath
_ Int
l Int
c Int
_) =
UInt -> UInt -> Position
Position (Int -> UInt
forall a. Enum a => Int -> a
toEnum Int
l UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1) (Int -> UInt
forall a. Enum a => Int -> a
toEnum Int
c)
rangeFromLoc :: Loc -> Range
rangeFromLoc :: Loc -> Range
rangeFromLoc (Loc Pos
start Pos
end) = Position -> Position -> Range
Range (Pos -> Position
getStartPos Pos
start) (Pos -> Position
getEndPos Pos
end)
rangeFromLoc Loc
NoLoc = Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
0 UInt
0) (UInt -> UInt -> Position
Position UInt
0 UInt
5)
rangeFromSrcLoc :: SrcLoc -> Range
rangeFromSrcLoc :: SrcLoc -> Range
rangeFromSrcLoc = Loc -> Range
rangeFromLoc (Loc -> Range) -> (SrcLoc -> Loc) -> SrcLoc -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> Loc
forall a. Located a => a -> Loc
locOf