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

{-|
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
  , runSessionWithHandles
  -- ** Config
  , SessionConfig(..)
  , defaultConfig
  , C.fullCaps
  -- ** Exceptions
  , module Language.LSP.Test.Exceptions
  , withTimeout
  -- * Sending
  , request
  , request_
  , sendRequest
  , sendNotification
  , sendResponse
  -- * Receving
  , module Language.LSP.Test.Parsing
  -- * Utilities
  -- | Quick helper functions for common tasks.

  -- ** Initialization
  , initializeResponse
  -- ** Documents
  , createDoc
  , openDoc
  , closeDoc
  , changeDoc
  , documentContents
  , getDocumentEdit
  , getDocUri
  , getVersionedDoc
  -- ** Symbols
  , getDocumentSymbols
  -- ** Diagnostics
  , waitForDiagnostics
  , waitForDiagnosticsSource
  , noDiagnostics
  , getCurrentDiagnostics
  , getIncompleteProgressSessions
  -- ** Commands
  , executeCommand
  -- ** Code Actions
  , getCodeActions
  , getAllCodeActions
  , executeCodeAction
  -- ** Completions
  , getCompletions
  -- ** References
  , getReferences
  -- ** Definitions
  , getDeclarations
  , getDefinitions
  , getTypeDefinitions
  , getImplementations
  -- ** Renaming
  , rename
  -- ** Hover
  , getHover
  -- ** Highlights
  , getHighlights
  -- ** Formatting
  , formatDoc
  , formatRange
  -- ** Edits
  , applyEdit
  -- ** Code lenses
  , getCodeLenses
  -- ** Capabilities
  , getRegisteredCapabilities
  ) where

import Control.Applicative.Combinators
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Control.Exception
import Control.Lens hiding ((.=), List, Empty)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Aeson
import Data.Default
import qualified Data.HashMap.Strict as HashMap
import Data.List
import Data.Maybe
import Language.LSP.Types
import Language.LSP.Types.Lens hiding
  (id, capabilities, message, executeCommand, applyEdit, rename)
import qualified Language.LSP.Types.Lens as LSP
import qualified Language.LSP.Types.Capabilities as C
import Language.LSP.VFS
import Language.LSP.Test.Compat
import Language.LSP.Test.Decoding
import Language.LSP.Test.Exceptions
import Language.LSP.Test.Parsing
import Language.LSP.Test.Session
import Language.LSP.Test.Server
import System.Environment
import System.IO
import System.Directory
import System.FilePath
import System.Process (ProcessHandle)
import qualified System.FilePath.Glob as Glob

-- | 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 :: String -- ^ The command to run the server.
           -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
           -> FilePath -- ^ The filepath to the root directory for the session.
           -> Session a -- ^ The session to run.
           -> IO a
runSession :: String -> ClientCapabilities -> String -> Session a -> IO a
runSession = SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
forall a.
SessionConfig
-> String -> ClientCapabilities -> String -> Session a -> IO a
runSessionWithConfig SessionConfig
forall a. Default a => a
def

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

-- | Starts a new session, using the specified handles to communicate with the
-- server. You can use this to host the server within the same process.
-- An example with lsp might look like:
--
-- > (hinRead, hinWrite) <- createPipe
-- > (houtRead, houtWrite) <- createPipe
-- > 
-- > forkIO $ void $ runServerWithHandles hinRead houtWrite serverDefinition
-- > runSessionWithHandles hinWrite houtRead defaultConfig fullCaps "." $ do
-- >   -- ...
runSessionWithHandles :: Handle -- ^ The input handle
                      -> Handle -- ^ The output handle
                      -> SessionConfig
                      -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a
runSessionWithHandles :: Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles = Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
forall a.
Maybe ProcessHandle
-> Handle
-> Handle
-> SessionConfig
-> ClientCapabilities
-> String
-> Session a
-> IO a
runSessionWithHandles' Maybe ProcessHandle
forall a. Maybe a
Nothing


runSessionWithHandles' :: Maybe ProcessHandle
                       -> Handle -- ^ The input handle
                       -> Handle -- ^ The output handle
                       -> SessionConfig
                       -> C.ClientCapabilities -- ^ The capabilities that the client should declare.
                       -> FilePath -- ^ The filepath to the root directory for the session.
                       -> Session a -- ^ The session to run.
                       -> IO a
runSessionWithHandles' :: 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
-> Maybe Int
-> Maybe ClientInfo
-> Maybe Text
-> Maybe Uri
-> Maybe Value
-> ClientCapabilities
-> Maybe Trace
-> Maybe (List WorkspaceFolder)
-> InitializeParams
InitializeParams Maybe ProgressToken
forall a. Maybe a
Nothing
                                          (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pid)
                                          (ClientInfo -> Maybe ClientInfo
forall a. a -> Maybe a
Just ClientInfo
lspTestClientInfo)
                                          (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
absRootDir)
                                          (Uri -> Maybe Uri
forall a. a -> Maybe a
Just (Uri -> Maybe Uri) -> Uri -> Maybe Uri
forall a b. (a -> b) -> a -> b
$ String -> Uri
filePathToUri String
absRootDir)
                                          Maybe Value
forall a. Maybe a
Nothing
                                          ClientCapabilities
caps
                                          (Trace -> Maybe Trace
forall a. a -> Maybe a
Just Trace
TraceOff)
                                          ([WorkspaceFolder] -> List WorkspaceFolder
forall a. [a] -> List a
List ([WorkspaceFolder] -> List WorkspaceFolder)
-> Maybe [WorkspaceFolder] -> Maybe (List WorkspaceFolder)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionConfig -> Maybe [WorkspaceFolder]
initialWorkspaceFolders SessionConfig
config)
  Handle
-> Handle
-> Maybe ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
forall a.
Handle
-> Handle
-> Maybe ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
runSession' Handle
serverIn Handle
serverOut Maybe ProcessHandle
serverProc Handle -> SessionContext -> IO ()
listenServer SessionConfig
config ClientCapabilities
caps String
rootDir Session ()
exitServer (Session a -> IO a) -> Session a -> IO a
forall a b. (a -> b) -> a -> b
$ do
    -- Wrap the session around initialize and shutdown calls
    LspId 'Initialize
