{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE CPP #-}

module Language.LSP.Client.Session where

import Colog.Core (LogAction (..), Severity (..), WithSeverity (..))
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar.Extra
import Control.Exception (throw)
import Control.Lens hiding (Empty, List)
import Control.Lens.Extras (is)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Reader (ReaderT, asks)
import Control.Monad.State (StateT, execState)
import Data.Default (def)
import Data.Foldable (foldl', foldr', forM_, toList)
import Data.Function (on)
import Data.Functor (void)
import Data.Generics.Labels ()
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet (HashSet)
import Data.HashSet qualified as HashSet
import Data.List (sortBy)
import Data.List.Extra (groupOn)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromJust, fromMaybe, mapMaybe)
import Data.Row
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Text.Utf16.Rope (Rope)
import Language.LSP.Client.Decoding
import Language.LSP.Client.Exceptions (SessionException (UnexpectedResponseError))
import Language.LSP.Protocol.Capabilities (fullCaps)
import Language.LSP.Protocol.Lens hiding (error, to)
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import System.PosixCompat.Process (getProcessID)
import Language.LSP.VFS
    ( VFS
    , VfsLog
    , VirtualFile (..)
    , changeFromClientVFS
    , changeFromServerVFS
    , closeVFS
    , lsp_version
    , openVFS
    , vfsMap
    , virtualFileVersion
    )
import System.Directory (canonicalizePath)
import System.FilePath (isAbsolute, (</>))
import System.FilePath.Glob qualified as Glob
import Prelude hiding (id)
import Prelude qualified

data SessionState = SessionState
    { SessionState -> TMVar InitializeResult
initialized :: TMVar InitializeResult
    -- ^ The response of the initialization handshake, if any.
    , SessionState -> TVar RequestMap
pendingRequests :: TVar RequestMap
    -- ^ Response callbacks for sent requests waiting for a response. Once a response arrives the request is removed from this map.
    , SessionState -> TVar NotificationMap
notificationHandlers :: TVar NotificationMap
    -- ^ Notification callbacks that fire whenever a notification of their type is received.
    , SessionState -> TVar Int32
lastRequestId :: TVar Int32
    -- ^ A counter to send each request to the server is sent with a unique ID, allowing us to pair it back with its response.
    , SessionState -> TVar (HashMap Text SomeRegistration)
serverCapabilities :: TVar (HashMap Text SomeRegistration)
    -- ^ The capabilities that the server has dynamically registered with us so far.
    , SessionState -> ClientCapabilities
clientCapabilities :: ClientCapabilities
    -- ^ The client capabilities advertised to the server. Not a `TVar` because it does not change during the session.
    , SessionState -> TVar (HashSet ProgressToken)
progressTokens :: TVar (HashSet ProgressToken)
    -- ^ Progress messages received from the server.
    , SessionState -> TQueue FromClientMessage
outgoing :: TQueue FromClientMessage
    -- ^ Messages that have been serialised but not yet written to the output handle.
    , SessionState -> TVar VFS
vfs :: TVar VFS
    -- ^ Virtual, in-memory file system of the files known to the LSP.
    , SessionState -> FilePath
rootDir :: FilePath
    -- ^ The root of the project as sent to the server. Document URIs are relative to it. Not a `TVar` because it does not change during the session.
    }

defaultSessionState :: VFS -> IO SessionState
defaultSessionState :: VFS -> IO SessionState
defaultSessionState VFS
vfs' = do
    TMVar InitializeResult
initialized <- IO (TMVar InitializeResult)
forall a. IO (TMVar a)
newEmptyTMVarIO
    TVar RequestMap
pendingRequests <- RequestMap -> IO (TVar RequestMap)
forall a. a -> IO (TVar a)
newTVarIO RequestMap
emptyRequestMap
    TVar NotificationMap
notificationHandlers <- NotificationMap -> IO (TVar NotificationMap)
forall a. a -> IO (TVar a)
newTVarIO NotificationMap
emptyNotificationMap
    TVar Int32
lastRequestId <- Int32 -> IO (TVar Int32)
forall a. a -> IO (TVar a)
newTVarIO Int32
0
    TVar (HashMap Text SomeRegistration)
serverCapabilities <- HashMap Text SomeRegistration
-> IO (TVar (HashMap Text SomeRegistration))
forall a. a -> IO (TVar a)
newTVarIO HashMap Text SomeRegistration
forall a. Monoid a => a
mempty
    TVar (HashSet ProgressToken)
progressTokens <- HashSet ProgressToken -> IO (TVar (HashSet ProgressToken))
forall a. a -> IO (TVar a)
newTVarIO HashSet ProgressToken
forall a. Monoid a => a
mempty
    TQueue FromClientMessage
outgoing <- IO (TQueue FromClientMessage)
forall a. IO (TQueue a)
newTQueueIO
    TVar VFS
vfs <- VFS -> IO (TVar VFS)
forall a. a -> IO (TVar a)
newTVarIO VFS
vfs'
    pure
        SessionState
            { rootDir :: FilePath
rootDir = FilePath
"."
            , clientCapabilities :: ClientCapabilities
clientCapabilities = ClientCapabilities
forall a. Default a => a
def
            , TVar Int32
TVar (HashMap Text SomeRegistration)
TVar NotificationMap
TVar (HashSet ProgressToken)
TVar VFS
TVar RequestMap
TMVar InitializeResult
TQueue FromClientMessage
initialized :: TMVar InitializeResult
pendingRequests :: TVar RequestMap
notificationHandlers :: TVar NotificationMap
lastRequestId :: TVar Int32
serverCapabilities :: TVar (HashMap Text SomeRegistration)
progressTokens :: TVar (HashSet ProgressToken)
outgoing :: TQueue FromClientMessage
vfs :: TVar VFS
initialized :: TMVar InitializeResult
pendingRequests :: TVar RequestMap
notificationHandlers :: TVar NotificationMap
lastRequestId :: TVar Int32
serverCapabilities :: TVar (HashMap Text SomeRegistration)
progressTokens :: TVar (HashSet ProgressToken)
outgoing :: TQueue FromClientMessage
vfs :: TVar VFS
..
            }

{- | A session representing one instance of launching and connecting to a server.
It is essentially an STM-backed `StateT`: despite it being `ReaderT`, it can still
mutate `TVar` values.
-}
type Session = ReaderT SessionState IO

documentChangeUri :: DocumentChange -> Uri
documentChangeUri :: DocumentChange -> Uri
documentChangeUri (InL TextDocumentEdit
x) = TextDocumentEdit
x TextDocumentEdit -> Getting Uri TextDocumentEdit Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (OptionalVersionedTextDocumentIdentifier
 -> Const Uri OptionalVersionedTextDocumentIdentifier)
-> TextDocumentEdit -> Const Uri TextDocumentEdit
forall s a. HasTextDocument s a => Lens' s a
Lens' TextDocumentEdit OptionalVersionedTextDocumentIdentifier
textDocument ((OptionalVersionedTextDocumentIdentifier
  -> Const Uri OptionalVersionedTextDocumentIdentifier)
 -> TextDocumentEdit -> Const Uri TextDocumentEdit)
-> ((Uri -> Const Uri Uri)
    -> OptionalVersionedTextDocumentIdentifier
    -> Const Uri OptionalVersionedTextDocumentIdentifier)
-> Getting Uri TextDocumentEdit Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> OptionalVersionedTextDocumentIdentifier
-> Const Uri OptionalVersionedTextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' OptionalVersionedTextDocumentIdentifier Uri
uri
documentChangeUri (InR (InL CreateFile
x)) = CreateFile
x CreateFile -> Getting Uri CreateFile Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri CreateFile Uri
forall s a. HasUri s a => Lens' s a
Lens' CreateFile Uri
uri
documentChangeUri (InR (InR (InL RenameFile
x))) = RenameFile
x RenameFile -> Getting Uri RenameFile Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri RenameFile Uri
forall s a. HasOldUri s a => Lens' s a
Lens' RenameFile Uri
oldUri
documentChangeUri (InR (InR (InR DeleteFile
x))) = DeleteFile
x DeleteFile -> Getting Uri DeleteFile Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri DeleteFile Uri
forall s a. HasUri s a => Lens' s a
Lens' DeleteFile Uri
uri

