{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE TypeOperators #-}

{- |
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,

  -- ** 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.Default
import Data.List
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 = forall a.
SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
runSessionWithConfig 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 = forall a.
(CreateProcess -> CreateProcess)
-> SessionConfig
-> String
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithConfigCustomProcess 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'
  forall a.
String
-> Bool
-> (CreateProcess -> CreateProcess)
-> (Handle -> Handle -> ProcessHandle -> IO a)
-> IO a
withServer String
serverExe (SessionConfig -> Bool
logStdErr SessionConfig
config) CreateProcess -> CreateProcess
modifyCreateProcess forall a b. (a -> b) -> a -> b
$ \Handle
serverIn Handle
serverOut ProcessHandle
serverProc ->
    forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' (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 = forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' 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
          forall a. Maybe a
Nothing
          -- Narrowing to Int32 here, but it's unlikely that a PID will
          -- be outside the range
          (forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pid)
          (forall a. a -> Maybe a
Just Rec (("name" .== Text) .+ ("version" .== Maybe Text))
lspTestClientInfo)
          (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
absRootDir)
          forall a. Maybe a
Nothing
          (forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
absRootDir)
          ClientCapabilities
caps
          -- TODO: make this configurable?
          (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Object -> Value
Object forall a b. (a -> b) -> a -> b
$ SessionConfig -> Object
lspConfig SessionConfig
config')
          (forall a. a -> Maybe a
Just TraceValues
TraceValues_Off)
          (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ SessionConfig -> Maybe [WorkspaceFolder]
initialWorkspaceFolders SessionConfig
config)
  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 forall a b. (a -> b) -> a -> b
$ do
    -- Wrap the session around initialize and shutdown calls
    LspId 'Method_Initialize
initReqId <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SMethod 'Method_Initialize
SMethod_Initialize InitializeParams
initializeParams

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

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

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

    -- ... relay them back to the user Session so they can match on them!
    -- As long as they are allowed.
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FromServerMessage]
inBetween FromServerMessage -> Session ()
checkLegalBetweenMessage
    Chan SessionMessage
msgChan <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> Chan SessionMessage
messageChan
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Chan a -> [a] -> IO ()
writeList2Chan Chan SessionMessage
msgChan (FromServerMessage -> SessionMessage
ServerMessage 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 = forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session ()
request_ SMethod 'Method_Shutdown
SMethod_Shutdown forall a. Maybe a
Nothing forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_Exit
SMethod_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 <- forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar (SessionContext -> MVar RequestMap
requestMap SessionContext
context) forall a b. (a -> b) -> a -> b
$ \RequestMap
reqMap ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RequestMap -> ByteString -> (RequestMap, FromServerMessage)
decodeFromServerMsg RequestMap
reqMap ByteString
msgBytes
    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
_) -> 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
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowLogMessage TMessage m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_TelemetryEvent TMessage m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SMethod_WindowShowMessageRequest TMessage m
_) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage FromServerMessage
msg = 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' <- forall a. a -> Maybe a -> a
fromMaybe (SessionConfig -> Bool
logMessages SessionConfig
cfg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Bool)
checkEnv String
"LSP_TEST_LOG_MESSAGES"
  Bool
logStdErr' <- forall a. a -> Maybe a -> a
fromMaybe (SessionConfig -> Bool
logStdErr SessionConfig
cfg) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Bool)
checkEnv String
"LSP_TEST_LOG_STDERR"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SessionConfig
cfg{logMessages :: Bool
logMessages = Bool
logMessages', logStdErr :: Bool
logStdErr = Bool
logStdErr'}
 where
  checkEnv :: String -> IO (Maybe Bool)
  checkEnv :: String -> IO (Maybe Bool)
checkEnv String
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. (Eq a, IsString a) => a -> Bool
convertVal 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let Just VirtualFile
file = VFS
vfs forall s a. s -> Getting a s a -> a
^. forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (Uri -> NormalizedUri
toNormalizedUri (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri))
  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 <- forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit

  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) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      forall a e. Exception e => e -> a