initReqId <- SClientMethod 'Initialize
-> MessageParams 'Initialize -> Session (LspId 'Initialize)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod 'Initialize
SInitialize MessageParams 'Initialize
InitializeParams
initializeParams

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

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

    MVar (ResponseMessage 'Initialize)
initRspVar <- SessionContext -> MVar (ResponseMessage 'Initialize)
initRsp (SessionContext -> MVar (ResponseMessage 'Initialize))
-> Session SessionContext
-> Session (MVar (ResponseMessage 'Initialize))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask
    IO () -> Session ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ MVar (ResponseMessage 'Initialize)
-> ResponseMessage 'Initialize -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (ResponseMessage 'Initialize)
initRspVar ResponseMessage 'Initialize
initRspMsg
    SClientMethod 'Initialized
-> MessageParams 'Initialized -> Session ()
forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Initialized
SInitialized (InitializedParams -> Maybe InitializedParams
forall a. a -> Maybe a
Just InitializedParams
InitializedParams)

    case SessionConfig -> Maybe Value
lspConfig SessionConfig
config of
      Just Value
cfg -> SClientMethod 'WorkspaceDidChangeConfiguration
-> MessageParams 'WorkspaceDidChangeConfiguration -> Session ()
forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'WorkspaceDidChangeConfiguration
SWorkspaceDidChangeConfiguration (Value -> DidChangeConfigurationParams
DidChangeConfigurationParams Value
cfg)
      Maybe Value
Nothing -> () -> Session ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

    -- Run the actual test
    Session a
session
  where
  -- | Asks the server to shutdown and exit politely
  exitServer :: Session ()
  exitServer :: Session ()
exitServer = SClientMethod 'Shutdown -> MessageParams 'Shutdown -> Session ()
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session ()
request_ SClientMethod 'Shutdown
SShutdown MessageParams 'Shutdown
Empty
Empty Session () -> Session () -> Session ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SClientMethod 'Exit -> MessageParams 'Exit -> Session ()
forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod 'Exit
SExit MessageParams 'Exit
Empty
Empty

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

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

    case FromServerMessage
msg of
      (FromServerRsp SMethod m
SShutdown ResponseMessage m
_) -> () -> IO ()
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
SWindowShowMessage Message m
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SWindowLogMessage Message m
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
STelemetryEvent Message m
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (FromServerMess SMethod m
SWindowShowMessageRequest Message m
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage FromServerMessage
msg = SessionException -> Session ()
forall a e. Exception e => e -> a
throw (FromServerMessage -> SessionException
IllegalInitSequenceMessage FromServerMessage
msg)

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

-- | The current text contents of a document.
documentContents :: TextDocumentIdentifier -> Session T.Text
documentContents :: TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc = do
  VFS
vfs <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let file :: VirtualFile
file = VFS -> Map NormalizedUri VirtualFile
vfsMap VFS
vfs Map NormalizedUri VirtualFile -> NormalizedUri -> VirtualFile
forall k a. Ord k => Map k a -> k -> a
Map.! Uri -> NormalizedUri
toNormalizedUri (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
uri)
  Text -> Session Text
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
  RequestMessage 'WorkspaceApplyEdit
req <- SServerMethod 'WorkspaceApplyEdit
-> Session (ServerMessage 'WorkspaceApplyEdit)
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
message SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit

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

  TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc
  where
    checkDocumentChanges :: RequestMessage 'WorkspaceApplyEdit -> Bool
checkDocumentChanges RequestMessage 'WorkspaceApplyEdit
req =
      let changes :: Maybe (List DocumentChange)
changes = RequestMessage 'WorkspaceApplyEdit
req RequestMessage 'WorkspaceApplyEdit
-> Getting
     (Maybe (List DocumentChange))
     (RequestMessage 'WorkspaceApplyEdit)
     (Maybe (List DocumentChange))
-> Maybe (List DocumentChange)
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const (Maybe (List DocumentChange)) ApplyWorkspaceEditParams)
-> RequestMessage 'WorkspaceApplyEdit
-> Const
     (Maybe (List DocumentChange)) (RequestMessage 'WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
  -> Const (Maybe (List DocumentChange)) ApplyWorkspaceEditParams)
 -> RequestMessage 'WorkspaceApplyEdit
 -> Const
      (Maybe (List DocumentChange)) (RequestMessage 'WorkspaceApplyEdit))
-> ((Maybe (List DocumentChange)
     -> Const
          (Maybe (List DocumentChange)) (Maybe (List DocumentChange)))
    -> ApplyWorkspaceEditParams
    -> Const (Maybe (List DocumentChange)) ApplyWorkspaceEditParams)
-> Getting
     (Maybe (List DocumentChange))
     (RequestMessage 'WorkspaceApplyEdit)
     (Maybe (List DocumentChange))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit
 -> Const (Maybe (List DocumentChange)) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (List DocumentChange)) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit
  -> Const (Maybe (List DocumentChange)) WorkspaceEdit)
 -> ApplyWorkspaceEditParams
 -> Const (Maybe (List DocumentChange)) ApplyWorkspaceEditParams)
-> ((Maybe (List DocumentChange)
     -> Const
          (Maybe (List DocumentChange)) (Maybe (List DocumentChange)))
    -> WorkspaceEdit
    -> Const (Maybe (List DocumentChange)) WorkspaceEdit)
-> (Maybe (List DocumentChange)
    -> Const
         (Maybe (List DocumentChange)) (Maybe (List DocumentChange)))
-> ApplyWorkspaceEditParams
-> Const (Maybe (List DocumentChange)) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (List DocumentChange)
 -> Const
      (Maybe (List DocumentChange)) (Maybe (List DocumentChange)))
-> WorkspaceEdit
-> Const (Maybe (List DocumentChange)) WorkspaceEdit
forall s a. HasDocumentChanges s a => Lens' s a
documentChanges
          maybeDocs :: Maybe (List Uri)
maybeDocs = (List DocumentChange -> List Uri)
-> Maybe (List DocumentChange) -> Maybe (List Uri)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DocumentChange -> Uri) -> List DocumentChange -> List Uri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DocumentChange -> Uri
documentChangeUri) Maybe (List DocumentChange)
changes
      in case Maybe (List Uri)
maybeDocs of
        Just List Uri
docs -> (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
uri) Uri -> List Uri -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` List Uri
docs
        Maybe (List Uri)
Nothing -> Bool
False
    checkChanges :: RequestMessage 'WorkspaceApplyEdit -> Bool
checkChanges RequestMessage 'WorkspaceApplyEdit
req =
      let mMap :: Maybe (HashMap Uri (List TextEdit))
mMap = RequestMessage 'WorkspaceApplyEdit
req RequestMessage 'WorkspaceApplyEdit
-> Getting
     (Maybe (HashMap Uri (List TextEdit)))
     (RequestMessage 'WorkspaceApplyEdit)
     (Maybe (HashMap Uri (List TextEdit)))
-> Maybe (HashMap Uri (List TextEdit))
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const
      (Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams)
-> RequestMessage 'WorkspaceApplyEdit
-> Const
     (Maybe (HashMap Uri (List TextEdit)))
     (RequestMessage 'WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
  -> Const
       (Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams)
 -> RequestMessage 'WorkspaceApplyEdit
 -> Const
      (Maybe (HashMap Uri (List TextEdit)))
      (RequestMessage 'WorkspaceApplyEdit))
-> ((Maybe (HashMap Uri (List TextEdit))
     -> Const
          (Maybe (HashMap Uri (List TextEdit)))
          (Maybe (HashMap Uri (List TextEdit))))
    -> ApplyWorkspaceEditParams
    -> Const
         (Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams)
-> Getting
     (Maybe (HashMap Uri (List TextEdit)))
     (RequestMessage 'WorkspaceApplyEdit)
     (Maybe (HashMap Uri (List TextEdit)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit
 -> Const (Maybe (HashMap Uri (List TextEdit))) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const
     (Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit
  -> Const (Maybe (HashMap Uri (List TextEdit))) WorkspaceEdit)
 -> ApplyWorkspaceEditParams
 -> Const
      (Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams)
-> ((Maybe (HashMap Uri (List TextEdit))
     -> Const
          (Maybe (HashMap Uri (List TextEdit)))
          (Maybe (HashMap Uri (List TextEdit))))
    -> WorkspaceEdit
    -> Const (Maybe (HashMap Uri (List TextEdit))) WorkspaceEdit)
-> (Maybe (HashMap Uri (List TextEdit))
    -> Const
         (Maybe (HashMap Uri (List TextEdit)))
         (Maybe (HashMap Uri (List TextEdit))))
-> ApplyWorkspaceEditParams
-> Const
     (Maybe (HashMap Uri (List TextEdit))) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (HashMap Uri (List TextEdit))
 -> Const
      (Maybe (HashMap Uri (List TextEdit)))
      (Maybe (HashMap Uri (List TextEdit))))
-> WorkspaceEdit
-> Const (Maybe (HashMap Uri (List TextEdit))) WorkspaceEdit
forall s a. HasChanges s a => Lens' s a
changes
        in Bool
-> (HashMap Uri (List TextEdit) -> Bool)
-> Maybe (HashMap Uri (List TextEdit))
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Uri -> HashMap Uri (List TextEdit) -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
uri)) Maybe (HashMap Uri (List 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 (ResponseMessage m)
request :: SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod m
m = SClientMethod m -> MessageParams m -> Session (LspId m)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (LspId m)
sendRequest SClientMethod m
m (MessageParams m -> Session (LspId m))
-> (LspId m -> Session (ResponseMessage m))
-> MessageParams m
-> Session (ResponseMessage m)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Session FromServerMessage
-> Session (ResponseMessage m) -> Session (ResponseMessage m)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (Session (ResponseMessage m) -> Session (ResponseMessage m))
-> (LspId m -> Session (ResponseMessage m))
-> LspId m
-> Session (ResponseMessage m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SClientMethod m -> LspId m -> Session (ResponseMessage m)
forall (m :: Method 'FromClient 'Request).
SMethod m -> LspId m -> Session (ResponseMessage m)
responseForId SClientMethod m
m

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

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

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

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

  ~() <- case SClientMethod m -> ClientNotOrReq m
forall (t :: MethodType) (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
method of
    ClientNotOrReq m
IsClientReq -> RequestMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage RequestMessage m
mess
    ClientNotOrReq m
IsClientEither -> CustomMessage 'FromClient 'Request -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (CustomMessage 'FromClient 'Request -> Session ())
-> CustomMessage 'FromClient 'Request -> Session ()
forall a b. (a -> b) -> a -> b
$ RequestMessage 'CustomMethod -> CustomMessage 'FromClient 'Request
forall (f :: From).
RequestMessage 'CustomMethod -> CustomMessage f 'Request
ReqMess RequestMessage m
RequestMessage 'CustomMethod
mess

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

-- | Sends a notification to the server.
sendNotification :: SClientMethod (m :: Method FromClient Notification) -- ^ The notification method.
                 -> MessageParams m -- ^ The notification parameters.
                 -> Session ()
-- Open a virtual file if we send a did open text document notification
sendNotification :: SClientMethod m -> MessageParams m -> Session ()
sendNotification SClientMethod m
STextDocumentDidOpen MessageParams m
params = do
  let n :: NotificationMessage 'TextDocumentDidOpen
n = Text
-> SMethod 'TextDocumentDidOpen
-> MessageParams 'TextDocumentDidOpen
-> NotificationMessage 'TextDocumentDidOpen
forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SMethod 'TextDocumentDidOpen
STextDocumentDidOpen MessageParams m
MessageParams 'TextDocumentDidOpen
params
  VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let (VFS
newVFS,[String]
_) = VFS -> Message 'TextDocumentDidOpen -> (VFS, [String])
openVFS VFS
oldVFS Message 'TextDocumentDidOpen
NotificationMessage 'TextDocumentDidOpen
n
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
  NotificationMessage 'TextDocumentDidOpen -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage NotificationMessage 'TextDocumentDidOpen
n

-- Close a virtual file if we send a close text document notification
sendNotification SClientMethod m
STextDocumentDidClose MessageParams m
params = do
  let n :: NotificationMessage 'TextDocumentDidClose
n = Text
-> SMethod 'TextDocumentDidClose
-> MessageParams 'TextDocumentDidClose
-> NotificationMessage 'TextDocumentDidClose
forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SMethod 'TextDocumentDidClose
STextDocumentDidClose MessageParams m
MessageParams 'TextDocumentDidClose
params
  VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let (VFS
newVFS,[String]
_) = VFS -> Message 'TextDocumentDidClose -> (VFS, [String])
closeVFS VFS
oldVFS Message 'TextDocumentDidClose
NotificationMessage 'TextDocumentDidClose
n
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
  NotificationMessage 'TextDocumentDidClose -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage NotificationMessage 'TextDocumentDidClose
n

sendNotification SClientMethod m
STextDocumentDidChange MessageParams m
params = do
    let n :: NotificationMessage 'TextDocumentDidChange
n = Text
-> SMethod 'TextDocumentDidChange
-> MessageParams 'TextDocumentDidChange
-> NotificationMessage 'TextDocumentDidChange
forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SMethod 'TextDocumentDidChange
STextDocumentDidChange MessageParams m
MessageParams 'TextDocumentDidChange
params
    VFS
oldVFS <- SessionState -> VFS
vfs (SessionState -> VFS) -> Session SessionState -> Session VFS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
    let (VFS
newVFS,[String]
_) = VFS -> Message 'TextDocumentDidChange -> (VFS, [String])
changeFromClientVFS VFS
oldVFS Message 'TextDocumentDidChange
NotificationMessage 'TextDocumentDidChange
n
    (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
    NotificationMessage 'TextDocumentDidChange -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage NotificationMessage 'TextDocumentDidChange
n

sendNotification SClientMethod m
method MessageParams m
params =
  case SClientMethod m -> ClientNotOrReq m
forall (t :: MethodType) (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
method of
    ClientNotOrReq m
IsClientNot -> NotificationMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (Text -> SClientMethod m -> MessageParams m -> NotificationMessage m
forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SClientMethod m
method MessageParams m
params)
    ClientNotOrReq m
IsClientEither -> CustomMessage 'FromClient 'Notification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (NotificationMessage 'CustomMethod
-> CustomMessage 'FromClient 'Notification
forall (f :: From).
NotificationMessage 'CustomMethod -> CustomMessage f 'Notification
NotMess (NotificationMessage 'CustomMethod
 -> CustomMessage 'FromClient 'Notification)
-> NotificationMessage 'CustomMethod
-> CustomMessage 'FromClient 'Notification
forall a b. (a -> b) -> a -> b
$ Text -> SClientMethod m -> MessageParams m -> NotificationMessage m
forall (f :: From) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> NotificationMessage m
NotificationMessage Text
"2.0" SClientMethod m
method MessageParams m
params)

-- | Sends a response to the server.
sendResponse :: ToJSON (ResponseResult m) => ResponseMessage m -> Session ()
sendResponse :: ResponseMessage m -> Session ()
sendResponse = ResponseMessage m -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage

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

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

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

      createHits :: WatchKind -> Bool
createHits (WatchKind Bool
create Bool
_ Bool
_) = Bool
create

      regHits :: Registration WorkspaceDidChangeWatchedFiles -> Bool
      regHits :: Registration 'WorkspaceDidChangeWatchedFiles -> Bool
regHits Registration 'WorkspaceDidChangeWatchedFiles
reg = (Bool -> FileSystemWatcher -> Bool)
-> Bool -> List FileSystemWatcher -> Bool
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 (Registration 'WorkspaceDidChangeWatchedFiles
reg Registration 'WorkspaceDidChangeWatchedFiles
-> Getting
     (List FileSystemWatcher)
     (Registration 'WorkspaceDidChangeWatchedFiles)
     (List FileSystemWatcher)
-> List FileSystemWatcher
forall s a. s -> Getting a s a -> a
^. (DidChangeWatchedFilesRegistrationOptions
 -> Const
      (List FileSystemWatcher) DidChangeWatchedFilesRegistrationOptions)
-> Registration 'WorkspaceDidChangeWatchedFiles
-> Const
     (List FileSystemWatcher)
     (Registration 'WorkspaceDidChangeWatchedFiles)
forall s a. HasRegisterOptions s a => Lens' s a
registerOptions ((DidChangeWatchedFilesRegistrationOptions
  -> Const
       (List FileSystemWatcher) DidChangeWatchedFilesRegistrationOptions)
 -> Registration 'WorkspaceDidChangeWatchedFiles
 -> Const
      (List FileSystemWatcher)
      (Registration 'WorkspaceDidChangeWatchedFiles))
-> ((List FileSystemWatcher
     -> Const (List FileSystemWatcher) (List FileSystemWatcher))
    -> DidChangeWatchedFilesRegistrationOptions
    -> Const
         (List FileSystemWatcher) DidChangeWatchedFilesRegistrationOptions)
-> Getting
     (List FileSystemWatcher)
     (Registration 'WorkspaceDidChangeWatchedFiles)
     (List FileSystemWatcher)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List FileSystemWatcher
 -> Const (List FileSystemWatcher) (List FileSystemWatcher))
-> DidChangeWatchedFilesRegistrationOptions
-> Const
     (List FileSystemWatcher) DidChangeWatchedFilesRegistrationOptions
forall s a. HasWatchers s a => Lens' s a
watchers)

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

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

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

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

-- | Closes a text document and sends a textDocument/didOpen notification to the server.
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc TextDocumentIdentifier
docId = do
  let params :: DidCloseTextDocumentParams
params = TextDocumentIdentifier -> DidCloseTextDocumentParams
DidCloseTextDocumentParams (Uri -> TextDocumentIdentifier
TextDocumentIdentifier (TextDocumentIdentifier
docId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
uri))
  SMethod 'TextDocumentDidClose
-> MessageParams 'TextDocumentDidClose -> Session ()
forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'TextDocumentDidClose
STextDocumentDidClose MessageParams '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
-> List TextDocumentContentChangeEvent
-> DidChangeTextDocumentParams
DidChangeTextDocumentParams (VersionedTextDocumentIdentifier
verDoc VersionedTextDocumentIdentifier
-> (VersionedTextDocumentIdentifier
    -> VersionedTextDocumentIdentifier)
-> VersionedTextDocumentIdentifier
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
version ((Maybe Int -> Identity (Maybe Int))
 -> VersionedTextDocumentIdentifier
 -> Identity VersionedTextDocumentIdentifier)
-> ((Int -> Identity Int) -> Maybe Int -> Identity (Maybe Int))
-> (Int -> Identity Int)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Iso' (Maybe Int) Int
forall a. Eq a => a -> Iso' (Maybe a) a
non Int
0 ((Int -> Identity Int)
 -> VersionedTextDocumentIdentifier
 -> Identity VersionedTextDocumentIdentifier)
-> Int
-> VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1) ([TextDocumentContentChangeEvent]
-> List TextDocumentContentChangeEvent
forall a. [a] -> List a
List [TextDocumentContentChangeEvent]
changes)
  SMethod 'TextDocumentDidChange
-> MessageParams 'TextDocumentDidChange -> Session ()
forall (m :: Method 'FromClient 'Notification).
SClientMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'TextDocumentDidChange
STextDocumentDidChange MessageParams 'TextDocumentDidChange
DidChangeTextDocumentParams
params

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

-- | Waits for diagnostics to be published and returns them.
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics :: Session [Diagnostic]
waitForDiagnostics = do
  NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot <- Session FromServerMessage
-> Session (NotificationMessage 'TextDocumentPublishDiagnostics)
-> Session (NotificationMessage 'TextDocumentPublishDiagnostics)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (SServerMethod 'TextDocumentPublishDiagnostics
-> Session (ServerMessage 'TextDocumentPublishDiagnostics)
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
message SServerMethod 'TextDocumentPublishDiagnostics
STextDocumentPublishDiagnostics)
  let (List [Diagnostic]
diags) = NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot NotificationMessage 'TextDocumentPublishDiagnostics
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const (List Diagnostic) PublishDiagnosticsParams)
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> Const
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
params ((PublishDiagnosticsParams
  -> Const (List Diagnostic) PublishDiagnosticsParams)
 -> NotificationMessage 'TextDocumentPublishDiagnostics
 -> Const
      (List Diagnostic)
      (NotificationMessage 'TextDocumentPublishDiagnostics))
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
    -> PublishDiagnosticsParams
    -> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
LSP.diagnostics
  [Diagnostic] -> Session [Diagnostic]
forall (m :: * -> *) a. Monad m => a -> m a
return [Diagnostic]
diags

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

-- | Expects a 'PublishDiagnosticsNotification' and throws an
-- 'UnexpectedDiagnostics' exception if there are any diagnostics
-- returned.
noDiagnostics :: Session ()
noDiagnostics :: Session ()
noDiagnostics = do
  NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot <- SServerMethod 'TextDocumentPublishDiagnostics
-> Session (ServerMessage 'TextDocumentPublishDiagnostics)
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> Session (ServerMessage m)
message SServerMethod 'TextDocumentPublishDiagnostics
STextDocumentPublishDiagnostics
  Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NotificationMessage 'TextDocumentPublishDiagnostics
diagsNot NotificationMessage 'TextDocumentPublishDiagnostics
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const (List Diagnostic) PublishDiagnosticsParams)
-> NotificationMessage 'TextDocumentPublishDiagnostics
-> Const
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
forall s a. HasParams s a => Lens' s a
params ((PublishDiagnosticsParams
  -> Const (List Diagnostic) PublishDiagnosticsParams)
 -> NotificationMessage 'TextDocumentPublishDiagnostics
 -> Const
      (List Diagnostic)
      (NotificationMessage 'TextDocumentPublishDiagnostics))
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
    -> PublishDiagnosticsParams
    -> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
     (List Diagnostic)
     (NotificationMessage 'TextDocumentPublishDiagnostics)
     (List Diagnostic)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
-> PublishDiagnosticsParams
-> Const (List Diagnostic) PublishDiagnosticsParams
forall s a. HasDiagnostics s a => Lens' s a
LSP.diagnostics List Diagnostic -> List Diagnostic -> Bool
forall a. Eq a => a -> a -> Bool
/= [Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List []) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ IO () -> Session ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ SessionException -> IO ()
forall a e. Exception e => e -> a
throw SessionException
UnexpectedDiagnostics

-- | Returns the symbols in a document.
getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation])
getDocumentSymbols :: TextDocumentIdentifier
-> Session (Either [DocumentSymbol] [SymbolInformation])
getDocumentSymbols TextDocumentIdentifier
doc = do
  ResponseMessage Text
_ Maybe (LspId 'TextDocumentDocumentSymbol)
rspLid Either ResponseError (ResponseResult 'TextDocumentDocumentSymbol)
res <- SClientMethod 'TextDocumentDocumentSymbol
-> MessageParams 'TextDocumentDocumentSymbol
-> Session (ResponseMessage 'TextDocumentDocumentSymbol)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentDocumentSymbol
STextDocumentDocumentSymbol (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> DocumentSymbolParams
DocumentSymbolParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc)
  case Either ResponseError (ResponseResult 'TextDocumentDocumentSymbol)
res of
    Right (InL (List xs)) -> Either [DocumentSymbol] [SymbolInformation]
-> Session (Either [DocumentSymbol] [SymbolInformation])
forall (m :: * -> *) a. Monad m => a -> m a
return ([DocumentSymbol] -> Either [DocumentSymbol] [SymbolInformation]
forall a b. a -> Either a b
Left [DocumentSymbol]
xs)
    Right (InR (List xs)) -> Either [DocumentSymbol] [SymbolInformation]
-> Session (Either [DocumentSymbol] [SymbolInformation])
forall (m :: * -> *) a. Monad m => a -> m a
return ([SymbolInformation] -> Either [DocumentSymbol] [SymbolInformation]
forall a b. b -> Either a b
Right [SymbolInformation]
xs)
    Left ResponseError
err -> SessionException
-> Session (Either [DocumentSymbol] [SymbolInformation])
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'TextDocumentDocumentSymbol -> SomeLspId
forall (f :: From) (m :: Method f 'Request). LspId m -> SomeLspId
SomeLspId (LspId 'TextDocumentDocumentSymbol -> SomeLspId)
-> LspId 'TextDocumentDocumentSymbol -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'TextDocumentDocumentSymbol)
-> LspId 'TextDocumentDocumentSymbol
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId '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
  ResponseMessage 'TextDocumentCodeAction
rsp <- SClientMethod 'TextDocumentCodeAction
-> MessageParams 'TextDocumentCodeAction
-> Session (ResponseMessage 'TextDocumentCodeAction)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentCodeAction
STextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range CodeActionContext
ctx)

  case ResponseMessage 'TextDocumentCodeAction
rsp ResponseMessage 'TextDocumentCodeAction
-> Getting
     (Either ResponseError (List (Command |? CodeAction)))
     (ResponseMessage 'TextDocumentCodeAction)
     (Either ResponseError (List (Command |? CodeAction)))
-> Either ResponseError (List (Command |? CodeAction))
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError (List (Command |? CodeAction)))
  (ResponseMessage 'TextDocumentCodeAction)
  (Either ResponseError (List (Command |? CodeAction)))
forall s a. HasResult s a => Lens' s a
result of
    Right (List [Command |? CodeAction]
xs) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall (m :: * -> *) a. Monad m => a -> m a
return [Command |? CodeAction]
xs
    Left ResponseError
error -> SessionException -> Session [Command |? CodeAction]
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'TextDocumentCodeAction -> SomeLspId
forall (f :: From) (m :: Method f 'Request). LspId m -> SomeLspId
SomeLspId (LspId 'TextDocumentCodeAction -> SomeLspId)
-> LspId 'TextDocumentCodeAction -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'TextDocumentCodeAction)
-> LspId 'TextDocumentCodeAction
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (LspId 'TextDocumentCodeAction)
 -> LspId 'TextDocumentCodeAction)
-> Maybe (LspId 'TextDocumentCodeAction)
-> LspId 'TextDocumentCodeAction
forall a b. (a -> b) -> a -> b
$ ResponseMessage 'TextDocumentCodeAction
rsp ResponseMessage 'TextDocumentCodeAction
-> Getting
     (Maybe (LspId 'TextDocumentCodeAction))
     (ResponseMessage 'TextDocumentCodeAction)
     (Maybe (LspId 'TextDocumentCodeAction))
-> Maybe (LspId 'TextDocumentCodeAction)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (LspId 'TextDocumentCodeAction))
  (ResponseMessage 'TextDocumentCodeAction)
  (Maybe (LspId 'TextDocumentCodeAction))
forall s a. HasId s a => Lens' s a
LSP.id) ResponseError
error)

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

  ([Command |? CodeAction]
 -> Diagnostic -> Session [Command |? CodeAction])
-> [Command |? CodeAction]
-> [Diagnostic]
-> Session [Command |? CodeAction]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CodeActionContext
-> [Command |? CodeAction]
-> Diagnostic
-> Session [Command |? CodeAction]
go CodeActionContext
ctx) [] ([Diagnostic] -> Session [Command |? CodeAction])
-> Session [Diagnostic] -> Session [Command |? CodeAction]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc

  where
    go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
    go :: CodeActionContext
-> [Command |? CodeAction]
-> Diagnostic
-> Session [Command |? CodeAction]
go CodeActionContext
ctx [Command |? CodeAction]
acc Diagnostic
diag = do
      ResponseMessage Text
_ Maybe (LspId 'TextDocumentCodeAction)
rspLid Either ResponseError (ResponseResult 'TextDocumentCodeAction)
res <- SClientMethod 'TextDocumentCodeAction
-> MessageParams 'TextDocumentCodeAction
-> Session (ResponseMessage 'TextDocumentCodeAction)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentCodeAction
STextDocumentCodeAction (Maybe ProgressToken
-> Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> CodeActionParams
CodeActionParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc (Diagnostic
diag Diagnostic -> Getting Range Diagnostic Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range Diagnostic Range
forall s a. HasRange s a => Lens' s a
range) CodeActionContext
ctx)

      case Either ResponseError (ResponseResult 'TextDocumentCodeAction)
res of
        Left ResponseError
e -> SessionException -> Session [Command |? CodeAction]
forall a e. Exception e => e -> a
throw (SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError (LspId 'TextDocumentCodeAction -> SomeLspId
forall (f :: From) (m :: Method f 'Request). LspId m -> SomeLspId
SomeLspId (LspId 'TextDocumentCodeAction -> SomeLspId)
-> LspId 'TextDocumentCodeAction -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId 'TextDocumentCodeAction)
-> LspId 'TextDocumentCodeAction
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (LspId 'TextDocumentCodeAction)
rspLid) ResponseError
e)
        Right (List cmdOrCAs) -> [Command |? CodeAction] -> Session [Command |? CodeAction]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Command |? CodeAction]
acc [Command |? CodeAction]
-> [Command |? CodeAction] -> [Command |? CodeAction]
forall a. [a] -> [a] -> [a]
++ [Command |? CodeAction]
cmdOrCAs)

getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext
getCodeActionContextInRange :: TextDocumentIdentifier -> Range -> Session CodeActionContext
getCodeActionContextInRange TextDocumentIdentifier
doc Range
caRange = do
  [Diagnostic]
curDiags <- TextDocumentIdentifier -> Session [Diagnostic]
getCurrentDiagnostics TextDocumentIdentifier
doc
  let diags :: [Diagnostic]
diags = [ Diagnostic
d | d :: Diagnostic
d@Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range=Range
range} <- [Diagnostic]
curDiags
                  , Range -> Range -> Bool
overlappingRange Range
caRange Range
range
              ]
  CodeActionContext -> Session CodeActionContext
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeActionContext -> Session CodeActionContext)
-> CodeActionContext -> Session CodeActionContext
forall a b. (a -> b) -> a -> b
$ List Diagnostic -> Maybe (List CodeActionKind) -> CodeActionContext
CodeActionContext ([Diagnostic] -> List Diagnostic
forall a. [a] -> List a
List [Diagnostic]
diags) Maybe (List CodeActionKind)
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 Int
pl Int
po) (Range (Position Int
sl Int
so) (Position Int
el Int
eo)) =
         Int
pl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
sl Bool -> Bool -> Bool
&& Int
pl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
el
      Bool -> Bool -> Bool
|| Int
pl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl Bool -> Bool -> Bool
&& Int
pl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
po Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
so Bool -> Bool -> Bool
&& Int
po Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
eo
      Bool -> Bool -> Bool
|| Int
pl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl Bool -> Bool -> Bool
&& Int
po Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
so
      Bool -> Bool -> Bool
|| Int
pl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
po Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
eo

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

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

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

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

-- | Executes a code action.
-- Matching with the specification, if a code action
-- contains both an edit and a command, the edit will
-- be applied first.
executeCodeAction :: CodeAction -> Session ()
executeCodeAction :: CodeAction -> Session ()
executeCodeAction CodeAction
action = do
  Session ()
-> (WorkspaceEdit -> Session ())
-> Maybe WorkspaceEdit
-> Session ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Session ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) WorkspaceEdit -> Session ()
handleEdit (Maybe WorkspaceEdit -> Session ())
-> Maybe WorkspaceEdit -> Session ()
forall a b. (a -> b) -> a -> b
$ CodeAction
action CodeAction
-> Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
-> Maybe WorkspaceEdit
forall s a. s -> Getting a s a -> a
^. Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
forall s a. HasEdit s a => Lens' s a
edit
  Session ()
-> (Command -> Session ()) -> Maybe Command -> Session ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Session ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Command -> Session ()
executeCommand (Maybe Command -> Session ()) -> Maybe Command -> Session ()
forall a b. (a -> b) -> a -> b
$ CodeAction
action CodeAction
-> Getting (Maybe Command) CodeAction (Maybe Command)
-> Maybe Command
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Command) CodeAction (Maybe Command)
forall s a. HasCommand s a => Lens' s a
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 :: RequestMessage 'WorkspaceApplyEdit
req = Text
-> LspId 'WorkspaceApplyEdit
-> SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> RequestMessage 'WorkspaceApplyEdit
forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"" (Int -> LspId 'WorkspaceApplyEdit
forall (f :: From) (m :: Method f 'Request). Int -> LspId m
IdInt Int
0) SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
e)
            in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'WorkspaceApplyEdit
-> ServerMessage 'WorkspaceApplyEdit -> FromServerMessage
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit ServerMessage 'WorkspaceApplyEdit
RequestMessage 'WorkspaceApplyEdit
req)

-- | 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
  Map NormalizedUri VirtualFile
fs <- VFS -> Map NormalizedUri VirtualFile
vfsMap (VFS -> Map NormalizedUri VirtualFile)
-> (SessionState -> VFS)
-> SessionState
-> Map NormalizedUri VirtualFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> VFS
vfs (SessionState -> Map NormalizedUri VirtualFile)
-> Session SessionState -> Session (Map NormalizedUri VirtualFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  let ver :: Maybe Int
ver =
        case Map NormalizedUri VirtualFile
fs Map NormalizedUri VirtualFile -> NormalizedUri -> Maybe VirtualFile
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? Uri -> NormalizedUri
toNormalizedUri Uri
uri of
          Just VirtualFile
vf -> Int -> Maybe Int
forall a. a -> Maybe a
Just (VirtualFile -> Int
virtualFileVersion VirtualFile
vf)
          Maybe VirtualFile
_ -> Maybe Int
forall a. Maybe a
Nothing
  VersionedTextDocumentIdentifier
-> Session VersionedTextDocumentIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Maybe Int -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri Maybe Int
ver)

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

  VersionedTextDocumentIdentifier
verDoc <- TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
doc

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

  let supportsDocChanges :: Bool
supportsDocChanges = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
        let mWorkspace :: Maybe WorkspaceClientCapabilities
mWorkspace = ClientCapabilities
caps ClientCapabilities
-> Getting
     (Maybe WorkspaceClientCapabilities)
     ClientCapabilities
     (Maybe WorkspaceClientCapabilities)
-> Maybe WorkspaceClientCapabilities
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe WorkspaceClientCapabilities)
  ClientCapabilities
  (Maybe WorkspaceClientCapabilities)
forall s a. HasWorkspace s a => Lens' s a
LSP.workspace
        C.WorkspaceClientCapabilities Maybe Bool
_ Maybe WorkspaceEditClientCapabilities
mEdit Maybe DidChangeConfigurationClientCapabilities
_ Maybe DidChangeWatchedFilesClientCapabilities
_ Maybe WorkspaceSymbolClientCapabilities
_ Maybe ExecuteCommandClientCapabilities
_ Maybe Bool
_ Maybe Bool
_ <- Maybe WorkspaceClientCapabilities
mWorkspace
        C.WorkspaceEditClientCapabilities Maybe Bool
mDocChanges Maybe (List ResourceOperationKind)
_ Maybe FailureHandlingKind
_ Maybe Bool
_ Maybe WorkspaceEditChangeAnnotationClientCapabilities
_ <- Maybe WorkspaceEditClientCapabilities
mEdit
        Maybe Bool
mDocChanges

  let wEdit :: WorkspaceEdit
wEdit = if Bool
supportsDocChanges
      then
        let docEdit :: TextDocumentEdit
docEdit = VersionedTextDocumentIdentifier
-> List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit
TextDocumentEdit VersionedTextDocumentIdentifier
verDoc ([TextEdit |? AnnotatedTextEdit]
-> List (TextEdit |? AnnotatedTextEdit)
forall a. [a] -> List a
List [TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
InL TextEdit
edit])
        in Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit Maybe (HashMap Uri (List TextEdit))
forall a. Maybe a
Nothing (List DocumentChange -> Maybe (List DocumentChange)
forall a. a -> Maybe a
Just ([DocumentChange] -> List DocumentChange
forall a. [a] -> List a
List [TextDocumentEdit -> DocumentChange
forall a b. a -> a |? b
InL TextDocumentEdit
docEdit])) Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
      else
        let changes :: HashMap Uri (List TextEdit)
changes = Uri -> List TextEdit -> HashMap Uri (List TextEdit)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
uri) ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
edit])
        in Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (HashMap Uri (List TextEdit) -> Maybe (HashMap Uri (List TextEdit))
forall a. a -> Maybe a
Just HashMap Uri (List TextEdit)
changes) Maybe (List DocumentChange)
forall a. Maybe a
Nothing Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing

  let req :: RequestMessage 'WorkspaceApplyEdit
req = Text
-> LspId 'WorkspaceApplyEdit
-> SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> RequestMessage 'WorkspaceApplyEdit
forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"" (Int -> LspId 'WorkspaceApplyEdit
forall (f :: From) (m :: Method f 'Request). Int -> LspId m
IdInt Int
0) SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
  FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'WorkspaceApplyEdit
-> ServerMessage 'WorkspaceApplyEdit -> FromServerMessage
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit ServerMessage 'WorkspaceApplyEdit
RequestMessage '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
  ResponseMessage 'TextDocumentCompletion
rsp <- SClientMethod 'TextDocumentCompletion
-> MessageParams 'TextDocumentCompletion
-> Session (ResponseMessage 'TextDocumentCompletion)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentCompletion
STextDocumentCompletion (TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> Maybe CompletionContext
-> CompletionParams
CompletionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing Maybe CompletionContext
forall a. Maybe a
Nothing)

  case ResponseMessage 'TextDocumentCompletion
-> ResponseResult 'TextDocumentCompletion
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage 'TextDocumentCompletion
rsp of
    InL (List items) -> [CompletionItem] -> Session [CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
    InR (CompletionList _ (List items)) -> [CompletionItem] -> Session [CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items

-- | Returns the references for the position in the document.
getReferences :: TextDocumentIdentifier -- ^ The document to lookup in.
              -> Position -- ^ The position to lookup.
              -> Bool -- ^ Whether to include declarations as references.
              -> Session (List Location) -- ^ The locations of the references.
getReferences :: TextDocumentIdentifier
-> Position -> Bool -> Session (List Location)
getReferences TextDocumentIdentifier
doc Position
pos Bool
inclDecl =
  let ctx :: ReferenceContext
ctx = Bool -> ReferenceContext
ReferenceContext Bool
inclDecl
      params :: ReferenceParams
params = TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ReferenceContext
-> ReferenceParams
ReferenceParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing ReferenceContext
ctx
  in ResponseMessage 'TextDocumentReferences -> List Location
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult (ResponseMessage 'TextDocumentReferences -> List Location)
-> Session (ResponseMessage 'TextDocumentReferences)
-> Session (List Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'TextDocumentReferences
-> MessageParams 'TextDocumentReferences
-> Session (ResponseMessage 'TextDocumentReferences)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentReferences
STextDocumentReferences MessageParams 'TextDocumentReferences
ReferenceParams
params

-- | Returns the declarations(s) for the term at the specified position.
getDeclarations :: TextDocumentIdentifier -- ^ The document the term is in.
                -> Position -- ^ The position the term is at.
                -> Session ([Location] |? [LocationLink])
getDeclarations :: TextDocumentIdentifier
-> Position -> Session ([Location] |? [LocationLink])
getDeclarations = SClientMethod 'TextDocumentDeclaration
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams 'TextDocumentDeclaration)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SClientMethod 'TextDocumentDeclaration
STextDocumentDeclaration TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> MessageParams 'TextDocumentDeclaration
TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DeclarationParams
DeclarationParams

-- | Returns the definition(s) for the term at the specified position.
getDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
               -> Position -- ^ The position the term is at.
               -> Session ([Location] |? [LocationLink])
getDefinitions :: TextDocumentIdentifier
-> Position -> Session ([Location] |? [LocationLink])
getDefinitions = SClientMethod 'TextDocumentDefinition
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams 'TextDocumentDefinition)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SClientMethod 'TextDocumentDefinition
STextDocumentDefinition TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> MessageParams 'TextDocumentDefinition
TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DefinitionParams
DefinitionParams

-- | Returns the type definition(s) for the term at the specified position.
getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in.
                   -> Position -- ^ The position the term is at.
                   -> Session ([Location] |? [LocationLink])
getTypeDefinitions :: TextDocumentIdentifier
-> Position -> Session ([Location] |? [LocationLink])
getTypeDefinitions = SClientMethod 'TextDocumentTypeDefinition
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams 'TextDocumentTypeDefinition)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SClientMethod 'TextDocumentTypeDefinition
STextDocumentTypeDefinition TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> MessageParams 'TextDocumentTypeDefinition
TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> TypeDefinitionParams
TypeDefinitionParams 

-- | Returns the type definition(s) for the term at the specified position.
getImplementations :: TextDocumentIdentifier -- ^ The document the term is in.
                   -> Position -- ^ The position the term is at.
                   -> Session ([Location] |? [LocationLink])
getImplementations :: TextDocumentIdentifier
-> Position -> Session ([Location] |? [LocationLink])
getImplementations = SClientMethod 'TextDocumentImplementation
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams 'TextDocumentImplementation)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
forall (m :: Method 'FromClient 'Request).
(ResponseResult m
 ~ (Location |? (List Location |? List LocationLink))) =>
SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SClientMethod 'TextDocumentImplementation
STextDocumentImplementation TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> MessageParams 'TextDocumentImplementation
TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> ImplementationParams
ImplementationParams


getDeclarationyRequest :: (ResponseResult m ~ (Location |? (List Location |? List LocationLink)))
                       => SClientMethod m
                       -> (TextDocumentIdentifier
                            -> Position
                            -> Maybe ProgressToken
                            -> Maybe ProgressToken
                            -> MessageParams m)
                       -> TextDocumentIdentifier
                       -> Position
                       -> Session ([Location] |? [LocationLink])
getDeclarationyRequest :: SClientMethod m
-> (TextDocumentIdentifier
    -> Position
    -> Maybe ProgressToken
    -> Maybe ProgressToken
    -> MessageParams m)
-> TextDocumentIdentifier
-> Position
-> Session ([Location] |? [LocationLink])
getDeclarationyRequest SClientMethod m
method TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> MessageParams m
paramCons TextDocumentIdentifier
doc Position
pos = do
  let params :: MessageParams m
params = TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> MessageParams m
paramCons TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing
  ResponseMessage m
rsp <- SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod m
method MessageParams m
params
  case ResponseMessage m -> ResponseResult m
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage m
rsp of
      InL loc -> ([Location] |? [LocationLink])
-> Session ([Location] |? [LocationLink])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Location] -> [Location] |? [LocationLink]
forall a b. a -> a |? b
InL [Location
loc])
      InR (InL (List locs)) -> ([Location] |? [LocationLink])
-> Session ([Location] |? [LocationLink])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Location] -> [Location] |? [LocationLink]
forall a b. a -> a |? b
InL [Location]
locs)
      InR (InR (List locLinks)) -> ([Location] |? [LocationLink])
-> Session ([Location] |? [LocationLink])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([LocationLink] -> [Location] |? [LocationLink]
forall a b. b -> a |? b
InR [LocationLink]
locLinks)

-- | 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 = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> Text -> RenameParams
RenameParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing (String -> Text
T.pack String
newName)
  ResponseMessage 'TextDocumentRename
rsp <- SClientMethod 'TextDocumentRename
-> MessageParams 'TextDocumentRename
-> Session (ResponseMessage 'TextDocumentRename)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentRename
STextDocumentRename MessageParams 'TextDocumentRename
RenameParams
params
  let wEdit :: ResponseResult 'TextDocumentRename
wEdit = ResponseMessage 'TextDocumentRename
-> ResponseResult 'TextDocumentRename
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage 'TextDocumentRename
rsp
      req :: RequestMessage 'WorkspaceApplyEdit
req = Text
-> LspId 'WorkspaceApplyEdit
-> SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> RequestMessage 'WorkspaceApplyEdit
forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"" (Int -> LspId 'WorkspaceApplyEdit
forall (f :: From) (m :: Method f 'Request). Int -> LspId m
IdInt Int
0) SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing ResponseResult 'TextDocumentRename
WorkspaceEdit
wEdit)
  FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'WorkspaceApplyEdit
-> ServerMessage 'WorkspaceApplyEdit -> FromServerMessage
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit ServerMessage 'WorkspaceApplyEdit
RequestMessage 'WorkspaceApplyEdit
req)

-- | Returns the hover information at the specified position.
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover)
getHover TextDocumentIdentifier
doc Position
pos =
  let params :: HoverParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> HoverParams
HoverParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
  in ResponseMessage 'TextDocumentHover -> Maybe Hover
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult (ResponseMessage 'TextDocumentHover -> Maybe Hover)
-> Session (ResponseMessage 'TextDocumentHover)
-> Session (Maybe Hover)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'TextDocumentHover
-> MessageParams 'TextDocumentHover
-> Session (ResponseMessage 'TextDocumentHover)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentHover
STextDocumentHover MessageParams 'TextDocumentHover
HoverParams
params

-- | Returns the highlighted occurences of the term at the specified position
getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight)
getHighlights :: TextDocumentIdentifier
-> Position -> Session (List DocumentHighlight)
getHighlights TextDocumentIdentifier
doc Position
pos =
  let params :: DocumentHighlightParams
params = TextDocumentIdentifier
-> Position
-> Maybe ProgressToken
-> Maybe ProgressToken
-> DocumentHighlightParams
DocumentHighlightParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing
  in ResponseMessage 'TextDocumentDocumentHighlight
-> List DocumentHighlight
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult (ResponseMessage 'TextDocumentDocumentHighlight
 -> List DocumentHighlight)
-> Session (ResponseMessage 'TextDocumentDocumentHighlight)
-> Session (List DocumentHighlight)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'TextDocumentDocumentHighlight
-> MessageParams 'TextDocumentDocumentHighlight
-> Session (ResponseMessage 'TextDocumentDocumentHighlight)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentDocumentHighlight
STextDocumentDocumentHighlight MessageParams 'TextDocumentDocumentHighlight
DocumentHighlightParams
params

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

-- | Applies formatting to the specified document.
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
formatDoc TextDocumentIdentifier
doc FormattingOptions
opts = do
  let params :: DocumentFormattingParams
params = Maybe ProgressToken
-> TextDocumentIdentifier
-> FormattingOptions
-> DocumentFormattingParams
DocumentFormattingParams Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc FormattingOptions
opts
  List TextEdit
edits <- ResponseMessage 'TextDocumentFormatting -> List TextEdit
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult (ResponseMessage 'TextDocumentFormatting -> List TextEdit)
-> Session (ResponseMessage 'TextDocumentFormatting)
-> Session (List TextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'TextDocumentFormatting
-> MessageParams 'TextDocumentFormatting
-> Session (ResponseMessage 'TextDocumentFormatting)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentFormatting
STextDocumentFormatting MessageParams 'TextDocumentFormatting
DocumentFormattingParams
params
  TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits

-- | Applies formatting to the specified range in a document.
formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session ()
formatRange TextDocumentIdentifier
doc FormattingOptions
opts Range
range = do
  let params :: DocumentRangeFormattingParams
params = Maybe ProgressToken
-> TextDocumentIdentifier
-> Range
-> FormattingOptions
-> DocumentRangeFormattingParams
DocumentRangeFormattingParams Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
doc Range
range FormattingOptions
opts
  List TextEdit
edits <- ResponseMessage 'TextDocumentRangeFormatting -> List TextEdit
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult (ResponseMessage 'TextDocumentRangeFormatting -> List TextEdit)
-> Session (ResponseMessage 'TextDocumentRangeFormatting)
-> Session (List TextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SClientMethod 'TextDocumentRangeFormatting
-> MessageParams 'TextDocumentRangeFormatting
-> Session (ResponseMessage 'TextDocumentRangeFormatting)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentRangeFormatting
STextDocumentRangeFormatting MessageParams 'TextDocumentRangeFormatting
DocumentRangeFormattingParams
params
  TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits

applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits :: TextDocumentIdentifier -> List TextEdit -> Session ()
applyTextEdits TextDocumentIdentifier
doc List TextEdit
edits =
  let wEdit :: WorkspaceEdit
wEdit = Maybe (HashMap Uri (List TextEdit))
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (HashMap Uri (List TextEdit) -> Maybe (HashMap Uri (List TextEdit))
forall a. a -> Maybe a
Just (Uri -> List TextEdit -> HashMap Uri (List TextEdit)
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton (TextDocumentIdentifier
doc TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
uri) List TextEdit
edits)) Maybe (List DocumentChange)
forall a. Maybe a
Nothing Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
      -- Send a dummy message to updateState so it can do bookkeeping
      req :: RequestMessage 'WorkspaceApplyEdit
req = Text
-> LspId 'WorkspaceApplyEdit
-> SServerMethod 'WorkspaceApplyEdit
-> MessageParams 'WorkspaceApplyEdit
-> RequestMessage 'WorkspaceApplyEdit
forall (f :: From) (m :: Method f 'Request).
Text -> LspId m -> SMethod m -> MessageParams m -> RequestMessage m
RequestMessage Text
"" (Int -> LspId 'WorkspaceApplyEdit
forall (f :: From) (m :: Method f 'Request). Int -> LspId m
IdInt Int
0) SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
wEdit)
  in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (SServerMethod 'WorkspaceApplyEdit
-> ServerMessage 'WorkspaceApplyEdit -> FromServerMessage
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SServerMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit ServerMessage 'WorkspaceApplyEdit
RequestMessage 'WorkspaceApplyEdit
req)

-- | Returns the code lenses for the specified document.
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId = do
    ResponseMessage 'TextDocumentCodeLens
rsp <- SClientMethod 'TextDocumentCodeLens
-> MessageParams 'TextDocumentCodeLens
-> Session (ResponseMessage 'TextDocumentCodeLens)
forall (m :: Method 'FromClient 'Request).
SClientMethod m -> MessageParams m -> Session (ResponseMessage m)
request SClientMethod 'TextDocumentCodeLens
STextDocumentCodeLens (Maybe ProgressToken
-> Maybe ProgressToken -> TextDocumentIdentifier -> CodeLensParams
CodeLensParams Maybe ProgressToken
forall a. Maybe a
Nothing Maybe ProgressToken
forall a. Maybe a
Nothing TextDocumentIdentifier
tId)
    case ResponseMessage 'TextDocumentCodeLens
-> ResponseResult 'TextDocumentCodeLens
forall (f :: From) (m :: Method f 'Request).
ResponseMessage m -> ResponseResult m
getResponseResult ResponseMessage 'TextDocumentCodeLens
rsp of
        List res -> [CodeLens] -> Session [CodeLens]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [CodeLens]
res

-- | Returns a list of capabilities that the server has requested to /dynamically/
-- register during the 'Session'.
--
-- @since 0.11.0.0
getRegisteredCapabilities :: Session [SomeRegistration]
getRegisteredCapabilities :: Session [SomeRegistration]
getRegisteredCapabilities = Map Text SomeRegistration -> [SomeRegistration]
forall k a. Map k a -> [a]
Map.elems (Map Text SomeRegistration -> [SomeRegistration])
-> (SessionState -> Map Text SomeRegistration)
-> SessionState
-> [SomeRegistration]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map Text SomeRegistration
curDynCaps (SessionState -> [SomeRegistration])
-> Session SessionState -> Session [SomeRegistration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get