diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -2,17 +2,17 @@ -- vs RangeMap-based "in-range filtering" approaches module Main (main) where -import Control.DeepSeq (force) -import Control.Exception (evaluate) -import Control.Monad (replicateM) +import Control.DeepSeq (force) +import Control.Exception (evaluate) +import Control.Monad (replicateM) import qualified Criterion import qualified Criterion.Main -import Data.Random (RVar) -import qualified Data.Random as Fu -import qualified Ide.Plugin.RangeMap as RangeMap -import Language.LSP.Types (Position (..), Range (..), UInt, - isSubrangeOf) -import qualified System.Random.Stateful as Random +import Data.Random (RVar) +import qualified Data.Random as Fu +import qualified Ide.Plugin.RangeMap as RangeMap +import Language.LSP.Protocol.Types (Position (..), Range (..), UInt, + isSubrangeOf) +import qualified System.Random.Stateful as Random genRangeList :: Int -> RVar [Range] diff --git a/hls-plugin-api.cabal b/hls-plugin-api.cabal --- a/hls-plugin-api.cabal +++ b/hls-plugin-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-plugin-api -version: 2.6.0.0 +version: 2.7.0.0 synopsis: Haskell Language Server API for plugin communication description: Please see the README on GitHub at @@ -32,7 +32,13 @@ type: git location: https://github.com/haskell/haskell-language-server +common warnings + ghc-options: + -Wall -Wredundant-constraints -Wunused-packages + -Wno-name-shadowing -Wno-unticked-promoted-constructors + library + import: warnings exposed-modules: Ide.Logger Ide.Plugin.Config @@ -60,10 +66,10 @@ , filepath , ghc , hashable - , hls-graph == 2.6.0.0 + , hls-graph == 2.7.0.0 , lens , lens-aeson - , lsp ^>=2.3 + , lsp ^>=2.4 , megaparsec >=9.0 , mtl , opentelemetry >=0.4 @@ -84,10 +90,6 @@ else build-depends: unix - ghc-options: - -Wall -Wredundant-constraints -Wno-name-shadowing - -Wno-unticked-promoted-constructors -Wunused-packages - if flag(pedantic) ghc-options: -Werror @@ -95,15 +97,14 @@ cpp-options: -DUSE_FINGERTREE build-depends: hw-fingertree - default-language: Haskell2010 + default-language: GHC2021 default-extensions: DataKinds - KindSignatures - TypeOperators test-suite tests + import: warnings type: exitcode-stdio-1.0 - default-language: Haskell2010 + default-language: GHC2021 hs-source-dirs: test main-is: Main.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N @@ -125,16 +126,17 @@ , text benchmark rangemap-benchmark + import: warnings -- Benchmark doesn't make sense if fingertree implementation -- is not used. if !flag(use-fingertree) buildable: False type: exitcode-stdio-1.0 - default-language: Haskell2010 + default-language: GHC2021 hs-source-dirs: bench main-is: Main.hs - ghc-options: -threaded -Wall + ghc-options: -threaded build-depends: , base , criterion diff --git a/src/Ide/Logger.hs b/src/Ide/Logger.hs --- a/src/Ide/Logger.hs +++ b/src/Ide/Logger.hs @@ -1,13 +1,9 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} -- | This is a compatibility module that abstracts over the -- concrete choice of logging framework so users can plug in whatever @@ -178,7 +174,7 @@ fileHandle :: Either IOException Handle <- liftIO $ try (openFile path AppendMode) case fileHandle of Left e -> action $ Left e - Right fileHandle -> finally ((Right <$> makeHandleRecorder fileHandle) >>= action) (liftIO $ hClose fileHandle) + Right fileHandle -> finally (makeHandleRecorder fileHandle >>= action . Right) (liftIO $ hClose fileHandle) makeDefaultHandleRecorder :: MonadIO m diff --git a/src/Ide/Plugin/Config.hs b/src/Ide/Plugin/Config.hs --- a/src/Ide/Plugin/Config.hs +++ b/src/Ide/Plugin/Config.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} diff --git a/src/Ide/Plugin/ConfigUtils.hs b/src/Ide/Plugin/ConfigUtils.hs --- a/src/Ide/Plugin/ConfigUtils.hs +++ b/src/Ide/Plugin/ConfigUtils.hs @@ -94,6 +94,7 @@ SMethod_TextDocumentCompletion -> ["completionOn" A..= plcCompletionOn] SMethod_TextDocumentPrepareCallHierarchy -> ["callHierarchyOn" A..= plcCallHierarchyOn] SMethod_TextDocumentSemanticTokensFull -> ["semanticTokensOn" A..= plcSemanticTokensOn] + SMethod_TextDocumentSemanticTokensFullDelta -> ["semanticTokensOn" A..= plcSemanticTokensOn] _ -> [] -- | Generates json schema used in haskell vscode extension @@ -125,6 +126,7 @@ SMethod_TextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions" plcCompletionOn] SMethod_TextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy" plcCallHierarchyOn] SMethod_TextDocumentSemanticTokensFull -> [toKey' "semanticTokensOn" A..= schemaEntry "semantic tokens" plcSemanticTokensOn] + SMethod_TextDocumentSemanticTokensFullDelta -> [toKey' "semanticTokensOn" A..= schemaEntry "semantic tokens" plcSemanticTokensOn] _ -> [] schemaEntry desc defaultVal = A.object diff --git a/src/Ide/Plugin/Error.hs b/src/Ide/Plugin/Error.hs --- a/src/Ide/Plugin/Error.hs +++ b/src/Ide/Plugin/Error.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} module Ide.Plugin.Error ( -- * Plugin Error Handling API PluginError(..), diff --git a/src/Ide/Plugin/Properties.hs b/src/Ide/Plugin/Properties.hs --- a/src/Ide/Plugin/Properties.hs +++ b/src/Ide/Plugin/Properties.hs @@ -1,20 +1,15 @@ -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Ide.Plugin.Properties ( PropertyType (..), ToHsType, + NotElem, MetaData (..), PropertyKey (..), SPropertyKey (..), @@ -106,7 +101,7 @@ SomePropertyKeyWithMetaData (SPropertyKey k) (MetaData t) -- | 'Properties' is a partial implementation of json schema, without supporting union types and validation. --- In hls, it defines a set of properties which used in dedicated configuration of a plugin. +-- In hls, it defines a set of properties used in dedicated configuration of a plugin. -- A property is an immediate child of the json object in each plugin's "config" section. -- It was designed to be compatible with vscode's settings UI. -- Use 'emptyProperties' and 'useProperty' to create and consume 'Properties'. diff --git a/src/Ide/Plugin/RangeMap.hs b/src/Ide/Plugin/RangeMap.hs --- a/src/Ide/Plugin/RangeMap.hs +++ b/src/Ide/Plugin/RangeMap.hs @@ -1,9 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DerivingStrategies #-} -- | A map that allows fast \"in-range\" filtering. 'RangeMap' is meant -- to be constructed once and cached as part of a Shake rule. If @@ -19,14 +15,15 @@ filterByRange, ) where -import Data.Bifunctor (first) -import Data.Foldable (foldl') import Development.IDE.Graph.Classes (NFData) -import Language.LSP.Protocol.Types (Position, - Range (Range), - isSubrangeOf) #ifdef USE_FINGERTREE +import Data.Bifunctor (first) +import Data.Foldable (foldl') import qualified HaskellWorks.Data.IntervalMap.FingerTree as IM +import Language.LSP.Protocol.Types (Position, + Range (Range)) +#else +import Language.LSP.Protocol.Types (Range, isSubrangeOf) #endif -- | A map from code ranges to values. diff --git a/src/Ide/Plugin/Resolve.hs b/src/Ide/Plugin/Resolve.hs --- a/src/Ide/Plugin/Resolve.hs +++ b/src/Ide/Plugin/Resolve.hs @@ -1,11 +1,7 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} {-| This module currently includes helper functions to provide fallback support to code actions that use resolve in HLS. The difference between the two functions for code actions that don't support resolve is that @@ -26,7 +22,7 @@ (^?)) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Except (ExceptT (..), runExceptT) +import Control.Monad.Trans.Except (ExceptT (..)) import qualified Data.Aeson as A import Data.Maybe (catMaybes) @@ -39,11 +35,8 @@ import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types -import Language.LSP.Server (LspT, - ProgressCancellable (Cancellable), - getClientCapabilities, - sendRequest, - withIndefiniteProgress) +import Language.LSP.Server (LspT, getClientCapabilities, + sendRequest) data Log = DoesNotSupportResolve T.Text @@ -144,25 +137,24 @@ codeAction & L.data_ .~ (A.toJSON .WithURI uri <$> data_) where data_ = codeAction ^? L.data_ . _Just executeResolveCmd :: ResolveFunction ideState a 'Method_CodeActionResolve -> CommandFunction ideState CodeAction - executeResolveCmd resolveProvider ideState ca@CodeAction{_data_=Just value} = do - ExceptT $ withIndefiniteProgress "Applying edits for code action..." Cancellable $ runExceptT $ do - case A.fromJSON value of - A.Error err -> throwError $ parseError (Just value) (T.pack err) - A.Success (WithURI uri innerValue) -> do - case A.fromJSON innerValue of - A.Error err -> throwError $ parseError (Just value) (T.pack err) - A.Success innerValueDecoded -> do - resolveResult <- resolveProvider ideState plId ca uri innerValueDecoded - case resolveResult of - ca2@CodeAction {_edit = Just wedits } | diffCodeActions ca ca2 == ["edit"] -> do - _ <- ExceptT $ Right <$> sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) handleWEditCallback - pure $ InR Null - ca2@CodeAction {_edit = Just _ } -> - throwError $ internalError $ - "The resolve provider unexpectedly returned a code action with the following differing fields: " - <> (T.pack $ show $ diffCodeActions ca ca2) - _ -> throwError $ internalError "The resolve provider unexpectedly returned a result with no data field" - executeResolveCmd _ _ CodeAction{_data_= value} = throwError $ invalidParamsError ("The code action to resolve has an illegal data field: " <> (T.pack $ show value)) + executeResolveCmd resolveProvider ideState _token ca@CodeAction{_data_=Just value} = do + case A.fromJSON value of + A.Error err -> throwError $ parseError (Just value) (T.pack err) + A.Success (WithURI uri innerValue) -> do + case A.fromJSON innerValue of + A.Error err -> throwError $ parseError (Just value) (T.pack err) + A.Success innerValueDecoded -> do + resolveResult <- resolveProvider ideState plId ca uri innerValueDecoded + case resolveResult of + ca2@CodeAction {_edit = Just wedits } | diffCodeActions ca ca2 == ["edit"] -> do + _ <- ExceptT $ Right <$> sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedits) handleWEditCallback + pure $ InR Null + ca2@CodeAction {_edit = Just _ } -> + throwError $ internalError $ + "The resolve provider unexpectedly returned a code action with the following differing fields: " + <> (T.pack $ show $ diffCodeActions ca ca2) + _ -> throwError $ internalError "The resolve provider unexpectedly returned a result with no data field" + executeResolveCmd _ _ _ CodeAction{_data_= value} = throwError $ invalidParamsError ("The code action to resolve has an illegal data field: " <> (T.pack $ show value)) handleWEditCallback (Left err ) = do logWith recorder Warning (ApplyWorkspaceEditFailed err) pure () diff --git a/src/Ide/PluginUtils.hs b/src/Ide/PluginUtils.hs --- a/src/Ide/PluginUtils.hs +++ b/src/Ide/PluginUtils.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} diff --git a/src/Ide/Types.hs b/src/Ide/Types.hs --- a/src/Ide/Types.hs +++ b/src/Ide/Types.hs @@ -1,27 +1,18 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE BlockArguments #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MonadComprehensions #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE CUSKs #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MonadComprehensions #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} module Ide.Types ( PluginDescriptor(..), defaultPluginDescriptor, defaultCabalPluginDescriptor , defaultPluginPriority @@ -520,6 +511,9 @@ instance PluginMethod Request Method_TextDocumentSemanticTokensFull where handlesRequest = pluginEnabledWithFeature plcSemanticTokensOn +instance PluginMethod Request Method_TextDocumentSemanticTokensFullDelta where + handlesRequest = pluginEnabledWithFeature plcSemanticTokensOn + instance PluginMethod Request Method_TextDocumentPrepareCallHierarchy where handlesRequest = pluginEnabledWithFeature plcCallHierarchyOn @@ -760,6 +754,9 @@ instance PluginRequestMethod Method_TextDocumentSemanticTokensFull where combineResponses _ _ _ _ (x :| _) = x +instance PluginRequestMethod Method_TextDocumentSemanticTokensFullDelta where + combineResponses _ _ _ _ (x :| _) = x + takeLefts :: [a |? b] -> [a] takeLefts = mapMaybe (\x -> [res | (InL res) <- Just x]) @@ -989,6 +986,7 @@ type CommandFunction ideState a = ideState + -> Maybe ProgressToken -> a -> ExceptT PluginError (LspM Config) (Value |? Null) @@ -1077,6 +1075,7 @@ type FormattingHandler a = a + -> Maybe ProgressToken -> FormattingType -> T.Text -> NormalizedFilePath @@ -1093,11 +1092,11 @@ mf <- lift $ getVirtualFile $ toNormalizedUri uri case mf of Just vf -> do - let typ = case m of - SMethod_TextDocumentFormatting -> FormatText - SMethod_TextDocumentRangeFormatting -> FormatRange (params ^. L.range) + let (typ, mtoken) = case m of + SMethod_TextDocumentFormatting -> (FormatText, params ^. L.workDoneToken) + SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. L.range), params ^. L.workDoneToken) _ -> Prelude.error "mkFormattingHandlers: impossible" - f ide typ (virtualFileText vf) nfp opts + f ide mtoken typ (virtualFileText vf) nfp opts Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri | otherwise = throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri diff --git a/test/Ide/PluginUtilsTest.hs b/test/Ide/PluginUtilsTest.hs --- a/test/Ide/PluginUtilsTest.hs +++ b/test/Ide/PluginUtilsTest.hs @@ -1,16 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Ide.PluginUtilsTest ( tests ) where -import Data.Char (isPrint) import qualified Data.Set as Set import qualified Data.Text as T import qualified Ide.Plugin.RangeMap as RangeMap -import Ide.PluginUtils (extractTextInRange, - positionInRange, unescape) +import Ide.PluginUtils (extractTextInRange, unescape) import Language.LSP.Protocol.Types (Position (..), Range (Range), UInt, isSubrangeOf) import Test.Tasty @@ -106,7 +104,7 @@ pure $ Range x1 x2 where genRangeLength :: Gen UInt - genRangeLength = fromInteger <$> chooseInteger (5, 50) + genRangeLength = uInt (5, 50) genRangeMultiline :: Gen Range genRangeMultiline = do @@ -119,17 +117,20 @@ pure $ Range x1 x2 where genSecond :: Gen UInt - genSecond = fromInteger <$> chooseInteger (0, 10) + genSecond = uInt (0, 10) genPosition :: Gen Position genPosition = Position - <$> (fromInteger <$> chooseInteger (0, 1000)) - <*> (fromInteger <$> chooseInteger (0, 150)) + <$> uInt (0, 1000) + <*> uInt (0, 150) +uInt :: (Integer, Integer) -> Gen UInt +uInt (a, b) = fromInteger <$> chooseInteger (a, b) + instance Arbitrary Range where arbitrary = genRange -prop_rangemapListEq :: (Show a, Eq a, Ord a) => Range -> [(Range, a)] -> Property +prop_rangemapListEq :: (Show a, Ord a) => Range -> [(Range, a)] -> Property prop_rangemapListEq r xs = let filteredList = (map snd . filter (isSubrangeOf r . fst)) xs filteredRangeMap = RangeMap.filterByRange r (RangeMap.fromList' xs) diff --git a/test/Ide/TypesTests.hs b/test/Ide/TypesTests.hs --- a/test/Ide/TypesTests.hs +++ b/test/Ide/TypesTests.hs @@ -1,23 +1,19 @@ -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE TypeFamilies #-} module Ide.TypesTests ( tests ) where -import Control.Lens (preview, (?~), (^?)) -import Control.Monad ((>=>)) +import Control.Lens ((?~), (^?)) import Data.Default (Default (def)) import Data.Function ((&)) -import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty) +import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Maybe (isJust) import qualified Data.Text as Text -import Ide.Types (Config (Config), - PluginRequestMethod (combineResponses)) +import Ide.Types (PluginRequestMethod (combineResponses)) import qualified Language.LSP.Protocol.Lens as L -import Language.LSP.Protocol.Message (Method (Method_TextDocumentDefinition), +import Language.LSP.Protocol.Message (MessageParams, MessageResult, SMethod (..)) import Language.LSP.Protocol.Types (ClientCapabilities, Definition (Definition), @@ -29,18 +25,17 @@ Null (Null), Position (Position), Range (Range), - TextDocumentClientCapabilities (TextDocumentClientCapabilities, _definition), + TextDocumentClientCapabilities, TextDocumentIdentifier (TextDocumentIdentifier), TypeDefinitionClientCapabilities (TypeDefinitionClientCapabilities, _dynamicRegistration, _linkSupport), TypeDefinitionParams (..), - Uri (Uri), _L, _R, + Uri (Uri), _L, _R, _definition, _typeDefinition, filePathToUri, type (|?) (..)) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (assertBool, testCase, (@=?)) +import Test.Tasty.HUnit (testCase, (@=?)) import Test.Tasty.QuickCheck (ASCIIString (ASCIIString), Arbitrary (arbitrary), Gen, - NonEmptyList (NonEmpty), arbitraryBoundedEnum, cover, listOf1, oneof, testProperty, (===)) @@ -63,6 +58,11 @@ combineResponsesTextDocumentTypeDefinitionTests = testGroup "TextDocumentTypeDefinition" $ defAndTypeDefSharedTests SMethod_TextDocumentTypeDefinition typeDefinitionParams +defAndTypeDefSharedTests :: + ( MessageResult m ~ (Definition |? ([DefinitionLink] |? Null)) + , PluginRequestMethod m + ) + => SMethod m -> MessageParams m -> [TestTree] defAndTypeDefSharedTests message params = [ testCase "merges all single location responses into one response with all locations (without upgrading to links)" $ do let pluginResponses :: NonEmpty (Definition |? ([DefinitionLink] |? Null)) @@ -177,7 +177,11 @@ (isJust (result ^? _L) || isJust (result ^? _R >>= (^? _R))) === True ] -(range1, range2, range3) = (Range (Position 3 0) $ Position 3 5, Range (Position 5 7) $ Position 5 13, Range (Position 24 30) $ Position 24 40) + +range1, range2, range3 :: Range +range1 = Range (Position 3 0) $ Position 3 5 +range2 = Range (Position 5 7) $ Position 5 13 +range3 = Range (Position 24 30) $ Position 24 40 supportsLinkInAllDefinitionCaps :: ClientCapabilities supportsLinkInAllDefinitionCaps = def & L.textDocument ?~ textDocumentCaps