src/Language/Haskell/LSP/Test/Messages.hs

   1 {-# LANGUAGE RankNTypes #-}
   2 module Language.Haskell.LSP.Test.Messages where
   3
   4 import Data.Aeson
   5 import Language.Haskell.LSP.Messages
   6 import Language.Haskell.LSP.Types hiding (error)
   7
   8 isServerResponse :: FromServerMessage -> Bool
   9 isServerResponse (RspInitialize               _) = True
  10 isServerResponse (RspShutdown                 _) = True
  11 isServerResponse (RspHover                    _) = True
  12 isServerResponse (RspCompletion               _) = True
  13 isServerResponse (RspCompletionItemResolve    _) = True
  14 isServerResponse (RspSignatureHelp            _) = True
  15 isServerResponse (RspDefinition               _) = True
  16 isServerResponse (RspFindReferences           _) = True
  17 isServerResponse (RspDocumentHighlights       _) = True
  18 isServerResponse (RspDocumentSymbols          _) = True
  19 isServerResponse (RspWorkspaceSymbols         _) = True
  20 isServerResponse (RspCodeAction               _) = True
  21 isServerResponse (RspCodeLens                 _) = True
  22 isServerResponse (RspCodeLensResolve          _) = True
  23 isServerResponse (RspDocumentFormatting       _) = True
  24 isServerResponse (RspDocumentRangeFormatting  _) = True
  25 isServerResponse (RspDocumentOnTypeFormatting _) = True
  26 isServerResponse (RspRename                   _) = True
  27 isServerResponse (RspExecuteCommand           _) = True
  28 isServerResponse (RspError                    _) = True
  29 isServerResponse (RspDocumentLink             _) = True
  30 isServerResponse (RspDocumentLinkResolve      _) = True
  31 isServerResponse (RspWillSaveWaitUntil        _) = True
  32 isServerResponse _                               = False
  33
  34 isServerRequest :: FromServerMessage -> Bool
  35 isServerRequest (ReqRegisterCapability       _) = True
  36 isServerRequest (ReqApplyWorkspaceEdit       _) = True
  37 isServerRequest (ReqShowMessage              _) = True
  38 isServerRequest (ReqUnregisterCapability     _) = True
  39 isServerRequest _                               = False
  40
  41 isServerNotification :: FromServerMessage -> Bool
  42 isServerNotification (NotPublishDiagnostics       _) = True
  43 isServerNotification (NotLogMessage               _) = True
  44 isServerNotification (NotShowMessage              _) = True
  45 isServerNotification (NotTelemetry                _) = True
  46 isServerNotification (NotCancelRequestFromServer  _) = True
  47 isServerNotification _                               = False
  48
  49 handleServerMessage
  50     :: forall a.
  51        (forall b c. RequestMessage ServerMethod b c -> a)
  52     -> (forall d. ResponseMessage d -> a)
  53     -> (forall e. NotificationMessage ServerMethod e -> a)
  54     -> FromServerMessage
  55     -> a
  56 handleServerMessage request response notification msg = case msg of
  57     (ReqRegisterCapability       m) -> request m
  58     (ReqApplyWorkspaceEdit       m) -> request m
  59     (ReqShowMessage              m) -> request m
  60     (ReqUnregisterCapability     m) -> request m
  61     (RspInitialize               m) -> response m
  62     (RspShutdown                 m) -> response m
  63     (RspHover                    m) -> response m
  64     (RspCompletion               m) -> response m
  65     (RspCompletionItemResolve    m) -> response m
  66     (RspSignatureHelp            m) -> response m
  67     (RspDefinition               m) -> response m
  68     (RspFindReferences           m) -> response m
  69     (RspDocumentHighlights       m) -> response m
  70     (RspDocumentSymbols          m) -> response m
  71     (RspWorkspaceSymbols         m) -> response m
  72     (RspCodeAction               m) -> response m
  73     (RspCodeLens                 m) -> response m
  74     (RspCodeLensResolve          m) -> response m
  75     (RspDocumentFormatting       m) -> response m
  76     (RspDocumentRangeFormatting  m) -> response m
  77     (RspDocumentOnTypeFormatting m) -> response m
  78     (RspRename                   m) -> response m
  79     (RspExecuteCommand           m) -> response m
  80     (RspError                    m) -> response m
  81     (RspDocumentLink             m) -> response m
  82     (RspDocumentLinkResolve      m) -> response m
  83     (RspWillSaveWaitUntil        m) -> response m
  84     (RspTypeDefinition           m) -> response m
  85     (RspImplementation           m) -> response m
  86     (RspDocumentColor            m) -> response m
  87     (RspColorPresentation        m) -> response m
  88     (RspFoldingRange             m) -> response m
  89     (NotPublishDiagnostics       m) -> notification m
  90     (NotLogMessage               m) -> notification m
  91     (NotShowMessage              m) -> notification m
  92     (NotTelemetry                m) -> notification m
  93     (NotCancelRequestFromServer  m) -> notification m
  94
  95 handleClientMessage
  96     :: forall a.
  97        (forall b c . (ToJSON b, ToJSON c) => RequestMessage ClientMethod b c -> a)
  98     -> (forall d . ToJSON d => ResponseMessage d -> a)
  99     -> (forall e . ToJSON e => NotificationMessage ClientMethod e -> a)
 100     -> FromClientMessage
 101     -> a
 102 handleClientMessage request response notification msg = case msg of
 103  (ReqInitialize               m) -> request m
 104  (ReqShutdown                 m) -> request m
 105  (ReqHover                    m) -> request m
 106  (ReqCompletion               m) -> request m
 107  (ReqCompletionItemResolve    m) -> request m
 108  (ReqSignatureHelp            m) -> request m
 109  (ReqDefinition               m) -> request m
 110  (ReqFindReferences           m) -> request m
 111  (ReqDocumentHighlights       m) -> request m
 112  (ReqDocumentSymbols          m) -> request m
 113  (ReqWorkspaceSymbols         m) -> request m
 114  (ReqCodeAction               m) -> request m
 115  (ReqCodeLens                 m) -> request m
 116  (ReqCodeLensResolve          m) -> request m
 117  (ReqDocumentFormatting       m) -> request m
 118  (ReqDocumentRangeFormatting  m) -> request m
 119  (ReqDocumentOnTypeFormatting m) -> request m
 120  (ReqRename                   m) -> request m
 121  (ReqExecuteCommand           m) -> request m
 122  (ReqDocumentLink             m) -> request m
 123  (ReqDocumentLinkResolve      m) -> request m
 124  (ReqWillSaveWaitUntil        m) -> request m
 125  (ReqImplementation           m) -> request m
 126  (ReqTypeDefinition           m) -> request m
 127  (ReqDocumentColor            m) -> request m
 128  (ReqColorPresentation        m) -> request m
 129  (ReqFoldingRange             m) -> request m
 130  (RspApplyWorkspaceEdit       m) -> response m
 131  (RspFromClient               m) -> response m
 132  (NotInitialized              m) -> notification m
 133  (NotExit                     m) -> notification m
 134  (NotCancelRequestFromClient  m) -> notification m
 135  (NotDidChangeConfiguration   m) -> notification m
 136  (NotDidOpenTextDocument      m) -> notification m
 137  (NotDidChangeTextDocument    m) -> notification m
 138  (NotDidCloseTextDocument     m) -> notification m
 139  (NotWillSaveTextDocument     m) -> notification m
 140  (NotDidSaveTextDocument      m) -> notification m
 141  (NotDidChangeWatchedFiles    m) -> notification m
 142  (NotDidChangeWorkspaceFolders m) -> notification m
 143  (UnknownFromClientMessage    m) -> error $ "Unknown message sent from client: " ++ show m