{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Exposes the ghcide features as an HLS plugin

module Development.IDE.Plugin.HLS.GhcIde
  (
    descriptor
  ) where

import Data.Aeson
import Development.IDE
import Development.IDE.Plugin as Ghcide
import Development.IDE.Plugin.Completions as Completions
import Development.IDE.Plugin.CodeAction as 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 :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
  { pluginCommands :: [PluginCommand IdeState]
pluginCommands = [CommandId
-> Text
-> CommandFunction IdeState WorkspaceEdit
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand (Text -> CommandId
CommandId Text
"typesignature.add") Text
"adds a signature" CommandFunction IdeState WorkspaceEdit
commandAddSignature]
  , pluginCodeActionProvider :: Maybe (CodeActionProvider IdeState)
pluginCodeActionProvider = CodeActionProvider IdeState -> Maybe (CodeActionProvider IdeState)
forall a. a -> Maybe a
Just CodeActionProvider IdeState
codeAction'
  , pluginCodeLensProvider :: Maybe (CodeLensProvider IdeState)
pluginCodeLensProvider   = CodeLensProvider IdeState -> Maybe (CodeLensProvider IdeState)
forall a. a -> Maybe a
Just CodeLensProvider IdeState
codeLens'
  , pluginHoverProvider :: Maybe (HoverProvider IdeState)
pluginHoverProvider      = HoverProvider IdeState -> Maybe (HoverProvider IdeState)
forall a. a -> Maybe a
Just HoverProvider IdeState
hover'
  , pluginSymbolsProvider :: Maybe (SymbolsProvider IdeState)
pluginSymbolsProvider    = SymbolsProvider IdeState -> Maybe (SymbolsProvider IdeState)
forall a. a -> Maybe a
Just SymbolsProvider IdeState
symbolsProvider
  , pluginCompletionProvider :: Maybe (CompletionProvider IdeState)
pluginCompletionProvider = CompletionProvider IdeState -> Maybe (CompletionProvider IdeState)
forall a. a -> Maybe a
Just CompletionProvider IdeState
forall cofd.
LspFuncs cofd
-> IdeState
-> CompletionParams
-> IO (Either ResponseError CompletionResponseResult)
getCompletionsLSP
  , pluginRules :: Rules ()
pluginRules              = Plugin Any -> Rules ()
forall c. Plugin c -> Rules ()
Ghcide.pluginRules Plugin Any
forall c. Plugin c
Completions.plugin Rules () -> Rules () -> Rules ()
forall a. Semigroup a => a -> a -> a
<> Plugin Any -> Rules ()
forall c. Plugin c -> Rules ()
Ghcide.pluginRules Plugin Any
forall c. Plugin c
CodeAction.plugin
  }

-- ---------------------------------------------------------------------


hover' :: HoverProvider IdeState
hover' :: HoverProvider IdeState
hover' IdeState
ideState TextDocumentPositionParams
params = do
    Logger -> Text -> IO ()
logInfo (IdeState -> Logger
ideLogger IdeState
ideState) Text
"GhcIde.hover entered (ideLogger)" -- AZ

    HoverProvider IdeState
hover IdeState
ideState TextDocumentPositionParams
params

-- ---------------------------------------------------------------------


commandAddSignature :: CommandFunction IdeState WorkspaceEdit
commandAddSignature :: CommandFunction IdeState WorkspaceEdit
commandAddSignature LspFuncs Config
lf IdeState
ide WorkspaceEdit
params
    = LspFuncs Config
-> IdeState
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall c.
LspFuncs c
-> IdeState
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
commandHandler LspFuncs Config
lf IdeState
ide (Text
-> Maybe (List Value)
-> Maybe ProgressToken
-> ExecuteCommandParams
ExecuteCommandParams Text
"typesignature.add" (List Value -> Maybe (List Value)
forall a. a -> Maybe a
Just ([Value] -> List Value
forall a. [a] -> List a
List [WorkspaceEdit -> Value
forall a. ToJSON a => a -> Value
toJSON WorkspaceEdit
params])) Maybe ProgressToken
forall a. Maybe a
Nothing)

-- ---------------------------------------------------------------------


codeAction' :: CodeActionProvider IdeState
codeAction' :: CodeActionProvider IdeState
codeAction' LspFuncs Config
lf IdeState
ide PluginId
_ TextDocumentIdentifier
doc Range
range CodeActionContext
context = ([CAResult] -> List CAResult)
-> Either ResponseError [CAResult]
-> Either ResponseError (List CAResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CAResult] -> List CAResult
forall a. [a] -> List a
List (Either ResponseError [CAResult]
 -> Either ResponseError (List CAResult))
-> IO (Either ResponseError [CAResult])
-> IO (Either ResponseError (List CAResult))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LspFuncs Config
-> IdeState
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError [CAResult])
forall c.
LspFuncs c
-> IdeState
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError [CAResult])
codeAction LspFuncs Config
lf IdeState
ide TextDocumentIdentifier
doc Range
range CodeActionContext
context