-- eitherOf :: APrism' s a -> (a -> b) -> (s -> b) -> s -> b
-- eitherOf p a b = either b a . matching p
--
-- anyOf :: [APrism' s a] -> (a -> b) -> b -> s -> b
-- anyOf [] _ b = const b
-- anyOf (p : prisms) a b = eitherOf p a $ anyOf prisms a b

{- | Fires whenever the client receives a message from the server. Updates the session state as needed.
Note that this does not provide any business logic beyond updating the session state; you most likely
want to use `sendRequest` and `receiveNotification` to register callbacks for specific messages.
-}
handleServerMessage :: FromServerMessage -> Session ()
handleServerMessage :: FromServerMessage -> Session ()
handleServerMessage (FromServerMess SMethod m
SMethod_Progress TMessage m
req) =
    Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Getting Any [Value -> Bool] (Value -> Bool)
-> ((Value -> Bool) -> Bool) -> [Value -> Bool] -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf Getting Any [Value -> Bool] (Value -> Bool)
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
IndexedFold Int [Value -> Bool] (Value -> Bool)
folded ((Value -> Bool) -> Value -> Bool
forall a b. (a -> b) -> a -> b
$ TMessage m
TNotificationMessage 'Method_Progress
req TNotificationMessage 'Method_Progress
-> Getting Value (TNotificationMessage 'Method_Progress) Value
-> Value
forall s a. s -> Getting a s a -> a
^. (ProgressParams -> Const Value ProgressParams)
-> TNotificationMessage 'Method_Progress
-> Const Value (TNotificationMessage 'Method_Progress)
forall s a. HasParams s a => Lens' s a
Lens' (TNotificationMessage 'Method_Progress) ProgressParams
params ((ProgressParams -> Const Value ProgressParams)
 -> TNotificationMessage 'Method_Progress
 -> Const Value (TNotificationMessage 'Method_Progress))
-> ((Value -> Const Value Value)
    -> ProgressParams -> Const Value ProgressParams)
-> Getting Value (TNotificationMessage 'Method_Progress) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const Value Value)
-> ProgressParams -> Const Value ProgressParams
forall s a. HasValue s a => Lens' s a
Lens' ProgressParams Value
value) [APrism Value Value WorkDoneProgressBegin WorkDoneProgressBegin
-> Value -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism Value Value WorkDoneProgressBegin WorkDoneProgressBegin
Prism' Value WorkDoneProgressBegin
_workDoneProgressBegin, APrism Value Value WorkDoneProgressEnd WorkDoneProgressEnd
-> Value -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism Value Value WorkDoneProgressEnd WorkDoneProgressEnd
Prism' Value WorkDoneProgressEnd
_workDoneProgressEnd])
        (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ (SessionState -> TVar (HashSet ProgressToken))
-> ReaderT SessionState IO (TVar (HashSet ProgressToken))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar (HashSet ProgressToken)
progressTokens
        ReaderT SessionState IO (TVar (HashSet ProgressToken))
-> (TVar (HashSet ProgressToken) -> Session ()) -> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> Session ())
-> (TVar (HashSet ProgressToken) -> IO ())
-> TVar (HashSet ProgressToken)
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar (HashSet ProgressToken)
 -> (HashSet ProgressToken -> HashSet ProgressToken) -> IO ())
-> (HashSet ProgressToken -> HashSet ProgressToken)
-> TVar (HashSet ProgressToken)
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TVar (HashSet ProgressToken)
-> (HashSet ProgressToken -> HashSet ProgressToken) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO (ProgressToken -> HashSet ProgressToken -> HashSet ProgressToken
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HashSet.insert (ProgressToken -> HashSet ProgressToken -> HashSet ProgressToken)
-> ProgressToken -> HashSet ProgressToken -> HashSet ProgressToken
forall a b. (a -> b) -> a -> b
$ TMessage m
TNotificationMessage 'Method_Progress
req TNotificationMessage 'Method_Progress
-> Getting
     ProgressToken (TNotificationMessage 'Method_Progress) ProgressToken
-> ProgressToken
forall s a. s -> Getting a s a -> a
^. (ProgressParams -> Const ProgressToken ProgressParams)
-> TNotificationMessage 'Method_Progress
-> Const ProgressToken (TNotificationMessage 'Method_Progress)
forall s a. HasParams s a => Lens' s a
Lens' (TNotificationMessage 'Method_Progress) ProgressParams
params ((ProgressParams -> Const ProgressToken ProgressParams)
 -> TNotificationMessage 'Method_Progress
 -> Const ProgressToken (TNotificationMessage 'Method_Progress))
-> ((ProgressToken -> Const ProgressToken ProgressToken)
    -> ProgressParams -> Const ProgressToken ProgressParams)
-> Getting
     ProgressToken (TNotificationMessage 'Method_Progress) ProgressToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressToken -> Const ProgressToken ProgressToken)
-> ProgressParams -> Const ProgressToken ProgressParams
forall s a. HasToken s a => Lens' s a
Lens' ProgressParams ProgressToken
token)
handleServerMessage (FromServerMess SMethod m
SMethod_ClientRegisterCapability TMessage m
req) =
    (SessionState -> TVar (HashMap Text SomeRegistration))
-> ReaderT SessionState IO (TVar (HashMap Text SomeRegistration))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar (HashMap Text SomeRegistration)
serverCapabilities ReaderT SessionState IO (TVar (HashMap Text SomeRegistration))
-> (TVar (HashMap Text SomeRegistration) -> Session ())
-> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (TVar (HashMap Text SomeRegistration) -> IO ())
-> TVar (HashMap Text SomeRegistration)
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar (HashMap Text SomeRegistration)
 -> (HashMap Text SomeRegistration -> HashMap Text SomeRegistration)
 -> IO ())
-> (HashMap Text SomeRegistration -> HashMap Text SomeRegistration)
-> TVar (HashMap Text SomeRegistration)
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TVar (HashMap Text SomeRegistration)
-> (HashMap Text SomeRegistration -> HashMap Text SomeRegistration)
-> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO (HashMap Text SomeRegistration
-> HashMap Text SomeRegistration -> HashMap Text SomeRegistration
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HashMap.union ([(Text, SomeRegistration)] -> HashMap Text SomeRegistration
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text, SomeRegistration)]
newRegs))
  where
    regs :: [SomeRegistration]
regs = TMessage m
TRequestMessage 'Method_ClientRegisterCapability
req TRequestMessage 'Method_ClientRegisterCapability
-> Getting
     (Endo [SomeRegistration])
     (TRequestMessage 'Method_ClientRegisterCapability)
     SomeRegistration
-> [SomeRegistration]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (RegistrationParams
 -> Const (Endo [SomeRegistration]) RegistrationParams)
-> TRequestMessage 'Method_ClientRegisterCapability
-> Const
     (Endo [SomeRegistration])
     (TRequestMessage 'Method_ClientRegisterCapability)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_ClientRegisterCapability)
  RegistrationParams
params ((RegistrationParams
  -> Const (Endo [SomeRegistration]) RegistrationParams)
 -> TRequestMessage 'Method_ClientRegisterCapability
 -> Const
      (Endo [SomeRegistration])
      (TRequestMessage 'Method_ClientRegisterCapability))
-> ((SomeRegistration
     -> Const (Endo [SomeRegistration]) SomeRegistration)
    -> RegistrationParams
    -> Const (Endo [SomeRegistration]) RegistrationParams)
-> Getting
     (Endo [SomeRegistration])
     (TRequestMessage 'Method_ClientRegisterCapability)
     SomeRegistration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Registration] -> Const (Endo [SomeRegistration]) [Registration])
-> RegistrationParams
-> Const (Endo [SomeRegistration]) RegistrationParams
forall s a. HasRegistrations s a => Lens' s a
Lens' RegistrationParams [Registration]
registrations (([Registration] -> Const (Endo [SomeRegistration]) [Registration])
 -> RegistrationParams
 -> Const (Endo [SomeRegistration]) RegistrationParams)
-> ((SomeRegistration
     -> Const (Endo [SomeRegistration]) SomeRegistration)
    -> [Registration]
    -> Const (Endo [SomeRegistration]) [Registration])
-> (SomeRegistration
    -> Const (Endo [SomeRegistration]) SomeRegistration)
-> RegistrationParams
-> Const (Endo [SomeRegistration]) RegistrationParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Registration -> Const (Endo [SomeRegistration]) Registration)
-> [Registration] -> Const (Endo [SomeRegistration]) [Registration]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int [Registration] [Registration] Registration Registration
traversed ((Registration -> Const (Endo [SomeRegistration]) Registration)
 -> [Registration]
 -> Const (Endo [SomeRegistration]) [Registration])
-> ((SomeRegistration
     -> Const (Endo [SomeRegistration]) SomeRegistration)
    -> Registration -> Const (Endo [SomeRegistration]) Registration)
-> (SomeRegistration
    -> Const (Endo [SomeRegistration]) SomeRegistration)
-> [Registration]
-> Const (Endo [SomeRegistration]) [Registration]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Registration -> Maybe SomeRegistration)
-> Optic'
     (->)
     (Const (Endo [SomeRegistration]))
     Registration
     (Maybe SomeRegistration)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Registration -> Maybe SomeRegistration
toSomeRegistration Optic'
  (->)
  (Const (Endo [SomeRegistration]))
  Registration
  (Maybe SomeRegistration)
-> ((SomeRegistration
     -> Const (Endo [SomeRegistration]) SomeRegistration)
    -> Maybe SomeRegistration
    -> Const (Endo [SomeRegistration]) (Maybe SomeRegistration))
-> (SomeRegistration
    -> Const (Endo [SomeRegistration]) SomeRegistration)
-> Registration
-> Const (Endo [SomeRegistration]) Registration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SomeRegistration
 -> Const (Endo [SomeRegistration]) SomeRegistration)
-> Maybe SomeRegistration
-> Const (Endo [SomeRegistration]) (Maybe SomeRegistration)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just
    newRegs :: [(Text, SomeRegistration)]
newRegs = (\sr :: SomeRegistration
sr@(SomeRegistration TRegistration m
r) -> (TRegistration m
r TRegistration m -> Getting Text (TRegistration m) Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TRegistration m) Text
forall s a. HasId s a => Lens' s a
Lens' (TRegistration m) Text
id, SomeRegistration
sr)) (SomeRegistration -> (Text, SomeRegistration))
-> [SomeRegistration] -> [(Text, SomeRegistration)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SomeRegistration]
regs
handleServerMessage (FromServerMess SMethod m
SMethod_ClientUnregisterCapability TMessage m
req) =
    (SessionState -> TVar (HashMap Text SomeRegistration))
-> ReaderT SessionState IO (TVar (HashMap Text SomeRegistration))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar (HashMap Text SomeRegistration)
serverCapabilities ReaderT SessionState IO (TVar (HashMap Text SomeRegistration))
-> (TVar (HashMap Text SomeRegistration) -> Session ())
-> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (TVar (HashMap Text SomeRegistration) -> IO ())
-> TVar (HashMap Text SomeRegistration)
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar (HashMap Text SomeRegistration)
 -> (HashMap Text SomeRegistration -> HashMap Text SomeRegistration)
 -> IO ())
-> (HashMap Text SomeRegistration -> HashMap Text SomeRegistration)
-> TVar (HashMap Text SomeRegistration)
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TVar (HashMap Text SomeRegistration)
-> (HashMap Text SomeRegistration -> HashMap Text SomeRegistration)
-> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO ((HashMap Text SomeRegistration
 -> [Text] -> HashMap Text SomeRegistration)
-> [Text]
-> HashMap Text SomeRegistration
-> HashMap Text SomeRegistration
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text
 -> HashMap Text SomeRegistration -> HashMap Text SomeRegistration)
-> HashMap Text SomeRegistration
-> [Text]
-> HashMap Text SomeRegistration
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' Text
-> HashMap Text SomeRegistration -> HashMap Text SomeRegistration
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete) [Text]
unRegs)
  where
    unRegs :: [Text]
