Fix the handling of default HLS config again

ghcide/src/Development/IDE.hs

@@ -6,41 +6,45 @@ module Development.IDE
 
 ) where
 
-import Development.IDE.Core.RuleTypes as X
-import Development.IDE.Core.Rules as X
-  (getAtPoint
-  ,getClientConfigAction
-  ,getDefinition
-  ,getParsedModule
-  ,getTypeDefinition
-  )
-import Development.IDE.Core.FileExists as X
-  (getFileExists)
-import Development.IDE.Core.FileStore as X
-  (getFileContents)
-import Development.IDE.Core.IdeConfiguration as X
-  (IdeConfiguration(..)
-  ,isWorkspaceFile)
-import Development.IDE.Core.OfInterest as X (getFilesOfInterest)
-import Development.IDE.Core.Service as X (runAction)
-import Development.IDE.Core.Shake as X
-  ( IdeState,
-    shakeExtras,
-    ShakeExtras,
-    IdeRule,
-    define, defineEarlyCutoff,
-    use, useNoFile, uses, useWithStale, useWithStaleFast, useWithStaleFast',
-    FastResult(..),
-    use_, useNoFile_, uses_, useWithStale_,
-    ideLogger,
-    actionLogger,
-    IdeAction(..), runIdeAction
-  )
-import Development.IDE.GHC.Error as X
-import Development.IDE.GHC.Util as X
-import Development.IDE.Plugin as X
-import Development.IDE.Types.Diagnostics as X
-import Development.IDE.Types.HscEnvEq as X (HscEnvEq(..), hscEnv, hscEnvWithImportPaths)
-import Development.IDE.Types.Location as X
-import Development.IDE.Types.Logger as X
-import Development.Shake as X (Action, action, Rules, RuleResult)
+import           Development.IDE.Core.FileExists       as X (getFileExists)
+import           Development.IDE.Core.FileStore        as X (getFileContents)
+import           Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..),
+                                                             isWorkspaceFile)
+import           Development.IDE.Core.OfInterest       as X (getFilesOfInterest)
+import           Development.IDE.Core.RuleTypes        as X
+import           Development.IDE.Core.Rules            as X (getAtPoint,
+                                                             getClientConfigAction,
+                                                             getDefinition,
+                                                             getParsedModule,
+                                                             getTypeDefinition)
+import           Development.IDE.Core.Service          as X (runAction)
+import           Development.IDE.Core.Shake            as X (FastResult (..),
+                                                             IdeAction (..),
+                                                             IdeRule, IdeState,
+                                                             ShakeExtras,
+                                                             actionLogger,
+                                                             define,
+                                                             defineEarlyCutoff,
+                                                             getClientConfig,
+                                                             getPluginConfig,
+                                                             ideLogger,
+                                                             runIdeAction,
+                                                             shakeExtras, use,
+                                                             useNoFile,
+                                                             useNoFile_,
+                                                             useWithStale,
+                                                             useWithStaleFast,
+                                                             useWithStaleFast',
+                                                             useWithStale_,
+                                                             use_, uses, uses_)
+import           Development.IDE.GHC.Error             as X
+import           Development.IDE.GHC.Util              as X
+import           Development.IDE.Plugin                as X
+import           Development.IDE.Types.Diagnostics     as X
+import           Development.IDE.Types.HscEnvEq        as X (HscEnvEq (..),
+                                                             hscEnv,
+                                                             hscEnvWithImportPaths)
+import           Development.IDE.Types.Location        as X
+import           Development.IDE.Types.Logger          as X
+import           Development.Shake                     as X (Action, RuleResult,
+                                                             Rules, action)

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

@@ -1,9 +1,9 @@
 -- Copyright (c) 2019 The DAML Authors. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 
