From 3a280886d69c785db0a93cc8aa43e79f73b7f727 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Thu, 11 Apr 2019 21:08:06 +0200
Subject: [PATCH 01/10] WIP

---
 .../Haskell/LSP/Types/DataTypesJSON.hs        | 50 ++++++++++---------
 1 file changed, 26 insertions(+), 24 deletions(-)

diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
index 7fd2d965e..8c873c9da 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
@@ -499,7 +499,7 @@ interface ServerCapabilities {
          *
          * 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 @@ data TDS = TDSOptions TextDocumentSyncOptions
 
 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 @@ data GotoOptions = GotoOptionsStatic Bool
                  | 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 @@ data WorkspaceOptions =
   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 @@ Request:
 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 configuration section asked for.
-	 */
-	section?: string;
+        /**
+         * The scope to get the configuration section for.
+         */
+        scopeUri?: string;
+
+        /**
+         * The configuration section asked for.
+         */
+        section?: string;
 }
 Response:
 
@@ -1731,21 +1731,24 @@ Response
 
     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
@@ -2852,4 +2855,3 @@ data TraceNotification =
   } deriving (Show, Read, Eq)
 
 deriveJSON lspOptions ''TraceNotification
-

From d40c3e7c0aea9127e65ada602cf917f60db6e6ab Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Tue, 16 Apr 2019 21:33:40 +0200
Subject: [PATCH 02/10] Add MarkupContent to HoverResponse

And deprecate the old MarkedString as per the LSP spec.

Closes #141

Addresses some of #134
---
 ChangeLog.md                                  |  4 ++
 example/Main.hs                               |  2 +-
 haskell-lsp-types/ChangeLog.md                |  4 ++
 haskell-lsp-types/haskell-lsp-types.cabal     |  2 +-
 .../Haskell/LSP/Types/DataTypesJSON.hs        | 37 ++++++++--
 .../Haskell/LSP/Types/MarkupContent.hs        | 32 ++++-----
 haskell-lsp.cabal                             | 15 ++--
 test/JsonSpec.hs                              | 69 +++++++++++++++++++
 test/ServerCapabilitiesSpec.hs                |  2 +-
 test/WorkspaceEditSpec.hs                     |  2 +-
 test/WorkspaceFoldersSpec.hs                  |  2 +-
 11 files changed, 138 insertions(+), 33 deletions(-)
 create mode 100644 test/JsonSpec.hs

diff --git a/ChangeLog.md b/ChangeLog.md
index 68d001175..90e8926f7 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,9 @@
 # Revision history for haskell-lsp
 
+## 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/example/Main.hs b/example/Main.hs
index cf7667c6a..c99151d78 100644
--- a/example/Main.hs
+++ b/example/Main.hs
@@ -238,7 +238,7 @@ reactor lf inp = do
 
         let
           ht = Just $ J.Hover ms (Just range)
-          ms = J.List [J.CodeString $ J.LanguageString "lsp-hello" "TYPE INFO" ]
+          ms = J.HoverContentsMS $ J.List [J.CodeString $ J.LanguageString "lsp-hello" "TYPE INFO" ]
           range = J.Range pos pos
         reactorSend $ RspHover $ Core.makeResponseMessage req ht
 
diff --git a/haskell-lsp-types/ChangeLog.md b/haskell-lsp-types/ChangeLog.md
index 34f4e035d..aafe65116 100644
--- a/haskell-lsp-types/ChangeLog.md
+++ b/haskell-lsp-types/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/haskell-lsp-types.cabal b/haskell-lsp-types/haskell-lsp-types.cabal
index ec5f16973..d8774b7d3 100644
--- a/haskell-lsp-types/haskell-lsp-types.cabal
+++ b/haskell-lsp-types/haskell-lsp-types.cabal
@@ -1,5 +1,5 @@
 name:                haskell-lsp-types
-version:             0.8.2.0
+version:             0.8.3.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/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
index 8c873c9da..d4161ed17 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
@@ -18,14 +18,15 @@ import           Data.Aeson.TH
 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
@@ -1749,11 +1750,10 @@ interface Hover {
 }
 
 