throw (String -> SessionException
IncorrectApplyEditRequest (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 forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
L.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEdit s a => Lens' s a
L.edit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDocumentChanges s a => Lens' s a
L.documentChanges
        maybeDocs :: Maybe [Uri]
maybeDocs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri) 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
L.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasEdit s a => Lens' s a
L.edit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasChanges s a => Lens' s a
L.changes
     in forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall k a. Ord k => k -> Map k a -> Bool
Map.member (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
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 = forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod m
m forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \SessionState
c -> SessionState
c{curReqId :: Int32
curReqId = Int32
idn forall a. Num a => a -> a -> a
+ Int32
1}
  let id :: LspId m
id = forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
idn

  let mess :: TRequestMessage m
mess = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). HasReader r m => m r
ask
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar RequestMap
reqMap forall a b. (a -> b) -> a -> b
$
      \RequestMap
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'ClientToServer 'Request).
RequestMap -> LspId m -> SClientMethod m -> Maybe RequestMap
updateRequestMap RequestMap
r LspId m
id SClientMethod m
method

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

  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 = 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
params
  VFS
oldVFS <- SessionState -> VFS
vfs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState VFS
oldVFS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> m ()
openVFS forall a. Monoid a => a
mempty TNotificationMessage 'Method_TextDocumentDidOpen
n
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs :: VFS
vfs = VFS
newVFS})
  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 = 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
params
  VFS
oldVFS <- SessionState -> VFS
vfs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState VFS
oldVFS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> m ()
closeVFS forall a. Monoid a => a
mempty TNotificationMessage 'Method_TextDocumentDidClose
n
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs :: VFS
vfs = VFS
newVFS})
  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 = 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
params
  VFS
oldVFS <- SessionState -> VFS
vfs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let newVFS :: VFS
newVFS = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> s
execState VFS
oldVFS forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> m ()
changeFromClientVFS forall a. Monoid a => a
mempty TNotificationMessage 'Method_TextDocumentDidChange
n
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s{vfs :: VFS
vfs = VFS
newVFS})
  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 forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SMethod m
method of
    ClientNotOrReq m
IsClientNot -> forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (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 -> forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (forall (s :: Symbol) (f :: MessageDirection).
TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Notification
NotMess forall a b. (a -> b) -> a -> b
$ forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod m
method MessageParams m
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 = 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 = forall r (m :: * -> *). HasReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MVar a -> IO a
readMVar) 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
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{ignoringLogNotifications :: Bool
ignoringLogNotifications = Bool
value})

setIgnoringConfigurationRequests :: Bool -> Session ()
setIgnoringConfigurationRequests :: Bool -> Session ()
setIgnoringConfigurationRequests Bool
value = do
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{ignoringConfigurationRequests :: Bool
ignoringConfigurationRequests = Bool
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let newConfig :: Object
newConfig = Object -> Object
f Object
oldConfig
  forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
ss -> SessionState
ss{curLspConfig :: Object
curLspConfig = Object
newConfig})

  ClientCapabilities
caps <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities
  let supportsConfiguration :: Bool
supportsConfiguration = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ ClientCapabilities
caps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
L.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasConfiguration s a => Lens' s a
L.configuration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      -- TODO: make this configurable?
      -- if they support workspace/configuration then be annoying and don't send the full config so
      -- they have to request it
      configToSend :: Value
configToSend = if Bool
supportsConfiguration then Value
J.Null else Object -> Value
Object Object
newConfig
  forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_WorkspaceDidChangeConfiguration
SMethod_WorkspaceDidChangeConfiguration 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 (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 forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (forall a. IsString a => String -> a
fromString String
section) 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 forall a b. a -> (a -> b) -> b
& forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (forall a. IsString a => String -> a
fromString String
section) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  String
rootDir <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> String
rootDir
  ClientCapabilities
caps <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities
  String
absFile <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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
r]
      pred SomeRegistration
_ = forall a. Monoid a => a
mempty
      regs :: [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
regs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
pred forall a b. (a -> b) -> a -> b
$ 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 (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 = 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasRegisterOptions s a => Lens' s a
L.registerOptions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWatchers s a => Lens' s a
L.watchers)

      clientCapsSupports :: Bool
clientCapsSupports =
        ClientCapabilities
caps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
L.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDidChangeWatchedFiles s a => Lens' s a
L.didChangeWatchedFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDynamicRegistration s a => Lens' s a
L.dynamicRegistration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
          forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True
      shouldSend :: Bool
shouldSend = Bool
clientCapsSupports Bool -> Bool -> Bool
&& 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

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldSend forall a b. (a -> b) -> a -> b
$
    forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_WorkspaceDidChangeWatchedFiles
SMethod_WorkspaceDidChangeWatchedFiles forall a b. (a -> b) -> a -> b
$
      [FileEvent] -> DidChangeWatchedFilesParams
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 <- 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 <- 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
  forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen (TextDocumentItem -> DidOpenTextDocumentParams
DidOpenTextDocumentParams TextDocumentItem
item)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri))
  forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidClose
