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
   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 (RspTypeDefinition           _) = True
  17 isServerResponse (RspFindReferences           _) = True
  18 isServerResponse (RspDocumentHighlights       _) = True
  19 isServerResponse (RspDocumentSymbols          _) = True
  20 isServerResponse (RspWorkspaceSymbols         _) = True
  21 isServerResponse (RspCodeAction               _) = True
  22 isServerResponse (RspCodeLens                 _) = True
  23 isServerResponse (RspCodeLensResolve          _) = True
  24 isServerResponse (RspDocumentFormatting       _) = True
  25 isServerResponse (RspDocumentRangeFormatting  _) = True
  26 isServerResponse (RspDocumentOnTypeFormatting _) = True
  27 isServerResponse (RspRename                   _) = True
  28 isServerResponse (RspExecuteCommand           _) = True
  29 isServerResponse (RspError                    _) = True
  30 isServerResponse (RspDocumentLink             _) = True
  31 isServerResponse (RspDocumentLinkResolve      _) = True
  32 isServerResponse (RspWillSaveWaitUntil        _) = True
  33 isServerResponse _                               = False
  34
  35 isServerRequest :: FromServerMessage -> Bool
  36 isServerRequest (ReqRegisterCapability       _) = True
  37 isServerRequest (ReqApplyWorkspaceEdit       _) = True
  38 isServerRequest (ReqShowMessage              _) = True
  39 isServerRequest (ReqUnregisterCapability     _) = True
  40 isServerRequest _                               = False
  41
  42 isServerNotification :: FromServerMessage -> Bool
  43 isServerNotification (NotPublishDiagnostics       _) = True
  44 isServerNotification (NotLogMessage               _) = True
  45 isServerNotification (NotShowMessage              _) = True
  46 isServerNotification (NotTelemetry                _) = True
  47 isServerNotification (NotCancelRequestFromServer  _) = True
  48 isServerNotification _                               = False
  49
  50 handleServerMessage
  51     :: forall a.
  52        (forall b c. RequestMessage ServerMethod b c -> a)
  53     -> (forall d. ResponseMessage d -> a)
  54     -> (forall e. NotificationMessage ServerMethod e -> a)
  55     -> FromServerMessage
  56     -> a
  57 handleServerMessage request response notification msg = case msg of
  58     (ReqRegisterCapability       m) -> request m
  59     (ReqApplyWorkspaceEdit       m) -> request m
  60     (ReqShowMessage              m) -> request m
  61     (ReqUnregisterCapability     m) -> request m
  62     (ReqCustomServer             m) -> request m
  63     (ReqWorkDoneProgressCreate   m) -> request m
  64     (RspInitialize               m) -> response m
  65     (RspShutdown                 m) -> response m
  66     (RspHover                    m) -> response m
  67     (RspCompletion               m) -> response m
  68     (RspCompletionItemResolve    m) -> response m
  69     (RspSignatureHelp            m) -> response m
  70     (RspDefinition               m) -> response m
  71     (RspFindReferences           m) -> response m
  72     (RspDocumentHighlights       m) -> response m
  73     (RspDocumentSymbols          m) -> response m
  74     (RspWorkspaceSymbols         m) -> response m
  75     (RspCodeAction               m) -> response m
  76     (RspCodeLens                 m) -> response m
  77     (RspCodeLensResolve          m) -> response m
  78     (RspDocumentFormatting       m) -> response m
  79     (RspDocumentRangeFormatting  m) -> response m
  80     (RspDocumentOnTypeFormatting m) -> response m
  81     (RspRename                   m) -> response m
  82     (RspExecuteCommand           m) -> response m
  83     (RspError                    m) -> response m
  84     (RspDocumentLink             m) -> response m
  85     (RspDocumentLinkResolve      m) -> response m
  86     (RspWillSaveWaitUntil        m) -> response m
  87     (RspTypeDefinition           m) -> response m
  88     (RspImplementation           m) -> response m
  89     (RspDocumentColor            m) -> response m
  90     (RspColorPresentation        m) -> response m
  91     (RspFoldingRange             m) -> response m
  92     (RspCustomServer             m) -> response m
  93     (NotPublishDiagnostics       m) -> notification m
  94     (NotLogMessage               m) -> notification m
  95     (NotShowMessage              m) -> notification m
  96     (NotWorkDoneProgressBegin    m) -> notification m
  97     (NotWorkDoneProgressReport   m) -> notification m
  98     (NotWorkDoneProgressEnd      m) -> notification m
  99     (NotTelemetry                m) -> notification m
 100     (NotCancelRequestFromServer  m) -> notification m
 101     (NotCustomServer             m) -> notification m
 102
 103 handleClientMessage
 104     :: forall a.
 105        (forall b c . (ToJSON b, ToJSON c) => RequestMessage ClientMethod b c -> a)
 106     -> (forall d . ToJSON d => ResponseMessage d -> a)
 107     -> (forall e . ToJSON e => NotificationMessage ClientMethod e -> a)
 108     -> FromClientMessage
 109     -> a
 110 handleClientMessage request response notification msg = case msg of
 111  (ReqInitialize               m) -> request m
 112  (ReqShutdown                 m) -> request m
 113  (ReqHover                    m) -> request m
 114  (ReqCompletion               m) -> request m
 115  (ReqCompletionItemResolve    m) -> request m
 116  (ReqSignatureHelp            m) -> request m
 117  (ReqDefinition               m) -> request m
 118  (ReqFindReferences           m) -> request m
 119  (ReqDocumentHighlights       m) -> request m
 120  (ReqDocumentSymbols          m) -> request m
 121  (ReqWorkspaceSymbols         m) -> request m
 122  (ReqCodeAction               m) -> request m
 123  (ReqCodeLens                 m) -> request m
 124  (ReqCodeLensResolve          m) -> request m
 125  (ReqDocumentFormatting       m) -> request m
 126  (ReqDocumentRangeFormatting  m) -> request m
 127  (ReqDocumentOnTypeFormatting m) -> request m
 128  (ReqPrepareRename            m) -> request m
 129  (ReqRename                   m) -> request m
 130  (ReqExecuteCommand           m) -> request m
 131  (ReqDocumentLink             m) -> request m
 132  (ReqDocumentLinkResolve      m) -> request m
 133  (ReqWillSaveWaitUntil        m) -> request m
 134  (ReqImplementation           m) -> request m
 135  (ReqTypeDefinition           m) -> request m
 136  (ReqDocumentColor            m) -> request m
 137  (ReqColorPresentation        m) -> request m
 138  (ReqFoldingRange             m) -> request m
 139  (RspApplyWorkspaceEdit       m) -> response m
 140  (RspFromClient               m) -> response m
 141  (NotInitialized              m) -> notification m
 142  (NotExit                     m) -> notification m
 143  (NotCancelRequestFromClient  m) -> notification m
 144  (NotDidChangeConfiguration   m) -> notification m
 145  (NotDidOpenTextDocument      m) -> notification m
 146  (NotDidChangeTextDocument    m) -> notification m
 147  (NotDidCloseTextDocument     m) -> notification m
 148  (NotWillSaveTextDocument     m) -> notification m
 149  (NotDidSaveTextDocument      m) -> notification m
 150  (NotDidChangeWatchedFiles    m) -> notification m
 151  (NotDidChangeWorkspaceFolders m) -> notification m
 152  (NotWorkDoneProgressCancel    m) -> notification m
 153  (ReqCustomClient             m) -> request m
 154  (NotCustomClient             m) -> notification m