Skip to content

Commit d0f5f5a

Browse files
michaelpjmichaelpj
authored
Merge branch 'master' into add-swarm
2 parents 89410e3 + 99fed59 commit d0f5f5a

File tree

6 files changed

+49
-40
lines changed

6 files changed

+49
-40
lines changed

‎lsp-types/src/Language/LSP/Types/Common.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ module Language.LSP.Types.Common where
99
import Control.Applicative
1010
import Control.DeepSeq
1111
import Data.Aeson
12-
import qualified Data.HashMap.Strict as HashMap
1312
import GHC.Generics
1413

1514
-- | A terser, isomorphic data type for 'Either', that does not get tagged when
@@ -55,5 +54,5 @@ instance ToJSON Empty where
5554
toJSON Empty = Null
5655
instance FromJSON Empty where
5756
parseJSON Null = pure Empty
58-
parseJSON (Object o) | HashMap.null o = pure Empty
57+
parseJSON (Object o) | o == mempty = pure Empty
5958
parseJSON _ = fail "expected 'null' or '{}'"

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

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@ module Language.LSP.Types.MarkupContent where
1212
import Data.Aeson
1313
import Data.Aeson.TH
1414
import Data.Text (Text)
15+
import qualified Data.Text as T
1516
import Language.LSP.Types.Utils
1617

1718
-- | Describes the content type that a client supports in various
@@ -81,10 +82,18 @@ sectionSeparator = "* * *\n"
8182

8283
-- ---------------------------------------------------------------------
8384

85+
-- | Given some plaintext, convert it into some equivalent markdown text.
86+
-- This is not *quite* the identity function.
87+
plainTextToMarkdown :: Text -> Text
88+
-- Line breaks in markdown paragraphs are ignored unless the line ends with two spaces.
89+
-- In order to respect the line breaks in the original plaintext, we stick two spaces on the end of every line.
90+
plainTextToMarkdown = T.unlines . fmap (<> " ") . T.lines
91+
8492
instance Semigroup MarkupContent where
8593
MarkupContent MkPlainText s1 <> MarkupContent MkPlainText s2 = MarkupContent MkPlainText (s1 `mappend` s2)
86-
MarkupContent MkMarkdown s1 <> MarkupContent _ s2 = MarkupContent MkMarkdown (s1 `mappend` s2)
87-
MarkupContent _ s1 <> MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown (s1 `mappend` s2)
94+
MarkupContent MkMarkdown s1 <> MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown (s1 `mappend` s2)
95+
MarkupContent MkPlainText s1 <> MarkupContent MkMarkdown s2 = MarkupContent MkMarkdown (plainTextToMarkdown s1 `mappend` s2)
96+
MarkupContent MkMarkdown s1 <> MarkupContent MkPlainText s2 = MarkupContent MkMarkdown (s1 `mappend` plainTextToMarkdown s2)
8897

8998
instance Monoid MarkupContent where
9099
mempty = MarkupContent MkPlainText ""

‎lsp-types/src/Language/LSP/Types/Message.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -55,12 +55,12 @@ import Language.LSP.Types.WatchedFiles
5555
import Language.LSP.Types.WorkspaceEdit
5656
import Language.LSP.Types.WorkspaceFolders
5757
import Language.LSP.Types.WorkspaceSymbol
58-
import qualified Data.HashMap.Strict as HM
5958

6059
import Data.Kind
6160
import Data.Aeson
6261
import Data.Aeson.TH
6362
import Data.Text (Text)
63+
import Data.String
6464
import GHC.Generics
6565

6666
-- ---------------------------------------------------------------------
@@ -274,8 +274,8 @@ deriving instance Show (MessageParams m) => Show (RequestMessage m)
274274
-- | Replace a missing field in an object with a null field, to simplify parsing
275275
-- This is a hack to allow other types than Maybe to work like Maybe in allowing the field to be missing.
276276
-- See also this issue: https://github.com/haskell/aeson/issues/646
277-
addNullField :: Text -> Value -> Value
278-
addNullField s (Object o) = Object $ HM.insertWith (\_new old -> old) s Null o
277+
addNullField :: String -> Value -> Value
278+
addNullField s (Object o) = Object $ o <> fromString s .= Null
279279
addNullField _ v = v
280280

281281
instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (RequestMessage m) where

‎lsp-types/src/Language/LSP/Types/Parsing.hs