-{-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE TypeFamilies      #-}
 
 -- | A Shake implementation of the compiler service, built
 --   using the "Shaker" abstraction layer for in-memory use.
@@ -18,26 +18,27 @@ module Development.IDE.Core.Service(
     updatePositionMapping,
     ) where
 
-import Development.IDE.Types.Options (IdeOptions(..))
-import Development.IDE.Core.Debouncer
-import           Development.IDE.Core.FileStore  (fileStoreRules)
+import           Development.IDE.Core.Debouncer
 import           Development.IDE.Core.FileExists (fileExistsRules)
+import           Development.IDE.Core.FileStore  (fileStoreRules)
 import           Development.IDE.Core.OfInterest
-import Development.IDE.Types.Logger as Logger
+import           Development.IDE.Types.Logger    as Logger
+import           Development.IDE.Types.Options   (IdeOptions (..))
 import           Development.Shake
-import qualified Language.LSP.Server as LSP
-import qualified Language.LSP.Types as LSP
 import           Ide.Plugin.Config
+import qualified Language.LSP.Server             as LSP
+import qualified Language.LSP.Types              as LSP
 
+import           Control.Monad
 import           Development.IDE.Core.Shake
-import Control.Monad
 
 
 ------------------------------------------------------------
 -- Exposed API
 
 -- | Initialise the Compiler Service.
-initialise :: Rules ()
+initialise :: Config
+           -> Rules ()
            -> Maybe (LSP.LanguageContextEnv Config)
            -> Logger
            -> Debouncer LSP.NormalizedUri
@@ -46,9 +47,10 @@ initialise :: Rules ()
            -> HieDb
            -> IndexQueue
            -> IO IdeState
-initialise mainRule lspEnv logger debouncer options vfs hiedb hiedbChan =
+initialise defaultConfig mainRule lspEnv logger debouncer options vfs hiedb hiedbChan =
     shakeOpen
         lspEnv
+        defaultConfig
         logger
         debouncer
         (optShakeProfiling options)

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

@@ -47,6 +47,8 @@ module Development.IDE.Core.Shake(
     getIdeOptions,
     getIdeOptionsIO,
     GlobalIdeOptions(..),
+    getClientConfig,
+    getPluginConfig,
     garbageCollect,
     knownTargets,
     setPriority,
@@ -140,6 +142,8 @@ import           Control.Exception.Extra hiding (bracket_)
 import UnliftIO.Exception (bracket_)
 import           Ide.Plugin.Config
 import Data.Default
+import qualified Ide.PluginUtils               as HLS
+import           Ide.Types                      ( PluginId )
 
 -- | We need to serialize writes to the database, so we send any function that
 -- needs to write to the database over the channel, where it will be picked up by
@@ -196,6 +200,8 @@ data ShakeExtras = ShakeExtras
       -- ^ Registery for functions that compute/get "stale" results for the rule
       -- (possibly from disk)
     , vfs :: VFSHandle
+    , defaultConfig :: Config
+      -- ^ Default HLS config, only relevant if the client does not provide any Config
     }
 
 type WithProgressFunc = forall a.
@@ -219,6 +225,16 @@ getShakeExtrasRules = do
     Just x <- getShakeExtraRules @ShakeExtras
     return x
 
+getClientConfig :: LSP.MonadLsp Config m => ShakeExtras -> m Config
+getClientConfig ShakeExtras { defaultConfig } =
+    fromMaybe defaultConfig <$> HLS.getClientConfig
+
+getPluginConfig
+    :: LSP.MonadLsp Config m => ShakeExtras -> PluginId -> m PluginConfig
+getPluginConfig extras plugin = do
+    config <- getClientConfig extras
+    return $ HLS.configForPlugin config plugin
+
 -- | Register a function that will be called to get the "stale" result of a rule, possibly from disk
 -- This is called when we don't already have a result, or computing the rule failed.
 -- The result of this function will always be marked as 'stale', and a 'proper' rebuild of the rule will
@@ -445,6 +461,7 @@ seqValue v b = case v of
 
 -- | Open a 'IdeState', should be shut using 'shakeShut'.
 shakeOpen :: Maybe (LSP.LanguageContextEnv Config)
+          -> Config
           -> Logger
           -> Debouncer NormalizedUri
           -> Maybe FilePath
@@ -456,7 +473,7 @@ shakeOpen :: Maybe (LSP.LanguageContextEnv Config)
           -> ShakeOptions
           -> Rules ()
           -> IO IdeState
-shakeOpen lspEnv logger debouncer
+shakeOpen lspEnv defaultConfig logger debouncer
   shakeProfileDir (IdeReportProgress reportProgress) ideTesting@(IdeTesting testing) hiedb indexQueue vfs opts rules = mdo
 
     inProgress <- newVar HMap.empty

ghcide/src/Development/IDE/Main.hs

@@ -104,7 +104,7 @@ defaultMain :: Arguments -> IO ()
 defaultMain Arguments{..} = do
     pid <- T.pack . show <$> getProcessID
 
-    let hlsPlugin = asGhcIdePlugin argsHlsPlugins
+    let hlsPlugin = asGhcIdePlugin argsDefaultHlsConfig argsHlsPlugins
         hlsCommands = allLspCmdIds' pid argsHlsPlugins
         plugins = hlsPlugin <> argsGhcidePlugin
         options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands }
@@ -138,6 +138,7 @@ defaultMain Arguments{..} = do
                     caps = LSP.resClientCapabilities env
                 debouncer <- newAsyncDebouncer
                 initialise
+                    argsDefaultHlsConfig
                     rules
                     (Just env)
                     argsLogger
@@ -177,7 +178,7 @@ defaultMain Arguments{..} = do
                         { optCheckParents = pure NeverCheck
                         , optCheckProject = pure False
                         }
