Invert the dependency between hls-plugin-api and ghcide (haskell#701)

* Invert the dependency between ghcide and hls-plugin-api

This PR includes changes both to ghcide and HLS to implement the reorg described in https://github.com/haskell/ghcide/issues/936#issuecomment-751437853

To summarise:

- `hls-plugin-api` no longer depends on ghcide.
- `ghcide` now depends on `hls-plugin-api` and exposes:
  - The ghcide HLS plugin
  - The `asGhcIdePlugin` adaptor

The goals are:
- to be able to break the `ghcide` HLS plugin down
- to rewrite exe:ghcide on top of the HLS plugin model.

The ghcide side is reviewed in haskell/ghcide#963

If this change is accepted there are two further considerations:
- This would be a good moment to merge the 2 repos, so that there is no history loss.
- `hls-plugin-api` will need to be released to Hackage prior to merging haskell/ghcide#963

* clean up

* Fix the ghcide plugin to include the rules

* clean up PartialHandlers definition

The ghcide partial handlers for completions, code actions and hover are not
really being used, since they get overriden by the `<> ps` append. This is due
to the right-biased semantics of `PartialHandlers`

* Move ghcide LspConfig into Ide.Plugin.Config

* Use HLS plugins in ghcide

For now there is only one, the main ghcide plugin. But this will allow us to
break it down in more fine grained plugins with parallel semantics, both for
execution and error handling

* Fix hlints

* Revert "Temporarily disable the upstream branch for benchmarks"

This reverts commit 7bb3c6e.

* Disable the Windows 8.6.4 test

* Fix unrelated hlints

Not sure why these are triggering now.

Linting should be restricted to the Diff ...

.github/workflows/test.yml

@@ -20,6 +20,8 @@ jobs:
           - os: windows-latest
             ghc: "8.8.2" # fails due to error with Cabal
         include:
+          - os: windows-latest
+            ghc: "8.6.4" # times out after 300m
           - os: windows-latest
             ghc: "8.10.2.2" # only available for windows and choco
           # one ghc-lib build

exe/Plugins.hs

@@ -3,12 +3,13 @@
 module Plugins where
 
 import           Ide.Types                 (IdePlugins)
-import           Ide.Plugin                (pluginDescToIdePlugins)
+import           Ide.PluginUtils           (pluginDescToIdePlugins)
 
 -- fixed plugins
 import           Ide.Plugin.Example        as Example
 import           Ide.Plugin.Example2       as Example2
-import           Ide.Plugin.GhcIde         as GhcIde
+import           Development.IDE           (IdeState)
+import           Development.IDE.Plugin.HLS.GhcIde as GhcIde
 
 -- haskell-language-server optional plugins
 
@@ -73,7 +74,7 @@ import           Ide.Plugin.Brittany       as Brittany
 -- These can be freely added or removed to tailor the available
 -- features of the server.
 
-idePlugins :: Bool -> IdePlugins
+idePlugins :: Bool -> IdePlugins IdeState
 idePlugins includeExamples = pluginDescToIdePlugins allPlugins
   where
     allPlugins = if includeExamples

ghcide/bench/config.yaml

@@ -55,5 +55,5 @@ versions:
 # - v0.4.0
 # - v0.5.0
 # - v0.6.0
-# - upstream: origin/master
+- upstream: origin/master
 - HEAD

ghcide/exe/Main.hs

@@ -28,8 +28,6 @@ import Development.IDE.Types.Diagnostics
 import Development.IDE.Types.Options
 import Development.IDE.Types.Logger
 import Development.IDE.Plugin
-import Development.IDE.Plugin.Completions as Completions
-import Development.IDE.Plugin.CodeAction as CodeAction
 import Development.IDE.Plugin.Test as Test
 import Development.IDE.Session (loadSession)
 import qualified Language.Haskell.LSP.Core as LSP
@@ -54,6 +52,10 @@ import Development.IDE (action)
 import Text.Printf
 import Development.IDE.Core.Tracing
 import Development.IDE.Types.Shake (Key(Key))
+import Development.IDE.Plugin.HLS (asGhcIdePlugin)
+import Development.IDE.Plugin.HLS.GhcIde as GhcIde
+import Ide.Plugin.Config
+import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins)
 
 ghcideVersion :: IO String
 ghcideVersion = do
@@ -83,18 +85,23 @@ main = do
     whenJust argsCwd IO.setCurrentDirectory
 
     dir <- IO.getCurrentDirectory
-    command <- makeLspCommandId "typesignature.add"
 
