+ setSGR [SetColor Foreground Vivid Cyan]
+ putStrLn $ "--> " ++ B.unpack encoded
+ setSGR [Reset]
+
+ B.hPut h (addHeader encoded)
+
+
+
+-- | Returns the initialize response that was received from the server.
+-- The initialize requests and responses are not included the session,
+-- so if you need to test it use this.
+initializeResponse :: Session InitializeResponse
+initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
+
+-- | Opens a text document and sends a notification to the client.
+openDoc :: FilePath -> String -> Session TextDocumentIdentifier
+openDoc file languageId = do
+ item <- getDocItem file languageId
+ sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams item)
+ TextDocumentIdentifier <$> getDocUri file
+ where
+ -- | Reads in a text document as the first version.
+ getDocItem :: FilePath -- ^ The path to the text document to read in.
+ -> String -- ^ The language ID, e.g "haskell" for .hs files.
+ -> Session TextDocumentItem
+ getDocItem file languageId = do
+ context <- ask
+ let fp = rootDir context </> file
+ contents <- liftIO $ T.readFile fp
+ return $ TextDocumentItem (filePathToUri fp) (T.pack languageId) 0 contents
+
+-- | Gets the Uri for the file corrected to the session directory.
+getDocUri :: FilePath -> Session Uri
+getDocUri file = do
+ context <- ask
+ let fp = rootDir context </> file
+ return $ filePathToUri fp
+
+waitForDiagnostics :: Session [Diagnostic]
+waitForDiagnostics = do
+ diagsNot <- skipManyTill anyMessage notification :: Session PublishDiagnosticsNotification
+ let (List diags) = diagsNot ^. params . LSP.diagnostics
+ return diags
+
+-- | Expects a 'PublishDiagnosticsNotification' and throws an
+-- 'UnexpectedDiagnosticsException' if there are any diagnostics
+-- returned.
+noDiagnostics :: Session ()
+noDiagnostics = do
+ diagsNot <- notification :: Session PublishDiagnosticsNotification
+ when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnosticsException
+
+-- | Returns the symbols in a document.
+getDocumentSymbols :: TextDocumentIdentifier -> Session [SymbolInformation]
+getDocumentSymbols doc = do
+ ResponseMessage _ rspLid mRes mErr <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
+ maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr
+ let (Just (List symbols)) = mRes
+ return symbols
+
+getAllCodeActions :: TextDocumentIdentifier -> Session [CommandOrCodeAction]
+getAllCodeActions doc = do
+ curDiags <- fromMaybe [] . Map.lookup (doc ^. uri) . curDiagnostics <$> get
+ let ctx = CodeActionContext (List curDiags) Nothing
+
+ foldM (go ctx) [] curDiags
+
+ where
+ go :: CodeActionContext -> [CommandOrCodeAction] -> Diagnostic -> Session [CommandOrCodeAction]
+ go ctx acc diag = do
+ ResponseMessage _ rspLid mRes mErr <- sendRequest TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx)
+
+ case mErr of
+ Just e -> throw (UnexpectedResponseError rspLid e)
+ Nothing ->
+ let Just (List cmdOrCAs) = mRes
+ in return (acc ++ cmdOrCAs)
\ No newline at end of file