Skip to content

Commit e782320

Browse files
alanzalanz
authored
Merge pull request #148 from alanz/hover-reply
 Add MarkupContent to HoverResponse
2 parents cd94c9b + 3004608 commit e782320

12 files changed

+256
-60
lines changed

‎ChangeLog.md

+4
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# Revision history for haskell-lsp
22

3+
## 0.9.0.0
4+
5+
* Add `MarkupContent` to `HoverResponse`, and (some) json roundtrip tests.
6+
37
## 0.8.2.0 -- 2019-04-11
48

59
* Add `applyTextEdit` and `editTextEdit` helpers

‎example/Main.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -238,7 +238,7 @@ reactor lf inp = do
238238

239239
let
240240
ht = Just $ J.Hover ms (Just range)
241-
ms = J.List [J.CodeString $ J.LanguageString "lsp-hello" "TYPE INFO" ]
241+
ms = J.HoverContentsMS $ J.List [J.CodeString $ J.LanguageString "lsp-hello" "TYPE INFO" ]
242242
range = J.Range pos pos
243243
reactorSend $ RspHover $ Core.makeResponseMessage req ht
244244

‎haskell-lsp-types/ChangeLog.md

+4
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,9 @@
11
# Revision history for haskell-lsp-types
22

3+
## 0.8.3.0
4+
5+
* Add `MarkupContent` to `HoverResponse`, and (some) json roundtrip tests.
6+
37
## 0.8.2.0 -- 2019-04-11
48

59
* Add `applyTextEdit` and `editTextEdit` helpers

‎haskell-lsp-types/haskell-lsp-types.cabal

+1-1
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: haskell-lsp-types
2-
version: 0.8.2.0
2+
version: 0.9.0.0
33
synopsis: Haskell library for the Microsoft Language Server Protocol, data types
44

55
description: An implementation of the types to allow language implementors to

‎haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs

