{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeInType #-}

{- |
Module      : Language.LSP.Test
Description : A functional testing framework for LSP servers.
Maintainer  : luke_lau@icloud.com
Stability   : experimental
Portability : non-portable

Provides the framework to start functionally testing
<https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.
You should import "Language.LSP.Types" alongside this.
-}
module Language.LSP.Test (
  -- * Sessions
  Session,
  runSession,
  runSessionWithConfig,
  runSessionWithConfigCustomProcess,
  runSessionWithHandles,
  runSessionWithHandles',
  setIgnoringLogNotifications,
  setIgnoringConfigurationRequests,
  setIgnoringRegistrationRequests,

  -- ** Config
  SessionConfig (..),
  defaultConfig,
  C.fullCaps,

  -- ** Exceptions
  module Language.LSP.Test.Exceptions,
  withTimeout,

  -- * Sending
  request,
  request_,
  sendRequest,
  sendNotification,
  sendResponse,

  -- * Receiving
  module Language.LSP.Test.Parsing,

  -- * Utilities

  -- | Quick helper functions for common tasks.

  -- ** Initialization
  initializeResponse,

  -- ** Config
  modifyConfig,
  setConfig,
  modifyConfigSection,
  setConfigSection,

  -- ** Documents
  createDoc,
  openDoc,
  closeDoc,
  changeDoc,
  documentContents,
  getDocumentEdit,
  getDocUri,
  getVersionedDoc,

  -- ** Symbols
  getDocumentSymbols,

  -- ** Diagnostics
  waitForDiagnostics,
  waitForDiagnosticsSource,
  noDiagnostics,
  getCurrentDiagnostics,
  getIncompleteProgressSessions,

  -- ** Commands
  executeCommand,

  -- ** Code Actions
  getCodeActions,
  getAndResolveCodeActions,
  getAllCodeActions,
  executeCodeAction,
  resolveCodeAction,
  resolveAndExecuteCodeAction,

  -- ** Completions
  getCompletions,
  getAndResolveCompletions,

  -- ** References
  getReferences,

  -- ** Definitions
  getDeclarations,
  getDefinitions,
  getTypeDefinitions,
  getImplementations,

  -- ** Renaming
  rename,

  -- ** Hover
  getHover,

  -- ** Highlights
  getHighlights,

  -- ** Formatting
  formatDoc,
  formatRange,

  -- ** Edits
  applyEdit,

  -- ** Code lenses
  getCodeLenses,
  getAndResolveCodeLenses,
  resolveCodeLens,

  -- ** Call hierarchy
  prepareCallHierarchy,
  incomingCalls,
  outgoingCalls,

  -- ** SemanticTokens
  getSemanticTokens,

  -- ** Capabilities
  getRegisteredCapabilities,
) where

import Control.Applicative.Combinators
import Control.Concurrent
import Control.Exception
import Control.Lens hiding (Empty, List, (.=))
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.State (execState)
import Data.Aeson hiding (Null)
import Data.Aeson qualified as J
import Data.Aeson.KeyMap qualified as J
import Data.Default
import Data.List
import Data.List.Extra (firstJust)
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Set qualified as Set
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Traversable (for)
import Language.LSP.Protocol.Capabilities qualified as C
import Language.LSP.Protocol.Lens qualified as L
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Language.LSP.Test.Compat
import Language.LSP.Test.Decoding
import Language.LSP.Test.Exceptions
import Language.LSP.Test.Parsing
import Language.LSP.Test.Server
import Language.LSP.Test.Session
import Language.LSP.VFS
import System.Directory
import System.Environment
import System.FilePath
import System.FilePath.Glob qualified as Glob
import System.IO
import System.Process (CreateProcess, ProcessHandle)

{- | Starts a new session.

 > runSession "hie" fullCaps "path/to/root/dir" $ do
 >   doc <- openDoc "Desktop/simple.hs" "haskell"
 >   diags <- waitForDiagnostics
 >   let pos = Position 12 5
 >       params = TextDocumentPositionParams doc
 >   hover <- request STextdocumentHover params
-}
runSession ::
  -- | The command to run the server.
  String ->
  -- | The capabilities that the client should declare.
  ClientCapabilities ->
  -- | The filepath to the root directory for the session.
  FilePath ->
  -- | The session to run.
  Session a ->
  IO a
runSession :: forall a.
String -> ClientCapabilities -> String -> Session a -> IO a
runSession = SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
forall a.
SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
runSessionWithConfig SessionConfig
forall a. Default a => a
def

-- | Starts a new session with a custom configuration.
runSessionWithConfig ::
  -- | Configuration options for the session.
  SessionConfig ->
  -- | The command to run the server.
  String ->
  -- | The capabilities that the client should declare.
  ClientCapabilities ->
  -- | The filepath to the root directory for the session.
  FilePath ->
  -- | The session to run.
  Session a ->
  IO a
runSessionWithConfig :: forall a.
SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
runSessionWithConfig = (CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> String
-> Session a
-> IO a
forall a.
(CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithConfigCustomProcess CreateProcess -> CreateProcess
forall a. a -> a
id

-- | Starts a new session with a custom configuration and server 'CreateProcess'.
runSessionWithConfigCustomProcess ::
  -- | Tweak the 'CreateProcess' used to start the server.
  (CreateProcess -> CreateProcess) ->
  -- | Configuration options for the session.
  SessionConfig ->
  -- | The command to run the server.
  String ->
  -- | The capabilities that the client should declare.
  ClientCapabilities ->
  -- | The filepath to the root directory for the session.
  FilePath ->
  -- | The session to run.
  Session a ->
  IO a
runSessionWithConfigCustomProcess :: forall a.
(CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithConfigCustomProcess CreateProcess -> CreateProcess
modifyCreateProcess SessionConfig
config' String
serverExe ClientCapabilities
caps String
rootDir Session a
session = do
  SessionConfig
config <- SessionConfig -> IO SessionConfig
envOverrideConfig SessionConfig
config'
  String
-> Bool
-> (CreateProcess -> CreateProcess)
-> (Handle -> Handle -> ProcessHandle -> IO a)
-> IO a
forall a.
String
-> Bool
-> (CreateProcess -> CreateProcess)
-> (Handle -> Handle -> ProcessHandle -> IO a)
-> IO a
withServer String
serverExe (SessionConfig -> Bool
logStdErr SessionConfig
config) CreateProcess -> CreateProcess
modifyCreateProcess ((Handle -> Handle -> ProcessHandle -> IO a) -> IO a)
-> (Handle -> Handle -> ProcessHandle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
serverIn Handle
serverOut ProcessHandle
serverProc ->
    Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' (ProcessHandle -> Maybe ProcessHandle
forall a. a -> Maybe a
Just ProcessHandle
serverProc) Handle
serverIn Handle
serverOut SessionConfig
config ClientCapabilities
caps String
rootDir Session a
session

{- | Starts a new session, using the specified handles to communicate with the
 server. You can use this to host the server within the same process.
 An example with lsp might look like:

 > (hinRead, hinWrite) <- createPipe
 > (houtRead, houtWrite) <- createPipe
 >
 > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition
 > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
 >   -- ...
-}
runSessionWithHandles ::
  -- | The input handle
  Handle ->
  -- | The output handle
  Handle ->
  SessionConfig ->
  -- | The capabilities that the client should declare.
  ClientCapabilities ->
  -- | The filepath to the root directory for the session.
  FilePath ->
  -- | The session to run.
  Session a ->
  IO a
runSessionWithHandles :: forall a.
Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles = Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' Maybe ProcessHandle
forall a. Maybe a
Nothing

runSessionWithHandles' ::
  Maybe ProcessHandle ->
  -- | The input handle
  Handle ->
  -- | The output handle
  Handle ->
  SessionConfig ->
  -- | The capabilities that the client should declare.
  ClientCapabilities ->
  -- | The filepath to the root directory for the session.
  FilePath ->
  -- | The session to run.
  Session a ->
  IO a
runSessionWithHandles' :: forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' Maybe ProcessHandle
serverProc Handle
serverIn Handle
serverOut SessionConfig
config' ClientCapabilities
caps String
rootDir Session a
session = do
  Int
pid <- IO Int
getCurrentProcessID
  String
absRootDir <- String -> IO String
canonicalizePath String
rootDir

  SessionConfig
config <- SessionConfig -> IO SessionConfig
envOverrideConfig SessionConfig
config'

  let initializeParams :: InitializeParams
initializeParams =
        Maybe ProgressToken
-> (Int32 |? Null)
-> Maybe
     (Rec (("name" .== Text) .+ (("version" .== Maybe Text) .+ Empty)))
-> Maybe Text
-> Maybe (Text |? Null)
-> (Uri |? Null)
-> ClientCapabilities
-> Maybe Value
-> Maybe TraceValues
-> Maybe ([WorkspaceFolder] |? Null)
-> InitializeParams
InitializeParams
          Maybe ProgressToken
forall a. Maybe a
Nothing
          -- Narrowing to Int32 here, but it's unlikely that a PID will
          -- be outside the range
          (Int32 -> Int32 |? Null
forall a b. a -> a |? b
InL (Int32 -> Int32 |? Null) -> Int32 -> Int32 |? Null
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pid)
          (Rec ('R '["name" ':-> Text, "version" ':-> Maybe Text])
-> Maybe (Rec ('R '["name" ':-> Text, "version" ':-> Maybe Text]))
forall a. a -> Maybe a
Just Rec (("name" .== Text) .+ ("version" .== Maybe Text))
Rec ('R '["name" ':-> Text, "version" ':-> Maybe Text])
lspTestClientInfo)
          (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
absRootDir)
          Maybe (Text |? Null)
forall a. Maybe a
Nothing
          (Uri -> Uri |? Null
forall a b. a -> a |? b
InL (Uri -> Uri |? Null) -> Uri -> Uri |? Null
forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
absRootDir)
          ClientCapabilities
caps
          -- TODO: make this configurable?
          (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ SessionConfig -> Object
lspConfig SessionConfig
config')
          (TraceValues -> Maybe TraceValues
forall a. a -> Maybe a
Just TraceValues
TraceValues_Off)
          (([WorkspaceFolder] -> [WorkspaceFolder] |? Null)
-> Maybe [WorkspaceFolder] -> Maybe ([WorkspaceFolder] |? Null)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [WorkspaceFolder] -> [WorkspaceFolder] |? Null
forall a b. a -> a |? b
InL (Maybe [WorkspaceFolder] -> Maybe ([WorkspaceFolder] |? Null))
-> Maybe [WorkspaceFolder] -> Maybe ([WorkspaceFolder] |? Null)
forall a b. (a -> b) -> a -> b
$ SessionConfig -> Maybe [WorkspaceFolder]
initialWorkspaceFolders SessionConfig
config)
  Handle
-> Handle
-> Maybe ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
forall a.
Handle
-> Handle
-> Maybe ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
runSession' Handle
serverIn Handle
serverOut Maybe ProcessHandle
serverProc Handle -> SessionContext -> IO ()
listenServer SessionConfig
config ClientCapabilities
caps String
rootDir Session ()
exitServer (Session a -> IO a) -> Session a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    -- Wrap the session around initialize and shutdown calls
    LspId 'Method_Initialize
initReqId <- SClientMethod 'Method_Initialize
-> MessageParams 'Method_Initialize
-> Session (LspId 'Method_Initialize)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod 'Method_Initialize
SMethod_Initialize MessageParams 'Method_Initialize
InitializeParams
initializeParams

    -- Because messages can be sent in between the request and response,
    -- collect them and then...
    ([FromServerMessage]
inBetween, TResponseMessage 'Method_Initialize
initRspMsg) <- Session FromServerMessage
-> Session (TResponseMessage 'Method_Initialize)
-> Session
     ([FromServerMessage], TResponseMessage 'Method_Initialize)
forall (m :: * -> *) a end.
Alternative m =>
m a -> m end -> m ([a], end)
manyTill_ Session FromServerMessage
anyMessage (SClientMethod 'Method_Initialize
-> LspId 'Method_Initialize
-> Session (TResponseMessage 'Method_Initialize)
forall (m :: Method 'ClientToServer 'Request).
SMethod m -> LspId m -> Session (TResponseMessage m)
responseForId SClientMethod 'Method_Initialize
SMethod_Initialize LspId 'Method_Initialize
initReqId)

    case TResponseMessage 'Method_Initialize
initRspMsg TResponseMessage 'Method_Initialize
-> Getting
     (Either ResponseError InitializeResult)
     (TResponseMessage 'Method_Initialize)
     (Either ResponseError InitializeResult)
-> Either ResponseError InitializeResult
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError InitializeResult)
  (TResponseMessage 'Method_Initialize)
  (Either ResponseError InitializeResult)
forall s a. HasResult s a => Lens' s a
Lens'
  (TResponseMessage 'Method_Initialize)
  (Either ResponseError InitializeResult)
L.result of
      Left ResponseError
error -> IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String
"Error while initializing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ResponseError -> String
forall a. Show a => a -> String
show ResponseError
error)
      Right InitializeResult
_ -> () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    MVar (TResponseMessage 'Method_Initialize)
initRspVar <- SessionContext -> MVar (TResponseMessage 'Method_Initialize)
initRsp (SessionContext -> MVar (TResponseMessage 'Method_Initialize))
-> Session SessionContext
-> Session (MVar (TResponseMessage 'Method_Initialize))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
    IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ MVar (TResponseMessage 'Method_Initialize)
-> TResponseMessage 'Method_Initialize -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (TResponseMessage 'Method_Initialize)
initRspVar TResponseMessage 'Method_Initialize
initRspMsg
    SClientMethod 'Method_Initialized
-> MessageParams 'Method_Initialized -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Method_Initialized
SMethod_Initialized MessageParams 'Method_Initialized
InitializedParams
InitializedParams

    -- ... relay them back to the user Session so they can match on them!
    -- As long as they are allowed.
    [FromServerMessage]
-> (FromServerMessage -> Session ()) -> Session ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FromServerMessage]
inBetween FromServerMessage -> Session ()
checkLegalBetweenMessage
    Chan SessionMessage
msgChan <- (SessionContext -> Chan SessionMessage)
-> Session (Chan SessionMessage)
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> Chan SessionMessage
messageChan
    IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ Chan SessionMessage -> [SessionMessage] -> IO ()
forall a. Chan a -> [a] -> IO ()
writeList2Chan Chan SessionMessage
msgChan (FromServerMessage -> SessionMessage
ServerMessage (FromServerMessage -> SessionMessage)
-> [FromServerMessage] -> [SessionMessage]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FromServerMessage]
inBetween)

    -- Run the actual test
    Session a
session
 where
  -- \| Asks the server to shutdown and exit politely
  exitServer :: Session ()
  exitServer :: Session ()
exitServer = SClientMethod 'Method_Shutdown
-> MessageParams 'Method_Shutdown -> Session ()
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session ()
request_ SClientMethod 'Method_Shutdown
SMethod_Shutdown Maybe Void
MessageParams 'Method_Shutdown
forall a. Maybe a
Nothing Session () -> Session () -> Session ()
forall a b. Session a -> Session b -> Session b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SClientMethod 'Method_Exit
-> MessageParams 'Method_Exit -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Method_Exit
SMethod_Exit Maybe Void
MessageParams 'Method_Exit
forall a. Maybe a
Nothing

  -- \| Listens to the server output until the shutdown ACK,
  -- makes sure it matches the record and signals any semaphores
  listenServer :: Handle -> SessionContext -> IO ()
  listenServer :: Handle -> SessionContext -> IO ()
listenServer Handle
serverOut SessionContext
context = do
    ByteString
msgBytes <- Handle -> IO ByteString
getNextMessage Handle
serverOut

    FromServerMessage
msg <- MVar RequestMap
-> (RequestMap -> IO (RequestMap, FromServerMessage))
-> IO FromServerMessage
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (SessionContext -> MVar RequestMap
requestMap SessionContext
context) ((RequestMap -> IO (RequestMap, FromServerMessage))
 -> IO FromServerMessage)
-> (RequestMap -> IO (RequestMap, FromServerMessage))
-> IO FromServerMessage
forall a b. (a -> b) -> a -> b
$ \RequestMap
reqMap ->
      (RequestMap, FromServerMessage)
-> IO (RequestMap, FromServerMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((RequestMap, FromServerMessage)
 -> IO (RequestMap, FromServerMessage))
-> (RequestMap, FromServerMessage)
-> IO (RequestMap, FromServerMessage)
forall a b. (a -> b) -> a -> b
$ RequestMap -> ByteString -> (RequestMap, FromServerMessage)
decodeFromServerMsg RequestMap
reqMap ByteString
msgBytes
    Chan SessionMessage -> SessionMessage -> IO ()
forall a. Chan a -> a -> IO ()
writeChan (SessionContext -> Chan SessionMessage
messageChan SessionContext
context) (FromServerMessage -> SessionMessage
ServerMessage FromServerMessage
msg)

    case FromServerMessage
msg of
      (FromServerRsp SMethod m
SMethod_Shutdown TResponseMessage m
_) -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      FromServerMessage
_ -> Handle -> SessionContext -> IO ()
listenServer Handle
serverOut SessionContext
context

  -- \| Is this message allowed to be sent by the server between the intialize
  -- request and response?
  -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
  checkLegalBetweenMessage :: FromServerMessage -> Session ()
  checkLegalBetweenMessage :: FromServerMessage -> Session ()
checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowShowMessage TMessage m
_) = () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowLogMessage TMessage m
_) = () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_TelemetryEvent TMessage m
_) = () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowShowMessageRequest TMessage m
_) = () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage FromServerMessage
msg = SessionException -> Session ()
forall a e. Exception e => e -> a
throw (FromServerMessage -> SessionException
IllegalInitSequenceMessage FromServerMessage
msg)

-- | Check environment variables to override the config
envOverrideConfig :: SessionConfig -> IO SessionConfig
envOverrideConfig :: SessionConfig -> IO SessionConfig
envOverrideConfig SessionConfig
cfg = do
  Bool
logMessages' <- Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (SessionConfig -> Bool
logMessages SessionConfig
cfg) (Maybe Bool -> Bool) -> IO (Maybe Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Bool)
checkEnv String
"LSP_TEST_LOG_MESSAGES"
  Bool
logStdErr' <- Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (SessionConfig -> Bool
logStdErr SessionConfig
cfg) (Maybe Bool -> Bool) -> IO (Maybe Bool) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Bool)
checkEnv String
"LSP_TEST_LOG_STDERR"
  SessionConfig -> IO SessionConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionConfig -> IO SessionConfig)
-> SessionConfig -> IO SessionConfig
forall a b. (a -> b) -> a -> b
$ SessionConfig
cfg{logMessages = logMessages', logStdErr = logStdErr'}
 where
  checkEnv :: String -> IO (Maybe Bool)
  checkEnv :: String -> IO (Maybe Bool)
checkEnv String
s = (String -> Bool) -> Maybe String -> Maybe Bool
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
convertVal (Maybe String -> Maybe Bool)
-> IO (Maybe String) -> IO (Maybe Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
s
  convertVal :: a -> Bool
convertVal a
"0" = Bool
False
  convertVal a
_ = Bool
True

-- | The current text contents of a document.
documentContents :: TextDocumentIdentifier -> Session T.Text
documentContents :: TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc = do
  VFS
vfs <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let Just VirtualFile
file = VFS
vfs VFS
-> Getting (Maybe VirtualFile) VFS (Maybe VirtualFile)
-> Maybe VirtualFile
forall s a. s -> Getting a s a -> a
^. (Map NormalizedUri VirtualFile
 -> Const (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> VFS -> Const (Maybe VirtualFile) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
  -> Const (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
 -> VFS -> Const (Maybe VirtualFile) VFS)
-> ((Maybe VirtualFile
     -> Const (Maybe VirtualFile) (Maybe VirtualFile))
    -> Map NormalizedUri VirtualFile
    -> Const (Maybe VirtualFile) (Map NormalizedUri VirtualFile))
-> Getting (Maybe VirtualFile) VFS (Maybe VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Lens'
     (Map NormalizedUri VirtualFile)
     (Maybe (IxValue (Map NormalizedUri VirtualFile)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Uri -> NormalizedUri
toNormalizedUri (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
L.uri))
  Text -> Session Text
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (VirtualFile -> Text
virtualFileText VirtualFile
file)

{- | Parses an ApplyEditRequest, checks that it is for the passed document
 and returns the new content
-}
getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
getDocumentEdit :: TextDocumentIdentifier -> Session Text
getDocumentEdit TextDocumentIdentifier
doc = do
  TRequestMessage 'Method_WorkspaceApplyEdit
req <- SServerMethod 'Method_WorkspaceApplyEdit
-> Session (TMessage 'Method_WorkspaceApplyEdit)
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit

  Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (TRequestMessage 'Method_WorkspaceApplyEdit -> Bool
checkDocumentChanges TRequestMessage 'Method_WorkspaceApplyEdit
req Bool -> Bool -> Bool
|| TRequestMessage 'Method_WorkspaceApplyEdit -> Bool
checkChanges TRequestMessage 'Method_WorkspaceApplyEdit
req) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$
    IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$
      SessionException -> IO ()
forall a e. Exception e => e -> a
throw (String -> SessionException
IncorrectApplyEditRequest (TRequestMessage 'Method_WorkspaceApplyEdit -> String
forall a. Show a => a -> String
show TRequestMessage 'Method_WorkspaceApplyEdit
req))

  TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc
 where
  checkDocumentChanges :: TRequestMessage 'Method_WorkspaceApplyEdit -> Bool
checkDocumentChanges TRequestMessage 'Method_WorkspaceApplyEdit
req =
    let changes :: Maybe [DocumentChange]
changes = TRequestMessage 'Method_WorkspaceApplyEdit
req TRequestMessage 'Method_WorkspaceApplyEdit
-> Getting
     (Maybe [DocumentChange])
     (TRequestMessage 'Method_WorkspaceApplyEdit)
     (Maybe [DocumentChange])
-> Maybe [DocumentChange]
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> TRequestMessage 'Method_WorkspaceApplyEdit
-> Const
     (Maybe [DocumentChange])
     (TRequestMessage 'Method_WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_WorkspaceApplyEdit)
  ApplyWorkspaceEditParams
L.params ((ApplyWorkspaceEditParams
  -> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
 -> TRequestMessage 'Method_WorkspaceApplyEdit
 -> Const
      (Maybe [DocumentChange])
      (TRequestMessage 'Method_WorkspaceApplyEdit))
-> ((Maybe [DocumentChange]
     -> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
    -> ApplyWorkspaceEditParams
    -> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> Getting
     (Maybe [DocumentChange])
     (TRequestMessage 'Method_WorkspaceApplyEdit)
     (Maybe [DocumentChange])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
Lens' ApplyWorkspaceEditParams WorkspaceEdit
L.edit ((WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
 -> ApplyWorkspaceEditParams
 -> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> ((Maybe [DocumentChange]
     -> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
    -> WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
-> (Maybe [DocumentChange]
    -> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
-> ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [DocumentChange]
 -> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
-> WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit
forall s a. HasDocumentChanges s a => Lens' s a
Lens' WorkspaceEdit (Maybe [DocumentChange])
L.documentChanges
        maybeDocs :: Maybe [Uri]
maybeDocs = ([DocumentChange] -> [Uri])
-> Maybe [DocumentChange] -> Maybe [Uri]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DocumentChange -> Uri) -> [DocumentChange] -> [Uri]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocumentChange -> Uri
documentChangeUri) Maybe [DocumentChange]
changes
     in case Maybe [Uri]
maybeDocs of
          Just [Uri]
docs -> (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
L.uri) Uri -> [Uri] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Uri]
docs
          Maybe [Uri]
Nothing -> Bool
False
  checkChanges :: TRequestMessage 'Method_WorkspaceApplyEdit -> Bool
checkChanges TRequestMessage 'Method_WorkspaceApplyEdit
req =
    let mMap :: Maybe (Map Uri [TextEdit])
mMap = TRequestMessage 'Method_WorkspaceApplyEdit
req TRequestMessage 'Method_WorkspaceApplyEdit
-> Getting
     (Maybe (Map Uri [TextEdit]))
     (TRequestMessage 'Method_WorkspaceApplyEdit)
     (Maybe (Map Uri [TextEdit]))
-> Maybe (Map Uri [TextEdit])
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> TRequestMessage 'Method_WorkspaceApplyEdit
-> Const
     (Maybe (Map Uri [TextEdit]))
     (TRequestMessage 'Method_WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_WorkspaceApplyEdit)
  ApplyWorkspaceEditParams
L.params ((ApplyWorkspaceEditParams
  -> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
 -> TRequestMessage 'Method_WorkspaceApplyEdit
 -> Const
      (Maybe (Map Uri [TextEdit]))
      (TRequestMessage 'Method_WorkspaceApplyEdit))
-> ((Maybe (Map Uri [TextEdit])
     -> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
    -> ApplyWorkspaceEditParams
    -> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> Getting
     (Maybe (Map Uri [TextEdit]))
     (TRequestMessage 'Method_WorkspaceApplyEdit)
     (Maybe (Map Uri [TextEdit]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
Lens' ApplyWorkspaceEditParams WorkspaceEdit
L.edit ((WorkspaceEdit
  -> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
 -> ApplyWorkspaceEditParams
 -> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> ((Maybe (Map Uri [TextEdit])
     -> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
    -> WorkspaceEdit
    -> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
-> (Maybe (Map Uri [TextEdit])
    -> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
-> ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Map Uri [TextEdit])
 -> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
-> WorkspaceEdit
-> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit
forall s a. HasChanges s a => Lens' s a
Lens' WorkspaceEdit (Maybe (Map Uri [TextEdit]))
L.changes
     in Bool
-> (Map Uri [TextEdit] -> Bool)
-> Maybe (Map Uri [TextEdit])
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Uri -> Map Uri [TextEdit] -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (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
L.uri)) Maybe (Map Uri [TextEdit])
mMap

{- | Sends a request to the server and waits for its response.
 Will skip any messages in between the request and the response
 @
 rsp <- request STextDocumentDocumentSymbol params
 @
 Note: will skip any messages in between the request and the response.
-}
request :: SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request :: forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod m
m = SClientMethod m -> MessageParams m -> Session (LspId m)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod m
m (MessageParams m -> Session (LspId m))
-> (LspId m -> Session (TResponseMessage m))
-> MessageParams m
-> Session (TResponseMessage m)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Session FromServerMessage
-> Session (TResponseMessage m) -> Session (TResponseMessage m)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (Session (TResponseMessage m) -> Session (TResponseMessage m))
-> (LspId m -> Session (TResponseMessage m))
-> LspId m
-> Session (TResponseMessage m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SClientMethod m -> LspId m -> Session (TResponseMessage m)
forall (m :: Method 'ClientToServer 'Request).
SMethod m -> LspId m -> Session (TResponseMessage m)
responseForId SClientMethod m
m

-- | The same as 'sendRequest', but discard the response.
request_ :: SClientMethod (m :: Method ClientToServer Request) -> MessageParams m -> Session ()
request_ :: forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session ()
request_ SClientMethod m
p = Session (TResponseMessage m) -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Session (TResponseMessage m) -> Session ())
-> (MessageParams m -> Session (TResponseMessage m))
-> MessageParams m
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod m
p

-- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
sendRequest ::
  -- | The request method.
  SClientMethod m ->
  -- | The request parameters.
  MessageParams m ->
  -- | The id of the request that was sent.
  Session (LspId m)
sendRequest :: forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod m
method MessageParams m
params = do
  Int32
idn <- SessionState -> Int32
curReqId (SessionState -> Int32) -> Session SessionState -> Session Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> Session ())
-> (SessionState -> SessionState) -> Session ()
forall a b. (a -> b) -> a -> b
$ \SessionState
c -> SessionState
c{curReqId = idn + 1}
  let id :: LspId m
id = Int32 -> LspId m
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
idn

  let mess :: TRequestMessage m
mess = Text
-> LspId m
-> SClientMethod m
-> MessageParams m
-> TRequestMessage m
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"2.0" LspId m
id SClientMethod m
method MessageParams m
params

  -- Update the request map
  MVar RequestMap
reqMap <- SessionContext -> MVar RequestMap
requestMap (SessionContext -> MVar RequestMap)
-> Session SessionContext -> Session (MVar RequestMap)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
  IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$
    MVar RequestMap -> (RequestMap -> IO RequestMap) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar RequestMap
reqMap ((RequestMap -> IO RequestMap) -> IO ())
-> (RequestMap -> IO RequestMap) -> IO ()
forall a b. (a -> b) -> a -> b
$
      \RequestMap
r -> RequestMap -> IO RequestMap
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestMap -> IO RequestMap) -> RequestMap -> IO RequestMap
forall a b. (a -> b) -> a -> b
$ Maybe RequestMap -> RequestMap
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe RequestMap -> RequestMap) -> Maybe RequestMap -> RequestMap
forall a b. (a -> b) -> a -> b
$ RequestMap -> LspId m -> SClientMethod m -> Maybe RequestMap
forall (m :: Method 'ClientToServer 'Request).
RequestMap -> LspId m -> SClientMethod m -> Maybe RequestMap
updateRequestMap RequestMap
r LspId m
id SClientMethod m
method

  ~() <- case SClientMethod m -> ClientNotOrReq m
forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
method of
    ClientNotOrReq m
IsClientReq -> TRequestMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage TRequestMessage m
mess
    ClientNotOrReq m
IsClientEither -> TCustomMessage s 'ClientToServer 'Request -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (TCustomMessage s 'ClientToServer 'Request -> Session ())
-> TCustomMessage s 'ClientToServer 'Request -> Session ()
forall a b. (a -> b) -> a -> b
$ TRequestMessage ('Method_CustomMethod s)
-> TCustomMessage s 'ClientToServer 'Request
forall (s :: Symbol) (f :: MessageDirection).
TRequestMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Request
ReqMess TRequestMessage m
TRequestMessage ('Method_CustomMethod s)
mess

  LspId m -> Session (LspId m)
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return LspId m
id

-- | Sends a notification to the server.
sendNotification ::
  -- | The notification method.
  SClientMethod (m :: Method ClientToServer Notification) ->
  -- | The notification parameters.
  MessageParams m ->
  Session ()
-- Open a virtual file if we send a did open text document notification
sendNotification :: forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod m
SMethod_TextDocumentDidOpen MessageParams m
params = do
  let n :: TNotificationMessage 'Method_TextDocumentDidOpen
n = Text
-> SMethod 'Method_TextDocumentDidOpen
-> MessageParams 'Method_TextDocumentDidOpen
-> TNotificationMessage 'Method_TextDocumentDidOpen
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen MessageParams m
MessageParams 'Method_TextDocumentDidOpen
params
  VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = (State VFS () -> VFS -> VFS) -> VFS -> State VFS () -> VFS
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState VFS
oldVFS (State VFS () -> VFS) -> State VFS () -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> m ()
openVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidOpen
TNotificationMessage 'Method_TextDocumentDidOpen
n
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs = newVFS})
  TNotificationMessage 'Method_TextDocumentDidOpen -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage TNotificationMessage 'Method_TextDocumentDidOpen
n

-- Close a virtual file if we send a close text document notification
sendNotification SMethod m
SMethod_TextDocumentDidClose MessageParams m
params = do
  let n :: TNotificationMessage 'Method_TextDocumentDidClose
n = Text
-> SMethod 'Method_TextDocumentDidClose
-> MessageParams 'Method_TextDocumentDidClose
-> TNotificationMessage 'Method_TextDocumentDidClose
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose MessageParams m
MessageParams 'Method_TextDocumentDidClose
params
  VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = (State VFS () -> VFS -> VFS) -> VFS -> State VFS () -> VFS
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState VFS
oldVFS (State VFS () -> VFS) -> State VFS () -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> m ()
closeVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidClose
TNotificationMessage 'Method_TextDocumentDidClose
n
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs = newVFS})
  TNotificationMessage 'Method_TextDocumentDidClose -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage TNotificationMessage 'Method_TextDocumentDidClose
n
sendNotification SMethod m
SMethod_TextDocumentDidChange MessageParams m
params = do
  let n :: TNotificationMessage 'Method_TextDocumentDidChange
n = Text
-> SMethod 'Method_TextDocumentDidChange
-> MessageParams 'Method_TextDocumentDidChange
-> TNotificationMessage 'Method_TextDocumentDidChange
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange MessageParams m
MessageParams 'Method_TextDocumentDidChange
params
  VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = (State VFS () -> VFS -> VFS) -> VFS -> State VFS () -> VFS
forall a b c. (a -> b -> c) -> b -> a -> c
flip State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState VFS
oldVFS (State VFS () -> VFS) -> State VFS () -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> m ()
changeFromClientVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidChange
TNotificationMessage 'Method_TextDocumentDidChange
n
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs = newVFS})
  TNotificationMessage 'Method_TextDocumentDidChange -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage TNotificationMessage 'Method_TextDocumentDidChange
n
sendNotification SMethod m
method MessageParams m
params =
  case SMethod m -> ClientNotOrReq m
forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SMethod m
method of
    ClientNotOrReq m
IsClientNot -> TNotificationMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (Text -> SMethod m -> MessageParams m -> TNotificationMessage m
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod m
method MessageParams m
params)
    ClientNotOrReq m
IsClientEither -> TCustomMessage s 'ClientToServer 'Notification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s 'ClientToServer 'Notification
forall (s :: Symbol) (f :: MessageDirection).
TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Notification
NotMess (TNotificationMessage ('Method_CustomMethod s)
 -> TCustomMessage s 'ClientToServer 'Notification)
-> TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s 'ClientToServer 'Notification
forall a b. (a -> b) -> a -> b
$ Text
-> SMethod ('Method_CustomMethod s)
-> MessageParams ('Method_CustomMethod s)
-> TNotificationMessage ('Method_CustomMethod s)
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod m
SMethod ('Method_CustomMethod s)
method MessageParams m
MessageParams ('Method_CustomMethod s)
params)

-- | Sends a response to the server.
sendResponse :: (ToJSON (MessageResult m), ToJSON (ErrorData m)) => TResponseMessage m -> Session ()
sendResponse :: forall {f :: MessageDirection} (m :: Method f 'Request).
(ToJSON (MessageResult m), ToJSON (ErrorData m)) =>
TResponseMessage m -> Session ()
sendResponse = TResponseMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage

{- | Returns the initialize response that was received from the server.
 The initialize requests and responses are not included the session,
 so if you need to test it use this.
-}
initializeResponse :: Session (TResponseMessage Method_Initialize)
initializeResponse :: Session (TResponseMessage 'Method_Initialize)
initializeResponse = Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask Session SessionContext
-> (SessionContext
    -> Session (TResponseMessage 'Method_Initialize))
-> Session (TResponseMessage 'Method_Initialize)
forall a b. Session a -> (a -> Session b) -> Session b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (TResponseMessage 'Method_Initialize)
-> Session (TResponseMessage 'Method_Initialize)
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TResponseMessage 'Method_Initialize)
 -> Session (TResponseMessage 'Method_Initialize))
-> (MVar (TResponseMessage 'Method_Initialize)
    -> IO (TResponseMessage 'Method_Initialize))
-> MVar (TResponseMessage 'Method_Initialize)
-> Session (TResponseMessage 'Method_Initialize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (TResponseMessage 'Method_Initialize)
-> IO (TResponseMessage 'Method_Initialize)
forall a. MVar a -> IO a
readMVar) (MVar (TResponseMessage 'Method_Initialize)
 -> Session (TResponseMessage 'Method_Initialize))
-> (SessionContext -> MVar (TResponseMessage 'Method_Initialize))
-> SessionContext
-> Session (TResponseMessage 'Method_Initialize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionContext -> MVar (TResponseMessage 'Method_Initialize)
initRsp

setIgnoringLogNotifications :: Bool -> Session ()
setIgnoringLogNotifications :: Bool -> Session ()
setIgnoringLogNotifications Bool
value = do
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{ignoringLogNotifications = value})

setIgnoringConfigurationRequests :: Bool -> Session ()
setIgnoringConfigurationRequests :: Bool -> Session ()
setIgnoringConfigurationRequests Bool
value = do
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{ignoringConfigurationRequests = value})

setIgnoringRegistrationRequests :: Bool -> Session ()
setIgnoringRegistrationRequests :: Bool -> Session ()
setIgnoringRegistrationRequests Bool
value = do
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{ignoringRegistrationRequests = value})

{- | Modify the client config. This will send a notification to the server that the
 config has changed.
-}
modifyConfig :: (Object -> Object) -> Session ()
modifyConfig :: (Object -> Object) -> Session ()
modifyConfig Object -> Object
f = do
  Object
oldConfig <- SessionState -> Object
curLspConfig (SessionState -> Object) -> Session SessionState -> Session Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let newConfig :: Object
newConfig = Object -> Object
f Object
oldConfig
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{curLspConfig = newConfig})

  -- We're going to be difficult and follow the new direction of the spec as much
  -- as possible. That means _not_ sending didChangeConfiguration notifications
  -- unless the server has registered for them
  [SomeRegistration]
registeredCaps <- Session [SomeRegistration]
getRegisteredCapabilities
  let
    requestedSections :: Maybe [T.Text]
    requestedSections :: Maybe [Text]
requestedSections = ((SomeRegistration -> Maybe [Text])
 -> [SomeRegistration] -> Maybe [Text])
-> [SomeRegistration]
-> (SomeRegistration -> Maybe [Text])
-> Maybe [Text]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (SomeRegistration -> Maybe [Text])
-> [SomeRegistration] -> Maybe [Text]
forall a b. (a -> Maybe b) -> [a] -> Maybe b
firstJust [SomeRegistration]
registeredCaps ((SomeRegistration -> Maybe [Text]) -> Maybe [Text])
-> (SomeRegistration -> Maybe [Text]) -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ \(SomeRegistration (TRegistration Text
_ SClientMethod m
regMethod Maybe (RegistrationOptions m)
regOpts)) ->
      case SClientMethod m
regMethod of
        SClientMethod m
SMethod_WorkspaceDidChangeConfiguration -> case Maybe (RegistrationOptions m)
regOpts of
          Just (DidChangeConfigurationRegistrationOptions{$sel:_section:DidChangeConfigurationRegistrationOptions :: DidChangeConfigurationRegistrationOptions -> Maybe (Text |? [Text])
_section = Maybe (Text |? [Text])
section}) -> case Maybe (Text |? [Text])
section of
            Just (InL Text
s) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
s]
            Just (InR [Text]
ss) -> [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text]
ss
            Maybe (Text |? [Text])
Nothing -> Maybe [Text]
forall a. Maybe a
Nothing
          Maybe (RegistrationOptions m)
_ -> Maybe [Text]
forall a. Maybe a
Nothing
        SClientMethod m
_ -> Maybe [Text]
forall a. Maybe a
Nothing
    requestedSectionKeys :: Maybe [J.Key]
    requestedSectionKeys :: Maybe [Key]
requestedSectionKeys = (([Text] -> [Key]) -> Maybe [Text] -> Maybe [Key]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Text] -> [Key]) -> Maybe [Text] -> Maybe [Key])
-> ((Text -> Key) -> [Text] -> [Key])
-> (Text -> Key)
-> Maybe [Text]
-> Maybe [Key]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Key) -> [Text] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (String -> Key
forall a. IsString a => String -> a
fromString (String -> Key) -> (Text -> String) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Maybe [Text]
requestedSections
  let configToSend :: Value
configToSend = case Maybe [Key]
requestedSectionKeys of
        Just [Key]
ss -> Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> Bool) -> Object -> Object
forall v. (Key -> v -> Bool) -> KeyMap v -> KeyMap v
J.filterWithKey (\Key
k Value
_ -> Key
k Key -> [Key] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Key]
ss) Object
newConfig
        Maybe [Key]
Nothing -> Object -> Value
Object Object
newConfig
  SClientMethod 'Method_WorkspaceDidChangeConfiguration
-> MessageParams 'Method_WorkspaceDidChangeConfiguration
-> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Method_WorkspaceDidChangeConfiguration
SMethod_WorkspaceDidChangeConfiguration (MessageParams 'Method_WorkspaceDidChangeConfiguration
 -> Session ())
-> MessageParams 'Method_WorkspaceDidChangeConfiguration
-> Session ()
forall a b. (a -> b) -> a -> b
$ Value -> DidChangeConfigurationParams
DidChangeConfigurationParams Value
configToSend

{- | Set the client config. This will send a notification to the server that the
 config has changed.
-}
setConfig :: Object -> Session ()
setConfig :: Object -> Session ()
setConfig Object
newConfig = (Object -> Object) -> Session ()
modifyConfig (Object -> Object -> Object
forall a b. a -> b -> a
const Object
newConfig)

{- | Modify a client config section (if already present, otherwise does nothing).
 This will send a notification to the server that the config has changed.
-}
modifyConfigSection :: String -> (Value -> Value) -> Session ()
modifyConfigSection :: String -> (Value -> Value) -> Session ()
modifyConfigSection String
section Value -> Value
f = (Object -> Object) -> Session ()
modifyConfig (\Object
o -> Object
o Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (String -> Key
forall a. IsString a => String -> a
fromString String
section) ((Value -> Identity Value) -> Object -> Identity Object)
-> (Value -> Value) -> Object -> Object
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Value -> Value
f)

{- | Set a client config section. This will send a notification to the server that the
 config has changed.
-}
setConfigSection :: String -> Value -> Session ()
setConfigSection :: String -> Value -> Session ()
setConfigSection String
section Value
settings = (Object -> Object) -> Session ()
modifyConfig (\Object
o -> Object
o Object -> (Object -> Object) -> Object
forall a b. a -> (a -> b) -> b
& Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (String -> Key
forall a. IsString a => String -> a
fromString String
section) ((Maybe Value -> Identity (Maybe Value))
 -> Object -> Identity Object)
-> Value -> Object -> Object
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Value
settings)

{- | /Creates/ a new text document. This is different from 'openDoc'
 as it sends a workspace/didChangeWatchedFiles notification letting the server
 know that a file was created within the workspace, __provided that the server
 has registered for it__, and the file matches any patterns the server
 registered for.
 It /does not/ actually create a file on disk, but is useful for convincing
 the server that one does exist.

 @since 11.0.0.0
-}
createDoc ::
  -- | The path to the document to open, __relative to the root directory__.
  FilePath ->
  -- | The text document's language identifier, e.g. @"haskell"@.
  T.Text ->
  -- | The content of the text document to create.
  T.Text ->
  -- | The identifier of the document just created.
  Session TextDocumentIdentifier
createDoc :: String -> Text -> Text -> Session TextDocumentIdentifier
createDoc String
file Text
languageId Text
contents = do
  Map Text SomeRegistration
dynCaps <- SessionState -> Map Text SomeRegistration
curDynCaps (SessionState -> Map Text SomeRegistration)
-> Session SessionState -> Session (Map Text SomeRegistration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  String
rootDir <- (SessionContext -> String) -> Session String
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> String
rootDir
  ClientCapabilities
caps <- (SessionContext -> ClientCapabilities)
-> Session ClientCapabilities
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities
  String
absFile <- IO String -> Session String
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Session String) -> IO String -> Session String
forall a b. (a -> b) -> a -> b
$ String -> IO String
canonicalizePath (String
rootDir String -> String -> String
</> String
file)
  let pred :: SomeRegistration -> [TRegistration Method_WorkspaceDidChangeWatchedFiles]
      pred :: SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
pred (SomeRegistration r :: TRegistration m
r@(TRegistration Text
_ SMethod m
SMethod_WorkspaceDidChangeWatchedFiles Maybe (RegistrationOptions m)
_)) = [TRegistration m
TRegistration 'Method_WorkspaceDidChangeWatchedFiles
r]
      pred SomeRegistration
_ = [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
forall a. Monoid a => a
mempty
      regs :: [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
regs = (SomeRegistration
 -> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles])
-> [SomeRegistration]
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
pred ([SomeRegistration]
 -> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles])
-> [SomeRegistration]
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
forall a b. (a -> b) -> a -> b
$ Map Text SomeRegistration -> [SomeRegistration]
forall k a. Map k a -> [a]
Map.elems Map Text SomeRegistration
dynCaps
      watchHits :: FileSystemWatcher -> Bool
      watchHits :: FileSystemWatcher -> Bool
watchHits (FileSystemWatcher (GlobPattern (InL (Pattern Text
pattern))) Maybe WatchKind
kind) =
        -- If WatchKind is excluded, defaults to all true as per spec
        String -> Bool
fileMatches (Text -> String
T.unpack Text
pattern) Bool -> Bool -> Bool
&& WatchKind -> Bool
containsCreate (WatchKind -> Maybe WatchKind -> WatchKind
forall a. a -> Maybe a -> a
fromMaybe WatchKind
WatchKind_Create Maybe WatchKind
kind)
      -- TODO: Relative patterns
      watchHits FileSystemWatcher
_ = Bool
False

      fileMatches :: String -> Bool
fileMatches String
pattern = Pattern -> String -> Bool
Glob.match (String -> Pattern
Glob.compile String
pattern) String
relOrAbs
       where
        -- If the pattern is absolute then match against the absolute fp
        relOrAbs :: String
relOrAbs
          | String -> Bool
isAbsolute String
pattern = String
absFile
          | Bool
otherwise = String
file

      regHits :: TRegistration Method_WorkspaceDidChangeWatchedFiles -> Bool
      regHits :: TRegistration 'Method_WorkspaceDidChangeWatchedFiles -> Bool
regHits TRegistration 'Method_WorkspaceDidChangeWatchedFiles
reg = (Bool -> FileSystemWatcher -> Bool)
-> Bool -> [FileSystemWatcher] -> Bool
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Bool
acc FileSystemWatcher
w -> Bool
acc Bool -> Bool -> Bool
|| FileSystemWatcher -> Bool
watchHits FileSystemWatcher
w) Bool
False (TRegistration 'Method_WorkspaceDidChangeWatchedFiles
reg TRegistration 'Method_WorkspaceDidChangeWatchedFiles
-> Getting
     [FileSystemWatcher]
     (TRegistration 'Method_WorkspaceDidChangeWatchedFiles)
     [FileSystemWatcher]
-> [FileSystemWatcher]
forall s a. s -> Getting a s a -> a
^. (Maybe DidChangeWatchedFilesRegistrationOptions
 -> Const
      [FileSystemWatcher]
      (Maybe DidChangeWatchedFilesRegistrationOptions))
-> TRegistration 'Method_WorkspaceDidChangeWatchedFiles
-> Const
     [FileSystemWatcher]
     (TRegistration 'Method_WorkspaceDidChangeWatchedFiles)
forall s a. HasRegisterOptions s a => Lens' s a
Lens'
  (TRegistration 'Method_WorkspaceDidChangeWatchedFiles)
  (Maybe DidChangeWatchedFilesRegistrationOptions)
L.registerOptions ((Maybe DidChangeWatchedFilesRegistrationOptions
  -> Const
       [FileSystemWatcher]
       (Maybe DidChangeWatchedFilesRegistrationOptions))
 -> TRegistration 'Method_WorkspaceDidChangeWatchedFiles
 -> Const
      [FileSystemWatcher]
      (TRegistration 'Method_WorkspaceDidChangeWatchedFiles))
-> (([FileSystemWatcher]
     -> Const [FileSystemWatcher] [FileSystemWatcher])
    -> Maybe DidChangeWatchedFilesRegistrationOptions
    -> Const
         [FileSystemWatcher]
         (Maybe DidChangeWatchedFilesRegistrationOptions))
-> Getting
     [FileSystemWatcher]
     (TRegistration 'Method_WorkspaceDidChangeWatchedFiles)
     [FileSystemWatcher]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DidChangeWatchedFilesRegistrationOptions
 -> Const
      [FileSystemWatcher] DidChangeWatchedFilesRegistrationOptions)
-> Maybe DidChangeWatchedFilesRegistrationOptions
-> Const
     [FileSystemWatcher]
     (Maybe DidChangeWatchedFilesRegistrationOptions)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((DidChangeWatchedFilesRegistrationOptions
  -> Const
       [FileSystemWatcher] DidChangeWatchedFilesRegistrationOptions)
 -> Maybe DidChangeWatchedFilesRegistrationOptions
 -> Const
      [FileSystemWatcher]
      (Maybe DidChangeWatchedFilesRegistrationOptions))
-> (([FileSystemWatcher]
     -> Const [FileSystemWatcher] [FileSystemWatcher])
    -> DidChangeWatchedFilesRegistrationOptions
    -> Const
         [FileSystemWatcher] DidChangeWatchedFilesRegistrationOptions)
-> ([FileSystemWatcher]
    -> Const [FileSystemWatcher] [FileSystemWatcher])
-> Maybe DidChangeWatchedFilesRegistrationOptions
-> Const
     [FileSystemWatcher]
     (Maybe DidChangeWatchedFilesRegistrationOptions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FileSystemWatcher]
 -> Const [FileSystemWatcher] [FileSystemWatcher])
-> DidChangeWatchedFilesRegistrationOptions
-> Const
     [FileSystemWatcher] DidChangeWatchedFilesRegistrationOptions
forall s a. HasWatchers s a => Lens' s a
Lens' DidChangeWatchedFilesRegistrationOptions [FileSystemWatcher]
L.watchers)

      clientCapsSupports :: Bool
clientCapsSupports =
        ClientCapabilities
caps ClientCapabilities
-> Getting (First Bool) ClientCapabilities Bool -> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe WorkspaceClientCapabilities
 -> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ClientCapabilities -> Const (First Bool) ClientCapabilities
forall s a. HasWorkspace s a => Lens' s a
Lens' ClientCapabilities (Maybe WorkspaceClientCapabilities)
L.workspace ((Maybe WorkspaceClientCapabilities
  -> Const (First Bool) (Maybe WorkspaceClientCapabilities))
 -> ClientCapabilities -> Const (First Bool) ClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe WorkspaceClientCapabilities
    -> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> Getting (First Bool) ClientCapabilities Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceClientCapabilities
 -> Const (First Bool) WorkspaceClientCapabilities)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((WorkspaceClientCapabilities
  -> Const (First Bool) WorkspaceClientCapabilities)
 -> Maybe WorkspaceClientCapabilities
 -> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
    -> WorkspaceClientCapabilities
    -> Const (First Bool) WorkspaceClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe DidChangeWatchedFilesClientCapabilities
 -> Const
      (First Bool) (Maybe DidChangeWatchedFilesClientCapabilities))
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities
forall s a. HasDidChangeWatchedFiles s a => Lens' s a
Lens'
  WorkspaceClientCapabilities
  (Maybe DidChangeWatchedFilesClientCapabilities)
L.didChangeWatchedFiles ((Maybe DidChangeWatchedFilesClientCapabilities
  -> Const
       (First Bool) (Maybe DidChangeWatchedFilesClientCapabilities))
 -> WorkspaceClientCapabilities
 -> Const (First Bool) WorkspaceClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe DidChangeWatchedFilesClientCapabilities
    -> Const
         (First Bool) (Maybe DidChangeWatchedFilesClientCapabilities))
-> (Bool -> Const (First Bool) Bool)
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DidChangeWatchedFilesClientCapabilities
 -> Const (First Bool) DidChangeWatchedFilesClientCapabilities)
-> Maybe DidChangeWatchedFilesClientCapabilities
-> Const
     (First Bool) (Maybe DidChangeWatchedFilesClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((DidChangeWatchedFilesClientCapabilities
  -> Const (First Bool) DidChangeWatchedFilesClientCapabilities)
 -> Maybe DidChangeWatchedFilesClientCapabilities
 -> Const
      (First Bool) (Maybe DidChangeWatchedFilesClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
    -> DidChangeWatchedFilesClientCapabilities
    -> Const (First Bool) DidChangeWatchedFilesClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe DidChangeWatchedFilesClientCapabilities
-> Const
     (First Bool) (Maybe DidChangeWatchedFilesClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Const (First Bool) (Maybe Bool))
-> DidChangeWatchedFilesClientCapabilities
-> Const (First Bool) DidChangeWatchedFilesClientCapabilities
forall s a. HasDynamicRegistration s a => Lens' s a
Lens' DidChangeWatchedFilesClientCapabilities (Maybe Bool)
L.dynamicRegistration ((Maybe Bool -> Const (First Bool) (Maybe Bool))
 -> DidChangeWatchedFilesClientCapabilities
 -> Const (First Bool) DidChangeWatchedFilesClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe Bool -> Const (First Bool) (Maybe Bool))
-> (Bool -> Const (First Bool) Bool)
-> DidChangeWatchedFilesClientCapabilities
-> Const (First Bool) DidChangeWatchedFilesClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (First Bool) Bool)
-> Maybe Bool -> Const (First Bool) (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just
          Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      shouldSend :: Bool
shouldSend = Bool
clientCapsSupports Bool -> Bool -> Bool
&& (Bool
 -> TRegistration 'Method_WorkspaceDidChangeWatchedFiles -> Bool)
-> Bool
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
-> Bool
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Bool
acc TRegistration 'Method_WorkspaceDidChangeWatchedFiles
r -> Bool
acc Bool -> Bool -> Bool
|| TRegistration 'Method_WorkspaceDidChangeWatchedFiles -> Bool
regHits TRegistration 'Method_WorkspaceDidChangeWatchedFiles
r) Bool
False [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
regs

  Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldSend (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$
    SClientMethod 'Method_WorkspaceDidChangeWatchedFiles
-> MessageParams 'Method_WorkspaceDidChangeWatchedFiles
-> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Method_WorkspaceDidChangeWatchedFiles
SMethod_WorkspaceDidChangeWatchedFiles (MessageParams 'Method_WorkspaceDidChangeWatchedFiles
 -> Session ())
-> MessageParams 'Method_WorkspaceDidChangeWatchedFiles
-> Session ()
forall a b. (a -> b) -> a -> b
$
      [FileEvent] -> DidChangeWatchedFilesParams
DidChangeWatchedFilesParams ([FileEvent] -> DidChangeWatchedFilesParams)
-> [FileEvent] -> DidChangeWatchedFilesParams
forall a b. (a -> b) -> a -> b
$
        [Uri -> FileChangeType -> FileEvent
FileEvent (String -> Uri
filePathToUri (String
rootDir String -> String -> String
</> String
file)) FileChangeType
FileChangeType_Created]
  String -> Text -> Text -> Session TextDocumentIdentifier
openDoc' String
file Text
languageId Text
contents

{- | Opens a text document that /exists on disk/, and sends a
 textDocument/didOpen notification to the server.
-}
openDoc :: FilePath -> T.Text -> Session TextDocumentIdentifier
openDoc :: String -> Text -> Session TextDocumentIdentifier
openDoc String
file Text
languageId = do
  SessionContext
context <- Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
  let fp :: String
fp = SessionContext -> String
rootDir SessionContext
context String -> String -> String
</> String
file
  Text
contents <- IO Text -> Session Text
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Session Text) -> IO Text -> Session Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
T.readFile String
fp
  String -> Text -> Text -> Session TextDocumentIdentifier
openDoc' String
file Text
languageId Text
contents

{- | This is a variant of `openDoc` that takes the file content as an argument.
 Use this is the file exists /outside/ of the current workspace.
-}
openDoc' :: FilePath -> T.Text -> T.Text -> Session TextDocumentIdentifier
openDoc' :: String -> Text -> Text -> Session TextDocumentIdentifier
openDoc' String
file Text
languageId Text
contents = do
  SessionContext
context <- Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
  let fp :: String
fp = SessionContext -> String
rootDir SessionContext
context String -> String -> String
</> String
file
      uri :: Uri
uri = String -> Uri
filePathToUri String
fp
      item :: TextDocumentItem
item = Uri -> Text -> Int32 -> Text -> TextDocumentItem
TextDocumentItem Uri
uri Text
languageId Int32
0 Text
contents
  SMethod 'Method_TextDocumentDidOpen
-> MessageParams 'Method_TextDocumentDidOpen -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen (TextDocumentItem -> DidOpenTextDocumentParams
DidOpenTextDocumentParams TextDocumentItem
item)
  TextDocumentIdentifier -> Session TextDocumentIdentifier
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextDocumentIdentifier -> Session TextDocumentIdentifier)
-> TextDocumentIdentifier -> Session TextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
uri

-- | Closes a text document and sends a textDocument/didOpen notification to the server.
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc TextDocumentIdentifier
docId = do
  let params :: DidCloseTextDocumentParams
params = TextDocumentIdentifier -> DidCloseTextDocumentParams
DidCloseTextDocumentParams (Uri -> TextDocumentIdentifier
TextDocumentIdentifier (TextDocumentIdentifier
docId 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
L.uri))
  SMethod 'Method_TextDocumentDidClose
-> MessageParams 'Method_TextDocumentDidClose -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose MessageParams 'Method_TextDocumentDidClose
DidCloseTextDocumentParams
params

-- | Changes a text document and sends a textDocument/didOpen notification to the server.
changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
changeDoc :: TextDocumentIdentifier
-> [TextDocumentContentChangeEvent] -> Session ()
changeDoc TextDocumentIdentifier
docId [TextDocumentContentChangeEvent]
changes = do
  VersionedTextDocumentIdentifier
verDoc <- TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
docId
  let params :: DidChangeTextDocumentParams
params = VersionedTextDocumentIdentifier
-> [TextDocumentContentChangeEvent] -> DidChangeTextDocumentParams
DidChangeTextDocumentParams (VersionedTextDocumentIdentifier
verDoc VersionedTextDocumentIdentifier
-> (VersionedTextDocumentIdentifier
    -> VersionedTextDocumentIdentifier)
-> VersionedTextDocumentIdentifier
forall a b. a -> (a -> b) -> b
& (Int32 -> Identity Int32)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Int32
L.version ((Int32 -> Identity Int32)
 -> VersionedTextDocumentIdentifier
 -> Identity VersionedTextDocumentIdentifier)
-> Int32
-> VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int32
1) [TextDocumentContentChangeEvent]
changes
  SMethod 'Method_TextDocumentDidChange
-> MessageParams 'Method_TextDocumentDidChange -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange MessageParams 'Method_TextDocumentDidChange
DidChangeTextDocumentParams
params

-- | Gets the Uri for the file corrected to the session directory.
getDocUri :: FilePath -> Session Uri
getDocUri :: String -> Session Uri
getDocUri String
file = do
  SessionContext
context <- Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
  let fp :: String
fp = SessionContext -> String
rootDir SessionContext
context String -> String -> String
</> String
file
  Uri -> Session Uri
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Session Uri) -> Uri -> Session Uri
forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
fp

-- | Waits for diagnostics to be published and returns them.
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics = do
  TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot <- Session FromServerMessage
-> Session
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
-> Session
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (SServerMethod 'Method_TextDocumentPublishDiagnostics
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SServerMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics)
  let diags :: [Diagnostic]
diags = TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Getting
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     [Diagnostic]
-> [Diagnostic]
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const [Diagnostic] PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
  PublishDiagnosticsParams
L.params ((PublishDiagnosticsParams
  -> Const [Diagnostic] PublishDiagnosticsParams)
 -> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
 -> Const
      [Diagnostic]
      (TNotificationMessage 'Method_TextDocumentPublishDiagnostics))
-> (([Diagnostic] -> Const [Diagnostic] [Diagnostic])
    -> PublishDiagnosticsParams
    -> Const [Diagnostic] PublishDiagnosticsParams)
-> Getting
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Diagnostic] -> Const [Diagnostic] [Diagnostic])
-> PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
Lens' PublishDiagnosticsParams [Diagnostic]
L.diagnostics
  [Diagnostic] -> Session [Diagnostic]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
diags

{- | The same as 'waitForDiagnostics', but will only match a specific
 'Language.LSP.Types._source'.
-}
waitForDiagnosticsSource :: String -> Session [Diagnostic]
waitForDiagnosticsSource :: String -> Session [Diagnostic]
waitForDiagnosticsSource String
src = do
  [Diagnostic]
diags <- Session [Diagnostic]
waitForDiagnostics
  let res :: [Diagnostic]
res = (Diagnostic -> Bool) -> [Diagnostic] -> [Diagnostic]
forall a. (a -> Bool) -> [a] -> [a]
filter Diagnostic -> Bool
matches [Diagnostic]
diags
  if [Diagnostic] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
res
    then String -> Session [Diagnostic]
waitForDiagnosticsSource String
src
    else [Diagnostic] -> Session [Diagnostic]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
res
 where
  matches :: Diagnostic -> Bool
  matches :: Diagnostic -> Bool
matches Diagnostic
d = Diagnostic
d Diagnostic
-> Getting (Maybe Text) Diagnostic (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Diagnostic (Maybe Text)
forall s a. HasSource s a => Lens' s a
Lens' Diagnostic (Maybe Text)
L.source Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just (String -> Text
T.pack String
src)

{- | Expects a 'PublishDiagnosticsNotification' and throws an
 'UnexpectedDiagnostics' exception if there are any diagnostics
 returned.
-}
noDiagnostics :: Session ()
noDiagnostics :: Session ()
noDiagnostics = do
  TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot <- SServerMethod 'Method_TextDocumentPublishDiagnostics
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SServerMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics
  Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Getting
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     [Diagnostic]
-> [Diagnostic]
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const [Diagnostic] PublishDiagnosticsParams)
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Const
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
Lens'
  (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
  PublishDiagnosticsParams
L.params ((PublishDiagnosticsParams
  -> Const [Diagnostic] PublishDiagnosticsParams)
 -> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
 -> Const
      [Diagnostic]
      (TNotificationMessage 'Method_TextDocumentPublishDiagnostics))
-> (([Diagnostic] -> Const [Diagnostic] [Diagnostic])
    -> PublishDiagnosticsParams
    -> Const [Diagnostic] PublishDiagnosticsParams)
-> Getting
     [Diagnostic]
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
     [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Diagnostic] -> Const [Diagnostic] [Diagnostic])
-> PublishDiagnosticsParams
-> Const [Diagnostic] PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
Lens' PublishDiagnosticsParams [Diagnostic]
L.diagnostics [Diagnostic] -> [Diagnostic] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ SessionException -> IO ()
forall a e. Exception e => e -> a
throw SessionException
UnexpectedDiagnostics

-- | Returns the symbols in a document.
getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [SymbolInformation] [DocumentSymbol])
getDocumentSymbols :: TextDocumentIdentifier
-> Session (Either [SymbolInformation] [DocumentSymbol])
getDocumentSymbols TextDocumentIdentifier
doc = do
  TResponseMessage Text
_ Maybe (LspId 'Method_TextDocumentDocumentSymbol)
rspLid Either
  ResponseError (MessageResult 'Method_TextDocumentDocumentSymbol)
res <- SClientMethod 'Method_TextDocumentDocumentSymbol
-> MessageParams 'Method_TextDocumentDocumentSymbol
-> Session (TResponseMessage 'Method_TextDocumentDocumentSymbol)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentDocumentSymbol
SMethod_TextDocumentDocumentSymbol (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> DocumentSymbolParams
DocumentSymbolParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc)
  case Either
  ResponseError (MessageResult 'Method_TextDocumentDocumentSymbol)
res of
    Right (InL [SymbolInformation]
xs) -> Either [SymbolInformation] [DocumentSymbol]
-> Session (Either [SymbolInformation] [DocumentSymbol])
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ([SymbolInformation] -> Either [SymbolInformation] [DocumentSymbol]
forall a b. a -> Either a b
Left [SymbolInformation]
xs)
    Right (InR (InL [DocumentSymbol]
xs)) -> Either [SymbolInformation] [DocumentSymbol]
-> Session (Either [SymbolInformation] [DocumentSymbol])
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocumentSymbol] -> Either [SymbolInformation] [DocumentSymbol]
forall a b. b -> Either a b
Right [DocumentSymbol]
xs)
    Right (InR (InR Null
_)) -> Either [SymbolInformation] [DocumentSymbol]
-> Session (Either [SymbolInformation] [DocumentSymbol])
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocumentSymbol] -> Either [SymbolInformation] [DocumentSymbol]
forall a b. b -> Either a b
Right [])
    Left ResponseError
err -> SessionException
-> Session (Either [SymbolInformation] [DocumentSymbol])
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'Method_TextDocumentDocumentSymbol -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId (LspId 'Method_TextDocumentDocumentSymbol -> SomeLspId)
-> LspId 'Method_TextDocumentDocumentSymbol -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'Method_TextDocumentDocumentSymbol)
-> LspId 'Method_TextDocumentDocumentSymbol
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'Method_TextDocumentDocumentSymbol)
rspLid) ResponseError
err)

-- | Returns the code actions in the specified range.
getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getCodeActions TextDocumentIdentifier
doc Range
range = do
  CodeActionContext
ctx <- TextDocumentIdentifier -> Range -> Session CodeActionContext
getCodeActionContextInRange TextDocumentIdentifier
doc Range
range
  TResponseMessage 'Method_TextDocumentCodeAction
rsp <- SClientMethod 'Method_TextDocumentCodeAction
-> MessageParams 'Method_TextDocumentCodeAction
-> Session (TResponseMessage 'Method_TextDocumentCodeAction)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range CodeActionContext
ctx)

  case TResponseMessage 'Method_TextDocumentCodeAction
rsp TResponseMessage 'Method_TextDocumentCodeAction
-> Getting
     (Either ResponseError ([Command |? CodeAction] |? Null))
     (TResponseMessage 'Method_TextDocumentCodeAction)
     (Either ResponseError ([Command |? CodeAction] |? Null))
-> Either ResponseError ([Command |? CodeAction] |? Null)
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError ([Command |? CodeAction] |? Null))
  (TResponseMessage 'Method_TextDocumentCodeAction)
  (Either ResponseError ([Command |? CodeAction] |? Null))
forall s a. HasResult s a => Lens' s a
Lens'
  (TResponseMessage 'Method_TextDocumentCodeAction)
  (Either ResponseError ([Command |? CodeAction] |? Null))
L.result of
    Right (InL [Command |? CodeAction]
xs) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [Command |? CodeAction]
xs
    Right (InR Null
_) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Left ResponseError
error -> SessionException -> Session [Command |? CodeAction]
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'Method_TextDocumentCodeAction -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId (LspId 'Method_TextDocumentCodeAction -> SomeLspId)
-> LspId 'Method_TextDocumentCodeAction -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'Method_TextDocumentCodeAction)
-> LspId 'Method_TextDocumentCodeAction
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_TextDocumentCodeAction)
 -> LspId 'Method_TextDocumentCodeAction)
-> Maybe (LspId 'Method_TextDocumentCodeAction)
-> LspId 'Method_TextDocumentCodeAction
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentCodeAction
rsp TResponseMessage 'Method_TextDocumentCodeAction
-> Getting
     (Maybe (LspId 'Method_TextDocumentCodeAction))
     (TResponseMessage 'Method_TextDocumentCodeAction)
     (Maybe (LspId 'Method_TextDocumentCodeAction))
-> Maybe (LspId 'Method_TextDocumentCodeAction)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (LspId 'Method_TextDocumentCodeAction))
  (TResponseMessage 'Method_TextDocumentCodeAction)
  (Maybe (LspId 'Method_TextDocumentCodeAction))
forall s a. HasId s a => Lens' s a
Lens'
  (TResponseMessage 'Method_TextDocumentCodeAction)
  (Maybe (LspId 'Method_TextDocumentCodeAction))
L.id) ResponseError
error)

{- | Returns the code actions in the specified range, resolving any with
 a non empty _data_ field.
-}
getAndResolveCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getAndResolveCodeActions :: TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getAndResolveCodeActions TextDocumentIdentifier
doc Range
range = do
  [Command |? CodeAction]
items <- TextDocumentIdentifier -> Range -> Session [Command |? CodeAction]
getCodeActions TextDocumentIdentifier
doc Range
range
  [Command |? CodeAction]
-> ((Command |? CodeAction) -> Session (Command |? CodeAction))
-> Session [Command |? CodeAction]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Command |? CodeAction]
items (((Command |? CodeAction) -> Session (Command |? CodeAction))
 -> Session [Command |? CodeAction])
-> ((Command |? CodeAction) -> Session (Command |? CodeAction))
-> Session [Command |? CodeAction]
forall a b. (a -> b) -> a -> b
$ \case
    l :: Command |? CodeAction
l@(InL Command
_) -> (Command |? CodeAction) -> Session (Command |? CodeAction)
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command |? CodeAction
l
    (InR CodeAction
r) | Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (CodeAction
r CodeAction
-> Getting (Maybe Value) CodeAction (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CodeAction (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CodeAction (Maybe Value)
L.data_) -> CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR (CodeAction -> Command |? CodeAction)
-> Session CodeAction -> Session (Command |? CodeAction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeAction -> Session CodeAction
resolveCodeAction CodeAction
r
    r :: Command |? CodeAction
r@(InR CodeAction
_) -> (Command |? CodeAction) -> Session (Command |? CodeAction)
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command |? CodeAction
r

{- | Returns all the code actions in a document by
 querying the code actions at each of the current
 diagnostics' positions.
-}
getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
getAllCodeActions :: TextDocumentIdentifier -> Session [Command |? CodeAction]
getAllCodeActions TextDocumentIdentifier
doc = do
  CodeActionContext
ctx <- TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc

  ([Command |? CodeAction]
 -> Diagnostic -> Session [Command |? CodeAction])
-> [Command |? CodeAction]
-> [Diagnostic]
-> Session [Command |? CodeAction]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CodeActionContext
-> [Command |? CodeAction]
-> Diagnostic
-> Session [Command |? CodeAction]
go CodeActionContext
ctx) [] ([Diagnostic] -> Session [Command |? CodeAction])
-> Session [Diagnostic] -> Session [Command |? CodeAction]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc
 where
  go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
  go :: CodeActionContext
-> [Command |? CodeAction]
-> Diagnostic
-> Session [Command |? CodeAction]
go CodeActionContext
ctx [Command |? CodeAction]
acc Diagnostic
diag = do
    TResponseMessage Text
_ Maybe (LspId 'Method_TextDocumentCodeAction)
rspLid Either ResponseError (MessageResult 'Method_TextDocumentCodeAction)
res <- SClientMethod 'Method_TextDocumentCodeAction
-> MessageParams 'Method_TextDocumentCodeAction
-> Session (TResponseMessage 'Method_TextDocumentCodeAction)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc (Diagnostic
diag Diagnostic -> Getting Range Diagnostic Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range Diagnostic Range
forall s a. HasRange s a => Lens' s a
Lens' Diagnostic Range
L.range) CodeActionContext
ctx)

    case Either ResponseError (MessageResult 'Method_TextDocumentCodeAction)
res of
      Left ResponseError
e -> SessionException -> Session [Command |? CodeAction]
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'Method_TextDocumentCodeAction -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId (LspId 'Method_TextDocumentCodeAction -> SomeLspId)
-> LspId 'Method_TextDocumentCodeAction -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'Method_TextDocumentCodeAction)
-> LspId 'Method_TextDocumentCodeAction
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'Method_TextDocumentCodeAction)
rspLid) ResponseError
e)
      Right (InL [Command |? CodeAction]
cmdOrCAs) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Command |? CodeAction]
acc [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction]
cmdOrCAs)
      Right (InR Null
_) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Command |? CodeAction]
acc

getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext
getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext
getCodeActionContextInRange TextDocumentIdentifier
doc Range
caRange = do
  [Diagnostic]
curDiags <- TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc
  let diags :: [Diagnostic]
diags =
        [ Diagnostic
d | d :: Diagnostic
d@Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range = Range
range} <- [Diagnostic]
curDiags, Range -> Range -> Bool
overlappingRange Range
caRange Range
range
        ]
  CodeActionContext -> Session CodeActionContext
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeActionContext -> Session CodeActionContext)
-> CodeActionContext -> Session CodeActionContext
forall a b. (a -> b) -> a -> b
$ [Diagnostic]
-> Maybe [CodeActionKind]
-> Maybe CodeActionTriggerKind
-> CodeActionContext
CodeActionContext [Diagnostic]
diags Maybe [CodeActionKind]
forall a. Maybe a
Nothing Maybe CodeActionTriggerKind
forall a. Maybe a
Nothing
 where
  overlappingRange :: Range -> Range -> Bool
  overlappingRange :: Range -> Range -> Bool
overlappingRange (Range Position
s Position
e) Range
range =
    Position -> Range -> Bool
positionInRange Position
s Range
range
      Bool -> Bool -> Bool
|| Position -> Range -> Bool
positionInRange Position
e Range
range

  positionInRange :: Position -> Range -> Bool
  positionInRange :: Position -> Range -> Bool
positionInRange (Position UInt
pl UInt
po) (Range (Position UInt
sl UInt
so) (Position UInt
el UInt
eo)) =
    UInt
pl UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
> UInt
sl Bool -> Bool -> Bool
&& UInt
pl UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
< UInt
el
      Bool -> Bool -> Bool
|| UInt
pl UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
sl Bool -> Bool -> Bool
&& UInt
pl UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
el Bool -> Bool -> Bool
&& UInt
po UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
>= UInt
so Bool -> Bool -> Bool
&& UInt
po UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
<= UInt
eo
      Bool -> Bool -> Bool
|| UInt
pl UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
sl Bool -> Bool -> Bool
&& UInt
po UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
>= UInt
so
      Bool -> Bool -> Bool
|| UInt
pl UInt -> UInt -> Bool
forall a. Eq a => a -> a -> Bool
== UInt
el Bool -> Bool -> Bool
&& UInt
po UInt -> UInt -> Bool
forall a. Ord a => a -> a -> Bool
<= UInt
eo

getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc = do
  [Diagnostic]
curDiags <- TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc
  CodeActionContext -> Session CodeActionContext
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeActionContext -> Session CodeActionContext)
-> CodeActionContext -> Session CodeActionContext
forall a b. (a -> b) -> a -> b
$ [Diagnostic]
-> Maybe [CodeActionKind]
-> Maybe CodeActionTriggerKind
-> CodeActionContext
CodeActionContext [Diagnostic]
curDiags Maybe [CodeActionKind]
forall a. Maybe a
Nothing Maybe CodeActionTriggerKind
forall a. Maybe a
Nothing

{- | Returns the current diagnostics that have been sent to the client.
 Note that this does not wait for more to come in.
-}
getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc = [Diagnostic] -> Maybe [Diagnostic] -> [Diagnostic]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Diagnostic] -> [Diagnostic])
-> (SessionState -> Maybe [Diagnostic])
-> SessionState
-> [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedUri
-> Map NormalizedUri [Diagnostic] -> Maybe [Diagnostic]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Uri -> NormalizedUri
toNormalizedUri (Uri -> NormalizedUri) -> Uri -> NormalizedUri
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
L.uri) (Map NormalizedUri [Diagnostic] -> Maybe [Diagnostic])
-> (SessionState -> Map NormalizedUri [Diagnostic])
-> SessionState
-> Maybe [Diagnostic]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map NormalizedUri [Diagnostic]
curDiagnostics (SessionState -> [Diagnostic])
-> Session SessionState -> Session [Diagnostic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get

-- | Returns the tokens of all progress sessions that have started but not yet ended.
getIncompleteProgressSessions :: Session (Set.Set ProgressToken)
getIncompleteProgressSessions :: Session (Set ProgressToken)
getIncompleteProgressSessions = SessionState -> Set ProgressToken
curProgressSessions (SessionState -> Set ProgressToken)
-> Session SessionState -> Session (Set ProgressToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get

-- | Executes a command.
executeCommand :: Command -> Session ()
executeCommand :: Command -> Session ()
executeCommand Command
cmd = do
  let args :: Maybe [Value]
args = ByteString -> Maybe [Value]
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe [Value]) -> ByteString -> Maybe [Value]
forall a b. (a -> b) -> a -> b
$ [Value] -> ByteString
forall a. ToJSON a => a -> ByteString
encode ([Value] -> ByteString) -> [Value] -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe [Value] -> [Value]
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe [Value] -> [Value]) -> Maybe [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ Command
cmd Command
-> Getting (Maybe [Value]) Command (Maybe [Value]) -> Maybe [Value]
forall s a. s -> Getting a s a -> a
^. Getting (Maybe [Value]) Command (Maybe [Value])
forall s a. HasArguments s a => Lens' s a
Lens' Command (Maybe [Value])
L.arguments
      execParams :: ExecuteCommandParams
execParams = Maybe ProgressToken
-> Text -> Maybe [Value] -> ExecuteCommandParams
ExecuteCommandParams Maybe ProgressToken
forall a. Maybe a
Nothing (Command
cmd Command -> Getting Text Command Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Command Text
forall s a. HasCommand s a => Lens' s a
Lens' Command Text
L.command) Maybe [Value]
args
  Session (LspId 'Method_WorkspaceExecuteCommand) -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Session (LspId 'Method_WorkspaceExecuteCommand) -> Session ())
-> Session (LspId 'Method_WorkspaceExecuteCommand) -> Session ()
forall a b. (a -> b) -> a -> b
$ SClientMethod 'Method_WorkspaceExecuteCommand
-> MessageParams 'Method_WorkspaceExecuteCommand
-> Session (LspId 'Method_WorkspaceExecuteCommand)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod 'Method_WorkspaceExecuteCommand
SMethod_WorkspaceExecuteCommand MessageParams 'Method_WorkspaceExecuteCommand
ExecuteCommandParams
execParams

{- | Executes a code action.
 Matching with the specification, if a code action
 contains both an edit and a command, the edit will
 be applied first.
-}
executeCodeAction :: CodeAction -> Session ()
executeCodeAction :: CodeAction -> Session ()
executeCodeAction CodeAction
action = do
  Session ()
-> (WorkspaceEdit -> Session ())
-> Maybe WorkspaceEdit
-> Session ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Session ()
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) WorkspaceEdit -> Session ()
handleEdit (Maybe WorkspaceEdit -> Session ())
-> Maybe WorkspaceEdit -> Session ()
forall a b. (a -> b) -> a -> b
$ CodeAction
action CodeAction
-> Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
-> Maybe WorkspaceEdit
forall s a. s -> Getting a s a -> a
^. Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
forall s a. HasEdit s a => Lens' s a
Lens' CodeAction (Maybe WorkspaceEdit)
L.edit
  Session ()
-> (Command -> Session ()) -> Maybe Command -> Session ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Session ()
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Command -> Session ()
executeCommand (Maybe Command -> Session ()) -> Maybe Command -> Session ()
forall a b. (a -> b) -> a -> b
$ CodeAction
action CodeAction
-> Getting (Maybe Command) CodeAction (Maybe Command)
-> Maybe Command
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Command) CodeAction (Maybe Command)
forall s a. HasCommand s a => Lens' s a
Lens' CodeAction (Maybe Command)
L.command
 where
  handleEdit :: WorkspaceEdit -> Session ()
  handleEdit :: WorkspaceEdit -> Session ()
handleEdit WorkspaceEdit
e =
    -- Its ok to pass in dummy parameters here as they aren't used
    let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = Text
-> LspId 'Method_WorkspaceApplyEdit
-> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> TRequestMessage 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (Int32 -> LspId 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
e)
     in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'Method_WorkspaceApplyEdit
-> TMessage 'Method_WorkspaceApplyEdit -> FromServerMessage
forall (t :: MessageKind) (m :: Method 'ServerToClient t)
       (a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TMessage 'Method_WorkspaceApplyEdit
TRequestMessage 'Method_WorkspaceApplyEdit
req)

-- | Resolves the provided code action.
resolveCodeAction :: CodeAction -> Session CodeAction
resolveCodeAction :: CodeAction -> Session CodeAction
resolveCodeAction CodeAction
ca = do
  TResponseMessage 'Method_CodeActionResolve
rsp <- SClientMethod 'Method_CodeActionResolve
-> MessageParams 'Method_CodeActionResolve
-> Session (TResponseMessage 'Method_CodeActionResolve)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_CodeActionResolve
SMethod_CodeActionResolve MessageParams 'Method_CodeActionResolve
CodeAction
ca
  case TResponseMessage 'Method_CodeActionResolve
rsp TResponseMessage 'Method_CodeActionResolve
-> Getting
     (Either ResponseError CodeAction)
     (TResponseMessage 'Method_CodeActionResolve)
     (Either ResponseError CodeAction)
-> Either ResponseError CodeAction
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError CodeAction)
  (TResponseMessage 'Method_CodeActionResolve)
  (Either ResponseError CodeAction)
forall s a. HasResult s a => Lens' s a
Lens'
  (TResponseMessage 'Method_CodeActionResolve)
  (Either ResponseError CodeAction)
L.result of
    Right CodeAction
ca -> CodeAction -> Session CodeAction
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return CodeAction
ca
    Left ResponseError
er -> SessionException -> Session CodeAction
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'Method_CodeActionResolve -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId (LspId 'Method_CodeActionResolve -> SomeLspId)
-> LspId 'Method_CodeActionResolve -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'Method_CodeActionResolve)
-> LspId 'Method_CodeActionResolve
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_CodeActionResolve)
 -> LspId 'Method_CodeActionResolve)
-> Maybe (LspId 'Method_CodeActionResolve)
-> LspId 'Method_CodeActionResolve
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CodeActionResolve
rsp TResponseMessage 'Method_CodeActionResolve
-> Getting
     (Maybe (LspId 'Method_CodeActionResolve))
     (TResponseMessage 'Method_CodeActionResolve)
     (Maybe (LspId 'Method_CodeActionResolve))
-> Maybe (LspId 'Method_CodeActionResolve)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (LspId 'Method_CodeActionResolve))
  (TResponseMessage 'Method_CodeActionResolve)
  (Maybe (LspId 'Method_CodeActionResolve))
forall s a. HasId s a => Lens' s a
Lens'
  (TResponseMessage 'Method_CodeActionResolve)
  (Maybe (LspId 'Method_CodeActionResolve))
L.id) ResponseError
er)

{- | If a code action contains a _data_ field: resolves the code action, then
 executes it. Otherwise, just executes it.
-}
resolveAndExecuteCodeAction :: CodeAction -> Session ()
resolveAndExecuteCodeAction :: CodeAction -> Session ()
resolveAndExecuteCodeAction ca :: CodeAction
ca@CodeAction{$sel:_data_:CodeAction :: CodeAction -> Maybe Value
_data_ = Just Value
_} = do
  CodeAction
caRsp <- CodeAction -> Session CodeAction
resolveCodeAction CodeAction
ca
  CodeAction -> Session ()
executeCodeAction CodeAction
caRsp
resolveAndExecuteCodeAction CodeAction
ca = CodeAction -> Session ()
executeCodeAction CodeAction
ca

-- | Adds the current version to the document, as tracked by the session.
getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc (TextDocumentIdentifier Uri
uri) = do
  VFS
vfs <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let ver :: Maybe Int32
ver = VFS
vfs VFS -> Getting (First Int32) VFS Int32 -> Maybe Int32
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Map NormalizedUri VirtualFile
 -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> VFS -> Const (First Int32) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
  -> Const (First Int32) (Map NormalizedUri VirtualFile))
 -> VFS -> Const (First Int32) VFS)
-> ((Int32 -> Const (First Int32) Int32)
    -> Map NormalizedUri VirtualFile
    -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> Getting (First Int32) VFS Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Traversal'
     (Map NormalizedUri VirtualFile)
     (IxValue (Map NormalizedUri VirtualFile))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri) ((VirtualFile -> Const (First Int32) VirtualFile)
 -> Map NormalizedUri VirtualFile
 -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> ((Int32 -> Const (First Int32) Int32)
    -> VirtualFile -> Const (First Int32) VirtualFile)
-> (Int32 -> Const (First Int32) Int32)
-> Map NormalizedUri VirtualFile
-> Const (First Int32) (Map NormalizedUri VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VirtualFile -> Int32)
-> (Int32 -> Const (First Int32) Int32)
-> VirtualFile
-> Const (First Int32) VirtualFile
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to VirtualFile -> Int32
virtualFileVersion
  -- TODO: is this correct? Could return an OptionalVersionedTextDocumentIdentifier,
  -- but that complicated callers...
  VersionedTextDocumentIdentifier
-> Session VersionedTextDocumentIdentifier
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Int32 -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri (Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 Maybe Int32
ver))

-- | Applys an edit to the document and returns the updated document version.
applyEdit :: TextDocumentIdentifier -> TextEdit -> Session VersionedTextDocumentIdentifier
applyEdit :: TextDocumentIdentifier
-> TextEdit -> Session VersionedTextDocumentIdentifier
applyEdit TextDocumentIdentifier
doc TextEdit
edit = do
  VersionedTextDocumentIdentifier
verDoc <- TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
doc

  ClientCapabilities
caps <- (SessionContext -> ClientCapabilities)
-> Session ClientCapabilities
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities

  let supportsDocChanges :: Bool
supportsDocChanges = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ClientCapabilities
caps ClientCapabilities
-> Getting (First Bool) ClientCapabilities Bool -> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe WorkspaceClientCapabilities
 -> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ClientCapabilities -> Const (First Bool) ClientCapabilities
forall s a. HasWorkspace s a => Lens' s a
Lens' ClientCapabilities (Maybe WorkspaceClientCapabilities)
L.workspace ((Maybe WorkspaceClientCapabilities
  -> Const (First Bool) (Maybe WorkspaceClientCapabilities))
 -> ClientCapabilities -> Const (First Bool) ClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe WorkspaceClientCapabilities
    -> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> Getting (First Bool) ClientCapabilities Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceClientCapabilities
 -> Const (First Bool) WorkspaceClientCapabilities)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((WorkspaceClientCapabilities
  -> Const (First Bool) WorkspaceClientCapabilities)
 -> Maybe WorkspaceClientCapabilities
 -> Const (First Bool) (Maybe WorkspaceClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
    -> WorkspaceClientCapabilities
    -> Const (First Bool) WorkspaceClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceClientCapabilities
-> Const (First Bool) (Maybe WorkspaceClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe WorkspaceEditClientCapabilities
 -> Const (First Bool) (Maybe WorkspaceEditClientCapabilities))
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities
forall s a. HasWorkspaceEdit s a => Lens' s a
Lens'
  WorkspaceClientCapabilities (Maybe WorkspaceEditClientCapabilities)
L.workspaceEdit ((Maybe WorkspaceEditClientCapabilities
  -> Const (First Bool) (Maybe WorkspaceEditClientCapabilities))
 -> WorkspaceClientCapabilities
 -> Const (First Bool) WorkspaceClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe WorkspaceEditClientCapabilities
    -> Const (First Bool) (Maybe WorkspaceEditClientCapabilities))
-> (Bool -> Const (First Bool) Bool)
-> WorkspaceClientCapabilities
-> Const (First Bool) WorkspaceClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEditClientCapabilities
 -> Const (First Bool) WorkspaceEditClientCapabilities)
-> Maybe WorkspaceEditClientCapabilities
-> Const (First Bool) (Maybe WorkspaceEditClientCapabilities)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((WorkspaceEditClientCapabilities
  -> Const (First Bool) WorkspaceEditClientCapabilities)
 -> Maybe WorkspaceEditClientCapabilities
 -> Const (First Bool) (Maybe WorkspaceEditClientCapabilities))
-> ((Bool -> Const (First Bool) Bool)
    -> WorkspaceEditClientCapabilities
    -> Const (First Bool) WorkspaceEditClientCapabilities)
-> (Bool -> Const (First Bool) Bool)
-> Maybe WorkspaceEditClientCapabilities
-> Const (First Bool) (Maybe WorkspaceEditClientCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Bool -> Const (First Bool) (Maybe Bool))
-> WorkspaceEditClientCapabilities
-> Const (First Bool) WorkspaceEditClientCapabilities
forall s a. HasDocumentChanges s a => Lens' s a
Lens' WorkspaceEditClientCapabilities (Maybe Bool)
L.documentChanges ((Maybe Bool -> Const (First Bool) (Maybe Bool))
 -> WorkspaceEditClientCapabilities
 -> Const (First Bool) WorkspaceEditClientCapabilities)
-> ((Bool -> Const (First Bool) Bool)
    -> Maybe Bool -> Const (First Bool) (Maybe Bool))
-> (Bool -> Const (First Bool) Bool)
-> WorkspaceEditClientCapabilities
-> Const (First Bool) WorkspaceEditClientCapabilities
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (First Bool) Bool)
-> Maybe Bool -> Const (First Bool) (Maybe Bool)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just

  let wEdit :: WorkspaceEdit
wEdit =
        if Bool
supportsDocChanges
          then
            let docEdit :: TextDocumentEdit
docEdit = OptionalVersionedTextDocumentIdentifier
-> [TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit
TextDocumentEdit (AReview
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
-> OptionalVersionedTextDocumentIdentifier
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
Prism'
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
_versionedTextDocumentIdentifier VersionedTextDocumentIdentifier
verDoc) [TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
InL TextEdit
edit]
             in Maybe (Map Uri [TextEdit])
-> Maybe [DocumentChange]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit Maybe (Map Uri [TextEdit])
forall a. Maybe a
Nothing ([DocumentChange] -> Maybe [DocumentChange]
forall a. a -> Maybe a
Just [TextDocumentEdit -> DocumentChange
forall a b. a -> a |? b
InL TextDocumentEdit
docEdit]) Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
          else
            let changes :: Map Uri [TextEdit]
changes = Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton (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
L.uri) [TextEdit
edit]
             in Maybe (Map Uri [TextEdit])
-> Maybe [DocumentChange]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just Map Uri [TextEdit]
changes) Maybe [DocumentChange]
forall a. Maybe a
Nothing Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing

  let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = Text
-> LspId 'Method_WorkspaceApplyEdit
-> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> TRequestMessage 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (Int32 -> LspId 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
  FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'Method_WorkspaceApplyEdit
-> TMessage 'Method_WorkspaceApplyEdit -> FromServerMessage
forall (t :: MessageKind) (m :: Method 'ServerToClient t)
       (a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TMessage 'Method_WorkspaceApplyEdit
TRequestMessage 'Method_WorkspaceApplyEdit
req)

  -- version may have changed
  TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
doc

-- | Returns the completions for the position in the document.
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions TextDocumentIdentifier
doc Position
pos = do
  TResponseMessage 'Method_TextDocumentCompletion
rsp <- SClientMethod 'Method_TextDocumentCompletion
-> MessageParams 'Method_TextDocumentCompletion
-> Session (TResponseMessage 'Method_TextDocumentCompletion)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentCompletion
SMethod_TextDocumentCompletion (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> Maybe CompletionContext
-> CompletionParams
CompletionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing Maybe CompletionContext
forall a. Maybe a
Nothing)

  case TResponseMessage 'Method_TextDocumentCompletion
-> MessageResult 'Method_TextDocumentCompletion
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentCompletion
rsp of
    InL [CompletionItem]
items -> [CompletionItem] -> Session [CompletionItem]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
    InR (InL CompletionList
c) -> [CompletionItem] -> Session [CompletionItem]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return ([CompletionItem] -> Session [CompletionItem])
-> [CompletionItem] -> Session [CompletionItem]
forall a b. (a -> b) -> a -> b
$ CompletionList
c CompletionList
-> Getting [CompletionItem] CompletionList [CompletionItem]
-> [CompletionItem]
forall s a. s -> Getting a s a -> a
^. Getting [CompletionItem] CompletionList [CompletionItem]
forall s a. HasItems s a => Lens' s a
Lens' CompletionList [CompletionItem]
L.items
    InR (InR Null
_) -> [CompletionItem] -> Session [CompletionItem]
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return []

{- | Returns the completions for the position in the document, resolving any with
 a non empty _data_ field.
-}
getAndResolveCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getAndResolveCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
getAndResolveCompletions TextDocumentIdentifier
doc Position
pos = do
  [CompletionItem]
items <- TextDocumentIdentifier -> Position -> Session [CompletionItem]
getCompletions TextDocumentIdentifier
doc Position
pos
  [CompletionItem]
-> (CompletionItem -> Session CompletionItem)
-> Session [CompletionItem]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CompletionItem]
items ((CompletionItem -> Session CompletionItem)
 -> Session [CompletionItem])
-> (CompletionItem -> Session CompletionItem)
-> Session [CompletionItem]
forall a b. (a -> b) -> a -> b
$ \CompletionItem
item -> if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (CompletionItem
item CompletionItem
-> Getting (Maybe Value) CompletionItem (Maybe Value)
-> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CompletionItem (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CompletionItem (Maybe Value)
L.data_) then CompletionItem -> Session CompletionItem
resolveCompletion CompletionItem
item else CompletionItem -> Session CompletionItem
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItem
item

-- | Resolves the provided completion item.
resolveCompletion :: CompletionItem -> Session CompletionItem
resolveCompletion :: CompletionItem -> Session CompletionItem
resolveCompletion CompletionItem
ci = do
  TResponseMessage 'Method_CompletionItemResolve
rsp <- SClientMethod 'Method_CompletionItemResolve
-> MessageParams 'Method_CompletionItemResolve
-> Session (TResponseMessage 'Method_CompletionItemResolve)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_CompletionItemResolve
SMethod_CompletionItemResolve MessageParams 'Method_CompletionItemResolve
CompletionItem
ci
  case TResponseMessage 'Method_CompletionItemResolve
rsp TResponseMessage 'Method_CompletionItemResolve
-> Getting
     (Either ResponseError CompletionItem)
     (TResponseMessage 'Method_CompletionItemResolve)
     (Either ResponseError CompletionItem)
-> Either ResponseError CompletionItem
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError CompletionItem)
  (TResponseMessage 'Method_CompletionItemResolve)
  (Either ResponseError CompletionItem)
forall s a. HasResult s a => Lens' s a
Lens'
  (TResponseMessage 'Method_CompletionItemResolve)
  (Either ResponseError CompletionItem)
L.result of
    Right CompletionItem
ci -> CompletionItem -> Session CompletionItem
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return CompletionItem
ci
    Left ResponseError
error -> SessionException -> Session CompletionItem
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'Method_CompletionItemResolve -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId (LspId 'Method_CompletionItemResolve -> SomeLspId)
-> LspId 'Method_CompletionItemResolve -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'Method_CompletionItemResolve)
-> LspId 'Method_CompletionItemResolve
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_CompletionItemResolve)
 -> LspId 'Method_CompletionItemResolve)
-> Maybe (LspId 'Method_CompletionItemResolve)
-> LspId 'Method_CompletionItemResolve
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CompletionItemResolve
rsp TResponseMessage 'Method_CompletionItemResolve
-> Getting
     (Maybe (LspId 'Method_CompletionItemResolve))
     (TResponseMessage 'Method_CompletionItemResolve)
     (Maybe (LspId 'Method_CompletionItemResolve))
-> Maybe (LspId 'Method_CompletionItemResolve)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (LspId 'Method_CompletionItemResolve))
  (TResponseMessage 'Method_CompletionItemResolve)
  (Maybe (LspId 'Method_CompletionItemResolve))
forall s a. HasId s a => Lens' s a
Lens'
  (TResponseMessage 'Method_CompletionItemResolve)
  (Maybe (LspId 'Method_CompletionItemResolve))
L.id) ResponseError
error)

-- | Returns the references for the position in the document.
getReferences ::
  -- | The document to lookup in.
  TextDocumentIdentifier ->
  -- | The position to lookup.
  Position ->
  -- | Whether to include declarations as references.
  Bool ->
  -- | The locations of the references.
  Session [Location]
getReferences :: TextDocumentIdentifier -> Position -> Bool -> Session [Location]
getReferences TextDocumentIdentifier
doc Position
pos Bool
inclDecl =
  let ctx :: ReferenceContext
ctx = Bool -> ReferenceContext
ReferenceContext Bool
inclDecl
      params :: ReferenceParams
params = TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ReferenceContext
-> ReferenceParams
ReferenceParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing ReferenceContext
ctx
   in ([Location] |? Null) -> [Location]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([Location] |? Null) -> [Location])
-> (TResponseMessage 'Method_TextDocumentReferences
    -> [Location] |? Null)
-> TResponseMessage 'Method_TextDocumentReferences
-> [Location]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentReferences
-> MessageResult 'Method_TextDocumentReferences
TResponseMessage 'Method_TextDocumentReferences
-> [Location] |? Null
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentReferences -> [Location])
-> Session (TResponseMessage 'Method_TextDocumentReferences)
-> Session [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentReferences
-> MessageParams 'Method_TextDocumentReferences
-> Session (TResponseMessage 'Method_TextDocumentReferences)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentReferences
SMethod_TextDocumentReferences MessageParams 'Method_TextDocumentReferences
ReferenceParams
params

-- | Returns the declarations(s) for the term at the specified position.
getDeclarations ::
  -- | The document the term is in.
  TextDocumentIdentifier ->
  -- | The position the term is at.
  Position ->
  Session (Declaration |? [DeclarationLink] |? Null)
getDeclarations :: TextDocumentIdentifier
-> Position -> Session (Declaration |? ([DeclarationLink] |? Null))
getDeclarations TextDocumentIdentifier
doc Position
pos = do
  TResponseMessage 'Method_TextDocumentDeclaration
rsp <- SClientMethod 'Method_TextDocumentDeclaration
-> MessageParams 'Method_TextDocumentDeclaration
-> Session (TResponseMessage 'Method_TextDocumentDeclaration)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentDeclaration
SMethod_TextDocumentDeclaration (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DeclarationParams
DeclarationParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing)
  (Declaration |? ([DeclarationLink] |? Null))
-> Session (Declaration |? ([DeclarationLink] |? Null))
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Declaration |? ([DeclarationLink] |? Null))
 -> Session (Declaration |? ([DeclarationLink] |? Null)))
-> (Declaration |? ([DeclarationLink] |? Null))
-> Session (Declaration |? ([DeclarationLink] |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentDeclaration
-> MessageResult 'Method_TextDocumentDeclaration
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentDeclaration
rsp

-- | Returns the definition(s) for the term at the specified position.
getDefinitions ::
  -- | The document the term is in.
  TextDocumentIdentifier ->
  -- | The position the term is at.
  Position ->
  Session (Definition |? [DefinitionLink] |? Null)
getDefinitions :: TextDocumentIdentifier
-> Position -> Session (Definition |? ([DefinitionLink] |? Null))
getDefinitions TextDocumentIdentifier
doc Position
pos = do
  TResponseMessage 'Method_TextDocumentDefinition
rsp <- SClientMethod 'Method_TextDocumentDefinition
-> MessageParams 'Method_TextDocumentDefinition
-> Session (TResponseMessage 'Method_TextDocumentDefinition)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentDefinition
SMethod_TextDocumentDefinition (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DefinitionParams
DefinitionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing)
  (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Definition |? ([DefinitionLink] |? Null))
 -> Session (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentDefinition
-> MessageResult 'Method_TextDocumentDefinition
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentDefinition
rsp

-- | Returns the type definition(s) for the term at the specified position.
getTypeDefinitions ::
  -- | The document the term is in.
  TextDocumentIdentifier ->
  -- | The position the term is at.
  Position ->
  Session (Definition |? [DefinitionLink] |? Null)
getTypeDefinitions :: TextDocumentIdentifier
-> Position -> Session (Definition |? ([DefinitionLink] |? Null))
getTypeDefinitions TextDocumentIdentifier
doc Position
pos = do
  TResponseMessage 'Method_TextDocumentTypeDefinition
rsp <- SClientMethod 'Method_TextDocumentTypeDefinition
-> MessageParams 'Method_TextDocumentTypeDefinition
-> Session (TResponseMessage 'Method_TextDocumentTypeDefinition)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentTypeDefinition
SMethod_TextDocumentTypeDefinition (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> TypeDefinitionParams
TypeDefinitionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing)
  (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Definition |? ([DefinitionLink] |? Null))
 -> Session (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentTypeDefinition
-> MessageResult 'Method_TextDocumentTypeDefinition
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentTypeDefinition
rsp

-- | Returns the type definition(s) for the term at the specified position.
getImplementations ::
  -- | The document the term is in.
  TextDocumentIdentifier ->
  -- | The position the term is at.
  Position ->
  Session (Definition |? [DefinitionLink] |? Null)
getImplementations :: TextDocumentIdentifier
-> Position -> Session (Definition |? ([DefinitionLink] |? Null))
getImplementations TextDocumentIdentifier
doc Position
pos = do
  TResponseMessage 'Method_TextDocumentImplementation
rsp <- SClientMethod 'Method_TextDocumentImplementation
-> MessageParams 'Method_TextDocumentImplementation
-> Session (TResponseMessage 'Method_TextDocumentImplementation)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentImplementation
SMethod_TextDocumentImplementation (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ImplementationParams
ImplementationParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing)
  (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Definition |? ([DefinitionLink] |? Null))
 -> Session (Definition |? ([DefinitionLink] |? Null)))
-> (Definition |? ([DefinitionLink] |? Null))
-> Session (Definition |? ([DefinitionLink] |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentImplementation
-> MessageResult 'Method_TextDocumentImplementation
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentImplementation
rsp

-- | Renames the term at the specified position.
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
rename :: TextDocumentIdentifier -> Position -> String -> Session ()
rename TextDocumentIdentifier
doc Position
pos String
newName = do
  let params :: RenameParams
params = Maybe ProgressToken
-> TextDocumentIdentifier -> Position -> Text -> RenameParams
RenameParams Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc Position
pos (String -> Text
T.pack String
newName)
  TResponseMessage 'Method_TextDocumentRename
rsp <- SClientMethod 'Method_TextDocumentRename
-> MessageParams 'Method_TextDocumentRename
-> Session (TResponseMessage 'Method_TextDocumentRename)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentRename
SMethod_TextDocumentRename MessageParams 'Method_TextDocumentRename
RenameParams
params
  let wEdit :: MessageResult 'Method_TextDocumentRename
wEdit = TResponseMessage 'Method_TextDocumentRename
-> MessageResult 'Method_TextDocumentRename
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentRename
rsp
  case (WorkspaceEdit |? Null) -> Maybe WorkspaceEdit
forall a. (a |? Null) -> Maybe a
nullToMaybe MessageResult 'Method_TextDocumentRename
WorkspaceEdit |? Null
wEdit of
    Just WorkspaceEdit
e -> do
      let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = Text
-> LspId 'Method_WorkspaceApplyEdit
-> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> TRequestMessage 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (Int32 -> LspId 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
e)
      FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'Method_WorkspaceApplyEdit
-> TMessage 'Method_WorkspaceApplyEdit -> FromServerMessage
forall (t :: MessageKind) (m :: Method 'ServerToClient t)
       (a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TMessage 'Method_WorkspaceApplyEdit
TRequestMessage 'Method_WorkspaceApplyEdit
req)
    Maybe WorkspaceEdit
Nothing -> () -> Session ()
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Returns the hover information at the specified position.
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover TextDocumentIdentifier
doc Position
pos =
  let params :: HoverParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> HoverParams
HoverParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
   in (Hover |? Null) -> Maybe Hover
forall a. (a |? Null) -> Maybe a
nullToMaybe ((Hover |? Null) -> Maybe Hover)
-> (TResponseMessage 'Method_TextDocumentHover -> Hover |? Null)
-> TResponseMessage 'Method_TextDocumentHover
-> Maybe Hover
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentHover
-> MessageResult 'Method_TextDocumentHover
TResponseMessage 'Method_TextDocumentHover -> Hover |? Null
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentHover -> Maybe Hover)
-> Session (TResponseMessage 'Method_TextDocumentHover)
-> Session (Maybe Hover)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentHover
-> MessageParams 'Method_TextDocumentHover
-> Session (TResponseMessage 'Method_TextDocumentHover)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentHover
SMethod_TextDocumentHover MessageParams 'Method_TextDocumentHover
HoverParams
params

-- | Returns the highlighted occurrences of the term at the specified position
getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
getHighlights TextDocumentIdentifier
doc Position
pos =
  let params :: DocumentHighlightParams
params = TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DocumentHighlightParams
DocumentHighlightParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing
   in ([DocumentHighlight] |? Null) -> [DocumentHighlight]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([DocumentHighlight] |? Null) -> [DocumentHighlight])
-> (TResponseMessage 'Method_TextDocumentDocumentHighlight
    -> [DocumentHighlight] |? Null)
-> TResponseMessage 'Method_TextDocumentDocumentHighlight
-> [DocumentHighlight]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentDocumentHighlight
-> MessageResult 'Method_TextDocumentDocumentHighlight
TResponseMessage 'Method_TextDocumentDocumentHighlight
-> [DocumentHighlight] |? Null
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentDocumentHighlight
 -> [DocumentHighlight])
-> Session (TResponseMessage 'Method_TextDocumentDocumentHighlight)
-> Session [DocumentHighlight]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentDocumentHighlight
-> MessageParams 'Method_TextDocumentDocumentHighlight
-> Session (TResponseMessage 'Method_TextDocumentDocumentHighlight)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentDocumentHighlight
SMethod_TextDocumentDocumentHighlight MessageParams 'Method_TextDocumentDocumentHighlight
DocumentHighlightParams
params

{- | Checks the response for errors and throws an exception if needed.
 Returns the result if successful.
-}
getResponseResult :: (ToJSON (ErrorData m)) => TResponseMessage m -> MessageResult m
getResponseResult :: forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage m
rsp =
  case TResponseMessage m
rsp TResponseMessage m
-> Getting
     (Either ResponseError (MessageResult m))
     (TResponseMessage m)
     (Either ResponseError (MessageResult m))
-> Either ResponseError (MessageResult m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError (MessageResult m))
  (TResponseMessage m)
  (Either ResponseError (MessageResult m))
forall s a. HasResult s a => Lens' s a
Lens' (TResponseMessage m) (Either ResponseError (MessageResult m))
L.result of
    Right MessageResult m
x -> MessageResult m
x
    Left ResponseError
err -> SessionException -> MessageResult m
forall a e. Exception e => e -> a
throw (SessionException -> MessageResult m)
-> SessionException -> MessageResult m
forall a b. (a -> b) -> a -> b
$ SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId m -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId (LspId m -> SomeLspId) -> LspId m -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId m) -> LspId m
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId m) -> LspId m) -> Maybe (LspId m) -> LspId m
forall a b. (a -> b) -> a -> b
$ TResponseMessage m
rsp TResponseMessage m
-> Getting (Maybe (LspId m)) (TResponseMessage m) (Maybe (LspId m))
-> Maybe (LspId m)
forall s a. s -> Getting a s a -> a
^. Getting (Maybe (LspId m)) (TResponseMessage m) (Maybe (LspId m))
forall s a. HasId s a => Lens' s a
Lens' (TResponseMessage m) (Maybe (LspId m))
L.id) ResponseError
err

-- | Applies formatting to the specified document.
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc TextDocumentIdentifier
doc FormattingOptions
opts = do
  let params :: DocumentFormattingParams
params = Maybe ProgressToken
-> TextDocumentIdentifier
-> FormattingOptions
-> DocumentFormattingParams
DocumentFormattingParams Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc FormattingOptions
opts
  [TextEdit]
edits <- ([TextEdit] |? Null) -> [TextEdit]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([TextEdit] |? Null) -> [TextEdit])
-> (TResponseMessage 'Method_TextDocumentFormatting
    -> [TextEdit] |? Null)
-> TResponseMessage 'Method_TextDocumentFormatting
-> [TextEdit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentFormatting
-> MessageResult 'Method_TextDocumentFormatting
TResponseMessage 'Method_TextDocumentFormatting
-> [TextEdit] |? Null
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentFormatting -> [TextEdit])
-> Session (TResponseMessage 'Method_TextDocumentFormatting)
-> Session [TextEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentFormatting
-> MessageParams 'Method_TextDocumentFormatting
-> Session (TResponseMessage 'Method_TextDocumentFormatting)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentFormatting
SMethod_TextDocumentFormatting MessageParams 'Method_TextDocumentFormatting
DocumentFormattingParams
params
  TextDocumentIdentifier -> [TextEdit] -> Session ()
applyTextEdits TextDocumentIdentifier
doc [TextEdit]
edits

-- | Applies formatting to the specified range in a document.
formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
formatRange TextDocumentIdentifier
doc FormattingOptions
opts Range
range = do
  let params :: DocumentRangeFormattingParams
params = Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> FormattingOptions
-> DocumentRangeFormattingParams
DocumentRangeFormattingParams Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range FormattingOptions
opts
  [TextEdit]
edits <- ([TextEdit] |? Null) -> [TextEdit]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([TextEdit] |? Null) -> [TextEdit])
-> (TResponseMessage 'Method_TextDocumentRangeFormatting
    -> [TextEdit] |? Null)
-> TResponseMessage 'Method_TextDocumentRangeFormatting
-> [TextEdit]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TResponseMessage 'Method_TextDocumentRangeFormatting
-> MessageResult 'Method_TextDocumentRangeFormatting
TResponseMessage 'Method_TextDocumentRangeFormatting
-> [TextEdit] |? Null
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult (TResponseMessage 'Method_TextDocumentRangeFormatting
 -> [TextEdit])
-> Session (TResponseMessage 'Method_TextDocumentRangeFormatting)
-> Session [TextEdit]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'Method_TextDocumentRangeFormatting
-> MessageParams 'Method_TextDocumentRangeFormatting
-> Session (TResponseMessage 'Method_TextDocumentRangeFormatting)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentRangeFormatting
SMethod_TextDocumentRangeFormatting MessageParams 'Method_TextDocumentRangeFormatting
DocumentRangeFormattingParams
params
  TextDocumentIdentifier -> [TextEdit] -> Session ()
applyTextEdits TextDocumentIdentifier
doc [TextEdit]
edits

applyTextEdits :: TextDocumentIdentifier -> [TextEdit] -> Session ()
applyTextEdits :: TextDocumentIdentifier -> [TextEdit] -> Session ()
applyTextEdits TextDocumentIdentifier
doc [TextEdit]
edits =
  let wEdit :: WorkspaceEdit
wEdit = Maybe (Map Uri [TextEdit])
-> Maybe [DocumentChange]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just (Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
Map.singleton (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
L.uri) [TextEdit]
edits)) Maybe [DocumentChange]
forall a. Maybe a
Nothing Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
      -- Send a dummy message to updateState so it can do bookkeeping
      req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = Text
-> LspId 'Method_WorkspaceApplyEdit
-> SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> TRequestMessage 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (Int32 -> LspId 'Method_WorkspaceApplyEdit
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
   in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'Method_WorkspaceApplyEdit
-> TMessage 'Method_WorkspaceApplyEdit -> FromServerMessage
forall (t :: MessageKind) (m :: Method 'ServerToClient t)
       (a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TMessage 'Method_WorkspaceApplyEdit
TRequestMessage 'Method_WorkspaceApplyEdit
req)

-- | Returns the code lenses for the specified document.
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId = do
  TResponseMessage 'Method_TextDocumentCodeLens
rsp <- SClientMethod 'Method_TextDocumentCodeLens
-> MessageParams 'Method_TextDocumentCodeLens
-> Session (TResponseMessage 'Method_TextDocumentCodeLens)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentCodeLens
SMethod_TextDocumentCodeLens (Maybe ProgressToken
-> Maybe ProgressToken -> TextDocumentIdentifier -> CodeLensParams
CodeLensParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
tId)
  [CodeLens] -> Session [CodeLens]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CodeLens] -> Session [CodeLens])
-> [CodeLens] -> Session [CodeLens]
forall a b. (a -> b) -> a -> b
$ ([CodeLens] |? Null) -> [CodeLens]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([CodeLens] |? Null) -> [CodeLens])
-> ([CodeLens] |? Null) -> [CodeLens]
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentCodeLens
-> MessageResult 'Method_TextDocumentCodeLens
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentCodeLens
rsp

{- | Returns the code lenses for the specified document, resolving any with
 a non empty _data_ field.
-}
getAndResolveCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getAndResolveCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getAndResolveCodeLenses TextDocumentIdentifier
tId = do
  [CodeLens]
codeLenses <- TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId
  [CodeLens] -> (CodeLens -> Session CodeLens) -> Session [CodeLens]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CodeLens]
codeLenses ((CodeLens -> Session CodeLens) -> Session [CodeLens])
-> (CodeLens -> Session CodeLens) -> Session [CodeLens]
forall a b. (a -> b) -> a -> b
$ \CodeLens
codeLens -> if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (CodeLens
codeLens CodeLens
-> Getting (Maybe Value) CodeLens (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) CodeLens (Maybe Value)
forall s a. HasData_ s a => Lens' s a
Lens' CodeLens (Maybe Value)
L.data_) then CodeLens -> Session CodeLens
resolveCodeLens CodeLens
codeLens else CodeLens -> Session CodeLens
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CodeLens
codeLens

-- | Resolves the provided code lens.
resolveCodeLens :: CodeLens -> Session CodeLens
resolveCodeLens :: CodeLens -> Session CodeLens
resolveCodeLens CodeLens
cl = do
  TResponseMessage 'Method_CodeLensResolve
rsp <- SClientMethod 'Method_CodeLensResolve
-> MessageParams 'Method_CodeLensResolve
-> Session (TResponseMessage 'Method_CodeLensResolve)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_CodeLensResolve
SMethod_CodeLensResolve MessageParams 'Method_CodeLensResolve
CodeLens
cl
  case TResponseMessage 'Method_CodeLensResolve
rsp TResponseMessage 'Method_CodeLensResolve
-> Getting
     (Either ResponseError CodeLens)
     (TResponseMessage 'Method_CodeLensResolve)
     (Either ResponseError CodeLens)
-> Either ResponseError CodeLens
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError CodeLens)
  (TResponseMessage 'Method_CodeLensResolve)
  (Either ResponseError CodeLens)
forall s a. HasResult s a => Lens' s a
Lens'
  (TResponseMessage 'Method_CodeLensResolve)
  (Either ResponseError CodeLens)
L.result of
    Right CodeLens
cl -> CodeLens -> Session CodeLens
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return CodeLens
cl
    Left ResponseError
error -> SessionException -> Session CodeLens
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'Method_CodeLensResolve -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId (LspId 'Method_CodeLensResolve -> SomeLspId)
-> LspId 'Method_CodeLensResolve -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'Method_CodeLensResolve)
-> LspId 'Method_CodeLensResolve
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'Method_CodeLensResolve)
 -> LspId 'Method_CodeLensResolve)
-> Maybe (LspId 'Method_CodeLensResolve)
-> LspId 'Method_CodeLensResolve
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CodeLensResolve
rsp TResponseMessage 'Method_CodeLensResolve
-> Getting
     (Maybe (LspId 'Method_CodeLensResolve))
     (TResponseMessage 'Method_CodeLensResolve)
     (Maybe (LspId 'Method_CodeLensResolve))
-> Maybe (LspId 'Method_CodeLensResolve)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (LspId 'Method_CodeLensResolve))
  (TResponseMessage 'Method_CodeLensResolve)
  (Maybe (LspId 'Method_CodeLensResolve))
forall s a. HasId s a => Lens' s a
Lens'
  (TResponseMessage 'Method_CodeLensResolve)
  (Maybe (LspId 'Method_CodeLensResolve))
L.id) ResponseError
error)

-- | Pass a param and return the response from `prepareCallHierarchy`
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy = SMethod 'Method_TextDocumentPrepareCallHierarchy
-> MessageParams 'Method_TextDocumentPrepareCallHierarchy
-> Session [CallHierarchyItem]
forall (m :: Method 'ClientToServer 'Request) a.
(ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'Method_TextDocumentPrepareCallHierarchy
SMethod_TextDocumentPrepareCallHierarchy

incomingCalls :: CallHierarchyIncomingCallsParams -> Session [CallHierarchyIncomingCall]
incomingCalls :: CallHierarchyIncomingCallsParams
-> Session [CallHierarchyIncomingCall]
incomingCalls = SMethod 'Method_CallHierarchyIncomingCalls
-> MessageParams 'Method_CallHierarchyIncomingCalls
-> Session [CallHierarchyIncomingCall]
forall (m :: Method 'ClientToServer 'Request) a.
(ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'Method_CallHierarchyIncomingCalls
SMethod_CallHierarchyIncomingCalls

outgoingCalls :: CallHierarchyOutgoingCallsParams -> Session [CallHierarchyOutgoingCall]
outgoingCalls :: CallHierarchyOutgoingCallsParams
-> Session [CallHierarchyOutgoingCall]
outgoingCalls = SMethod 'Method_CallHierarchyOutgoingCalls
-> MessageParams 'Method_CallHierarchyOutgoingCalls
-> Session [CallHierarchyOutgoingCall]
forall (m :: Method 'ClientToServer 'Request) a.
(ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod 'Method_CallHierarchyOutgoingCalls
SMethod_CallHierarchyOutgoingCalls

-- | Send a request and receive a response with list.
resolveRequestWithListResp ::
  forall (m :: Method ClientToServer Request) a.
  (ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
  SMethod m ->
  MessageParams m ->
  Session [a]
resolveRequestWithListResp :: forall (m :: Method 'ClientToServer 'Request) a.
(ToJSON (ErrorData m), MessageResult m ~ ([a] |? Null)) =>
SMethod m -> MessageParams m -> Session [a]
resolveRequestWithListResp SMethod m
method MessageParams m
params = do
  TResponseMessage m
rsp <- SMethod m -> MessageParams m -> Session (TResponseMessage m)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod m
method MessageParams m
params
  [a] -> Session [a]
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Session [a]) -> [a] -> Session [a]
forall a b. (a -> b) -> a -> b
$ ([a] |? Null) -> [a]
forall a. Monoid a => (a |? Null) -> a
absorbNull (([a] |? Null) -> [a]) -> ([a] |? Null) -> [a]
forall a b. (a -> b) -> a -> b
$ TResponseMessage m -> MessageResult m
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage m
rsp

-- | Pass a param and return the response from `semanticTokensFull`
getSemanticTokens :: TextDocumentIdentifier -> Session (SemanticTokens |? Null)
getSemanticTokens :: TextDocumentIdentifier -> Session (SemanticTokens |? Null)
getSemanticTokens TextDocumentIdentifier
doc = do
  let params :: SemanticTokensParams
params = Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> SemanticTokensParams
SemanticTokensParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc
  TResponseMessage 'Method_TextDocumentSemanticTokensFull
rsp <- SClientMethod 'Method_TextDocumentSemanticTokensFull
-> MessageParams 'Method_TextDocumentSemanticTokensFull
-> Session
     (TResponseMessage 'Method_TextDocumentSemanticTokensFull)
forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SClientMethod 'Method_TextDocumentSemanticTokensFull
SMethod_TextDocumentSemanticTokensFull MessageParams 'Method_TextDocumentSemanticTokensFull
SemanticTokensParams
params
  (SemanticTokens |? Null) -> Session (SemanticTokens |? Null)
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((SemanticTokens |? Null) -> Session (SemanticTokens |? Null))
-> (SemanticTokens |? Null) -> Session (SemanticTokens |? Null)
forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentSemanticTokensFull
-> MessageResult 'Method_TextDocumentSemanticTokensFull
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentSemanticTokensFull
rsp

{- | Returns a list of capabilities that the server has requested to /dynamically/
 register during the 'Session'.

 @since 0.11.0.0
-}
getRegisteredCapabilities :: Session [SomeRegistration]
getRegisteredCapabilities :: Session [SomeRegistration]
getRegisteredCapabilities = Map Text SomeRegistration -> [SomeRegistration]
forall k a. Map k a -> [a]
Map.elems (Map Text SomeRegistration -> [SomeRegistration])
-> (SessionState -> Map Text SomeRegistration)
-> SessionState
-> [SomeRegistration]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map Text SomeRegistration
curDynCaps (SessionState -> [SomeRegistration])
-> Session SessionState -> Session [SomeRegistration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get