{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE DerivingVia          #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE BinaryLiterals       #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE TypeInType           #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RoleAnnotations #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -fprint-explicit-kinds #-}


module Language.LSP.Server.Core where

import           Colog.Core (LogAction (..), WithSeverity (..))
import           Control.Concurrent.Async
import           Control.Concurrent.STM
import qualified Control.Exception as E
import           Control.Monad
import           Control.Monad.Fix
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.Class
import           Control.Monad.IO.Unlift
import           Control.Lens ( (^.), (^?), _Just, at)
import qualified Data.Aeson as J
import           Data.Default
import           Data.Functor.Product
import           Data.IxMap
import qualified Data.HashMap.Strict as HM
import           Data.Kind
import qualified Data.List as L
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Map.Strict as Map
import           Data.Maybe
import           Data.Monoid (Ap(..))
import           Data.Ord (Down (Down))
import qualified Data.Text as T
import           Data.Text ( Text )
import qualified Data.UUID as UUID
import qualified Language.LSP.Types.Capabilities    as J
import Language.LSP.Types as J
import           Language.LSP.Types.SMethodMap (SMethodMap)
import qualified Language.LSP.Types.SMethodMap as SMethodMap
import qualified Language.LSP.Types.Lens as J
import           Language.LSP.VFS
import           Language.LSP.Diagnostics
import           System.Random hiding (next)
import           Control.Monad.Trans.Identity
import           Control.Monad.Catch (MonadMask, MonadCatch, MonadThrow)

-- ---------------------------------------------------------------------
{-# ANN module ("HLint: ignore Eta reduce"         :: String) #-}
{-# ANN module ("HLint: ignore Redundant do"       :: String) #-}
{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
-- ---------------------------------------------------------------------

newtype LspT config m a = LspT { forall config (m :: * -> *) a.
LspT config m a -> ReaderT (LanguageContextEnv config) m a
unLspT :: ReaderT (LanguageContextEnv config) m a }
  deriving (forall a b. a -> LspT config m b -> LspT config m a
forall a b. (a -> b) -> LspT config m a -> LspT config m b
forall config (m :: * -> *) a b.
Functor m =>
a -> LspT config m b -> LspT config m a
forall config (m :: * -> *) a b.
Functor m =>
(a -> b) -> LspT config m a -> LspT config m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> LspT config m b -> LspT config m a
$c<$ :: forall config (m :: * -> *) a b.
Functor m =>
a -> LspT config m b -> LspT config m a
fmap :: forall a b. (a -> b) -> LspT config m a -> LspT config m b
$cfmap :: forall config (m :: * -> *) a b.
Functor m =>
(a -> b) -> LspT config m a -> LspT config m b
Functor, forall a. a -> LspT config m a
forall a b. LspT config m a -> LspT config m b -> LspT config m a
forall a b. LspT config m a -> LspT config m b -> LspT config m b
forall a b.
LspT config m (a -> b) -> LspT config m a -> LspT config m b
forall a b c.
(a -> b -> c)
-> LspT config m a -> LspT config m b -> LspT config m c
forall {config} {m :: * -> *}.
Applicative m =>
Functor (LspT config m)
forall config (m :: * -> *) a.
Applicative m =>
a -> LspT config m a
forall config (m :: * -> *) a b.
Applicative m =>
LspT config m a -> LspT config m b -> LspT config m a
forall config (m :: * -> *) a b.
Applicative m =>
LspT config m a -> LspT config m b -> LspT config m b
forall config (m :: * -> *) a b.
Applicative m =>
LspT config m (a -> b) -> LspT config m a -> LspT config m b
forall config (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> LspT config m a -> LspT config m b -> LspT config m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. LspT config m a -> LspT config m b -> LspT config m a
$c<* :: forall config (m :: * -> *) a b.
Applicative m =>
LspT config m a -> LspT config m b -> LspT config m a
*> :: forall a b. LspT config m a -> LspT config m b -> LspT config m b
$c*> :: forall config (m :: * -> *) a b.
Applicative m =>
LspT config m a -> LspT config m b -> LspT config m b
liftA2 :: forall a b c.
(a -> b -> c)
-> LspT config m a -> LspT config m b -> LspT config m c
$cliftA2 :: forall config (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> LspT config m a -> LspT config m b -> LspT config m c
<*> :: forall a b.
LspT config m (a -> b) -> LspT config m a -> LspT config m b
$c<*> :: forall config (m :: * -> *) a b.
Applicative m =>
LspT config m (a -> b) -> LspT config m a -> LspT config m b
pure :: forall a. a -> LspT config m a
$cpure :: forall config (m :: * -> *) a.
Applicative m =>
a -> LspT config m a
Applicative, forall a. a -> LspT config m a
forall a b. LspT config m a -> LspT config m b -> LspT config m b
forall a b.
LspT config m a -> (a -> LspT config m b) -> LspT config m b
forall {config} {m :: * -> *}.
Monad m =>
Applicative (LspT config m)
forall config (m :: * -> *) a. Monad m => a -> LspT config m a
forall config (m :: * -> *) a b.
Monad m =>
LspT config m a -> LspT config m b -> LspT config m b
forall config (m :: * -> *) a b.
Monad m =>
LspT config m a -> (a -> LspT config m b) -> LspT config m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> LspT config m a
$creturn :: forall config (m :: * -> *) a. Monad m => a -> LspT config m a
>> :: forall a b. LspT config m a -> LspT config m b -> LspT config m b
$c>> :: forall config (m :: * -> *) a b.
Monad m =>
LspT config m a -> LspT config m b -> LspT config m b
>>= :: forall a b.
LspT config m a -> (a -> LspT config m b) -> LspT config m b
$c>>= :: forall config (m :: * -> *) a b.
Monad m =>
LspT config m a -> (a -> LspT config m b) -> LspT config m b
Monad, forall e a.
Exception e =>
LspT config m a -> (e -> LspT config m a) -> LspT config m a
forall {config} {m :: * -> *}.
MonadCatch m =>
MonadThrow (LspT config m)
forall config (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
LspT config m a -> (e -> LspT config m a) -> LspT config m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
LspT config m a -> (e -> LspT config m a) -> LspT config m a
$ccatch :: forall config (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
LspT config m a -> (e -> LspT config m a) -> LspT config m a
MonadCatch, forall a. IO a -> LspT config m a
forall {config} {m :: * -> *}. MonadIO m => Monad (LspT config m)
forall config (m :: * -> *) a. MonadIO m => IO a -> LspT config m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> LspT config m a
$cliftIO :: forall config (m :: * -> *) a. MonadIO m => IO a -> LspT config m a
MonadIO, forall b.
((forall a. LspT config m a -> LspT config m a) -> LspT config m b)
-> LspT config m b
forall a b c.
LspT config m a
-> (a -> ExitCase b -> LspT config m c)
-> (a -> LspT config m b)
-> LspT config m (b, c)
forall {config} {m :: * -> *}.
MonadMask m =>
MonadCatch (LspT config m)
forall config (m :: * -> *) b.
MonadMask m =>
((forall a. LspT config m a -> LspT config m a) -> LspT config m b)
-> LspT config m b
forall config (m :: * -> *) a b c.
MonadMask m =>
LspT config m a
-> (a -> ExitCase b -> LspT config m c)
-> (a -> LspT config m b)
-> LspT config m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
LspT config m a
-> (a -> ExitCase b -> LspT config m c)
-> (a -> LspT config m b)
-> LspT config m (b, c)
$cgeneralBracket :: forall config (m :: * -> *) a b c.
MonadMask m =>
LspT config m a
-> (a -> ExitCase b -> LspT config m c)
-> (a -> LspT config m b)
-> LspT config m (b, c)
uninterruptibleMask :: forall b.
((forall a. LspT config m a -> LspT config m a) -> LspT config m b)
-> LspT config m b
$cuninterruptibleMask :: forall config (m :: * -> *) b.
MonadMask m =>
((forall a. LspT config m a -> LspT config m a) -> LspT config m b)
-> LspT config m b
mask :: forall b.
((forall a. LspT config m a -> LspT config m a) -> LspT config m b)
-> LspT config m b
$cmask :: forall config (m :: * -> *) b.
MonadMask m =>
((forall a. LspT config m a -> LspT config m a) -> LspT config m b)
-> LspT config m b
MonadMask, forall e a. Exception e => e -> LspT config m a
forall {config} {m :: * -> *}.
MonadThrow m =>
Monad (LspT config m)
forall config (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LspT config m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> LspT config m a
$cthrowM :: forall config (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> LspT config m a
MonadThrow, forall config (m :: * -> *) a. Monad m => m a -> LspT config m a
forall (m :: * -> *) a. Monad m => m a -> LspT config m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> LspT config m a
$clift :: forall config (m :: * -> *) a. Monad m => m a -> LspT config m a
MonadTrans, forall b.
((forall a. LspT config m a -> IO a) -> IO b) -> LspT config m b
forall {config} {m :: * -> *}.
MonadUnliftIO m =>
MonadIO (LspT config m)
forall config (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. LspT config m a -> IO a) -> IO b) -> LspT config m b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b.
((forall a. LspT config m a -> IO a) -> IO b) -> LspT config m b
$cwithRunInIO :: forall config (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. LspT config m a -> IO a) -> IO b) -> LspT config m b
MonadUnliftIO, forall a. (a -> LspT config m a) -> LspT config m a
forall {config} {m :: * -> *}. MonadFix m => Monad (LspT config m)
forall config (m :: * -> *) a.
MonadFix m =>
(a -> LspT config m a) -> LspT config m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> LspT config m a) -> LspT config m a
$cmfix :: forall config (m :: * -> *) a.
MonadFix m =>
(a -> LspT config m a) -> LspT config m a
MonadFix)
  deriving (NonEmpty (LspT config m a) -> LspT config m a
LspT config m a -> LspT config m a -> LspT config m a
forall b. Integral b => b -> LspT config m a -> LspT config m a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall config (m :: * -> *) a.
(Applicative m, Semigroup a) =>
NonEmpty (LspT config m a) -> LspT config m a
forall config (m :: * -> *) a.
(Applicative m, Semigroup a) =>
LspT config m a -> LspT config m a -> LspT config m a
forall config (m :: * -> *) a b.
(Applicative m, Semigroup a, Integral b) =>
b -> LspT config m a -> LspT config m a
stimes :: forall b. Integral b => b -> LspT config m a -> LspT config m a
$cstimes :: forall config (m :: * -> *) a b.
(Applicative m, Semigroup a, Integral b) =>
b -> LspT config m a -> LspT config m a
sconcat :: NonEmpty (LspT config m a) -> LspT config m a
$csconcat :: forall config (m :: * -> *) a.
(Applicative m, Semigroup a) =>
NonEmpty (LspT config m a) -> LspT config m a
<> :: LspT config m a -> LspT config m a -> LspT config m a
$c<> :: forall config (m :: * -> *) a.
(Applicative m, Semigroup a) =>
LspT config m a -> LspT config m a -> LspT config m a
Semigroup, LspT config m a
[LspT config m a] -> LspT config m a
LspT config m a -> LspT config m a -> LspT config m a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {config} {m :: * -> *} {a}.
(Applicative m, Monoid a) =>
Semigroup (LspT config m a)
forall config (m :: * -> *) a.
(Applicative m, Monoid a) =>
LspT config m a
forall config (m :: * -> *) a.
(Applicative m, Monoid a) =>
[LspT config m a] -> LspT config m a
forall config (m :: * -> *) a.
(Applicative m, Monoid a) =>
LspT config m a -> LspT config m a -> LspT config m a
mconcat :: [LspT config m a] -> LspT config m a
$cmconcat :: forall config (m :: * -> *) a.
(Applicative m, Monoid a) =>
[LspT config m a] -> LspT config m a
mappend :: LspT config m a -> LspT config m a -> LspT config m a
$cmappend :: forall config (m :: * -> *) a.
(Applicative m, Monoid a) =>
LspT config m a -> LspT config m a -> LspT config m a
mempty :: LspT config m a
$cmempty :: forall config (m :: * -> *) a.
(Applicative m, Monoid a) =>
LspT config m a
Monoid) via (Ap (LspT config m) a)

-- for deriving the instance of MonadUnliftIO
type role LspT representational representational nominal

runLspT :: LanguageContextEnv config -> LspT config m a -> m a
runLspT :: forall config (m :: * -> *) a.
LanguageContextEnv config -> LspT config m a -> m a
runLspT LanguageContextEnv config
env = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT LanguageContextEnv config
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall config (m :: * -> *) a.
LspT config m a -> ReaderT (LanguageContextEnv config) m a
unLspT

{-# INLINE runLspT #-}

type LspM config = LspT config IO

class MonadUnliftIO m => MonadLsp config m | m -> config where
  getLspEnv :: m (LanguageContextEnv config)

instance MonadUnliftIO m => MonadLsp config (LspT config m) where
  {-# SPECIALIZE instance MonadLsp config (LspT config IO) #-}
  {-# INLINE getLspEnv #-}
  getLspEnv :: LspT config m (LanguageContextEnv config)
getLspEnv = forall config (m :: * -> *) a.
ReaderT (LanguageContextEnv config) m a -> LspT config m a
LspT forall (m :: * -> *) r. Monad m => ReaderT r m r
ask

instance MonadLsp c m => MonadLsp c (ReaderT r m) where
  {-# SPECIALIZE instance MonadLsp config (ReaderT r (LspT config IO)) #-}
  {-# INLINE getLspEnv #-}
  getLspEnv :: ReaderT r m (LanguageContextEnv c)
getLspEnv = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv

instance MonadLsp c m => MonadLsp c (IdentityT m) where
  getLspEnv :: IdentityT @(*) m (LanguageContextEnv c)
getLspEnv = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv

data LanguageContextEnv config =
  LanguageContextEnv
  { forall config. LanguageContextEnv config -> Handlers IO
resHandlers            :: !(Handlers IO)
  , forall config.
LanguageContextEnv config -> config -> Value -> Either Text config
resParseConfig         :: !(config -> J.Value -> Either T.Text config)
  , forall config.
LanguageContextEnv config -> FromServerMessage -> IO ()
resSendMessage         :: !(FromServerMessage -> IO ())
  -- We keep the state in a TVar to be thread safe
  , forall config.
LanguageContextEnv config -> LanguageContextState config
resState               :: !(LanguageContextState config)
  , forall config. LanguageContextEnv config -> ClientCapabilities
resClientCapabilities  :: !J.ClientCapabilities
  , forall config. LanguageContextEnv config -> Maybe FilePath
resRootPath            :: !(Maybe FilePath)
  }

-- ---------------------------------------------------------------------
-- Handlers
-- ---------------------------------------------------------------------

-- | A mapping from methods to the static 'Handler's that should be used to
-- handle responses when they come in from the client. To build up a 'Handlers',
-- you should 'mconcat' a list of 'notificationHandler' and 'requestHandler's:
--
-- @
-- mconcat [
--   notificationHandler SInitialized $ \notif -> pure ()
-- , requestHandler STextDocumentHover $ \req responder -> pure ()
-- ]
-- @
data Handlers m
  = Handlers
  { forall (m :: * -> *).
Handlers m
-> SMethodMap
     @'FromClient @'Request (ClientMessageHandler m 'Request)
reqHandlers :: !(SMethodMap (ClientMessageHandler m Request))
  , forall (m :: * -> *).
Handlers m
-> SMethodMap
     @'FromClient @'Notification (ClientMessageHandler m 'Notification)
notHandlers :: !(SMethodMap (ClientMessageHandler m Notification))
  }
instance Semigroup (Handlers config) where
  Handlers SMethodMap
  @'FromClient @'Request (ClientMessageHandler config 'Request)
r1 SMethodMap
  @'FromClient
  @'Notification
  (ClientMessageHandler config 'Notification)
n1 <> :: Handlers config -> Handlers config -> Handlers config
<> Handlers SMethodMap
  @'FromClient @'Request (ClientMessageHandler config 'Request)
r2 SMethodMap
  @'FromClient
  @'Notification
  (ClientMessageHandler config 'Notification)
n2 = forall (m :: * -> *).
SMethodMap @'FromClient @'Request (ClientMessageHandler m 'Request)
-> SMethodMap
     @'FromClient @'Notification (ClientMessageHandler m 'Notification)
-> Handlers m
Handlers (SMethodMap
  @'FromClient @'Request (ClientMessageHandler config 'Request)
r1 forall a. Semigroup a => a -> a -> a
<> SMethodMap
  @'FromClient @'Request (ClientMessageHandler config 'Request)
r2) (SMethodMap
  @'FromClient
  @'Notification
  (ClientMessageHandler config 'Notification)
n1 forall a. Semigroup a => a -> a -> a
<> SMethodMap
  @'FromClient
  @'Notification
  (ClientMessageHandler config 'Notification)
n2)
instance Monoid (Handlers config) where
  mempty :: Handlers config
mempty = forall (m :: * -> *).
SMethodMap @'FromClient @'Request (ClientMessageHandler m 'Request)
-> SMethodMap
     @'FromClient @'Notification (ClientMessageHandler m 'Notification)
-> Handlers m
Handlers forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

notificationHandler :: forall (m :: Method FromClient Notification) f. SMethod m -> Handler f m -> Handlers f
notificationHandler :: forall (m :: Method 'FromClient 'Notification) (f :: * -> *).
SMethod @'FromClient @'Notification m
-> Handler @'FromClient @'Notification f m -> Handlers f
notificationHandler SMethod @'FromClient @'Notification m
m Handler @'FromClient @'Notification f m
h = forall (m :: * -> *).
SMethodMap @'FromClient @'Request (ClientMessageHandler m 'Request)
-> SMethodMap
     @'FromClient @'Notification (ClientMessageHandler m 'Notification)
-> Handlers m
Handlers forall a. Monoid a => a
mempty (forall {f :: From} {t :: MethodType} (a :: Method f t)
       (v :: Method f t -> *).
SMethod @f @t a -> v a -> SMethodMap @f @t v
SMethodMap.singleton SMethod @'FromClient @'Notification m
m (forall (f :: * -> *) (t :: MethodType) (m :: Method 'FromClient t).
Handler @'FromClient @t f m -> ClientMessageHandler f t m
ClientMessageHandler Handler @'FromClient @'Notification f m
h))

requestHandler :: forall (m :: Method FromClient Request) f. SMethod m -> Handler f m -> Handlers f
requestHandler :: forall (m :: Method 'FromClient 'Request) (f :: * -> *).
SMethod @'FromClient @'Request m
-> Handler @'FromClient @'Request f m -> Handlers f
requestHandler SMethod @'FromClient @'Request m
m Handler @'FromClient @'Request f m
h = forall (m :: * -> *).
SMethodMap @'FromClient @'Request (ClientMessageHandler m 'Request)
-> SMethodMap
     @'FromClient @'Notification (ClientMessageHandler m 'Notification)
-> Handlers m
Handlers (forall {f :: From} {t :: MethodType} (a :: Method f t)
       (v :: Method f t -> *).
SMethod @f @t a -> v a -> SMethodMap @f @t v
SMethodMap.singleton SMethod @'FromClient @'Request m
m (forall (f :: * -> *) (t :: MethodType) (m :: Method 'FromClient t).
Handler @'FromClient @t f m -> ClientMessageHandler f t m
ClientMessageHandler Handler @'FromClient @'Request f m
h)) forall a. Monoid a => a
mempty

-- | Wrapper to restrict 'Handler's to 'FromClient' 'Method's
newtype ClientMessageHandler f (t :: MethodType) (m :: Method FromClient t) = ClientMessageHandler (Handler f m)

-- | The type of a handler that handles requests and notifications coming in
-- from the server or client
type family Handler (f :: Type -> Type) (m :: Method from t) = (result :: Type) | result -> f t m where
  Handler f (m :: Method _from Request)      = RequestMessage m -> (Either ResponseError (ResponseResult m) -> f ()) -> f ()
  Handler f (m :: Method _from Notification) = NotificationMessage m -> f ()

-- | How to convert two isomorphic data structures between each other.
data m <~> n
  = Iso
  { forall {k} (m :: k -> *) (n :: k -> *).
(<~>) @k m n -> forall (a :: k). m a -> n a
forward :: forall a. m a -> n a
  , forall {k} (m :: k -> *) (n :: k -> *).
(<~>) @k m n -> forall (a :: k). n a -> m a
backward :: forall a. n a -> m a
  }

transmuteHandlers :: (m <~> n) -> Handlers m -> Handlers n
transmuteHandlers :: forall (m :: * -> *) (n :: * -> *).
(<~>) @(*) m n -> Handlers m -> Handlers n
transmuteHandlers (<~>) @(*) m n
nat = forall (m :: * -> *) (n :: * -> *).
(forall (a :: Method 'FromClient 'Request).
 Handler @'FromClient @'Request m a
 -> Handler @'FromClient @'Request n a)
-> (forall (a :: Method 'FromClient 'Notification).
    Handler @'FromClient @'Notification m a
    -> Handler @'FromClient @'Notification n a)
-> Handlers m
-> Handlers n
mapHandlers (\Handler @'FromClient @'Request m a
i RequestMessage @'FromClient a
m Either ResponseError (ResponseResult @'FromClient a) -> n ()
k -> forall {k} (m :: k -> *) (n :: k -> *).
(<~>) @k m n -> forall (a :: k). m a -> n a
forward (<~>) @(*) m n
nat (Handler @'FromClient @'Request m a
i RequestMessage @'FromClient a
m (forall {k} (m :: k -> *) (n :: k -> *).
(<~>) @k m n -> forall (a :: k). n a -> m a
backward (<~>) @(*) m n
nat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ResponseError (ResponseResult @'FromClient a) -> n ()
k))) (\Handler @'FromClient @'Notification m a
i NotificationMessage @'FromClient a
m -> forall {k} (m :: k -> *) (n :: k -> *).
(<~>) @k m n -> forall (a :: k). m a -> n a
forward (<~>) @(*) m n
nat (Handler @'FromClient @'Notification m a
i NotificationMessage @'FromClient a
m))

mapHandlers
  :: (forall (a :: Method FromClient Request). Handler m a -> Handler n a)
  -> (forall (a :: Method FromClient Notification). Handler m a -> Handler n a)
  -> Handlers m -> Handlers n
mapHandlers :: forall (m :: * -> *) (n :: * -> *).
(forall (a :: Method 'FromClient 'Request).
 Handler @'FromClient @'Request m a
 -> Handler @'FromClient @'Request n a)
-> (forall (a :: Method 'FromClient 'Notification).
    Handler @'FromClient @'Notification m a
    -> Handler @'FromClient @'Notification n a)
-> Handlers m
-> Handlers n
mapHandlers forall (a :: Method 'FromClient 'Request).
Handler @'FromClient @'Request m a
-> Handler @'FromClient @'Request n a
mapReq forall (a :: Method 'FromClient 'Notification).
Handler @'FromClient @'Notification m a
-> Handler @'FromClient @'Notification n a
mapNot (Handlers SMethodMap @'FromClient @'Request (ClientMessageHandler m 'Request)
reqs SMethodMap
  @'FromClient @'Notification (ClientMessageHandler m 'Notification)
nots) = forall (m :: * -> *).
SMethodMap @'FromClient @'Request (ClientMessageHandler m 'Request)
-> SMethodMap
     @'FromClient @'Notification (ClientMessageHandler m 'Notification)
-> Handlers m
Handlers SMethodMap @'FromClient @'Request (ClientMessageHandler n 'Request)
reqs' SMethodMap
  @'FromClient @'Notification (ClientMessageHandler n 'Notification)
nots'
  where
    reqs' :: SMethodMap @'FromClient @'Request (ClientMessageHandler n 'Request)
reqs' = forall {f :: From} {t :: MethodType} (u :: Method f t -> *)
       (v :: Method f t -> *).
(forall (a :: Method f t). u a -> v a)
-> SMethodMap @f @t u -> SMethodMap @f @t v
SMethodMap.map (\(ClientMessageHandler Handler @'FromClient @'Request m a
i) -> forall (f :: * -> *) (t :: MethodType) (m :: Method 'FromClient t).
Handler @'FromClient @t f m -> ClientMessageHandler f t m
ClientMessageHandler forall a b. (a -> b) -> a -> b
$ forall (a :: Method 'FromClient 'Request).
Handler @'FromClient @'Request m a
-> Handler @'FromClient @'Request n a
mapReq Handler @'FromClient @'Request m a
i) SMethodMap @'FromClient @'Request (ClientMessageHandler m 'Request)
reqs
    nots' :: SMethodMap
  @'FromClient @'Notification (ClientMessageHandler n 'Notification)
nots' = forall {f :: From} {t :: MethodType} (u :: Method f t -> *)
       (v :: Method f t -> *).
(forall (a :: Method f t). u a -> v a)
-> SMethodMap @f @t u -> SMethodMap @f @t v
SMethodMap.map (\(ClientMessageHandler Handler @'FromClient @'Notification m a
i) -> forall (f :: * -> *) (t :: MethodType) (m :: Method 'FromClient t).
Handler @'FromClient @t f m -> ClientMessageHandler f t m
ClientMessageHandler forall a b. (a -> b) -> a -> b
$ forall (a :: Method 'FromClient 'Notification).
Handler @'FromClient @'Notification m a
-> Handler @'FromClient @'Notification n a
mapNot Handler @'FromClient @'Notification m a
i) SMethodMap
  @'FromClient @'Notification (ClientMessageHandler m 'Notification)
nots

-- | state used by the LSP dispatcher to manage the message loop
data LanguageContextState config =
  LanguageContextState
  { forall config. LanguageContextState config -> TVar VFSData
resVFS                 :: !(TVar VFSData)
  , forall config. LanguageContextState config -> TVar DiagnosticStore
resDiagnostics         :: !(TVar DiagnosticStore)
  , forall config. LanguageContextState config -> TVar config
resConfig              :: !(TVar config)
  , forall config.
LanguageContextState config -> TVar [WorkspaceFolder]
resWorkspaceFolders    :: !(TVar [WorkspaceFolder])
  , forall config. LanguageContextState config -> ProgressData
resProgressData        :: !ProgressData
  , forall config. LanguageContextState config -> TVar ResponseMap
resPendingResponses    :: !(TVar ResponseMap)
  , forall config.
LanguageContextState config -> TVar (RegistrationMap 'Notification)
resRegistrationsNot    :: !(TVar (RegistrationMap Notification))
  , forall config.
LanguageContextState config -> TVar (RegistrationMap 'Request)
resRegistrationsReq    :: !(TVar (RegistrationMap Request))
  , forall config. LanguageContextState config -> TVar Int32
resLspId               :: !(TVar Int32)
  }

type ResponseMap = IxMap LspId (Product SMethod ServerResponseCallback)

type RegistrationMap (t :: MethodType) = SMethodMap (Product RegistrationId (ClientMessageHandler IO t))

data RegistrationToken (m :: Method FromClient t) = RegistrationToken (SMethod m) (RegistrationId m)
newtype RegistrationId (m :: Method FromClient t) = RegistrationId Text
  deriving RegistrationId @t m -> RegistrationId @t m -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: MethodType) (m :: Method 'FromClient t).
RegistrationId @t m -> RegistrationId @t m -> Bool
/= :: RegistrationId @t m -> RegistrationId @t m -> Bool
$c/= :: forall (t :: MethodType) (m :: Method 'FromClient t).
RegistrationId @t m -> RegistrationId @t m -> Bool
== :: RegistrationId @t m -> RegistrationId @t m -> Bool
$c== :: forall (t :: MethodType) (m :: Method 'FromClient t).
RegistrationId @t m -> RegistrationId @t m -> Bool
Eq

data ProgressData = ProgressData { ProgressData -> TVar Int32
progressNextId :: !(TVar Int32)
                                 , ProgressData -> TVar (Map ProgressToken (IO ()))
progressCancel :: !(TVar (Map.Map ProgressToken (IO ()))) }

data VFSData =
  VFSData
    { VFSData -> VFS
vfsData :: !VFS
    , VFSData -> Map FilePath FilePath
reverseMap :: !(Map.Map FilePath FilePath)
    }

{-# INLINE modifyState #-}
modifyState :: MonadLsp config m => (LanguageContextState config -> TVar a) -> (a -> a) -> m ()
modifyState :: forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> (a -> a) -> m ()
modifyState LanguageContextState config -> TVar a
sel a -> a
f = do
  TVar a
tvarDat <- LanguageContextState config -> TVar a
sel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall config.
LanguageContextEnv config -> LanguageContextState config
resState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar a
tvarDat a -> a
f

{-# INLINE stateState #-}
stateState :: MonadLsp config m => (LanguageContextState config -> TVar s) -> (s -> (a,s)) -> m a
stateState :: forall config (m :: * -> *) s a.
MonadLsp config m =>
(LanguageContextState config -> TVar s) -> (s -> (a, s)) -> m a
stateState LanguageContextState config -> TVar s
sel s -> (a, s)
f = do
  TVar s
tvarDat <- LanguageContextState config -> TVar s
sel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall config.
LanguageContextEnv config -> LanguageContextState config
resState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall s a. TVar s -> (s -> (a, s)) -> STM a
stateTVar TVar s
tvarDat s -> (a, s)
f

{-# INLINE getsState #-}
getsState :: MonadLsp config m => (LanguageContextState config -> TVar a) -> m a
getsState :: forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> m a
getsState LanguageContextState config -> TVar a
f = do
  TVar a
tvarDat <- LanguageContextState config -> TVar a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall config.
LanguageContextEnv config -> LanguageContextState config
resState forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> IO a
readTVarIO TVar a
tvarDat

-- ---------------------------------------------------------------------

-- | Language Server Protocol options that the server may configure.
-- If you set handlers for some requests, you may need to set some of these options.
data Options =
  Options
    { Options -> Maybe TextDocumentSyncOptions
textDocumentSync                 :: Maybe J.TextDocumentSyncOptions
    -- |  The characters that trigger completion automatically.
    , Options -> Maybe FilePath
completionTriggerCharacters      :: Maybe [Char]
    -- | The list of all possible characters that commit a completion. This field can be used
    -- if clients don't support individual commit characters per completion item. See
    -- `_commitCharactersSupport`.
    , Options -> Maybe FilePath
completionAllCommitCharacters    :: Maybe [Char]
    -- | The characters that trigger signature help automatically.
    , Options -> Maybe FilePath
signatureHelpTriggerCharacters   :: Maybe [Char]
    -- | List of characters that re-trigger signature help.
    -- These trigger characters are only active when signature help is already showing. All trigger characters
    -- are also counted as re-trigger characters.
    , Options -> Maybe FilePath
signatureHelpRetriggerCharacters :: Maybe [Char]
    -- | CodeActionKinds that this server may return.
    -- The list of kinds may be generic, such as `CodeActionKind.Refactor`, or the server
    -- may list out every specific kind they provide.
    , Options -> Maybe [CodeActionKind]
codeActionKinds                  :: Maybe [CodeActionKind]
    -- | The list of characters that triggers on type formatting.
    -- If you set `documentOnTypeFormattingHandler`, you **must** set this.
    -- The first character is mandatory, so a 'NonEmpty' should be passed.
    , Options -> Maybe (NonEmpty Char)
documentOnTypeFormattingTriggerCharacters :: Maybe (NonEmpty Char)
    -- | The commands to be executed on the server.
    -- If you set `executeCommandHandler`, you **must** set this.
    , Options -> Maybe [Text]
executeCommandCommands           :: Maybe [Text]
    -- | Information about the server that can be advertised to the client.
    , Options -> Maybe ServerInfo
serverInfo                       :: Maybe J.ServerInfo
    }

instance Default Options where
  def :: Options
def = Maybe TextDocumentSyncOptions
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe FilePath
-> Maybe [CodeActionKind]
-> Maybe (NonEmpty Char)
-> Maybe [Text]
-> Maybe ServerInfo
-> Options
Options forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

defaultOptions :: Options
defaultOptions :: Options
defaultOptions = forall a. Default a => a
def

-- | A package indicating the percentage of progress complete and a
-- an optional message to go with it during a 'withProgress'
--
-- @since 0.10.0.0
data ProgressAmount = ProgressAmount (Maybe UInt) (Maybe Text)

-- | Thrown if the user cancels a 'Cancellable' 'withProgress'/'withIndefiniteProgress'/ session
--
-- @since 0.11.0.0
data ProgressCancelledException = ProgressCancelledException
  deriving Int -> ProgressCancelledException -> ShowS
[ProgressCancelledException] -> ShowS
ProgressCancelledException -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ProgressCancelledException] -> ShowS
$cshowList :: [ProgressCancelledException] -> ShowS
show :: ProgressCancelledException -> FilePath
$cshow :: ProgressCancelledException -> FilePath
showsPrec :: Int -> ProgressCancelledException -> ShowS
$cshowsPrec :: Int -> ProgressCancelledException -> ShowS
Show
instance E.Exception ProgressCancelledException

-- | Whether or not the user should be able to cancel a 'withProgress'/'withIndefiniteProgress'
-- session
--
-- @since 0.11.0.0
data ProgressCancellable = Cancellable | NotCancellable

-- | Contains all the callbacks to use for initialized the language server.
-- it is parameterized over a config type variable representing the type for the
-- specific configuration data the language server needs to use.
data ServerDefinition config = forall m a.
  ServerDefinition
    { forall config. ServerDefinition config -> config
defaultConfig :: config
      -- ^ The default value we initialize the config variable to.
    , forall config.
ServerDefinition config -> config -> Value -> Either Text config
onConfigurationChange :: config -> J.Value -> Either T.Text config
      -- ^ @onConfigurationChange oldConfig newConfig@ is called whenever the
      -- clients sends a message with a changed client configuration. This
      -- callback should return either the parsed configuration data or an error
      -- indicating what went wrong. The parsed configuration object will be
      -- stored internally and can be accessed via 'config'.
      -- It is also called on the `initializationOptions` field of the InitializeParams
    , ()
doInitialize :: LanguageContextEnv config -> Message Initialize -> IO (Either ResponseError a)
      -- ^ Called *after* receiving the @initialize@ request and *before*
      -- returning the response. This callback will be invoked to offer the
      -- language server implementation the chance to create any processes or
      -- start new threads that may be necessary for the server lifecycle. It can
      -- also return an error in the initialization if necessary.
    , ()
staticHandlers :: Handlers m
      -- ^ Handlers for any methods you want to statically support.
      -- The handlers here cannot be unregistered during the server's lifetime
      -- and will be registered statically in the initialize request.
    , ()
interpretHandler :: a -> (m <~> IO)
      -- ^ How to run the handlers in your own monad of choice, @m@.
      -- It is passed the result of 'doInitialize', so typically you will want
      -- to thread along the 'LanguageContextEnv' as well as any other state you
      -- need to run your monad. @m@ should most likely be built on top of
      -- 'LspT'.
      --
      -- @
      --  ServerDefinition { ...
      --  , doInitialize = \env _req -> pure $ Right env
      --  , interpretHandler = \env -> Iso
      --     (runLspT env) -- how to convert from IO ~> m
      --     liftIO        -- how to convert from m ~> IO
      --  }
      -- @
    , forall config. ServerDefinition config -> Options
options :: Options
      -- ^ Configurable options for the server's capabilities.
    }

-- | A function that a 'Handler' is passed that can be used to respond to a
-- request with either an error, or the response params.
newtype ServerResponseCallback (m :: Method FromServer Request)
  = ServerResponseCallback (Either ResponseError (ResponseResult m) -> IO ())

-- | Return value signals if response handler was inserted successfully
-- Might fail if the id was already in the map
addResponseHandler :: MonadLsp config f => LspId m -> (Product SMethod ServerResponseCallback) m -> f Bool
addResponseHandler :: forall config (f :: * -> *) (m :: Method 'FromServer 'Request).
MonadLsp config f =>
LspId @'FromServer m
-> Product
     @(Method 'FromServer 'Request)
     (SMethod @'FromServer @'Request)
     ServerResponseCallback
     m
-> f Bool
addResponseHandler LspId @'FromServer m
lid Product
  @(Method 'FromServer 'Request)
  (SMethod @'FromServer @'Request)
  ServerResponseCallback
  m
h = do
  forall config (m :: * -> *) s a.
MonadLsp config m =>
(LanguageContextState config -> TVar s) -> (s -> (a, s)) -> m a
stateState forall config. LanguageContextState config -> TVar ResponseMap
resPendingResponses forall a b. (a -> b) -> a -> b
$ \ResponseMap
pending ->
    case forall {a} (k :: a -> *) (m :: a) (f :: a -> *).
IxOrd @a k =>
k m -> f m -> IxMap @a k f -> Maybe (IxMap @a k f)
insertIxMap LspId @'FromServer m
lid Product
  @(Method 'FromServer 'Request)
  (SMethod @'FromServer @'Request)
  ServerResponseCallback
  m
h ResponseMap
pending of
      Just !ResponseMap
m -> (Bool
True, ResponseMap
m)
      Maybe ResponseMap
Nothing -> (Bool
False, ResponseMap
pending)

sendNotification
  :: forall (m :: Method FromServer Notification) f config. MonadLsp config f
  => SServerMethod m
  -> MessageParams m
  -> f ()
sendNotification :: forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod @'Notification m
-> MessageParams @'FromServer @'Notification m -> f ()
sendNotification SServerMethod @'Notification m
m MessageParams @'FromServer @'Notification m
params =
  let msg :: NotificationMessage @'FromServer m
msg = forall (f :: From) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> NotificationMessage @f m
NotificationMessage Text
"2.0" SServerMethod @'Notification m
m MessageParams @'FromServer @'Notification m
params
  in case forall {t :: MethodType} (m :: Method 'FromServer t).
SServerMethod @t m -> ServerNotOrReq @t m
splitServerMethod SServerMethod @'Notification m
m of
        ServerNotOrReq @'Notification m
IsServerNot -> forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification).
((Message @'FromServer @'Notification m :: *)
 ~ (NotificationMessage @'FromServer m :: *)) =>
NotificationMessage @'FromServer m -> FromServerMessage
fromServerNot NotificationMessage @'FromServer m
msg
        ServerNotOrReq @'Notification m
IsServerEither -> forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient forall a b. (a -> b) -> a -> b
$ forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod @'FromServer @t m
-> Message @'FromServer @t m -> FromServerMessage' a
FromServerMess SServerMethod @'Notification m
m forall a b. (a -> b) -> a -> b
$ forall (f :: From).
NotificationMessage @f ('CustomMethod @f @'Notification)
-> CustomMessage f 'Notification
NotMess NotificationMessage @'FromServer m
msg

sendRequest :: forall (m :: Method FromServer Request) f config. MonadLsp config f
            => SServerMethod m
            -> MessageParams m
            -> (Either ResponseError (ResponseResult m) -> f ())
            -> f (LspId m)
sendRequest :: forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod @'Request m
-> MessageParams @'FromServer @'Request m
-> (Either ResponseError (ResponseResult @'FromServer m) -> f ())
-> f (LspId @'FromServer m)
sendRequest SServerMethod @'Request m
m MessageParams @'FromServer @'Request m
params Either ResponseError (ResponseResult @'FromServer m) -> f ()
resHandler = do
  LspId @'FromServer m
reqId <- forall (f :: From) (m :: Method f 'Request). Int32 -> LspId @f m
IdInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *). MonadLsp config m => m Int32
freshLspId
  f () -> IO ()
rio <- forall (m :: * -> *) a. MonadUnliftIO m => m (m a -> IO a)
askRunInIO
  Bool
success <- forall config (f :: * -> *) (m :: Method 'FromServer 'Request).
MonadLsp config f =>
LspId @'FromServer m
-> Product
     @(Method 'FromServer 'Request)
     (SMethod @'FromServer @'Request)
     ServerResponseCallback
     m
-> f Bool
addResponseHandler LspId @'FromServer m
reqId (forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product @k f g a
Pair SServerMethod @'Request m
m (forall (m :: Method 'FromServer 'Request).
(Either ResponseError (ResponseResult @'FromServer m) -> IO ())
-> ServerResponseCallback m
ServerResponseCallback (f () -> IO ()
rio forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ResponseError (ResponseResult @'FromServer m) -> f ()
resHandler)))
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => FilePath -> a
error FilePath
"LSP: could not send FromServer request as id is reused"

  let msg :: RequestMessage @'FromServer m
msg = forall (f :: From) (m :: Method f 'Request).
Text
-> LspId @f m
-> SMethod @f @'Request m
-> MessageParams @f @'Request m
-> RequestMessage @f m
RequestMessage Text
"2.0" LspId @'FromServer m
reqId SServerMethod @'Request m
m MessageParams @'FromServer @'Request m
params
  ~() <- case forall {t :: MethodType} (m :: Method 'FromServer t).
SServerMethod @t m -> ServerNotOrReq @t m
splitServerMethod SServerMethod @'Request m
m of
    ServerNotOrReq @'Request m
IsServerReq -> forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Request).
((Message @'FromServer @'Request m :: *)
 ~ (RequestMessage @'FromServer m :: *)) =>
RequestMessage @'FromServer m -> FromServerMessage
fromServerReq RequestMessage @'FromServer m
msg
    ServerNotOrReq @'Request m
IsServerEither -> forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient forall a b. (a -> b) -> a -> b
$ forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod @'FromServer @t m
-> Message @'FromServer @t m -> FromServerMessage' a
FromServerMess SServerMethod @'Request m
m forall a b. (a -> b) -> a -> b
$ forall (f :: From).
RequestMessage @f ('CustomMethod @f @'Request)
-> CustomMessage f 'Request
ReqMess RequestMessage @'FromServer m
msg
  forall (m :: * -> *) a. Monad m => a -> m a
return LspId @'FromServer m
reqId

-- ---------------------------------------------------------------------

-- | Return the 'VirtualFile' associated with a given 'NormalizedUri', if there is one.
getVirtualFile :: MonadLsp config m => NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile :: forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile NormalizedUri
uri = do
  VFS
dat <- VFSData -> VFS
vfsData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> m a
getsState forall config. LanguageContextState config -> TVar VFSData
resVFS
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ VFS
dat forall s a. s -> Getting a s a -> a
^. forall s a. HasVfsMap s a => Lens' s a
vfsMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at NormalizedUri
uri

{-# INLINE getVirtualFile #-}

getVirtualFiles :: MonadLsp config m => m VFS
getVirtualFiles :: forall config (m :: * -> *). MonadLsp config m => m VFS
getVirtualFiles = VFSData -> VFS
vfsData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> m a
getsState forall config. LanguageContextState config -> TVar VFSData
resVFS

{-# INLINE getVirtualFiles #-}

-- | Take an atomic snapshot of the current state of the virtual file system.
snapshotVirtualFiles :: LanguageContextEnv c -> STM VFS
snapshotVirtualFiles :: forall c. LanguageContextEnv c -> STM VFS
snapshotVirtualFiles LanguageContextEnv c
env = VFSData -> VFS
vfsData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TVar a -> STM a
readTVar (forall config. LanguageContextState config -> TVar VFSData
resVFS forall a b. (a -> b) -> a -> b
$ forall config.
LanguageContextEnv config -> LanguageContextState config
resState LanguageContextEnv c
env)

{-# INLINE snapshotVirtualFiles #-}


-- | Dump the current text for a given VFS file to a temporary file,
-- and return the path to the file.
persistVirtualFile :: MonadLsp config m => LogAction m (WithSeverity VfsLog) -> NormalizedUri -> m (Maybe FilePath)
persistVirtualFile :: forall config (m :: * -> *).
MonadLsp config m =>
LogAction m (WithSeverity VfsLog)
-> NormalizedUri -> m (Maybe FilePath)
persistVirtualFile LogAction m (WithSeverity VfsLog)
logger NormalizedUri
uri = do
  forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall config (m :: * -> *) s a.
MonadLsp config m =>
(LanguageContextState config -> TVar s) -> (s -> (a, s)) -> m a
stateState forall config. LanguageContextState config -> TVar VFSData
resVFS forall a b. (a -> b) -> a -> b
$ \VFSData
vfs ->
    case forall (m :: * -> *).
MonadIO m =>
LogAction m (WithSeverity VfsLog)
-> VFS -> NormalizedUri -> Maybe (FilePath, m ())
persistFileVFS LogAction m (WithSeverity VfsLog)
logger (VFSData -> VFS
vfsData VFSData
vfs) NormalizedUri
uri of
      Maybe (FilePath, m ())
Nothing -> (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing, VFSData
vfs)
      Just (FilePath
fn, m ()
write) ->
        let !revMap :: Map FilePath FilePath
revMap = case Uri -> Maybe FilePath
uriToFilePath (NormalizedUri -> Uri
fromNormalizedUri NormalizedUri
uri) of
              Just FilePath
uri_fp -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert FilePath
fn FilePath
uri_fp forall a b. (a -> b) -> a -> b
$ VFSData -> Map FilePath FilePath
reverseMap VFSData
vfs
              -- TODO: Does the VFS make sense for URIs which are not files?
              -- The reverse map should perhaps be (FilePath -> URI)
              Maybe FilePath
Nothing -> VFSData -> Map FilePath FilePath
reverseMap VFSData
vfs
            !vfs' :: VFSData
vfs' = VFSData
vfs {reverseMap :: Map FilePath FilePath
reverseMap = Map FilePath FilePath
revMap}
            act :: m (Maybe FilePath)
act = do
              m ()
write
              forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just FilePath
fn)
        in (m (Maybe FilePath)
act, VFSData
vfs')

-- | Given a text document identifier, annotate it with the latest version.
getVersionedTextDoc :: MonadLsp config m => TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedTextDoc :: forall config (m :: * -> *).
MonadLsp config m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedTextDoc TextDocumentIdentifier
doc = do
  let uri :: Uri
uri = TextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasUri s a => Lens' s a
J.uri
  Maybe VirtualFile
mvf <- forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile (Uri -> NormalizedUri
toNormalizedUri Uri
uri)
  let ver :: Maybe Int32
ver = case Maybe VirtualFile
mvf of
        Just (VirtualFile Int32
lspver Int
_ Rope
_) -> forall a. a -> Maybe a
Just Int32
lspver
        Maybe VirtualFile
Nothing -> forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return (Uri -> Maybe Int32 -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
uri Maybe Int32
ver)

{-# INLINE getVersionedTextDoc #-}

-- TODO: should this function return a URI?
-- | If the contents of a VFS has been dumped to a temporary file, map
-- the temporary file name back to the original one.
reverseFileMap :: MonadLsp config m => m (FilePath -> FilePath)
reverseFileMap :: forall config (m :: * -> *). MonadLsp config m => m ShowS
reverseFileMap = do
  VFSData
vfs <- forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> m a
getsState forall config. LanguageContextState config -> TVar VFSData
resVFS
  let f :: ShowS
f FilePath
fp = forall a. a -> Maybe a -> a
fromMaybe FilePath
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. VFSData -> Map FilePath FilePath
reverseMap forall a b. (a -> b) -> a -> b
$ VFSData
vfs
  forall (m :: * -> *) a. Monad m => a -> m a
return ShowS
f

{-# INLINE reverseFileMap #-}

-- ---------------------------------------------------------------------

sendToClient :: MonadLsp config m => FromServerMessage -> m ()
sendToClient :: forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient FromServerMessage
msg = do
  FromServerMessage -> IO ()
f <- forall config.
LanguageContextEnv config -> FromServerMessage -> IO ()
resSendMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FromServerMessage -> IO ()
f FromServerMessage
msg

{-# INLINE sendToClient #-}

-- ---------------------------------------------------------------------

freshLspId :: MonadLsp config m => m Int32
freshLspId :: forall config (m :: * -> *). MonadLsp config m => m Int32
freshLspId = do
  forall config (m :: * -> *) s a.
MonadLsp config m =>
(LanguageContextState config -> TVar s) -> (s -> (a, s)) -> m a
stateState forall config. LanguageContextState config -> TVar Int32
resLspId forall a b. (a -> b) -> a -> b
$ \Int32
cur ->
    let !next :: Int32
next = Int32
curforall a. Num a => a -> a -> a
+Int32
1 in (Int32
cur, Int32
next)

{-# INLINE freshLspId #-}

-- ---------------------------------------------------------------------

-- | The current configuration from the client as set via the @initialize@ and
-- @workspace/didChangeConfiguration@ requests, as well as by calls to
-- 'setConfig'.
getConfig :: MonadLsp config m => m config
getConfig :: forall config (m :: * -> *). MonadLsp config m => m config
getConfig = forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> m a
getsState forall config. LanguageContextState config -> TVar config
resConfig

{-# INLINE getConfig #-}

setConfig :: MonadLsp config m => config -> m ()
setConfig :: forall config (m :: * -> *). MonadLsp config m => config -> m ()
setConfig config
config = forall config (m :: * -> *) s a.
MonadLsp config m =>
(LanguageContextState config -> TVar s) -> (s -> (a, s)) -> m a
stateState forall config. LanguageContextState config -> TVar config
resConfig (forall a b. a -> b -> a
const ((), config
config))

{-# INLINE setConfig #-}

getClientCapabilities :: MonadLsp config m => m J.ClientCapabilities
getClientCapabilities :: forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities = forall config. LanguageContextEnv config -> ClientCapabilities
resClientCapabilities forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv

{-# INLINE getClientCapabilities #-}

getRootPath :: MonadLsp config m => m (Maybe FilePath)
getRootPath :: forall config (m :: * -> *).
MonadLsp config m =>
m (Maybe FilePath)
getRootPath = forall config. LanguageContextEnv config -> Maybe FilePath
resRootPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv

{-# INLINE getRootPath #-}

-- | The current workspace folders, if the client supports workspace folders.
getWorkspaceFolders :: MonadLsp config m => m (Maybe [WorkspaceFolder])
getWorkspaceFolders :: forall config (m :: * -> *).
MonadLsp config m =>
m (Maybe [WorkspaceFolder])
getWorkspaceFolders = do
  ClientCapabilities
clientCaps <- forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
  let clientSupportsWfs :: Bool
clientSupportsWfs = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
        let (J.ClientCapabilities Maybe WorkspaceClientCapabilities
mw Maybe TextDocumentClientCapabilities
_ Maybe WindowClientCapabilities
_ Maybe GeneralClientCapabilities
_ Maybe Object
_) = ClientCapabilities
clientCaps
        (J.WorkspaceClientCapabilities Maybe Bool
_ Maybe WorkspaceEditClientCapabilities
_ Maybe DidChangeConfigurationClientCapabilities
_ Maybe DidChangeWatchedFilesClientCapabilities
_ Maybe WorkspaceSymbolClientCapabilities
_ Maybe ExecuteCommandClientCapabilities
_ Maybe Bool
mwf Maybe Bool
_ Maybe SemanticTokensWorkspaceClientCapabilities
_) <- Maybe WorkspaceClientCapabilities
mw
        Maybe Bool
mwf
  if Bool
clientSupportsWfs
    then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> m a
getsState forall config.
LanguageContextState config -> TVar [WorkspaceFolder]
resWorkspaceFolders
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

{-# INLINE getWorkspaceFolders #-}

-- | Sends a @client/registerCapability@ request and dynamically registers
-- a 'Method' with a 'Handler'. Returns 'Nothing' if the client does not
-- support dynamic registration for the specified method, otherwise a
-- 'RegistrationToken' which can be used to unregister it later.
registerCapability :: forall f t (m :: Method FromClient t) config.
                      MonadLsp config f
                   => SClientMethod m
                   -> RegistrationOptions m
                   -> Handler f m
                   -> f (Maybe (RegistrationToken m))
registerCapability :: forall (f :: * -> *) (t :: MethodType) (m :: Method 'FromClient t)
       config.
MonadLsp config f =>
SClientMethod @t m
-> RegistrationOptions @t m
-> Handler @'FromClient @t f m
-> f (Maybe (RegistrationToken @t m))
registerCapability SClientMethod @t m
method RegistrationOptions @t m
regOpts Handler @'FromClient @t f m
f = do
  ClientCapabilities
clientCaps <- forall config. LanguageContextEnv config -> ClientCapabilities
resClientCapabilities forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv
  Handlers IO
handlers <- forall config. LanguageContextEnv config -> Handlers IO
resHandlers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall config (m :: * -> *).
MonadLsp config m =>
m (LanguageContextEnv config)
getLspEnv
  let alreadyStaticallyRegistered :: Bool
alreadyStaticallyRegistered = case forall {t :: MethodType} (m :: Method 'FromClient t).
SClientMethod @t m -> ClientNotOrReq @t m
splitClientMethod SClientMethod @t m
method of
        ClientNotOrReq @t m
IsClientNot -> forall {f1 :: From} {t1 :: MethodType} {f2 :: From}
       {t2 :: MethodType} (a :: Method f1 t1) (v :: Method f2 t2 -> *).
SMethod @f1 @t1 a -> SMethodMap @f2 @t2 v -> Bool
SMethodMap.member SClientMethod @t m
method forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Handlers m
-> SMethodMap
     @'FromClient @'Notification (ClientMessageHandler m 'Notification)
notHandlers Handlers IO
handlers
        ClientNotOrReq @t m
IsClientReq -> forall {f1 :: From} {t1 :: MethodType} {f2 :: From}
       {t2 :: MethodType} (a :: Method f1 t1) (v :: Method f2 t2 -> *).
SMethod @f1 @t1 a -> SMethodMap @f2 @t2 v -> Bool
SMethodMap.member SClientMethod @t m
method forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Handlers m
-> SMethodMap
     @'FromClient @'Request (ClientMessageHandler m 'Request)
reqHandlers Handlers IO
handlers
        ClientNotOrReq @t m
IsClientEither -> forall a. HasCallStack => FilePath -> a
error FilePath
"Cannot register capability for custom methods"
  ClientCapabilities -> Bool -> f (Maybe (RegistrationToken @t m))
go ClientCapabilities
clientCaps Bool
alreadyStaticallyRegistered
  where
    -- If the server has already registered statically, don't dynamically register
    -- as per the spec
    go :: ClientCapabilities -> Bool -> f (Maybe (RegistrationToken @t m))
go ClientCapabilities
_clientCaps Bool
True = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    go ClientCapabilities
clientCaps  Bool
False
      -- First, check to see if the client supports dynamic registration on this method
      | ClientCapabilities -> Bool
dynamicSupported ClientCapabilities
clientCaps = do
          Text
uuid <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ UUID -> Text
UUID.toText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom forall a g. (Random a, RandomGen g) => g -> (a, g)
random
          let registration :: Registration @t m
registration = forall (t :: MethodType) (m :: Method 'FromClient t).
Text
-> SClientMethod @t m
-> RegistrationOptions @t m
-> Registration @t m
J.Registration Text
uuid SClientMethod @t m
method RegistrationOptions @t m
regOpts
              params :: RegistrationParams
params = List SomeRegistration -> RegistrationParams
J.RegistrationParams (forall a. [a] -> List a
J.List [forall (t :: MethodType) (m :: Method 'FromClient t).
Registration @t m -> SomeRegistration
J.SomeRegistration Registration @t m
registration])
              regId :: RegistrationId @t m
regId = forall (t :: MethodType) (m :: Method 'FromClient t).
Text -> RegistrationId @t m
RegistrationId Text
uuid
          UnliftIO f
rio <- forall (m :: * -> *). MonadUnliftIO m => m (UnliftIO m)
askUnliftIO
          ~() <- case forall {t :: MethodType} (m :: Method 'FromClient t).
SClientMethod @t m -> ClientNotOrReq @t m
splitClientMethod SClientMethod @t m
method of
            ClientNotOrReq @t m
IsClientNot -> forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> (a -> a) -> m ()
modifyState forall config.
LanguageContextState config -> TVar (RegistrationMap 'Notification)
resRegistrationsNot forall a b. (a -> b) -> a -> b
$ \RegistrationMap 'Notification
oldRegs ->
              let pair :: Product
  @(Method 'FromClient t)
  (RegistrationId @t)
  (ClientMessageHandler IO t)
  m
pair = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product @k f g a
Pair RegistrationId @t m
regId (forall (f :: * -> *) (t :: MethodType) (m :: Method 'FromClient t).
Handler @'FromClient @t f m -> ClientMessageHandler f t m
ClientMessageHandler (forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO f
rio forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler @'FromClient @t f m
f))
                in forall {f :: From} {t :: MethodType} (a :: Method f t)
       (v :: Method f t -> *).
SMethod @f @t a -> v a -> SMethodMap @f @t v -> SMethodMap @f @t v
SMethodMap.insert SClientMethod @t m
method Product
  @(Method 'FromClient t)
  (RegistrationId @t)
  (ClientMessageHandler IO t)
  m
pair RegistrationMap 'Notification
oldRegs
            ClientNotOrReq @t m
IsClientReq -> forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> (a -> a) -> m ()
modifyState forall config.
LanguageContextState config -> TVar (RegistrationMap 'Request)
resRegistrationsReq forall a b. (a -> b) -> a -> b
$ \RegistrationMap 'Request
oldRegs ->
              let pair :: Product
  @(Method 'FromClient t)
  (RegistrationId @t)
  (ClientMessageHandler IO t)
  m
pair = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product @k f g a
Pair RegistrationId @t m
regId (forall (f :: * -> *) (t :: MethodType) (m :: Method 'FromClient t).
Handler @'FromClient @t f m -> ClientMessageHandler f t m
ClientMessageHandler (\RequestMessage @'FromClient m
msg Either ResponseError (ResponseResult @'FromClient m) -> IO ()
k -> forall (m :: * -> *). UnliftIO m -> forall a. m a -> IO a
unliftIO UnliftIO f
rio forall a b. (a -> b) -> a -> b
$ Handler @'FromClient @t f m
f RequestMessage @'FromClient m
msg (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ResponseError (ResponseResult @'FromClient m) -> IO ()
k)))
                in forall {f :: From} {t :: MethodType} (a :: Method f t)
       (v :: Method f t -> *).
SMethod @f @t a -> v a -> SMethodMap @f @t v -> SMethodMap @f @t v
SMethodMap.insert SClientMethod @t m
method Product
  @(Method 'FromClient t)
  (RegistrationId @t)
  (ClientMessageHandler IO t)
  m
pair RegistrationMap 'Request
oldRegs
            ClientNotOrReq @t m
IsClientEither -> forall a. HasCallStack => FilePath -> a
error FilePath
"Cannot register capability for custom methods"

          -- TODO: handle the scenario where this returns an error
          LspId @'FromServer 'ClientRegisterCapability
_ <- forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod @'Request m
-> MessageParams @'FromServer @'Request m
-> (Either ResponseError (ResponseResult @'FromServer m) -> f ())
-> f (LspId @'FromServer m)
sendRequest SMethod @'FromServer @'Request 'ClientRegisterCapability
SClientRegisterCapability RegistrationParams
params forall a b. (a -> b) -> a -> b
$ \Either
  ResponseError
  (ResponseResult @'FromServer 'ClientRegisterCapability)
_res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (forall (t :: MethodType) (m :: Method 'FromClient t).
SMethod @'FromClient @t m
-> RegistrationId @t m -> RegistrationToken @t m
RegistrationToken SClientMethod @t m
method RegistrationId @t m
regId))
      | Bool
otherwise        = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

    -- Also I'm thinking we should move this function to somewhere in messages.hs so
    -- we don't forget to update it when adding new methods...
    capDyn :: J.HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
    capDyn :: forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn (Just a
x) = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ a
x forall s a. s -> Getting a s a -> a
^. forall s a. HasDynamicRegistration s a => Lens' s a
J.dynamicRegistration
    capDyn Maybe a
Nothing  = Bool
False

    -- | Checks if client capabilities declares that the method supports dynamic registration
    dynamicSupported :: ClientCapabilities -> Bool
dynamicSupported ClientCapabilities
clientCaps = case SClientMethod @t m
method of
      SClientMethod @t m
SWorkspaceDidChangeConfiguration  -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
J.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDidChangeConfiguration s a => Lens' s a
J.didChangeConfiguration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
SWorkspaceDidChangeWatchedFiles   -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
J.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDidChangeWatchedFiles s a => Lens' s a
J.didChangeWatchedFiles forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
SWorkspaceSymbol                  -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
J.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSymbol s a => Lens' s a
J.symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
SWorkspaceExecuteCommand          -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasWorkspace s a => Lens' s a
J.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasExecuteCommand s a => Lens' s a
J.executeCommand forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDidOpen              -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSynchronization s a => Lens' s a
J.synchronization forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDidChange            -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSynchronization s a => Lens' s a
J.synchronization forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDidClose             -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSynchronization s a => Lens' s a
J.synchronization forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentCompletion           -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCompletion s a => Lens' s a
J.completion forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentHover                -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasHover s a => Lens' s a
J.hover forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentSignatureHelp        -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSignatureHelp s a => Lens' s a
J.signatureHelp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDeclaration          -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDeclaration s a => Lens' s a
J.declaration forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDefinition           -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDefinition s a => Lens' s a
J.definition forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentTypeDefinition       -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasTypeDefinition s a => Lens' s a
J.typeDefinition forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentImplementation       -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasImplementation s a => Lens' s a
J.implementation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentReferences           -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasReferences s a => Lens' s a
J.references forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDocumentHighlight    -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDocumentHighlight s a => Lens' s a
J.documentHighlight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDocumentSymbol       -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDocumentSymbol s a => Lens' s a
J.documentSymbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentCodeAction           -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCodeAction s a => Lens' s a
J.codeAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentCodeLens             -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCodeLens s a => Lens' s a
J.codeLens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDocumentLink         -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasDocumentLink s a => Lens' s a
J.documentLink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentDocumentColor        -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasColorProvider s a => Lens' s a
J.colorProvider forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentColorPresentation    -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasColorProvider s a => Lens' s a
J.colorProvider forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentFormatting           -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFormatting s a => Lens' s a
J.formatting forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentRangeFormatting      -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRangeFormatting s a => Lens' s a
J.rangeFormatting forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentOnTypeFormatting     -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasOnTypeFormatting s a => Lens' s a
J.onTypeFormatting forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentRename               -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasRename s a => Lens' s a
J.rename forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentFoldingRange         -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasFoldingRange s a => Lens' s a
J.foldingRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentSelectionRange       -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSelectionRange s a => Lens' s a
J.selectionRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentPrepareCallHierarchy -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasCallHierarchy s a => Lens' s a
J.callHierarchy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
STextDocumentSemanticTokens       -> forall a. HasDynamicRegistration a (Maybe Bool) => Maybe a -> Bool
capDyn forall a b. (a -> b) -> a -> b
$ ClientCapabilities
clientCaps forall s a. s -> Getting (First a) s a -> Maybe a
^? forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasSemanticTokens s a => Lens' s a
J.semanticTokens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just
      SClientMethod @t m
_                                 -> Bool
False

-- | Sends a @client/unregisterCapability@ request and removes the handler
-- for that associated registration.
unregisterCapability :: MonadLsp config f => RegistrationToken m -> f ()
unregisterCapability :: forall {t :: MethodType} config (f :: * -> *)
       (m :: Method 'FromClient t).
MonadLsp config f =>
RegistrationToken @t m -> f ()
unregisterCapability (RegistrationToken SMethod @'FromClient @t m
m (RegistrationId Text
uuid)) = do
  ~() <- case forall {t :: MethodType} (m :: Method 'FromClient t).
SClientMethod @t m -> ClientNotOrReq @t m
splitClientMethod SMethod @'FromClient @t m
m of
    ClientNotOrReq @t m
IsClientReq -> forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> (a -> a) -> m ()
modifyState forall config.
LanguageContextState config -> TVar (RegistrationMap 'Request)
resRegistrationsReq forall a b. (a -> b) -> a -> b
$ forall {f1 :: From} {t1 :: MethodType} {f2 :: From}
       {t2 :: MethodType} (a :: Method f1 t1) (v :: Method f2 t2 -> *).
SMethod @f1 @t1 a -> SMethodMap @f2 @t2 v -> SMethodMap @f2 @t2 v
SMethodMap.delete SMethod @'FromClient @t m
m
    ClientNotOrReq @t m
IsClientNot -> forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> (a -> a) -> m ()
modifyState forall config.
LanguageContextState config -> TVar (RegistrationMap 'Notification)
resRegistrationsNot forall a b. (a -> b) -> a -> b
$ forall {f1 :: From} {t1 :: MethodType} {f2 :: From}
       {t2 :: MethodType} (a :: Method f1 t1) (v :: Method f2 t2 -> *).
SMethod @f1 @t1 a -> SMethodMap @f2 @t2 v -> SMethodMap @f2 @t2 v
SMethodMap.delete SMethod @'FromClient @t m
m
    ClientNotOrReq @t m
IsClientEither -> forall a. HasCallStack => FilePath -> a
error FilePath
"Cannot unregister capability for custom methods"

  let unregistration :: Unregistration
unregistration = Text -> SomeClientMethod -> Unregistration
J.Unregistration Text
uuid (forall (t :: MethodType) (m :: Method 'FromClient t).
SMethod @'FromClient @t m -> SomeClientMethod
J.SomeClientMethod SMethod @'FromClient @t m
m)
      params :: UnregistrationParams
params = List Unregistration -> UnregistrationParams
J.UnregistrationParams (forall a. [a] -> List a
J.List [Unregistration
unregistration])
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod @'Request m
-> MessageParams @'FromServer @'Request m
-> (Either ResponseError (ResponseResult @'FromServer m) -> f ())
-> f (LspId @'FromServer m)
sendRequest SMethod @'FromServer @'Request 'ClientUnregisterCapability
SClientUnregisterCapability UnregistrationParams
params forall a b. (a -> b) -> a -> b
$ \Either
  ResponseError
  (ResponseResult @'FromServer 'ClientUnregisterCapability)
_res -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

--------------------------------------------------------------------------------
-- PROGRESS
--------------------------------------------------------------------------------

storeProgress :: MonadLsp config m => ProgressToken -> Async a -> m ()
storeProgress :: forall config (m :: * -> *) a.
MonadLsp config m =>
ProgressToken -> Async a -> m ()
storeProgress ProgressToken
n Async a
a = forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> (a -> a) -> m ()
modifyState (ProgressData -> TVar (Map ProgressToken (IO ()))
progressCancel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall config. LanguageContextState config -> ProgressData
resProgressData) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ProgressToken
n (forall e a. Exception e => Async a -> e -> IO ()
cancelWith Async a
a ProgressCancelledException
ProgressCancelledException)

{-# INLINE storeProgress #-}

deleteProgress :: MonadLsp config m => ProgressToken -> m ()
deleteProgress :: forall config (m :: * -> *).
MonadLsp config m =>
ProgressToken -> m ()
deleteProgress ProgressToken
n = forall config (m :: * -> *) a.
MonadLsp config m =>
(LanguageContextState config -> TVar a) -> (a -> a) -> m ()
modifyState (ProgressData -> TVar (Map ProgressToken (IO ()))
progressCancel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall config. LanguageContextState config -> ProgressData
resProgressData) forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ProgressToken
n

{-# INLINE deleteProgress #-}

-- Get a new id for the progress session and make a new one
getNewProgressId :: MonadLsp config m => m ProgressToken
getNewProgressId :: forall config (m :: * -> *). MonadLsp config m => m ProgressToken
getNewProgressId = do
  forall config (m :: * -> *) s a.
MonadLsp config m =>
(LanguageContextState config -> TVar s) -> (s -> (a, s)) -> m a
stateState (ProgressData -> TVar Int32
progressNextId forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall config. LanguageContextState config -> ProgressData
resProgressData) forall a b. (a -> b) -> a -> b
$ \Int32
cur ->
    let !next :: Int32
next = Int32
curforall a. Num a => a -> a -> a
+Int32
1
    in (Int32 -> ProgressToken
ProgressNumericToken Int32
cur, Int32
next)

{-# INLINE getNewProgressId #-}

withProgressBase :: MonadLsp c m => Bool -> Text -> ProgressCancellable -> ((ProgressAmount -> m ()) -> m a) -> m a
withProgressBase :: forall c (m :: * -> *) a.
MonadLsp c m =>
Bool
-> Text
-> ProgressCancellable
-> ((ProgressAmount -> m ()) -> m a)
-> m a
withProgressBase Bool
indefinite Text
title ProgressCancellable
cancellable (ProgressAmount -> m ()) -> m a
f = do

  ProgressToken
progId <- forall config (m :: * -> *). MonadLsp config m => m ProgressToken
getNewProgressId

  let initialPercentage :: Maybe UInt
initialPercentage
        | Bool
indefinite = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just UInt
0
      cancellable' :: Bool
cancellable' = case ProgressCancellable
cancellable of
                      ProgressCancellable
Cancellable -> Bool
True
                      ProgressCancellable
NotCancellable -> Bool
False

  -- Create progress token
  -- FIXME  : This needs to wait until the request returns before
  -- continuing!!!
  LspId @'FromServer 'WindowWorkDoneProgressCreate
_ <- forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod @'Request m
-> MessageParams @'FromServer @'Request m
-> (Either ResponseError (ResponseResult @'FromServer m) -> f ())
-> f (LspId @'FromServer m)
sendRequest SMethod @'FromServer @'Request 'WindowWorkDoneProgressCreate
SWindowWorkDoneProgressCreate
        (ProgressToken -> WorkDoneProgressCreateParams
WorkDoneProgressCreateParams ProgressToken
progId) forall a b. (a -> b) -> a -> b
$ \Either
  ResponseError
  (ResponseResult @'FromServer 'WindowWorkDoneProgressCreate)
res -> do
          case Either
  ResponseError
  (ResponseResult @'FromServer 'WindowWorkDoneProgressCreate)
res of
            -- An error occurred when the client was setting it up
            -- No need to do anything then, as per the spec
            Left ResponseError
_err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Right ResponseResult @'FromServer 'WindowWorkDoneProgressCreate
Empty
Empty -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  -- Send the begin and done notifications via 'bracket_' so that they are always fired
  a
res <- forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
runInBase ->
    forall a b c. IO a -> IO b -> IO c -> IO c
E.bracket_
      -- Send begin notification
      (forall a. m a -> IO a
runInBase forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod @'Notification m
-> MessageParams @'FromServer @'Notification m -> f ()
sendNotification SMethod @'FromServer @'Notification 'Progress
SProgress forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WorkDoneProgressBeginParams -> SomeProgressParams
Begin forall a b. (a -> b) -> a -> b
$ forall t. ProgressToken -> t -> ProgressParams t
ProgressParams ProgressToken
progId forall a b. (a -> b) -> a -> b
$
          Text
-> Maybe Bool
-> Maybe Text
-> Maybe UInt
-> WorkDoneProgressBeginParams
WorkDoneProgressBeginParams Text
title (forall a. a -> Maybe a
Just Bool
cancellable') forall a. Maybe a
Nothing Maybe UInt
initialPercentage)

      -- Send end notification
      (forall a. m a -> IO a
runInBase forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod @'Notification m
-> MessageParams @'FromServer @'Notification m -> f ()
sendNotification SMethod @'FromServer @'Notification 'Progress
SProgress forall a b. (a -> b) -> a -> b
$
        WorkDoneProgressEndParams -> SomeProgressParams
End forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. ProgressToken -> t -> ProgressParams t
ProgressParams ProgressToken
progId (Maybe Text -> WorkDoneProgressEndParams
WorkDoneProgressEndParams forall a. Maybe a
Nothing)) forall a b. (a -> b) -> a -> b
$ do

      -- Run f asynchronously
      Async a
aid <- forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
runInBase forall a b. (a -> b) -> a -> b
$ (ProgressAmount -> m ()) -> m a
f (forall {config} {f :: * -> *}.
MonadLsp config f =>
ProgressToken -> ProgressAmount -> f ()
updater ProgressToken
progId)
      forall a. m a -> IO a
runInBase forall a b. (a -> b) -> a -> b
$ forall config (m :: * -> *) a.
MonadLsp config m =>
ProgressToken -> Async a -> m ()
storeProgress ProgressToken
progId Async a
aid
      forall a. Async a -> IO a
wait Async a
aid

  -- Delete the progress cancellation from the map
  -- If we don't do this then it's easy to leak things as the map contains any IO action.
  forall config (m :: * -> *).
MonadLsp config m =>
ProgressToken -> m ()
deleteProgress ProgressToken
progId

  forall (m :: * -> *) a. Monad m => a -> m a
return a
res
  where updater :: ProgressToken -> ProgressAmount -> f ()
updater ProgressToken
progId (ProgressAmount Maybe UInt
percentage Maybe Text
msg) = do
          forall (m :: Method 'FromServer 'Notification) (f :: * -> *)
       config.
MonadLsp config f =>
SServerMethod @'Notification m
-> MessageParams @'FromServer @'Notification m -> f ()
sendNotification SMethod @'FromServer @'Notification 'Progress
SProgress forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WorkDoneProgressReportParams -> SomeProgressParams
Report forall a b. (a -> b) -> a -> b
$ forall t. ProgressToken -> t -> ProgressParams t
ProgressParams ProgressToken
progId forall a b. (a -> b) -> a -> b
$
              Maybe Bool
-> Maybe Text -> Maybe UInt -> WorkDoneProgressReportParams
WorkDoneProgressReportParams forall a. Maybe a
Nothing Maybe Text
msg Maybe UInt
percentage

clientSupportsProgress :: J.ClientCapabilities -> Bool
clientSupportsProgress :: ClientCapabilities -> Bool
clientSupportsProgress (J.ClientCapabilities Maybe WorkspaceClientCapabilities
_ Maybe TextDocumentClientCapabilities
_ Maybe WindowClientCapabilities
wc Maybe GeneralClientCapabilities
_ Maybe Object
_) = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
  (J.WindowClientCapabilities Maybe Bool
mProgress Maybe ShowMessageRequestClientCapabilities
_ Maybe ShowDocumentClientCapabilities
_) <- Maybe WindowClientCapabilities
wc
  Maybe Bool
mProgress

{-# INLINE clientSupportsProgress #-}

-- | Wrapper for reporting progress to the client during a long running
-- task.
-- 'withProgress' @title cancellable f@ starts a new progress reporting
-- session, and finishes it once f is completed.
-- f is provided with an update function that allows it to report on
-- the progress during the session.
-- If @cancellable@ is 'Cancellable', @f@ will be thrown a
-- 'ProgressCancelledException' if the user cancels the action in
-- progress.
withProgress :: MonadLsp c m => Text -> ProgressCancellable -> ((ProgressAmount -> m ()) -> m a) -> m a
withProgress :: forall c (m :: * -> *) a.
MonadLsp c m =>
Text
-> ProgressCancellable -> ((ProgressAmount -> m ()) -> m a) -> m a
withProgress Text
title ProgressCancellable
cancellable (ProgressAmount -> m ()) -> m a
f = do
  ClientCapabilities
clientCaps <- forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
  if ClientCapabilities -> Bool
clientSupportsProgress ClientCapabilities
clientCaps
    then forall c (m :: * -> *) a.
MonadLsp c m =>
Bool
-> Text
-> ProgressCancellable
-> ((ProgressAmount -> m ()) -> m a)
-> m a
withProgressBase Bool
False Text
title ProgressCancellable
cancellable (ProgressAmount -> m ()) -> m a
f
    else (ProgressAmount -> m ()) -> m a
f (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Same as 'withProgress', but for processes that do not report the
-- precentage complete.
--
-- @since 0.10.0.0
withIndefiniteProgress :: MonadLsp c m => Text -> ProgressCancellable -> m a -> m a
withIndefiniteProgress :: forall c (m :: * -> *) a.
MonadLsp c m =>
Text -> ProgressCancellable -> m a -> m a
withIndefiniteProgress Text
title ProgressCancellable
cancellable m a
f = do
  ClientCapabilities
clientCaps <- forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
getClientCapabilities
  if ClientCapabilities -> Bool
clientSupportsProgress ClientCapabilities
clientCaps
    then forall c (m :: * -> *) a.
MonadLsp c m =>
Bool
-> Text
-> ProgressCancellable
-> ((ProgressAmount -> m ()) -> m a)
-> m a
withProgressBase Bool
True Text
title ProgressCancellable
cancellable (forall a b. a -> b -> a
const m a
f)
    else m a
f

-- ---------------------------------------------------------------------

-- | Aggregate all diagnostics pertaining to a particular version of a document,
-- by source, and sends a @textDocument/publishDiagnostics@ notification with
-- the total (limited by the first parameter) whenever it is updated.
publishDiagnostics :: MonadLsp config m => Int -> NormalizedUri -> TextDocumentVersion -> DiagnosticsBySource -> m ()
publishDiagnostics :: forall config (m :: * -> *).
MonadLsp config m =>
Int -> NormalizedUri -> Maybe Int32 -> DiagnosticsBySource -> m ()
publishDiagnostics Int
maxDiagnosticCount NormalizedUri
uri Maybe Int32
version DiagnosticsBySource
diags = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall config (m :: * -> *) s a.
MonadLsp config m =>
(LanguageContextState config -> TVar s) -> (s -> (a, s)) -> m a
stateState forall config. LanguageContextState config -> TVar DiagnosticStore
resDiagnostics forall a b. (a -> b) -> a -> b
$ \DiagnosticStore
oldDiags->
  let !newDiags :: DiagnosticStore
newDiags = DiagnosticStore
-> NormalizedUri
-> Maybe Int32
-> DiagnosticsBySource
-> DiagnosticStore
updateDiagnostics DiagnosticStore
oldDiags NormalizedUri
uri Maybe Int32
version DiagnosticsBySource
diags
      mdp :: Maybe PublishDiagnosticsParams
mdp = Int
-> DiagnosticStore
-> NormalizedUri
-> Maybe PublishDiagnosticsParams
getDiagnosticParamsFor Int
maxDiagnosticCount DiagnosticStore
newDiags NormalizedUri
uri
      act :: m ()
act = case Maybe PublishDiagnosticsParams
mdp of
        Maybe PublishDiagnosticsParams
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just PublishDiagnosticsParams
params ->
          forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification).
((Message @'FromServer @'Notification m :: *)
 ~ (NotificationMessage @'FromServer m :: *)) =>
NotificationMessage @'FromServer m -> FromServerMessage
J.fromServerNot forall a b. (a -> b) -> a -> b
$ forall (f :: From) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> NotificationMessage @f m
J.NotificationMessage Text
"2.0" SMethod @'FromServer @'Notification 'TextDocumentPublishDiagnostics
J.STextDocumentPublishDiagnostics PublishDiagnosticsParams
params
      in (m ()
act,DiagnosticStore
newDiags)

-- ---------------------------------------------------------------------

-- | Remove all diagnostics from a particular source, and send the updates to
-- the client.
flushDiagnosticsBySource :: MonadLsp config m => Int -- ^ Max number of diagnostics to send
                         -> Maybe DiagnosticSource -> m ()
flushDiagnosticsBySource :: forall config (m :: * -> *).
MonadLsp config m =>
Int -> Maybe Text -> m ()
flushDiagnosticsBySource Int
maxDiagnosticCount Maybe Text
msource = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall config (m :: * -> *) s a.
MonadLsp config m =>
(LanguageContextState config -> TVar s) -> (s -> (a, s)) -> m a
stateState forall config. LanguageContextState config -> TVar DiagnosticStore
resDiagnostics forall a b. (a -> b) -> a -> b
$ \DiagnosticStore
oldDiags ->
  let !newDiags :: DiagnosticStore
newDiags = DiagnosticStore -> Maybe Text -> DiagnosticStore
flushBySource DiagnosticStore
oldDiags Maybe Text
msource
      -- Send the updated diagnostics to the client
      act :: m ()
act = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k v. HashMap k v -> [k]
HM.keys DiagnosticStore
newDiags) forall a b. (a -> b) -> a -> b
$ \NormalizedUri
uri -> do
        let mdp :: Maybe PublishDiagnosticsParams
mdp = Int
-> DiagnosticStore
-> NormalizedUri
-> Maybe PublishDiagnosticsParams
getDiagnosticParamsFor Int
maxDiagnosticCount DiagnosticStore
newDiags NormalizedUri
uri
        case Maybe PublishDiagnosticsParams
mdp of
          Maybe PublishDiagnosticsParams
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just PublishDiagnosticsParams
params -> do
            forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification).
((Message @'FromServer @'Notification m :: *)
 ~ (NotificationMessage @'FromServer m :: *)) =>
NotificationMessage @'FromServer m -> FromServerMessage
J.fromServerNot forall a b. (a -> b) -> a -> b
$ forall (f :: From) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> NotificationMessage @f m
J.NotificationMessage Text
"2.0" SMethod @'FromServer @'Notification 'TextDocumentPublishDiagnostics
J.STextDocumentPublishDiagnostics PublishDiagnosticsParams
params
      in (m ()
act,DiagnosticStore
newDiags)

-- ---------------------------------------------------------------------

-- | The changes in a workspace edit should be applied from the end of the file
-- toward the start. Sort them into this order.
reverseSortEdit :: J.WorkspaceEdit -> J.WorkspaceEdit
reverseSortEdit :: WorkspaceEdit -> WorkspaceEdit
reverseSortEdit (J.WorkspaceEdit Maybe WorkspaceEditMap
cs Maybe (List DocumentChange)
dcs Maybe ChangeAnnotationMap
anns) = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
J.WorkspaceEdit Maybe WorkspaceEditMap
cs' Maybe (List DocumentChange)
dcs' Maybe ChangeAnnotationMap
anns
  where
    cs' :: Maybe J.WorkspaceEditMap
    cs' :: Maybe WorkspaceEditMap
cs' = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ) List TextEdit -> List TextEdit
sortTextEdits Maybe WorkspaceEditMap
cs

    dcs' :: Maybe (J.List J.DocumentChange)
    dcs' :: Maybe (List DocumentChange)
dcs' = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) DocumentChange -> DocumentChange
sortOnlyTextDocumentEdits Maybe (List DocumentChange)
dcs

    sortTextEdits :: J.List J.TextEdit -> J.List J.TextEdit
    sortTextEdits :: List TextEdit -> List TextEdit
sortTextEdits (J.List [TextEdit]
edits) = forall a. [a] -> List a
J.List (forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range)) [TextEdit]
edits)

    sortOnlyTextDocumentEdits :: J.DocumentChange -> J.DocumentChange
    sortOnlyTextDocumentEdits :: DocumentChange -> DocumentChange
sortOnlyTextDocumentEdits (J.InL (J.TextDocumentEdit VersionedTextDocumentIdentifier
td (J.List [TextEdit |? AnnotatedTextEdit]
edits))) = forall a b. a -> a |? b
J.InL forall a b. (a -> b) -> a -> b
$ VersionedTextDocumentIdentifier
-> List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit
J.TextDocumentEdit VersionedTextDocumentIdentifier
td (forall a. [a] -> List a
J.List [TextEdit |? AnnotatedTextEdit]
edits')
      where
        edits' :: [TextEdit |? AnnotatedTextEdit]
edits' = forall b a. Ord b => (a -> b) -> [a] -> [a]
L.sortOn (forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextEdit |? AnnotatedTextEdit) -> Range
editRange) [TextEdit |? AnnotatedTextEdit]
edits
    sortOnlyTextDocumentEdits (J.InR CreateFile |? (RenameFile |? DeleteFile)
others) = forall a b. b -> a |? b
J.InR CreateFile |? (RenameFile |? DeleteFile)
others

    editRange :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.Range
    editRange :: (TextEdit |? AnnotatedTextEdit) -> Range
editRange (J.InR AnnotatedTextEdit
e) = AnnotatedTextEdit
e forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range
    editRange (J.InL TextEdit
e) = TextEdit
e forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range