diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for haskell-lsp-types +## 0.8.3.0 + +* Add `MarkupContent` to `HoverResponse`, and (some) json roundtrip tests. + ## 0.8.2.0 -- 2019-04-11 * Add `applyTextEdit` and `editTextEdit` helpers diff --git a/haskell-lsp-types.cabal b/haskell-lsp-types.cabal --- a/haskell-lsp-types.cabal +++ b/haskell-lsp-types.cabal @@ -1,5 +1,5 @@ name: haskell-lsp-types -version: 0.8.2.0 +version: 0.9.0.0 synopsis: Haskell library for the Microsoft Language Server Protocol, data types description: An implementation of the types to allow language implementors to diff --git a/src/Language/Haskell/LSP/Types/DataTypesJSON.hs b/src/Language/Haskell/LSP/Types/DataTypesJSON.hs --- a/src/Language/Haskell/LSP/Types/DataTypesJSON.hs +++ b/src/Language/Haskell/LSP/Types/DataTypesJSON.hs @@ -5,7 +5,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -18,14 +17,15 @@ import Data.Aeson.Types import Data.Text (Text) import qualified Data.Text as T +import Language.Haskell.LSP.Types.ClientCapabilities import Language.Haskell.LSP.Types.Command import Language.Haskell.LSP.Types.Constants -import Language.Haskell.LSP.Types.ClientCapabilities import Language.Haskell.LSP.Types.Diagnostic import Language.Haskell.LSP.Types.DocumentFilter import Language.Haskell.LSP.Types.List -import Language.Haskell.LSP.Types.Message import Language.Haskell.LSP.Types.Location +import Language.Haskell.LSP.Types.MarkupContent +import Language.Haskell.LSP.Types.Message import Language.Haskell.LSP.Types.Symbol import Language.Haskell.LSP.Types.TextDocument import Language.Haskell.LSP.Types.Uri @@ -499,7 +499,7 @@ * * Since 3.10.0 */ - foldingRangeProvider?: boolean | FoldingRangeProviderOptions | (FoldingRangeProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions); + foldingRangeProvider?: boolean | FoldingRangeProviderOptions | (FoldingRangeProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions); /** * The server provides execute command support. */ @@ -544,7 +544,7 @@ instance FromJSON TDS where parseJSON x = TDSOptions <$> parseJSON x <|> TDSKind <$> parseJSON x - + instance ToJSON TDS where toJSON (TDSOptions x) = toJSON x toJSON (TDSKind x) = toJSON x @@ -553,7 +553,7 @@ | GotoOptionsDynamic { -- | A document selector to identify the scope of the registration. If set to null -- the document selector provided on the client side will be used. - _documentSelector :: Maybe DocumentSelector + _documentSelector :: Maybe DocumentSelector -- | The id used to register the request. The id can be used to deregister -- the request again. See also Registration#id. , _id :: Maybe Text @@ -624,7 +624,7 @@ deriving (Show, Read, Eq) deriveJSON lspOptions ''WorkspaceOptions - + data InitializeResponseCapabilitiesInner = InitializeResponseCapabilitiesInner { -- | Defines how text documents are synced. Is either a detailed structure @@ -1232,19 +1232,19 @@ method: ‘workspace/configuration’ params: ConfigurationParams defined as follows export interface ConfigurationParams { - items: ConfigurationItem[]; + items: ConfigurationItem[]; } export interface ConfigurationItem { - /** - * The scope to get the configuration section for. - */ - scopeUri?: string; + /** + * The scope to get the configuration section for. + */ + scopeUri?: string; - /** - * The configuration section asked for. - */ - section?: string; + /** + * The configuration section asked for. + */ + section?: string; } Response: @@ -1731,26 +1731,28 @@ result: Hover | null defined as follows: + /** - * The result of a hove request. + * The result of a hover request. */ interface Hover { - /** - * The hover's content - */ - contents: MarkedString | MarkedString[]; + /** + * The hover's content + */ + contents: MarkedString | MarkedString[] | MarkupContent; - /** - * An optional range - */ - range?: Range; + /** + * An optional range is a range inside a text document + * that is used to visualize a hover, e.g. by changing the background color. + */ + range?: Range; } -Where MarkedString is defined as follows: + /** * MarkedString can be used to render human readable text. It is either a markdown string * or a code-block that provides a language and a code snippet. The language identifier - * is sematically equal to the optional language identifier in fenced code blocks in GitHub + * is semantically equal to the optional language identifier in fenced code blocks in GitHub * issues. See https://help.github.com/articles/creating-and-highlighting-code-blocks/#syntax-highlighting * * The pair of a language and a value is an equivalent to markdown: @@ -1759,7 +1761,8 @@ * ``` * * Note that markdown strings will be sanitized - that means html will be escaped. - */ +* @deprecated use MarkupContent instead. +*/ type MarkedString = string | { language: string; value: string }; error: code and message set in case an exception happens during the hover @@ -1777,6 +1780,7 @@ deriveJSON lspOptions ''LanguageString +{-# DEPRECATED MarkedString, PlainString, CodeString "Use MarkupContent instead, since 3.3.0 (11/24/2017)" #-} data MarkedString = PlainString T.Text | CodeString LanguageString @@ -1789,9 +1793,52 @@ parseJSON (A.String t) = pure $ PlainString t parseJSON o = CodeString <$> parseJSON o +-- ------------------------------------- + +data HoverContents = + HoverContentsMS (List MarkedString) + | HoverContents MarkupContent + | HoverContentsEmpty + deriving (Read,Show,Eq) + +instance ToJSON HoverContents where + toJSON (HoverContentsMS x) = toJSON x + toJSON (HoverContents x) = toJSON x + toJSON (HoverContentsEmpty) = A.Null +instance FromJSON HoverContents where + parseJSON v@(A.String _) = HoverContentsMS <$> parseJSON v + parseJSON (A.Null) = pure HoverContentsEmpty + parseJSON v@(A.Array _) = HoverContentsMS <$> parseJSON v + parseJSON v@(A.Object _) = HoverContents <$> parseJSON v + <|> HoverContentsMS <$> parseJSON v + parseJSON _ = mempty + +-- ------------------------------------- + +#if __GLASGOW_HASKELL__ >= 804 +instance Semigroup HoverContents where + (<>) = mappend +#endif + +instance Monoid HoverContents where + mempty = HoverContentsEmpty + + HoverContentsEmpty `mappend` hc = hc + hc `mappend` HoverContentsEmpty = hc + HoverContents h1 `mappend` HoverContents h2 = HoverContents (h1 `mappend` h2) + HoverContents h1 `mappend` HoverContentsMS (List h2s) = HoverContents (mconcat (h1: (map toMarkupContent h2s))) + HoverContentsMS (List h1s) `mappend` HoverContents h2 = HoverContents (mconcat ((map toMarkupContent h1s) ++ [h2])) + HoverContentsMS (List h1s) `mappend` HoverContentsMS (List h2s) = HoverContentsMS (List (h1s `mappend` h2s)) + +toMarkupContent :: MarkedString -> MarkupContent +toMarkupContent (PlainString s) = unmarkedUpContent s +toMarkupContent (CodeString (LanguageString lang s)) = markedUpContent lang s + +-- ------------------------------------- + data Hover = Hover - { _contents :: List MarkedString + { _contents :: HoverContents , _range :: Maybe Range } deriving (Read,Show,Eq) @@ -2852,4 +2899,3 @@ } deriving (Show, Read, Eq) deriveJSON lspOptions ''TraceNotification - diff --git a/src/Language/Haskell/LSP/Types/MarkupContent.hs b/src/Language/Haskell/LSP/Types/MarkupContent.hs --- a/src/Language/Haskell/LSP/Types/MarkupContent.hs +++ b/src/Language/Haskell/LSP/Types/MarkupContent.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} @@ -11,6 +12,7 @@ import Data.Aeson import Data.Aeson.TH +import Data.Semigroup import Data.Text (Text) import Language.Haskell.LSP.Types.Constants @@ -23,15 +25,15 @@ * are reserved for internal usage. */ export namespace MarkupKind { - /** - * Plain text is supported as a content format - */ - export const PlainText: 'plaintext' = 'plaintext'; + /** + * Plain text is supported as a content format + */ + export const PlainText: 'plaintext' = 'plaintext'; - /** - * Markdown is supported as a content format - */ - export const Markdown: 'markdown' = 'markdown'; + /** + * Markdown is supported as a content format + */ + export const Markdown: 'markdown' = 'markdown'; } export type MarkupKind = 'plaintext' | 'markdown'; -} @@ -78,15 +80,15 @@ * remove HTML from the markdown to avoid script execution. */ export interface MarkupContent { - /** - * The type of the Markup - */ - kind: MarkupKind; + /** + * The type of the Markup + */ + kind: MarkupKind; - /** - * The content itself - */ - value: string; + /** + * The content itself + */ + value: string; } -} @@ -120,3 +122,37 @@ deriving (Read, Show, Eq) deriveJSON lspOptions ''MarkupContent + +-- --------------------------------------------------------------------- + +-- | Create a 'MarkupContent' containing a quoted language string only. +markedUpContent :: Text -> Text -> MarkupContent +markedUpContent lang quote + = MarkupContent MkMarkdown ("```" <> lang <> "\n" <> quote <> "\n```\n") + +-- --------------------------------------------------------------------- + +-- | Create a 'MarkupContent' containing unquoted text +unmarkedUpContent :: Text -> MarkupContent +unmarkedUpContent str = MarkupContent MkPlainText str + +-- --------------------------------------------------------------------- + +-- | Markdown for a section separator in Markdown, being a horizontal line +sectionSeparator :: Text +sectionSeparator = "*\t*\t*\n" + +-- --------------------------------------------------------------------- + +#if __GLASGOW_HASKELL__ >= 804 +instance Semigroup MarkupContent where + (<>) = mappend +#endif + +instance Monoid MarkupContent where + mempty = MarkupContent MkPlainText "" + MarkupContent MkPlainText s1 `mappend` MarkupContent MkPlainText s2 = MarkupContent MkPlainText (s1 `mappend` s2) + MarkupContent MkMarkdown s1 `mappend` MarkupContent _ s2 = MarkupContent MkMarkdown (s1 `mappend` s2) + MarkupContent _ s1 `mappend` MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown (s1 `mappend` s2) + +-- ---------------------------------------------------------------------