{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ExistentialQuantification #-}

{-|
Module      : Language.Haskell.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.Haskell.LSP.Types" alongside this.
-}
module Language.Haskell.LSP.Test
  (
  -- * Sessions
    Session
  , runSession
  -- ** Config
  , runSessionWithConfig
  , SessionConfig(..)
  , defaultConfig
  , C.fullCaps
  -- ** Exceptions
  , module Language.Haskell.LSP.Test.Exceptions
  , withTimeout
  -- * Sending
  , request
  , request_
  , sendRequest
  , sendNotification
  , sendResponse
  -- * Receving
  , module Language.Haskell.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
  , getDefinitions
  , getTypeDefinitions
  -- ** 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)
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.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Lens hiding
  (id, capabilities, message, executeCommand, applyEdit, rename)
import qualified Language.Haskell.LSP.Types.Lens as LSP
import qualified Language.Haskell.LSP.Types.Capabilities as C
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Compat
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Exceptions
import Language.Haskell.LSP.Test.Parsing
import Language.Haskell.LSP.Test.Session
import Language.Haskell.LSP.Test.Server
import System.Environment
import System.IO
import System.Directory
import System.FilePath
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 TextDocumentHover 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
  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 Int
-> Maybe Text
-> Maybe Uri
-> Maybe Value
-> ClientCapabilities
-> Maybe Trace
-> Maybe (List WorkspaceFolder)
-> InitializeParams
InitializeParams (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
pid)
                                          (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)
                                          Maybe (List WorkspaceFolder)
forall a. Maybe a
Nothing
  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 ->
    Handle
-> Handle
-> ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
forall a.
Handle
-> Handle
-> ProcessHandle
-> (Handle -> SessionContext -> IO ())
-> SessionConfig
-> ClientCapabilities
-> String
-> Session ()
-> Session a
-> IO a
runSessionWithHandles Handle
serverIn Handle
serverOut 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
      -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
      LspId
initReqId <- ClientMethod -> InitializeParams -> Session LspId
forall params.
ToJSON params =>
ClientMethod -> params -> Session LspId
sendRequest ClientMethod
Initialize InitializeParams
initializeParams

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

      case ResponseMessage InitializeResponseCapabilities
initRspMsg ResponseMessage InitializeResponseCapabilities
-> Getting
     (Either ResponseError InitializeResponseCapabilities)
     (ResponseMessage InitializeResponseCapabilities)
     (Either ResponseError InitializeResponseCapabilities)
-> Either ResponseError InitializeResponseCapabilities
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError InitializeResponseCapabilities)
  (ResponseMessage InitializeResponseCapabilities)
  (Either ResponseError InitializeResponseCapabilities)
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 InitializeResponseCapabilities
_ -> () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      MVar (ResponseMessage InitializeResponseCapabilities)
initRspVar <- SessionContext
-> MVar (ResponseMessage InitializeResponseCapabilities)
initRsp (SessionContext
 -> MVar (ResponseMessage InitializeResponseCapabilities))
-> Session SessionContext
-> Session (MVar (ResponseMessage InitializeResponseCapabilities))
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 InitializeResponseCapabilities)
-> ResponseMessage InitializeResponseCapabilities -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (ResponseMessage InitializeResponseCapabilities)
initRspVar ResponseMessage InitializeResponseCapabilities
initRspMsg
      ClientMethod -> InitializedParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
Initialized InitializedParams
InitializedParams

      case SessionConfig -> Maybe Value
lspConfig SessionConfig
config of
        Just Value