+77-31
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,6 @@
55
{-# LANGUAGE FlexibleInstances #-}
66
{-# LANGUAGE FunctionalDependencies #-}
77
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
8-
{-# LANGUAGE MultiParamTypeClasses #-}
98
{-# LANGUAGE OverloadedStrings #-}
109
{-# LANGUAGE TemplateHaskell #-}
1110
{-# LANGUAGE TypeSynonymInstances #-}
@@ -18,14 +17,15 @@ import Data.Aeson.TH
1817
import Data.Aeson.Types
1918
import Data.Text (Text)
2019
import qualified Data.Text as T
20+
import Language.Haskell.LSP.Types.ClientCapabilities
2121
import Language.Haskell.LSP.Types.Command
2222
import Language.Haskell.LSP.Types.Constants
23-
import Language.Haskell.LSP.Types.ClientCapabilities
2423
import Language.Haskell.LSP.Types.Diagnostic
2524
import Language.Haskell.LSP.Types.DocumentFilter
2625
import Language.Haskell.LSP.Types.List
27-
import Language.Haskell.LSP.Types.Message
2826
import Language.Haskell.LSP.Types.Location
27+
import Language.Haskell.LSP.Types.MarkupContent
28+
import Language.Haskell.LSP.Types.Message
2929
import Language.Haskell.LSP.Types.Symbol
3030
import Language.Haskell.LSP.Types.TextDocument
3131
import Language.Haskell.LSP.Types.Uri
@@ -499,7 +499,7 @@ interface ServerCapabilities {
499499
*
500500
* Since 3.10.0
501501
*/
502-
foldingRangeProvider?: boolean | FoldingRangeProviderOptions | (FoldingRangeProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions);
502+
foldingRangeProvider?: boolean | FoldingRangeProviderOptions | (FoldingRangeProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions);
503503
/**
504504
* The server provides execute command support.
505505
*/
@@ -544,7 +544,7 @@ data TDS = TDSOptions TextDocumentSyncOptions
544544

545545
instance FromJSON TDS where
546546
parseJSON x = TDSOptions <$> parseJSON x <|> TDSKind <$> parseJSON x
547-
547+
548548
instance ToJSON TDS where
549549
toJSON (TDSOptions x) = toJSON x
550550
toJSON (TDSKind x) = toJSON x
@@ -553,7 +553,7 @@ data GotoOptions = GotoOptionsStatic Bool
553553
| GotoOptionsDynamic
554554
{ -- | A document selector to identify the scope of the registration. If set to null
555555
-- the document selector provided on the client side will be used.
556-
_documentSelector :: Maybe DocumentSelector
556+
_documentSelector :: Maybe DocumentSelector
557557
-- | The id used to register the request. The id can be used to deregister
558558
-- the request again. See also Registration#id.
559559
, _id :: Maybe Text
@@ -624,7 +624,7 @@ data WorkspaceOptions =
624624
deriving (Show, Read, Eq)
625625

626626
deriveJSON lspOptions ''WorkspaceOptions
627-
627+
628628
data InitializeResponseCapabilitiesInner =
629629
InitializeResponseCapabilitiesInner
630630
{ -- | Defines how text documents are synced. Is either a detailed structure
@@ -1232,19 +1232,19 @@ Request:
12321232
method: ‘workspace/configuration’
12331233
params: ConfigurationParams defined as follows
12341234
export interface ConfigurationParams {
1235-
items: ConfigurationItem[];
1235+
items: ConfigurationItem[];
12361236
}
12371237
12381238
export interface ConfigurationItem {
1239-
/**
1240-
* The scope to get the configuration section for.
1241-
*/
1242-
scopeUri?: string;
1243-
1244-
/**
1245-
* The configuration section asked for.
1246-
*/
1247-
section?: string;
1239+
/**
1240+
* The scope to get the configuration section for.
1241+
*/
1242+
scopeUri?: string;
1243+
1244+
/**
1245+
* The configuration section asked for.
1246+
*/
1247+
section?: string;
12481248
}
12491249
Response:
12501250
@@ -1731,26 +1731,28 @@ Response
17311731
17321732
result: Hover | null defined as follows:
17331733
1734+
17341735
/**
1735-
* The result of a hove request.
1736+
* The result of a hover request.
17361737
*/
17371738
interface Hover {
1738-
/**
1739-
* The hover's content
1740-
*/
1741-
contents: MarkedString | MarkedString[];
1739+
/**
1740+
* The hover's content
1741+
*/
1742+
contents: MarkedString | MarkedString[] | MarkupContent;
17421743
1743-
/**
1744-
* An optional range
1745-
*/
1746-
range?: Range;
1744+
/**
1745+
* An optional range is a range inside a text document
1746+
* that is used to visualize a hover, e.g. by changing the background color.
1747+
*/
1748+
range?: Range;
17471749
}
17481750
1749-
Where MarkedString is defined as follows:
1751+
17501752
/**
17511753
* MarkedString can be used to render human readable text. It is either a markdown string
17521754
* or a code-block that provides a language and a code snippet. The language identifier
1753-
* is sematically equal to the optional language identifier in fenced code blocks in GitHub
1755+
* is semantically equal to the optional language identifier in fenced code blocks in GitHub
17541756
* issues. See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting
17551757
*
17561758
* The pair of a language and a value is an equivalent to markdown:
@@ -1759,7 +1761,8 @@ Where MarkedString is defined as follows:
17591761
* ```
17601762
*
17611763
* Note that markdown strings will be sanitized - that means html will be escaped.
1762-
*/
1764+
* @deprecated use MarkupContent instead.
1765+
*/
17631766
type MarkedString = string | { language: string; value: string };
17641767
17651768
error: code and message set in case an exception happens during the hover
@@ -1777,6 +1780,7 @@ data LanguageString =
17771780

17781781
deriveJSON lspOptions ''LanguageString
17791782

1783+
{-# DEPRECATED MarkedString, PlainString, CodeString "Use MarkupContent instead, since 3.3.0 (11/24/2017)" #-}
17801784
data MarkedString =
17811785
PlainString T.Text
17821786
| CodeString LanguageString
@@ -1789,9 +1793,52 @@ instance FromJSON MarkedString where
17891793
parseJSON (A.String t) = pure $ PlainString t
17901794
parseJSON o = CodeString <$> parseJSON o
17911795

1796+
-- -------------------------------------
1797+
1798+
data HoverContents =
1799+
HoverContentsMS (List MarkedString)
1800+
| HoverContents MarkupContent
1801+
| HoverContentsEmpty
1802+
deriving (Read,Show,Eq)
1803+
1804+
instance ToJSON HoverContents where
1805+
toJSON (HoverContentsMS x) = toJSON x
1806+
toJSON (HoverContents x) = toJSON x
1807+
toJSON (HoverContentsEmpty) = A.Null
1808+
instance FromJSON HoverContents where
1809+
parseJSON v@(A.String _) = HoverContentsMS <$> parseJSON v
1810+
parseJSON (A.Null) = pure HoverContentsEmpty
1811+
parseJSON v@(A.Array _) = HoverContentsMS <$> parseJSON v
1812+
parseJSON v@(A.Object _) = HoverContents <$> parseJSON v
1813+
<|> HoverContentsMS <$> parseJSON v
1814+
parseJSON _ = mempty
1815+
1816+
-- -------------------------------------
1817+
1818+
#if __GLASGOW_HASKELL__ >= 804
1819+
instance Semigroup HoverContents where
1820+
(<>) = mappend
1821+
#endif
1822+
1823+
instance Monoid HoverContents where
1824+
mempty = HoverContentsEmpty
1825+
1826+
HoverContentsEmpty `mappend` hc = hc
1827+
hc `mappend` HoverContentsEmpty = hc
1828+
HoverContents h1 `mappend` HoverContents h2 = HoverContents (h1 `mappend` h2)
1829+
HoverContents h1 `mappend` HoverContentsMS (List h2s) = HoverContents (mconcat (h1: (map toMarkupContent h2s)))
1830+
HoverContentsMS (List h1s) `mappend` HoverContents h2 = HoverContents (mconcat ((map toMarkupContent h1s) ++ [h2]))
1831+
HoverContentsMS (List h1s) `mappend` HoverContentsMS (List h2s) = HoverContentsMS (List (h1s `mappend` h2s))
1832+
1833+
toMarkupContent :: MarkedString -> MarkupContent
1834+
toMarkupContent (PlainString s) = unmarkedUpContent s
1835+
toMarkupContent (CodeString (LanguageString lang s)) = markedUpContent lang s
1836+
1837+
-- -------------------------------------
1838+
17921839
data Hover =
17931840
Hover
1794-
{ _contents :: List MarkedString
1841+
{ _contents :: HoverContents
17951842
, _range :: Maybe Range
17961843
} deriving (Read,Show,Eq)
17971844

@@ -2852,4 +2899,3 @@ data TraceNotification =
28522899
} deriving (Show, Read, Eq)
28532900

28542901
deriveJSON lspOptions ''TraceNotification
2855-

‎haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs

+54-18
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE CPP #-}
12
{-# LANGUAGE DuplicateRecordFields #-}
23
{-# LANGUAGE OverloadedStrings #-}
34
{-# LANGUAGE TemplateHaskell #-}
@@ -11,6 +12,7 @@ module Language.Haskell.LSP.Types.MarkupContent where
1112

1213
import Data.Aeson
1314
import Data.Aeson.TH
15+
import Data.Semigroup
1416
import Data.Text (Text)
1517
import Language.Haskell.LSP.Types.Constants
1618

@@ -23,15 +25,15 @@ import Language.Haskell.LSP.Types.Constants
2325
* are reserved for internal usage.
2426
*/
2527
export namespace MarkupKind {
26-
/**
27-
* Plain text is supported as a content format
28-
*/
29-
export const PlainText: 'plaintext' = 'plaintext';
30-
31-
/**
32-
* Markdown is supported as a content format
33-
*/
34-
export const Markdown: 'markdown' = 'markdown';
28+
/**
29+
* Plain text is supported as a content format
30+
*/
31+
export const PlainText: 'plaintext' = 'plaintext';
32+
33+
/**
34+
* Markdown is supported as a content format
35+
*/
36+
export const Markdown: 'markdown' = 'markdown';
3537
}
3638
export type MarkupKind = 'plaintext' | 'markdown';
3739
-}
@@ -78,15 +80,15 @@ instance FromJSON MarkupKind where
7880
* remove HTML from the markdown to avoid script execution.
7981
*/
8082
export interface MarkupContent {
81-
/**
82-
* The type of the Markup
83-
*/
84-
kind: MarkupKind;
85-
86-
/**
87-
* The content itself
88-
*/
89-
value: string;
83+
/**
84+
* The type of the Markup
85+
*/
86+
kind: MarkupKind;
87+
88+
/**
89+
* The content itself
90+
*/
91+
value: string;
9092
}
9193
-}
9294

@@ -120,3 +122,37 @@ data MarkupContent =
120122
deriving (Read, Show, Eq)
121123

122124
deriveJSON lspOptions ''MarkupContent
125+
126+
-- ---------------------------------------------------------------------
127+
128+
-- | Create a 'MarkupContent' containing a quoted language string only.
129+
markedUpContent :: Text -> Text -> MarkupContent
130+
markedUpContent lang quote
131+
= MarkupContent MkMarkdown ("```" <> lang <> "\n" <> quote <> "\n```\n")
132+
133+
-- ---------------------------------------------------------------------
134+
135+
-- | Create a 'MarkupContent' containing unquoted text
136+
unmarkedUpContent :: Text -> MarkupContent
137+
unmarkedUpContent str = MarkupContent MkPlainText str
138+
139+
-- ---------------------------------------------------------------------
140+
141+
-- | Markdown for a section separator in Markdown, being a horizontal line
142+
sectionSeparator :: Text
143+
sectionSeparator = "*\t*\t*\n"
144+
145+
-- ---------------------------------------------------------------------
146+
147+
#if __GLASGOW_HASKELL__ >= 804
148+
instance Semigroup MarkupContent where
149+
(<>) = mappend
150+
#endif
151+
152+
instance Monoid MarkupContent where
153+
mempty = MarkupContent MkPlainText ""
154+
MarkupContent MkPlainText s1 `mappend` MarkupContent MkPlainText s2 = MarkupContent MkPlainText (s1 `mappend` s2)
155+
MarkupContent MkMarkdown s1 `mappend` MarkupContent _ s2 = MarkupContent MkMarkdown (s1 `mappend` s2)
156+
MarkupContent _ s1 `mappend` MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown (s1 `mappend` s2)
157+
158+
-- ---------------------------------------------------------------------

0 commit comments

Comments
 (0)