SMethod_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 forall a b. a -> (a -> b) -> b
& forall s a. HasVersion s a => Lens' s a
L.version forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int32
1) [TextDocumentContentChangeEvent]
changes
  forall (m :: Method 'ClientToServer 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidChange
SMethod_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 <- forall r (m :: * -> *). HasReader r m => m r
ask
  let fp :: String
fp = SessionContext -> String
rootDir SessionContext
context String -> String -> String
</> String
file
  forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics)
  let diags :: [Diagnostic]
diags = TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
L.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics
  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 = forall a. (a -> Bool) -> [a] -> [a]
filter Diagnostic -> Bool
matches [Diagnostic]
diags
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diagnostic]
res
    then String -> Session [Diagnostic]
waitForDiagnosticsSource String
src
    else forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
res
 where
  matches :: Diagnostic -> Bool
  matches :: Diagnostic -> Bool
matches Diagnostic
d = Diagnostic
d forall s a. s -> Getting a s a -> a
^. forall s a. HasSource s a => Lens' s a
L.source forall a. Eq a => a -> a -> Bool
== 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 <- forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message SMethod 'Method_TextDocumentPublishDiagnostics
SMethod_TextDocumentPublishDiagnostics
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diagsNot forall s a. s -> Getting a s a -> a
^. forall s a. HasParams s a => Lens' s a
L.params forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDiagnostics s a => Lens' s a
L.diagnostics forall a. Eq a => a -> a -> Bool
/= []) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentDocumentSymbol
SMethod_TextDocumentDocumentSymbol (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> DocumentSymbolParams
DocumentSymbolParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc)
  case Either
  ResponseError (MessageResult 'Method_TextDocumentDocumentSymbol)
res of
    Right (InL [SymbolInformation]
xs) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left [SymbolInformation]
xs)
    Right (InR (InL [DocumentSymbol]
xs)) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [DocumentSymbol]
xs)
    Right (InR (InR Null
_)) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right [])
    Left ResponseError
err -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range CodeActionContext
ctx)

  case TResponseMessage 'Method_TextDocumentCodeAction
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
    Right (InL [Command |? CodeAction]
xs) -> forall (m :: * -> *) a. Monad m => a -> m a
return [Command |? CodeAction]
xs
    Right (InR Null
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return []
    Left ResponseError
error -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_TextDocumentCodeAction
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
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
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Command |? CodeAction]
items forall a b. (a -> b) -> a -> b
$ \case
    l :: Command |? CodeAction
l@(InL Command
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Command |? CodeAction
l
    (InR CodeAction
r) | forall a. Maybe a -> Bool
isJust (CodeAction
r forall s a. s -> Getting a s a -> a
^. forall s a. HasData_ s a => Lens' s a
L.data_) -> forall a b. b -> a |? b
InR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodeAction -> Session CodeAction
resolveCodeAction CodeAction
r
    r :: Command |? CodeAction
r@(InR CodeAction
_) -> 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

  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) [] 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentCodeAction
SMethod_TextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc (Diagnostic
diag forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
L.range) CodeActionContext
ctx)

    case Either ResponseError (MessageResult 'Method_TextDocumentCodeAction)
res of
      Left ResponseError
e -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'Method_TextDocumentCodeAction)
rspLid) ResponseError
e)
      Right (InL [Command |? CodeAction]
cmdOrCAs) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Command |? CodeAction]
acc forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction]
cmdOrCAs)
      Right (InR Null
_) -> 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
        ]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Diagnostic]
-> Maybe [CodeActionKind]
-> Maybe CodeActionTriggerKind
-> CodeActionContext
CodeActionContext [Diagnostic]
diags forall a. Maybe a
Nothing 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 forall a. Ord a => a -> a -> Bool
> UInt
sl Bool -> Bool -> Bool
&& UInt
pl forall a. Ord a => a -> a -> Bool
< UInt
el
      Bool -> Bool -> Bool
|| UInt
pl forall a. Eq a => a -> a -> Bool
== UInt
sl Bool -> Bool -> Bool
&& UInt
pl forall a. Eq a => a -> a -> Bool
== UInt
el Bool -> Bool -> Bool
&& UInt
po forall a. Ord a => a -> a -> Bool
>= UInt
so Bool -> Bool -> Bool
&& UInt
po forall a. Ord a => a -> a -> Bool
<= UInt
eo
      Bool -> Bool -> Bool