cfg -> ClientMethod -> DidChangeConfigurationParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
WorkspaceDidChangeConfiguration (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 = ClientMethod -> Maybe Value -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
request_ ClientMethod
Shutdown (Maybe Value
forall a. Maybe a
Nothing :: Maybe Value) Session () -> Session () -> Session ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ClientMethod -> ExitParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
Exit ExitParams
ExitParams

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

    RequestMap
reqMap <- MVar RequestMap -> IO RequestMap
forall a. MVar a -> IO a
readMVar (MVar RequestMap -> IO RequestMap)
-> MVar RequestMap -> IO RequestMap
forall a b. (a -> b) -> a -> b
$ SessionContext -> MVar RequestMap
requestMap SessionContext
context

    let msg :: FromServerMessage
msg = RequestMap -> ByteString -> 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
      (RspShutdown ShutdownResponse
_) -> () -> 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 (NotShowMessage ShowMessageNotification
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (NotLogMessage LogMessageNotification
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (NotTelemetry TelemetryNotification
_) = () -> Session ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  checkLegalBetweenMessage (ReqShowMessage ShowMessageRequest
_) = () -> 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
  ApplyWorkspaceEditRequest
req <- Session ApplyWorkspaceEditRequest
forall a. (Typeable a, FromJSON a) => Session a
message :: Session ApplyWorkspaceEditRequest

  Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ApplyWorkspaceEditRequest -> Bool
checkDocumentChanges ApplyWorkspaceEditRequest
req Bool -> Bool -> Bool
|| ApplyWorkspaceEditRequest -> Bool
checkChanges ApplyWorkspaceEditRequest
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 (ApplyWorkspaceEditRequest -> String
forall a. Show a => a -> String
show ApplyWorkspaceEditRequest
req))

  TextDocumentIdentifier -> Session Text
documentContents TextDocumentIdentifier
doc
  where
    checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
    checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
checkDocumentChanges ApplyWorkspaceEditRequest
req =
      let changes :: Maybe (List TextDocumentEdit)
changes = ApplyWorkspaceEditRequest
req ApplyWorkspaceEditRequest
-> Getting
     (Maybe (List TextDocumentEdit))
     ApplyWorkspaceEditRequest
     (Maybe (List TextDocumentEdit))
-> Maybe (List TextDocumentEdit)
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditRequest
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
  -> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
 -> ApplyWorkspaceEditRequest
 -> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditRequest)
-> ((Maybe (List TextDocumentEdit)
     -> Const
          (Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
    -> ApplyWorkspaceEditParams
    -> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> Getting
     (Maybe (List TextDocumentEdit))
     ApplyWorkspaceEditRequest
     (Maybe (List TextDocumentEdit))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit
 -> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit
  -> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
 -> ApplyWorkspaceEditParams
 -> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams)
-> ((Maybe (List TextDocumentEdit)
     -> Const
          (Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
    -> WorkspaceEdit
    -> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit)
-> (Maybe (List TextDocumentEdit)
    -> Const
         (Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> ApplyWorkspaceEditParams
-> Const (Maybe (List TextDocumentEdit)) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (List TextDocumentEdit)
 -> Const
      (Maybe (List TextDocumentEdit)) (Maybe (List TextDocumentEdit)))
-> WorkspaceEdit
-> Const (Maybe (List TextDocumentEdit)) WorkspaceEdit
forall s a. HasDocumentChanges s a => Lens' s a
documentChanges
          maybeDocs :: Maybe (List Uri)
maybeDocs = (List TextDocumentEdit -> List Uri)
-> Maybe (List TextDocumentEdit) -> Maybe (List Uri)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TextDocumentEdit -> Uri) -> List TextDocumentEdit -> List Uri
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TextDocumentEdit -> Getting Uri TextDocumentEdit Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (VersionedTextDocumentIdentifier
 -> Const Uri VersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const Uri TextDocumentEdit
forall s a. HasTextDocument s a => Lens' s a
textDocument ((VersionedTextDocumentIdentifier
  -> Const Uri VersionedTextDocumentIdentifier)
 -> TextDocumentEdit -> Const Uri TextDocumentEdit)
-> ((Uri -> Const Uri Uri)
    -> VersionedTextDocumentIdentifier
    -> Const Uri VersionedTextDocumentIdentifier)
-> Getting Uri TextDocumentEdit Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> VersionedTextDocumentIdentifier
-> Const Uri VersionedTextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri)) Maybe (List TextDocumentEdit)
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 :: ApplyWorkspaceEditRequest -> Bool
    checkChanges :: ApplyWorkspaceEditRequest -> Bool
checkChanges ApplyWorkspaceEditRequest
req =
      let mMap :: Maybe WorkspaceEditMap
mMap = ApplyWorkspaceEditRequest
req ApplyWorkspaceEditRequest
-> Getting
     (Maybe WorkspaceEditMap)
     ApplyWorkspaceEditRequest
     (Maybe WorkspaceEditMap)
-> Maybe WorkspaceEditMap
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams)
-> ApplyWorkspaceEditRequest
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditRequest
forall s a. HasParams s a => Lens' s a
params ((ApplyWorkspaceEditParams
  -> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams)
 -> ApplyWorkspaceEditRequest
 -> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditRequest)
-> ((Maybe WorkspaceEditMap
     -> Const (Maybe WorkspaceEditMap) (Maybe WorkspaceEditMap))
    -> ApplyWorkspaceEditParams
    -> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams)
-> Getting
     (Maybe WorkspaceEditMap)
     ApplyWorkspaceEditRequest
     (Maybe WorkspaceEditMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const (Maybe WorkspaceEditMap) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
edit ((WorkspaceEdit -> Const (Maybe WorkspaceEditMap) WorkspaceEdit)
 -> ApplyWorkspaceEditParams
 -> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams)
-> ((Maybe WorkspaceEditMap
     -> Const (Maybe WorkspaceEditMap) (Maybe WorkspaceEditMap))
    -> WorkspaceEdit -> Const (Maybe WorkspaceEditMap) WorkspaceEdit)
-> (Maybe WorkspaceEditMap
    -> Const (Maybe WorkspaceEditMap) (Maybe WorkspaceEditMap))
-> ApplyWorkspaceEditParams
-> Const (Maybe WorkspaceEditMap) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe WorkspaceEditMap
 -> Const (Maybe WorkspaceEditMap) (Maybe WorkspaceEditMap))
-> WorkspaceEdit -> Const (Maybe WorkspaceEditMap) WorkspaceEdit
forall s a. HasChanges s a => Lens' s a
changes
        in Bool
-> (WorkspaceEditMap -> Bool) -> Maybe WorkspaceEditMap -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Uri -> WorkspaceEditMap -> 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 WorkspaceEditMap
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 TextDocumentDocumentSymbol params :: Session DocumentSymbolsResponse
-- @
-- Note: will skip any messages in between the request and the response.
request :: (ToJSON params, FromJSON a) => ClientMethod -> params -> Session (ResponseMessage a)
request :: ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
m = ClientMethod -> params -> Session LspId
forall params.
ToJSON params =>
ClientMethod -> params -> Session LspId
sendRequest ClientMethod
m (params -> Session LspId)
-> (LspId -> Session (ResponseMessage a))
-> params
-> Session (ResponseMessage a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Session FromServerMessage
-> Session (ResponseMessage a) -> Session (ResponseMessage a)
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage (Session (ResponseMessage a) -> Session (ResponseMessage a))
-> (LspId -> Session (ResponseMessage a))
-> LspId
-> Session (ResponseMessage a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LspId -> Session (ResponseMessage a)
forall a. FromJSON a => LspId -> Session (ResponseMessage a)
responseForId

-- | The same as 'sendRequest', but discard the response.
request_ :: ToJSON params => ClientMethod -> params -> Session ()
request_ :: ClientMethod -> params -> Session ()
request_ ClientMethod
p = Session (ResponseMessage Value) -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Session (ResponseMessage Value) -> Session ())
-> (params -> Session (ResponseMessage Value))
-> params
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ClientMethod -> params -> Session (ResponseMessage Value)
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
p :: ToJSON params => params -> Session (ResponseMessage Value))

-- | Sends a request to the server. Unlike 'request', this doesn't wait for the response.
sendRequest
  :: ToJSON params
  => ClientMethod -- ^ The request method.
  -> params -- ^ The request parameters.
  -> Session LspId -- ^ The id of the request that was sent.
sendRequest :: ClientMethod -> params -> Session LspId
sendRequest ClientMethod
method params
params = do
  LspId
id <- SessionState -> LspId
curReqId (SessionState -> LspId) -> Session SessionState -> Session LspId
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 :: LspId
curReqId = LspId -> LspId
nextId LspId
id }

  let req :: RequestMessage' params
req = Text -> LspId -> ClientMethod -> params -> RequestMessage' params
forall a. Text -> LspId -> ClientMethod -> a -> RequestMessage' a
RequestMessage' Text
"2.0" LspId
id ClientMethod
method params
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
$ RequestMap -> LspId -> ClientMethod -> RequestMap
updateRequestMap RequestMap
r LspId
id ClientMethod
method

  RequestMessage' params -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage RequestMessage' params
req

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

  where nextId :: LspId -> LspId
nextId (IdInt Int
i) = Int -> LspId
IdInt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        nextId (IdString Text
s) = Text -> LspId
IdString (Text -> LspId) -> Text -> LspId
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ String -> Integer
forall a. Read a => String -> a
read (Text -> String
T.unpack Text
s) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1

-- | A custom type for request message that doesn't
-- need a response type, allows us to infer the request
-- message type without using proxies.
data RequestMessage' a = RequestMessage' T.Text LspId ClientMethod a

instance ToJSON a => ToJSON (RequestMessage' a) where
  toJSON :: RequestMessage' a -> Value
toJSON (RequestMessage' Text
rpc LspId
id ClientMethod
method a
params) =
    [Pair] -> Value
object [Text
"jsonrpc" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
rpc, Text
"id" Text -> LspId -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LspId
id, Text
"method" Text -> ClientMethod -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ClientMethod
method, Text
"params" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
params]


-- | Sends a notification to the server.
sendNotification :: ToJSON a
                 => ClientMethod -- ^ The notification method.
                 -> a -- ^ The notification parameters.
                 -> Session ()

-- Open a virtual file if we send a did open text document notification
sendNotification :: ClientMethod -> a -> Session ()
sendNotification ClientMethod
TextDocumentDidOpen a
params = do
  let params' :: DidOpenTextDocumentParams
params' = Maybe DidOpenTextDocumentParams -> DidOpenTextDocumentParams
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DidOpenTextDocumentParams -> DidOpenTextDocumentParams)
-> Maybe DidOpenTextDocumentParams -> DidOpenTextDocumentParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe DidOpenTextDocumentParams
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe DidOpenTextDocumentParams)
-> ByteString -> Maybe DidOpenTextDocumentParams
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
params
      n :: DidOpenTextDocumentNotification
      n :: DidOpenTextDocumentNotification
n = Text
-> ClientMethod
-> DidOpenTextDocumentParams
-> DidOpenTextDocumentNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
TextDocumentDidOpen DidOpenTextDocumentParams
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 -> DidOpenTextDocumentNotification -> (VFS, [String])
openVFS VFS
oldVFS DidOpenTextDocumentNotification
n
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
  DidOpenTextDocumentNotification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage DidOpenTextDocumentNotification
n

-- Close a virtual file if we send a close text document notification
sendNotification ClientMethod
TextDocumentDidClose a
params = do
  let params' :: DidCloseTextDocumentParams
params' = Maybe DidCloseTextDocumentParams -> DidCloseTextDocumentParams
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DidCloseTextDocumentParams -> DidCloseTextDocumentParams)
-> Maybe DidCloseTextDocumentParams -> DidCloseTextDocumentParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe DidCloseTextDocumentParams
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe DidCloseTextDocumentParams)
-> ByteString -> Maybe DidCloseTextDocumentParams
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
params
      n :: DidCloseTextDocumentNotification
      n :: DidCloseTextDocumentNotification