-    let plugins = Completions.plugin <> CodeAction.plugin
+    let hlsPlugins = pluginDescToIdePlugins [GhcIde.descriptor "ghcide"]
+
+    pid <- T.pack . show <$> getProcessID
+    let hlsPlugin = asGhcIdePlugin hlsPlugins
+        hlsCommands = allLspCmdIds' pid hlsPlugins
+
+    let plugins = hlsPlugin
             <> if argsTesting then Test.plugin else mempty
-        onInitialConfiguration :: InitializeRequest -> Either T.Text LspConfig
+        onInitialConfiguration :: InitializeRequest -> Either T.Text Config
         onInitialConfiguration x = case x ^. params . initializationOptions of
-          Nothing -> Right defaultLspConfig
+          Nothing -> Right def
           Just v -> case J.fromJSON v of
             J.Error err -> Left $ T.pack err
             J.Success a -> Right a
         onConfigurationChange = const $ Left "Updating Not supported"
-        options = def { LSP.executeCommandCommands = Just [command]
+        options = def { LSP.executeCommandCommands = Just hlsCommands
                       , LSP.completionTriggerCharacters = Just "."
                       }
 
@@ -106,7 +113,7 @@ main = do
             t <- t
             hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
             sessionLoader <- loadSession $ fromMaybe dir rootPath
-            config <- fromMaybe defaultLspConfig <$> getConfig
+            config <- fromMaybe def <$> getConfig
             let options = (defaultIdeOptions sessionLoader)
                     { optReportProgress    = clientSupportsProgress caps
                     , optShakeProfiling    = argsShakeProfiling
@@ -159,7 +166,7 @@ main = do
                     , optTesting           = IdeTesting argsTesting
                     , optThreads           = argsThreads
                     , optCheckParents      = NeverCheck
-                    , optCheckProject      = CheckProject False
+                    , optCheckProject      = False
                     }
             logLevel = if argsVerbose then minBound else Info
         ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs

ghcide/ghcide.cabal

@@ -56,6 +56,8 @@ library
         haskell-lsp-types == 0.22.*,
         haskell-lsp == 0.22.*,
         hie-compat,
+        hls-plugin-api,
+        lens,
         mtl,
         network-uri,
         parallel,
@@ -127,7 +129,6 @@ library
         include
     exposed-modules:
         Development.IDE
-        Development.IDE.Compat
         Development.IDE.Core.Debouncer
         Development.IDE.Core.FileStore
         Development.IDE.Core.IdeConfiguration
@@ -163,6 +164,8 @@ library
         Development.IDE.Plugin
         Development.IDE.Plugin.Completions
         Development.IDE.Plugin.CodeAction
+        Development.IDE.Plugin.HLS
+        Development.IDE.Plugin.HLS.GhcIde
         Development.IDE.Plugin.Test
 
     -- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses
@@ -190,6 +193,7 @@ library
         Development.IDE.Plugin.CodeAction.RuleTypes
         Development.IDE.Plugin.Completions.Logic
         Development.IDE.Plugin.Completions.Types
+        Development.IDE.Plugin.HLS.Formatter
         Development.IDE.Types.Action
     ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns
 
@@ -265,6 +269,7 @@ executable ghcide
         haskell-lsp-types,
         heapsize,
         hie-bios,
+        hls-plugin-api,
         ghcide,
         lens,
         optparse-applicative,

ghcide/session-loader/Development/IDE/Session.hs

@@ -136,7 +136,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
                       } <- getShakeExtras
 
     IdeOptions{ optTesting = IdeTesting optTesting
-              , optCheckProject = CheckProject checkProject
+              , optCheckProject = checkProject
               , optCustomDynFlags
               , optExtensions
               } <- getIdeOptions

ghcide/src/Development/IDE.hs

