module Futhark.LSP.Handlers (handlers) where
import Colog.Core (logStringStderr, (<&))
import Control.Lens ((^.))
import Data.Aeson.Types (Value (Array, String))
import Data.IORef
import Data.Vector qualified as V
import Futhark.LSP.Compile (tryReCompile, tryTakeStateFromIORef)
import Futhark.LSP.State (State (..))
import Futhark.LSP.Tool (findDefinitionRange, getHoverInfoFromState)
import Language.LSP.Server (Handlers, LspM, notificationHandler, requestHandler)
import Language.LSP.Types
import Language.LSP.Types.Lens (HasUri (uri))
onInitializeHandler :: Handlers (LspM ())
onInitializeHandler :: Handlers (LspT () IO)
onInitializeHandler = forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'Initialized
SInitialized forall a b. (a -> b) -> a -> b
$ \NotificationMessage 'Initialized
_msg ->
forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& String
"Initialized"
onHoverHandler :: IORef State -> Handlers (LspM ())
onHoverHandler :: IORef State -> Handlers (LspT () IO)
onHoverHandler IORef State
state_mvar = forall (m :: Method 'FromClient 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'TextDocumentHover
STextDocumentHover forall a b. (a -> b) -> a -> b
$ \RequestMessage 'TextDocumentHover
req Either ResponseError (Maybe Hover) -> LspT () IO ()
responder -> do
let RequestMessage Text
_ LspId 'TextDocumentHover
_ SMethod 'TextDocumentHover
_ (HoverParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
_workDone) = RequestMessage 'TextDocumentHover
req
Position UInt
l UInt
c = Position
pos
file_path :: Maybe String
file_path = Uri -> Maybe String
uriToFilePath forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri
forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& (String
"Got hover request: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Maybe String
file_path, Position
pos))
State
state <- IORef State -> Maybe String -> LspT () IO State
tryTakeStateFromIORef IORef State
state_mvar Maybe String
file_path
Either ResponseError (Maybe Hover) -> LspT () IO ()
responder forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ State -> Maybe String -> Int -> Int -> Maybe Hover
getHoverInfoFromState State
state Maybe String
file_path (forall a. Enum a => a -> Int
fromEnum UInt
l forall a. Num a => a -> a -> a
+ Int
1) (forall a. Enum a => a -> Int
fromEnum UInt
c forall a. Num a => a -> a -> a
+ Int
1)
onDocumentFocusHandler :: IORef State -> Handlers (LspM ())
onDocumentFocusHandler :: IORef State -> Handlers (LspT () IO)
onDocumentFocusHandler IORef State
state_mvar = forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler (forall {f :: From} {t :: MethodType}. Text -> SMethod 'CustomMethod
SCustomMethod Text
"custom/onFocusTextDocument") forall a b. (a -> b) -> a -> b
$ \NotificationMessage 'CustomMethod
msg -> do
forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& String
"Got custom request: onFocusTextDocument"
let NotificationMessage Text
_ SMethod 'CustomMethod
_ (Array Array
vector_param) = NotificationMessage 'CustomMethod
msg
String Text
focused_uri = forall a. Vector a -> a
V.head Array
vector_param
IORef State -> Maybe String -> LspT () IO ()
tryReCompile IORef State
state_mvar (Uri -> Maybe String
uriToFilePath (Text -> Uri
Uri Text
focused_uri))
goToDefinitionHandler :: IORef State -> Handlers (LspM ())
goToDefinitionHandler :: IORef State -> Handlers (LspT () IO)
goToDefinitionHandler IORef State
state_mvar = forall (m :: Method 'FromClient 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'TextDocumentDefinition
STextDocumentDefinition forall a b. (a -> b) -> a -> b
$ \RequestMessage 'TextDocumentDefinition
req Either
ResponseError (Location |? (List Location |? List LocationLink))
-> LspT () IO ()
responder -> do
let RequestMessage Text
_ LspId 'TextDocumentDefinition
_ SMethod 'TextDocumentDefinition
_ (DefinitionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
_workDone Maybe ProgressToken
_partial) = RequestMessage 'TextDocumentDefinition
req
Position UInt
l UInt
c = Position
pos
file_path :: Maybe String
file_path = Uri -> Maybe String
uriToFilePath forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri
forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& (String
"Got goto definition: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Maybe String
file_path, Position
pos))
State
state <- IORef State -> Maybe String -> LspT () IO State
tryTakeStateFromIORef IORef State
state_mvar Maybe String
file_path
case State -> Maybe String -> Int -> Int -> Maybe Location
findDefinitionRange State
state Maybe String
file_path (forall a. Enum a => a -> Int
fromEnum UInt
l forall a. Num a => a -> a -> a
+ Int
1) (forall a. Enum a => a -> Int
fromEnum UInt
c forall a. Num a => a -> a -> a
+ Int
1) of
Maybe Location
Nothing -> Either
ResponseError (Location |? (List Location |? List LocationLink))
-> LspT () IO ()
responder forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ 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 []
Just Location
loc -> Either
ResponseError (Location |? (List Location |? List LocationLink))
-> LspT () IO ()
responder forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL Location
loc
onDocumentSaveHandler :: IORef State -> Handlers (LspM ())
onDocumentSaveHandler :: IORef State -> Handlers (LspT () IO)
onDocumentSaveHandler IORef State
state_mvar = forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'TextDocumentDidSave
STextDocumentDidSave forall a b. (a -> b) -> a -> b
$ \NotificationMessage 'TextDocumentDidSave
msg -> do
let NotificationMessage Text
_ SMethod 'TextDocumentDidSave
_ (DidSaveTextDocumentParams TextDocumentIdentifier
doc Maybe Text
_text) = NotificationMessage 'TextDocumentDidSave
msg
file_path :: Maybe String
file_path = Uri -> Maybe String
uriToFilePath forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri
forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& (String
"Saved document: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show TextDocumentIdentifier
doc)
IORef State -> Maybe String -> LspT () IO ()
tryReCompile IORef State
state_mvar Maybe String
file_path
onDocumentChangeHandler :: IORef State -> Handlers (LspM ())
onDocumentChangeHandler :: IORef State -> Handlers (LspT () IO)
onDocumentChangeHandler IORef State
state_mvar = forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'TextDocumentDidChange
STextDocumentDidChange forall a b. (a -> b) -> a -> b
$ \NotificationMessage 'TextDocumentDidChange
msg -> do
let NotificationMessage Text
_ SMethod 'TextDocumentDidChange
_ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier
doc List TextDocumentContentChangeEvent
_content) = NotificationMessage 'TextDocumentDidChange
msg
file_path :: Maybe String
file_path = Uri -> Maybe String
uriToFilePath forall a b. (a -> b) -> a -> b
$ VersionedTextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri
IORef State -> Maybe String -> LspT () IO ()
tryReCompile IORef State
state_mvar Maybe String
file_path
onDocumentOpenHandler :: IORef State -> Handlers (LspM ())
onDocumentOpenHandler :: IORef State -> Handlers (LspT () IO)
onDocumentOpenHandler IORef State
state_mvar = forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'TextDocumentDidOpen
STextDocumentDidOpen forall a b. (a -> b) -> a -> b
$ \NotificationMessage 'TextDocumentDidOpen
msg -> do
let NotificationMessage Text
_ SMethod 'TextDocumentDidOpen
_ (DidOpenTextDocumentParams TextDocumentItem
doc) = NotificationMessage 'TextDocumentDidOpen
msg
file_path :: Maybe String
file_path = Uri -> Maybe String
uriToFilePath forall a b. (a -> b) -> a -> b
$ TextDocumentItem
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri
forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& (String
"Opened document: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (TextDocumentItem
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
uri))
IORef State -> Maybe String -> LspT () IO ()
tryReCompile IORef State
state_mvar Maybe String
file_path
onDocumentCloseHandler :: Handlers (LspM ())
onDocumentCloseHandler :: Handlers (LspT () IO)
onDocumentCloseHandler = forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'TextDocumentDidClose
STextDocumentDidClose forall a b. (a -> b) -> a -> b
$ \NotificationMessage 'TextDocumentDidClose
_msg ->
forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& String
"Closed document"
onWorkspaceDidChangeConfiguration :: IORef State -> Handlers (LspM ())
onWorkspaceDidChangeConfiguration :: IORef State -> Handlers (LspT () IO)
onWorkspaceDidChangeConfiguration IORef State
_state_mvar =
forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'WorkspaceDidChangeConfiguration
SWorkspaceDidChangeConfiguration forall a b. (a -> b) -> a -> b
$ \NotificationMessage 'WorkspaceDidChangeConfiguration
msg -> do
let NotificationMessage Text
_ SMethod 'WorkspaceDidChangeConfiguration
_ (DidChangeConfigurationParams Value
_settings) = NotificationMessage 'WorkspaceDidChangeConfiguration
msg
forall (m :: * -> *). MonadIO m => LogAction m String
logStringStderr forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& String
"WorkspaceDidChangeConfiguration"
handlers :: IORef State -> Handlers (LspM ())
handlers :: IORef State -> Handlers (LspT () IO)
handlers IORef State
state_mvar =
forall a. Monoid a => [a] -> a
mconcat
[ Handlers (LspT () IO)
onInitializeHandler,
IORef State -> Handlers (LspT () IO)
onDocumentOpenHandler IORef State
state_mvar,
Handlers (LspT () IO)
onDocumentCloseHandler,
IORef State -> Handlers (LspT () IO)
onDocumentSaveHandler IORef State
state_mvar,
IORef State -> Handlers (LspT () IO)
onDocumentChangeHandler IORef State
state_mvar,
IORef State -> Handlers (LspT () IO)
onDocumentFocusHandler IORef State
state_mvar,
IORef State -> Handlers (LspT () IO)
goToDefinitionHandler IORef State
state_mvar,
IORef State -> Handlers (LspT () IO)
onHoverHandler IORef State
state_mvar,
IORef State -> Handlers (LspT () IO)
onWorkspaceDidChangeConfiguration IORef State
state_mvar
]