n = Text
-> ClientMethod
-> DidCloseTextDocumentParams
-> DidCloseTextDocumentNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
TextDocumentDidClose DidCloseTextDocumentParams
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 -> DidCloseTextDocumentNotification -> (VFS, [String])
closeVFS VFS
oldVFS DidCloseTextDocumentNotification
n
  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
  DidCloseTextDocumentNotification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage DidCloseTextDocumentNotification
n

sendNotification ClientMethod
TextDocumentDidChange a
params = do
    let params' :: DidChangeTextDocumentParams
params' = Maybe DidChangeTextDocumentParams -> DidChangeTextDocumentParams
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe DidChangeTextDocumentParams -> DidChangeTextDocumentParams)
-> Maybe DidChangeTextDocumentParams -> DidChangeTextDocumentParams
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe DidChangeTextDocumentParams
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe DidChangeTextDocumentParams)
-> ByteString -> Maybe DidChangeTextDocumentParams
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
params
        n :: DidChangeTextDocumentNotification
        n :: DidChangeTextDocumentNotification
n = Text
-> ClientMethod
-> DidChangeTextDocumentParams
-> DidChangeTextDocumentNotification
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
TextDocumentDidChange DidChangeTextDocumentParams
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 -> DidChangeTextDocumentNotification -> (VFS, [String])
changeFromClientVFS VFS
oldVFS DidChangeTextDocumentNotification
n
    (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify (\SessionState
s -> SessionState
s { vfs :: VFS
vfs = VFS
newVFS })
    DidChangeTextDocumentNotification -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage DidChangeTextDocumentNotification
n

sendNotification ClientMethod
method a
params = NotificationMessage ClientMethod a -> Session ()
forall (m :: * -> *) a.
(MonadIO m, HasReader SessionContext m, ToJSON a) =>
a -> m ()
sendMessage (Text -> ClientMethod -> a -> NotificationMessage ClientMethod a
forall m a. Text -> m -> a -> NotificationMessage m a
NotificationMessage Text
"2.0" ClientMethod
method a
params)

-- | Sends a response to the server.
sendResponse :: ToJSON a => ResponseMessage a -> Session ()
sendResponse :: ResponseMessage a -> Session ()
sendResponse = ResponseMessage a -> 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 InitializeResponse
initializeResponse :: Session (ResponseMessage InitializeResponseCapabilities)
initializeResponse = SessionContext
-> MVar (ResponseMessage InitializeResponseCapabilities)
initRsp (SessionContext
 -> MVar (ResponseMessage InitializeResponseCapabilities))
-> Session SessionContext
-> Session (MVar (ResponseMessage InitializeResponseCapabilities))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionContext
forall r (m :: * -> *). HasReader r m => m r
ask Session (MVar (ResponseMessage InitializeResponseCapabilities))
-> (MVar (ResponseMessage InitializeResponseCapabilities)
    -> Session (ResponseMessage InitializeResponseCapabilities))
-> Session (ResponseMessage InitializeResponseCapabilities)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (ResponseMessage InitializeResponseCapabilities)
-> Session (ResponseMessage InitializeResponseCapabilities)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ResponseMessage InitializeResponseCapabilities)
 -> Session (ResponseMessage InitializeResponseCapabilities))
