{-# LANGUAGE OverloadedStrings #-}

-- | Generally useful definition used in various places in the
-- language server implementation.
module Futhark.LSP.Tool
  ( getHoverInfoFromState,
    findDefinitionRange,
    rangeFromSrcLoc,
    rangeFromLoc,
    posToUri,
  )
where

import qualified Data.Text as T
import Futhark.Compiler.Program (lpImports)
import Futhark.LSP.State (State (..))
import Futhark.Util.Loc (Loc (Loc, NoLoc), Pos (Pos), SrcLoc, locOf, srclocOf)
import Futhark.Util.Pretty (prettyText)
import Language.Futhark.Core (locStr)
import Language.Futhark.Prop (isBuiltinLoc)
import Language.Futhark.Query
  ( AtPos (AtName),
    BoundTo (BoundTerm),
    atPos,
    boundLoc,
  )
import Language.LSP.Types
  ( Location (..),
    Position (..),
    Range (..),
    Uri,
    filePathToUri,
  )

-- | Retrieve hover info for the definition referenced at the given
-- file at the given line and column number (the two 'Int's).
getHoverInfoFromState :: State -> Maybe FilePath -> Int -> Int -> Maybe T.Text
getHoverInfoFromState :: State -> Maybe FilePath -> Int -> Int -> Maybe Text
getHoverInfoFromState State
state (Just FilePath
path) Int
l Int
c = do
  AtName QualName VName
qn (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
  case BoundTo
def of
    BoundTerm StructType
t Loc
defloc -> do
      Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
        (QualName VName -> Text
forall a. Pretty a => a -> Text
prettyText QualName VName
qn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> StructType -> Text
forall a. Pretty a => a -> Text
prettyText StructType
t)
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Loc -> Bool
forall a. Located a => a -> Bool
isBuiltinLoc Loc
defloc
            then Text
forall a. Monoid a => a
mempty
            else Text
"\n\n**Definition: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (SrcLoc -> FilePath
forall a. Located a => a -> FilePath
locStr (Loc -> SrcLoc
forall a. Located a => a -> SrcLoc
srclocOf Loc
defloc)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"**"
    BoundTo
bound
      | Loc -> Bool
forall a. Located a => a -> Bool
isBuiltinLoc (BoundTo -> Loc
boundLoc BoundTo
bound) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Builtin definition."
      | Bool
otherwise -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"Definition: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Loc -> FilePath
forall a. Located a => a -> FilePath
locStr (BoundTo -> Loc
boundLoc BoundTo
bound))
getHoverInfoFromState State
_ Maybe FilePath
_ Int
_ Int
_ = Maybe Text
forall a. Maybe a
Nothing

-- | Find the location of the definition referenced at the given file
-- at the given line and column number (the two 'Int's).
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
  -- some unnessecary operations inside `queryAtPos` for this function
  -- but shouldn't affect performance much since "Go to definition" is called less frequently
  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 =
  case State -> Maybe LoadedProg
stateProgram State
state of
    Maybe LoadedProg
Nothing -> Maybe AtPos
forall a. Maybe a
Nothing
    Just LoadedProg
loaded_prog -> Imports -> Pos -> Maybe AtPos
atPos (LoadedProg -> Imports
lpImports LoadedProg
loaded_prog) Pos
pos

-- | Convert a Futhark 'Pos' to an LSP 'Uri'.
posToUri :: Pos -> Uri
posToUri :: Pos -> Uri
posToUri (Pos FilePath
file Int
_ Int
_ Int
_) = FilePath -> Uri
filePathToUri FilePath
file

-- Futhark's parser has a slightly different notion of locations than
-- LSP; so we tweak the positions here.
getStartPos :: Pos -> Position
getStartPos :: Pos -> Position
getStartPos (Pos FilePath
_ Int
line Int
col Int
_) =
  UInt -> UInt -> Position
Position (Int -> UInt
forall a. Enum a => Int -> a
toEnum Int
line UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1) (Int -> UInt
forall a. Enum a => Int -> a
toEnum Int
col UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1)

getEndPos :: Pos -> Position
getEndPos :: Pos -> Position
getEndPos (Pos FilePath
_ Int
line Int
col Int
_) =
  UInt -> UInt -> Position
Position (Int -> UInt
forall a. Enum a => Int -> a
toEnum Int
line UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
1) (Int -> UInt
forall a. Enum a => Int -> a
toEnum Int
col)

-- | Create an LSP 'Range' from a Futhark 'Loc'.
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) -- only when file not found, throw error after moving to vfs

-- | Create an LSP 'Range' from a Futhark 'SrcLoc'.
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