|| UInt
pl forall a. Eq a => a -> a -> Bool
== UInt
sl Bool -> Bool -> Bool
&& UInt
po forall a. Ord a => a -> a -> Bool
>= UInt
so
      Bool -> Bool -> Bool
|| UInt
pl forall a. Eq a => a -> a -> Bool
== UInt
el Bool -> Bool -> Bool
&& UInt
po 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Diagnostic]
-> Maybe [CodeActionKind]
-> Maybe CodeActionTriggerKind
-> CodeActionContext
CodeActionContext [Diagnostic]
curDiags forall a. Maybe a
Nothing 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 = forall a. a -> Maybe a -> a
fromMaybe [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Uri -> NormalizedUri
toNormalizedUri forall a b. (a -> b) -> a -> b
$ TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map NormalizedUri [Diagnostic]
curDiagnostics forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a. FromJSON a => ByteString -> Maybe a
decode forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Command
cmd forall s a. s -> Getting a s a -> a
^. forall s a. HasArguments s a => Lens' s a
L.arguments
      execParams :: ExecuteCommandParams
execParams = Maybe ProgressToken
-> Text -> Maybe [Value] -> ExecuteCommandParams
ExecuteCommandParams forall a. Maybe a
Nothing (Command
cmd forall s a. s -> Getting a s a -> a
^. forall s a. HasCommand s a => Lens' s a
L.command) Maybe [Value]
args
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SMethod 'Method_WorkspaceExecuteCommand
SMethod_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
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) WorkspaceEdit -> Session ()
handleEdit forall a b. (a -> b) -> a -> b
$ CodeAction
action forall s a. s -> Getting a s a -> a
^. forall s a. HasEdit s a => Lens' s a
L.edit
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) Command -> Session ()
executeCommand forall a b. (a -> b) -> a -> b
$ CodeAction
action forall s a. s -> Getting a s a -> a
^. forall s a. HasCommand s a => Lens' s a
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 = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
e)
     in forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MessageKind) (m :: Method 'ServerToClient t)
       (a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod 'Method_WorkspaceApplyEdit
SMethod_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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_CodeActionResolve
SMethod_CodeActionResolve CodeAction
ca
  case TResponseMessage 'Method_CodeActionResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
    Right CodeAction
ca -> forall (m :: * -> *) a. Monad m => a -> m a
return CodeAction
ca
    Left ResponseError
er -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CodeActionResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get
  let ver :: Maybe Int32
ver = VFS
vfs forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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...
  forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Int32 -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri (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 <- forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> ClientCapabilities
sessionCapabilities

  let supportsDocChanges :: Bool
supportsDocChanges = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ ClientCapabilities
caps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
L.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasWorkspaceEdit s a => Lens' s a
L.workspaceEdit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDocumentChanges s a => Lens' s a
L.documentChanges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just

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

  let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
  forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MessageKind) (m :: Method 'ServerToClient t)
       (a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod 'Method_WorkspaceApplyEdit
SMethod_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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentCompletion
SMethod_TextDocumentCompletion (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> Maybe CompletionContext
-> CompletionParams
CompletionParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing)

  case forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentCompletion
rsp of
    InL [CompletionItem]
items -> forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
    InR (InL CompletionList
c) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CompletionList
c forall s a. s -> Getting a s a -> a
^. forall s a. HasItems s a => Lens' s a
L.items
    InR (InR Null
_) -> 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
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CompletionItem]
items forall a b. (a -> b) -> a -> b
$ \CompletionItem
item -> if forall a. Maybe a -> Bool
isJust (CompletionItem
item forall s a. s -> Getting a s a -> a
^. forall s a. HasData_ s a => Lens' s a
L.data_) then CompletionItem -> Session CompletionItem
resolveCompletion CompletionItem
item else 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_CompletionItemResolve
SMethod_CompletionItemResolve CompletionItem
ci
  case TResponseMessage 'Method_CompletionItemResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
    Right CompletionItem
ci -> forall (m :: * -> *) a. Monad m => a -> m a
return CompletionItem
ci
    Left ResponseError
error -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CompletionItemResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing ReferenceContext
ctx
   in forall a. Monoid a => (a |? Null) -> a
absorbNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentReferences
SMethod_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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentDeclaration
SMethod_TextDocumentDeclaration (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DeclarationParams
DeclarationParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentDefinition
SMethod_TextDocumentDefinition (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DefinitionParams
DefinitionParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentTypeDefinition
SMethod_TextDocumentTypeDefinition (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> TypeDefinitionParams
TypeDefinitionParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentImplementation
SMethod_TextDocumentImplementation (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ImplementationParams
ImplementationParams TextDocumentIdentifier
doc Position
pos forall a. Maybe a
Nothing forall a. Maybe a
Nothing)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 forall a. Maybe a
Nothing TextDocumentIdentifier
doc Position
pos (String -> Text
T.pack String
newName)
  TResponseMessage 'Method_TextDocumentRename
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentRename
SMethod_TextDocumentRename RenameParams
params
  let wEdit :: MessageResult 'Method_TextDocumentRename
wEdit = forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_TextDocumentRename
rsp
  case forall a. (a |? Null) -> Maybe a
nullToMaybe MessageResult 'Method_TextDocumentRename
wEdit of
    Just WorkspaceEdit
e -> do
      let req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
e)
      forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MessageKind) (m :: Method 'ServerToClient t)
       (a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit TRequestMessage 'Method_WorkspaceApplyEdit
req)
    Maybe WorkspaceEdit
Nothing -> 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 forall a. Maybe a
Nothing
   in forall a. (a |? Null) -> Maybe a
nullToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentHover
SMethod_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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing
   in forall a. Monoid a => (a |? Null) -> a
absorbNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentDocumentHighlight
SMethod_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 forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
    Right MessageResult m
x -> MessageResult m
x
    Left ResponseError
err -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ TResponseMessage m
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
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 forall a. Maybe a
Nothing TextDocumentIdentifier
doc FormattingOptions
opts
  [TextEdit]
edits <- forall a. Monoid a => (a |? Null) -> a
absorbNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentFormatting
SMethod_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 forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range FormattingOptions
opts
  [TextEdit]
edits <- forall a. Monoid a => (a |? Null) -> a
absorbNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentRangeFormatting
SMethod_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 (forall a. a -> Maybe a
Just (forall k a. k -> a -> Map k a
Map.singleton (TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
L.uri) [TextEdit]
edits)) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
      -- Send a dummy message to updateState so it can do bookkeeping
      req :: TRequestMessage 'Method_WorkspaceApplyEdit
req = forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"" (forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt Int32
0) SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
   in forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (forall (t :: MessageKind) (m :: Method 'ServerToClient t)
       (a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod 'Method_WorkspaceApplyEdit
SMethod_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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentCodeLens
SMethod_TextDocumentCodeLens (Maybe ProgressToken
-> Maybe ProgressToken -> TextDocumentIdentifier -> CodeLensParams
CodeLensParams forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
tId)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => (a |? Null) -> a
absorbNull forall a b. (a -> b) -> a -> b
$ 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
  forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [CodeLens]
codeLenses forall a b. (a -> b) -> a -> b
$ \CodeLens
codeLens -> if forall a. Maybe a -> Bool
isJust (CodeLens
codeLens forall s a. s -> Getting a s a -> a
^. forall s a. HasData_ s a => Lens' s a
L.data_) then CodeLens -> Session CodeLens
resolveCodeLens CodeLens
codeLens else 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_CodeLensResolve
SMethod_CodeLensResolve CodeLens
cl
  case TResponseMessage 'Method_CodeLensResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasResult s a => Lens' s a
L.result of
    Right CodeLens
cl -> forall (m :: * -> *) a. Monad m => a -> m a
return CodeLens
cl
    Left ResponseError
error -> forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ TResponseMessage 'Method_CodeLensResolve
rsp forall s a. s -> Getting a s a -> a
^. forall s a. HasId s a => Lens' s a
L.id) ResponseError
error)

-- | Pass a param and return the response from `prepareCallHierarchy`
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy :: CallHierarchyPrepareParams -> Session [CallHierarchyItem]
prepareCallHierarchy = 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 = 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 = 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 <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod m
method MessageParams m
params
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => (a |? Null) -> a
absorbNull forall a b. (a -> b) -> a -> b
$ 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 `prepareCallHierarchy`
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 forall a. Maybe a
Nothing forall a. Maybe a
Nothing TextDocumentIdentifier
doc
  TResponseMessage 'Method_TextDocumentSemanticTokensFull
rsp <- forall (m :: Method 'ClientToServer 'Request).
SClientMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod 'Method_TextDocumentSemanticTokensFull
SMethod_TextDocumentSemanticTokensFull SemanticTokensParams
params
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 = forall k a. Map k a -> [a]
Map.elems forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map Text SomeRegistration
curDynCaps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). HasState s m => m s
get