-> (MVar (ResponseMessage InitializeResponseCapabilities)
    -> IO (ResponseMessage InitializeResponseCapabilities))
-> MVar (ResponseMessage InitializeResponseCapabilities)
-> Session (ResponseMessage InitializeResponseCapabilities)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (ResponseMessage InitializeResponseCapabilities)
-> IO (ResponseMessage InitializeResponseCapabilities)
forall a. MVar a -> IO a
readMVar)

-- | /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__.
          -> String -- ^ 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 -> String -> Text -> Session TextDocumentIdentifier
createDoc String
file String
languageId Text
contents = do
  Map Text Registration
dynCaps <- SessionState -> Map Text Registration
curDynCaps (SessionState -> Map Text Registration)
-> Session SessionState -> Session (Map Text Registration)
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 regs :: [Registration]
regs = (Registration -> Bool) -> [Registration] -> [Registration]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Registration
r -> Registration
r Registration
-> Getting ClientMethod Registration ClientMethod -> ClientMethod
forall s a. s -> Getting a s a -> a
^. Getting ClientMethod Registration ClientMethod
forall s a. HasMethod s a => Lens' s a
method ClientMethod -> ClientMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientMethod
WorkspaceDidChangeWatchedFiles) ([Registration] -> [Registration])
-> [Registration] -> [Registration]
forall a b. (a -> b) -> a -> b
$
              Map Text Registration -> [Registration]
forall k a. Map k a -> [a]
Map.elems Map Text Registration
dynCaps
      watchHits :: FileSystemWatcher -> Bool
      watchHits :: FileSystemWatcher -> Bool
watchHits (FileSystemWatcher String
pattern Maybe WatchKind
kind) =
        -- If WatchKind is exlcuded, defaults to all true as per spec
        String -> Bool
fileMatches String
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 -> Bool
      regHits :: Registration -> Bool
regHits Registration
reg = Maybe () -> Bool
forall a. Maybe a -> Bool
isJust (Maybe () -> Bool) -> Maybe () -> Bool
forall a b. (a -> b) -> a -> b
$ do
        Value
opts <- Registration
reg Registration
-> Getting (Maybe Value) Registration (Maybe Value) -> Maybe Value
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Value) Registration (Maybe Value)
forall s a. HasRegisterOptions s a => Lens' s a
registerOptions
        DidChangeWatchedFilesRegistrationOptions