-- ---------------------------------------------------------------------


codeLens' :: CodeLensProvider IdeState
codeLens' :: CodeLensProvider IdeState
codeLens' LspFuncs Config
lf IdeState
ide PluginId
_ CodeLensParams
params = LspFuncs Config
-> IdeState
-> CodeLensParams
-> IO (Either ResponseError (List CodeLens))
forall c.
LspFuncs c
-> IdeState
-> CodeLensParams
-> IO (Either ResponseError (List CodeLens))
codeLens LspFuncs Config
lf IdeState
ide CodeLensParams
params

-- ---------------------------------------------------------------------


symbolsProvider :: SymbolsProvider IdeState
symbolsProvider :: SymbolsProvider IdeState
symbolsProvider LspFuncs Config
ls IdeState
ide DocumentSymbolParams
params = do
    Either ResponseError DSResult
ds <- LspFuncs Config
-> IdeState
-> DocumentSymbolParams
-> IO (Either ResponseError DSResult)
forall c.
LspFuncs c
-> IdeState
-> DocumentSymbolParams
-> IO (Either ResponseError DSResult)
moduleOutline LspFuncs Config
ls IdeState
ide DocumentSymbolParams
params
    case Either ResponseError DSResult
ds of
        Right (DSDocumentSymbols (List [DocumentSymbol]
ls)) -> Either ResponseError [DocumentSymbol]
-> IO (Either ResponseError [DocumentSymbol])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError [DocumentSymbol]
 -> IO (Either ResponseError [DocumentSymbol]))
-> Either ResponseError [DocumentSymbol]
-> IO (Either ResponseError [DocumentSymbol])
forall a b. (a -> b) -> a -> b
$ [DocumentSymbol] -> Either ResponseError [DocumentSymbol]
forall a b. b -> Either a b
Right [DocumentSymbol]
ls
        Right (DSSymbolInformation (List [SymbolInformation]
_si)) ->
            Either ResponseError [DocumentSymbol]
-> IO (Either ResponseError [DocumentSymbol])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError [DocumentSymbol]
 -> IO (Either ResponseError [DocumentSymbol]))
-> Either ResponseError [DocumentSymbol]
-> IO (Either ResponseError [DocumentSymbol])
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError [DocumentSymbol]
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError [DocumentSymbol])
-> ResponseError -> Either ResponseError [DocumentSymbol]
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError Text
"GhcIde.symbolsProvider: DSSymbolInformation deprecated"
        Left ResponseError
err -> Either ResponseError [DocumentSymbol]
-> IO (Either ResponseError [DocumentSymbol])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError [DocumentSymbol]
 -> IO (Either ResponseError [DocumentSymbol]))
-> Either ResponseError [DocumentSymbol]
-> IO (Either ResponseError [DocumentSymbol])
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError [DocumentSymbol]
forall a b. a -> Either a b
Left ResponseError
err

-- ---------------------------------------------------------------------