-            ide <- initialise rules Nothing argsLogger debouncer options vfs hiedb hieChan
+            ide <- initialise argsDefaultHlsConfig rules Nothing argsLogger debouncer options vfs hiedb hieChan
 
             putStrLn "\nStep 4/4: Type checking the files"
             setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files

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

@@ -9,38 +9,38 @@ module Development.IDE.Plugin.Completions
     , NonLocalCompletions(..)
     ) where
 
-import Control.Monad
-import Control.Monad.Extra
-import Control.Monad.Trans.Maybe
-import Data.Aeson
-import Data.List (find)
-import Data.Maybe
-import qualified Data.Text as T
-import Language.LSP.Types
-import qualified Language.LSP.Server as LSP
-import qualified Language.LSP.VFS as VFS
-import Development.Shake.Classes
-import Development.Shake
-import GHC.Generics
-import Development.IDE.Core.Service
-import Development.IDE.Core.PositionMapping
-import Development.IDE.Plugin.Completions.Logic
-import Development.IDE.Types.Location
-import Development.IDE.Core.RuleTypes
-import Development.IDE.Core.Shake
-import Development.IDE.GHC.Compat
-import Development.IDE.GHC.ExactPrint (Annotated (annsA), GetAnnotatedParsedSource (GetAnnotatedParsedSource))
-import Development.IDE.Types.HscEnvEq (hscEnv)
-import Development.IDE.Plugin.CodeAction.ExactPrint
-import Development.IDE.Plugin.Completions.Types
-import Ide.Plugin.Config (Config (completionSnippetsOn))
-import Ide.PluginUtils (getClientConfig)
-import Ide.Types
-import TcRnDriver (tcRnImportDecls)
-import Control.Concurrent.Async (concurrently)
-import GHC.Exts (toList)
-import Development.IDE.GHC.Error (rangeToSrcSpan)
-import Development.IDE.GHC.Util (prettyPrint)
+import           Control.Concurrent.Async                     (concurrently)
+import           Control.Monad
+import           Control.Monad.Extra
+import           Control.Monad.Trans.Maybe
+import           Data.Aeson
+import           Data.List                                    (find)
+import           Data.Maybe
+import qualified Data.Text                                    as T
+import           Development.IDE.Core.PositionMapping
+import           Development.IDE.Core.RuleTypes
+import           Development.IDE.Core.Service
+import           Development.IDE.Core.Shake
+import           Development.IDE.GHC.Compat
+import           Development.IDE.GHC.Error                    (rangeToSrcSpan)
+import           Development.IDE.GHC.ExactPrint               (Annotated (annsA),
+                                                               GetAnnotatedParsedSource (GetAnnotatedParsedSource))
+import           Development.IDE.GHC.Util                     (prettyPrint)
+import           Development.IDE.Plugin.CodeAction.ExactPrint
+import           Development.IDE.Plugin.Completions.Logic
+import           Development.IDE.Plugin.Completions.Types
+import           Development.IDE.Types.HscEnvEq               (hscEnv)
+import           Development.IDE.Types.Location
+import           Development.Shake
+import           Development.Shake.Classes
+import           GHC.Exts                                     (toList)
+import           GHC.Generics
+import           Ide.Plugin.Config                            (Config (completionSnippetsOn))
+import           Ide.Types
+import qualified Language.LSP.Server                          as LSP
+import           Language.LSP.Types
+import qualified Language.LSP.VFS                             as VFS
+import           TcRnDriver                                   (tcRnImportDecls)
 
 descriptor :: PluginId -> PluginDescriptor IdeState
 descriptor plId = (defaultPluginDescriptor plId)
@@ -86,7 +86,7 @@ dropListFromImportDecl iDecl = let
     f d@ImportDecl {ideclHiding} = case ideclHiding of
         Just (False, _) -> d {ideclHiding=Nothing}
         -- if hiding or Nothing just return d
-        _ -> d
+        _               -> d
     f x = x
     in f <$> iDecl
 
@@ -135,7 +135,7 @@ getCompletionsLSP ide plId
                 -> return (InL $ List [])
               (Just pfix', _) -> do
                 let clientCaps = clientCapabilities $ shakeExtras ide
-                config <- getClientConfig
+                config <- getClientConfig $ shakeExtras ide
                 let snippets = WithSnippets . completionSnippetsOn $ config
                 allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps snippets
                 pure $ InL (List allCompletions)
@@ -200,5 +200,5 @@ liftMaybe :: Monad m => Maybe a -> MaybeT m a
 liftMaybe a = MaybeT $ pure a
 
 liftEither :: Monad m => Either e a -> MaybeT m a
-liftEither (Left _) = mzero
+liftEither (Left _)  = mzero
 liftEither (Right x) = return x