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

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 (runReaderT), ask, asks)
import Control.Monad.State (StateT, execState)
import Control.Monad.Trans.Class (MonadTrans, lift)
import Data.Aeson (Value)
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.Text (Text)
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Text.Utf16.Rope.Mixed (Rope)
import Language.LSP.Client.Decoding
import Language.LSP.Client.Exceptions (SessionException (UnexpectedResponseError))
import Language.LSP.Protocol.Capabilities (fullLatestClientCaps)
import Language.LSP.Protocol.Lens qualified as LSP
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Language.LSP.VFS
import System.Directory (canonicalizePath)
import System.FilePath (isAbsolute, (</>))
import System.FilePath.Glob qualified as Glob
import System.PosixCompat.Process (getProcessID)
import Prelude hiding (id)
import Prelude qualified

data SessionState = SessionState
    { 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 :: (MonadIO io) => VFS -> io SessionState
defaultSessionState :: forall (io :: * -> *). MonadIO io => VFS -> io SessionState
defaultSessionState VFS
vfs' = IO SessionState -> io SessionState
forall a. IO a -> io a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SessionState -> io SessionState)
-> IO SessionState -> io SessionState
forall a b. (a -> b) -> a -> b
$ do
    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
TQueue FromClientMessage
pendingRequests :: TVar RequestMap
notificationHandlers :: TVar NotificationMap
lastRequestId :: TVar Int32
serverCapabilities :: TVar (HashMap Text SomeRegistration)
progressTokens :: TVar (HashSet ProgressToken)
outgoing :: TQueue FromClientMessage
vfs :: TVar VFS
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 SessionT = ReaderT SessionState

type Session = SessionT IO

class (Monad m) => MonadSession m where
    liftSession :: forall a. Session a -> m a

instance {-# OVERLAPPING #-} (MonadIO m) => MonadSession (SessionT m) where
    liftSession :: forall a. Session a -> SessionT m a
liftSession Session a
a = IO a -> ReaderT SessionState m a
forall a. IO a -> ReaderT SessionState m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ReaderT SessionState m a)
-> (SessionState -> IO a)
-> SessionState
-> ReaderT SessionState m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session a -> SessionState -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Session a
a (SessionState -> ReaderT SessionState m a)
-> ReaderT SessionState m SessionState -> ReaderT SessionState m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT SessionState m SessionState
forall r (m :: * -> *). MonadReader r m => m r
ask

instance {-# OVERLAPPABLE #-} (MonadTrans t, MonadSession m, Monad (t m)) => MonadSession (t m) where
    liftSession :: forall a. Session a -> t m a
liftSession = m a -> t m a
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> t m a) -> (Session a -> m a) -> Session a -> t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session a -> m a
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession

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
LSP.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
LSP.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
LSP.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
LSP.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
LSP.uri

{- | 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 :: (MonadSession m) => FromServerMessage -> m ()
handleServerMessage :: forall (m :: * -> *). MonadSession m => FromServerMessage -> m ()
handleServerMessage (FromServerMess SMethod m
SMethod_Progress TMessage m
req) =
    Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ())
-> (Session () -> Session ()) -> Session () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
LSP.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
LSP.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 () -> m ()) -> Session () -> m ()
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
LSP.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
LSP.token)
handleServerMessage (FromServerMess SMethod m
SMethod_ClientRegisterCapability TMessage m
req) =
    Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$ (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 => 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
LSP.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]
LSP.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
LSP.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) =
    Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$ (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
LSP.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
LSP.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]
LSP.unregisterations
handleServerMessage (FromServerMess SMethod m
SMethod_WorkspaceApplyEdit TMessage m
r) = Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
LSP.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
LSP.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])
LSP.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
LSP.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
LSP.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
LSP.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]))
LSP.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
LSP.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 (method :: Method 'ClientToServer 'Notification)
       (m :: * -> *).