Lines changed: 29 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -14,13 +14,13 @@
1414
{-# LANGUAGE TupleSections #-}
1515
{-# LANGUAGE TypeApplications #-}
1616
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
17+
{-# LANGUAGE ScopedTypeVariables #-}
1718

1819
module Language.LSP.Types.Parsing where
1920

2021
import Language.LSP.Types.LspId
2122
import Language.LSP.Types.Method
2223
import Language.LSP.Types.Message
23-
import qualified Data.HashMap.Strict as HM
2424

2525
import Data.Aeson
2626
import Data.Aeson.Types
@@ -90,25 +90,26 @@ Notification | jsonrpc | | method | params?
9090
{-# INLINE parseServerMessage #-}
9191
parseServerMessage :: LookupFunc FromClient a -> Value -> Parser (FromServerMessage' a)
9292
parseServerMessage lookupId v@(Object o) = do
93-
case HM.lookup "method" o of
94-
Just cmd -> do
95-
-- Request or Notification
96-
SomeServerMethod m <- parseJSON cmd
93+
methMaybe <- o .:! "method"
94+
idMaybe <- o .:! "id"
95+
case methMaybe of
96+
-- Request or Notification
97+
Just (SomeServerMethod m) ->
9798
case splitServerMethod m of
9899
IsServerNot -> FromServerMess m <$> parseJSON v
99100
IsServerReq -> FromServerMess m <$> parseJSON v
100-
IsServerEither
101-
| HM.member "id" o -- Request
102-
, SCustomMethod cm <- m ->
101+
IsServerEither | SCustomMethod cm <- m -> do
102+
case idMaybe of
103+
-- Request
104+
Just _ ->
103105
let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromServer Request))
104-
in FromServerMess m' <$> parseJSON v
105-
| SCustomMethod cm <- m ->
106+
in FromServerMess m' <$> parseJSON v
107+
Nothing ->
106108
let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromServer Notification))
107-
in FromServerMess m' <$> parseJSON v
109+
in FromServerMess m' <$> parseJSON v
108110
Nothing -> do
109-
case HM.lookup "id" o of
110-
Just i' -> do
111-
i <- parseJSON i'
111+
case idMaybe of
112+
Just i -> do
112113
case lookupId i of
113114
Just (m,res) -> clientResponseJSON m $ FromServerRsp res <$> parseJSON v
114115
Nothing -> fail $ unwords ["Failed in looking up response type of", show v]
@@ -118,25 +119,26 @@ parseServerMessage _ v = fail $ unwords ["parseServerMessage expected object, go
118119
{-# INLINE parseClientMessage #-}
119120
parseClientMessage :: LookupFunc FromServer a -> Value -> Parser (FromClientMessage' a)
120121
parseClientMessage lookupId v@(Object o) = do
121-
case HM.lookup "method" o of
122-
Just cmd -> do
123-
-- Request or Notification
124-
SomeClientMethod m <- parseJSON cmd
122+
methMaybe <- o .:! "method"
123+
idMaybe <- o .:! "id"
124+
case methMaybe of
125+
-- Request or Notification
126+
Just (SomeClientMethod m) ->
125127
case splitClientMethod m of
126128
IsClientNot -> FromClientMess m <$> parseJSON v
127129
IsClientReq -> FromClientMess m <$> parseJSON v
128-
IsClientEither
129-
| HM.member "id" o -- Request
130-
, SCustomMethod cm <- m ->
130+
IsClientEither | SCustomMethod cm <- m -> do
131+
case idMaybe of
132+
-- Request
133+
Just _ ->
131134
let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromClient Request))
132-
in FromClientMess m' <$> parseJSON v
133-
| SCustomMethod cm <- m ->
135+
in FromClientMess m' <$> parseJSON v
136+
Nothing ->
134137
let m' = (SCustomMethod cm :: SMethod (CustomMethod :: Method FromClient Notification))
135-
in FromClientMess m' <$> parseJSON v
138+
in FromClientMess m' <$> parseJSON v
136139
Nothing -> do
137-
case HM.lookup "id" o of
138-
Just i' -> do
139-
i <- parseJSON i'
140+
case idMaybe of
141+
Just i -> do
140142
case lookupId i of
141143
Just (m,res) -> serverResponseJSON m $ FromClientRsp res <$> parseJSON v
142144
Nothing -> fail $ unwords ["Failed in looking up response type of", show v]

‎lsp/example/Reactor.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,6 @@ import Control.Monad
3030
import Control.Monad.IO.Class
3131
import Control.Monad.STM
3232
import qualified Data.Aeson as J
33-
import qualified Data.HashMap.Strict as H
3433
import qualified Data.Text as T
3534
import GHC.Generics (Generic)
3635
import Language.LSP.Server
@@ -263,8 +262,8 @@ handle = mconcat
263262
cmd = "lsp-hello-command"
264263
-- need 'file' and 'start_pos'
265264
args = J.List
266-
[ J.Object $ H.fromList [("file", J.Object $ H.fromList [("textDocument",J.toJSON doc)])]
267-
, J.Object $ H.fromList [("start_pos",J.Object $ H.fromList [("position", J.toJSON start)])]
265+
[ J.object [("file", J.object [("textDocument",J.toJSON doc)])]
266+
, J.object [("start_pos",J.object [("position", J.toJSON start)])]
268267
]
269268
cmdparams = Just args
270269
makeCommand (J.Diagnostic _r _s _c _source _m _t _l) = []

‎lsp/test/TypesSpec.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,10 +21,10 @@ diagnosticsSpec = do
2121
J.unmarkedUpContent "string1\n" <> J.unmarkedUpContent "string2\n"
2222
`shouldBe` J.unmarkedUpContent "string1\nstring2\n"
2323
it "appends a marked up and a plain string" $ do
24-
J.markedUpContent "haskell" "foo :: Int" <> J.unmarkedUpContent "string2\n"
25-
`shouldBe` J.MarkupContent J.MkMarkdown "\n```haskell\nfoo :: Int\n```\nstring2\n"
24+
J.markedUpContent "haskell" "foo :: Int" <> J.unmarkedUpContent "string2\nstring3\n"
25+
`shouldBe` J.MarkupContent J.MkMarkdown "\n```haskell\nfoo :: Int\n```\nstring2 \nstring3 \n"
2626
it "appends a plain string and a marked up string" $ do
2727
J.unmarkedUpContent "string2\n" <> J.markedUpContent "haskell" "foo :: Int"
28-
`shouldBe` J.MarkupContent J.MkMarkdown "string2\n\n```haskell\nfoo :: Int\n```\n"
28+
`shouldBe` J.MarkupContent J.MkMarkdown "string2 \n\n```haskell\nfoo :: Int\n```\n"
2929

3030
-- ---------------------------------------------------------------------

0 commit comments

Comments
 (0)