diff --git a/exe/Plugins.hs b/exe/Plugins.hs index dec73e8994..4672ab92b2 100644 --- a/exe/Plugins.hs +++ b/exe/Plugins.hs @@ -89,7 +89,6 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins then basePlugins ++ examplePlugins else basePlugins basePlugins = - GhcIde.descriptors ++ #if pragmas Pragmas.descriptor "pragmas" : #endif @@ -135,7 +134,9 @@ idePlugins includeExamples = pluginDescToIdePlugins allPlugins #if splice Splice.descriptor "splice" : #endif - [] + -- The ghcide descriptors should come last so that the notification handlers + -- (which restart the Shake build) run after everything else + GhcIde.descriptors examplePlugins = [Example.descriptor "eg" ,Example2.descriptor "eg2" diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 45457f6d7a..81186a0a21 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -58,7 +58,7 @@ library haddock-library ^>= 1.10.0, hashable, hie-compat ^>= 0.1.0.0, - hls-plugin-api ^>= 1.0.0.0, + hls-plugin-api ^>= 1.1.0.0, lens, hiedb == 0.3.0.1, lsp-types == 1.1.*, diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index df9c12264b..fb0062f6e2 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -41,7 +41,6 @@ import Development.IDE.Core.IdeConfiguration import Development.IDE.Core.Shake import Development.IDE.Core.Tracing import Development.IDE.LSP.HoverDefinition -import Development.IDE.LSP.Notifications import Development.IDE.Types.Logger import System.IO.Unsafe (unsafeInterleaveIO) @@ -100,7 +99,6 @@ runLanguageServer options getHieDbLoc onConfigurationChange userHandlers getIdeS let ideHandlers = mconcat [ setIdeHandlers , userHandlers - , setHandlersNotifications -- absolutely critical, join them with user notifications ] -- Send everything over a channel, since you need to wait until after initialise before diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index ccdcbacab6..e1909691f9 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -7,7 +7,8 @@ {-# LANGUAGE RankNTypes #-} module Development.IDE.LSP.Notifications - ( setHandlersNotifications + ( whenUriFile + , descriptor ) where import qualified Language.LSP.Server as LSP @@ -37,15 +38,15 @@ import Development.IDE.Core.FileStore (resetFileStore, typecheckParents) import Development.IDE.Core.OfInterest import Ide.Plugin.Config (CheckParents (CheckOnClose)) - +import Ide.Types whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath' -setHandlersNotifications :: LSP.Handlers (ServerM c) -setHandlersNotifications = mconcat - [ notificationHandler LSP.STextDocumentDidOpen $ - \ide (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do +descriptor :: PluginId -> PluginDescriptor IdeState +descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers = mconcat + [ mkPluginNotificationHandler LSP.STextDocumentDidOpen $ + \ide _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do updatePositionMapping ide (VersionedTextDocumentIdentifier _uri (Just _version)) (List []) whenUriFile _uri $ \file -> do -- We don't know if the file actually exists, or if the contents match those on disk @@ -54,23 +55,23 @@ setHandlersNotifications = mconcat setFileModified ide False file logDebug (ideLogger ide) $ "Opened text document: " <> getUri _uri - , notificationHandler LSP.STextDocumentDidChange $ - \ide (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do + , mkPluginNotificationHandler LSP.STextDocumentDidChange $ + \ide _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do updatePositionMapping ide identifier changes whenUriFile _uri $ \file -> do modifyFilesOfInterest ide (M.insert file Modified{firstOpen=False}) setFileModified ide False file logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri - , notificationHandler LSP.STextDocumentDidSave $ - \ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do + , mkPluginNotificationHandler LSP.STextDocumentDidSave $ + \ide _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do whenUriFile _uri $ \file -> do modifyFilesOfInterest ide (M.insert file OnDisk) setFileModified ide True file logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri - , notificationHandler LSP.STextDocumentDidClose $ - \ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do + , mkPluginNotificationHandler LSP.STextDocumentDidClose $ + \ide _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do whenUriFile _uri $ \file -> do modifyFilesOfInterest ide (M.delete file) -- Refresh all the files that depended on this @@ -78,8 +79,8 @@ setHandlersNotifications = mconcat when (checkParents >= CheckOnClose) $ typecheckParents ide file logDebug (ideLogger ide) $ "Closed text document: " <> getUri _uri - , notificationHandler LSP.SWorkspaceDidChangeWatchedFiles $ - \ide (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do + , mkPluginNotificationHandler LSP.SWorkspaceDidChangeWatchedFiles $ + \ide _ (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do -- See Note [File existence cache and LSP file watchers] which explains why we get these notifications and -- what we do with them let msg = Text.pack $ show fileEvents @@ -88,22 +89,22 @@ setHandlersNotifications = mconcat resetFileStore ide fileEvents setSomethingModified ide - , notificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $ - \ide (DidChangeWorkspaceFoldersParams events) -> liftIO $ do + , mkPluginNotificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $ + \ide _ (DidChangeWorkspaceFoldersParams events) -> liftIO $ do let add = S.union substract = flip S.difference modifyWorkspaceFolders ide $ add (foldMap (S.singleton . parseWorkspaceFolder) (_added events)) . substract (foldMap (S.singleton . parseWorkspaceFolder) (_removed events)) - , notificationHandler LSP.SWorkspaceDidChangeConfiguration $ - \ide (DidChangeConfigurationParams cfg) -> liftIO $ do + , mkPluginNotificationHandler LSP.SWorkspaceDidChangeConfiguration $ + \ide _ (DidChangeConfigurationParams cfg) -> liftIO $ do let msg = Text.pack $ show cfg logDebug (ideLogger ide) $ "Configuration changed: " <> msg modifyClientSettings ide (const $ Just cfg) setSomethingModified ide - , notificationHandler LSP.SInitialized $ \ide _ -> do + , mkPluginNotificationHandler LSP.SInitialized $ \ide _ _ -> do clientCapabilities <- LSP.getClientCapabilities let watchSupported = case () of _ | LSP.ClientCapabilities{_workspace} <- clientCapabilities @@ -138,3 +139,4 @@ setHandlersNotifications = mconcat void $ LSP.sendRequest SClientRegisterCapability regParams (const $ pure ()) -- TODO handle response else liftIO $ logDebug (ideLogger ide) "Warning: Client does not support watched files. Falling back to OS polling" ] + } diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 2113a38b77..1a87e36582 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE GADTs #-} -{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} module Development.IDE.Plugin.HLS ( @@ -8,6 +10,7 @@ module Development.IDE.Plugin.HLS import Control.Exception (SomeException) import Control.Monad +import Control.Monad.IO.Class import qualified Data.Aeson as J import Data.Bifunctor import Data.Dependent.Map (DMap) @@ -24,6 +27,7 @@ import Development.IDE.Core.Shake import Development.IDE.Core.Tracing import Development.IDE.LSP.Server import Development.IDE.Plugin +import Development.IDE.Types.Logger import Development.Shake (Rules) import Ide.Plugin.Config import Ide.PluginUtils (getClientConfig) @@ -44,7 +48,8 @@ asGhcIdePlugin :: Config -> IdePlugins IdeState -> Plugin Config asGhcIdePlugin defaultConfig mp = mkPlugin rulesPlugins HLS.pluginRules <> mkPlugin executeCommandPlugins HLS.pluginCommands <> - mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers + mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers <> + mkPlugin (extensibleNotificationPlugins defaultConfig) HLS.pluginNotificationHandlers where ls = Map.toList (ipMap mp) @@ -154,6 +159,31 @@ extensiblePlugins defaultConfig xs = Plugin mempty handlers Just xs -> do caps <- LSP.getClientCapabilities pure $ Right $ combineResponses m config caps params xs +-- --------------------------------------------------------------------- + +extensibleNotificationPlugins :: Config -> [(PluginId, PluginNotificationHandlers IdeState)] -> Plugin Config +extensibleNotificationPlugins defaultConfig xs = Plugin mempty handlers + where + IdeNotificationHandlers handlers' = foldMap bakePluginId xs + bakePluginId :: (PluginId, PluginNotificationHandlers IdeState) -> IdeNotificationHandlers + bakePluginId (pid,PluginNotificationHandlers hs) = IdeNotificationHandlers $ DMap.map + (\(PluginNotificationHandler f) -> IdeNotificationHandler [(pid,f pid)]) + hs + handlers = mconcat $ do + (IdeNotification m :=> IdeNotificationHandler fs') <- DMap.assocs handlers' + pure $ notificationHandler m $ \ide params -> do + config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig + let fs = filter (\(pid,_) -> plcGlobalOn $ configForPlugin config pid) fs' + case nonEmpty fs of + Nothing -> do + liftIO $ logInfo (ideLogger ide) "extensibleNotificationPlugins no enabled plugins" + pure () + Just fs -> do + -- We run the notifications in order, so the core ghcide provider + -- (which restarts the shake process) hopefully comes last + mapM_ (\(pid,f) -> otTracedProvider pid (fromString $ show m) $ f ide params) fs + +-- --------------------------------------------------------------------- runConcurrently :: MonadUnliftIO m @@ -175,12 +205,25 @@ combineErrors xs = ResponseError InternalError (T.pack (show xs)) Nothing newtype IdeHandler (m :: J.Method FromClient Request) = IdeHandler [(PluginId,IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either ResponseError (ResponseResult m))))] +-- | Combine the 'PluginHandler' for all plugins +newtype IdeNotificationHandler (m :: J.Method FromClient Notification) + = IdeNotificationHandler [(PluginId, IdeState -> MessageParams m -> LSP.LspM Config ())] +-- type NotificationHandler (m :: Method FromClient Notification) = MessageParams m -> IO ()` + -- | Combine the 'PluginHandlers' for all plugins -newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler) +newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler) +newtype IdeNotificationHandlers = IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler) instance Semigroup IdeHandlers where (IdeHandlers a) <> (IdeHandlers b) = IdeHandlers $ DMap.unionWithKey go a b where - go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a ++ b) + go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a <> b) instance Monoid IdeHandlers where mempty = IdeHandlers mempty + +instance Semigroup IdeNotificationHandlers where + (IdeNotificationHandlers a) <> (IdeNotificationHandlers b) = IdeNotificationHandlers $ DMap.unionWithKey go a b + where + go _ (IdeNotificationHandler a) (IdeNotificationHandler b) = IdeNotificationHandler (a <> b) +instance Monoid IdeNotificationHandlers where + mempty = IdeNotificationHandlers mempty diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index 636c2c6287..9d6892bf75 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -1,29 +1,31 @@ {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} -- | Exposes the ghcide features as an HLS plugin module Development.IDE.Plugin.HLS.GhcIde ( descriptors ) where -import Development.IDE -import Development.IDE.LSP.HoverDefinition -import Development.IDE.LSP.Outline -import Ide.Types -import Language.LSP.Types -import Language.LSP.Server (LspM) -import Text.Regex.TDFA.Text() -import qualified Development.IDE.Plugin.CodeAction as CodeAction -import qualified Development.IDE.Plugin.Completions as Completions -import qualified Development.IDE.Plugin.TypeLenses as TypeLenses -import Control.Monad.IO.Class +import Control.Monad.IO.Class +import Development.IDE +import Development.IDE.LSP.HoverDefinition +import qualified Development.IDE.LSP.Notifications as Notifications +import Development.IDE.LSP.Outline +import qualified Development.IDE.Plugin.CodeAction as CodeAction +import qualified Development.IDE.Plugin.Completions as Completions +import qualified Development.IDE.Plugin.TypeLenses as TypeLenses +import Ide.Types +import Language.LSP.Server (LspM) +import Language.LSP.Types +import Text.Regex.TDFA.Text () descriptors :: [PluginDescriptor IdeState] descriptors = [ descriptor "ghcide-hover-and-symbols", CodeAction.descriptor "ghcide-code-actions", Completions.descriptor "ghcide-completions", - TypeLenses.descriptor "ghcide-type-lenses" + TypeLenses.descriptor "ghcide-type-lenses", + Notifications.descriptor "ghcide-core" ] -- --------------------------------------------------------------------- diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 40313da1fe..7087f97736 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -60,7 +60,7 @@ library , lsp , hie-bios , hiedb - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , hslogger , optparse-applicative , optparse-simple @@ -380,7 +380,7 @@ common hls-test-utils , data-default , lsp , hie-bios - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , hslogger , hspec , hspec-core diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 378364c434..6c6f48319b 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: hls-plugin-api -version: 1.0.0.0 +version: 1.1.0.0 synopsis: Haskell Language Server API for plugin communication description: Please see the README on GitHub at diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index f9585a16c1..10703c5a8e 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -64,6 +64,7 @@ data PluginDescriptor ideState = , pluginCommands :: ![PluginCommand ideState] , pluginHandlers :: PluginHandlers ideState , pluginCustomConfig :: CustomConfig + , pluginNotificationHandlers :: PluginNotificationHandlers ideState } -- | An existential wrapper of 'Properties', used only for documenting and generating config templates @@ -191,6 +192,8 @@ instance PluginMethod TextDocumentRangeFormatting where pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid combineResponses _ _ _ _ (x :| _) = x +-- --------------------------------------------------------------------- + -- | Methods which have a PluginMethod instance data IdeMethod (m :: Method FromClient Request) = PluginMethod m => IdeMethod (SMethod m) instance GEq IdeMethod where @@ -198,12 +201,22 @@ instance GEq IdeMethod where instance GCompare IdeMethod where gcompare (IdeMethod a) (IdeMethod b) = gcompare a b +-- | Methods which have a PluginMethod instance +data IdeNotification (m :: Method FromClient Notification) = HasTracing (MessageParams m) => IdeNotification (SMethod m) +instance GEq IdeNotification where + geq (IdeNotification a) (IdeNotification b) = geq a b +instance GCompare IdeNotification where + gcompare (IdeNotification a) (IdeNotification b) = gcompare a b + -- | Combine handlers for the newtype PluginHandler a (m :: Method FromClient Request) = PluginHandler (PluginId -> a -> MessageParams m -> LspM Config (NonEmpty (Either ResponseError (ResponseResult m)))) -newtype PluginHandlers a = PluginHandlers (DMap IdeMethod (PluginHandler a)) +newtype PluginNotificationHandler a (m :: Method FromClient Notification) + = PluginNotificationHandler (PluginId -> a -> MessageParams m -> LspM Config ()) +newtype PluginHandlers a = PluginHandlers (DMap IdeMethod (PluginHandler a)) +newtype PluginNotificationHandlers a = PluginNotificationHandlers (DMap IdeNotification (PluginNotificationHandler a)) instance Semigroup (PluginHandlers a) where (PluginHandlers a) <> (PluginHandlers b) = PluginHandlers $ DMap.unionWithKey go a b where @@ -213,8 +226,19 @@ instance Semigroup (PluginHandlers a) where instance Monoid (PluginHandlers a) where mempty = PluginHandlers mempty +instance Semigroup (PluginNotificationHandlers a) where + (PluginNotificationHandlers a) <> (PluginNotificationHandlers b) = PluginNotificationHandlers $ DMap.unionWithKey go a b + where + go _ (PluginNotificationHandler f) (PluginNotificationHandler g) = PluginNotificationHandler $ \pid ide params -> + f pid ide params >> g pid ide params + +instance Monoid (PluginNotificationHandlers a) where + mempty = PluginNotificationHandlers mempty + type PluginMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config (Either ResponseError (ResponseResult m)) +type PluginNotificationMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config () + -- | Make a handler for plugins with no extra data mkPluginHandler :: PluginMethod m @@ -225,6 +249,17 @@ mkPluginHandler m f = PluginHandlers $ DMap.singleton (IdeMethod m) (PluginHandl where f' pid ide params = pure <$> f ide pid params +-- | Make a handler for plugins with no extra data +mkPluginNotificationHandler + :: HasTracing (MessageParams m) + => SClientMethod (m :: Method FromClient Notification) + -> PluginNotificationMethodHandler ideState m + -> PluginNotificationHandlers ideState +mkPluginNotificationHandler m f + = PluginNotificationHandlers $ DMap.singleton (IdeNotification m) (PluginNotificationHandler f') + where + f' pid ide = f ide pid + defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState defaultPluginDescriptor plId = PluginDescriptor @@ -233,6 +268,7 @@ defaultPluginDescriptor plId = mempty mempty emptyCustomConfig + mempty newtype CommandId = CommandId T.Text deriving (Show, Read, Eq, Ord) diff --git a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal index f2b6ce840f..0c3961e852 100644 --- a/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal +++ b/plugins/hls-brittany-plugin/hls-brittany-plugin.cabal @@ -22,7 +22,7 @@ library , ghc-boot-th , ghcide ^>= 1.1.0.0 , lsp-types - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , lens , text , transformers diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal index f210186435..5c8e576681 100644 --- a/plugins/hls-class-plugin/hls-class-plugin.cabal +++ b/plugins/hls-class-plugin/hls-class-plugin.cabal @@ -21,7 +21,7 @@ library , base >=4.12 && <5 , containers , lsp - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , ghc , ghc-exactprint , ghcide ^>= 1.1.0.0 diff --git a/plugins/hls-eval-plugin/hls-eval-plugin.cabal b/plugins/hls-eval-plugin/hls-eval-plugin.cabal index 404b0303ee..fa5e6e2992 100644 --- a/plugins/hls-eval-plugin/hls-eval-plugin.cabal +++ b/plugins/hls-eval-plugin/hls-eval-plugin.cabal @@ -53,7 +53,7 @@ library , hashable , lsp , lsp-types - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , lens , megaparsec >=9.0 , mtl diff --git a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal index cb1ad143cf..bc8959a739 100644 --- a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal +++ b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal @@ -21,7 +21,7 @@ library , deepseq , lsp-types , lsp - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , ghc , ghcide ^>= 1.1.0.0 , shake diff --git a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal index 7d91a6535c..0a0401a351 100644 --- a/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal +++ b/plugins/hls-haddock-comments-plugin/hls-haddock-comments-plugin.cabal @@ -25,7 +25,7 @@ library , ghc-exactprint , ghcide ^>= 1.1.0.0 , lsp-types - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , text , unordered-containers diff --git a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 927f3687ed..b181bdc46c 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -43,7 +43,7 @@ library , hashable , lsp , hlint >=3.2 - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , hslogger , lens , regex-tdfa diff --git a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal index 47f374a553..ae23cb1798 100644 --- a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal +++ b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal @@ -23,7 +23,7 @@ library , extra , lsp , lsp-types - , hls-plugin-api ^>= 1.0 + , hls-plugin-api >= 1.0 && < 1.2 , ghc , ghcide ^>= 1.1 , hashable diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal index f0ed041828..52d3a46efd 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -21,7 +21,7 @@ library , extra , foldl , lsp - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , ghc , ghc-exactprint , ghcide ^>= 1.1.0.0 diff --git a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal index 3ff75ba36c..f264bbf4ce 100644 --- a/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal +++ b/plugins/hls-tactics-plugin/hls-tactics-plugin.cabal @@ -67,7 +67,7 @@ library , ghc-source-gen , ghcide ^>= 1.1.0.0 , lsp - , hls-plugin-api ^>= 1.0.0.0 + , hls-plugin-api >= 1.0 && < 1.2 , lens , mtl , refinery ^>=0.3