-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:
@@ -1762,7 +1762,8 @@ Where MarkedString is defined as follows:
  * ```
  *
  * 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
@@ -1780,6 +1781,7 @@ data LanguageString =
 
 deriveJSON lspOptions ''LanguageString
 
+{-# DEPRECATED MarkedString, PlainString, CodeString "Use MarkupContent instead, since 3.3.0 (11/24/2017)" #-}
 data MarkedString =
     PlainString T.Text
   | CodeString LanguageString
@@ -1792,9 +1794,32 @@ 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.Null)     = HoverContentsMS <$> parseJSON v
+  parseJSON v@(A.Array _)  = HoverContentsMS <$> parseJSON v
+  parseJSON v@(A.Object o) = do
+    mk <- o .:? "kind" :: Parser (Maybe MarkupKind)
+    case mk of
+      Nothing -> HoverContentsMS <$> parseJSON v
+      _       -> HoverContents   <$> parseJSON v
+  parseJSON _ = fail "HoverContents"
+
+-- -------------------------------------
+
 data Hover =
   Hover
-    { _contents :: List MarkedString
+    { _contents :: HoverContents
     , _range    :: Maybe Range
     } deriving (Read,Show,Eq)
 
diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
index 03f3538a7..20dad000e 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
@@ -23,15 +23,15 @@ import           Language.Haskell.LSP.Types.Constants
  * 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 +78,15 @@ instance FromJSON MarkupKind where
  * 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;
 }
 -}
 
diff --git a/haskell-lsp.cabal b/haskell-lsp.cabal
index 0dd464192..da7358bc6 100644
--- a/haskell-lsp.cabal
+++ b/haskell-lsp.cabal
@@ -1,5 +1,5 @@
 name:                haskell-lsp
-version:             0.8.2.0
+version:             0.8.3.0
 synopsis:            Haskell library for the Microsoft Language Server Protocol
 
 description:         An implementation of the types, and basic message server to
@@ -44,7 +44,7 @@ library
                      , filepath
                      , hslogger
                      , hashable
-                     , haskell-lsp-types >= 0.8
+                     , haskell-lsp-types >= 0.8.3
                      , lens >= 4.15.2
                      , mtl
                      , network-uri
@@ -94,6 +94,7 @@ test-suite haskell-lsp-test
   main-is:             Main.hs
   other-modules:       Spec
                        CapabilitiesSpec
+                       JsonSpec
                        DiagnosticsSpec
                        MethodSpec
                        ServerCapabilitiesSpec
@@ -102,22 +103,24 @@ test-suite haskell-lsp-test
                        WorkspaceEditSpec
                        WorkspaceFoldersSpec
   build-depends:       base
+                     , QuickCheck
                      , aeson
                      , bytestring
                      , containers
                      , data-default
                      , directory
                      , filepath
-                     , hspec
                      , hashable
+                     , haskell-lsp
+                     , hspec
                      -- , hspec-jenkins
                      , lens >= 4.15.2
                      , network-uri
+                     , quickcheck-instances
                      , sorted-list == 0.2.1.*
-                     , yi-rope
-                     , haskell-lsp
-                     , text
                      , stm
+                     , text
+                     , yi-rope
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall
   default-language:    Haskell2010
 
diff --git a/test/JsonSpec.hs b/test/JsonSpec.hs
new file mode 100644
index 000000000..09592d2ca
--- /dev/null
+++ b/test/JsonSpec.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE DataKinds            #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverloadedStrings    #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- | Test for JSON serialization
+module JsonSpec where
+
+import           Language.Haskell.LSP.Types
+
+import           Data.Aeson
+import           Test.Hspec
+import           Test.Hspec.QuickCheck
+import           Test.QuickCheck               hiding (Success)
+import           Test.QuickCheck.Instances     ()
+
+-- import Debug.Trace
+-- ---------------------------------------------------------------------
+
+{-# ANN module ("HLint: ignore Redundant do"       :: String) #-}
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = describe "dispatcher" jsonSpec
+
+-- ---------------------------------------------------------------------
+
+jsonSpec :: Spec
+jsonSpec = do
+  describe "General JSON instances round trip" $ do
+  -- DataTypesJSON
+    prop "LanguageString"    (propertyJsonRoundtrip :: LanguageString -> Bool)
+    prop "MarkedString"      (propertyJsonRoundtrip :: MarkedString -> Bool)
+    prop "MarkupContent"     (propertyJsonRoundtrip :: MarkupContent -> Bool)
+    prop "HoverContents"     (propertyJsonRoundtrip :: HoverContents -> Bool)
+
+
+-- ---------------------------------------------------------------------
+
+propertyJsonRoundtrip :: (Eq a, ToJSON a, FromJSON a) => a -> Bool
+propertyJsonRoundtrip a = Success a == fromJSON (toJSON a)
+
+-- ---------------------------------------------------------------------
+
+instance Arbitrary LanguageString where
+  arbitrary = LanguageString <$> arbitrary <*> arbitrary
+
+instance Arbitrary MarkedString where
+  arbitrary = oneof [PlainString <$> arbitrary, CodeString <$> arbitrary]
+
+instance Arbitrary MarkupContent where
+  arbitrary = MarkupContent <$> arbitrary <*> arbitrary
+
+instance Arbitrary MarkupKind where
+  arbitrary = oneof [pure MkPlainText,pure MkMarkdown]
+
+instance Arbitrary HoverContents where
+  arbitrary = oneof [HoverContentsMS <$> arbitrary, HoverContents <$> arbitrary]
+
+-- | make lists of maximum length 3 for test performance
+smallList :: Gen a -> Gen [a]
+smallList = resize 3 . listOf
+
+instance (Arbitrary a) => Arbitrary (List a) where
+  arbitrary = List <$> arbitrary
+
+-- ---------------------------------------------------------------------
diff --git a/test/ServerCapabilitiesSpec.hs b/test/ServerCapabilitiesSpec.hs
index 2f2142b4b..6f4790d13 100644
--- a/test/ServerCapabilitiesSpec.hs
+++ b/test/ServerCapabilitiesSpec.hs
@@ -24,7 +24,7 @@ spec = describe "server capabilities" $ do
     describe "encodes" $
       it "just id" $
         encode (FoldingRangeOptionsDynamicDocument Nothing (Just "foo")) `shouldBe` "{\"id\":\"foo\"}"
-  it "decodes" $ 
+  it "decodes" $
     let input = "{\"hoverProvider\": true, \"colorProvider\": {\"id\": \"abc123\", \"documentSelector\": " <> documentFiltersJson <> "}}"
         Just caps = decode input :: Maybe InitializeResponseCapabilitiesInner
       in caps ^. colorProvider `shouldBe` Just (ColorOptionsDynamicDocument (Just documentFilters) (Just "abc123"))
diff --git a/test/WorkspaceEditSpec.hs b/test/WorkspaceEditSpec.hs
index 481ca7994..1ae19002c 100644
--- a/test/WorkspaceEditSpec.hs
+++ b/test/WorkspaceEditSpec.hs
@@ -20,6 +20,6 @@ spec = do
   describe "editTextEdit" $
     it "edits a multiline text edit" $
       let orig = TextEdit (Range (Position 1 1) (Position 2 2)) "hello\nworld"
-          inner = TextEdit (Range (Position 0 3) (Position 1 3)) "ios\ngo" 
+          inner = TextEdit (Range (Position 0 3) (Position 1 3)) "ios\ngo"
           expected = TextEdit (Range (Position 1 1) (Position 2 2)) "helios\ngold"
          in editTextEdit orig inner `shouldBe` expected
diff --git a/test/WorkspaceFoldersSpec.hs b/test/WorkspaceFoldersSpec.hs
index 747904bf1..9f176d6ef 100644
--- a/test/WorkspaceFoldersSpec.hs
+++ b/test/WorkspaceFoldersSpec.hs
@@ -32,7 +32,7 @@ spec = describe "workspace folders" $
             in handleMessage initCb tvarCtx clStr jsonStr
 
     let starterWorkspaces = List [wf0]
-        initParams = InitializeParams 
+        initParams = InitializeParams
           Nothing Nothing (Just (Uri "/foo")) Nothing fullCaps Nothing (Just starterWorkspaces)
         initMsg :: InitializeRequest
         initMsg = RequestMessage "2.0" (IdInt 0) Initialize initParams

From 9da98fd0dc87790913ad730734ab75a8a3b1088b Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Wed, 17 Apr 2019 21:11:45 +0200
Subject: [PATCH 03/10] Add Semigroup instance for MarkupContent

---
 .../Haskell/LSP/Types/MarkupContent.hs        | 23 ++++++++++++++
 haskell-lsp.cabal                             |  1 +
 test/TypesSpec.hs                             | 30 +++++++++++++++++++
 3 files changed, 54 insertions(+)
 create mode 100644 test/TypesSpec.hs

diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
index 20dad000e..b465dbe0b 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
@@ -11,6 +11,7 @@ module Language.Haskell.LSP.Types.MarkupContent where
 
 import           Data.Aeson
 import           Data.Aeson.TH
+import           Data.Semigroup
 import           Data.Text                                      (Text)
 import           Language.Haskell.LSP.Types.Constants
 
@@ -120,3 +121,25 @@ data MarkupContent =
   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
+
+-- ---------------------------------------------------------------------
+
+instance Semigroup MarkupContent where
+  MarkupContent MkPlainText s1 <> MarkupContent MkPlainText s2 = MarkupContent MkPlainText (s1 <> s2)
+  MarkupContent MkMarkdown  s1 <> MarkupContent _           s2 = MarkupContent MkMarkdown  (s1 <> s2)
+  MarkupContent _           s1 <> MarkupContent MkMarkdown  s2 = MarkupContent MkMarkdown  (s1 <> s2)
+
+-- ---------------------------------------------------------------------
diff --git a/haskell-lsp.cabal b/haskell-lsp.cabal
index da7358bc6..24e9d7514 100644
--- a/haskell-lsp.cabal
+++ b/haskell-lsp.cabal
@@ -98,6 +98,7 @@ test-suite haskell-lsp-test
                        DiagnosticsSpec
                        MethodSpec
                        ServerCapabilitiesSpec
+                       TypesSpec
                        URIFilePathSpec
                        VspSpec
                        WorkspaceEditSpec
diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs
new file mode 100644
index 000000000..fb1ac0e63
--- /dev/null
+++ b/test/TypesSpec.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+module TypesSpec where
+
+import qualified Language.Haskell.LSP.Types as J
+import           Test.Hspec
+
+-- ---------------------------------------------------------------------
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = diagnosticsSpec
+
+-- ---------------------------------------------------------------------
+
+diagnosticsSpec :: Spec
+diagnosticsSpec = do
+  describe "MarkupContent" $ do
+    it "appends two plainstrings" $ do
+      J.unmarkedUpContent "string1\n" <> J.unmarkedUpContent "string2\n"
+        `shouldBe` J.unmarkedUpContent "string1\nstring2\n"
+    it "appends a marked up and a plain string" $ do
+      J.markedUpContent "haskell" "foo :: Int" <> J.unmarkedUpContent "string2\n"
+        `shouldBe` J.MarkupContent J.MkMarkdown "```haskell\nfoo :: Int\n```\nstring2\n"
+    it "appends a plain string and a marked up string" $ do
+       J.unmarkedUpContent "string2\n" <> J.markedUpContent "haskell" "foo :: Int"
+        `shouldBe` J.MarkupContent J.MkMarkdown "string2\n```haskell\nfoo :: Int\n```\n"
+
+-- ---------------------------------------------------------------------

From 78309b5eff5a3328de31b0693099440eb5ce1cc7 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Wed, 17 Apr 2019 23:25:26 +0200
Subject: [PATCH 04/10] Bump version to 0.9.0.0, HoverContents is an API change

And add Monoid instance for HoverContents too, so it is easy to
combine results from multiple sources.

It may be necessary to tweak a separator used in combining, it is
currently just \n.
---
 haskell-lsp-types/haskell-lsp-types.cabal     |  2 +-
 .../Haskell/LSP/Types/DataTypesJSON.hs        | 22 ++++++++++++++++---
 .../Haskell/LSP/Types/MarkupContent.hs        |  4 +++-
 haskell-lsp.cabal                             |  2 +-
 test/JsonSpec.hs                              |  4 +++-
 5 files changed, 27 insertions(+), 7 deletions(-)

diff --git a/haskell-lsp-types/haskell-lsp-types.cabal b/haskell-lsp-types/haskell-lsp-types.cabal
index d8774b7d3..4a1b85901 100644
--- a/haskell-lsp-types/haskell-lsp-types.cabal
+++ b/haskell-lsp-types/haskell-lsp-types.cabal
@@ -1,5 +1,5 @@
 name:                haskell-lsp-types
-version:             0.8.3.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/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
index d4161ed17..01ea82a4e 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
@@ -1,11 +1,9 @@
-{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DeriveTraversable          #-}
 {-# LANGUAGE DuplicateRecordFields      #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE FunctionalDependencies     #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE TypeSynonymInstances       #-}
@@ -16,6 +14,7 @@ import           Control.Applicative
 import qualified Data.Aeson                                 as A
 import           Data.Aeson.TH
 import           Data.Aeson.Types
+import           Data.Semigroup
 import           Data.Text                                  (Text)
 import qualified Data.Text                                  as T
 import           Language.Haskell.LSP.Types.ClientCapabilities
@@ -1799,14 +1798,16 @@ instance FromJSON MarkedString where
 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 v@(A.Null)     = HoverContentsMS <$> parseJSON v
+  parseJSON v@(A.Null)     = pure HoverContentsEmpty
   parseJSON v@(A.Array _)  = HoverContentsMS <$> parseJSON v
   parseJSON v@(A.Object o) = do
     mk <- o .:? "kind" :: Parser (Maybe MarkupKind)
@@ -1817,6 +1818,21 @@ instance FromJSON HoverContents where
 
 -- -------------------------------------
 
+instance Semigroup HoverContents where
+  HoverContentsEmpty <> hc = hc
+  hc <> HoverContentsEmpty = hc
+  HoverContents h1 <> HoverContents h2 = HoverContents (h1 <> h2)
+  HoverContents h1 <> HoverContentsMS (List h2s) = HoverContents (mconcat (h1: (map toMarkupContent h2s)))
+
+instance Monoid HoverContents where
+  mempty = HoverContentsEmpty
+
+toMarkupContent :: MarkedString -> MarkupContent
+toMarkupContent (PlainString s) = unmarkedUpContent s
+toMarkupContent (CodeString (LanguageString lang s)) = markedUpContent lang s
+
+-- -------------------------------------
+
 data Hover =
   Hover
     { _contents :: HoverContents
diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
index b465dbe0b..24a831afe 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
@@ -11,7 +11,6 @@ module Language.Haskell.LSP.Types.MarkupContent where
 
 import           Data.Aeson
 import           Data.Aeson.TH
-import           Data.Semigroup
 import           Data.Text                                      (Text)
 import           Language.Haskell.LSP.Types.Constants
 
@@ -142,4 +141,7 @@ instance Semigroup MarkupContent where
   MarkupContent MkMarkdown  s1 <> MarkupContent _           s2 = MarkupContent MkMarkdown  (s1 <> s2)
   MarkupContent _           s1 <> MarkupContent MkMarkdown  s2 = MarkupContent MkMarkdown  (s1 <> s2)
 
+instance Monoid MarkupContent where
+  mempty = MarkupContent MkPlainText ""
+
 -- ---------------------------------------------------------------------
diff --git a/haskell-lsp.cabal b/haskell-lsp.cabal
index 24e9d7514..b0e32c3f2 100644
--- a/haskell-lsp.cabal
+++ b/haskell-lsp.cabal
@@ -1,5 +1,5 @@
 name:                haskell-lsp
-version:             0.8.3.0
+version:             0.9.0.0
 synopsis:            Haskell library for the Microsoft Language Server Protocol
 
 description:         An implementation of the types, and basic message server to
diff --git a/test/JsonSpec.hs b/test/JsonSpec.hs
index 09592d2ca..a69b8d3a3 100644
--- a/test/JsonSpec.hs
+++ b/test/JsonSpec.hs
@@ -57,7 +57,9 @@ instance Arbitrary MarkupKind where
   arbitrary = oneof [pure MkPlainText,pure MkMarkdown]
 
 instance Arbitrary HoverContents where
-  arbitrary = oneof [HoverContentsMS <$> arbitrary, HoverContents <$> arbitrary]
+  arbitrary = oneof [ HoverContentsMS <$> arbitrary
+                    , HoverContents <$> arbitrary
+                    , pure HoverContentsEmpty]
 
 -- | make lists of maximum length 3 for test performance
 smallList :: Gen a -> Gen [a]

From 98469ce224531d9c47667345285e97d193bdc29e Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Thu, 18 Apr 2019 14:24:19 +0200
Subject: [PATCH 05/10] Fix Semigroup backward compatiblity

---
 .../src/Language/Haskell/LSP/Types/MarkupContent.hs | 13 +++++++++----
 test/TypesSpec.hs                                   |  1 +
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
index 24a831afe..1a03af06a 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE DuplicateRecordFields      #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE TemplateHaskell            #-}
@@ -11,6 +12,8 @@ module Language.Haskell.LSP.Types.MarkupContent where
 
 import           Data.Aeson
 import           Data.Aeson.TH
+-- import           Data.Monoid
+import           Data.Semigroup
 import           Data.Text                                      (Text)
 import           Language.Haskell.LSP.Types.Constants
 
@@ -135,13 +138,15 @@ unmarkedUpContent :: Text -> MarkupContent
 unmarkedUpContent str = MarkupContent MkPlainText str
 
 -- ---------------------------------------------------------------------
-
+#if __GLASGOW_HASKELL__ >= 804
 instance Semigroup MarkupContent where
-  MarkupContent MkPlainText s1 <> MarkupContent MkPlainText s2 = MarkupContent MkPlainText (s1 <> s2)
-  MarkupContent MkMarkdown  s1 <> MarkupContent _           s2 = MarkupContent MkMarkdown  (s1 <> s2)
-  MarkupContent _           s1 <> MarkupContent MkMarkdown  s2 = MarkupContent MkMarkdown  (s1 <> s2)
+  (<>) = 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)
 
 -- ---------------------------------------------------------------------
diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs
index fb1ac0e63..42b473986 100644
--- a/test/TypesSpec.hs
+++ b/test/TypesSpec.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module TypesSpec where
 
+import           Data.Monoid
 import qualified Language.Haskell.LSP.Types as J
 import           Test.Hspec
 

From 5b68861c19990bbc5c3ca91d208cc11ee216cfd6 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Thu, 18 Apr 2019 15:08:24 +0200
Subject: [PATCH 06/10] Trying again

---
 .../Haskell/LSP/Types/DataTypesJSON.hs         | 18 ++++++++++++------
 .../Haskell/LSP/Types/MarkupContent.hs         |  2 +-
 2 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
index 01ea82a4e..9008e70b5 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE DeriveTraversable          #-}
 {-# LANGUAGE DuplicateRecordFields      #-}
@@ -14,7 +15,6 @@ import           Control.Applicative
 import qualified Data.Aeson                                 as A
 import           Data.Aeson.TH
 import           Data.Aeson.Types
-import           Data.Semigroup
 import           Data.Text                                  (Text)
 import qualified Data.Text                                  as T
 import           Language.Haskell.LSP.Types.ClientCapabilities
@@ -1807,7 +1807,7 @@ instance ToJSON HoverContents where
   toJSON (HoverContentsEmpty) = A.Null
 instance FromJSON HoverContents where
   parseJSON v@(A.String _) = HoverContentsMS <$> parseJSON v
-  parseJSON v@(A.Null)     = pure HoverContentsEmpty
+  parseJSON   (A.Null)     = pure HoverContentsEmpty
   parseJSON v@(A.Array _)  = HoverContentsMS <$> parseJSON v
   parseJSON v@(A.Object o) = do
     mk <- o .:? "kind" :: Parser (Maybe MarkupKind)
@@ -1818,15 +1818,21 @@ instance FromJSON HoverContents where
 
 -- -------------------------------------
 
+#if __GLASGOW_HASKELL__ >= 804
 instance Semigroup HoverContents where
-  HoverContentsEmpty <> hc = hc
-  hc <> HoverContentsEmpty = hc
-  HoverContents h1 <> HoverContents h2 = HoverContents (h1 <> h2)
-  HoverContents h1 <> HoverContentsMS (List h2s) = HoverContents (mconcat (h1: (map toMarkupContent h2s)))
+  (<>) = 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
diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
index 1a03af06a..18800c004 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
@@ -12,7 +12,6 @@ module Language.Haskell.LSP.Types.MarkupContent where
 
 import           Data.Aeson
 import           Data.Aeson.TH
--- import           Data.Monoid
 import           Data.Semigroup
 import           Data.Text                                      (Text)
 import           Language.Haskell.LSP.Types.Constants
@@ -138,6 +137,7 @@ unmarkedUpContent :: Text -> MarkupContent
 unmarkedUpContent str = MarkupContent MkPlainText str
 
 -- ---------------------------------------------------------------------
+
 #if __GLASGOW_HASKELL__ >= 804
 instance Semigroup MarkupContent where
   (<>) = mappend

From 9b1352d35411460754a164ec2b51c843ce545e2f Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Thu, 18 Apr 2019 15:33:22 +0200
Subject: [PATCH 07/10] Clean up HoverContents JSON instance slightly

---
 .../src/Language/Haskell/LSP/Types/DataTypesJSON.hs      | 9 +++------
 1 file changed, 3 insertions(+), 6 deletions(-)

diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
index 9008e70b5..fb8a5ff76 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
@@ -1809,12 +1809,9 @@ 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 o) = do
-    mk <- o .:? "kind" :: Parser (Maybe MarkupKind)
-    case mk of
-      Nothing -> HoverContentsMS <$> parseJSON v
-      _       -> HoverContents   <$> parseJSON v
-  parseJSON _ = fail "HoverContents"
+  parseJSON v@(A.Object o) = HoverContents   <$> parseJSON v
+                         <|> HoverContentsMS <$> parseJSON v
+  parseJSON _ = mempty
 
 -- -------------------------------------
 

From 7c5f4ee7badaeb2694b93eddb23ae8a3a76767fa Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Thu, 18 Apr 2019 15:36:57 +0200
Subject: [PATCH 08/10] Remove warning

---
 .../src/Language/Haskell/LSP/Types/DataTypesJSON.hs             | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
index fb8a5ff76..a1d05e86e 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/DataTypesJSON.hs
@@ -1809,7 +1809,7 @@ 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 o) = HoverContents   <$> parseJSON v
+  parseJSON v@(A.Object _) = HoverContents   <$> parseJSON v
                          <|> HoverContentsMS <$> parseJSON v
   parseJSON _ = mempty
 

From 55196c12a5444f7a69951b6f4fd4597bdc7c4077 Mon Sep 17 00:00:00 2001
From: Luke Lau <luke_lau@icloud.com>
Date: Fri, 19 Apr 2019 00:03:09 +0100
Subject: [PATCH 09/10] Update ChangeLog.md

---
 ChangeLog.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index 90e8926f7..be5a7add6 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,6 +1,6 @@
 # Revision history for haskell-lsp
 
-## 0.8.3.0
+## 0.9.0.0
 
 * Add `MarkupContent` to `HoverResponse`, and (some) json roundtrip tests.
 

From 3004608c73e5faae264f5a0bdcb2b68bfbd35b1e Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Fri, 19 Apr 2019 13:47:43 +0200
Subject: [PATCH 10/10] Introduce sectionSeparator for use in clients

---
 .../src/Language/Haskell/LSP/Types/MarkupContent.hs         | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
index 18800c004..46e5d97de 100644
--- a/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
+++ b/haskell-lsp-types/src/Language/Haskell/LSP/Types/MarkupContent.hs
@@ -138,6 +138,12 @@ 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