{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeInType #-}

module Language.LSP.Test.Parsing (
  -- $receiving
  satisfy,
  satisfyMaybe,
  message,
  response,
  responseForId,
  customRequest,
  customNotification,
  anyRequest,
  anyResponse,
  anyNotification,
  anyMessage,
  loggingNotification,
  configurationRequest,
  loggingOrConfiguration,
  publishDiagnosticsNotification,
) where

import Control.Applicative
import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import Data.Conduit.Parser hiding (named)
import Data.Conduit.Parser qualified (named)
import Data.GADT.Compare
import Data.Text qualified as T
import Data.Typeable
import GHC.TypeLits (KnownSymbol, symbolVal)
import Language.LSP.Protocol.Message
import Language.LSP.Test.Session

{- $receiving
 To receive a message, specify the method of the message to expect:

 @
 msg1 <- message SWorkspaceApplyEdit
 msg2 <- message STextDocumentHover
 @

 'Language.LSP.Test.Session' is actually just a parser
 that operates on messages under the hood. This means that you
 can create and combine parsers to match specific sequences of
 messages that you expect.

 For example, if you wanted to match either a definition or
 references request:

 > defOrImpl = message STextDocumentDefinition
 >          <|> message STextDocumentReferences

 If you wanted to match any number of telemetry
 notifications immediately followed by a response:

 @
 logThenDiags =
  skipManyTill (message STelemetryEvent)
               anyResponse
 @
-}

{- | Consumes and returns the next message, if it satisfies the specified predicate.

 @since 0.5.2.0
-}
satisfy :: (FromServerMessage -> Bool) -> Session FromServerMessage
satisfy :: (FromServerMessage -> Bool) -> Session FromServerMessage
satisfy FromServerMessage -> Bool
pred = (FromServerMessage -> Maybe FromServerMessage)
-> Session FromServerMessage
forall a. (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe (\FromServerMessage
msg -> if FromServerMessage -> Bool
pred FromServerMessage
msg then FromServerMessage -> Maybe FromServerMessage
forall a. a -> Maybe a
Just FromServerMessage
msg else Maybe FromServerMessage
forall a. Maybe a
Nothing)

{- | Consumes and returns the result of the specified predicate if it returns `Just`.

 @since 0.6.1.0
-}
satisfyMaybe :: (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe :: forall a. (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe FromServerMessage -> Maybe a
pred = (FromServerMessage -> Session (Maybe a)) -> Session a
forall a. (FromServerMessage -> Session (Maybe a)) -> Session a
satisfyMaybeM (Maybe a -> Session (Maybe a)
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Session (Maybe a))
-> (FromServerMessage -> Maybe a)
-> FromServerMessage
-> Session (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromServerMessage -> Maybe a
pred)

satisfyMaybeM :: (FromServerMessage -> Session (Maybe a)) -> Session a
satisfyMaybeM :: forall a. (FromServerMessage -> Session (Maybe a)) -> Session a
satisfyMaybeM FromServerMessage -> Session (Maybe a)
pred = do
  Bool
skipTimeout <- SessionState -> Bool
overridingTimeout (SessionState -> Bool) -> Session SessionState -> Session Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session SessionState
forall s (m :: * -> *). HasState s m => m s
get
  Int
timeoutId <- Session Int
forall (m :: * -> *).
(HasReader SessionContext m, MonadIO m) =>
m Int
getCurTimeoutId
  Maybe ThreadId
mtid <-
    if Bool
skipTimeout
      then Maybe ThreadId -> Session (Maybe ThreadId)
forall a. a -> Session a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ThreadId
forall a. Maybe a
Nothing
      else
        ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just (ThreadId -> Maybe ThreadId)
-> Session ThreadId -> Session (Maybe ThreadId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
          Chan SessionMessage
chan <- (SessionContext -> Chan SessionMessage)
-> Session (Chan SessionMessage)
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks SessionContext -> Chan SessionMessage
messageChan
          Int
timeout <- (SessionContext -> Int) -> Session Int
forall b. (SessionContext -> b) -> Session b
forall r (m :: * -> *) b. HasReader r m => (r -> b) -> m b
asks (SessionConfig -> Int
messageTimeout (SessionConfig -> Int)
-> (SessionContext -> SessionConfig) -> SessionContext -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionContext -> SessionConfig
config)
          IO ThreadId -> Session ThreadId
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> Session ThreadId)
-> IO ThreadId -> Session ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
            Int -> IO ()
threadDelay (Int
timeout Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000)
            Chan SessionMessage -> SessionMessage -> IO ()
forall a. Chan a -> a -> IO ()
writeChan Chan SessionMessage
chan (Int -> SessionMessage
TimeoutMessage Int
timeoutId)

  FromServerMessage
x <- ConduitParser
  FromServerMessage
  (StateT SessionState (ReaderT SessionContext IO))
  FromServerMessage
-> Session FromServerMessage
forall a.
ConduitParser
  FromServerMessage
  (StateT SessionState (ReaderT SessionContext IO))
  a
-> Session a
Session ConduitParser
  FromServerMessage
  (StateT SessionState (ReaderT SessionContext IO))
  FromServerMessage
forall (m :: * -> *) i. Monad m => ConduitParser i m i
await

  Maybe ThreadId -> (ThreadId -> Session ()) -> Session ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ThreadId
mtid ((ThreadId -> Session ()) -> Session ())
-> (ThreadId -> Session ()) -> Session ()
forall a b. (a -> b) -> a -> b
$ \ThreadId
tid -> do
    Int -> Session ()
forall (m :: * -> *).
(HasReader SessionContext m, MonadIO m) =>
Int -> m ()
bumpTimeoutId Int
timeoutId
    IO () -> Session ()
forall a. IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$ ThreadId -> IO ()
killThread ThreadId
tid

  (SessionState -> SessionState) -> Session ()
forall s (m :: * -> *). HasState s m => (s -> s) -> m ()
modify ((SessionState -> SessionState) -> Session ())
-> (SessionState -> SessionState) -> Session ()
forall a b. (a -> b) -> a -> b
$ \SessionState
s -> SessionState
s{lastReceivedMessage = Just x}

  Maybe a
res <- FromServerMessage -> Session (Maybe a)
pred FromServerMessage
x

  case Maybe a
res of
    Just a
a -> do
      LogMsgType -> FromServerMessage -> Session ()
forall a (m :: * -> *).
(ToJSON a, MonadIO m, HasReader SessionContext m) =>
LogMsgType -> a -> m ()
logMsg LogMsgType
LogServer FromServerMessage
x
      a -> Session a
forall a. a -> Session a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    Maybe a
Nothing -> Session a
forall a. Session a
forall (f :: * -> *) a. Alternative f => f a
empty

named :: T.Text -> Session a -> Session a
named :: forall a. Text -> Session a -> Session a
named Text
s (Session ConduitParser
  FromServerMessage
  (StateT SessionState (ReaderT SessionContext IO))
  a
x) = ConduitParser
  FromServerMessage
  (StateT SessionState (ReaderT SessionContext IO))
  a
-> Session a
forall a.
ConduitParser
  FromServerMessage
  (StateT SessionState (ReaderT SessionContext IO))
  a
-> Session a
Session (Text
-> ConduitParser
     FromServerMessage
     (StateT SessionState (ReaderT SessionContext IO))
     a
-> ConduitParser
     FromServerMessage
     (StateT SessionState (ReaderT SessionContext IO))
     a
forall (m :: * -> *) i a.
Monad m =>
Text -> ConduitParser i m a -> ConduitParser i m a
Data.Conduit.Parser.named Text
s ConduitParser
  FromServerMessage
  (StateT SessionState (ReaderT SessionContext IO))
  a
x)

{- | Matches a request or a notification coming from the server.
 Doesn't match Custom Messages
-}
message :: SServerMethod m -> Session (TMessage m)
message :: forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> Session (TMessage m)
message (SMethod_CustomMethod Proxy s
_) = String -> Session (TCustomMessage s 'ServerToClient t)
forall a. HasCallStack => String -> a
error String
"message can't be used with CustomMethod, use customRequest or customNotification instead"
message SServerMethod m
m1 = Text -> Session (TMessage m) -> Session (TMessage m)
forall a. Text -> Session a -> Session a
named (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Request for: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SServerMethod m -> String
forall a. Show a => a -> String
show SServerMethod m
m1) (Session (TMessage m) -> Session (TMessage m))
-> Session (TMessage m) -> Session (TMessage m)
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Maybe (TMessage m)) -> Session (TMessage m)
forall a. (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe ((FromServerMessage -> Maybe (TMessage m)) -> Session (TMessage m))
-> (FromServerMessage -> Maybe (TMessage m))
-> Session (TMessage m)
forall a b. (a -> b) -> a -> b
$ \case
  FromServerMess SMethod m
m2 TMessage m
msg -> do
    Either (CustomEq m m) (m :~~: m)
res <- SServerMethod m
-> SMethod m -> Maybe (Either (CustomEq m m) (m :~~: m))
forall {t1 :: MessageKind} {t2 :: MessageKind}
       (m1 :: Method 'ServerToClient t1)
       (m2 :: Method 'ServerToClient t2).
SServerMethod m1
-> SServerMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqServer SServerMethod m
m1 SMethod m
m2
    case Either (CustomEq m m) (m :~~: m)
res of
      Right m :~~: m
HRefl -> TMessage m -> Maybe (TMessage m)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMessage m
TMessage m
msg
      Left CustomEq m m
_f -> Maybe (TMessage m)
forall a. Maybe a
Nothing
  FromServerMessage
_ -> Maybe (TMessage m)
forall a. Maybe a
Nothing

customRequest :: KnownSymbol s => Proxy s -> Session (TMessage (Method_CustomMethod s :: Method ServerToClient Request))
customRequest :: forall (s :: Symbol).
KnownSymbol s =>
Proxy s -> Session (TMessage ('Method_CustomMethod s))
customRequest Proxy s
p =
  let m :: Text
m = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy s
p
   in Text
-> Session (TMessage ('Method_CustomMethod s))
-> Session (TMessage ('Method_CustomMethod s))
forall a. Text -> Session a -> Session a
named Text
m (Session (TMessage ('Method_CustomMethod s))
 -> Session (TMessage ('Method_CustomMethod s)))
-> Session (TMessage ('Method_CustomMethod s))
-> Session (TMessage ('Method_CustomMethod s))
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Maybe (TMessage ('Method_CustomMethod s)))
-> Session (TMessage ('Method_CustomMethod s))
forall a. (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe ((FromServerMessage -> Maybe (TMessage ('Method_CustomMethod s)))
 -> Session (TMessage ('Method_CustomMethod s)))
-> (FromServerMessage -> Maybe (TMessage ('Method_CustomMethod s)))
-> Session (TMessage ('Method_CustomMethod s))
forall a b. (a -> b) -> a -> b
$ \case
        FromServerMess SMethod m
m1 TMessage m
msg -> case SMethod m -> ServerNotOrReq m
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SMethod m
m1 of
          ServerNotOrReq m
IsServerEither -> case TMessage m
msg of
            ReqMess TRequestMessage ('Method_CustomMethod s)
_ -> case SMethod m
m1 SMethod m
-> SMethod ('Method_CustomMethod s)
-> Maybe (m :~: 'Method_CustomMethod s)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Method 'ServerToClient t)
       (b :: Method 'ServerToClient t).
SMethod a -> SMethod b -> Maybe (a :~: b)
`geq` Proxy s -> SMethod ('Method_CustomMethod s)
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod Proxy s
p of
              Just m :~: 'Method_CustomMethod s
Refl -> TCustomMessage s 'ServerToClient 'Request
-> Maybe (TCustomMessage s 'ServerToClient 'Request)
forall a. a -> Maybe a
Just TCustomMessage s 'ServerToClient 'Request
TMessage m
msg
              Maybe (m :~: 'Method_CustomMethod s)
_ -> Maybe (TCustomMessage s 'ServerToClient 'Request)
Maybe (TMessage ('Method_CustomMethod s))
forall a. Maybe a
Nothing
            TMessage m
_ -> Maybe (TCustomMessage s 'ServerToClient 'Request)
Maybe (TMessage ('Method_CustomMethod s))
forall a. Maybe a
Nothing
          ServerNotOrReq m
_ -> Maybe (TCustomMessage s 'ServerToClient 'Request)
Maybe (TMessage ('Method_CustomMethod s))
forall a. Maybe a
Nothing
        FromServerMessage
_ -> Maybe (TCustomMessage s 'ServerToClient 'Request)
Maybe (TMessage ('Method_CustomMethod s))
forall a. Maybe a
Nothing

customNotification :: KnownSymbol s => Proxy s -> Session (TMessage (Method_CustomMethod s :: Method ServerToClient Notification))
customNotification :: forall (s :: Symbol).
KnownSymbol s =>
Proxy s -> Session (TMessage ('Method_CustomMethod s))
customNotification Proxy s
p =
  let m :: Text
m = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy s
p
   in Text
-> Session (TMessage ('Method_CustomMethod s))
-> Session (TMessage ('Method_CustomMethod s))
forall a. Text -> Session a -> Session a
named Text
m (Session (TMessage ('Method_CustomMethod s))
 -> Session (TMessage ('Method_CustomMethod s)))
-> Session (TMessage ('Method_CustomMethod s))
-> Session (TMessage ('Method_CustomMethod s))
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Maybe (TMessage ('Method_CustomMethod s)))
-> Session (TMessage ('Method_CustomMethod s))
forall a. (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe ((FromServerMessage -> Maybe (TMessage ('Method_CustomMethod s)))
 -> Session (TMessage ('Method_CustomMethod s)))
-> (FromServerMessage -> Maybe (TMessage ('Method_CustomMethod s)))
-> Session (TMessage ('Method_CustomMethod s))
forall a b. (a -> b) -> a -> b
$ \case
        FromServerMess SMethod m
m1 TMessage m
msg -> case SMethod m -> ServerNotOrReq m
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SMethod m
m1 of
          ServerNotOrReq m
IsServerEither -> case TMessage m
msg of
            NotMess TNotificationMessage ('Method_CustomMethod s)
_ -> case SMethod m
m1 SMethod m
-> SMethod ('Method_CustomMethod s)
-> Maybe (m :~: 'Method_CustomMethod s)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Method 'ServerToClient t)
       (b :: Method 'ServerToClient t).
SMethod a -> SMethod b -> Maybe (a :~: b)
`geq` Proxy s -> SMethod ('Method_CustomMethod s)
forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod Proxy s
p of
              Just m :~: 'Method_CustomMethod s
Refl -> TCustomMessage s 'ServerToClient 'Notification
-> Maybe (TCustomMessage s 'ServerToClient 'Notification)
forall a. a -> Maybe a
Just TCustomMessage s 'ServerToClient 'Notification
TMessage m
msg
              Maybe (m :~: 'Method_CustomMethod s)
_ -> Maybe (TCustomMessage s 'ServerToClient 'Notification)
Maybe (TMessage ('Method_CustomMethod s))
forall a. Maybe a
Nothing
            TMessage m
_ -> Maybe (TCustomMessage s 'ServerToClient 'Notification)
Maybe (TMessage ('Method_CustomMethod s))
forall a. Maybe a
Nothing
          ServerNotOrReq m
_ -> Maybe (TCustomMessage s 'ServerToClient 'Notification)
Maybe (TMessage ('Method_CustomMethod s))
forall a. Maybe a
Nothing
        FromServerMessage
_ -> Maybe (TCustomMessage s 'ServerToClient 'Notification)
Maybe (TMessage ('Method_CustomMethod s))
forall a. Maybe a
Nothing

-- | Matches if the message is a notification.
anyNotification :: Session FromServerMessage
anyNotification :: Session FromServerMessage
anyNotification = Text -> Session FromServerMessage -> Session FromServerMessage
forall a. Text -> Session a -> Session a
named Text
"Any notification" (Session FromServerMessage -> Session FromServerMessage)
-> Session FromServerMessage -> Session FromServerMessage
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Bool) -> Session FromServerMessage
satisfy ((FromServerMessage -> Bool) -> Session FromServerMessage)
-> (FromServerMessage -> Bool) -> Session FromServerMessage
forall a b. (a -> b) -> a -> b
$ \case
  FromServerMess SMethod m
m TMessage m
msg -> case SMethod m -> ServerNotOrReq m
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SMethod m
m of
    ServerNotOrReq m
IsServerNot -> Bool
True
    ServerNotOrReq m
IsServerEither -> case TMessage m
msg of
      NotMess TNotificationMessage ('Method_CustomMethod s)
_ -> Bool
True
      TMessage m
_ -> Bool
False
    ServerNotOrReq m
_ -> Bool
False
  FromServerRsp SMethod m
_ TResponseMessage m
_ -> Bool
False

-- | Matches if the message is a request.
anyRequest :: Session FromServerMessage
anyRequest :: Session FromServerMessage
anyRequest = Text -> Session FromServerMessage -> Session FromServerMessage
forall a. Text -> Session a -> Session a
named Text
"Any request" (Session FromServerMessage -> Session FromServerMessage)
-> Session FromServerMessage -> Session FromServerMessage
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Bool) -> Session FromServerMessage
satisfy ((FromServerMessage -> Bool) -> Session FromServerMessage)
-> (FromServerMessage -> Bool) -> Session FromServerMessage
forall a b. (a -> b) -> a -> b
$ \case
  FromServerMess SMethod m
m TMessage m
_ -> case SMethod m -> ServerNotOrReq m
forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SMethod m
m of
    ServerNotOrReq m
IsServerReq -> Bool
True
    ServerNotOrReq m
_ -> Bool
False
  FromServerRsp SMethod m
_ TResponseMessage m
_ -> Bool
False

-- | Matches if the message is a response.
anyResponse :: Session FromServerMessage
anyResponse :: Session FromServerMessage
anyResponse = Text -> Session FromServerMessage -> Session FromServerMessage
forall a. Text -> Session a -> Session a
named Text
"Any response" (Session FromServerMessage -> Session FromServerMessage)
-> Session FromServerMessage -> Session FromServerMessage
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Bool) -> Session FromServerMessage
satisfy ((FromServerMessage -> Bool) -> Session FromServerMessage)
-> (FromServerMessage -> Bool) -> Session FromServerMessage
forall a b. (a -> b) -> a -> b
$ \case
  FromServerMess SMethod m
_ TMessage m
_ -> Bool
False
  FromServerRsp SMethod m
_ TResponseMessage m
_ -> Bool
True

-- | Matches a response coming from the server.
response :: SMethod (m :: Method ClientToServer Request) -> Session (TResponseMessage m)
response :: forall (m :: Method 'ClientToServer 'Request).
SMethod m -> Session (TResponseMessage m)
response SMethod m
m1 = Text
-> Session (TResponseMessage m) -> Session (TResponseMessage m)
forall a. Text -> Session a -> Session a
named (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Response for: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SMethod m -> String
forall a. Show a => a -> String
show SMethod m
m1) (Session (TResponseMessage m) -> Session (TResponseMessage m))
-> Session (TResponseMessage m) -> Session (TResponseMessage m)
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Maybe (TResponseMessage m))
-> Session (TResponseMessage m)
forall a. (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe ((FromServerMessage -> Maybe (TResponseMessage m))
 -> Session (TResponseMessage m))
-> (FromServerMessage -> Maybe (TResponseMessage m))
-> Session (TResponseMessage m)
forall a b. (a -> b) -> a -> b
$ \case
  FromServerRsp SMethod m
m2 TResponseMessage m
msg -> do
    m :~~: m
HRefl <- (SMethod m
 -> SMethod m -> Maybe (Either (CustomEq m m) (m :~~: m)))
-> SMethod m -> SMethod m -> Maybe (m :~~: m)
forall (t1 :: MessageKind) (t2 :: MessageKind)
       (f :: MessageDirection) (m1 :: Method f t1) (m2 :: Method f t2).
(t1 ~ t2) =>
(SMethod m1
 -> SMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2)))
-> SMethod m1 -> SMethod m2 -> Maybe (m1 :~~: m2)
runEq SMethod m -> SMethod m -> Maybe (Either (CustomEq m m) (m :~~: m))
forall {t1 :: MessageKind} {t2 :: MessageKind}
       (m1 :: Method 'ClientToServer t1)
       (m2 :: Method 'ClientToServer t2).
SClientMethod m1
-> SClientMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqClient SMethod m
m1 SMethod m
m2
    TResponseMessage m -> Maybe (TResponseMessage m)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TResponseMessage m
TResponseMessage m
msg
  FromServerMessage
_ -> Maybe (TResponseMessage m)
forall a. Maybe a
Nothing

-- | Like 'response', but matches a response for a specific id.
responseForId :: SMethod (m :: Method ClientToServer Request) -> LspId m -> Session (TResponseMessage m)
responseForId :: forall (m :: Method 'ClientToServer 'Request).
SMethod m -> LspId m -> Session (TResponseMessage m)
responseForId SMethod m
m LspId m
lid = Text
-> Session (TResponseMessage m) -> Session (TResponseMessage m)
forall a. Text -> Session a -> Session a
named (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Response for id: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LspId m -> String
forall a. Show a => a -> String
show LspId m
lid) (Session (TResponseMessage m) -> Session (TResponseMessage m))
-> Session (TResponseMessage m) -> Session (TResponseMessage m)
forall a b. (a -> b) -> a -> b
$ do
  (FromServerMessage -> Maybe (TResponseMessage m))
-> Session (TResponseMessage m)
forall a. (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe ((FromServerMessage -> Maybe (TResponseMessage m))
 -> Session (TResponseMessage m))
-> (FromServerMessage -> Maybe (TResponseMessage m))
-> Session (TResponseMessage m)
forall a b. (a -> b) -> a -> b
$ \FromServerMessage
msg -> do
    case FromServerMessage
msg of
      FromServerMess SMethod m
_ TMessage m
_ -> Maybe (TResponseMessage m)
forall a. Maybe a
Nothing
      FromServerRsp SMethod m
m' rspMsg :: TResponseMessage m
rspMsg@(TResponseMessage Text
_ Maybe (LspId m)
lid' Either ResponseError (MessageResult m)
_) -> do
        m :~~: m
HRefl <- (SMethod m
 -> SMethod m -> Maybe (Either (CustomEq m m) (m :~~: m)))
-> SMethod m -> SMethod m -> Maybe (m :~~: m)
forall (t1 :: MessageKind) (t2 :: MessageKind)
       (f :: MessageDirection) (m1 :: Method f t1) (m2 :: Method f t2).
(t1 ~ t2) =>
(SMethod m1
 -> SMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2)))
-> SMethod m1 -> SMethod m2 -> Maybe (m1 :~~: m2)
runEq SMethod m -> SMethod m -> Maybe (Either (CustomEq m m) (m :~~: m))
forall {t1 :: MessageKind} {t2 :: MessageKind}
       (m1 :: Method 'ClientToServer t1)
       (m2 :: Method 'ClientToServer t2).
SClientMethod m1
-> SClientMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqClient SMethod m
m SMethod m
m'
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (LspId m -> Maybe (LspId m)
forall a. a -> Maybe a
Just LspId m
lid Maybe (LspId m) -> Maybe (LspId m) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (LspId m)
Maybe (LspId m)
lid')
        TResponseMessage m -> Maybe (TResponseMessage m)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TResponseMessage m
TResponseMessage m
rspMsg

-- | Matches any type of message.
anyMessage :: Session FromServerMessage
anyMessage :: Session FromServerMessage
anyMessage = (FromServerMessage -> Bool) -> Session FromServerMessage
satisfy (Bool -> FromServerMessage -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Matches if the message is a log message notification or a show message notification/request.
loggingNotification :: Session FromServerMessage
loggingNotification :: Session FromServerMessage
loggingNotification = Text -> Session FromServerMessage -> Session FromServerMessage
forall a. Text -> Session a -> Session a
named Text
"Logging notification" (Session FromServerMessage -> Session FromServerMessage)
-> Session FromServerMessage -> Session FromServerMessage
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Bool) -> Session FromServerMessage
satisfy FromServerMessage -> Bool
forall {a :: Method 'ClientToServer 'Request -> *}.
FromServerMessage' a -> Bool
shouldSkip
 where
  shouldSkip :: FromServerMessage' a -> Bool
shouldSkip (FromServerMess SMethod m
SMethod_WindowLogMessage TMessage m
_) = Bool
True
  shouldSkip (FromServerMess SMethod m
SMethod_WindowShowMessage TMessage m
_) = Bool
True
  shouldSkip (FromServerMess SMethod m
SMethod_WindowShowMessageRequest TMessage m
_) = Bool
True
  shouldSkip (FromServerMess SMethod m
SMethod_WindowShowDocument TMessage m
_) = Bool
True
  shouldSkip FromServerMessage' a
_ = Bool
False

-- | Matches if the message is a configuration request from the server.
configurationRequest :: Session FromServerMessage
configurationRequest :: Session FromServerMessage
configurationRequest = Text -> Session FromServerMessage -> Session FromServerMessage
forall a. Text -> Session a -> Session a
named Text
"Configuration request" (Session FromServerMessage -> Session FromServerMessage)
-> Session FromServerMessage -> Session FromServerMessage
forall a b. (a -> b) -> a -> b
$ (FromServerMessage -> Bool) -> Session FromServerMessage
satisfy FromServerMessage -> Bool
forall {a :: Method 'ClientToServer 'Request -> *}.
FromServerMessage' a -> Bool
shouldSkip
 where
  shouldSkip :: FromServerMessage' a -> Bool
shouldSkip (FromServerMess SMethod m
SMethod_WorkspaceConfiguration TMessage m
_) = Bool
True
  shouldSkip FromServerMessage' a
_ = Bool
False

loggingOrConfiguration :: Session FromServerMessage
loggingOrConfiguration :: Session FromServerMessage
loggingOrConfiguration = Session FromServerMessage
loggingNotification Session FromServerMessage
-> Session FromServerMessage -> Session FromServerMessage
forall a. Session a -> Session a -> Session a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Session FromServerMessage
configurationRequest

{- | Matches a 'Language.LSP.Types.TextDocumentPublishDiagnostics'
 (textDocument/publishDiagnostics) notification.
-}
publishDiagnosticsNotification :: Session (TMessage Method_TextDocumentPublishDiagnostics)
publishDiagnosticsNotification :: Session (TMessage 'Method_TextDocumentPublishDiagnostics)
publishDiagnosticsNotification = Text
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall a. Text -> Session a -> Session a
named Text
"Publish diagnostics notification" (Session (TMessage 'Method_TextDocumentPublishDiagnostics)
 -> Session (TMessage 'Method_TextDocumentPublishDiagnostics))
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall a b. (a -> b) -> a -> b
$
  (FromServerMessage
 -> Maybe (TMessage 'Method_TextDocumentPublishDiagnostics))
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall a. (FromServerMessage -> Maybe a) -> Session a
satisfyMaybe ((FromServerMessage
  -> Maybe (TMessage 'Method_TextDocumentPublishDiagnostics))
 -> Session (TMessage 'Method_TextDocumentPublishDiagnostics))
-> (FromServerMessage
    -> Maybe (TMessage 'Method_TextDocumentPublishDiagnostics))
-> Session (TMessage 'Method_TextDocumentPublishDiagnostics)
forall a b. (a -> b) -> a -> b
$ \FromServerMessage
msg -> case FromServerMessage
msg of
    FromServerMess SMethod m
SMethod_TextDocumentPublishDiagnostics TMessage m
diags -> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Maybe
     (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall a. a -> Maybe a
Just TMessage m
TNotificationMessage 'Method_TextDocumentPublishDiagnostics
diags
    FromServerMessage
_ -> Maybe (TMessage 'Method_TextDocumentPublishDiagnostics)
Maybe (TNotificationMessage 'Method_TextDocumentPublishDiagnostics)
forall a. Maybe a
Nothing