(TMessage method ~ TNotificationMessage method, MonadSession m) =>
SMethod method -> MessageParams method -> m ()
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
LSP.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
LSP.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
LSP.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{Int32
Uri
_uri :: Uri
_version :: Int32
$sel:_uri:VersionedTextDocumentIdentifier :: VersionedTextDocumentIdentifier -> Uri
$sel:_version:VersionedTextDocumentIdentifier :: VersionedTextDocumentIdentifier -> Int32
..} ->
        (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
                    ( (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)
-> ((IxValue (Map NormalizedUri VirtualFile)
     -> Identity (IxValue (Map NormalizedUri VirtualFile)))
    -> Map NormalizedUri VirtualFile
    -> Identity (Map NormalizedUri VirtualFile))
-> (IxValue (Map NormalizedUri VirtualFile)
    -> Identity (IxValue (Map NormalizedUri 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) ((IxValue (Map NormalizedUri VirtualFile)
  -> Identity (IxValue (Map NormalizedUri VirtualFile)))
 -> VFS -> Identity VFS)
-> (IxValue (Map NormalizedUri VirtualFile)
    -> IxValue (Map NormalizedUri VirtualFile))
-> VFS
-> VFS
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (((Int32 -> Identity Int32)
-> IxValue (Map NormalizedUri VirtualFile)
-> Identity (IxValue (Map NormalizedUri VirtualFile))
forall s a. HasLsp_version s a => Lens' s a
Lens' (IxValue (Map NormalizedUri VirtualFile)) Int32
lsp_version ((Int32 -> Identity Int32)
 -> IxValue (Map NormalizedUri VirtualFile)
 -> Identity (IxValue (Map NormalizedUri VirtualFile)))
-> Int32
-> IxValue (Map NormalizedUri VirtualFile)
-> IxValue (Map NormalizedUri VirtualFile)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int32
_version) (IxValue (Map NormalizedUri VirtualFile)
 -> IxValue (Map NormalizedUri VirtualFile))
-> (IxValue (Map NormalizedUri VirtualFile)
    -> IxValue (Map NormalizedUri VirtualFile))
-> IxValue (Map NormalizedUri VirtualFile)
-> IxValue (Map NormalizedUri VirtualFile)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> Identity Int)
-> IxValue (Map NormalizedUri VirtualFile)
-> Identity (IxValue (Map NormalizedUri VirtualFile))
forall s a. HasFile_version s a => Lens' s a
Lens' (IxValue (Map NormalizedUri VirtualFile)) Int
file_version ((Int -> Identity Int)
 -> IxValue (Map NormalizedUri VirtualFile)
 -> Identity (IxValue (Map NormalizedUri VirtualFile)))
-> Int
-> IxValue (Map NormalizedUri VirtualFile)
-> IxValue (Map NormalizedUri VirtualFile)
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
1))
                    )
    TRequestMessage 'Method_WorkspaceApplyEdit
-> Either
     (TResponseError 'Method_WorkspaceApplyEdit)
     (MessageResult 'Method_WorkspaceApplyEdit)
-> Session ()
forall (method :: Method 'ServerToClient 'Request) (m :: * -> *).
MonadSession m =>
TRequestMessage method
-> Either (TResponseError method) (MessageResult method) -> m ()
sendResponse
        TMessage m
TRequestMessage 'Method_WorkspaceApplyEdit
r
        (Either
   (TResponseError 'Method_WorkspaceApplyEdit)
   (MessageResult 'Method_WorkspaceApplyEdit)
 -> Session ())
-> Either
     (TResponseError 'Method_WorkspaceApplyEdit)
     (MessageResult 'Method_WorkspaceApplyEdit)
-> Session ()
forall a b. (a -> b) -> a -> b
$ ApplyWorkspaceEditResult
-> Either
     (TResponseError 'Method_WorkspaceApplyEdit)
     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{Severity
VfsLog
getMsg :: VfsLog
getSeverity :: Severity
getMsg :: forall msg. WithSeverity msg -> msg
getSeverity :: forall msg. WithSeverity msg -> Severity
..} -> case Severity
getSeverity 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
getMsg; Severity
_ -> () -> State VFS ()
forall a. a -> StateT VFS Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    checkIfNeedsOpened :: Uri -> Session ()
    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 (method :: Method 'ClientToServer 'Notification)
       (m :: * -> *).
(TMessage method ~ TNotificationMessage method, MonadSession m) =>
SMethod method -> MessageParams method -> m ()
sendNotification
                SMethod 'Method_TextDocumentDidOpen
SMethod_TextDocumentDidOpen
                DidOpenTextDocumentParams
                    { $sel:_textDocument:DidOpenTextDocumentParams :: TextDocumentItem
_textDocument =
                        TextDocumentItem
                            { $sel:_uri:TextDocumentItem :: Uri
_uri = Uri
uri
                            , $sel:_languageId:TextDocumentItem :: LanguageKind
_languageId = LanguageKind
""
                            , $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
_textDocument <- 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
        let _contentChanges :: [TextDocumentContentChangeEvent]
_contentChanges = (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
        pure DidChangeTextDocumentParams{[TextDocumentContentChangeEvent]
VersionedTextDocumentIdentifier
_textDocument :: VersionedTextDocumentIdentifier
_contentChanges :: [TextDocumentContentChangeEvent]
$sel:_contentChanges:DidChangeTextDocumentParams :: [TextDocumentContentChangeEvent]
$sel:_textDocument:DidChangeTextDocumentParams :: VersionedTextDocumentIdentifier
..}

    editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent
    editToChangeEvent :: (TextEdit |? AnnotatedTextEdit) -> TextDocumentContentChangeEvent
editToChangeEvent (InR AnnotatedTextEdit
e) = (TextDocumentContentChangePartial
 |? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent
TextDocumentContentChangeEvent ((TextDocumentContentChangePartial
  |? TextDocumentContentChangeWholeDocument)
 -> TextDocumentContentChangeEvent)
-> (TextDocumentContentChangePartial
    |? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent
forall a b. (a -> b) -> a -> b
$ TextDocumentContentChangePartial
-> TextDocumentContentChangePartial
   |? TextDocumentContentChangeWholeDocument
forall a b. a -> a |? b
InL TextDocumentContentChangePartial{$sel:_rangeLength:TextDocumentContentChangePartial :: Maybe UInt
_rangeLength = Maybe UInt
forall a. Maybe a
Nothing, $sel:_range:TextDocumentContentChangePartial :: Range
_range = 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
LSP.range, $sel:_text:TextDocumentContentChangePartial :: Text
_text = 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
LSP.newText}
    editToChangeEvent (InL TextEdit
e) = (TextDocumentContentChangePartial
 |? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent
TextDocumentContentChangeEvent ((TextDocumentContentChangePartial
  |? TextDocumentContentChangeWholeDocument)
 -> TextDocumentContentChangeEvent)
-> (TextDocumentContentChangePartial
    |? TextDocumentContentChangeWholeDocument)
-> TextDocumentContentChangeEvent
forall a b. (a -> b) -> a -> b
$ TextDocumentContentChangePartial
-> TextDocumentContentChangePartial
   |? TextDocumentContentChangeWholeDocument
forall a b. a -> a |? b
InL TextDocumentContentChangePartial{$sel:_rangeLength:TextDocumentContentChangePartial :: Maybe UInt
_rangeLength = Maybe UInt
forall a. Maybe a
Nothing, $sel:_range:TextDocumentContentChangePartial :: Range
_range = 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
LSP.range, $sel:_text:TextDocumentContentChangePartial :: Text
_text = 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
LSP.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 :: Uri
$sel:_uri:OptionalVersionedTextDocumentIdentifier :: OptionalVersionedTextDocumentIdentifier -> Uri
_uri, $sel:_version:OptionalVersionedTextDocumentIdentifier :: OptionalVersionedTextDocumentIdentifier -> Int32 |? Null
_version = InL Int32
_} = do
        VersionedTextDocumentIdentifier{Int32
$sel:_version:VersionedTextDocumentIdentifier :: VersionedTextDocumentIdentifier -> Int32
_version :: Int32
_version} <- [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
        OptionalVersionedTextDocumentIdentifier
-> ReaderT SessionState IO OptionalVersionedTextDocumentIdentifier
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OptionalVersionedTextDocumentIdentifier{$sel:_version:OptionalVersionedTextDocumentIdentifier :: Int32 |? Null
_version = Int32 -> Int32 |? Null
forall a b. a -> a |? b
InL Int32
_version, Uri
_uri :: Uri
$sel:_uri:OptionalVersionedTextDocumentIdentifier :: Uri
..}
    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+1,n+2,...]
    -- where n is the current version
    textDocumentVersions :: Uri -> Session [VersionedTextDocumentIdentifier]
    textDocumentVersions :: Uri -> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
textDocumentVersions Uri
_uri = do
        [VersionedTextDocumentIdentifier]
-> [VersionedTextDocumentIdentifier]
forall a. HasCallStack => [a] -> [a]
tail ([VersionedTextDocumentIdentifier]
 -> [VersionedTextDocumentIdentifier])
-> (VersionedTextDocumentIdentifier
    -> [VersionedTextDocumentIdentifier])
-> VersionedTextDocumentIdentifier
-> [VersionedTextDocumentIdentifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VersionedTextDocumentIdentifier
 -> VersionedTextDocumentIdentifier)
-> VersionedTextDocumentIdentifier
-> [VersionedTextDocumentIdentifier]
forall a. (a -> a) -> a -> [a]
iterate ((Int32 -> Identity Int32)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Int32
LSP.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) (VersionedTextDocumentIdentifier
 -> [VersionedTextDocumentIdentifier])
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
-> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TextDocumentIdentifier
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
forall (m :: * -> *).
MonadSession m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier{Uri
_uri :: Uri
$sel:_uri:TextDocumentIdentifier :: Uri
_uri}

    textDocumentEdits :: Uri -> [TextEdit] -> Session [TextDocumentEdit]
    textDocumentEdits :: Uri -> [TextEdit] -> Session [TextDocumentEdit]
textDocumentEdits Uri
uri [TextEdit]
edits = do
        [VersionedTextDocumentIdentifier]
versions <- 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 ->
                    TextDocumentEdit
                        { $sel:_edits:TextDocumentEdit :: [TextEdit |? AnnotatedTextEdit]
_edits = [TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
InL TextEdit
e]
                        , $sel:_textDocument:TextDocumentEdit :: OptionalVersionedTextDocumentIdentifier
_textDocument = 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
                        }
                )
                [VersionedTextDocumentIdentifier]
versions
                [TextEdit]
edits

    getChangeParams :: Uri
-> [TextEdit]
-> ReaderT SessionState IO [DidChangeTextDocumentParams]
getChangeParams Uri
uri [TextEdit]
edits = do
        [TextDocumentEdit]
edits <- Uri -> [TextEdit] -> Session [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 =
        DidChangeTextDocumentParams
            { $sel:_contentChanges:DidChangeTextDocumentParams :: [TextDocumentContentChangeEvent]
_contentChanges = [[TextDocumentContentChangeEvent]]
-> [TextDocumentContentChangeEvent]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[TextDocumentContentChangeEvent]]
 -> [TextDocumentContentChangeEvent])
-> ([[TextDocumentContentChangeEvent]]
    -> [[TextDocumentContentChangeEvent]])
-> [[TextDocumentContentChangeEvent]]
-> [TextDocumentContentChangeEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[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]
LSP.contentChanges) (DidChangeTextDocumentParams -> [TextDocumentContentChangeEvent])
-> [DidChangeTextDocumentParams]
-> [[TextDocumentContentChangeEvent]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DidChangeTextDocumentParams]
params
            , $sel:_textDocument:DidChangeTextDocumentParams :: VersionedTextDocumentIdentifier
_textDocument = [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
LSP.textDocument
            }
handleServerMessage (FromServerMess SMethod m
SMethod_WindowWorkDoneProgressCreate TMessage m
req) = Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ())
-> (Either
      (TResponseError 'Method_WindowWorkDoneProgressCreate) Null
    -> Session ())
-> Either
     (TResponseError 'Method_WindowWorkDoneProgressCreate) Null
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TRequestMessage 'Method_WindowWorkDoneProgressCreate
-> Either
     (TResponseError 'Method_WindowWorkDoneProgressCreate)
     (MessageResult 'Method_WindowWorkDoneProgressCreate)
-> Session ()
forall (method :: Method 'ServerToClient 'Request) (m :: * -> *).
MonadSession m =>
TRequestMessage method
-> Either (TResponseError method) (MessageResult method) -> m ()
sendResponse TMessage m
TRequestMessage 'Method_WindowWorkDoneProgressCreate
req (Either (TResponseError 'Method_WindowWorkDoneProgressCreate) Null
 -> m ())
-> Either
     (TResponseError 'Method_WindowWorkDoneProgressCreate) Null
-> m ()
forall a b. (a -> b) -> a -> b
$ Null
-> Either
     (TResponseError 'Method_WindowWorkDoneProgressCreate) Null
forall a b. b -> Either a b
Right Null
Null
handleServerMessage FromServerMessage
_ = () -> m ()
forall a. a -> m 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 (method :: Method 'ClientToServer 'Request) m
     . (TMessage method ~ TRequestMessage method, MonadSession m)
    => SMethod method
    -> MessageParams method
    -> (TResponseMessage method -> IO ())
    -> m (LspId method)
sendRequest :: forall (method :: Method 'ClientToServer 'Request) (m :: * -> *).
(TMessage method ~ TRequestMessage method, MonadSession m) =>
SMethod method
-> MessageParams method
-> (TResponseMessage method -> IO ())
-> m (LspId method)
sendRequest SMethod method
requestMethod MessageParams method
_params TResponseMessage method -> IO ()
requestCallback = Session (LspId method) -> m (LspId method)
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session (LspId method) -> m (LspId method))
-> Session (LspId method) -> m (LspId method)
forall a b. (a -> b) -> a -> b
$ do
    LspId method
_id <- (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 method) -> Session (LspId method)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Int32 -> LspId method
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 method -> RequestCallback method -> RequestMap -> RequestMap
forall (m :: Method 'ClientToServer 'Request).
LspId m -> RequestCallback m -> RequestMap -> RequestMap
updateRequestMap LspId method
_id RequestCallback{SMethod method
TResponseMessage method -> IO ()
requestMethod :: SMethod method
requestCallback :: TResponseMessage method -> IO ()
requestCallback :: TResponseMessage method -> IO ()
requestMethod :: SMethod method
..})
    FromClientMessage -> Session ()
forall (m :: * -> *). MonadSession m => FromClientMessage -> m ()
sendMessage (FromClientMessage -> Session ())
-> FromClientMessage -> Session ()
forall a b. (a -> b) -> a -> b
$ TRequestMessage method -> FromClientMessage
forall (m :: Method 'ClientToServer 'Request).
(TMessage m ~ TRequestMessage m) =>
TRequestMessage m -> FromClientMessage
fromClientReq TRequestMessage{$sel:_jsonrpc:TRequestMessage :: Text
_jsonrpc = Text
"2.0", $sel:_method:TRequestMessage :: SMethod method
_method = SMethod method
requestMethod, MessageParams method
LspId method
_params :: MessageParams method
_id :: LspId method
$sel:_id:TRequestMessage :: LspId method
$sel:_params:TRequestMessage :: MessageParams method
..}
    pure LspId method
_id

{- | 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 (method :: Method 'ServerToClient 'Request) m
     . (MonadSession m)
    => TRequestMessage method
    -> Either (TResponseError method) (MessageResult method)
    -> m ()
sendResponse :: forall (method :: Method 'ServerToClient 'Request) (m :: * -> *).
MonadSession m =>
TRequestMessage method
-> Either (TResponseError method) (MessageResult method) -> m ()
sendResponse TRequestMessage{Text
MessageParams method
SMethod method
LspId method
$sel:_jsonrpc:TRequestMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> Text
$sel:_method:TRequestMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> SMethod m
$sel:_id:TRequestMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> LspId m
$sel:_params:TRequestMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> MessageParams m
_jsonrpc :: Text
_id :: LspId method
_method :: SMethod method
_params :: MessageParams method
..} Either (TResponseError method) (MessageResult method)
_result = Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ())
-> (FromClientMessage -> Session ()) -> FromClientMessage -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromClientMessage -> Session ()
forall (m :: * -> *). MonadSession m => FromClientMessage -> m ()
sendMessage (FromClientMessage -> m ()) -> FromClientMessage -> m ()
forall a b. (a -> b) -> a -> b
$ SMethod method -> TResponseMessage method -> FromClientMessage
forall (m :: Method 'ServerToClient 'Request)
       (a :: Method 'ServerToClient 'Request -> *).
a m -> TResponseMessage m -> FromClientMessage' a
FromClientRsp SMethod method
_method TResponseMessage{$sel:_id:TResponseMessage :: Maybe (LspId method)
_id = LspId method -> Maybe (LspId method)
forall a. a -> Maybe a
Just LspId method
_id, Either (TResponseError method) (MessageResult method)
Text
_jsonrpc :: Text
_result :: Either (TResponseError method) (MessageResult method)
$sel:_jsonrpc:TResponseMessage :: Text
$sel:_result:TResponseMessage :: Either (TResponseError method) (MessageResult method)
..}

-- {_id = Just _id, ..}

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

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

-- | Sends a notification to the server. Updates the VFS if the notification is a document update.
sendNotification
    :: forall (method :: Method 'ClientToServer 'Notification) m
     . (TMessage method ~ TNotificationMessage method, MonadSession m)
    => SMethod method
    -> MessageParams method
    -> m ()
sendNotification :: forall (method :: Method 'ClientToServer 'Notification)
       (m :: * -> *).
(TMessage method ~ TNotificationMessage method, MonadSession m) =>
SMethod method -> MessageParams method -> m ()
sendNotification SMethod method
m MessageParams method
params = Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let n :: TNotificationMessage method
n = Text
-> SMethod method
-> MessageParams method
-> TNotificationMessage method
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
TNotificationMessage Text
"2.0" SMethod method
m MessageParams method
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 method
m of
        SMethod method
SMethod_TextDocumentDidOpen -> IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (State VFS () -> IO ()) -> State VFS () -> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar VFS -> (VFS -> VFS) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO TVar VFS
vfs ((VFS -> VFS) -> IO ())
-> (State VFS () -> VFS -> VFS) -> State VFS () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState (State VFS () -> Session ()) -> State VFS () -> Session ()
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidOpen -> m ()
openVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidOpen
TNotificationMessage method
n
        SMethod method
SMethod_TextDocumentDidClose -> IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (State VFS () -> IO ()) -> State VFS () -> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar VFS -> (VFS -> VFS) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO TVar VFS
vfs ((VFS -> VFS) -> IO ())
-> (State VFS () -> VFS -> VFS) -> State VFS () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState (State VFS () -> Session ()) -> State VFS () -> Session ()
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidClose -> m ()
closeVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidClose
TNotificationMessage method
n
        SMethod method
SMethod_TextDocumentDidChange -> IO () -> Session ()
forall a. IO a -> ReaderT SessionState IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ())
-> (State VFS () -> IO ()) -> State VFS () -> Session ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar VFS -> (VFS -> VFS) -> IO ()
forall a. TVar a -> (a -> a) -> IO ()
modifyTVarIO TVar VFS
vfs ((VFS -> VFS) -> IO ())
-> (State VFS () -> VFS -> VFS) -> State VFS () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State VFS () -> VFS -> VFS
forall s a. State s a -> s -> s
execState (State VFS () -> Session ()) -> State VFS () -> Session ()
forall a b. (a -> b) -> a -> b
$ LogAction (StateT VFS Identity) (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> State VFS ()
forall (m :: * -> *).
MonadState VFS m =>
LogAction m (WithSeverity VfsLog)
-> TMessage 'Method_TextDocumentDidChange -> m ()
changeFromClientVFS LogAction (StateT VFS Identity) (WithSeverity VfsLog)
forall a. Monoid a => a
mempty TMessage 'Method_TextDocumentDidChange
TNotificationMessage method
n
        SMethod method
_ -> () -> Session ()
forall a. a -> ReaderT SessionState IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    FromClientMessage -> Session ()
forall (m :: * -> *). MonadSession m => FromClientMessage -> m ()
sendMessage (FromClientMessage -> Session ())
-> FromClientMessage -> Session ()
forall a b. (a -> b) -> a -> b
$ TNotificationMessage method -> FromClientMessage
forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
TNotificationMessage m -> FromClientMessage
fromClientNot TNotificationMessage method
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 (method :: Method 'ServerToClient 'Notification) m
     . (TMessage method ~ TNotificationMessage method, MonadSession m)
    => SMethod method
    -> (TMessage method -> IO ())
    -> m ()
receiveNotification :: forall (method :: Method 'ServerToClient 'Notification)
       (m :: * -> *).
(TMessage method ~ TNotificationMessage method, MonadSession m) =>
SMethod method -> (TMessage method -> IO ()) -> m ()
receiveNotification SMethod method
method TMessage method -> IO ()
notificationCallback =
    Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$
        (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 method
-> NotificationCallback method
-> NotificationMap
-> NotificationMap
forall (m :: Method 'ServerToClient 'Notification).
SMethod m
-> NotificationCallback m -> NotificationMap -> NotificationMap
appendNotificationCallback SMethod method
method NotificationCallback{TMessage method -> IO ()
TNotificationMessage method -> IO ()
notificationCallback :: TMessage method -> IO ()
notificationCallback :: TNotificationMessage method -> 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 (method :: Method 'ServerToClient 'Notification) m
     . (MonadSession m)
    => SMethod method
    -> m ()
clearNotificationCallback :: forall (method :: Method 'ServerToClient 'Notification)
       (m :: * -> *).
MonadSession m =>
SMethod method -> m ()
clearNotificationCallback SMethod method
method =
    Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$
        (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 method -> NotificationMap -> NotificationMap
forall (m :: Method 'ServerToClient 'Notification).
SMethod m -> NotificationMap -> NotificationMap
removeNotificationCallback SMethod method
method
                    )

-- | Queues a message to be sent to the server at the client's earliest convenience.
sendMessage :: (MonadSession m) => FromClientMessage -> m ()
sendMessage :: forall (m :: * -> *). MonadSession m => FromClientMessage -> m ()
sendMessage FromClientMessage
msg = Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$ (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 :: ClientInfo
lspClientInfo :: ClientInfo
lspClientInfo = ClientInfo{$sel:_name:ClientInfo :: Text
_name = Text
"lsp-client", $sel:_version:ClientInfo :: Maybe Text
_version = 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 :: (MonadSession m) => Maybe Value -> m InitializeResult
initialize :: forall (m :: * -> *).
MonadSession m =>
Maybe Value -> m InitializeResult
initialize Maybe Value
options = Session InitializeResult -> m InitializeResult
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session InitializeResult -> m InitializeResult)
-> Session InitializeResult -> m InitializeResult
forall a b. (a -> b) -> a -> b
$ 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
-> ReaderT SessionState IO (TResponseMessage 'Method_Initialize)
forall (method :: Method 'ClientToServer 'Request) (m :: * -> *).
(TMessage method ~ TRequestMessage method, MonadSession m) =>
SMethod method
-> MessageParams method -> m (TResponseMessage method)
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 ClientInfo
_clientInfo = ClientInfo -> Maybe ClientInfo
forall a. a -> Maybe a
Just ClientInfo
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
options
                , $sel:_capabilities:InitializeParams :: ClientCapabilities
_capabilities = ClientCapabilities
fullLatestClientCaps
                , $sel:_trace:InitializeParams :: Maybe TraceValue
_trace = TraceValue -> Maybe TraceValue
forall a. a -> Maybe a
Just TraceValue
TraceValue_Off
                , $sel:_workspaceFolders:InitializeParams :: Maybe ([WorkspaceFolder] |? Null)
_workspaceFolders = Maybe ([WorkspaceFolder] |? Null)
forall a. Maybe a
Nothing
                }
    SMethod 'Method_Initialized
-> MessageParams 'Method_Initialized -> Session ()
forall (method :: Method 'ClientToServer 'Notification)
       (m :: * -> *).
(TMessage method ~ TNotificationMessage method, MonadSession m) =>
SMethod method -> MessageParams method -> m ()
sendNotification SMethod 'Method_Initialized
SMethod_Initialized MessageParams 'Method_Initialized
InitializedParams
InitializedParams
    pure $ TResponseMessage 'Method_Initialize
-> MessageResult 'Method_Initialize
forall {f :: MessageDirection} (m :: Method f 'Request).
Show (ErrorData m) =>
TResponseMessage m -> MessageResult m
getResponseResult TResponseMessage 'Method_Initialize
response

{- | /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
    :: (MonadSession m)
    => FilePath
    -- ^ The path to the document to open, __relative to the root directory__.
    -> LanguageKind
    -- ^ The text document's language
    -> Text
    -- ^ The content of the text document to create.
    -> m TextDocumentIdentifier
    -- ^ The identifier of the document just created.
createDoc :: forall (m :: * -> *).
MonadSession m =>
FilePath -> LanguageKind -> Text -> m TextDocumentIdentifier
createDoc FilePath
file LanguageKind
language Text
contents = Session TextDocumentIdentifier -> m TextDocumentIdentifier
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session TextDocumentIdentifier -> m TextDocumentIdentifier)
-> Session TextDocumentIdentifier -> m TextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ 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{$sel:_globPattern:FileSystemWatcher :: FileSystemWatcher -> GlobPattern
_globPattern = GlobPattern (InL (Pattern Text
pattern)), Maybe WatchKind
_kind :: Maybe WatchKind
$sel:_kind:FileSystemWatcher :: FileSystemWatcher -> 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)
LSP.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]
LSP.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)
LSP.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)
LSP.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)
LSP.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 (method :: Method 'ClientToServer 'Notification)
       (m :: * -> *).
(TMessage method ~ TNotificationMessage method, MonadSession m) =>
SMethod method -> MessageParams method -> m ()
sendNotification
            SMethod 'Method_WorkspaceDidChangeWatchedFiles
SMethod_WorkspaceDidChangeWatchedFiles
            DidChangeWatchedFilesParams
                { $sel:_changes:DidChangeWatchedFilesParams :: [FileEvent]
_changes =
                    [ FileEvent
                        { $sel:_type_:FileEvent :: FileChangeType
_type_ = FileChangeType
FileChangeType_Created
                        , $sel:_uri:FileEvent :: Uri
_uri = FilePath -> Uri
filePathToUri (FilePath -> Uri) -> FilePath -> Uri
forall a b. (a -> b) -> a -> b
$ FilePath
rootDir FilePath -> FilePath -> FilePath
</> FilePath
file
                        }
                    ]
                }
    FilePath -> LanguageKind -> Text -> Session TextDocumentIdentifier
forall (m :: * -> *).
MonadSession m =>
FilePath -> LanguageKind -> Text -> m TextDocumentIdentifier
openDoc' FilePath
file LanguageKind
language Text
contents

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

-- | Closes a text document and sends a @textDocument/didClose@ notification to the server.
closeDoc :: (MonadSession m) => TextDocumentIdentifier -> m ()
closeDoc :: forall (m :: * -> *).
MonadSession m =>
TextDocumentIdentifier -> m ()
closeDoc TextDocumentIdentifier
docId =
    Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$
        SMethod 'Method_TextDocumentDidClose
-> MessageParams 'Method_TextDocumentDidClose -> Session ()
forall (method :: Method 'ClientToServer 'Notification)
       (m :: * -> *).
(TMessage method ~ TNotificationMessage method, MonadSession m) =>
SMethod method -> MessageParams method -> m ()
sendNotification
            SMethod 'Method_TextDocumentDidClose
SMethod_TextDocumentDidClose
            DidCloseTextDocumentParams
                { $sel:_textDocument:DidCloseTextDocumentParams :: TextDocumentIdentifier
_textDocument =
                    TextDocumentIdentifier
                        { $sel:_uri:TextDocumentIdentifier :: Uri
_uri = 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
LSP.uri
                        }
                }

-- | Changes a text document and sends a @textDocument/didChange@ notification to the server.
changeDoc :: (MonadSession m) => TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> m ()
changeDoc :: forall (m :: * -> *).
MonadSession m =>
TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> m ()
changeDoc TextDocumentIdentifier
docId [TextDocumentContentChangeEvent]
_contentChanges = Session () -> m ()
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session () -> m ()) -> Session () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    VersionedTextDocumentIdentifier
_textDocument <- TextDocumentIdentifier
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
forall (m :: * -> *).
MonadSession m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier
docId ReaderT SessionState IO VersionedTextDocumentIdentifier
-> (VersionedTextDocumentIdentifier
    -> VersionedTextDocumentIdentifier)
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Int32 -> Identity Int32)
-> VersionedTextDocumentIdentifier
-> Identity VersionedTextDocumentIdentifier
forall s a. HasVersion s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Int32
LSP.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
    SMethod 'Method_TextDocumentDidChange
-> MessageParams 'Method_TextDocumentDidChange -> Session ()
forall (method :: Method 'ClientToServer 'Notification)
       (m :: * -> *).
(TMessage method ~ TNotificationMessage method, MonadSession m) =>
SMethod method -> MessageParams method -> m ()
sendNotification SMethod 'Method_TextDocumentDidChange
SMethod_TextDocumentDidChange DidChangeTextDocumentParams{[TextDocumentContentChangeEvent]
VersionedTextDocumentIdentifier
$sel:_contentChanges:DidChangeTextDocumentParams :: [TextDocumentContentChangeEvent]
$sel:_textDocument:DidChangeTextDocumentParams :: VersionedTextDocumentIdentifier
_contentChanges :: [TextDocumentContentChangeEvent]
_textDocument :: VersionedTextDocumentIdentifier
..}

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

-- | The current text contents of a document.
documentContents :: (MonadSession m) => TextDocumentIdentifier -> m (Maybe Rope)
documentContents :: forall (m :: * -> *).
MonadSession m =>
TextDocumentIdentifier -> m (Maybe Rope)
documentContents TextDocumentIdentifier{Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri :: Uri
_uri} = Session (Maybe Rope) -> m (Maybe Rope)
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (Session (Maybe Rope) -> m (Maybe Rope))
-> Session (Maybe Rope) -> m (Maybe Rope)
forall a b. (a -> b) -> a -> b
$ 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 :: (MonadSession m) => TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedDoc :: forall (m :: * -> *).
MonadSession m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedDoc TextDocumentIdentifier{Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri :: Uri
_uri} = ReaderT SessionState IO VersionedTextDocumentIdentifier
-> m VersionedTextDocumentIdentifier
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (ReaderT SessionState IO VersionedTextDocumentIdentifier
 -> m VersionedTextDocumentIdentifier)
-> ReaderT SessionState IO VersionedTextDocumentIdentifier
-> m VersionedTextDocumentIdentifier
forall a b. (a -> b) -> a -> b
$ 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 _version :: Int32
_version = 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{Int32
Uri
$sel:_uri:VersionedTextDocumentIdentifier :: Uri
$sel:_version:VersionedTextDocumentIdentifier :: Int32
_uri :: Uri
_version :: Int32
..}

-- | Get all the versioned documents tracked by the session.
getAllVersionedDocs :: (MonadSession m) => m [VersionedTextDocumentIdentifier]
getAllVersionedDocs :: forall (m :: * -> *).
MonadSession m =>
m [VersionedTextDocumentIdentifier]
getAllVersionedDocs = ReaderT SessionState IO [VersionedTextDocumentIdentifier]
-> m [VersionedTextDocumentIdentifier]
forall a. Session a -> m a
forall (m :: * -> *) a. MonadSession m => Session a -> m a
liftSession (ReaderT SessionState IO [VersionedTextDocumentIdentifier]
 -> m [VersionedTextDocumentIdentifier])
-> ReaderT SessionState IO [VersionedTextDocumentIdentifier]
-> m [VersionedTextDocumentIdentifier]
forall a b. (a -> b) -> a -> b
$ 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 $
        Map NormalizedUri VirtualFile -> [(NormalizedUri, VirtualFile)]
forall k a. Map k a -> [(k, a)]
Map.toList (VFS
vfs VFS
-> Getting
     (Map NormalizedUri VirtualFile) VFS (Map NormalizedUri VirtualFile)
-> Map NormalizedUri VirtualFile
forall s a. s -> Getting a s a -> a
^. Getting
  (Map NormalizedUri VirtualFile) VFS (Map NormalizedUri VirtualFile)
forall s a. HasVfsMap s a => Lens' s a
Lens' VFS (Map NormalizedUri VirtualFile)
vfsMap) [(NormalizedUri, VirtualFile)]
-> ((NormalizedUri, VirtualFile)
    -> VersionedTextDocumentIdentifier)
-> [VersionedTextDocumentIdentifier]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(NormalizedUri
nuri, VirtualFile
vf) ->
            VersionedTextDocumentIdentifier
                { $sel:_uri:VersionedTextDocumentIdentifier :: Uri
_uri = NormalizedUri -> Uri
fromNormalizedUri NormalizedUri
nuri
                , $sel:_version:VersionedTextDocumentIdentifier :: Int32
_version = VirtualFile -> Int32
virtualFileVersion VirtualFile
vf
                }