module Development.IDE.LSP.HoverDefinition
( setHandlersDefinition
, setHandlersTypeDefinition
, setHandlersDocHighlight
, setHandlersReferences
, setHandlersWsSymbols
, hover
, gotoDefinition
, gotoTypeDefinition
) where
import Development.IDE.Core.Rules
import Development.IDE.Core.Shake
import Development.IDE.LSP.Server
import Development.IDE.Types.Location
import Development.IDE.Types.Logger
import qualified Language.Haskell.LSP.Core as LSP
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Types
import qualified Data.Text as T
gotoDefinition :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError LocationResponseParams)
hover :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError LocationResponseParams)
documentHighlight :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (List DocumentHighlight))
gotoDefinition :: IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams)
gotoDefinition = Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe [Location]))
-> LocationResponseParams
-> ([Location] -> LocationResponseParams)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams)
forall a b.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError b)
request Text
"Definition" NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getDefinition ([Location] -> LocationResponseParams
MultiLoc []) [Location] -> LocationResponseParams
MultiLoc
gotoTypeDefinition :: IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams)
gotoTypeDefinition = Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe [Location]))
-> LocationResponseParams
-> ([Location] -> LocationResponseParams)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams)
forall a b.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError b)
request Text
"TypeDefinition" NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getTypeDefinition ([Location] -> LocationResponseParams
MultiLoc []) [Location] -> LocationResponseParams
MultiLoc
hover :: IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (Maybe Hover))
hover = Text
-> (NormalizedFilePath
-> Position -> IdeAction (Maybe (Maybe Range, [Text])))
-> Maybe Hover
-> ((Maybe Range, [Text]) -> Maybe Hover)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (Maybe Hover))
forall a b.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError b)
request Text
"Hover" NormalizedFilePath
-> Position -> IdeAction (Maybe (Maybe Range, [Text]))
getAtPoint Maybe Hover
forall a. Maybe a
Nothing (Maybe Range, [Text]) -> Maybe Hover
foundHover
documentHighlight :: IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (List DocumentHighlight))
documentHighlight = Text
-> (NormalizedFilePath
-> Position -> IdeAction (Maybe [DocumentHighlight]))
-> List DocumentHighlight
-> ([DocumentHighlight] -> List DocumentHighlight)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (List DocumentHighlight))
forall a b.
Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError b)
request Text
"DocumentHighlight" NormalizedFilePath
-> Position -> IdeAction (Maybe [DocumentHighlight])
highlightAtPoint ([DocumentHighlight] -> List DocumentHighlight
forall a. [a] -> List a
List []) [DocumentHighlight] -> List DocumentHighlight
forall a. [a] -> List a
List
references :: IdeState -> ReferenceParams -> IO (Either ResponseError (List Location))
references :: IdeState
-> ReferenceParams -> IO (Either ResponseError (List Location))
references IdeState
ide (ReferenceParams (TextDocumentIdentifier Uri
uri) Position
pos ReferenceContext
_ Maybe ProgressToken
_) =
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) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
Text
"References request at position " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Position -> FilePath
showPosition Position
pos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" in file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
path
List Location -> Either ResponseError (List Location)
forall a b. b -> Either a b
Right (List Location -> Either ResponseError (List Location))
-> ([Location] -> List Location)
-> [Location]
-> Either ResponseError (List Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Location] -> List Location
forall a. [a] -> List a
List ([Location] -> Either ResponseError (List Location))
-> IO [Location] -> IO (Either ResponseError (List Location))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IdeState -> Action [Location] -> IO [Location]
forall a. FilePath -> IdeState -> Action a -> IO a
runAction FilePath
"references" IdeState
ide (Action [Location] -> IO [Location])
-> Action [Location] -> IO [Location]
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> Position -> Action [Location]
refsAtPoint NormalizedFilePath
filePath Position
pos)
Maybe FilePath
Nothing -> Either ResponseError (List Location)
-> IO (Either ResponseError (List Location))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (List Location)
-> IO (Either ResponseError (List Location)))
-> Either ResponseError (List Location)
-> IO (Either ResponseError (List Location))
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError (List Location)
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError (List Location))
-> ResponseError -> Either ResponseError (List Location)
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidParams (Text
"Invalid URI " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Uri -> FilePath
forall a. Show a => a -> FilePath
show Uri
uri)) Maybe Value
forall a. Maybe a
Nothing
wsSymbols :: IdeState -> WorkspaceSymbolParams -> IO (Either ResponseError (List SymbolInformation))
wsSymbols :: IdeState
-> WorkspaceSymbolParams
-> IO (Either ResponseError (List SymbolInformation))
wsSymbols IdeState
ide (WorkspaceSymbolParams Text
query Maybe ProgressToken
_) = do
Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Workspace symbols request: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
query
FilePath
-> ShakeExtras
-> IdeAction (Either ResponseError (List SymbolInformation))
-> IO (Either ResponseError (List SymbolInformation))
forall a. FilePath -> ShakeExtras -> IdeAction a -> IO a
runIdeAction FilePath
"WorkspaceSymbols" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (IdeAction (Either ResponseError (List SymbolInformation))
-> IO (Either ResponseError (List SymbolInformation)))
-> IdeAction (Either ResponseError (List SymbolInformation))
-> IO (Either ResponseError (List SymbolInformation))
forall a b. (a -> b) -> a -> b
$ List SymbolInformation
-> Either ResponseError (List SymbolInformation)
forall a b. b -> Either a b
Right (List SymbolInformation
-> Either ResponseError (List SymbolInformation))
-> (Maybe [SymbolInformation] -> List SymbolInformation)
-> Maybe [SymbolInformation]
-> Either ResponseError (List SymbolInformation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List SymbolInformation
-> ([SymbolInformation] -> List SymbolInformation)
-> Maybe [SymbolInformation]
-> List SymbolInformation
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([SymbolInformation] -> List SymbolInformation
forall a. [a] -> List a
List []) [SymbolInformation] -> List SymbolInformation
forall a. [a] -> List a
List (Maybe [SymbolInformation]
-> Either ResponseError (List SymbolInformation))
-> IdeAction (Maybe [SymbolInformation])
-> IdeAction (Either ResponseError (List SymbolInformation))
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) =
Hover -> Maybe Hover
forall a. a -> Maybe a
Just (Hover -> Maybe Hover) -> Hover -> Maybe Hover
forall a b. (a -> b) -> a -> b
$ HoverContents -> Maybe Range -> Hover
Hover (MarkupContent -> HoverContents
HoverContents (MarkupContent -> HoverContents) -> MarkupContent -> HoverContents
forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
sectionSeparator [Text]
contents) Maybe Range
mbRange
setHandlersDefinition, setHandlersTypeDefinition, setHandlersDocHighlight,
setHandlersReferences, setHandlersWsSymbols :: PartialHandlers c
setHandlersDefinition :: PartialHandlers c
setHandlersDefinition = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x ->
Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{definitionHandler :: Maybe (Handler DefinitionRequest)
LSP.definitionHandler = (ResponseMessage LocationResponseParams -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams))
-> Maybe (Handler DefinitionRequest)
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage LocationResponseParams -> FromServerMessage
RspDefinition ((LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams))
-> Maybe (Handler DefinitionRequest))
-> (LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams))
-> Maybe (Handler DefinitionRequest)
forall a b. (a -> b) -> a -> b
$ (IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams))
-> LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams)
forall a b. a -> b -> a
const IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams)
gotoDefinition}
setHandlersTypeDefinition :: PartialHandlers c
setHandlersTypeDefinition = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x ->
Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x {typeDefinitionHandler :: Maybe (Handler DefinitionRequest)
LSP.typeDefinitionHandler = (ResponseMessage LocationResponseParams -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams))
-> Maybe (Handler DefinitionRequest)
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage LocationResponseParams -> FromServerMessage
RspDefinition ((LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams))
-> Maybe (Handler DefinitionRequest))
-> (LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams))
-> Maybe (Handler DefinitionRequest)
forall a b. (a -> b) -> a -> b
$ (IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams))
-> LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams)
forall a b. a -> b -> a
const IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError LocationResponseParams)
gotoTypeDefinition}
setHandlersDocHighlight :: PartialHandlers c
setHandlersDocHighlight = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x ->
Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{documentHighlightHandler :: Maybe (Handler DocumentHighlightRequest)
LSP.documentHighlightHandler = (ResponseMessage (List DocumentHighlight) -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (List DocumentHighlight)))
-> Maybe (Handler DocumentHighlightRequest)
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List DocumentHighlight) -> FromServerMessage
RspDocumentHighlights ((LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (List DocumentHighlight)))
-> Maybe (Handler DocumentHighlightRequest))
-> (LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (List DocumentHighlight)))
-> Maybe (Handler DocumentHighlightRequest)
forall a b. (a -> b) -> a -> b
$ (IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (List DocumentHighlight)))
-> LspFuncs c
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (List DocumentHighlight))
forall a b. a -> b -> a
const IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError (List DocumentHighlight))
documentHighlight}
setHandlersReferences :: PartialHandlers c
setHandlersReferences = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x ->
Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{referencesHandler :: Maybe (Handler ReferencesRequest)
LSP.referencesHandler = (ResponseMessage (List Location) -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> ReferenceParams
-> IO (Either ResponseError (List Location)))
-> Maybe (Handler ReferencesRequest)
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List Location) -> FromServerMessage
RspFindReferences ((LspFuncs c
-> IdeState
-> ReferenceParams
-> IO (Either ResponseError (List Location)))
-> Maybe (Handler ReferencesRequest))
-> (LspFuncs c
-> IdeState
-> ReferenceParams
-> IO (Either ResponseError (List Location)))
-> Maybe (Handler ReferencesRequest)
forall a b. (a -> b) -> a -> b
$ (IdeState
-> ReferenceParams -> IO (Either ResponseError (List Location)))
-> LspFuncs c
-> IdeState
-> ReferenceParams
-> IO (Either ResponseError (List Location))
forall a b. a -> b -> a
const IdeState
-> ReferenceParams -> IO (Either ResponseError (List Location))
references}
setHandlersWsSymbols :: PartialHandlers c
setHandlersWsSymbols = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody,
HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> req
-> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
(Show m, Show req, HasTracing req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x ->
Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{workspaceSymbolHandler :: Maybe (Handler WorkspaceSymbolRequest)
LSP.workspaceSymbolHandler = (ResponseMessage (List SymbolInformation) -> FromServerMessage)
-> (LspFuncs c
-> IdeState
-> WorkspaceSymbolParams
-> IO (Either ResponseError (List SymbolInformation)))
-> Maybe (Handler WorkspaceSymbolRequest)
forall m req resp.
(Show m, Show req, HasTracing req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
-> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List SymbolInformation) -> FromServerMessage
RspWorkspaceSymbols ((LspFuncs c
-> IdeState
-> WorkspaceSymbolParams
-> IO (Either ResponseError (List SymbolInformation)))
-> Maybe (Handler WorkspaceSymbolRequest))
-> (LspFuncs c
-> IdeState
-> WorkspaceSymbolParams
-> IO (Either ResponseError (List SymbolInformation)))
-> Maybe (Handler WorkspaceSymbolRequest)
forall a b. (a -> b) -> a -> b
$ (IdeState
-> WorkspaceSymbolParams
-> IO (Either ResponseError (List SymbolInformation)))
-> LspFuncs c
-> IdeState
-> WorkspaceSymbolParams
-> IO (Either ResponseError (List SymbolInformation))
forall a b. a -> b -> a
const IdeState
-> WorkspaceSymbolParams
-> IO (Either ResponseError (List SymbolInformation))
wsSymbols}
request
:: T.Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError b)
request :: Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> b
-> (a -> b)
-> IdeState
-> TextDocumentPositionParams
-> IO (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 Maybe ProgressToken
_) = do
Maybe a
mbResult <- case Uri -> Maybe FilePath
uriToFilePath' Uri
uri of
Just FilePath
path -> Text
-> (NormalizedFilePath -> Position -> IdeAction (Maybe a))
-> IdeState
-> Position
-> FilePath
-> IO (Maybe a)
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 -> Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
Either ResponseError b -> IO (Either ResponseError b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError b -> IO (Either ResponseError b))
-> Either ResponseError b -> IO (Either ResponseError b)
forall a b. (a -> b) -> a -> b
$ b -> Either ResponseError b
forall a b. b -> Either a b
Right (b -> Either ResponseError b) -> b -> Either ResponseError b
forall a b. (a -> b) -> a -> b
$ b -> (a -> b) -> Maybe 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 :: 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 ()
logInfo (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" request at position " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Position -> FilePath
showPosition Position
pos) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
" in file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
path
FilePath -> ShakeExtras -> IdeAction b -> IO b
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)