@@ -9,6 +9,7 @@ module Development.IDE
 import Development.IDE.Core.RuleTypes as X
 import Development.IDE.Core.Rules as X
   (getAtPoint
+  ,getClientConfigAction
   ,getDefinition
   ,getParsedModule
   ,getTypeDefinition

ghcide/src/Development/IDE/Core/FileStore.hs

@@ -40,6 +40,7 @@ import Development.IDE.Core.RuleTypes
 import Development.IDE.Types.Options
 import qualified Data.Rope.UTF16 as Rope
 import Development.IDE.Import.DependencyInformation
+import Ide.Plugin.Config (CheckParents(..))
 
 #ifdef mingw32_HOST_OS
 import qualified System.Directory as Dir

ghcide/src/Development/IDE/Core/IdeConfiguration.hs

@@ -88,4 +88,4 @@ isWorkspaceFile file =
           workspaceFolders
 
 getClientSettings :: Action (Maybe Value)
-getClientSettings = unhashed . clientSettings <$> getIdeConfiguration
+getClientSettings = unhashed . clientSettings <$> getIdeConfiguration

ghcide/src/Development/IDE/Core/Rules.hs

@@ -27,11 +27,14 @@ module Development.IDE.Core.Rules(
     highlightAtPoint,
     getDependencies,
     getParsedModule,
+    getClientConfigAction,
     ) where
 
 import Fingerprint
 
+import Data.Aeson (fromJSON, Result(Success), FromJSON)
 import Data.Binary hiding (get, put)
+import Data.Default
 import Data.Tuple.Extra
 import Control.Monad.Extra
 import Control.Monad.Trans.Class
@@ -890,6 +893,15 @@ getClientSettingsRule = defineEarlyCutOffNoFile $ \GetClientSettings -> do
   settings <- clientSettings <$> getIdeConfiguration
   return (BS.pack . show . hash $ settings, settings)
 
+-- | Returns the client configurarion stored in the IdeState.
+-- You can use this function to access it from shake Rules
+getClientConfigAction :: (Default a, FromJSON a) => Action a
+getClientConfigAction = do
+  mbVal <- unhashed <$> useNoFile_ GetClientSettings
+  case fromJSON <$> mbVal of
+    Just (Success c) -> return c
+    _ -> return def
+
 -- | For now we always use bytecode
 getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)
 getLinkableType f = do

ghcide/src/Development/IDE/LSP/Notifications.hs

@@ -33,6 +33,7 @@ import qualified Data.Text                        as Text
 import           Development.IDE.Core.FileStore   (setSomethingModified, setFileModified, typecheckParents)
 import           Development.IDE.Core.FileExists  (modifyFileExists, watchedGlobs)
 import           Development.IDE.Core.OfInterest
+import Ide.Plugin.Config (CheckParents(CheckOnClose))
 
 
 whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()

ghcide/src/Development/IDE/Plugin.hs

@@ -1,14 +1,17 @@
-
-module Development.IDE.Plugin(Plugin(..), codeActionPlugin, codeActionPluginWithRules,makeLspCommandId,getPid) where
+module Development.IDE.Plugin
+  ( Plugin(..)
+  , codeActionPlugin
+  , codeActionPluginWithRules
+  , makeLspCommandId
+  ) where
 
 import Data.Default
 import qualified Data.Text as T
 import Development.Shake
 import Development.IDE.LSP.Server
-
-import           Language.Haskell.LSP.Types
-import Development.IDE.Compat
 import Development.IDE.Core.Rules
+import Ide.PluginUtils
+import           Language.Haskell.LSP.Types
 import qualified Language.Haskell.LSP.Core as LSP
 import Language.Haskell.LSP.Messages
 
@@ -50,11 +53,5 @@ codeActionPluginWithRules rr f = Plugin rr $ PartialHandlers $ \WithMessage{..}
 --   on that.
 makeLspCommandId :: T.Text -> IO T.Text
 makeLspCommandId command = do
-    pid <- getPid
-    return $ pid <> ":ghcide:" <> command
-
--- | Get the operating system process id for the running server
--- instance. This should be the same for the lifetime of the instance,
--- and different from that of any other currently running instance.
-getPid :: IO T.Text
-getPid = T.pack . show <$> getProcessID
+    pid <- getProcessID
+    return $ T.pack (show pid) <> ":ghcide:" <> command

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

@@ -53,6 +53,7 @@ import ConLike
 import GhcPlugins (
     flLabel,
     unpackFS)
+import Data.Either (fromRight)
 
 -- From haskell-ide-engine/hie-plugin-api/Haskell/Ide/Engine/Context.hs
 
@@ -337,14 +338,14 @@ cacheDataProducer packageState curMod rdrEnv limports deps = do
                 name' <- lookupName packageState m n
                 return $ name' >>= safeTyThingForRecord
 
-        let recordCompls = case either (const Nothing) id record_ty of
+        let recordCompls = case fromRight Nothing record_ty of
                 Just (ctxStr, flds) -> case flds of
                     [] -> []
                     _ -> [mkRecordSnippetCompItem ctxStr flds (ppr mn) docs imp']
                 Nothing -> []
 
-        return $ [mkNameCompItem n mn (either (const Nothing) id ty) Nothing docs imp'] ++
-                 recordCompls
+        return $ mkNameCompItem n mn (fromRight Nothing ty) Nothing docs imp'
+                 : recordCompls
 
   (unquals,quals) <- getCompls rdrElts