Invert the dependency with hls-plugin-api

ghcide.cabal

@@ -55,6 +55,8 @@ library
         haskell-lsp-types == 0.22.*,
         haskell-lsp == 0.22.*,
         hie-compat,
+        hls-plugin-api,
+        lens,
         mtl,
         network-uri,
         parallel,
@@ -126,7 +128,6 @@ library
         include
     exposed-modules:
         Development.IDE
-        Development.IDE.Compat
         Development.IDE.Core.Debouncer
         Development.IDE.Core.FileStore
         Development.IDE.Core.IdeConfiguration
@@ -161,6 +162,9 @@ library
         Development.IDE.Plugin
         Development.IDE.Plugin.Completions
         Development.IDE.Plugin.CodeAction
+        Development.IDE.Plugin.Formatter
+        Development.IDE.Plugin.GhcIde
+        Development.IDE.Plugin.HLS
         Development.IDE.Plugin.Test
 
     -- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses

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

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

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
@@ -886,6 +889,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

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

src/Development/IDE/Plugin/CodeAction.hs

@@ -648,7 +648,7 @@ suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
     | Just (binding, mod_srcspan) <-
       matchRegExMultipleImports _message
     , Just c <- contents
-    = mod_srcspan >>= (\(x, y) -> suggestions c binding x y) 
+    = mod_srcspan >>= (\(x, y) -> suggestions c binding x y)
     | otherwise = []
     where
         suggestions c binding mod srcspan
@@ -664,7 +664,7 @@ suggestExtendImport exportsMap contents Diagnostic{_range=_range,..}
         renderImport IdentInfo {parent, rendered}
           | Just p <- parent = p <> "(" <> rendered <> ")"
           | otherwise        = rendered
-        lookupExportMap binding mod 
+        lookupExportMap binding mod
           | Just match <- Map.lookup binding (getExportsMap exportsMap)
           , [(ident, _)] <- filter (\(_,m) -> mod == m) (Set.toList match)
            = Just ident

src/Development/IDE/Plugin/Formatter.hs

@@ -0,0 +1,75 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Development.IDE.Plugin.Formatter
+  (
+    formatting
+  , rangeFormatting
+  )
+where
+
+import qualified Data.Map  as Map
+import qualified Data.Text as T
+import           Development.IDE
+import           Ide.PluginUtils
+import           Ide.Types
+import           Ide.Plugin.Config
+import qualified Language.Haskell.LSP.Core as LSP
+import           Language.Haskell.LSP.Types
+import           Text.Regex.TDFA.Text()
+
+-- ---------------------------------------------------------------------
+
+formatting :: Map.Map PluginId (FormattingProvider IdeState IO)
+           -> LSP.LspFuncs Config -> IdeState -> DocumentFormattingParams
+           -> IO (Either ResponseError (List TextEdit))
+formatting providers lf ideState
+    (DocumentFormattingParams (TextDocumentIdentifier uri) params _mprogress)
+  = doFormatting lf providers ideState FormatText uri params
+
+-- ---------------------------------------------------------------------
+
+rangeFormatting :: Map.Map PluginId (FormattingProvider IdeState IO)
+                -> LSP.LspFuncs Config -> IdeState -> DocumentRangeFormattingParams
+                -> IO (Either ResponseError (List TextEdit))
+rangeFormatting providers lf ideState
+    (DocumentRangeFormattingParams (TextDocumentIdentifier uri) range params _mprogress)
+  = doFormatting lf providers ideState (FormatRange range) uri params
+
+-- ---------------------------------------------------------------------
+
+doFormatting :: LSP.LspFuncs Config -> Map.Map PluginId (FormattingProvider IdeState IO)
+             -> IdeState -> FormattingType -> Uri -> FormattingOptions
+             -> IO (Either ResponseError (List TextEdit))
+doFormatting lf providers ideState ft uri params = do
+  mc <- LSP.config lf
+  let mf = maybe "none" formattingProvider mc
+  case Map.lookup (PluginId mf) providers of
+      Just provider ->
+        case uriToFilePath uri of
+          Just (toNormalizedFilePath -> fp) -> do
+            (_, mb_contents) <- runAction "Formatter" ideState $ getFileContents fp
+            case mb_contents of
+              Just contents -> do
+                  logDebug (ideLogger ideState) $ T.pack $
+                      "Formatter.doFormatting: contents=" ++ show contents -- AZ
+                  provider lf ideState ft contents fp params
+              Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri
+          Nothing -> return $ Left $ responseError $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri
+      Nothing -> return $ Left $ responseError $ mconcat
+        [ "Formatter plugin: no formatter found for:["
+        , mf
+        , "]"
+        , if mf == "brittany"
+          then T.unlines
+            [ "\nThe haskell-language-server must be compiled with the agpl flag to provide Brittany."
+            , "Stack users add 'agpl: true' in the flags section of the 'stack.yaml' file."
+            , "The 'haskell-language-server.cabal' file already has this flag enabled by default."
+            , "For more information see: https://github.com/haskell/haskell-language-server/issues/269"
+            ]
+          else ""
+        ]
+

src/Development/IDE/Plugin/GhcIde.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Development.IDE.Plugin.GhcIde
+  (
+    descriptor
+  ) where
+
+import Data.Aeson
+import Development.IDE
+import Development.IDE.Plugin.Completions
+import Development.IDE.Plugin.CodeAction
+import Development.IDE.LSP.HoverDefinition
+import Development.IDE.LSP.Outline
+import Ide.PluginUtils
+import Ide.Types
+import Language.Haskell.LSP.Types
+import Text.Regex.TDFA.Text()
+
+-- ---------------------------------------------------------------------
+
+descriptor :: PluginId -> PluginDescriptor IdeState
+descriptor plId = (defaultPluginDescriptor plId)
+  { pluginCommands = [PluginCommand (CommandId "typesignature.add") "adds a signature" commandAddSignature]
+  , pluginCodeActionProvider = Just codeAction'
+  , pluginCodeLensProvider   = Just codeLens'
+  , pluginHoverProvider      = Just hover'
+  , pluginSymbolsProvider    = Just symbolsProvider
+  , pluginCompletionProvider = Just getCompletionsLSP
+  }
+
+-- ---------------------------------------------------------------------
+
+hover' :: HoverProvider IdeState
+hover' ideState params = do
+    logInfo (ideLogger ideState) "GhcIde.hover entered (ideLogger)" -- AZ
+    hover ideState params
+
+-- ---------------------------------------------------------------------
+
+commandAddSignature :: CommandFunction IdeState WorkspaceEdit
+commandAddSignature lf ide params
+    = commandHandler lf ide (ExecuteCommandParams "typesignature.add" (Just (List [toJSON params])) Nothing)
+
+-- ---------------------------------------------------------------------
+
+codeAction' :: CodeActionProvider IdeState
+codeAction' lf ide _ doc range context = fmap List <$> codeAction lf ide doc range context
+
+-- ---------------------------------------------------------------------
+
+codeLens' :: CodeLensProvider IdeState
+codeLens' lf ide _ params = codeLens lf ide params
+
+-- ---------------------------------------------------------------------
+
+symbolsProvider :: SymbolsProvider IdeState
+symbolsProvider ls ide params = do
+    ds <- moduleOutline ls ide params
+    case ds of
+        Right (DSDocumentSymbols (List ls)) -> return $ Right ls
+        Right (DSSymbolInformation (List _si)) ->
+            return $ Left $ responseError "GhcIde.symbolsProvider: DSSymbolInformation deprecated"
+        Left err -> return $ Left err
+
+-- ---------------------------------------------------------------------