{-# LANGUAGE OverloadedStrings #-}
module Language.Haskell.LSP.Test.Decoding where
import Prelude hiding ( id )
import Data.Aeson
import Data.Foldable
import Control.Exception
import Control.Lens
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import System.IO
import System.IO.Error
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Lens
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Test.Exceptions
import qualified Data.HashMap.Strict as HM
getAllMessages :: Handle -> IO [B.ByteString]
getAllMessages :: Handle -> IO [ByteString]
getAllMessages Handle
h = do
Bool
done <- Handle -> IO Bool
hIsEOF Handle
h
if Bool
done
then [ByteString] -> IO [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return []
else do
ByteString
msg <- Handle -> IO ByteString
getNextMessage Handle
h
(ByteString
msg ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO [ByteString]
getAllMessages Handle
h
getNextMessage :: Handle -> IO B.ByteString
getNextMessage :: Handle -> IO ByteString
getNextMessage Handle
h = do
[(String, String)]
headers <- Handle -> IO [(String, String)]
getHeaders Handle
h
case String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (String -> String) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
init (String -> Int) -> Maybe String -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"Content-Length" [(String, String)]
headers of
Maybe Int
Nothing -> SessionException -> IO ByteString
forall a e. Exception e => e -> a
throw SessionException
NoContentLengthHeader
Just Int
size -> Handle -> Int -> IO ByteString
B.hGet Handle
h Int
size
addHeader :: B.ByteString -> B.ByteString
ByteString
content = [ByteString] -> ByteString
B.concat
[ ByteString
"Content-Length: "
, String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> Int64 -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
B.length ByteString
content
, ByteString
"\r\n"
, ByteString
"\r\n"
, ByteString
content
]
getHeaders :: Handle -> IO [(String, String)]
Handle
h = do
String
l <- IO String -> (IOError -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (Handle -> IO String
hGetLine Handle
h) IOError -> IO String
forall p. IOError -> p
eofHandler
let (String
name, String
val) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') String
l
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
val then [(String, String)] -> IO [(String, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else ((String
name, Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
2 String
val) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
:) ([(String, String)] -> [(String, String)])
-> IO [(String, String)] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO [(String, String)]
getHeaders Handle
h
where eofHandler :: IOError -> p
eofHandler IOError
e
| IOError -> Bool
isEOFError IOError
e = SessionException -> p
forall a e. Exception e => e -> a
throw SessionException
UnexpectedServerTermination
| Bool
otherwise = IOError -> p
forall a e. Exception e => e -> a
throw IOError
e
type RequestMap = HM.HashMap LspId ClientMethod
newRequestMap :: RequestMap
newRequestMap :: RequestMap
newRequestMap = RequestMap
forall k v. HashMap k v
HM.empty
updateRequestMap :: RequestMap -> LspId -> ClientMethod -> RequestMap
updateRequestMap :: RequestMap -> LspId -> ClientMethod -> RequestMap
updateRequestMap RequestMap
reqMap LspId
id ClientMethod
method = LspId -> ClientMethod -> RequestMap -> RequestMap
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert LspId
id ClientMethod
method RequestMap
reqMap
getRequestMap :: [FromClientMessage] -> RequestMap
getRequestMap :: [FromClientMessage] -> RequestMap
getRequestMap = (RequestMap -> FromClientMessage -> RequestMap)
-> RequestMap -> [FromClientMessage] -> RequestMap
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl RequestMap -> FromClientMessage -> RequestMap
helper RequestMap
forall k v. HashMap k v
HM.empty
where
helper :: RequestMap -> FromClientMessage -> RequestMap
helper RequestMap
acc FromClientMessage
msg = case FromClientMessage
msg of
(ReqInitialize InitializeRequest
val) -> InitializeRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert InitializeRequest
val RequestMap
acc
(ReqShutdown ShutdownRequest
val) -> ShutdownRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert ShutdownRequest
val RequestMap
acc
(ReqHover HoverRequest
val) -> HoverRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert HoverRequest
val RequestMap
acc
(ReqCompletion CompletionRequest
val) -> CompletionRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert CompletionRequest
val RequestMap
acc
(ReqCompletionItemResolve CompletionItemResolveRequest
val) -> CompletionItemResolveRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert CompletionItemResolveRequest
val RequestMap
acc
(ReqSignatureHelp SignatureHelpRequest
val) -> SignatureHelpRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert SignatureHelpRequest
val RequestMap
acc
(ReqDefinition DefinitionRequest
val) -> DefinitionRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DefinitionRequest
val RequestMap
acc
(ReqTypeDefinition DefinitionRequest
val) -> DefinitionRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DefinitionRequest
val RequestMap
acc
(ReqFindReferences ReferencesRequest
val) -> ReferencesRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert ReferencesRequest
val RequestMap
acc
(ReqDocumentHighlights DocumentHighlightRequest
val) -> DocumentHighlightRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DocumentHighlightRequest
val RequestMap
acc
(ReqDocumentSymbols DocumentSymbolRequest
val) -> DocumentSymbolRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DocumentSymbolRequest
val RequestMap
acc
(ReqWorkspaceSymbols WorkspaceSymbolRequest
val) -> WorkspaceSymbolRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert WorkspaceSymbolRequest
val RequestMap
acc
(ReqCodeAction CodeActionRequest
val) -> CodeActionRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert CodeActionRequest
val RequestMap
acc
(ReqCodeLens CodeLensRequest
val) -> CodeLensRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert CodeLensRequest
val RequestMap
acc
(ReqCodeLensResolve CodeLensResolveRequest
val) -> CodeLensResolveRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert CodeLensResolveRequest
val RequestMap
acc
(ReqDocumentFormatting DocumentFormattingRequest
val) -> DocumentFormattingRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DocumentFormattingRequest
val RequestMap
acc
(ReqDocumentRangeFormatting DocumentRangeFormattingRequest
val) -> DocumentRangeFormattingRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DocumentRangeFormattingRequest
val RequestMap
acc
(ReqDocumentOnTypeFormatting DocumentOnTypeFormattingRequest
val) -> DocumentOnTypeFormattingRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DocumentOnTypeFormattingRequest
val RequestMap
acc
(ReqRename RenameRequest
val) -> RenameRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert RenameRequest
val RequestMap
acc
(ReqExecuteCommand ExecuteCommandRequest
val) -> ExecuteCommandRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert ExecuteCommandRequest
val RequestMap
acc
(ReqDocumentLink DocumentLinkRequest
val) -> DocumentLinkRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DocumentLinkRequest
val RequestMap
acc
(ReqDocumentLinkResolve DocumentLinkResolveRequest
val) -> DocumentLinkResolveRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert DocumentLinkResolveRequest
val RequestMap
acc
(ReqWillSaveWaitUntil WillSaveWaitUntilTextDocumentRequest
val) -> WillSaveWaitUntilTextDocumentRequest -> RequestMap -> RequestMap
forall k s v.
(Eq k, Hashable k, HasId s k, HasMethod s v) =>
s -> HashMap k v -> HashMap k v
insert WillSaveWaitUntilTextDocumentRequest
val RequestMap
acc
FromClientMessage
_ -> RequestMap
acc
insert :: s -> HashMap k v -> HashMap k v
insert s
m = k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (s
m s -> Getting k s k -> k
forall s a. s -> Getting a s a -> a
^. Getting k s k
forall s a. HasId s a => Lens' s a
id) (s
m s -> Getting v s v -> v
forall s a. s -> Getting a s a -> a
^. Getting v s v
forall s a. HasMethod s a => Lens' s a
method)
matchResponseMsgType :: ClientMethod -> B.ByteString -> FromServerMessage
matchResponseMsgType :: ClientMethod -> ByteString -> FromServerMessage
matchResponseMsgType ClientMethod
req = case ClientMethod
req of
ClientMethod
Initialize -> InitializeResponse -> FromServerMessage
RspInitialize (InitializeResponse -> FromServerMessage)
-> (ByteString -> InitializeResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> InitializeResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
Shutdown -> ShutdownResponse -> FromServerMessage
RspShutdown (ShutdownResponse -> FromServerMessage)
-> (ByteString -> ShutdownResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShutdownResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentHover -> HoverResponse -> FromServerMessage
RspHover (HoverResponse -> FromServerMessage)
-> (ByteString -> HoverResponse) -> ByteString -> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HoverResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentCompletion -> CompletionResponse -> FromServerMessage
RspCompletion (CompletionResponse -> FromServerMessage)
-> (ByteString -> CompletionResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CompletionResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
CompletionItemResolve -> CompletionItemResolveResponse -> FromServerMessage
RspCompletionItemResolve (CompletionItemResolveResponse -> FromServerMessage)
-> (ByteString -> CompletionItemResolveResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CompletionItemResolveResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentSignatureHelp -> SignatureHelpResponse -> FromServerMessage
RspSignatureHelp (SignatureHelpResponse -> FromServerMessage)
-> (ByteString -> SignatureHelpResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SignatureHelpResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentDefinition -> DefinitionResponse -> FromServerMessage
RspDefinition (DefinitionResponse -> FromServerMessage)
-> (ByteString -> DefinitionResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DefinitionResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentTypeDefinition -> DefinitionResponse -> FromServerMessage
RspTypeDefinition (DefinitionResponse -> FromServerMessage)
-> (ByteString -> DefinitionResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DefinitionResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentReferences -> ReferencesResponse -> FromServerMessage
RspFindReferences (ReferencesResponse -> FromServerMessage)
-> (ByteString -> ReferencesResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ReferencesResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentDocumentHighlight -> DocumentHighlightsResponse -> FromServerMessage
RspDocumentHighlights (DocumentHighlightsResponse -> FromServerMessage)
-> (ByteString -> DocumentHighlightsResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DocumentHighlightsResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentDocumentSymbol -> DocumentSymbolsResponse -> FromServerMessage
RspDocumentSymbols (DocumentSymbolsResponse -> FromServerMessage)
-> (ByteString -> DocumentSymbolsResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DocumentSymbolsResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
WorkspaceSymbol -> WorkspaceSymbolsResponse -> FromServerMessage
RspWorkspaceSymbols (WorkspaceSymbolsResponse -> FromServerMessage)
-> (ByteString -> WorkspaceSymbolsResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> WorkspaceSymbolsResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentCodeAction -> CodeActionResponse -> FromServerMessage
RspCodeAction (CodeActionResponse -> FromServerMessage)
-> (ByteString -> CodeActionResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CodeActionResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentCodeLens -> CodeLensResponse -> FromServerMessage
RspCodeLens (CodeLensResponse -> FromServerMessage)
-> (ByteString -> CodeLensResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CodeLensResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
CodeLensResolve -> CodeLensResolveResponse -> FromServerMessage
RspCodeLensResolve (CodeLensResolveResponse -> FromServerMessage)
-> (ByteString -> CodeLensResolveResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CodeLensResolveResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentFormatting -> DocumentFormattingResponse -> FromServerMessage
RspDocumentFormatting (DocumentFormattingResponse -> FromServerMessage)
-> (ByteString -> DocumentFormattingResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DocumentFormattingResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentRangeFormatting -> DocumentFormattingResponse -> FromServerMessage
RspDocumentRangeFormatting (DocumentFormattingResponse -> FromServerMessage)
-> (ByteString -> DocumentFormattingResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DocumentFormattingResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentOnTypeFormatting -> DocumentFormattingResponse -> FromServerMessage
RspDocumentOnTypeFormatting (DocumentFormattingResponse -> FromServerMessage)
-> (ByteString -> DocumentFormattingResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DocumentFormattingResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentRename -> RenameResponse -> FromServerMessage
RspRename (RenameResponse -> FromServerMessage)
-> (ByteString -> RenameResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> RenameResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
WorkspaceExecuteCommand -> ExecuteCommandResponse -> FromServerMessage
RspExecuteCommand (ExecuteCommandResponse -> FromServerMessage)
-> (ByteString -> ExecuteCommandResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ExecuteCommandResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentDocumentLink -> DocumentLinkResponse -> FromServerMessage
RspDocumentLink (DocumentLinkResponse -> FromServerMessage)
-> (ByteString -> DocumentLinkResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DocumentLinkResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
DocumentLinkResolve -> DocumentLinkResolveResponse -> FromServerMessage
RspDocumentLinkResolve (DocumentLinkResolveResponse -> FromServerMessage)
-> (ByteString -> DocumentLinkResolveResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DocumentLinkResolveResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
TextDocumentWillSaveWaitUntil -> DocumentFormattingResponse -> FromServerMessage
RspWillSaveWaitUntil (DocumentFormattingResponse -> FromServerMessage)
-> (ByteString -> DocumentFormattingResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> DocumentFormattingResponse
forall a. FromJSON a => ByteString -> a
decoded
CustomClientMethod{} -> ExecuteCommandResponse -> FromServerMessage
RspCustomServer (ExecuteCommandResponse -> FromServerMessage)
-> (ByteString -> ExecuteCommandResponse)
-> ByteString
-> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ExecuteCommandResponse
forall a. FromJSON a => ByteString -> a
decoded
ClientMethod
x -> String -> FromServerMessage
forall a. HasCallStack => String -> a
error (String -> FromServerMessage)
-> (ByteString -> String) -> ByteString -> FromServerMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ClientMethod -> String
forall a. Show a => a -> String
show ClientMethod
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is not a request: ") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show
where decoded :: ByteString -> a
decoded ByteString
x = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Couldn't decode response for the request type: "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ ClientMethod -> String
forall a. Show a => a -> String
show ClientMethod
req String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
x)
(ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
x)
decodeFromServerMsg :: RequestMap -> B.ByteString -> FromServerMessage
decodeFromServerMsg :: RequestMap -> ByteString -> FromServerMessage
decodeFromServerMsg RequestMap
reqMap ByteString
bytes =
case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"method" HashMap Text Value
obj of
Just Value
methodStr -> case Value -> Result ServerMethod
forall a. FromJSON a => Value -> Result a
fromJSON Value
methodStr of
Success ServerMethod
method -> case ServerMethod
method of
ServerMethod
TextDocumentPublishDiagnostics -> PublishDiagnosticsNotification -> FromServerMessage
NotPublishDiagnostics (PublishDiagnosticsNotification -> FromServerMessage)
-> PublishDiagnosticsNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe PublishDiagnosticsNotification
-> PublishDiagnosticsNotification
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PublishDiagnosticsNotification
-> PublishDiagnosticsNotification)
-> Maybe PublishDiagnosticsNotification
-> PublishDiagnosticsNotification
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe PublishDiagnosticsNotification
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
WindowShowMessage -> ShowMessageNotification -> FromServerMessage
NotShowMessage (ShowMessageNotification -> FromServerMessage)
-> ShowMessageNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe ShowMessageNotification -> ShowMessageNotification
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ShowMessageNotification -> ShowMessageNotification)
-> Maybe ShowMessageNotification -> ShowMessageNotification
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ShowMessageNotification
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
WindowLogMessage -> LogMessageNotification -> FromServerMessage
NotLogMessage (LogMessageNotification -> FromServerMessage)
-> LogMessageNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe LogMessageNotification -> LogMessageNotification
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe LogMessageNotification -> LogMessageNotification)
-> Maybe LogMessageNotification -> LogMessageNotification
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe LogMessageNotification
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
CancelRequestServer -> CancelNotificationServer -> FromServerMessage
NotCancelRequestFromServer (CancelNotificationServer -> FromServerMessage)
-> CancelNotificationServer -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe CancelNotificationServer -> CancelNotificationServer
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe CancelNotificationServer -> CancelNotificationServer)
-> Maybe CancelNotificationServer -> CancelNotificationServer
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe CancelNotificationServer
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
Progress ->
Maybe FromServerMessage -> FromServerMessage
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe FromServerMessage -> FromServerMessage)
-> Maybe FromServerMessage -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ [Maybe FromServerMessage] -> Maybe FromServerMessage
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [WorkDoneProgressBeginNotification -> FromServerMessage
NotWorkDoneProgressBegin (WorkDoneProgressBeginNotification -> FromServerMessage)
-> Maybe WorkDoneProgressBeginNotification
-> Maybe FromServerMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe WorkDoneProgressBeginNotification
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes, WorkDoneProgressReportNotification -> FromServerMessage
NotWorkDoneProgressReport (WorkDoneProgressReportNotification -> FromServerMessage)
-> Maybe WorkDoneProgressReportNotification
-> Maybe FromServerMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe WorkDoneProgressReportNotification
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes, WorkDoneProgressEndNotification -> FromServerMessage
NotWorkDoneProgressEnd (WorkDoneProgressEndNotification -> FromServerMessage)
-> Maybe WorkDoneProgressEndNotification -> Maybe FromServerMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe WorkDoneProgressEndNotification
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes]
ServerMethod
WindowWorkDoneProgressCreate -> WorkDoneProgressCreateRequest -> FromServerMessage
ReqWorkDoneProgressCreate (WorkDoneProgressCreateRequest -> FromServerMessage)
-> WorkDoneProgressCreateRequest -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe WorkDoneProgressCreateRequest
-> WorkDoneProgressCreateRequest
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe WorkDoneProgressCreateRequest
-> WorkDoneProgressCreateRequest)
-> Maybe WorkDoneProgressCreateRequest
-> WorkDoneProgressCreateRequest
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe WorkDoneProgressCreateRequest
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
TelemetryEvent -> TelemetryNotification -> FromServerMessage
NotTelemetry (TelemetryNotification -> FromServerMessage)
-> TelemetryNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe TelemetryNotification -> TelemetryNotification
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TelemetryNotification -> TelemetryNotification)
-> Maybe TelemetryNotification -> TelemetryNotification
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe TelemetryNotification
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
WindowShowMessageRequest -> ShowMessageRequest -> FromServerMessage
ReqShowMessage (ShowMessageRequest -> FromServerMessage)
-> ShowMessageRequest -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe ShowMessageRequest -> ShowMessageRequest
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ShowMessageRequest -> ShowMessageRequest)
-> Maybe ShowMessageRequest -> ShowMessageRequest
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ShowMessageRequest
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
ClientRegisterCapability -> RegisterCapabilityRequest -> FromServerMessage
ReqRegisterCapability (RegisterCapabilityRequest -> FromServerMessage)
-> RegisterCapabilityRequest -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe RegisterCapabilityRequest -> RegisterCapabilityRequest
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe RegisterCapabilityRequest -> RegisterCapabilityRequest)
-> Maybe RegisterCapabilityRequest -> RegisterCapabilityRequest
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe RegisterCapabilityRequest
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
ClientUnregisterCapability -> UnregisterCapabilityRequest -> FromServerMessage
ReqUnregisterCapability (UnregisterCapabilityRequest -> FromServerMessage)
-> UnregisterCapabilityRequest -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe UnregisterCapabilityRequest -> UnregisterCapabilityRequest
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UnregisterCapabilityRequest -> UnregisterCapabilityRequest)
-> Maybe UnregisterCapabilityRequest -> UnregisterCapabilityRequest
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe UnregisterCapabilityRequest
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
WorkspaceApplyEdit -> ApplyWorkspaceEditRequest -> FromServerMessage
ReqApplyWorkspaceEdit (ApplyWorkspaceEditRequest -> FromServerMessage)
-> ApplyWorkspaceEditRequest -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe ApplyWorkspaceEditRequest -> ApplyWorkspaceEditRequest
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ApplyWorkspaceEditRequest -> ApplyWorkspaceEditRequest)
-> Maybe ApplyWorkspaceEditRequest -> ApplyWorkspaceEditRequest
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ApplyWorkspaceEditRequest
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
ServerMethod
WorkspaceWorkspaceFolders -> String -> FromServerMessage
forall a. HasCallStack => String -> a
error String
"ReqWorkspaceFolders not supported yet"
ServerMethod
WorkspaceConfiguration -> String -> FromServerMessage
forall a. HasCallStack => String -> a
error String
"ReqWorkspaceConfiguration not supported yet"
CustomServerMethod Text
_
| Text
"id" Text -> HashMap Text Value -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap Text Value
obj Bool -> Bool -> Bool
&& Text
"method" Text -> HashMap Text Value -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap Text Value
obj -> CustomServerRequest -> FromServerMessage
ReqCustomServer (CustomServerRequest -> FromServerMessage)
-> CustomServerRequest -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe CustomServerRequest -> CustomServerRequest
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe CustomServerRequest -> CustomServerRequest)
-> Maybe CustomServerRequest -> CustomServerRequest
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe CustomServerRequest
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
| Text
"id" Text -> HashMap Text Value -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
`HM.member` HashMap Text Value
obj -> ExecuteCommandResponse -> FromServerMessage
RspCustomServer (ExecuteCommandResponse -> FromServerMessage)
-> ExecuteCommandResponse -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe ExecuteCommandResponse -> ExecuteCommandResponse
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ExecuteCommandResponse -> ExecuteCommandResponse)
-> Maybe ExecuteCommandResponse -> ExecuteCommandResponse
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ExecuteCommandResponse
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
| Bool
otherwise -> TelemetryNotification -> FromServerMessage
NotCustomServer (TelemetryNotification -> FromServerMessage)
-> TelemetryNotification -> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Maybe TelemetryNotification -> TelemetryNotification
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TelemetryNotification -> TelemetryNotification)
-> Maybe TelemetryNotification -> TelemetryNotification
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe TelemetryNotification
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes
Error String
e -> String -> FromServerMessage
forall a. HasCallStack => String -> a
error String
e
Maybe Value
Nothing -> case ByteString -> Maybe ExecuteCommandResponse
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes :: Maybe (ResponseMessage Value) of
Just ExecuteCommandResponse
msg -> case LspId -> RequestMap -> Maybe ClientMethod
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup (LspIdRsp -> LspId
requestId (LspIdRsp -> LspId) -> LspIdRsp -> LspId
forall a b. (a -> b) -> a -> b
$ ExecuteCommandResponse
msg ExecuteCommandResponse
-> Getting LspIdRsp ExecuteCommandResponse LspIdRsp -> LspIdRsp
forall s a. s -> Getting a s a -> a
^. Getting LspIdRsp ExecuteCommandResponse LspIdRsp
forall s a. HasId s a => Lens' s a
id) RequestMap
reqMap of
Just ClientMethod
req -> ClientMethod -> ByteString -> FromServerMessage
matchResponseMsgType ClientMethod
req ByteString
bytes
Maybe ClientMethod
Nothing -> String -> FromServerMessage
forall a. HasCallStack => String -> a
error String
"Couldn't match up response with request"
Maybe ExecuteCommandResponse
Nothing -> String -> FromServerMessage
forall a. HasCallStack => String -> a
error String
"Couldn't decode message"
where obj :: HashMap Text Value
obj = Maybe (HashMap Text Value) -> HashMap Text Value
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (HashMap Text Value) -> HashMap Text Value)
-> Maybe (HashMap Text Value) -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (HashMap Text Value)
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
bytes :: Object