{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
module Development.IDE.LSP.HoverDefinition
(
hover
, gotoDefinition
, gotoTypeDefinition
, documentHighlight
, references
, wsSymbols
) where
import Control.Monad.IO.Class
import Development.IDE.Core.Actions
import Development.IDE.Core.Rules
import Development.IDE.Core.Shake
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import qualified Language.LSP.Server as LSP
import Language.LSP.Types
import qualified Data.Text as T
gotoDefinition :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (ResponseResult TextDocumentDefinition))
hover :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (Maybe Hover))
gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (ResponseResult TextDocumentTypeDefinition))
documentHighlight :: IdeState -> TextDocumentPositionParams -> LSP.LspM c (Either ResponseError (List DocumentHighlight))
gotoDefinition :: forall c.
IdeState
-> TextDocumentPositionParams
-> LspM
c (Either ResponseError (ResponseResult 'TextDocumentDefinition))
gotoDefinition = forall a b c.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> LspM c (Either ResponseError b)
request Text
"Definition" NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getDefinition (forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List []) (forall a b. b -> a |? b
InR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> a |? b
InL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> List a
List)
gotoTypeDefinition :: forall c.
IdeState
-> TextDocumentPositionParams
-> LspM
c
(Either ResponseError (ResponseResult 'TextDocumentTypeDefinition))
gotoTypeDefinition = forall a b c.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> LspM c (Either ResponseError b)
request Text
"TypeDefinition" NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getTypeDefinition (forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List []) (forall a b. b -> a |? b
InR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> a |? b
InL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> List a
List)
hover :: forall c.
IdeState
-> TextDocumentPositionParams
-> LspM c (Either ResponseError (Maybe Hover))
hover = forall a b c.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> LspM c (Either ResponseError b)
request Text
"Hover" NormalizedFilePath
-> Position -> IdeAction (Maybe (Maybe Range, [Text]))
getAtPoint forall a. Maybe a
Nothing (Maybe Range, [Text]) -> Maybe Hover
foundHover
documentHighlight :: forall c.
IdeState
-> TextDocumentPositionParams
-> LspM c (Either ResponseError (List DocumentHighlight))
documentHighlight = forall a b c.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> LspM c (Either ResponseError b)
request Text
"DocumentHighlight" NormalizedFilePath
-> Position -> IdeAction (Maybe [DocumentHighlight])
highlightAtPoint (forall a. [a] -> List a
List []) forall a. [a] -> List a
List
references :: IdeState -> ReferenceParams -> LSP.LspM c (Either ResponseError (List Location))
references :: forall c.
IdeState
-> ReferenceParams -> LspM c (Either ResponseError (List Location))
references IdeState
ide (ReferenceParams (TextDocumentIdentifier Uri
uri) Position
pos Maybe ProgressToken
_ Maybe ProgressToken
_ ReferenceContext
_) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
case Uri -> Maybe FilePath
uriToFilePath' Uri
uri of
Just FilePath
path -> do
let filePath :: NormalizedFilePath
filePath = FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
path
Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) forall a b. (a -> b) -> a -> b
$
Text
"References request at position " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Position -> FilePath
showPosition Position
pos) forall a. Semigroup a => a -> a -> a
<>
Text
" in file: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
path
forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> List a
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"references" IdeState
ide forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Position -> Action [Location]
refsAtPoint NormalizedFilePath
filePath Position
pos)
Maybe FilePath
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidParams (Text
"Invalid URI " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (forall a. Show a => a -> FilePath
show Uri
uri)) forall a. Maybe a
Nothing
wsSymbols :: IdeState -> WorkspaceSymbolParams -> LSP.LspM c (Either ResponseError (List SymbolInformation))
wsSymbols :: forall c.
IdeState
-> WorkspaceSymbolParams
-> LspM c (Either ResponseError (List SymbolInformation))
wsSymbols IdeState
ide (WorkspaceSymbolParams Maybe ProgressToken
_ Maybe ProgressToken
_ Text
query) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) forall a b. (a -> b) -> a -> b
$ Text
"Workspace symbols request: " forall a. Semigroup a => a -> a -> a
<> Text
query
forall a. FilePath -> ShakeExtras -> IdeAction a -> IO a
runIdeAction FilePath
"WorkspaceSymbols" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. [a] -> List a
List []) forall a. [a] -> List a
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IdeAction (Maybe [SymbolInformation])
workspaceSymbols Text
query
foundHover :: (Maybe Range, [T.Text]) -> Maybe Hover
foundHover :: (Maybe Range, [Text]) -> Maybe Hover
foundHover (Maybe Range
mbRange, [Text]
contents) =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HoverContents -> Maybe Range -> Hover
Hover (MarkupContent -> HoverContents
HoverContents forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
sectionSeparator [Text]
contents) Maybe Range
mbRange
request
:: T.Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> LSP.LspM c (Either ResponseError b)
request :: forall a b c.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> LspM c (Either ResponseError b)
request Text
label NormalizedFilePath -> Position -> IdeAction (Maybe a)
getResults b
notFound a -> b
found IdeState
ide (TextDocumentPositionParams (TextDocumentIdentifier Uri
uri) Position
pos) = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe a
mbResult <- case Uri -> Maybe FilePath
uriToFilePath' Uri
uri of
Just FilePath
path -> forall b.
Text
-> (NormalizedFilePath -> Position -> IdeAction b)
-> IdeState
-> Position
-> FilePath
-> IO b
logAndRunRequest Text
label NormalizedFilePath -> Position -> IdeAction (Maybe a)
getResults IdeState
ide Position
pos FilePath
path
Maybe FilePath
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
notFound a -> b
found Maybe a
mbResult
logAndRunRequest :: T.Text -> (NormalizedFilePath -> Position -> IdeAction b) -> IdeState -> Position -> String -> IO b
logAndRunRequest :: forall b.
Text
-> (NormalizedFilePath -> Position -> IdeAction b)
-> IdeState
-> Position
-> FilePath
-> IO b
logAndRunRequest Text
label NormalizedFilePath -> Position -> IdeAction b
getResults IdeState
ide Position
pos FilePath
path = do
let filePath :: NormalizedFilePath
filePath = FilePath -> NormalizedFilePath
toNormalizedFilePath' FilePath
path
Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) forall a b. (a -> b) -> a -> b
$
Text
label forall a. Semigroup a => a -> a -> a
<> Text
" request at position " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Position -> FilePath
showPosition Position
pos) forall a. Semigroup a => a -> a -> a
<>
Text
" in file: " forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
path
forall a. FilePath -> ShakeExtras -> IdeAction a -> IO a
runIdeAction (Text -> FilePath
T.unpack Text
label) (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (NormalizedFilePath -> Position -> IdeAction b
getResults NormalizedFilePath
filePath Position
pos)