fileWatchOpts <- case Value -> Result DidChangeWatchedFilesRegistrationOptions
forall a. FromJSON a => Value -> Result a
fromJSON Value
opts :: Result DidChangeWatchedFilesRegistrationOptions of
          Success DidChangeWatchedFilesRegistrationOptions
x -> DidChangeWatchedFilesRegistrationOptions
-> Maybe DidChangeWatchedFilesRegistrationOptions
forall a. a -> Maybe a
Just DidChangeWatchedFilesRegistrationOptions
x
          Error String
_ -> Maybe DidChangeWatchedFilesRegistrationOptions
forall a. Maybe a
Nothing
        if (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 (DidChangeWatchedFilesRegistrationOptions
fileWatchOpts DidChangeWatchedFilesRegistrationOptions
-> Getting
     (List FileSystemWatcher)
     DidChangeWatchedFilesRegistrationOptions
     (List FileSystemWatcher)
-> List FileSystemWatcher
forall s a. s -> Getting a s a -> a
^. Getting
  (List FileSystemWatcher)
  DidChangeWatchedFilesRegistrationOptions
  (List FileSystemWatcher)
forall s a. HasWatchers s a => Lens' s a
watchers)
          then () -> Maybe ()
forall a. a -> Maybe a
Just ()
          else Maybe ()
forall a. Maybe a
Nothing

      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 -> Bool) -> Bool -> [Registration] -> Bool
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Bool
acc Registration
r -> Bool
acc Bool -> Bool -> Bool
|| Registration -> Bool
regHits Registration
r) Bool
False [Registration]
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
$
    ClientMethod -> DidChangeWatchedFilesParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
WorkspaceDidChangeWatchedFiles (DidChangeWatchedFilesParams -> Session ())
-> DidChangeWatchedFilesParams -> 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 -> String -> Text -> Session TextDocumentIdentifier
openDoc' String
file String
languageId Text
contents

-- | Opens a text document that /exists on disk/, and sends a
-- textDocument/didOpen notification to the server.
openDoc :: FilePath -> String -> Session TextDocumentIdentifier
openDoc :: String -> String -> Session TextDocumentIdentifier
openDoc String
file String
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 -> String -> Text -> Session TextDocumentIdentifier
openDoc' String
file String
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 -> String -> T.Text -> Session TextDocumentIdentifier
openDoc' :: String -> String -> Text -> Session TextDocumentIdentifier
openDoc' String
file String
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 (String -> Text
T.pack String
languageId) Int
0 Text
contents
  ClientMethod -> DidOpenTextDocumentParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
TextDocumentDidOpen (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))
  ClientMethod -> DidCloseTextDocumentParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
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)
  ClientMethod -> DidChangeTextDocumentParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
sendNotification ClientMethod
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
  PublishDiagnosticsNotification
