haskell-lsp-types 0.21.0.0 → 0.22.0.0

raw patch · 8 files changed

+227/−154 lines, 8 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +3/−0
• haskell-lsp-types.cabal +4/−3
• src/Language/Haskell/LSP/Types.hs +2/−0
• src/Language/Haskell/LSP/Types/DataTypesJSON.hs +0/−134
• src/Language/Haskell/LSP/Types/Hover.hs +151/−0
• src/Language/Haskell/LSP/Types/Lens.hs +1/−0
• src/Language/Haskell/LSP/Types/MarkupContent.hs +1/−0
• src/Language/Haskell/LSP/Types/Message.hs +65/−17

@@ -1,5 +1,8 @@ # Revision history for haskell-lsp-types +* ResponseMessage results are now an Either type (@greenhat)+* Support for GHC 8.10.1+ ## 0.21.0.0  * Stop getCompletionPrefix from crashing if beforePos is empty

@@ -1,5 +1,5 @@ name:                haskell-lsp-types-version:             0.21.0.0+version:             0.22.0.0 synopsis:            Haskell library for the Microsoft Language Server Protocol, data types  description:         An implementation of the types to allow language implementors to@@ -10,7 +10,7 @@ license-file:        LICENSE author:              Alan Zimmerman maintainer:          alan.zimm@gmail.com-copyright:           Alan Zimmerman, 2016-2018+copyright:           Alan Zimmerman, 2016-2020 category:            Development build-type:          Simple extra-source-files:  ChangeLog.md, README.md@@ -32,6 +32,7 @@                      , Language.Haskell.LSP.Types.Diagnostic                      , Language.Haskell.LSP.Types.DocumentFilter                      , Language.Haskell.LSP.Types.FoldingRange+                     , Language.Haskell.LSP.Types.Hover                      , Language.Haskell.LSP.Types.List                      , Language.Haskell.LSP.Types.Location                      , Language.Haskell.LSP.Types.MarkupContent@@ -46,7 +47,7 @@  -- other-extensions:   ghc-options:         -Wall   -- ghc-options:         -Werror-  build-depends:       base >= 4.9 && < 4.14+  build-depends:       base >= 4.9 && < 4.15                      , aeson >=1.2.2.0                      , binary                      , bytestring

@@ -7,6 +7,7 @@   , module Language.Haskell.LSP.Types.Diagnostic   , module Language.Haskell.LSP.Types.DocumentFilter   , module Language.Haskell.LSP.Types.FoldingRange+  , module Language.Haskell.LSP.Types.Hover   , module Language.Haskell.LSP.Types.List   , module Language.Haskell.LSP.Types.Location   , module Language.Haskell.LSP.Types.MarkupContent@@ -29,6 +30,7 @@ import           Language.Haskell.LSP.Types.Diagnostic import           Language.Haskell.LSP.Types.DocumentFilter import           Language.Haskell.LSP.Types.FoldingRange+import           Language.Haskell.LSP.Types.Hover import           Language.Haskell.LSP.Types.List import           Language.Haskell.LSP.Types.Location import           Language.Haskell.LSP.Types.MarkupContent

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP                        #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE DeriveTraversable          #-} {-# LANGUAGE DuplicateRecordFields      #-}@@ -28,7 +27,6 @@ import           Language.Haskell.LSP.Types.DocumentFilter import           Language.Haskell.LSP.Types.List import           Language.Haskell.LSP.Types.Location-import           Language.Haskell.LSP.Types.MarkupContent import           Language.Haskell.LSP.Types.Message import           Language.Haskell.LSP.Types.Progress import           Language.Haskell.LSP.Types.Symbol@@ -1725,138 +1723,6 @@   type PublishDiagnosticsNotification = NotificationMessage ServerMethod PublishDiagnosticsParams---- ----------------------------------------------------------------------{--Hover Request--The hover request is sent from the client to the server to request hover-information at a given text document position.--    Changed: In 2.0 the request uses TextDocumentPositionParams with a proper-    textDocument and position property. In 1.0 the uri of the referenced text-    document was inlined into the params object.--Request--    method: 'textDocument/hover'-    params: TextDocumentPositionParams--Response--    result: Hover | null defined as follows:---/**- * The result of a hover request.- */-interface Hover {-        /**-         * The hover's content-         */-        contents: MarkedString | MarkedString[] | MarkupContent;--        /**-         * 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;-}---/**- * 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 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:- * ```${language}- * ${value}- * ```- *- * 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-    request.--Registration Options: TextDocumentRegistrationOptions---}--data LanguageString =-  LanguageString-    { _language :: Text-    , _value    :: Text-    } deriving (Read,Show,Eq)--deriveJSON lspOptions ''LanguageString--{-# DEPRECATED MarkedString, PlainString, CodeString "Use MarkupContent instead, since 3.3.0 (11/24/2017)" #-}-data MarkedString =-    PlainString T.Text-  | CodeString LanguageString-    deriving (Eq,Read,Show)--instance ToJSON MarkedString where-  toJSON (PlainString x) = toJSON x-  toJSON (CodeString  x) = toJSON x-instance FromJSON MarkedString where-  parseJSON (A.String t) = pure $ PlainString t-  parseJSON o            = CodeString <$> parseJSON o---- ---------------------------------------data HoverContents =-    HoverContentsMS (List MarkedString)-  | HoverContents   MarkupContent-  deriving (Read,Show,Eq)--instance ToJSON HoverContents where-  toJSON (HoverContentsMS  x) = toJSON x-  toJSON (HoverContents    x) = toJSON x-instance FromJSON HoverContents where-  parseJSON v@(A.String _) = HoverContentsMS <$> parseJSON v-  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 = HoverContentsMS (List [])--  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 :: HoverContents-    , _range    :: Maybe Range-    } deriving (Read,Show,Eq)--deriveJSON lspOptions ''Hover---type HoverRequest = RequestMessage ClientMethod TextDocumentPositionParams (Maybe Hover)-type HoverResponse = ResponseMessage (Maybe Hover)  -- --------------------------------------------------------------------- {-