unRegs = (Unregistration -> Getting Text Unregistration Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Unregistration Text
forall s a. HasId s a => Lens' s a
Lens' Unregistration Text
id) (Unregistration -> Text) -> [Unregistration] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMessage m
TRequestMessage 'Method_ClientUnregisterCapability
req TRequestMessage 'Method_ClientUnregisterCapability
-> Getting
     [Unregistration]
     (TRequestMessage 'Method_ClientUnregisterCapability)
     [Unregistration]
-> [Unregistration]
forall s a. s -> Getting a s a -> a
^. (UnregistrationParams
 -> Const [Unregistration] UnregistrationParams)
-> TRequestMessage 'Method_ClientUnregisterCapability
-> Const
     [Unregistration]
     (TRequestMessage 'Method_ClientUnregisterCapability)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_ClientUnregisterCapability)
  UnregistrationParams
params ((UnregistrationParams
  -> Const [Unregistration] UnregistrationParams)
 -> TRequestMessage 'Method_ClientUnregisterCapability
 -> Const
      [Unregistration]
      (TRequestMessage 'Method_ClientUnregisterCapability))
-> (([Unregistration] -> Const [Unregistration] [Unregistration])
    -> UnregistrationParams
    -> Const [Unregistration] UnregistrationParams)
-> Getting
     [Unregistration]
     (TRequestMessage 'Method_ClientUnregisterCapability)
     [Unregistration]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Unregistration] -> Const [Unregistration] [Unregistration])
-> UnregistrationParams
-> Const [Unregistration] UnregistrationParams
forall s a. HasUnregisterations s a => Lens' s a
Lens' UnregistrationParams [Unregistration]
unregisterations
handleServerMessage (FromServerMess SMethod m
SMethod_WorkspaceApplyEdit TMessage m
r) = do
    -- First, prefer the versioned documentChanges field
    [DidChangeTextDocumentParams]
allChangeParams <- case TMessage m
TRequestMessage 'Method_WorkspaceApplyEdit
r TRequestMessage 'Method_WorkspaceApplyEdit
-> Getting
     (Maybe [DocumentChange])
     (TRequestMessage 'Method_WorkspaceApplyEdit)
     (Maybe [DocumentChange])
-> Maybe [DocumentChange]
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> TRequestMessage 'Method_WorkspaceApplyEdit
-> Const
     (Maybe [DocumentChange])
     (TRequestMessage 'Method_WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_WorkspaceApplyEdit)
  ApplyWorkspaceEditParams
params ((ApplyWorkspaceEditParams
  -> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
 -> TRequestMessage 'Method_WorkspaceApplyEdit
 -> Const
      (Maybe [DocumentChange])
      (TRequestMessage 'Method_WorkspaceApplyEdit))
-> ((Maybe [DocumentChange]
     -> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
    -> ApplyWorkspaceEditParams
    -> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> Getting
     (Maybe [DocumentChange])
     (TRequestMessage 'Method_WorkspaceApplyEdit)
     (Maybe [DocumentChange])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
Lens' ApplyWorkspaceEditParams WorkspaceEdit
edit ((WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
 -> ApplyWorkspaceEditParams
 -> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams)
-> ((Maybe [DocumentChange]
     -> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
    -> WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit)
-> (Maybe [DocumentChange]
    -> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
-> ApplyWorkspaceEditParams
-> Const (Maybe [DocumentChange]) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe [DocumentChange]
 -> Const (Maybe [DocumentChange]) (Maybe [DocumentChange]))
-> WorkspaceEdit -> Const (Maybe [DocumentChange]) WorkspaceEdit
forall s a. HasDocumentChanges s a => Lens' s a
Lens' WorkspaceEdit (Maybe [DocumentChange])
documentChanges of
        Just [DocumentChange]
cs -> do
            (DocumentChange -> Session ()) -> [DocumentChange] -> Session ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Uri -> Session ()
checkIfNeedsOpened (Uri -> Session ())
-> (DocumentChange -> Uri) -> DocumentChange -> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentChange -> Uri
documentChangeUri) [DocumentChange]
cs
            -- replace the user provided version numbers with the VFS ones + 1
            -- (technically we should check that the user versions match the VFS ones)
            [DocumentChange]
cs' <- LensLike
  (ReaderT SessionState IO)
  [DocumentChange]
  [DocumentChange]
  OptionalVersionedTextDocumentIdentifier
  OptionalVersionedTextDocumentIdentifier
-> LensLike
     (ReaderT SessionState IO)
     [DocumentChange]
     [DocumentChange]
     OptionalVersionedTextDocumentIdentifier
     OptionalVersionedTextDocumentIdentifier
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf ((DocumentChange -> ReaderT SessionState IO DocumentChange)
-> [DocumentChange] -> ReaderT SessionState IO [DocumentChange]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((DocumentChange -> ReaderT SessionState IO DocumentChange)
 -> [DocumentChange] -> ReaderT SessionState IO [DocumentChange])
-> ((OptionalVersionedTextDocumentIdentifier
     -> ReaderT SessionState IO OptionalVersionedTextDocumentIdentifier)
    -> DocumentChange -> ReaderT SessionState IO DocumentChange)
-> LensLike
     (ReaderT SessionState IO)
     [DocumentChange]
     [DocumentChange]
     OptionalVersionedTextDocumentIdentifier
     OptionalVersionedTextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentEdit -> ReaderT SessionState IO TextDocumentEdit)
-> DocumentChange -> ReaderT SessionState IO DocumentChange
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f a) -> p (a |? b) (f (a |? b))
_L ((TextDocumentEdit -> ReaderT SessionState IO TextDocumentEdit)
 -> DocumentChange -> ReaderT SessionState IO DocumentChange)
-> ((OptionalVersionedTextDocumentIdentifier
     -> ReaderT SessionState IO OptionalVersionedTextDocumentIdentifier)
    -> TextDocumentEdit -> ReaderT SessionState IO TextDocumentEdit)
-> (OptionalVersionedTextDocumentIdentifier
    -> ReaderT SessionState IO OptionalVersionedTextDocumentIdentifier)
-> DocumentChange
-> ReaderT SessionState IO DocumentChange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptionalVersionedTextDocumentIdentifier
 -> ReaderT SessionState IO OptionalVersionedTextDocumentIdentifier)
-> TextDocumentEdit -> ReaderT SessionState IO TextDocumentEdit
forall s a. HasTextDocument s a => Lens' s a
Lens' TextDocumentEdit OptionalVersionedTextDocumentIdentifier
textDocument) OptionalVersionedTextDocumentIdentifier
-> ReaderT SessionState IO OptionalVersionedTextDocumentIdentifier
bumpNewestVersion [DocumentChange]
cs
            return $ (DocumentChange -> Maybe DidChangeTextDocumentParams)
-> [DocumentChange] -> [DidChangeTextDocumentParams]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DocumentChange -> Maybe DidChangeTextDocumentParams
getParamsFromDocumentChange [DocumentChange]
cs'
        -- Then fall back to the changes field
        Maybe [DocumentChange]
Nothing -> case TMessage m
TRequestMessage 'Method_WorkspaceApplyEdit
r TRequestMessage 'Method_WorkspaceApplyEdit
-> Getting
     (Maybe (Map Uri [TextEdit]))
     (TRequestMessage 'Method_WorkspaceApplyEdit)
     (Maybe (Map Uri [TextEdit]))
-> Maybe (Map Uri [TextEdit])
forall s a. s -> Getting a s a -> a
^. (ApplyWorkspaceEditParams
 -> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> TRequestMessage 'Method_WorkspaceApplyEdit
-> Const
     (Maybe (Map Uri [TextEdit]))
     (TRequestMessage 'Method_WorkspaceApplyEdit)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_WorkspaceApplyEdit)
  ApplyWorkspaceEditParams
params ((ApplyWorkspaceEditParams
  -> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
 -> TRequestMessage 'Method_WorkspaceApplyEdit
 -> Const
      (Maybe (Map Uri [TextEdit]))
      (TRequestMessage 'Method_WorkspaceApplyEdit))
-> ((Maybe (Map Uri [TextEdit])
     -> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
    -> ApplyWorkspaceEditParams
    -> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> Getting
     (Maybe (Map Uri [TextEdit]))
     (TRequestMessage 'Method_WorkspaceApplyEdit)
     (Maybe (Map Uri [TextEdit]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WorkspaceEdit -> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
-> ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams
forall s a. HasEdit s a => Lens' s a
Lens' ApplyWorkspaceEditParams WorkspaceEdit
edit ((WorkspaceEdit
  -> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
 -> ApplyWorkspaceEditParams
 -> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams)
-> ((Maybe (Map Uri [TextEdit])
     -> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
    -> WorkspaceEdit
    -> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit)
-> (Maybe (Map Uri [TextEdit])
    -> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
-> ApplyWorkspaceEditParams
-> Const (Maybe (Map Uri [TextEdit])) ApplyWorkspaceEditParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Map Uri [TextEdit])
 -> Const (Maybe (Map Uri [TextEdit])) (Maybe (Map Uri [TextEdit])))
-> WorkspaceEdit
-> Const (Maybe (Map Uri [TextEdit])) WorkspaceEdit
forall s a. HasChanges s a => Lens' s a
Lens' WorkspaceEdit (Maybe (Map Uri [TextEdit]))
changes of
            Just Map Uri [TextEdit]
cs -> do
                (Uri -> Session ()) -> [Uri] -> Session ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Uri -> Session ()
checkIfNeedsOpened (Map Uri [TextEdit] -> [Uri]
forall k a. Map k a -> [k]
Map.keys Map Uri [TextEdit]
cs)
                [[DidChangeTextDocumentParams]] -> [DidChangeTextDocumentParams]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[DidChangeTextDocumentParams]] -> [DidChangeTextDocumentParams])
-> ReaderT SessionState IO [[DidChangeTextDocumentParams]]
-> ReaderT SessionState IO [DidChangeTextDocumentParams]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Uri, [TextEdit])
 -> ReaderT SessionState IO [DidChangeTextDocumentParams])
-> [(Uri, [TextEdit])]
-> ReaderT SessionState IO [[DidChangeTextDocumentParams]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Uri
 -> [TextEdit]
 -> ReaderT SessionState IO [DidChangeTextDocumentParams])
-> (Uri, [TextEdit])
-> ReaderT SessionState IO [DidChangeTextDocumentParams]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Uri
-> [TextEdit]
-> ReaderT SessionState IO [DidChangeTextDocumentParams]
getChangeParams) (Map Uri [TextEdit] -> [(Uri, [TextEdit])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Uri [TextEdit]
cs)
            Maybe (Map Uri [TextEdit])
Nothing ->
                FilePath -> ReaderT SessionState IO [DidChangeTextDocumentParams]
forall a. HasCallStack => FilePath -> a
error FilePath
"WorkspaceEdit contains neither documentChanges nor changes!"

    (SessionState -> TVar VFS) -> ReaderT SessionState IO (TVar VFS)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar VFS
vfs ReaderT SessionState IO (TVar VFS)
-> (TVar VFS -> Session ()) -> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (TVar VFS -> IO ()) -> TVar VFS -> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar VFS -> (VFS -> VFS) -> IO ())
-> (VFS -> VFS) -> TVar VFS -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TVar VFS -> (VFS -> VFS) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO (State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState (State VFS () -> VFS -> VFS) -> State VFS () -> VFS -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_WorkspaceApplyEdit -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_WorkspaceApplyEdit -> m ()
changeFromServerVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
logger TMessage m
TMessage 'Method_WorkspaceApplyEdit
r)

    let groupedParams :: [[DidChangeTextDocumentParams]]
groupedParams = (DidChangeTextDocumentParams -> VersionedTextDocumentIdentifier)
-> [DidChangeTextDocumentParams] -> [[DidChangeTextDocumentParams]]
forall k a. Eq k => (a -> k) -> [a] -> [[a]]
groupOn (Getting
  VersionedTextDocumentIdentifier
  DidChangeTextDocumentParams
  VersionedTextDocumentIdentifier
-> DidChangeTextDocumentParams -> VersionedTextDocumentIdentifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  VersionedTextDocumentIdentifier
  DidChangeTextDocumentParams
  VersionedTextDocumentIdentifier
forall s a. HasTextDocument s a => Lens' s a
Lens' DidChangeTextDocumentParams VersionedTextDocumentIdentifier
textDocument) [DidChangeTextDocumentParams]
allChangeParams
        mergedParams :: [DidChangeTextDocumentParams]
mergedParams = [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
mergeParams ([DidChangeTextDocumentParams] -> DidChangeTextDocumentParams)
-> [[DidChangeTextDocumentParams]] -> [DidChangeTextDocumentParams]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[DidChangeTextDocumentParams]]
groupedParams

    [DidChangeTextDocumentParams]
-> (DidChangeTextDocumentParams -> Session ()) -> Session ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [DidChangeTextDocumentParams]
mergedParams ((DidChangeTextDocumentParams -> Session ()) -> Session ())
-> (DidChangeTextDocumentParams -> Session ()) -> Session ()
forall a b. (a -> b) -> a -> b
$ SMethod 'Method_TextDocumentDidChange
-> MessageParams 'Method_TextDocumentDidChange -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
SMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange

    -- Update VFS to new document versions
    let sortedVersions :: [[DidChangeTextDocumentParams]]
sortedVersions = (DidChangeTextDocumentParams
 -> DidChangeTextDocumentParams -> Ordering)
-> [DidChangeTextDocumentParams] -> [DidChangeTextDocumentParams]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int32 -> Int32 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int32 -> Int32 -> Ordering)
-> (DidChangeTextDocumentParams -> Int32)
-> DidChangeTextDocumentParams
-> DidChangeTextDocumentParams
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (DidChangeTextDocumentParams
-> Getting Int32 DidChangeTextDocumentParams Int32 -> Int32
forall s a. s -> Getting a s a -> a
^. (VersionedTextDocumentIdentifier
 -> Const Int32 VersionedTextDocumentIdentifier)
-> DidChangeTextDocumentParams
-> Const Int32 DidChangeTextDocumentParams
forall s a. HasTextDocument s a => Lens' s a
Lens' DidChangeTextDocumentParams VersionedTextDocumentIdentifier
textDocument ((VersionedTextDocumentIdentifier
  -> Const Int32 VersionedTextDocumentIdentifier)
 -> DidChangeTextDocumentParams
 -> Const Int32 DidChangeTextDocumentParams)
-> ((Int32 -> Const Int32 Int32)
    -> VersionedTextDocumentIdentifier
    -> Const Int32 VersionedTextDocumentIdentifier)
-> Getting Int32 DidChangeTextDocumentParams Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Const Int32 Int32)
-> VersionedTextDocumentIdentifier
-> Const Int32 VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Int32
version)) ([DidChangeTextDocumentParams] -> [DidChangeTextDocumentParams])
-> [[DidChangeTextDocumentParams]]
-> [[DidChangeTextDocumentParams]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[DidChangeTextDocumentParams]]
groupedParams
        latestVersions :: [VersionedTextDocumentIdentifier]
latestVersions = Getting
  VersionedTextDocumentIdentifier
  DidChangeTextDocumentParams
  VersionedTextDocumentIdentifier
-> DidChangeTextDocumentParams -> VersionedTextDocumentIdentifier
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  VersionedTextDocumentIdentifier
  DidChangeTextDocumentParams
  VersionedTextDocumentIdentifier
forall s a. HasTextDocument s a => Lens' s a
Lens' DidChangeTextDocumentParams VersionedTextDocumentIdentifier
textDocument (DidChangeTextDocumentParams -> VersionedTextDocumentIdentifier)
-> ([DidChangeTextDocumentParams] -> DidChangeTextDocumentParams)
-> [DidChangeTextDocumentParams]
-> VersionedTextDocumentIdentifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
forall a. HasCallStack => [a] -> a
last ([DidChangeTextDocumentParams] -> VersionedTextDocumentIdentifier)
-> [[DidChangeTextDocumentParams]]
-> [VersionedTextDocumentIdentifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[DidChangeTextDocumentParams]]
sortedVersions

    [VersionedTextDocumentIdentifier]
-> (VersionedTextDocumentIdentifier -> Session ()) -> Session ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [VersionedTextDocumentIdentifier]
latestVersions ((VersionedTextDocumentIdentifier -> Session ()) -> Session ())
-> (VersionedTextDocumentIdentifier -> Session ()) -> Session ()
forall a b. (a -> b) -> a -> b
$ \(VersionedTextDocumentIdentifier Uri
uri Int32
v) ->
        (SessionState -> TVar VFS) -> ReaderT SessionState IO (TVar VFS)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar VFS
vfs
            ReaderT SessionState IO (TVar VFS)
-> (TVar VFS -> Session ()) -> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
            (IO () -> Session ())
-> (TVar VFS -> IO ()) -> TVar VFS -> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar VFS -> (VFS -> VFS) -> IO ())
-> (VFS -> VFS) -> TVar VFS -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
                TVar VFS -> (VFS -> VFS) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO
                ( \VFS
vfs -> do
                    let update :: VirtualFile -> VirtualFile
update (VirtualFile Int32
_ Int
file_ver Rope
t) = Int32 -> Int -> Rope -> VirtualFile
VirtualFile Int32
v (Int
file_ver Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Rope
t
                     in VFS
vfs VFS -> (VFS -> VFS) -> VFS
forall a b. a -> (a -> b) -> b
& (Map NormalizedUri VirtualFile
 -> Identity (Map NormalizedUri VirtualFile))
-> VFS -> Identity VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
  -> Identity (Map NormalizedUri VirtualFile))
 -> VFS -> Identity VFS)
-> ((VirtualFile -> Identity VirtualFile)
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (VirtualFile -> Identity VirtualFile)
-> VFS
-> Identity VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Traversal'
     (Map NormalizedUri VirtualFile)
     (IxValue (Map NormalizedUri VirtualFile))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri) ((VirtualFile -> Identity VirtualFile) -> VFS -> Identity VFS)
-> (VirtualFile -> VirtualFile) -> VFS -> VFS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ VirtualFile -> VirtualFile
update
                )
    TRequestMessage 'Method_WorkspaceApplyEdit
-> Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
-> Session ()
forall (m :: Method 'ServerToClient 'Request).
TRequestMessage m
-> Either ResponseError (MessageResult m) -> Session ()
sendResponse
        TMessage m
TRequestMessage 'Method_WorkspaceApplyEdit
r
        (Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
 -> Session ())
-> Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
-> Session ()
forall a b. (a -> b) -> a -> b
$ ApplyWorkspaceEditResult
-> Either ResponseError ApplyWorkspaceEditResult
forall a b. b -> Either a b
Right
            ApplyWorkspaceEditResult
                { $sel:_applied:ApplyWorkspaceEditResult :: Bool
_applied = Bool
True
                , $sel:_failureReason:ApplyWorkspaceEditResult :: Maybe Text
_failureReason = Maybe Text
forall a. Maybe a
Nothing
                , $sel:_failedChange:ApplyWorkspaceEditResult :: Maybe UInt
_failedChange = Maybe UInt
forall a. Maybe a
Nothing
                }
  where
    logger :: LogAction (StateT VFS Identity) (WithSeverity VfsLog)
    logger :: LogAction (StateT VFS Identity) (WithSeverity VfsLog)
logger = (WithSeverity VfsLog -> State VFS ())
-> LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((WithSeverity VfsLog -> State VFS ())
 -> LogAction (StateT VFS Identity) (WithSeverity VfsLog))
-> (WithSeverity VfsLog -> State VFS ())
-> LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a b. (a -> b) -> a -> b
$ \(WithSeverity VfsLog
msg Severity
sev) -> case Severity
sev of Severity
Error -> FilePath -> State VFS ()
forall a. HasCallStack => FilePath -> a
error (FilePath -> State VFS ()) -> FilePath -> State VFS ()
forall a b. (a -> b) -> a -> b
$ VfsLog -> FilePath
forall a. Show a => a -> FilePath
show VfsLog
msg; Severity
_ -> () -> State VFS ()
forall a. a -> StateT VFS Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    checkIfNeedsOpened :: Uri -> Session ()
checkIfNeedsOpened Uri
uri = do
        Bool
isOpen <- (SessionState -> TVar VFS) -> ReaderT SessionState IO (TVar VFS)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar VFS
vfs ReaderT SessionState IO (TVar VFS)
-> (TVar VFS -> ReaderT SessionState IO VFS)
-> ReaderT SessionState IO VFS
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO VFS -> ReaderT SessionState IO VFS
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VFS -> ReaderT SessionState IO VFS)
-> (TVar VFS -> IO VFS) -> TVar VFS -> ReaderT SessionState IO VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar VFS -> IO VFS
forall a. TVar a -> IO a
readTVarIO ReaderT SessionState IO VFS
-> (VFS -> Bool) -> ReaderT SessionState IO Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Getting Any VFS (IxValue (Map NormalizedUri VirtualFile))
-> VFS -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Map NormalizedUri VirtualFile
 -> Const Any (Map NormalizedUri VirtualFile))
-> VFS -> Const Any VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
  -> Const Any (Map NormalizedUri VirtualFile))
 -> VFS -> Const Any VFS)
-> ((IxValue (Map NormalizedUri VirtualFile)
     -> Const Any (IxValue (Map NormalizedUri VirtualFile)))
    -> Map NormalizedUri VirtualFile
    -> Const Any (Map NormalizedUri VirtualFile))
-> Getting Any VFS (IxValue (Map NormalizedUri VirtualFile))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Traversal'
     (Map NormalizedUri VirtualFile)
     (IxValue (Map NormalizedUri VirtualFile))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri))

        -- if its not open, open it
        Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isOpen (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ do
            Text
contents <- ReaderT SessionState IO Text
-> (FilePath -> ReaderT SessionState IO Text)
-> Maybe FilePath
-> ReaderT SessionState IO Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> ReaderT SessionState IO Text
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"") (IO Text -> ReaderT SessionState IO Text
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ReaderT SessionState IO Text)
-> (FilePath -> IO Text)
-> FilePath
-> ReaderT SessionState IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Text
Text.readFile) (Uri -> Maybe FilePath
uriToFilePath Uri
uri)
            SMethod 'Method_TextDocumentDidOpen
-> MessageParams 'Method_TextDocumentDidOpen -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
SMethod m -> MessageParams m -> Session ()
sendNotification
                SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen
                DidOpenTextDocumentParams
                    { $sel:_textDocument:DidOpenTextDocumentParams :: TextDocumentItem
_textDocument =
                        TextDocumentItem
                            { $sel:_uri:TextDocumentItem :: Uri
_uri = Uri
uri
                            , $sel:_languageId:TextDocumentItem :: Text
_languageId = Text
""
                            , $sel:_version:TextDocumentItem :: Int32
_version = Int32
0
                            , $sel:_text:TextDocumentItem :: Text
_text = Text
contents
                            }
                    }

    getParamsFromTextDocumentEdit :: TextDocumentEdit -> Maybe DidChangeTextDocumentParams
    getParamsFromTextDocumentEdit :: TextDocumentEdit -> Maybe DidChangeTextDocumentParams
getParamsFromTextDocumentEdit (TextDocumentEdit OptionalVersionedTextDocumentIdentifier
docId [TextEdit |? AnnotatedTextEdit]
edits) = do
        VersionedTextDocumentIdentifier
-> [TextDocumentContentChangeEvent] -> DidChangeTextDocumentParams
DidChangeTextDocumentParams (VersionedTextDocumentIdentifier
 -> [TextDocumentContentChangeEvent] -> DidChangeTextDocumentParams)
-> Maybe VersionedTextDocumentIdentifier
-> Maybe
     ([TextDocumentContentChangeEvent] -> DidChangeTextDocumentParams)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OptionalVersionedTextDocumentIdentifier
docId OptionalVersionedTextDocumentIdentifier
-> Getting
     (First VersionedTextDocumentIdentifier)
     OptionalVersionedTextDocumentIdentifier
     VersionedTextDocumentIdentifier
-> Maybe VersionedTextDocumentIdentifier
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First VersionedTextDocumentIdentifier)
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
Prism'
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
_versionedTextDocumentIdentifier Maybe
  ([TextDocumentContentChangeEvent] -> DidChangeTextDocumentParams)
-> Maybe [TextDocumentContentChangeEvent]
-> Maybe DidChangeTextDocumentParams
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TextDocumentContentChangeEvent]
-> Maybe [TextDocumentContentChangeEvent]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent
editToChangeEvent ((TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent)
-> [TextEdit |? AnnotatedTextEdit]
-> [TextDocumentContentChangeEvent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TextEdit |? AnnotatedTextEdit]
edits)

    editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent
    editToChangeEvent :: (TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent
editToChangeEvent (InR AnnotatedTextEdit
e) = (Rec
   (Extend "range" Range ('R '[])
    .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
        .+ (("text" .== Text) .+ 'R '[])))
 |? Rec (("text" .== Text) .+ 'R '[]))
-> TextDocumentContentChangeEvent
TextDocumentContentChangeEvent ((Rec
    (Extend "range" Range ('R '[])
     .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
         .+ (("text" .== Text) .+ 'R '[])))
  |? Rec (("text" .== Text) .+ 'R '[]))
 -> TextDocumentContentChangeEvent)
-> (Rec
      (Extend "range" Range ('R '[])
       .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
           .+ (("text" .== Text) .+ 'R '[])))
    |? Rec (("text" .== Text) .+ 'R '[]))
