diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Revision history for haskell-lsp +## 0.22.0.0 + +* 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 diff --git a/haskell-lsp.cabal b/haskell-lsp.cabal --- a/haskell-lsp.cabal +++ b/haskell-lsp.cabal @@ -1,5 +1,5 @@ name: haskell-lsp -version: 0.21.0.0 +version: 0.22.0.0 synopsis: Haskell library for the Microsoft Language Server Protocol description: An implementation of the types, and basic message server to @@ -14,7 +14,7 @@ license-file: LICENSE author: Alan Zimmerman maintainer: alan.zimm@gmail.com -copyright: Alan Zimmerman, 2016-2019 +copyright: Alan Zimmerman, 2016-2020 category: Development build-type: Simple extra-source-files: ChangeLog.md, README.md @@ -35,7 +35,7 @@ -- other-modules: -- other-extensions: ghc-options: -Wall - build-depends: base >= 4.9 && < 4.14 + build-depends: base >= 4.9 && < 4.15 , async , aeson >=1.0.0.0 , attoparsec @@ -46,7 +46,7 @@ , filepath , hslogger , hashable - , haskell-lsp-types == 0.21.* + , haskell-lsp-types == 0.22.* , lens >= 4.15.2 , mtl , network-uri @@ -67,7 +67,7 @@ default-language: Haskell2010 ghc-options: -Wall - build-depends: base >= 4.9 && < 4.14 + build-depends: base >= 4.9 && < 4.15 , aeson , bytestring , containers diff --git a/src/Language/Haskell/LSP/Core.hs b/src/Language/Haskell/LSP/Core.hs --- a/src/Language/Haskell/LSP/Core.hs +++ b/src/Language/Haskell/LSP/Core.hs @@ -666,10 +666,10 @@ -- --------------------------------------------------------------------- makeResponseMessage :: J.RequestMessage J.ClientMethod req resp -> resp -> J.ResponseMessage resp -makeResponseMessage req result = J.ResponseMessage "2.0" (J.responseId $ req ^. J.id) (Just result) Nothing +makeResponseMessage req result = J.ResponseMessage "2.0" (J.responseId $ req ^. J.id) (Right result) makeResponseError :: J.LspIdRsp -> J.ResponseError -> J.ResponseMessage () -makeResponseError origId err = J.ResponseMessage "2.0" origId Nothing (Just err) +makeResponseError origId err = J.ResponseMessage "2.0" origId (Left err) -- --------------------------------------------------------------------- -- | @@ -694,8 +694,8 @@ sendErrorResponseS :: SendFunc -> J.LspIdRsp -> J.ErrorCode -> Text -> IO () sendErrorResponseS sf origId err msg = do - sf $ RspError (J.ResponseMessage "2.0" origId Nothing - (Just $ J.ResponseError err msg Nothing) :: J.ErrorResponse) + sf $ RspError (J.ResponseMessage "2.0" origId + (Left $ J.ResponseError err msg Nothing) :: J.ErrorResponse) sendErrorLog :: TVar (LanguageContextData config) -> Text -> IO () sendErrorLog tv msg = sendErrorLogS (sendEvent tv) msg @@ -881,7 +881,7 @@ Nothing -> do let capa = serverCapabilities (getCapabilities params) (resOptions ctx) (resHandlers ctx) -- TODO: wrap this up into a fn to create a response message - res = J.ResponseMessage "2.0" (J.responseId origId) (Just $ J.InitializeResponseCapabilities capa) Nothing + res = J.ResponseMessage "2.0" (J.responseId origId) (Right $ J.InitializeResponseCapabilities capa) sendResponse tvarCtx $ RspInitialize res @@ -1038,7 +1038,7 @@ -- utility --- +-- -- Logger -- setupLogger :: Maybe FilePath -> [String] -> Priority -> IO () diff --git a/test/JsonSpec.hs b/test/JsonSpec.hs --- a/test/JsonSpec.hs +++ b/test/JsonSpec.hs @@ -8,7 +8,8 @@ import Language.Haskell.LSP.Types -import Data.Aeson +import qualified Data.Aeson as J +import Data.List(isPrefixOf) import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck hiding (Success) @@ -23,7 +24,9 @@ main = hspec spec spec :: Spec -spec = describe "dispatcher" jsonSpec +spec = do + describe "dispatcher" jsonSpec + describe "ResponseMessage" responseMessageSpec -- --------------------------------------------------------------------- @@ -31,18 +34,39 @@ jsonSpec = do describe "General JSON instances round trip" $ do -- DataTypesJSON - prop "LanguageString" (propertyJsonRoundtrip :: LanguageString -> Property) - prop "MarkedString" (propertyJsonRoundtrip :: MarkedString -> Property) - prop "MarkupContent" (propertyJsonRoundtrip :: MarkupContent -> Property) - prop "HoverContents" (propertyJsonRoundtrip :: HoverContents -> Property) - prop "ResponseMessage" (propertyJsonRoundtrip :: ResponseMessage (Maybe ()) -> Property) - prop "WatchedFiles" (propertyJsonRoundtrip :: DidChangeWatchedFilesRegistrationOptions -> Property) + prop "LanguageString" (propertyJsonRoundtrip :: LanguageString -> Property) + prop "MarkedString" (propertyJsonRoundtrip :: MarkedString -> Property) + prop "MarkupContent" (propertyJsonRoundtrip :: MarkupContent -> Property) + prop "HoverContents" (propertyJsonRoundtrip :: HoverContents -> Property) + prop "ResponseError" (propertyJsonRoundtrip :: ResponseError -> Property) + prop "WatchedFiles" (propertyJsonRoundtrip :: DidChangeWatchedFilesRegistrationOptions -> Property) + prop "ResponseMessage ()" + (propertyJsonRoundtrip :: ResponseMessage () -> Property) + prop "ResponseMessage JSON value" + (propertyJsonRoundtrip :: ResponseMessage J.Value -> Property) +responseMessageSpec :: Spec +responseMessageSpec = do + describe "edge cases" $ do + it "decodes result = null" $ do + let input = "{\"jsonrpc\": \"2.0\", \"id\": 123, \"result\": null}" + in J.decode input `shouldBe` Just + (ResponseMessage "2.0" (IdRspInt 123) (Right J.Null)) + describe "invalid JSON" $ do + it "throws if neither result nor error is present" $ do + (J.eitherDecode "{\"jsonrpc\":\"2.0\",\"id\":1}" :: Either String (ResponseMessage ())) + `shouldBe` Left ("Error in $: Both error and result cannot be Nothing") + it "throws if both result and error are present" $ do + (J.eitherDecode + "{\"jsonrpc\":\"2.0\",\"id\": 1,\"result\":1,\"error\":{\"code\":-32700,\"message\":\"\",\"data\":null}}" + :: Either String (ResponseMessage Int)) + `shouldSatisfy` + (either (\err -> isPrefixOf "Error in $: Both error and result cannot be present" err) (\_ -> False)) -- --------------------------------------------------------------------- -propertyJsonRoundtrip :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Property -propertyJsonRoundtrip a = Success a === fromJSON (toJSON a) +propertyJsonRoundtrip :: (Eq a, Show a, J.ToJSON a, J.FromJSON a) => a -> Property +propertyJsonRoundtrip a = J.Success a === J.fromJSON (J.toJSON a) -- --------------------------------------------------------------------- @@ -69,13 +93,11 @@ [ ResponseMessage <$> arbitrary <*> arbitrary - <*> (Just <$> arbitrary) - <*> pure Nothing + <*> (Right <$> arbitrary) , ResponseMessage <$> arbitrary <*> arbitrary - <*> pure Nothing - <*> (Just <$> arbitrary) + <*> (Left <$> arbitrary) ] instance Arbitrary LspIdRsp where @@ -106,6 +128,14 @@ instance (Arbitrary a) => Arbitrary (List a) where arbitrary = List <$> arbitrary + +instance Arbitrary J.Value where + arbitrary = oneof + [ J.String <$> arbitrary + , J.Number <$> arbitrary + , J.Bool <$> arbitrary + , pure J.Null + ] -- ---------------------------------------------------------------------