@@ -0,0 +1,151 @@+{-# LANGUAGE CPP              #-}+{-# LANGUAGE TemplateHaskell  #-}+{-# LANGUAGE DuplicateRecordFields      #-}+module Language.Haskell.LSP.Types.Hover where++import           Control.Applicative+import           Data.Aeson+import           Data.Aeson.TH+import           Data.Text                      ( Text )+import           Language.Haskell.LSP.Types.Constants+import           Language.Haskell.LSP.Types.List+import           Language.Haskell.LSP.Types.Location+import           Language.Haskell.LSP.Types.MarkupContent+import           Language.Haskell.LSP.Types.Message+import           Language.Haskell.LSP.Types.TextDocument++-- ---------------------------------------------------------------------++{-+/**+ * 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 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:+ * ```${language}+ * ${value}+ * ```+ *+ * 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+    request.++Registration Options: TextDocumentRegistrationOptions++-}++data LanguageString =+  LanguageString+    { _language :: Text+    , _value    :: Text+    } deriving (Read,Show,Eq)++deriveJSON lspOptions ''LanguageString++{-# DEPRECATED MarkedString, PlainString, CodeString "Use MarkupContent instead, since 3.3.0 (11/24/2017)" #-}+data MarkedString =+    PlainString Text+  | CodeString LanguageString+    deriving (Eq,Read,Show)++instance ToJSON MarkedString where+  toJSON (PlainString x) = toJSON x+  toJSON (CodeString  x) = toJSON x+instance FromJSON MarkedString where+  parseJSON (String t) = pure $ PlainString t+  parseJSON o            = CodeString <$> parseJSON o++-- ---------------------------------------------------------------------+{-+Hover Request++The hover request is sent from the client to the server to request hover+information at a given text document position.++    Changed: In 2.0 the request uses TextDocumentPositionParams with a proper+    textDocument and position property. In 1.0 the uri of the referenced text+    document was inlined into the params object.++Request++    method: 'textDocument/hover'+    params: TextDocumentPositionParams++Response++    result: Hover | null defined as follows:+++/**+ * The result of a hover request.+ */+interface Hover {+        /**+         * The hover's content+         */+        contents: MarkedString | MarkedString[] | MarkupContent;++        /**+         * 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;+}++-}+++-- -------------------------------------++data HoverContents =+    HoverContentsMS (List MarkedString)+  | HoverContents   MarkupContent+  deriving (Read,Show,Eq)++instance ToJSON HoverContents where+  toJSON (HoverContentsMS  x) = toJSON x+  toJSON (HoverContents    x) = toJSON x+instance FromJSON HoverContents where+  parseJSON v@(String _) = HoverContentsMS <$> parseJSON v+  parseJSON v@(Array _)  = HoverContentsMS <$> parseJSON v+  parseJSON v@(Object _) = HoverContents   <$> parseJSON v+                         <|> HoverContentsMS <$> parseJSON v+  parseJSON _ = mempty++-- -------------------------------------++#if __GLASGOW_HASKELL__ >= 804+instance Semigroup HoverContents where+  (<>) = mappend+#endif++instance Monoid HoverContents where+  mempty = HoverContentsMS (List [])++  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 :: HoverContents+    , _range    :: Maybe Range+    } deriving (Read,Show,Eq)++deriveJSON lspOptions ''Hover++type HoverRequest = RequestMessage ClientMethod TextDocumentPositionParams (Maybe Hover)+type HoverResponse = ResponseMessage (Maybe Hover)

@@ -14,6 +14,7 @@ import           Language.Haskell.LSP.Types.Diagnostic import           Language.Haskell.LSP.Types.DocumentFilter import           Language.Haskell.LSP.Types.FoldingRange+import           Language.Haskell.LSP.Types.Hover import           Language.Haskell.LSP.Types.Message import           Language.Haskell.LSP.Types.Location import           Language.Haskell.LSP.Types.Symbol

@@ -156,3 +156,4 @@   MarkupContent _           s1 `mappend` MarkupContent MkMarkdown  s2 = MarkupContent MkMarkdown  (s1 `mappend` s2)  -- ---------------------------------------------------------------------+

@@ -3,12 +3,10 @@ {-# LANGUAGE TemplateHaskell            #-} module Language.Haskell.LSP.Types.Message where -import           Control.Monad import qualified Data.Aeson                                 as A import           Data.Aeson.TH import           Data.Aeson.Types import           Data.Hashable-import           Data.Maybe -- For <= 8.2.2 import           Data.Text                                  (Text) import           Language.Haskell.LSP.Types.Constants@@ -369,6 +367,28 @@  -- ------------------------------------- +{-+  https://microsoft.github.io/language-server-protocol/specification#responseMessage++  interface ResponseError {+    /**+    * A number indicating the error type that occurred.+    */+    code: number;++    /**+    * A string providing a short description of the error.+    */+    message: string;++    /**+    * A primitive or structured value that contains additional+    * information about the error. Can be omitted.+    */+    data?: string | number | boolean | array | object | null;+  }+-}+ data ResponseError =   ResponseError     { _code    :: ErrorCode@@ -380,30 +400,58 @@  -- --------------------------------------------------------------------- --- | Either result or error must be Just.+{-+  https://microsoft.github.io/language-server-protocol/specification#responseMessage++  interface ResponseMessage extends Message {+    /**+    * The request id.+    */+    id: number | string | null;++    /**+    * The result of a request. This member is REQUIRED on success.+    * This member MUST NOT exist if there was an error invoking the method.+    */+    result?: string | number | boolean | object | null;++    /**+    * The error object in case a request fails.+    */+    error?: ResponseError;+  }+-}+ data ResponseMessage a =   ResponseMessage     { _jsonrpc :: Text     , _id      :: LspIdRsp-    , _result  :: Maybe a-    , _error   :: Maybe ResponseError+    , _result  :: Either ResponseError a     } deriving (Read,Show,Eq) -deriveToJSON lspOptions ''ResponseMessage+instance ToJSON a => ToJSON (ResponseMessage a) where+  toJSON (ResponseMessage { _jsonrpc = jsonrpc, _id = lspid, _result = result })+    = object+      [ "jsonrpc" .= jsonrpc+      , "id" .= lspid+      , case result of+        Left  err -> "error" .= err+        Right a   -> "result" .= a+      ]  instance FromJSON a => FromJSON (ResponseMessage a) where   parseJSON = withObject "Response" $ \o -> do-    rsp <- ResponseMessage-      <$> o .: "jsonrpc"-      <*> o .: "id"-      -- It is important to use .:! so that result = null gets decoded as Just Nothing-      <*> o .:! "result"-      <*> o .:! "error"-    -- We make sure that one of them is present. Without this check we can end up-    -- parsing a Request as a ResponseMessage.-    unless (isJust (_result rsp) || isJust (_error rsp)) $-      fail "ResponseMessage must either have a result or an error"-    pure rsp+    _jsonrpc <- o .: "jsonrpc"+    _id      <- o .: "id"+    -- It is important to use .:! so that "result = null" (without error) gets decoded as Just Null+    _result  <- o .:! "result"+    _error   <- o .:? "error"+    result   <- case (_error, _result) of+      ((Just err), Nothing   ) -> pure $ Left err+      (Nothing   , (Just res)) -> pure $ Right res+      ((Just   _), (Just   _)) -> fail $ "Both error and result cannot be present"+      (Nothing, Nothing) -> fail "Both error and result cannot be Nothing"+    return $ ResponseMessage _jsonrpc _id $ result  type ErrorResponse = ResponseMessage ()