diagsNot <- Session FromServerMessage
-> Session PublishDiagnosticsNotification
-> Session PublishDiagnosticsNotification
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill Session FromServerMessage
anyMessage Session PublishDiagnosticsNotification
forall a. (Typeable a, FromJSON a) => Session a
message :: Session PublishDiagnosticsNotification
  let (List [Diagnostic]
diags) = PublishDiagnosticsNotification
diagsNot PublishDiagnosticsNotification
-> Getting
     (List Diagnostic) PublishDiagnosticsNotification (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const (List Diagnostic) PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const (List Diagnostic) PublishDiagnosticsNotification
forall s a. HasParams s a => Lens' s a
params ((PublishDiagnosticsParams
  -> Const (List Diagnostic) PublishDiagnosticsParams)
 -> PublishDiagnosticsNotification
 -> Const (List Diagnostic) PublishDiagnosticsNotification)
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
    -> PublishDiagnosticsParams
    -> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
     (List Diagnostic) PublishDiagnosticsNotification (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.Haskell.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
  PublishDiagnosticsNotification
diagsNot <- Session PublishDiagnosticsNotification
forall a. (Typeable a, FromJSON a) => Session a
message :: Session PublishDiagnosticsNotification
  Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PublishDiagnosticsNotification
diagsNot PublishDiagnosticsNotification
-> Getting
     (List Diagnostic) PublishDiagnosticsNotification (List Diagnostic)
-> List Diagnostic
forall s a. s -> Getting a s a -> a
^. (PublishDiagnosticsParams
 -> Const (List Diagnostic) PublishDiagnosticsParams)
-> PublishDiagnosticsNotification
-> Const (List Diagnostic) PublishDiagnosticsNotification
forall s a. HasParams s a => Lens' s a
params ((PublishDiagnosticsParams
  -> Const (List Diagnostic) PublishDiagnosticsParams)
 -> PublishDiagnosticsNotification
 -> Const (List Diagnostic) PublishDiagnosticsNotification)
-> ((List Diagnostic -> Const (List Diagnostic) (List Diagnostic))
    -> PublishDiagnosticsParams
    -> Const (List Diagnostic) PublishDiagnosticsParams)
-> Getting
     (List Diagnostic) PublishDiagnosticsNotification (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
_ LspIdRsp
rspLid Either ResponseError DSResult
res <- ClientMethod
-> DocumentSymbolParams -> Session (ResponseMessage DSResult)
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentDocumentSymbol (TextDocumentIdentifier
-> Maybe ProgressToken -> DocumentSymbolParams
DocumentSymbolParams TextDocumentIdentifier
doc Maybe ProgressToken
forall a. Maybe a
Nothing) :: Session DocumentSymbolsResponse
  case Either ResponseError DSResult
res of
    Right (DSDocumentSymbols (List [DocumentSymbol]
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 (DSSymbolInformation (List [SymbolInformation]
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 (LspIdRsp -> ResponseError -> SessionException
UnexpectedResponseError LspIdRsp
rspLid ResponseError
err)

-- | Returns the code actions in the specified range.
getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult]
getCodeActions TextDocumentIdentifier
doc Range
range = do
  CodeActionContext
ctx <- TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc
  ResponseMessage (List CAResult)
rsp <- ClientMethod
-> CodeActionParams -> Session (ResponseMessage (List CAResult))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentCodeAction (TextDocumentIdentifier
-> Range
-> CodeActionContext
-> Maybe ProgressToken
-> CodeActionParams
CodeActionParams TextDocumentIdentifier
doc Range
range CodeActionContext
ctx Maybe ProgressToken
forall a. Maybe a
Nothing)

  case ResponseMessage (List CAResult)
rsp ResponseMessage (List CAResult)
-> Getting
     (Either ResponseError (List CAResult))
     (ResponseMessage (List CAResult))
     (Either ResponseError (List CAResult))
-> Either ResponseError (List CAResult)
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError (List CAResult))
  (ResponseMessage (List CAResult))
  (Either ResponseError (List CAResult))
forall s a. HasResult s a => Lens' s a
result of
    Right (List [CAResult]
xs) -> [CAResult] -> Session [CAResult]
forall (m :: * -> *) a. Monad m => a -> m a
return [CAResult]
xs
    Left ResponseError
error -> SessionException -> Session [CAResult]
forall a e. Exception e => e -> a
throw (LspIdRsp -> ResponseError -> SessionException
UnexpectedResponseError (ResponseMessage (List CAResult)
rsp ResponseMessage (List CAResult)
-> Getting LspIdRsp (ResponseMessage (List CAResult)) LspIdRsp
-> LspIdRsp
forall s a. s -> Getting a s a -> a
^. Getting LspIdRsp (ResponseMessage (List CAResult)) LspIdRsp
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 [CAResult]
getAllCodeActions :: TextDocumentIdentifier -> Session [CAResult]
getAllCodeActions TextDocumentIdentifier
doc = do
  CodeActionContext
ctx <- TextDocumentIdentifier -> Session CodeActionContext
getCodeActionContext TextDocumentIdentifier
doc

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

  where
    go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
    go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult]
go CodeActionContext
ctx [CAResult]
acc Diagnostic
diag = do
      ResponseMessage Text
_ LspIdRsp
rspLid Either ResponseError (List CAResult)
res <- ClientMethod
-> CodeActionParams -> Session (ResponseMessage (List CAResult))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentCodeAction (TextDocumentIdentifier
-> Range
-> CodeActionContext
-> Maybe ProgressToken
-> CodeActionParams
CodeActionParams 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 Maybe ProgressToken
forall a. Maybe a
Nothing)

      case Either ResponseError (List CAResult)
res of
        Left ResponseError
e -> SessionException -> Session [CAResult]
forall a e. Exception e => e -> a
throw (LspIdRsp -> ResponseError -> SessionException
UnexpectedResponseError LspIdRsp
rspLid ResponseError
e)
        Right (List [CAResult]
cmdOrCAs) -> [CAResult] -> Session [CAResult]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([CAResult]
acc [CAResult] -> [CAResult] -> [CAResult]
forall a. [a] -> [a] -> [a]
++ [CAResult]
cmdOrCAs)

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 = Text
-> Maybe (List Value)
-> Maybe ProgressToken
-> ExecuteCommandParams
ExecuteCommandParams (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 Maybe ProgressToken
forall a. Maybe a
Nothing
  ClientMethod -> ExecuteCommandParams -> Session ()
forall a. ToJSON a => ClientMethod -> a -> Session ()
request_ ClientMethod
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 ServerMethod ApplyWorkspaceEditParams resp
req = Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage ServerMethod ApplyWorkspaceEditParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"" (Int -> LspId
IdInt Int
0) ServerMethod
WorkspaceApplyEdit (WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
e)
            in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
forall resp.
RequestMessage ServerMethod ApplyWorkspaceEditParams resp
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 -> Maybe WorkspaceClientCapabilities
C._workspace ClientCapabilities
caps
        C.WorkspaceClientCapabilities Maybe Bool
_ Maybe WorkspaceEditClientCapabilities
mEdit Maybe DidChangeConfigurationClientCapabilities
_ Maybe DidChangeWatchedFilesClientCapabilities
_ Maybe SymbolClientCapabilities
_ Maybe ExecuteClientCapabilities
_ Maybe Bool
_ Maybe Bool
_ <- Maybe WorkspaceClientCapabilities
mWorkspace
        C.WorkspaceEditClientCapabilities Maybe Bool
mDocChanges <- Maybe WorkspaceEditClientCapabilities
mEdit
        Maybe Bool
mDocChanges

  let wEdit :: WorkspaceEdit
wEdit = if Bool
supportsDocChanges
      then
        let docEdit :: TextDocumentEdit
docEdit = VersionedTextDocumentIdentifier
-> List TextEdit -> TextDocumentEdit
TextDocumentEdit VersionedTextDocumentIdentifier
verDoc ([TextEdit] -> List TextEdit
forall a. [a] -> List a
List [TextEdit
edit])
        in Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
forall a. Maybe a
Nothing (List TextDocumentEdit -> Maybe (List TextDocumentEdit)
forall a. a -> Maybe a
Just ([TextDocumentEdit] -> List TextDocumentEdit
forall a. [a] -> List a
List [TextDocumentEdit
docEdit]))
      else
        let changes :: WorkspaceEditMap
changes = Uri -> List TextEdit -> WorkspaceEditMap
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 WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just WorkspaceEditMap
changes) Maybe (List TextDocumentEdit)
forall a. Maybe a
Nothing

  let req :: RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req = Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage ServerMethod ApplyWorkspaceEditParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"" (Int -> LspId
IdInt Int
0) ServerMethod
WorkspaceApplyEdit (WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
wEdit)
  FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
forall resp.
RequestMessage ServerMethod ApplyWorkspaceEditParams resp
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 CompletionResponseResult
rsp <- ClientMethod
-> TextDocumentPositionParams
-> Session (ResponseMessage CompletionResponseResult)
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentCompletion (TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing)

  case ResponseMessage CompletionResponseResult
-> CompletionResponseResult
forall a. ResponseMessage a -> a
getResponseResult ResponseMessage CompletionResponseResult
rsp of
    Completions (List [CompletionItem]
items) -> [CompletionItem] -> Session [CompletionItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [CompletionItem]
items
    CompletionList (CompletionListType Bool
_ (List [CompletionItem]
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 [Location] -- ^ The locations of the references.
getReferences :: TextDocumentIdentifier -> Position -> Bool -> Session [Location]
getReferences TextDocumentIdentifier
doc Position
pos Bool
inclDecl =
  let ctx :: ReferenceContext
ctx = Bool -> ReferenceContext
ReferenceContext Bool
inclDecl
      params :: ReferenceParams
params = TextDocumentIdentifier
-> Position
-> ReferenceContext
-> Maybe ProgressToken
-> ReferenceParams
ReferenceParams TextDocumentIdentifier
doc Position
pos ReferenceContext
ctx Maybe ProgressToken
forall a. Maybe a
Nothing
  in ResponseMessage [Location] -> [Location]
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage [Location] -> [Location])
-> Session (ResponseMessage [Location]) -> Session [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> ReferenceParams -> Session (ResponseMessage [Location])
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentReferences ReferenceParams
params

-- | 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] -- ^ The location(s) of the definitions
getDefinitions :: TextDocumentIdentifier -> Position -> Session [Location]
getDefinitions TextDocumentIdentifier
doc Position
pos = do
  let params :: TextDocumentPositionParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
  DefinitionResponse
rsp <- ClientMethod
-> TextDocumentPositionParams -> Session DefinitionResponse
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentDefinition TextDocumentPositionParams
params :: Session DefinitionResponse
  case DefinitionResponse -> LocationResponseParams
forall a. ResponseMessage a -> a
getResponseResult DefinitionResponse
rsp of
    SingleLoc Location
loc -> [Location] -> Session [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Location
loc]
    MultiLoc [Location]
locs -> [Location] -> Session [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Location]
locs

-- | 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] -- ^ The location(s) of the definitions
getTypeDefinitions :: TextDocumentIdentifier -> Position -> Session [Location]
getTypeDefinitions TextDocumentIdentifier
doc Position
pos = do
  let params :: TextDocumentPositionParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
  DefinitionResponse
rsp <- ClientMethod
-> TextDocumentPositionParams -> Session DefinitionResponse
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentTypeDefinition TextDocumentPositionParams
params :: Session TypeDefinitionResponse
  case DefinitionResponse -> LocationResponseParams
forall a. ResponseMessage a -> a
getResponseResult DefinitionResponse
rsp of
    SingleLoc Location
loc -> [Location] -> Session [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Location
loc]
    MultiLoc [Location]
locs -> [Location] -> Session [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Location]
locs

-- | 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 -> Text -> Maybe ProgressToken -> RenameParams
RenameParams TextDocumentIdentifier
doc Position
pos (String -> Text
T.pack String
newName) Maybe ProgressToken
forall a. Maybe a
Nothing
  RenameResponse
rsp <- ClientMethod -> RenameParams -> Session RenameResponse
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentRename RenameParams
params :: Session RenameResponse
  let wEdit :: WorkspaceEdit
wEdit = RenameResponse -> WorkspaceEdit
forall a. ResponseMessage a -> a
getResponseResult RenameResponse
rsp
      req :: RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req = Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage ServerMethod ApplyWorkspaceEditParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"" (Int -> LspId
IdInt Int
0) ServerMethod
WorkspaceApplyEdit (WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
wEdit)
  FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
forall resp.
RequestMessage ServerMethod ApplyWorkspaceEditParams resp
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 :: TextDocumentPositionParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
  in ResponseMessage (Maybe Hover) -> Maybe Hover
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage (Maybe Hover) -> Maybe Hover)
-> Session (ResponseMessage (Maybe Hover)) -> Session (Maybe Hover)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> TextDocumentPositionParams
-> Session (ResponseMessage (Maybe Hover))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentHover TextDocumentPositionParams
params

-- | Returns the highlighted occurences of the term at the specified position
getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight]
getHighlights TextDocumentIdentifier
doc Position
pos =
  let params :: TextDocumentPositionParams
params = TextDocumentIdentifier
-> Position -> Maybe ProgressToken -> TextDocumentPositionParams
TextDocumentPositionParams TextDocumentIdentifier
doc Position
pos Maybe ProgressToken
forall a. Maybe a
Nothing
  in ResponseMessage [DocumentHighlight] -> [DocumentHighlight]
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage [DocumentHighlight] -> [DocumentHighlight])
-> Session (ResponseMessage [DocumentHighlight])
-> Session [DocumentHighlight]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> TextDocumentPositionParams
-> Session (ResponseMessage [DocumentHighlight])
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentDocumentHighlight TextDocumentPositionParams
params

-- | Checks the response for errors and throws an exception if needed.
-- Returns the result if successful.
getResponseResult :: ResponseMessage a -> a
getResponseResult :: ResponseMessage a -> a
getResponseResult ResponseMessage a
rsp =
  case ResponseMessage a
rsp ResponseMessage a
-> Getting
     (Either ResponseError a)
     (ResponseMessage a)
     (Either ResponseError a)
-> Either ResponseError a
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError a)
  (ResponseMessage a)
  (Either ResponseError a)
forall s a. HasResult s a => Lens' s a
result of
    Right a
x -> a
x
    Left ResponseError
err -> SessionException -> a
forall a e. Exception e => e -> a
throw (SessionException -> a) -> SessionException -> a
forall a b. (a -> b) -> a -> b
$ LspIdRsp -> ResponseError -> SessionException
UnexpectedResponseError (ResponseMessage a
rsp ResponseMessage a
-> Getting LspIdRsp (ResponseMessage a) LspIdRsp -> LspIdRsp
forall s a. s -> Getting a s a -> a
^. Getting LspIdRsp (ResponseMessage a) LspIdRsp
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 = TextDocumentIdentifier
-> FormattingOptions
-> Maybe ProgressToken
-> DocumentFormattingParams
DocumentFormattingParams TextDocumentIdentifier
doc FormattingOptions
opts Maybe ProgressToken
forall a. Maybe a
Nothing
  List TextEdit
edits <- ResponseMessage (List TextEdit) -> List TextEdit
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage (List TextEdit) -> List TextEdit)
-> Session (ResponseMessage (List TextEdit))
-> Session (List TextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> DocumentFormattingParams
-> Session (ResponseMessage (List TextEdit))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
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 = TextDocumentIdentifier
-> Range
-> FormattingOptions
-> Maybe ProgressToken
-> DocumentRangeFormattingParams
DocumentRangeFormattingParams TextDocumentIdentifier
doc Range
range FormattingOptions
opts Maybe ProgressToken
forall a. Maybe a
Nothing
  List TextEdit
edits <- ResponseMessage (List TextEdit) -> List TextEdit
forall a. ResponseMessage a -> a
getResponseResult (ResponseMessage (List TextEdit) -> List TextEdit)
-> Session (ResponseMessage (List TextEdit))
-> Session (List TextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientMethod
-> DocumentRangeFormattingParams
-> Session (ResponseMessage (List TextEdit))
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
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 WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just (Uri -> List TextEdit -> WorkspaceEditMap
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 TextDocumentEdit)
forall a. Maybe a
Nothing
      -- Send a dummy message to updateState so it can do bookkeeping
      req :: RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req = Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage ServerMethod ApplyWorkspaceEditParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"" (Int -> LspId
IdInt Int
0) ServerMethod
WorkspaceApplyEdit (WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams WorkspaceEdit
wEdit)
  in FromServerMessage -> Session ()
forall (m :: * -> *).
(MonadIO m, HasReader SessionContext m, HasState SessionState m) =>
FromServerMessage -> m ()
updateState (ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit ApplyWorkspaceEditRequest
forall resp.
RequestMessage ServerMethod ApplyWorkspaceEditParams resp
req)

-- | Returns the code lenses for the specified document.
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens]
getCodeLenses TextDocumentIdentifier
tId = do
    CodeLensResponse
rsp <- ClientMethod -> CodeLensParams -> Session CodeLensResponse
forall params a.
(ToJSON params, FromJSON a) =>
ClientMethod -> params -> Session (ResponseMessage a)
request ClientMethod
TextDocumentCodeLens (TextDocumentIdentifier -> Maybe ProgressToken -> CodeLensParams
CodeLensParams TextDocumentIdentifier
tId Maybe ProgressToken
forall a. Maybe a
Nothing) :: Session CodeLensResponse
    case CodeLensResponse -> List CodeLens
forall a. ResponseMessage a -> a
getResponseResult CodeLensResponse
rsp of
        List [CodeLens]
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 [Registration]
getRegisteredCapabilities :: Session [Registration]
getRegisteredCapabilities = (Map Text Registration -> [Registration]
forall k a. Map k a -> [a]
Map.elems (Map Text Registration -> [Registration])
-> (SessionState -> Map Text Registration)
-> SessionState
-> [Registration]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionState -> Map Text Registration
curDynCaps) (SessionState -> [Registration])
-> Session SessionState -> Session [Registration]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get