-> TextDocumentContentChangeEvent
forall a b. (a -> b) -> a -> b
$ Rec
  (Extend "range" Range ('R '[])
   .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
       .+ (("text" .== Text) .+ 'R '[])))
-> Rec
     (Extend "range" Range ('R '[])
      .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
          .+ (("text" .== Text) .+ 'R '[])))
   |? Rec (("text" .== Text) .+ 'R '[])
forall a b. a -> a |? b
InL (Rec
   (Extend "range" Range ('R '[])
    .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
        .+ (("text" .== Text) .+ 'R '[])))
 -> Rec
      (Extend "range" Range ('R '[])
       .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
           .+ (("text" .== Text) .+ 'R '[])))
    |? Rec (("text" .== Text) .+ 'R '[]))
-> Rec
     (Extend "range" Range ('R '[])
      .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
          .+ (("text" .== Text) .+ 'R '[])))
-> Rec
     (Extend "range" Range ('R '[])
      .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
          .+ (("text" .== Text) .+ 'R '[])))
   |? Rec (("text" .== Text) .+ 'R '[])
forall a b. (a -> b) -> a -> b
$ Label "range"
#range Label "range" -> Range -> Rec (Extend "range" Range ('R '[]))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== (AnnotatedTextEdit
e AnnotatedTextEdit -> Getting Range AnnotatedTextEdit Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range AnnotatedTextEdit Range
forall s a. HasRange s a => Lens' s a
Lens' AnnotatedTextEdit Range
range) Rec ('R '[ "range" ':-> Range])
-> Rec ('R '[ "rangeLength" ':-> Maybe UInt])
-> Rec
     ('R '[ "range" ':-> Range] .+ 'R '[ "rangeLength" ':-> Maybe UInt])
forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ Label "rangeLength"
#rangeLength Label "rangeLength"
-> Maybe UInt -> Rec (Extend "rangeLength" (Maybe UInt) ('R '[]))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== Maybe UInt
forall a. Maybe a
Nothing Rec
  ('R '[ "range" ':-> Range] .+ 'R '[ "rangeLength" ':-> Maybe UInt])
-> Rec ('R '[ "text" ':-> Text])
-> Rec
     (('R '[ "range" ':-> Range]
       .+ 'R '[ "rangeLength" ':-> Maybe UInt])
      .+ 'R '[ "text" ':-> Text])
forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ Label "text"
#text Label "text" -> Text -> Rec ("text" .== Text)
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== (AnnotatedTextEdit
e AnnotatedTextEdit -> Getting Text AnnotatedTextEdit Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text AnnotatedTextEdit Text
forall s a. HasNewText s a => Lens' s a
Lens' AnnotatedTextEdit Text
newText)
    editToChangeEvent (InL TextEdit
e) = (Rec
   (Extend "range" Range ('R '[])
    .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
        .+ (("text" .== Text) .+ 'R '[])))
 |? Rec (("text" .== Text) .+ 'R '[]))
-> TextDocumentContentChangeEvent
TextDocumentContentChangeEvent ((Rec
    (Extend "range" Range ('R '[])
     .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
         .+ (("text" .== Text) .+ 'R '[])))
  |? Rec (("text" .== Text) .+ 'R '[]))
 -> TextDocumentContentChangeEvent)
-> (Rec
      (Extend "range" Range ('R '[])
       .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
           .+ (("text" .== Text) .+ 'R '[])))
    |? Rec (("text" .== Text) .+ 'R '[]))
-> TextDocumentContentChangeEvent
forall a b. (a -> b) -> a -> b
$ Rec
  (Extend "range" Range ('R '[])
   .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
       .+ (("text" .== Text) .+ 'R '[])))
-> Rec
     (Extend "range" Range ('R '[])
      .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
          .+ (("text" .== Text) .+ 'R '[])))
   |? Rec (("text" .== Text) .+ 'R '[])
forall a b. a -> a |? b
InL (Rec
   (Extend "range" Range ('R '[])
    .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
        .+ (("text" .== Text) .+ 'R '[])))
 -> Rec
      (Extend "range" Range ('R '[])
       .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
           .+ (("text" .== Text) .+ 'R '[])))
    |? Rec (("text" .== Text) .+ 'R '[]))
-> Rec
     (Extend "range" Range ('R '[])
      .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
          .+ (("text" .== Text) .+ 'R '[])))
-> Rec
     (Extend "range" Range ('R '[])
      .+ (Extend "rangeLength" (Maybe UInt) ('R '[])
          .+ (("text" .== Text) .+ 'R '[])))
   |? Rec (("text" .== Text) .+ 'R '[])
forall a b. (a -> b) -> a -> b
$ Label "range"
#range Label "range" -> Range -> Rec (Extend "range" Range ('R '[]))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== (TextEdit
e TextEdit -> Getting Range TextEdit Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range TextEdit Range
forall s a. HasRange s a => Lens' s a
Lens' TextEdit Range
range) Rec ('R '[ "range" ':-> Range])
-> Rec ('R '[ "rangeLength" ':-> Maybe UInt])
-> Rec
     ('R '[ "range" ':-> Range] .+ 'R '[ "rangeLength" ':-> Maybe UInt])
forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ Label "rangeLength"
#rangeLength Label "rangeLength"
-> Maybe UInt -> Rec (Extend "rangeLength" (Maybe UInt) ('R '[]))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== Maybe UInt
forall a. Maybe a
Nothing Rec
  ('R '[ "range" ':-> Range] .+ 'R '[ "rangeLength" ':-> Maybe UInt])
-> Rec ('R '[ "text" ':-> Text])
-> Rec
     (('R '[ "range" ':-> Range]
       .+ 'R '[ "rangeLength" ':-> Maybe UInt])
      .+ 'R '[ "text" ':-> Text])
forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ Label "text"
#text Label "text" -> Text -> Rec ("text" .== Text)
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== (TextEdit
e TextEdit -> Getting Text TextEdit Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text TextEdit Text
forall s a. HasNewText s a => Lens' s a
Lens' TextEdit Text
newText)

    getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams
    getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams
getParamsFromDocumentChange (InL TextDocumentEdit
textDocumentEdit) = TextDocumentEdit -> Maybe DidChangeTextDocumentParams
getParamsFromTextDocumentEdit TextDocumentEdit
textDocumentEdit
    getParamsFromDocumentChange DocumentChange
_ = Maybe DidChangeTextDocumentParams
forall a. Maybe a
Nothing

    bumpNewestVersion :: OptionalVersionedTextDocumentIdentifier -> Session OptionalVersionedTextDocumentIdentifier
    bumpNewestVersion :: OptionalVersionedTextDocumentIdentifier
-> ReaderT SessionState IO OptionalVersionedTextDocumentIdentifier
bumpNewestVersion (OptionalVersionedTextDocumentIdentifier Uri
uri (InL Int32
_)) = do
        VersionedTextDocumentIdentifier
nextVersion <- [VersionedTextDocumentIdentifier]
-> VersionedTextDocumentIdentifier
forall a. HasCallStack => [a] -> a
head ([VersionedTextDocumentIdentifier]
 -> VersionedTextDocumentIdentifier)
-> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
textDocumentVersions Uri
uri
        pure $ Uri -> (Int32 |? Null) -> OptionalVersionedTextDocumentIdentifier
OptionalVersionedTextDocumentIdentifier Uri
uri ((Int32 |? Null) -> OptionalVersionedTextDocumentIdentifier)
-> (Int32 |? Null) -> OptionalVersionedTextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ Int32 -> Int32 |? Null
forall a b. a -> a |? b
InL VersionedTextDocumentIdentifier
nextVersion._version
    bumpNewestVersion OptionalVersionedTextDocumentIdentifier
i = OptionalVersionedTextDocumentIdentifier
-> ReaderT SessionState IO OptionalVersionedTextDocumentIdentifier
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OptionalVersionedTextDocumentIdentifier
i

    -- For a uri returns an infinite list of versions [n,n+1,n+2,...]
    -- where n is the current version
    textDocumentVersions :: Uri -> Session [VersionedTextDocumentIdentifier]
    textDocumentVersions :: Uri -> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
textDocumentVersions Uri
uri = do
        VFS
vfs <- (SessionState -> TVar VFS) -> ReaderT SessionState IO (TVar VFS)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar VFS
vfs ReaderT SessionState IO (TVar VFS)
-> (TVar VFS -> ReaderT SessionState IO VFS)
-> ReaderT SessionState IO VFS
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO VFS -> ReaderT SessionState IO VFS
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VFS -> ReaderT SessionState IO VFS)
-> (TVar VFS -> IO VFS) -> TVar VFS -> ReaderT SessionState IO VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar VFS -> IO VFS
forall a. TVar a -> IO a
readTVarIO
        let curVer :: Int32
curVer = Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 (Maybe Int32 -> Int32) -> Maybe Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ VFS
vfs VFS -> Getting (First Int32) VFS Int32 -> Maybe Int32
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Map NormalizedUri VirtualFile
 -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> VFS -> Const (First Int32) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
  -> Const (First Int32) (Map NormalizedUri VirtualFile))
 -> VFS -> Const (First Int32) VFS)
-> ((Int32 -> Const (First Int32) Int32)
    -> Map NormalizedUri VirtualFile
    -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> Getting (First Int32) VFS Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Traversal'
     (Map NormalizedUri VirtualFile)
     (IxValue (Map NormalizedUri VirtualFile))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri) ((IxValue (Map NormalizedUri VirtualFile)
  -> Const (First Int32) (IxValue (Map NormalizedUri VirtualFile)))
 -> Map NormalizedUri VirtualFile
 -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> ((Int32 -> Const (First Int32) Int32)
    -> IxValue (Map NormalizedUri VirtualFile)
    -> Const (First Int32) (IxValue (Map NormalizedUri VirtualFile)))
-> (Int32 -> Const (First Int32) Int32)
-> Map NormalizedUri VirtualFile
-> Const (First Int32) (Map NormalizedUri VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Const (First Int32) Int32)
-> IxValue (Map NormalizedUri VirtualFile)
-> Const (First Int32) (IxValue (Map NormalizedUri VirtualFile))
forall s a. HasLsp_version s a => Lens' s a
Lens' (IxValue (Map NormalizedUri VirtualFile)) Int32
lsp_version
        [VersionedTextDocumentIdentifier]
-> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VersionedTextDocumentIdentifier]
 -> ReaderT SessionState IO [VersionedTextDocumentIdentifier])
-> [VersionedTextDocumentIdentifier]
-> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
forall a b. (a -> b) -> a -> b
$ Uri -> Int32 -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri (Int32 -> VersionedTextDocumentIdentifier)
-> [Int32] -> [VersionedTextDocumentIdentifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int32
curVer Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1 ..]

    textDocumentEdits :: Uri -> [TextEdit] -> ReaderT SessionState IO [TextDocumentEdit]
textDocumentEdits Uri
uri [TextEdit]
edits = do
        [VersionedTextDocumentIdentifier]
vers <- Uri -> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
textDocumentVersions Uri
uri
        pure $ (VersionedTextDocumentIdentifier -> TextEdit -> TextDocumentEdit)
-> [VersionedTextDocumentIdentifier]
-> [TextEdit]
-> [TextDocumentEdit]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\VersionedTextDocumentIdentifier
v TextEdit
e -> OptionalVersionedTextDocumentIdentifier
-> [TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit
TextDocumentEdit (AReview
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
-> OptionalVersionedTextDocumentIdentifier
forall b (m :: * -> *) t. MonadReader b m => AReview t b -> m t
review AReview
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
Prism'
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
_versionedTextDocumentIdentifier VersionedTextDocumentIdentifier
v) [TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
InL TextEdit
e]) [VersionedTextDocumentIdentifier]
vers [TextEdit]
edits

    getChangeParams :: Uri
-> [TextEdit]
-> ReaderT SessionState IO [DidChangeTextDocumentParams]
getChangeParams Uri
uri [TextEdit]
edits = do
        [TextDocumentEdit]
edits <- Uri -> [TextEdit] -> ReaderT SessionState IO [TextDocumentEdit]
textDocumentEdits Uri
uri ([TextEdit] -> [TextEdit]
forall a. [a] -> [a]
reverse [TextEdit]
edits)
        pure $ (TextDocumentEdit -> Maybe DidChangeTextDocumentParams)
-> [TextDocumentEdit] -> [DidChangeTextDocumentParams]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TextDocumentEdit -> Maybe DidChangeTextDocumentParams
getParamsFromTextDocumentEdit [TextDocumentEdit]
edits

    mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
    mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
mergeParams [DidChangeTextDocumentParams]
params =
        let events :: [TextDocumentContentChangeEvent]
events = [[TextDocumentContentChangeEvent]]
-> [TextDocumentContentChangeEvent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TextDocumentContentChangeEvent]]
 -> [TextDocumentContentChangeEvent])
-> [[TextDocumentContentChangeEvent]]
-> [TextDocumentContentChangeEvent]
forall a b. (a -> b) -> a -> b
$ [[TextDocumentContentChangeEvent]]
-> [[TextDocumentContentChangeEvent]]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([[TextDocumentContentChangeEvent]]
 -> [[TextDocumentContentChangeEvent]])
-> [[TextDocumentContentChangeEvent]]
-> [[TextDocumentContentChangeEvent]]
forall a b. (a -> b) -> a -> b
$ [TextDocumentContentChangeEvent]
-> [TextDocumentContentChangeEvent]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([TextDocumentContentChangeEvent]
 -> [TextDocumentContentChangeEvent])
-> (DidChangeTextDocumentParams
    -> [TextDocumentContentChangeEvent])
-> DidChangeTextDocumentParams
-> [TextDocumentContentChangeEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DidChangeTextDocumentParams
-> Getting
     [TextDocumentContentChangeEvent]
     DidChangeTextDocumentParams
     [TextDocumentContentChangeEvent]
-> [TextDocumentContentChangeEvent]
forall s a. s -> Getting a s a -> a
^. Getting
  [TextDocumentContentChangeEvent]
  DidChangeTextDocumentParams
  [TextDocumentContentChangeEvent]
forall s a. HasContentChanges s a => Lens' s a
Lens' DidChangeTextDocumentParams [TextDocumentContentChangeEvent]
contentChanges) (DidChangeTextDocumentParams -> [TextDocumentContentChangeEvent])
-> [DidChangeTextDocumentParams]
-> [[TextDocumentContentChangeEvent]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DidChangeTextDocumentParams]
params
         in VersionedTextDocumentIdentifier
-> [TextDocumentContentChangeEvent] -> DidChangeTextDocumentParams
DidChangeTextDocumentParams ([DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
forall a. HasCallStack => [a] -> a
head [DidChangeTextDocumentParams]
params DidChangeTextDocumentParams
-> Getting
     VersionedTextDocumentIdentifier
     DidChangeTextDocumentParams
     VersionedTextDocumentIdentifier
-> VersionedTextDocumentIdentifier
forall s a. s -> Getting a s a -> a
^. Getting
  VersionedTextDocumentIdentifier
  DidChangeTextDocumentParams
  VersionedTextDocumentIdentifier
forall s a. HasTextDocument s a => Lens' s a
Lens' DidChangeTextDocumentParams VersionedTextDocumentIdentifier
textDocument) [TextDocumentContentChangeEvent]
events
handleServerMessage (FromServerMess SMethod m
SMethod_WindowWorkDoneProgressCreate TMessage m
req) = TRequestMessage 'Method_WindowWorkDoneProgressCreate
-> Either
     ResponseError (MessageResult 'Method_WindowWorkDoneProgressCreate)
-> Session ()
forall (m :: Method 'ServerToClient 'Request).
TRequestMessage m
-> Either ResponseError (MessageResult m) -> Session ()
sendResponse TMessage m
TRequestMessage 'Method_WindowWorkDoneProgressCreate
req (Either
   ResponseError (MessageResult 'Method_WindowWorkDoneProgressCreate)
 -> Session ())
-> Either
     ResponseError (MessageResult 'Method_WindowWorkDoneProgressCreate)
-> Session ()
forall a b. (a -> b) -> a -> b
$ Null -> Either ResponseError Null
forall a b. b -> Either a b
Right Null
Null
handleServerMessage FromServerMessage
_ = () -> Session ()
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

{- | Sends a request to the server, with a callback that fires when the response arrives.
Multiple requests can be waiting at the same time.
-}
sendRequest
    :: forall (m :: Method 'ClientToServer 'Request)
     . (TMessage m ~ TRequestMessage m)
    => SMethod m
    -> MessageParams m
    -> (TResponseMessage m -> IO ())
    -> Session (LspId m)
sendRequest :: forall (m :: Method 'ClientToServer 'Request).
(TMessage m ~ TRequestMessage m) =>
SMethod m
-> MessageParams m
-> (TResponseMessage m -> IO ())
-> Session (LspId m)
sendRequest SMethod m
requestMethod MessageParams m
params TResponseMessage m -> IO ()
requestCallback = do
    LspId m
reqId <- (SessionState -> TVar Int32)
-> ReaderT SessionState IO (TVar Int32)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar Int32
lastRequestId ReaderT SessionState IO (TVar Int32)
-> (TVar Int32 -> ReaderT SessionState IO Int32)
-> ReaderT SessionState IO Int32
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Int32 -> ReaderT SessionState IO Int32
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> ReaderT SessionState IO Int32)
-> (TVar Int32 -> IO Int32)
-> TVar Int32
-> ReaderT SessionState IO Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Int32) -> TVar Int32 -> IO Int32
forall a. (a -> a) -> TVar a -> IO a
overTVarIO (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1) ReaderT SessionState IO Int32
-> (Int32 -> LspId m) -> Session (LspId m)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int32 -> LspId m
forall (f :: MessageDirection) (m :: Method f 'Request).
Int32 -> LspId m
IdInt
    (SessionState -> TVar RequestMap)
-> ReaderT SessionState IO (TVar RequestMap)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar RequestMap
pendingRequests ReaderT SessionState IO (TVar RequestMap)
-> (TVar RequestMap -> Session ()) -> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (TVar RequestMap -> IO ()) -> TVar RequestMap -> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar RequestMap -> (RequestMap -> RequestMap) -> IO ())
-> (RequestMap -> RequestMap) -> TVar RequestMap -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TVar RequestMap -> (RequestMap -> RequestMap) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO (LspId m -> RequestCallback m -> RequestMap -> RequestMap
forall (m :: Method 'ClientToServer 'Request).
LspId m -> RequestCallback m -> RequestMap -> RequestMap
updateRequestMap LspId m
reqId RequestCallback{SMethod m
TResponseMessage m -> IO ()
requestMethod :: SMethod m
requestCallback :: TResponseMessage m -> IO ()
requestCallback :: TResponseMessage m -> IO ()
requestMethod :: SMethod m
..})
    FromClientMessage -> Session ()
sendMessage (FromClientMessage -> Session ())
-> FromClientMessage -> Session ()
forall a b. (a -> b) -> a -> b
$ TRequestMessage m -> FromClientMessage
forall (m :: Method 'ClientToServer 'Request).
(TMessage m ~ TRequestMessage m) =>
TRequestMessage m -> FromClientMessage
fromClientReq (TRequestMessage m -> FromClientMessage)
-> TRequestMessage m -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> LspId m -> SMethod m -> MessageParams m -> TRequestMessage m
TRequestMessage Text
"2.0" LspId m
reqId SMethod m
requestMethod MessageParams m
params
    pure LspId m
reqId

{- | Send a response to the server. This is used internally to acknowledge server requests.
Users of this library cannot register callbacks to server requests, so this function is probably of no use to them.
-}
sendResponse
    :: forall (m :: Method 'ServerToClient 'Request)
     . TRequestMessage m
    -> Either ResponseError (MessageResult m)
    -> Session ()
sendResponse :: forall (m :: Method 'ServerToClient 'Request).
TRequestMessage m
-> Either ResponseError (MessageResult m) -> Session ()
sendResponse TRequestMessage m
req Either ResponseError (MessageResult m)
res = do
    FromClientMessage -> Session ()
sendMessage (FromClientMessage -> Session ())
-> FromClientMessage -> Session ()
forall a b. (a -> b) -> a -> b
$ SMethod m -> TResponseMessage m -> FromClientMessage
forall (m :: Method 'ServerToClient 'Request)
       (a :: Method 'ServerToClient 'Request -> *).
a m -> TResponseMessage m -> FromClientMessage' a
FromClientRsp TRequestMessage m
req._method (TResponseMessage m -> FromClientMessage)
-> TResponseMessage m -> FromClientMessage
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe (LspId m)
-> Either ResponseError (MessageResult m)
-> TResponseMessage m
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> Maybe (LspId m)
-> Either ResponseError (MessageResult m)
-> TResponseMessage m
TResponseMessage TRequestMessage m
req._jsonrpc (LspId m -> Maybe (LspId m)
forall a. a -> Maybe a
Just TRequestMessage m
req._id) Either ResponseError (MessageResult m)
res

-- | Sends a request to the server and synchronously waits for its response.
request
    :: forall (m :: Method 'ClientToServer 'Request)
     . (TMessage m ~ TRequestMessage m)
    => SMethod m
    -> MessageParams m
    -> Session (TResponseMessage m)
request :: forall (m :: Method 'ClientToServer 'Request).
(TMessage m ~ TRequestMessage m) =>
SMethod m -> MessageParams m -> Session (TResponseMessage m)
request SMethod m
method MessageParams m
params = do
    MVar (TResponseMessage m)
done <- IO (MVar (TResponseMessage m))
-> ReaderT SessionState IO (MVar (TResponseMessage m))
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (MVar (TResponseMessage m))
forall a. IO (MVar a)
newEmptyMVar
    ReaderT SessionState IO (LspId m) -> Session ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SessionState IO (LspId m) -> Session ())
-> ReaderT SessionState IO (LspId m) -> Session ()
forall a b. (a -> b) -> a -> b
$ SMethod m
-> MessageParams m
-> (TResponseMessage m -> IO ())
-> ReaderT SessionState IO (LspId m)
forall (m :: Method 'ClientToServer 'Request).
(TMessage m ~ TRequestMessage m) =>
SMethod m
-> MessageParams m
-> (TResponseMessage m -> IO ())
-> Session (LspId m)
sendRequest SMethod m
method MessageParams m
params ((TResponseMessage m -> IO ())
 -> ReaderT SessionState IO (LspId m))
-> (TResponseMessage m -> IO ())
-> ReaderT SessionState IO (LspId m)
forall a b. (a -> b) -> a -> b
$ MVar (TResponseMessage m) -> TResponseMessage m -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (TResponseMessage m)
done
    IO (TResponseMessage m) -> Session (TResponseMessage m)
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TResponseMessage m) -> Session (TResponseMessage m))
-> IO (TResponseMessage m) -> Session (TResponseMessage m)
forall a b. (a -> b) -> a -> b
$ MVar (TResponseMessage m) -> IO (TResponseMessage m)
forall a. MVar a -> IO a
takeMVar MVar (TResponseMessage m)
done

{- | Checks the response for errors and throws an exception if needed.
 Returns the result if successful.
-}
getResponseResult :: TResponseMessage m -> MessageResult m
getResponseResult :: forall {f :: MessageDirection} (m :: Method f 'Request).
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage m
response = (ResponseError -> MessageResult m)
-> (MessageResult m -> MessageResult m)
-> Either ResponseError (MessageResult m)
-> MessageResult m
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ResponseError -> MessageResult m
err MessageResult m -> MessageResult m
forall a. a -> a
Prelude.id (Either ResponseError (MessageResult m) -> MessageResult m)
-> Either ResponseError (MessageResult m) -> MessageResult m
forall a b. (a -> b) -> a -> b
$ TResponseMessage m
response TResponseMessage m
-> Getting
     (Either ResponseError (MessageResult m))
     (TResponseMessage m)
     (Either ResponseError (MessageResult m))
-> Either ResponseError (MessageResult m)
forall s a. s -> Getting a s a -> a
^. Getting
  (Either ResponseError (MessageResult m))
  (TResponseMessage m)
  (Either ResponseError (MessageResult m))
forall s a. HasResult s a => Lens' s a
Lens' (TResponseMessage m) (Either ResponseError (MessageResult m))
result
  where
    lid :: SomeLspId
lid = LspId m -> SomeLspId
forall {f :: MessageDirection} (m :: Method f 'Request).
LspId m -> SomeLspId
SomeLspId (LspId m -> SomeLspId) -> LspId m -> SomeLspId
forall a b. (a -> b) -> a -> b
$ Maybe (LspId m) -> LspId m
forall a. HasCallStack => Maybe a -> a
fromJust TResponseMessage m
response._id
    err :: ResponseError -> MessageResult m
err = SessionException -> MessageResult m
forall a e. Exception e => e -> a
throw (SessionException -> MessageResult m)
-> (ResponseError -> SessionException)
-> ResponseError
-> MessageResult m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeLspId -> ResponseError -> SessionException
UnexpectedResponseError SomeLspId
lid

-- | Sends a notification to the server. Updates the VFS if the notification is a document update.
sendNotification
    :: forall (m :: Method 'ClientToServer 'Notification)
     . (TMessage m ~ TNotificationMessage m)
    => SMethod m
    -> MessageParams m
    -> Session ()
sendNotification :: forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
SMethod m -> MessageParams m -> Session ()
sendNotification SMethod m
m MessageParams m
params = do
    let n :: TNotificationMessage m
n = Text -> SMethod m -> MessageParams m -> TNotificationMessage m
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod m
m MessageParams m
params
    TVar VFS
vfs <- (SessionState -> TVar VFS) -> ReaderT SessionState IO (TVar VFS)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar VFS
vfs
    case SMethod m
m of
        SMethod m
SMethod_TextDocumentDidOpen -> IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ TVar VFS -> (VFS -> VFS) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO TVar VFS
vfs (State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState (State VFS () -> VFS -> VFS) -> State VFS () -> VFS -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> m ()
openVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidOpen
TNotificationMessage m
n)
        SMethod m
SMethod_TextDocumentDidClose -> IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ TVar VFS -> (VFS -> VFS) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO TVar VFS
vfs (State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState (State VFS () -> VFS -> VFS) -> State VFS () -> VFS -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> m ()
closeVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidClose
TNotificationMessage m
n)
        SMethod m
SMethod_TextDocumentDidChange -> IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ TVar VFS -> (VFS -> VFS) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO TVar VFS
vfs (State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState (State VFS () -> VFS -> VFS) -> State VFS () -> VFS -> VFS
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> m ()
changeFromClientVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidChange
TNotificationMessage m
n)
        SMethod m
_ -> () -> Session ()
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FromClientMessage -> Session ()
sendMessage (FromClientMessage -> Session ())
-> FromClientMessage -> Session ()
forall a b. (a -> b) -> a -> b
$ TNotificationMessage m -> FromClientMessage
forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
TNotificationMessage m -> FromClientMessage
fromClientNot TNotificationMessage m
n

{- | Registers a callback for notifications received from the server.
If multiple callbacks are registered for the same notification method, they will all be called.
-}
receiveNotification
    :: forall (m :: Method 'ServerToClient 'Notification)
     . (TMessage m ~ TNotificationMessage m)
    => SMethod m
    -> (TMessage m -> IO ())
    -> Session ()
receiveNotification :: forall (m :: Method 'ServerToClient 'Notification).
(TMessage m ~ TNotificationMessage m) =>
SMethod m -> (TMessage m -> IO ()) -> Session ()
receiveNotification SMethod m
method TMessage m -> IO ()
notificationCallback =
    (SessionState -> TVar NotificationMap)
-> ReaderT SessionState IO (TVar NotificationMap)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar NotificationMap
notificationHandlers
        ReaderT SessionState IO (TVar NotificationMap)
-> (TVar NotificationMap -> Session ()) -> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> Session ())
-> (TVar NotificationMap -> IO ())
-> TVar NotificationMap
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar NotificationMap
 -> (NotificationMap -> NotificationMap) -> IO ())
-> (NotificationMap -> NotificationMap)
-> TVar NotificationMap
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
            TVar NotificationMap
-> (NotificationMap -> NotificationMap) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO
            ( SMethod m
-> NotificationCallback m -> NotificationMap -> NotificationMap
forall (m :: Method 'ServerToClient 'Notification).
SMethod m
-> NotificationCallback m -> NotificationMap -> NotificationMap
appendNotificationCallback SMethod m
method NotificationCallback{TMessage m -> IO ()
TNotificationMessage m -> IO ()
notificationCallback :: TMessage m -> IO ()
notificationCallback :: TNotificationMessage m -> IO ()
..}
            )

{- | Clears the registered callback for the given notification method, if any.
If multiple callbacks have been registered, this clears /all/ of them.
-}
clearNotificationCallback
    :: forall (m :: Method 'ServerToClient 'Notification)
     . SMethod m
    -> Session ()
clearNotificationCallback :: forall (m :: Method 'ServerToClient 'Notification).
SMethod m -> Session ()
clearNotificationCallback SMethod m
method =
    (SessionState -> TVar NotificationMap)
-> ReaderT SessionState IO (TVar NotificationMap)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar NotificationMap
notificationHandlers
        ReaderT SessionState IO (TVar NotificationMap)
-> (TVar NotificationMap -> Session ()) -> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> Session ())
-> (TVar NotificationMap -> IO ())
-> TVar NotificationMap
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TVar NotificationMap
 -> (NotificationMap -> NotificationMap) -> IO ())
-> (NotificationMap -> NotificationMap)
-> TVar NotificationMap
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip
            TVar NotificationMap
-> (NotificationMap -> NotificationMap) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO
            ( SMethod m -> NotificationMap -> NotificationMap
forall (m :: Method 'ServerToClient 'Notification).
SMethod m -> NotificationMap -> NotificationMap
removeNotificationCallback SMethod m
method
            )

-- | Queues a message to be sent to the server at the client's earliest convenience.
sendMessage :: FromClientMessage -> Session ()
sendMessage :: FromClientMessage -> Session ()
sendMessage FromClientMessage
msg = (SessionState -> TQueue FromClientMessage)
-> ReaderT SessionState IO (TQueue FromClientMessage)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TQueue FromClientMessage
outgoing ReaderT SessionState IO (TQueue FromClientMessage)
-> (TQueue FromClientMessage -> Session ()) -> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (TQueue FromClientMessage -> IO ())
-> TQueue FromClientMessage
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ())
-> (TQueue FromClientMessage -> STM ())
-> TQueue FromClientMessage
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TQueue FromClientMessage -> FromClientMessage -> STM ()
forall a. TQueue a -> a -> STM ()
`writeTQueue` FromClientMessage
msg)

lspClientInfo :: Rec ("name" .== Text .+ "version" .== Maybe Text)
lspClientInfo :: Rec (Extend "name" Text ('R '[]) .+ ("version" .== Maybe Text))
lspClientInfo = Label "name"
#name Label "name" -> Text -> Rec (Extend "name" Text ('R '[]))
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== Text
"lsp-client" Rec ('R '[ "name" ':-> Text])
-> Rec ('R '[ "version" ':-> Maybe Text])
-> Rec
     ('R '[ "name" ':-> Text] .+ 'R '[ "version" ':-> Maybe Text])
forall (l :: Row (*)) (r :: Row (*)).
FreeForall l =>
Rec l -> Rec r -> Rec (l .+ r)
.+ Label "version"
#version Label "version" -> Maybe Text -> Rec ("version" .== Maybe Text)
forall (l :: Symbol) a.
KnownSymbol l =>
Label l -> a -> Rec (l .== a)
.== Text -> Maybe Text
forall a. a -> Maybe a
Just CURRENT_PACKAGE_VERSION

{- | Performs the initialisation handshake and synchronously waits for its completion.
When the function completes, the session is initialised.
-}
initialize :: Session ()
initialize :: Session ()
initialize = do
    ProcessID
pid <- IO ProcessID -> ReaderT SessionState IO ProcessID
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ProcessID
getProcessID
    TResponseMessage 'Method_Initialize
response <-
        SMethod 'Method_Initialize
-> MessageParams 'Method_Initialize
-> Session (TResponseMessage 'Method_Initialize)
forall (m :: Method 'ClientToServer 'Request).
(TMessage m ~ TRequestMessage m) =>
SMethod m -> MessageParams m -> Session (TResponseMessage m)
request
            SMethod 'Method_Initialize
SMethod_Initialize
            InitializeParams
                { $sel:_workDoneToken:InitializeParams :: Maybe ProgressToken
_workDoneToken = Maybe ProgressToken
forall a. Maybe a
Nothing
                , $sel:_processId:InitializeParams :: Int32 |? Null
_processId = Int32 -> Int32 |? Null
forall a b. a -> a |? b
InL (Int32 -> Int32 |? Null) -> Int32 -> Int32 |? Null
forall a b. (a -> b) -> a -> b
$ ProcessID -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ProcessID
pid
                , $sel:_clientInfo:InitializeParams :: Maybe
  (Rec
     (Extend "name" Text ('R '[])
      .+ (("version" .== Maybe Text) .+ 'R '[])))
_clientInfo = Rec ('R '[ "name" ':-> Text, "version" ':-> Maybe Text])
-> Maybe (Rec ('R '[ "name" ':-> Text, "version" ':-> Maybe Text]))
forall a. a -> Maybe a
Just Rec (Extend "name" Text ('R '[]) .+ ("version" .== Maybe Text))
Rec ('R '[ "name" ':-> Text, "version" ':-> Maybe Text])
lspClientInfo
                , $sel:_locale:InitializeParams :: Maybe Text
_locale = Maybe Text
forall a. Maybe a
Nothing
                , $sel:_rootPath:InitializeParams :: Maybe (Text |? Null)
_rootPath = Maybe (Text |? Null)
forall a. Maybe a
Nothing
                , $sel:_rootUri:InitializeParams :: Uri |? Null
_rootUri = Null -> Uri |? Null
forall a b. b -> a |? b
InR Null
Null
                , $sel:_initializationOptions:InitializeParams :: Maybe Value
_initializationOptions = Maybe Value
forall a. Maybe a
Nothing
                , $sel:_capabilities:InitializeParams :: ClientCapabilities
_capabilities = ClientCapabilities
fullCaps
                , $sel:_trace:InitializeParams :: Maybe TraceValues
_trace = TraceValues -> Maybe TraceValues
forall a. a -> Maybe a
Just TraceValues
TraceValues_Off
                , $sel:_workspaceFolders:InitializeParams :: Maybe ([WorkspaceFolder] |? Null)
_workspaceFolders = Maybe ([WorkspaceFolder] |? Null)
forall a. Maybe a
Nothing
                }
    (SessionState -> TMVar InitializeResult)
-> ReaderT SessionState IO (TMVar InitializeResult)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TMVar InitializeResult
initialized ReaderT SessionState IO (TMVar InitializeResult)
-> (TMVar InitializeResult -> Session ()) -> Session ()
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (TMVar InitializeResult -> IO ())
-> TMVar InitializeResult
-> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ())
-> (TMVar InitializeResult -> STM ())
-> TMVar InitializeResult
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TMVar InitializeResult -> InitializeResult -> STM ())
-> InitializeResult -> TMVar InitializeResult -> STM ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip TMVar InitializeResult -> InitializeResult -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar (TResponseMessage 'Method_Initialize
-> MessageResult 'Method_Initialize
forall {f :: MessageDirection} (m :: Method f 'Request).
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_Initialize
response)
    SMethod 'Method_Initialized
-> MessageParams 'Method_Initialized -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
SMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_Initialized
SMethod_Initialized MessageParams 'Method_Initialized
InitializedParams
InitializedParams

{- | /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.
-}
createDoc
    :: FilePath
    -- ^ The path to the document to open, __relative to the root directory__.
    -> Text
    -- ^ The text document's language identifier, e.g. @"haskell"@.
    -> Text
    -- ^ The content of the text document to create.
    -> Session TextDocumentIdentifier
    -- ^ The identifier of the document just created.
createDoc :: FilePath -> Text -> Text -> Session TextDocumentIdentifier
createDoc FilePath
file Text
language Text
contents = do
    HashMap Text SomeRegistration
serverCaps <- (SessionState -> TVar (HashMap Text SomeRegistration))
-> ReaderT SessionState IO (TVar (HashMap Text SomeRegistration))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar (HashMap Text SomeRegistration)
serverCapabilities ReaderT SessionState IO (TVar (HashMap Text SomeRegistration))
-> (TVar (HashMap Text SomeRegistration)
    -> ReaderT SessionState IO (HashMap Text SomeRegistration))
-> ReaderT SessionState IO (HashMap Text SomeRegistration)
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (HashMap Text SomeRegistration)
-> ReaderT SessionState IO (HashMap Text SomeRegistration)
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (HashMap Text SomeRegistration)
 -> ReaderT SessionState IO (HashMap Text SomeRegistration))
-> (TVar (HashMap Text SomeRegistration)
    -> IO (HashMap Text SomeRegistration))
-> TVar (HashMap Text SomeRegistration)
-> ReaderT SessionState IO (HashMap Text SomeRegistration)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (HashMap Text SomeRegistration)
-> IO (HashMap Text SomeRegistration)
forall a. TVar a -> IO a
readTVarIO
    ClientCapabilities
clientCaps <- (SessionState -> ClientCapabilities)
-> ReaderT SessionState IO ClientCapabilities
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> ClientCapabilities
clientCapabilities
    FilePath
rootDir <- (SessionState -> FilePath) -> ReaderT SessionState IO FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> FilePath
rootDir
    FilePath
absFile <- IO FilePath -> ReaderT SessionState IO FilePath
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ReaderT SessionState IO FilePath)
-> IO FilePath -> ReaderT SessionState IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath (FilePath
rootDir FilePath -> FilePath -> FilePath
</> FilePath
file)
    let pred :: SomeRegistration -> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
        pred :: SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
pred (SomeRegistration r :: TRegistration m
r@TRegistration{$sel:_method:TRegistration :: forall (t :: MessageKind) (m :: Method 'ClientToServer t).
TRegistration m -> SClientMethod m
_method = SMethod m
SMethod_WorkspaceDidChangeWatchedFiles}) = [TRegistration m
TRegistration 'Method_WorkspaceDidChangeWatchedFiles
r]
        pred SomeRegistration
_ = [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
forall a. Monoid a => a
mempty
        regs :: [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
        regs :: [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
regs = (SomeRegistration
 -> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles])
-> [SomeRegistration]
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SomeRegistration
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
pred ([SomeRegistration]
 -> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles])
-> [SomeRegistration]
-> [TRegistration 'Method_WorkspaceDidChangeWatchedFiles]
forall a b. (a -> b) -> a -> b
$ HashMap Text SomeRegistration -> [SomeRegistration]
forall k v. HashMap k v -> [v]
HashMap.elems HashMap Text SomeRegistration
serverCaps
        watchHits :: FileSystemWatcher -> Bool
        watchHits :: FileSystemWatcher -> Bool
watchHits (FileSystemWatcher (GlobPattern (InL (Pattern Text
pattern))) Maybe WatchKind
kind) =
            FilePath -> Bool
fileMatches (Text -> FilePath
Text.unpack Text
pattern) Bool -> Bool -> Bool
&& Bool -> (WatchKind -> Bool) -> Maybe WatchKind -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True WatchKind -> Bool
containsCreate Maybe WatchKind
kind
        watchHits FileSystemWatcher
_ = Bool
False

        fileMatches :: String -> Bool
        fileMatches :: FilePath -> Bool
fileMatches FilePath
pattern = Pattern -> FilePath -> Bool
Glob.match (FilePath -> Pattern
Glob.compile FilePath
pattern) (if FilePath -> Bool
isAbsolute FilePath
pattern then FilePath
absFile else FilePath
file)

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

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

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

{- | Opens a text document that /exists on disk/, and sends a
 @textDocument/didOpen@ notification to the server.
-}
openDoc :: FilePath -> Text -> Session TextDocumentIdentifier
openDoc :: FilePath -> Text -> Session TextDocumentIdentifier
openDoc FilePath
file Text
language = do
    FilePath
rootDir <- (SessionState -> FilePath) -> ReaderT SessionState IO FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> FilePath
rootDir
    let fp :: FilePath
fp = FilePath
rootDir FilePath -> FilePath -> FilePath
</> FilePath
file
    Text
contents <- IO Text -> ReaderT SessionState IO Text
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ReaderT SessionState IO Text)
-> IO Text -> ReaderT SessionState IO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
Text.readFile FilePath
fp
    FilePath -> Text -> Text -> Session TextDocumentIdentifier
openDoc' FilePath
file Text
language 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 -> Text -> Text -> Session TextDocumentIdentifier
openDoc' :: FilePath -> Text -> Text -> Session TextDocumentIdentifier
openDoc' FilePath
file Text
language Text
contents = do
    FilePath
rootDir <- (SessionState -> FilePath) -> ReaderT SessionState IO FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> FilePath
rootDir
    let fp :: FilePath
fp = FilePath
rootDir FilePath -> FilePath -> FilePath
</> FilePath
file
        uri :: Uri
uri = FilePath -> Uri
filePathToUri FilePath
fp
        item :: TextDocumentItem
item = Uri -> Text -> Int32 -> Text -> TextDocumentItem
TextDocumentItem Uri
uri Text
language Int32
0 Text
contents
    SMethod 'Method_TextDocumentDidOpen
-> MessageParams 'Method_TextDocumentDidOpen -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
SMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen (TextDocumentItem -> DidOpenTextDocumentParams
DidOpenTextDocumentParams TextDocumentItem
item)
    pure $ Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
uri

-- | Closes a text document and sends a @textDocument/didClose@ notification to the server.
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc :: TextDocumentIdentifier -> Session ()
closeDoc TextDocumentIdentifier
docId = do
    let params :: DidCloseTextDocumentParams
params = TextDocumentIdentifier -> DidCloseTextDocumentParams
DidCloseTextDocumentParams (Uri -> TextDocumentIdentifier
TextDocumentIdentifier (TextDocumentIdentifier
docId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri))
    SMethod 'Method_TextDocumentDidClose
-> MessageParams 'Method_TextDocumentDidClose -> Session ()
forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
SMethod m -> MessageParams m -> Session ()
sendNotification SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose MessageParams 'Method_TextDocumentDidClose
DidCloseTextDocumentParams
params

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

-- | Gets the Uri for the file relative to the session's root directory.
getDocUri :: FilePath -> Session Uri
getDocUri :: FilePath -> Session Uri
getDocUri FilePath
file = do
    FilePath
rootDir <- (SessionState -> FilePath) -> ReaderT SessionState IO FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> FilePath
rootDir
    let fp :: FilePath
fp = FilePath
rootDir FilePath -> FilePath -> FilePath
</> FilePath
file
    Uri -> Session Uri
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
return (Uri -> Session Uri) -> Uri -> Session Uri
forall a b. (a -> b) -> a -> b
$ FilePath -> Uri
filePathToUri FilePath
fp

-- | The current text contents of a document.
documentContents :: TextDocumentIdentifier -> Session (Maybe Rope)
documentContents :: TextDocumentIdentifier -> Session (Maybe Rope)
documentContents (TextDocumentIdentifier Uri
uri) = do
    VFS
vfs <- (SessionState -> TVar VFS) -> ReaderT SessionState IO (TVar VFS)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar VFS
vfs ReaderT SessionState IO (TVar VFS)
-> (TVar VFS -> ReaderT SessionState IO VFS)
-> ReaderT SessionState IO VFS
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO VFS -> ReaderT SessionState IO VFS
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VFS -> ReaderT SessionState IO VFS)
-> (TVar VFS -> IO VFS) -> TVar VFS -> ReaderT SessionState IO VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar VFS -> IO VFS
forall a. TVar a -> IO a
readTVarIO
    pure $ VFS
vfs VFS -> Getting (First Rope) VFS Rope -> Maybe Rope
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Map NormalizedUri VirtualFile
 -> Const (First Rope) (Map NormalizedUri VirtualFile))
-> VFS -> Const (First Rope) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
  -> Const (First Rope) (Map NormalizedUri VirtualFile))
 -> VFS -> Const (First Rope) VFS)
-> ((Rope -> Const (First Rope) Rope)
    -> Map NormalizedUri VirtualFile
    -> Const (First Rope) (Map NormalizedUri VirtualFile))
-> Getting (First Rope) VFS Rope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Traversal'
     (Map NormalizedUri VirtualFile)
     (IxValue (Map NormalizedUri VirtualFile))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri) ((VirtualFile -> Const (First Rope) VirtualFile)
 -> Map NormalizedUri VirtualFile
 -> Const (First Rope) (Map NormalizedUri VirtualFile))
-> ((Rope -> Const (First Rope) Rope)
    -> VirtualFile -> Const (First Rope) VirtualFile)
-> (Rope -> Const (First Rope) Rope)
-> Map NormalizedUri VirtualFile
-> Const (First Rope) (Map NormalizedUri VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VirtualFile -> Rope)
-> (Rope -> Const (First Rope) Rope)
-> VirtualFile
-> Const (First Rope) VirtualFile
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to VirtualFile -> Rope
_file_text

-- | Adds the current version to the document, as tracked by the session.
getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
getVersionedDoc :: TextDocumentIdentifier
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
getVersionedDoc (TextDocumentIdentifier Uri
uri) = do
    VFS
vfs <- (SessionState -> TVar VFS) -> ReaderT SessionState IO (TVar VFS)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks SessionState -> TVar VFS
vfs ReaderT SessionState IO (TVar VFS)
-> (TVar VFS -> ReaderT SessionState IO VFS)
-> ReaderT SessionState IO VFS
forall a b.
ReaderT SessionState IO a
-> (a -> ReaderT SessionState IO b) -> ReaderT SessionState IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO VFS -> ReaderT SessionState IO VFS
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VFS -> ReaderT SessionState IO VFS)
-> (TVar VFS -> IO VFS) -> TVar VFS -> ReaderT SessionState IO VFS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar VFS -> IO VFS
forall a. TVar a -> IO a
readTVarIO
    let ver :: Int32
