{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitNamespaces #-}

-- | The handlers exposed by the language server.
module Futhark.LSP.Handlers (handlers) where

import Colog.Core (Severity (Debug, Info), (<&))
import Control.Lens ((^.))
import Control.Monad.Except (ExceptT, MonadError (throwError), liftEither, throwError)
import Control.Monad.Trans (lift)
import Control.Monad.Trans.Except (runExcept, runExceptT)
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (Value (Array, String))
import Data.Bifunctor (bimap, first)
import Data.Function ((&))
import Data.IORef (IORef)
import Data.Maybe (fromMaybe)
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Mixed.Rope qualified as R
import Data.Vector qualified as V
import Futhark.Fmt.Printer (fmtToText)
import Futhark.LSP.CodeAction (getCodeActions)
import Futhark.LSP.CodeLens qualified as CodeLens
import Futhark.LSP.CommandType (CommandType (CodeLens))
import Futhark.LSP.Compile (tryReCompile, tryTakeStateFromIORef)
import Futhark.LSP.InlayHint (getInlayHints)
import Futhark.LSP.State (State (..))
import Futhark.LSP.Tool (findDefinitionRange, getHoverInfoFromState, logWithSeverity)
import Futhark.Util (showText)
import Futhark.Util.Pretty (prettyText)
import Language.Futhark.Core (locText)
import Language.Futhark.Parser.Monad (SyntaxError (SyntaxError))
import Language.LSP.Protocol.Lens (arguments, command, line, params, range, start, textDocument, uri)
import Language.LSP.Protocol.Message
  ( Method (..),
    SMethod (..),
    TNotificationMessage (TNotificationMessage),
    TRequestMessage (TRequestMessage),
    TResponseError (TResponseError, _code, _message, _xdata),
  )
import Language.LSP.Protocol.Types
  ( ClientCapabilities,
    CodeLens,
    Definition (Definition),
    DefinitionParams (DefinitionParams),
    DidChangeTextDocumentParams (DidChangeTextDocumentParams),
    DidSaveTextDocumentParams (DidSaveTextDocumentParams),
    DocumentFormattingParams (DocumentFormattingParams),
    ErrorCodes (ErrorCodes_InvalidParams, ErrorCodes_InvalidRequest),
    HoverParams (HoverParams),
    LSPErrorCodes (LSPErrorCodes_RequestFailed),
    Null (..),
    Position (Position, _character, _line),
    Range (Range, _end, _start),
    SemanticTokens (SemanticTokens, _data_, _resultId),
    TextEdit (TextEdit, _newText, _range),
    Uri (..),
    toNormalizedUri,
    uriToFilePath,
    type (|?) (..),
  )
import Language.LSP.Server (Handlers, LspM, LspT, getVirtualFile, notificationHandler, requestHandler)
import Language.LSP.VFS (file_text)
import Text.Read (readMaybe)

onInitializeHandler :: Handlers (LspM ())
onInitializeHandler :: Handlers (LspT () IO)
onInitializeHandler = SMethod 'Method_Initialized
-> Handler (LspT () IO) 'Method_Initialized
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'Method_Initialized
SMethod_Initialized (Handler (LspT () IO) 'Method_Initialized -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_Initialized
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TNotificationMessage 'Method_Initialized
_msg ->
  Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Info LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Text
"Initialized"

onHoverHandler :: IORef State -> Handlers (LspM ())
onHoverHandler :: IORef State -> Handlers (LspT () IO)
onHoverHandler IORef State
state_mvar =
  SMethod 'Method_TextDocumentHover
-> Handler (LspT () IO) 'Method_TextDocumentHover
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_TextDocumentHover
SMethod_TextDocumentHover (Handler (LspT () IO) 'Method_TextDocumentHover
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentHover
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_TextDocumentHover
req Either (TResponseError 'Method_TextDocumentHover) (Hover |? Null)
-> LspT () IO ()
responder -> do
    let TRequestMessage Text
_ LspId 'Method_TextDocumentHover
_ SMethod 'Method_TextDocumentHover
_ (HoverParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
_workDone) = TRequestMessage 'Method_TextDocumentHover
req
        Position UInt
l UInt
c = Position
pos
        file_path :: Maybe FilePath
file_path = Uri -> Maybe FilePath
uriToFilePath (Uri -> Maybe FilePath) -> Uri -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Text
"Got hover request: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Maybe FilePath, Position) -> Text
forall a. Show a => a -> Text
showText (Maybe FilePath
file_path, Position
pos)
    state <- IORef State -> Maybe FilePath -> LspT () IO State
tryTakeStateFromIORef IORef State
state_mvar Maybe FilePath
file_path
    responder $ Right $ maybe (InR Null) InL $ getHoverInfoFromState state file_path (fromEnum l + 1) (fromEnum c + 1)

onDocumentFocusHandler :: IORef State -> Handlers (LspM ())
onDocumentFocusHandler :: IORef State -> Handlers (LspT () IO)
onDocumentFocusHandler IORef State
state_mvar =
  SMethod ('Method_CustomMethod "custom/onFocusTextDocument")
-> Handler
     (LspT () IO) ('Method_CustomMethod "custom/onFocusTextDocument")
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler (Proxy "custom/onFocusTextDocument"
-> SMethod ('Method_CustomMethod "custom/onFocusTextDocument")
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @"custom/onFocusTextDocument")) (Handler
   (LspT () IO) ('Method_CustomMethod "custom/onFocusTextDocument")
 -> Handlers (LspT () IO))
-> Handler
     (LspT () IO) ('Method_CustomMethod "custom/onFocusTextDocument")
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TNotificationMessage
  ('Method_CustomMethod "custom/onFocusTextDocument")
msg -> do
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Text
"Got custom request: onFocusTextDocument"
    let TNotificationMessage Text
_ SMethod ('Method_CustomMethod "custom/onFocusTextDocument")
_ (Array Array
vector_param) = TNotificationMessage
  ('Method_CustomMethod "custom/onFocusTextDocument")
msg
        String Text
focused_uri = Array -> Value
forall a. Vector a -> a
V.head Array
vector_param -- only one parameter passed from the client
    IORef State -> Maybe FilePath -> LspT () IO ()
tryReCompile IORef State
state_mvar (Uri -> Maybe FilePath
uriToFilePath (Text -> Uri
Uri Text
focused_uri))

goToDefinitionHandler :: IORef State -> Handlers (LspM ())
goToDefinitionHandler :: IORef State -> Handlers (LspT () IO)
goToDefinitionHandler IORef State
state_mvar =
  SMethod 'Method_TextDocumentDefinition
-> Handler (LspT () IO) 'Method_TextDocumentDefinition
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_TextDocumentDefinition
SMethod_TextDocumentDefinition (Handler (LspT () IO) 'Method_TextDocumentDefinition
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentDefinition
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_TextDocumentDefinition
req Either
  (TResponseError 'Method_TextDocumentDefinition)
  (Definition |? ([DefinitionLink] |? Null))
-> LspT () IO ()
responder -> do
    let TRequestMessage Text
_ LspId 'Method_TextDocumentDefinition
_ SMethod 'Method_TextDocumentDefinition
_ (DefinitionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
_workDone Maybe ProgressToken
_partial) = TRequestMessage 'Method_TextDocumentDefinition
req
        Position UInt
l UInt
c = Position
pos
        file_path :: Maybe FilePath
file_path = Uri -> Maybe FilePath
uriToFilePath (Uri -> Maybe FilePath) -> Uri -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug
      LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& (Text
"Got goto definition: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Maybe FilePath, Position) -> Text
forall a. Show a => a -> Text
showText (Maybe FilePath
file_path, Position
pos))
    state <- IORef State -> Maybe FilePath -> LspT () IO State
tryTakeStateFromIORef IORef State
state_mvar Maybe FilePath
file_path
    case findDefinitionRange state file_path (fromEnum l + 1) (fromEnum c + 1) of
      Maybe Location
Nothing -> Either
  (TResponseError 'Method_TextDocumentDefinition)
  (Definition |? ([DefinitionLink] |? Null))
-> LspT () IO ()
responder (Either
   (TResponseError 'Method_TextDocumentDefinition)
   (Definition |? ([DefinitionLink] |? Null))
 -> LspT () IO ())
-> Either
     (TResponseError 'Method_TextDocumentDefinition)
     (Definition |? ([DefinitionLink] |? Null))
-> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ (Definition |? ([DefinitionLink] |? Null))
-> Either
     (TResponseError 'Method_TextDocumentDefinition)
     (Definition |? ([DefinitionLink] |? Null))
forall a b. b -> Either a b
Right ((Definition |? ([DefinitionLink] |? Null))
 -> Either
      (TResponseError 'Method_TextDocumentDefinition)
      (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> Either
     (TResponseError 'Method_TextDocumentDefinition)
     (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ ([DefinitionLink] |? Null)
-> Definition |? ([DefinitionLink] |? Null)
forall a b. b -> a |? b
InR (([DefinitionLink] |? Null)
 -> Definition |? ([DefinitionLink] |? Null))
-> ([DefinitionLink] |? Null)
-> Definition |? ([DefinitionLink] |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> [DefinitionLink] |? Null
forall a b. b -> a |? b
InR Null
Null
      Just Location
loc -> Either
  (TResponseError 'Method_TextDocumentDefinition)
  (Definition |? ([DefinitionLink] |? Null))
-> LspT () IO ()
responder (Either
   (TResponseError 'Method_TextDocumentDefinition)
   (Definition |? ([DefinitionLink] |? Null))
 -> LspT () IO ())
-> Either
     (TResponseError 'Method_TextDocumentDefinition)
     (Definition |? ([DefinitionLink] |? Null))
-> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ (Definition |? ([DefinitionLink] |? Null))
-> Either
     (TResponseError 'Method_TextDocumentDefinition)
     (Definition |? ([DefinitionLink] |? Null))
forall a b. b -> Either a b
Right ((Definition |? ([DefinitionLink] |? Null))
 -> Either
      (TResponseError 'Method_TextDocumentDefinition)
      (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> Either
     (TResponseError 'Method_TextDocumentDefinition)
     (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ Definition -> Definition |? ([DefinitionLink] |? Null)
forall a b. a -> a |? b
InL (Definition -> Definition |? ([DefinitionLink] |? Null))
-> Definition -> Definition |? ([DefinitionLink] |? Null)
forall a b. (a -> b) -> a -> b
$ (Location |? [Location]) -> Definition
Definition ((Location |? [Location]) -> Definition)
-> (Location |? [Location]) -> Definition
forall a b. (a -> b) -> a -> b
$ Location -> Location |? [Location]
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 =
  SMethod 'Method_TextDocumentDidSave
-> Handler (LspT () IO) 'Method_TextDocumentDidSave
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'Method_TextDocumentDidSave
SMethod_TextDocumentDidSave (Handler (LspT () IO) 'Method_TextDocumentDidSave
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentDidSave
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TNotificationMessage 'Method_TextDocumentDidSave
msg -> do
    let TNotificationMessage Text
_ SMethod 'Method_TextDocumentDidSave
_ (DidSaveTextDocumentParams TextDocumentIdentifier
doc Maybe Text
_text) = TNotificationMessage 'Method_TextDocumentDidSave
msg
        file_path :: Maybe FilePath
file_path = Uri -> Maybe FilePath
uriToFilePath (Uri -> Maybe FilePath) -> Uri -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& (Text
"Saved document: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TextDocumentIdentifier -> Text
forall a. Show a => a -> Text
showText TextDocumentIdentifier
doc)
    IORef State -> Maybe FilePath -> LspT () IO ()
tryReCompile IORef State
state_mvar Maybe FilePath
file_path

onDocumentChangeHandler :: IORef State -> Handlers (LspM ())
onDocumentChangeHandler :: IORef State -> Handlers (LspT () IO)
onDocumentChangeHandler IORef State
state_mvar =
  SMethod 'Method_TextDocumentDidChange
-> Handler (LspT () IO) 'Method_TextDocumentDidChange
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange (Handler (LspT () IO) 'Method_TextDocumentDidChange
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentDidChange
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TNotificationMessage 'Method_TextDocumentDidChange
msg -> do
    let TNotificationMessage Text
_ SMethod 'Method_TextDocumentDidChange
_ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier
doc [TextDocumentContentChangeEvent]
_content) = TNotificationMessage 'Method_TextDocumentDidChange
msg
        file_path :: Maybe FilePath
file_path = Uri -> Maybe FilePath
uriToFilePath (Uri -> Maybe FilePath) -> Uri -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ VersionedTextDocumentIdentifier
doc VersionedTextDocumentIdentifier
-> Getting Uri VersionedTextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri VersionedTextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Uri
uri
    IORef State -> Maybe FilePath -> LspT () IO ()
tryReCompile IORef State
state_mvar Maybe FilePath
file_path

onDocumentOpenHandler :: IORef State -> Handlers (LspM ())
onDocumentOpenHandler :: IORef State -> Handlers (LspT () IO)
onDocumentOpenHandler IORef State
state_mvar =
  SMethod 'Method_TextDocumentDidOpen
-> Handler (LspT () IO) 'Method_TextDocumentDidOpen
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen (Handler (LspT () IO) 'Method_TextDocumentDidOpen
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentDidOpen
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TNotificationMessage 'Method_TextDocumentDidOpen
msg ->
    IORef State -> Maybe FilePath -> LspT () IO ()
tryReCompile IORef State
state_mvar (Maybe FilePath -> LspT () IO ())
-> Maybe FilePath -> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ Uri -> Maybe FilePath
uriToFilePath (Uri -> Maybe FilePath) -> Uri -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ TNotificationMessage 'Method_TextDocumentDidOpen
msg TNotificationMessage 'Method_TextDocumentDidOpen
-> Getting
     Uri (TNotificationMessage 'Method_TextDocumentDidOpen) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (DidOpenTextDocumentParams -> Const Uri DidOpenTextDocumentParams)
-> TNotificationMessage 'Method_TextDocumentDidOpen
-> Const Uri (TNotificationMessage 'Method_TextDocumentDidOpen)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentDidOpen)
  DidOpenTextDocumentParams
params ((DidOpenTextDocumentParams -> Const Uri DidOpenTextDocumentParams)
 -> TNotificationMessage 'Method_TextDocumentDidOpen
 -> Const Uri (TNotificationMessage 'Method_TextDocumentDidOpen))
-> ((Uri -> Const Uri Uri)
    -> DidOpenTextDocumentParams
    -> Const Uri DidOpenTextDocumentParams)
-> Getting
     Uri (TNotificationMessage 'Method_TextDocumentDidOpen) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentItem -> Const Uri TextDocumentItem)
-> DidOpenTextDocumentParams -> Const Uri DidOpenTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
Lens' DidOpenTextDocumentParams TextDocumentItem
textDocument ((TextDocumentItem -> Const Uri TextDocumentItem)
 -> DidOpenTextDocumentParams
 -> Const Uri DidOpenTextDocumentParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentItem -> Const Uri TextDocumentItem)
-> (Uri -> Const Uri Uri)
-> DidOpenTextDocumentParams
-> Const Uri DidOpenTextDocumentParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentItem -> Const Uri TextDocumentItem
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentItem Uri
uri

-- Nothing to do when a document is closed, but we ask for the
-- notification, so we must handle it.
onDocumentCloseHandler :: Handlers (LspM ())
onDocumentCloseHandler :: Handlers (LspT () IO)
onDocumentCloseHandler = SMethod 'Method_TextDocumentDidClose
-> Handler (LspT () IO) 'Method_TextDocumentDidClose
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose (Handler (LspT () IO) 'Method_TextDocumentDidClose
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentDidClose
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TNotificationMessage 'Method_TextDocumentDidClose
_msg -> () -> LspT () IO ()
forall a. a -> LspT () IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- Sent by Eglot when first connecting - not sure when else it might
-- be sent.
onWorkspaceDidChangeConfiguration :: IORef State -> Handlers (LspM ())
onWorkspaceDidChangeConfiguration :: IORef State -> Handlers (LspT () IO)
onWorkspaceDidChangeConfiguration IORef State
_state_mvar =
  SMethod 'Method_WorkspaceDidChangeConfiguration
-> Handler (LspT () IO) 'Method_WorkspaceDidChangeConfiguration
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Notification) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
notificationHandler SMethod 'Method_WorkspaceDidChangeConfiguration
SMethod_WorkspaceDidChangeConfiguration (Handler (LspT () IO) 'Method_WorkspaceDidChangeConfiguration
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_WorkspaceDidChangeConfiguration
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TNotificationMessage 'Method_WorkspaceDidChangeConfiguration
_ ->
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Text
"WorkspaceDidChangeConfiguration"

onDocumentFormattingHandler :: Handlers (LspM ())
onDocumentFormattingHandler :: Handlers (LspT () IO)
onDocumentFormattingHandler =
  SMethod 'Method_TextDocumentFormatting
-> Handler (LspT () IO) 'Method_TextDocumentFormatting
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_TextDocumentFormatting
SMethod_TextDocumentFormatting (Handler (LspT () IO) 'Method_TextDocumentFormatting
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentFormatting
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_TextDocumentFormatting
message Either
  (TResponseError 'Method_TextDocumentFormatting)
  ([TextEdit] |? Null)
-> LspT () IO ()
report -> do
    let TRequestMessage Text
_ LspId 'Method_TextDocumentFormatting
_ SMethod 'Method_TextDocumentFormatting
_ MessageParams 'Method_TextDocumentFormatting
formattingParams = TRequestMessage 'Method_TextDocumentFormatting
message
        DocumentFormattingParams Maybe ProgressToken
_progressToken TextDocumentIdentifier
textDoc FormattingOptions
_opts = MessageParams 'Method_TextDocumentFormatting
formattingParams
        fileUri :: Uri
fileUri = TextDocumentIdentifier
textDoc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Text
"Formatting: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Uri -> Text
forall a. Show a => a -> Text
showText (TextDocumentIdentifier
textDoc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri)
    result <- ExceptT
  (TResponseError 'Method_TextDocumentFormatting)
  (LspT () IO)
  ([TextEdit] |? Null)
-> LspT
     ()
     IO
     (Either
        (TResponseError 'Method_TextDocumentFormatting)
        ([TextEdit] |? Null))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   (TResponseError 'Method_TextDocumentFormatting)
   (LspT () IO)
   ([TextEdit] |? Null)
 -> LspT
      ()
      IO
      (Either
         (TResponseError 'Method_TextDocumentFormatting)
         ([TextEdit] |? Null)))
-> ExceptT
     (TResponseError 'Method_TextDocumentFormatting)
     (LspT () IO)
     ([TextEdit] |? Null)
-> LspT
     ()
     IO
     (Either
        (TResponseError 'Method_TextDocumentFormatting)
        ([TextEdit] |? Null))
forall a b. (a -> b) -> a -> b
$ do
      virtualFile <- Uri
-> ExceptT
     (TResponseError 'Method_TextDocumentFormatting)
     (LspT () IO)
     VirtualFile
forall {f :: MessageDirection} {t :: (* -> *) -> * -> *}
       {m :: * -> *} {config} {m :: Method f 'Request}.
(MonadTrans t, MonadLsp config m,
 MonadError (TResponseError m) (t m)) =>
Uri -> t m VirtualFile
getVirtualFile' Uri
fileUri
      let fileText = Rope -> Text
R.toText (Rope -> Text) -> Rope -> Text
forall a b. (a -> b) -> a -> b
$ VirtualFile
virtualFile VirtualFile -> Getting Rope VirtualFile Rope -> Rope
forall s a. s -> Getting a s a -> a
^. Getting Rope VirtualFile Rope
forall s a. HasFile_text s a => Lens' s a
Lens' VirtualFile Rope
file_text
      formattedText <- fmtToText' (fromMaybe (T.unpack (getUri fileUri)) (uriToFilePath fileUri)) fileText
      pure $
        if formattedText == fileText
          then InR Null
          else InL [fullTextEdit formattedText]

    report result
  where
    fullTextEdit :: Text -> TextEdit
fullTextEdit Text
newText =
      TextEdit
        { _newText :: Text
_newText = Text
newText,
          _range :: Range
_range =
            Range
              { _start :: Position
_start =
                  Position
                    { _line :: UInt
_line = UInt
0,
                      _character :: UInt
_character = UInt
0
                    },
                _end :: Position
_end =
                  Position
                    { -- defaults back to real lines, as documented in @lsp-types@
                      _line :: UInt
_line = UInt
forall a. Bounded a => a
maxBound,
                      _character :: UInt
_character = UInt
forall a. Bounded a => a
maxBound
                    }
              }
        }

    fmtToText' :: FilePath -> Text -> m Text
fmtToText' FilePath
fname Text
ftext =
      FilePath -> Text -> Either SyntaxError Text
fmtToText FilePath
fname Text
ftext
        Either SyntaxError Text
-> (Either SyntaxError Text -> Either (TResponseError m) Text)
-> Either (TResponseError m) Text
forall a b. a -> (a -> b) -> b
& (SyntaxError -> TResponseError m)
-> Either SyntaxError Text -> Either (TResponseError m) Text
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SyntaxError -> TResponseError m
forall {f :: MessageDirection} {m :: Method f 'Request}.
SyntaxError -> TResponseError m
syntaxErrorResponse
        Either (TResponseError m) Text
-> (Either (TResponseError m) Text -> m Text) -> m Text
forall a b. a -> (a -> b) -> b
& Either (TResponseError m) Text -> m Text
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither

    getVirtualFile' :: Uri -> t m VirtualFile
getVirtualFile' Uri
fileUri = do
      maybeFile <- m (Maybe VirtualFile) -> t m (Maybe VirtualFile)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe VirtualFile) -> t m (Maybe VirtualFile))
-> m (Maybe VirtualFile) -> t m (Maybe VirtualFile)
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> m (Maybe VirtualFile)
forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile (Uri -> NormalizedUri
toNormalizedUri Uri
fileUri)
      case maybeFile of
        Maybe VirtualFile
Nothing -> TResponseError m -> t m VirtualFile
forall a. TResponseError m -> t m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TResponseError m -> t m VirtualFile)
-> TResponseError m -> t m VirtualFile
forall a b. (a -> b) -> a -> b
$ Uri -> TResponseError m
forall {f :: MessageDirection} {a} {m :: Method f 'Request}.
Show a =>
a -> TResponseError m
noSuchDocumentResponse Uri
fileUri
        Just VirtualFile
f -> VirtualFile -> t m VirtualFile
forall a. a -> t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VirtualFile
f

    syntaxErrorResponse :: SyntaxError -> TResponseError m
syntaxErrorResponse (SyntaxError Loc
loc Text
msg) =
      TResponseError
        { _code :: LSPErrorCodes |? ErrorCodes
_code = LSPErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. a -> a |? b
InL LSPErrorCodes
LSPErrorCodes_RequestFailed,
          _message :: Text
_message = Text
"Syntax error at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Loc -> Text
forall a. Located a => a -> Text
locText Loc
loc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Pretty a => a -> Text
prettyText Text
msg,
          _xdata :: Maybe (ErrorData m)
_xdata = Maybe (ErrorData m)
forall a. Maybe a
Nothing
        }

    noSuchDocumentResponse :: a -> TResponseError m
noSuchDocumentResponse a
fileUri =
      TResponseError
        { _xdata :: Maybe (ErrorData m)
_xdata = Maybe (ErrorData m)
forall a. Maybe a
Nothing,
          _message :: Text
_message = Text
"Failed to retrieve document at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
showText a
fileUri,
          _code :: LSPErrorCodes |? ErrorCodes
_code = ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidParams
        }

-- The lsp library always advertises the semanticTokens capability,
-- and some clients (Eglot) then request full semantic tokens whether
-- we registered a handler or not.  We do not compute semantic tokens,
-- so we answer with none.
onDocumentSemanticTokensFull :: Handlers (LspM ())
onDocumentSemanticTokensFull :: Handlers (LspT () IO)
onDocumentSemanticTokensFull =
  SMethod 'Method_TextDocumentSemanticTokensFull
-> Handler (LspT () IO) 'Method_TextDocumentSemanticTokensFull
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_TextDocumentSemanticTokensFull
SMethod_TextDocumentSemanticTokensFull (Handler (LspT () IO) 'Method_TextDocumentSemanticTokensFull
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentSemanticTokensFull
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_TextDocumentSemanticTokensFull
_ Either
  (TResponseError 'Method_TextDocumentSemanticTokensFull)
  (SemanticTokens |? Null)
-> LspT () IO ()
respond ->
    Either
  (TResponseError 'Method_TextDocumentSemanticTokensFull)
  (SemanticTokens |? Null)
-> LspT () IO ()
respond (Either
   (TResponseError 'Method_TextDocumentSemanticTokensFull)
   (SemanticTokens |? Null)
 -> LspT () IO ())
-> Either
     (TResponseError 'Method_TextDocumentSemanticTokensFull)
     (SemanticTokens |? Null)
-> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ (SemanticTokens |? Null)
-> Either
     (TResponseError 'Method_TextDocumentSemanticTokensFull)
     (SemanticTokens |? Null)
forall a b. b -> Either a b
Right ((SemanticTokens |? Null)
 -> Either
      (TResponseError 'Method_TextDocumentSemanticTokensFull)
      (SemanticTokens |? Null))
-> (SemanticTokens |? Null)
-> Either
     (TResponseError 'Method_TextDocumentSemanticTokensFull)
     (SemanticTokens |? Null)
forall a b. (a -> b) -> a -> b
$ SemanticTokens -> SemanticTokens |? Null
forall a b. a -> a |? b
InL (SemanticTokens -> SemanticTokens |? Null)
-> SemanticTokens -> SemanticTokens |? Null
forall a b. (a -> b) -> a -> b
$ SemanticTokens {_resultId :: Maybe Text
_resultId = Maybe Text
forall a. Maybe a
Nothing, _data_ :: [UInt]
_data_ = []}

onDocumentCodeLenses :: Handlers (LspM ())
onDocumentCodeLenses :: Handlers (LspT () IO)
onDocumentCodeLenses =
  SMethod 'Method_TextDocumentCodeLens
-> Handler (LspT () IO) 'Method_TextDocumentCodeLens
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_TextDocumentCodeLens
SMethod_TextDocumentCodeLens (Handler (LspT () IO) 'Method_TextDocumentCodeLens
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentCodeLens
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_TextDocumentCodeLens
request Either
  (TResponseError 'Method_TextDocumentCodeLens) ([CodeLens] |? Null)
-> LspT () IO ()
respond -> do
    let textDocUri :: Uri
textDocUri = TRequestMessage 'Method_TextDocumentCodeLens
request TRequestMessage 'Method_TextDocumentCodeLens
-> Getting Uri (TRequestMessage 'Method_TextDocumentCodeLens) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (CodeLensParams -> Const Uri CodeLensParams)
-> TRequestMessage 'Method_TextDocumentCodeLens
-> Const Uri (TRequestMessage 'Method_TextDocumentCodeLens)
forall s a. HasParams s a => Lens' s a
Lens' (TRequestMessage 'Method_TextDocumentCodeLens) CodeLensParams
params ((CodeLensParams -> Const Uri CodeLensParams)
 -> TRequestMessage 'Method_TextDocumentCodeLens
 -> Const Uri (TRequestMessage 'Method_TextDocumentCodeLens))
-> ((Uri -> Const Uri Uri)
    -> CodeLensParams -> Const Uri CodeLensParams)
-> Getting Uri (TRequestMessage 'Method_TextDocumentCodeLens) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CodeLensParams -> Const Uri CodeLensParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CodeLensParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CodeLensParams -> Const Uri CodeLensParams)
-> Getting Uri TextDocumentIdentifier Uri
-> (Uri -> Const Uri Uri)
-> CodeLensParams
-> Const Uri CodeLensParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug
      LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& (Text
"textDocument/CodeLens for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Uri -> Text
forall a. Show a => a -> Text
showText Uri
textDocUri)
    eitherLenses <- Uri -> LspT () IO (Either Text [CodeLens])
CodeLens.evalLensesFor Uri
textDocUri
    respond $ bimap failure success eitherLenses
  where
    success :: [CodeLens] -> [CodeLens] |? Null
    success :: [CodeLens] -> [CodeLens] |? Null
success = [CodeLens] -> [CodeLens] |? Null
forall a b. a -> a |? b
InL

    failure :: Text -> TResponseError m
failure Text
message =
      TResponseError
        { _xdata :: Maybe (ErrorData m)
_xdata = Maybe (ErrorData m)
forall a. Maybe a
Nothing,
          _message :: Text
_message = Text
message,
          _code :: LSPErrorCodes |? ErrorCodes
_code = ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidRequest
        }

onDocumentCodeLensResolve :: Handlers (LspM ())
onDocumentCodeLensResolve :: Handlers (LspT () IO)
onDocumentCodeLensResolve =
  SMethod 'Method_CodeLensResolve
-> Handler (LspT () IO) 'Method_CodeLensResolve
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_CodeLensResolve
SMethod_CodeLensResolve (Handler (LspT () IO) 'Method_CodeLensResolve
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_CodeLensResolve
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_CodeLensResolve
request Either (TResponseError 'Method_CodeLensResolve) CodeLens
-> LspT () IO ()
respond -> do
    let codeLens :: CodeLens
codeLens = TRequestMessage 'Method_CodeLensResolve
request TRequestMessage 'Method_CodeLensResolve
-> Getting
     CodeLens (TRequestMessage 'Method_CodeLensResolve) CodeLens
-> CodeLens
forall s a. s -> Getting a s a -> a
^. Getting CodeLens (TRequestMessage 'Method_CodeLensResolve) CodeLens
forall s a. HasParams s a => Lens' s a
Lens' (TRequestMessage 'Method_CodeLensResolve) CodeLens
params
        codeLensLine :: UInt
codeLensLine = CodeLens
codeLens CodeLens -> Getting UInt CodeLens UInt -> UInt
forall s a. s -> Getting a s a -> a
^. ((Range -> Const UInt Range) -> CodeLens -> Const UInt CodeLens
forall s a. HasRange s a => Lens' s a
Lens' CodeLens Range
range ((Range -> Const UInt Range) -> CodeLens -> Const UInt CodeLens)
-> ((UInt -> Const UInt UInt) -> Range -> Const UInt Range)
-> Getting UInt CodeLens UInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Const UInt Position) -> Range -> Const UInt Range
forall s a. HasStart s a => Lens' s a
Lens' Range Position
start ((Position -> Const UInt Position) -> Range -> Const UInt Range)
-> ((UInt -> Const UInt UInt) -> Position -> Const UInt Position)
-> (UInt -> Const UInt UInt)
-> Range
-> Const UInt Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UInt -> Const UInt UInt) -> Position -> Const UInt Position
forall s a. HasLine s a => Lens' s a
Lens' Position UInt
line)
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug
      LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& (Text
"Resolving code lens on line " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UInt -> Text
forall a. Show a => a -> Text
showText UInt
codeLensLine)
    let result :: Either Text CodeLens
result = Except Text CodeLens -> Either Text CodeLens
forall e a. Except e a -> Either e a
runExcept (Except Text CodeLens -> Either Text CodeLens)
-> Except Text CodeLens -> Either Text CodeLens
forall a b. (a -> b) -> a -> b
$ CodeLens -> Except Text CodeLens
CodeLens.resolve CodeLens
codeLens
    Either (TResponseError 'Method_CodeLensResolve) CodeLens
-> LspT () IO ()
respond (Either (TResponseError 'Method_CodeLensResolve) CodeLens
 -> LspT () IO ())
-> (Either Text CodeLens
    -> Either (TResponseError 'Method_CodeLensResolve) CodeLens)
-> Either Text CodeLens
-> LspT () IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> TResponseError 'Method_CodeLensResolve)
-> Either Text CodeLens
-> Either (TResponseError 'Method_CodeLensResolve) CodeLens
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> TResponseError 'Method_CodeLensResolve
failure (Either Text CodeLens -> LspT () IO ())
-> Either Text CodeLens -> LspT () IO ()
forall a b. (a -> b) -> a -> b
$ Either Text CodeLens
result
  where
    failure :: Text -> TResponseError Method_CodeLensResolve
    failure :: Text -> TResponseError 'Method_CodeLensResolve
failure Text
text =
      TResponseError
        { _xdata :: Maybe (ErrorData 'Method_CodeLensResolve)
_xdata = Maybe (Maybe Void)
Maybe (ErrorData 'Method_CodeLensResolve)
forall a. Maybe a
Nothing,
          _message :: Text
_message = Text
text,
          _code :: LSPErrorCodes |? ErrorCodes
_code = ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidParams
        }

-- | Dispatch to the correct Command Handler
executeCommand ::
  Text ->
  Maybe [Aeson.Value] ->
  ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) ()
executeCommand :: Text
-> Maybe [Value]
-> ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) ()
executeCommand Text
cmd_name Maybe [Value]
cmd_params = case FilePath -> Maybe CommandType
forall a. Read a => FilePath -> Maybe a
readMaybe (FilePath -> Maybe CommandType) -> FilePath -> Maybe CommandType
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
cmd_name of
  Just CommandType
CodeLens -> Maybe [Value]
-> ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) ()
CodeLens.execute Maybe [Value]
cmd_params
  Maybe CommandType
Nothing ->
    (Text, LSPErrorCodes |? ErrorCodes)
-> ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) ()
forall a.
(Text, LSPErrorCodes |? ErrorCodes)
-> ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      ( Text
"Unknown command name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cmd_name,
        ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidRequest
      )

onWorkspaceExecuteCommandHandler :: Handlers (LspM ())
onWorkspaceExecuteCommandHandler :: Handlers (LspT () IO)
onWorkspaceExecuteCommandHandler =
  SMethod 'Method_WorkspaceExecuteCommand
-> Handler (LspT () IO) 'Method_WorkspaceExecuteCommand
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_WorkspaceExecuteCommand
SMethod_WorkspaceExecuteCommand (Handler (LspT () IO) 'Method_WorkspaceExecuteCommand
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_WorkspaceExecuteCommand
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_WorkspaceExecuteCommand
request Either
  (TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT () IO ()
respond -> do
    let parameters :: ExecuteCommandParams
parameters = TRequestMessage 'Method_WorkspaceExecuteCommand
request TRequestMessage 'Method_WorkspaceExecuteCommand
-> Getting
     ExecuteCommandParams
     (TRequestMessage 'Method_WorkspaceExecuteCommand)
     ExecuteCommandParams
-> ExecuteCommandParams
forall s a. s -> Getting a s a -> a
^. Getting
  ExecuteCommandParams
  (TRequestMessage 'Method_WorkspaceExecuteCommand)
  ExecuteCommandParams
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_WorkspaceExecuteCommand)
  ExecuteCommandParams
params
        commandName :: Text
commandName = ExecuteCommandParams
parameters ExecuteCommandParams
-> Getting Text ExecuteCommandParams Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text ExecuteCommandParams Text
forall s a. HasCommand s a => Lens' s a
Lens' ExecuteCommandParams Text
command
        commandArgs :: Maybe [Value]
commandArgs = ExecuteCommandParams
parameters ExecuteCommandParams
-> Getting (Maybe [Value]) ExecuteCommandParams (Maybe [Value])
-> Maybe [Value]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Value]) ExecuteCommandParams (Maybe [Value])
forall s a. HasArguments s a => Lens' s a
Lens' ExecuteCommandParams (Maybe [Value])
arguments
    result <- ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) ()
-> LspT () IO (Either (Text, LSPErrorCodes |? ErrorCodes) ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) ()
 -> LspT () IO (Either (Text, LSPErrorCodes |? ErrorCodes) ()))
-> ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) ()
-> LspT () IO (Either (Text, LSPErrorCodes |? ErrorCodes) ())
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe [Value]
-> ExceptT (Text, LSPErrorCodes |? ErrorCodes) (LspT () IO) ()
executeCommand Text
commandName Maybe [Value]
commandArgs
    respond $ bimap (uncurry failure) (const $ InR Null) result
  where
    failure :: Text -> (LSPErrorCodes |? ErrorCodes) -> TResponseError m
failure Text
message LSPErrorCodes |? ErrorCodes
err =
      TResponseError
        { _xdata :: Maybe (ErrorData m)
_xdata = Maybe (ErrorData m)
forall a. Maybe a
Nothing,
          _message :: Text
_message = Text
message,
          _code :: LSPErrorCodes |? ErrorCodes
_code = LSPErrorCodes |? ErrorCodes
err
        }

onTextDocumentInlayHint :: IORef State -> Handlers (LspM ())
onTextDocumentInlayHint :: IORef State -> Handlers (LspT () IO)
onTextDocumentInlayHint IORef State
state_ref =
  SMethod 'Method_TextDocumentInlayHint
-> Handler (LspT () IO) 'Method_TextDocumentInlayHint
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_TextDocumentInlayHint
SMethod_TextDocumentInlayHint (Handler (LspT () IO) 'Method_TextDocumentInlayHint
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentInlayHint
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_TextDocumentInlayHint
request Either
  (TResponseError 'Method_TextDocumentInlayHint)
  ([InlayHint] |? Null)
-> LspT () IO ()
respond -> do
    let parameters :: InlayHintParams
parameters = TRequestMessage 'Method_TextDocumentInlayHint
request TRequestMessage 'Method_TextDocumentInlayHint
-> Getting
     InlayHintParams
     (TRequestMessage 'Method_TextDocumentInlayHint)
     InlayHintParams
-> InlayHintParams
forall s a. s -> Getting a s a -> a
^. Getting
  InlayHintParams
  (TRequestMessage 'Method_TextDocumentInlayHint)
  InlayHintParams
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentInlayHint) InlayHintParams
params
        filepath :: Maybe FilePath
filepath = Uri -> Maybe FilePath
uriToFilePath (Uri -> Maybe FilePath) -> Uri -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ InlayHintParams
parameters InlayHintParams -> Getting Uri InlayHintParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> InlayHintParams -> Const Uri InlayHintParams
forall s a. HasTextDocument s a => Lens' s a
Lens' InlayHintParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> InlayHintParams -> Const Uri InlayHintParams)
-> Getting Uri TextDocumentIdentifier Uri
-> Getting Uri InlayHintParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri)
        textRange :: Range
textRange = InlayHintParams
parameters InlayHintParams -> Getting Range InlayHintParams Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range InlayHintParams Range
forall s a. HasRange s a => Lens' s a
Lens' InlayHintParams Range
range
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Text
"Inlay hints request for range: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Range -> Text
forall a. Show a => a -> Text
showText Range
textRange

    state <- IORef State -> Maybe FilePath -> LspT () IO State
tryTakeStateFromIORef IORef State
state_ref Maybe FilePath
filepath
    let result = [InlayHint]
-> (FilePath -> [InlayHint]) -> Maybe FilePath -> [InlayHint]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Range -> State -> FilePath -> [InlayHint]
getInlayHints Range
textRange State
state) Maybe FilePath
filepath

    respond . Right $ InL result

onTextDocumentCodeAction :: IORef State -> Handlers (LspM ())
onTextDocumentCodeAction :: IORef State -> Handlers (LspT () IO)
onTextDocumentCodeAction IORef State
state_ref =
  SMethod 'Method_TextDocumentCodeAction
-> Handler (LspT () IO) 'Method_TextDocumentCodeAction
-> Handlers (LspT () IO)
forall (m :: Method 'ClientToServer 'Request) (f :: * -> *).
SMethod m -> Handler f m -> Handlers f
requestHandler SMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (Handler (LspT () IO) 'Method_TextDocumentCodeAction
 -> Handlers (LspT () IO))
-> Handler (LspT () IO) 'Method_TextDocumentCodeAction
-> Handlers (LspT () IO)
forall a b. (a -> b) -> a -> b
$ \TRequestMessage 'Method_TextDocumentCodeAction
request Either
  (TResponseError 'Method_TextDocumentCodeAction)
  ([Command |? CodeAction] |? Null)
-> LspT () IO ()
respond -> do
    let parameters :: CodeActionParams
parameters = TRequestMessage 'Method_TextDocumentCodeAction
request TRequestMessage 'Method_TextDocumentCodeAction
-> Getting
     CodeActionParams
     (TRequestMessage 'Method_TextDocumentCodeAction)
     CodeActionParams
-> CodeActionParams
forall s a. s -> Getting a s a -> a
^. Getting
  CodeActionParams
  (TRequestMessage 'Method_TextDocumentCodeAction)
  CodeActionParams
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCodeAction) CodeActionParams
params
        file_uri :: Uri
file_uri = CodeActionParams
parameters CodeActionParams -> Getting Uri CodeActionParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CodeActionParams -> Const Uri CodeActionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CodeActionParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CodeActionParams -> Const Uri CodeActionParams)
-> Getting Uri TextDocumentIdentifier Uri
-> Getting Uri CodeActionParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri)
        filepath :: Maybe FilePath
filepath = Uri -> Maybe FilePath
uriToFilePath (Uri -> Maybe FilePath) -> Uri -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ CodeActionParams
parameters CodeActionParams -> Getting Uri CodeActionParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CodeActionParams -> Const Uri CodeActionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CodeActionParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CodeActionParams -> Const Uri CodeActionParams)
-> Getting Uri TextDocumentIdentifier Uri
-> Getting Uri CodeActionParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri)
        textRange :: Range
textRange = CodeActionParams
parameters CodeActionParams -> Getting Range CodeActionParams Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range CodeActionParams Range
forall s a. HasRange s a => Lens' s a
Lens' CodeActionParams Range
range
    Severity -> LogAction (LspT () IO) Text
forall c (m :: * -> *).
MonadLsp c m =>
Severity -> LogAction m Text
logWithSeverity Severity
Debug LogAction (LspT () IO) Text -> Text -> LspT () IO ()
forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& Text
"Code action request for range: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Range -> Text
forall a. Show a => a -> Text
showText Range
textRange

    state <- IORef State -> Maybe FilePath -> LspT () IO State
tryTakeStateFromIORef IORef State
state_ref Maybe FilePath
filepath
    let result = [Command |? CodeAction]
-> (FilePath -> [Command |? CodeAction])
-> Maybe FilePath
-> [Command |? CodeAction]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Uri -> Range -> State -> FilePath -> [Command |? CodeAction]
getCodeActions Uri
file_uri Range
textRange State
state) Maybe FilePath
filepath

    respond $ Right $ InL result

-- | Given an 'IORef' tracking the state, produce a set of handlers.
-- When we want to add more features to the language server, this is
-- the thing to change.
handlers :: IORef State -> ClientCapabilities -> Handlers (LspM ())
handlers :: IORef State -> ClientCapabilities -> Handlers (LspT () IO)
handlers IORef State
state_mvar ClientCapabilities
_ =
  [Handlers (LspT () IO)] -> Handlers (LspT () IO)
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,
      Handlers (LspT () IO)
onDocumentCodeLenses,
      Handlers (LspT () IO)
onDocumentCodeLensResolve,
      Handlers (LspT () IO)
onDocumentFormattingHandler,
      Handlers (LspT () IO)
onDocumentSemanticTokensFull,
      IORef State -> Handlers (LspT () IO)
onTextDocumentInlayHint IORef State
state_mvar,
      IORef State -> Handlers (LspT () IO)
onTextDocumentCodeAction IORef State
state_mvar,
      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,
      Handlers (LspT () IO)
onWorkspaceExecuteCommandHandler
    ]