lsp-types-2.3.0.0: test/JsonSpec.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- we're using some deprecated stuff from the LSP spec, that's fine
{-# OPTIONS_GHC -fno-warn-deprecations #-}

-- | Test for JSON serialization
module JsonSpec where

import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types

import Language.LSP.Protocol.QuickCheck ()

import Data.Aeson qualified as J
import Data.List (isPrefixOf)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck hiding (Success)
import Test.QuickCheck.Instances ()

-- ---------------------------------------------------------------------

{-# ANN module ("HLint: ignore Redundant do" :: String) #-}

spec :: Spec
spec = do
  describe "MarkedString" $ do
    prop "roundtrip" (propertyJsonRoundtrip :: MarkedString -> Property)

  describe "MarkupContent" $ do
    prop "roundtrip" (propertyJsonRoundtrip :: MarkupContent -> Property)

  describe "TextDocumentContentChangeEvent" $ do
    prop "roundtrip" (propertyJsonRoundtrip :: TextDocumentContentChangeEvent -> Property)

  describe "WatchedFiles" $ do
    prop "roundtrip" (propertyJsonRoundtrip :: DidChangeWatchedFilesRegistrationOptions -> Property)

  describe "Registration" $ do
    -- Registration has a 'Maybe Value' field, so this test checks that 'Maybe Null' roundtrips properly
    prop "roundtrip" (propertyJsonRoundtrip :: Registration -> Property)

  describe "CompletionList" $ do
    it "handles optional field set to null in record" $ do
      J.eitherDecode "{ \"isIncomplete\" : true, \"itemDefaults\" : { \"data\" : null }, \"items\": [] }"
        `shouldBe` Right
          ( CompletionList
              True
              (Just (CompletionItemDefaults{_commitCharacters = Nothing, _editRange = Nothing, _insertTextFormat = Nothing, _insertTextMode = Nothing, _data_ = Just J.Null}))
              mempty
          )

  describe "CompletionItem" $ do
    it "example" $
      (J.decode "{\"jsonrpc\":\"2.0\",\"result\":[{\"label\":\"raisebox\"}],\"id\":1}" :: Maybe (TResponseMessage 'Method_TextDocumentCompletion))
        `shouldNotBe` Nothing

  describe "RequestMessage" $ do
    it "handles missing params field" $ do
      J.eitherDecode "{ \"jsonrpc\": \"2.0\", \"id\": 15, \"method\": \"shutdown\"}"
        `shouldBe` Right (TRequestMessage "2.0" (IdInt 15) SMethod_Shutdown Nothing)
    -- The 'params' field on a RequestMessage is optional _and_ null is _not_ a valid value. Check that we correctly parse null as 'Nothing'
    it "handles params field set to null" $ do
      J.eitherDecode "{ \"jsonrpc\": \"2.0\", \"id\": 15, \"method\": \"shutdown\", \"params\": null }"
        `shouldBe` Right (TRequestMessage "2.0" (IdInt 15) SMethod_Shutdown Nothing)

  describe "ResponseMessage" $ do
    prop
      "Hover roundtrip"
      (propertyJsonRoundtrip :: TResponseMessage 'Method_TextDocumentHover -> Property)
    -- The 'data' field on a ResponseError is optional _and_ null is a valid value. Check that we correctly parse null as 'Just Null'
    it "decodes error data = null" $ do
      let input = "{\"jsonrpc\": \"2.0\", \"id\": 123, \"error\": { \"code\": -32700, \"message\": \"oh no\", \"data\": null }}"
       in J.decode input
            `shouldBe` Just
              ( (TResponseMessage "2.0" (Just (IdInt 123)) (Left $ TResponseError (InR ErrorCodes_ParseError) "oh no" (Just J.Null))) ::
                  TResponseMessage ('Method_CustomMethod "hello")
              )
    it "throws if neither result nor error is present" $ do
      (J.eitherDecode "{\"jsonrpc\":\"2.0\",\"id\":1}" :: Either String (TResponseMessage 'Method_Initialize))
        `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\":{\"capabilities\": {}},\"error\":{\"code\":-32700,\"message\":\"\",\"data\":{ \"retry\":false}}}" ::
          Either String (TResponseMessage 'Method_Initialize)
        )
        `shouldSatisfy` (either (\err -> "Error in $: both error and result cannot be present" `isPrefixOf` err) (\_ -> False))
    it "decodes result = null" $ do
      let input = "{\"jsonrpc\": \"2.0\", \"id\": 123, \"result\": null}"
       in J.decode input
            `shouldBe` Just
              ((TResponseMessage "2.0" (Just (IdInt 123)) (Right $ InL J.Null)) :: TResponseMessage 'Method_WorkspaceExecuteCommand)

  describe "NotificationMessage" $ do
    it "handles missing params field" $ do
      J.eitherDecode "{ \"jsonrpc\": \"2.0\", \"method\": \"exit\"}"
        `shouldBe` Right (TNotificationMessage "2.0" SMethod_Exit Nothing)

-- ---------------------------------------------------------------------

propertyJsonRoundtrip :: (Eq a, Show a, J.ToJSON a, J.FromJSON a) => a -> Property
propertyJsonRoundtrip a = J.Success a === J.fromJSON (J.toJSON a)