ver = Int32 -> Maybe Int32 -> Int32
forall a. a -> Maybe a -> a
fromMaybe Int32
0 (Maybe Int32 -> Int32) -> Maybe Int32 -> Int32
forall a b. (a -> b) -> a -> b
$ VFS
vfs VFS -> Getting (First Int32) VFS Int32 -> Maybe Int32
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Map NormalizedUri VirtualFile
 -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> VFS -> Const (First Int32) VFS
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap ((Map NormalizedUri VirtualFile
  -> Const (First Int32) (Map NormalizedUri VirtualFile))
 -> VFS -> Const (First Int32) VFS)
-> ((Int32 -> Const (First Int32) Int32)
    -> Map NormalizedUri VirtualFile
    -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> Getting (First Int32) VFS Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map NormalizedUri VirtualFile)
-> Traversal'
     (Map NormalizedUri VirtualFile)
     (IxValue (Map NormalizedUri VirtualFile))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Uri -> NormalizedUri
toNormalizedUri Uri
uri) ((VirtualFile -> Const (First Int32) VirtualFile)
 -> Map NormalizedUri VirtualFile
 -> Const (First Int32) (Map NormalizedUri VirtualFile))
-> ((Int32 -> Const (First Int32) Int32)
    -> VirtualFile -> Const (First Int32) VirtualFile)
-> (Int32 -> Const (First Int32) Int32)
-> Map NormalizedUri VirtualFile
-> Const (First Int32) (Map NormalizedUri VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VirtualFile -> Int32)
-> (Int32 -> Const (First Int32) Int32)
-> VirtualFile
-> Const (First Int32) VirtualFile
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to VirtualFile -> Int32
virtualFileVersion
    VersionedTextDocumentIdentifier
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VersionedTextDocumentIdentifier
 -> ReaderT SessionState IO VersionedTextDocumentIdentifier)
-> VersionedTextDocumentIdentifier
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ Uri -> Int32 -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri Int32
ver