{-# LANGUAGE DeriveAnyClass #-}

module Development.IDE.Plugin.HLS
    (
      asGhcIdePlugin
    ) where

import           Control.Exception(SomeException, catch)
import           Control.Lens ( (^.) )
import           Control.Monad
import qualified Data.Aeson as J
import           Data.Either
import qualified Data.List                     as List
import qualified Data.Map  as Map
import           Data.Maybe
import qualified Data.Text                     as T
import           Development.IDE.Core.Shake
import           Development.IDE.LSP.Server
import           Development.IDE.Plugin
import           Development.IDE.Plugin.HLS.Formatter
import           GHC.Generics
import           Ide.Plugin.Config
import           Ide.Types as HLS
import qualified Language.Haskell.LSP.Core as LSP
import           Language.Haskell.LSP.Messages
import           Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types              as J
import qualified Language.Haskell.LSP.Types.Capabilities as C
import           Language.Haskell.LSP.Types.Lens as L hiding (formatting, rangeFormatting)
import qualified Language.Haskell.LSP.VFS                as VFS
import           Text.Regex.TDFA.Text()
import Development.Shake (Rules)
import Ide.PluginUtils (getClientConfig, pluginEnabled, getPluginConfig, responseError, getProcessID)
import Development.IDE.Types.Logger (logInfo)

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


-- | Map a set of plugins to the underlying ghcide engine.  Main point is

-- IdePlugins are arranged by kind of operation, 'Plugin' is arranged by message

-- category ('Notifaction', 'Request' etc).

asGhcIdePlugin :: IdePlugins IdeState -> Plugin Config
asGhcIdePlugin :: IdePlugins IdeState -> Plugin Config
asGhcIdePlugin IdePlugins IdeState
mp =
    ([(PluginId, Rules ())] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe (Rules ())) -> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, Rules ())] -> Plugin Config
rulesPlugins (Rules () -> Maybe (Rules ())
forall a. a -> Maybe a
Just (Rules () -> Maybe (Rules ()))
-> (PluginDescriptor IdeState -> Rules ())
-> PluginDescriptor IdeState
-> Maybe (Rules ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginDescriptor IdeState -> Rules ()
forall ideState. PluginDescriptor ideState -> Rules ()
HLS.pluginRules) Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
    ([(PluginId, [PluginCommand IdeState])] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe [PluginCommand IdeState])
-> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, [PluginCommand IdeState])] -> Plugin Config
executeCommandPlugins ([PluginCommand IdeState] -> Maybe [PluginCommand IdeState]
forall a. a -> Maybe a
Just ([PluginCommand IdeState] -> Maybe [PluginCommand IdeState])
-> (PluginDescriptor IdeState -> [PluginCommand IdeState])
-> PluginDescriptor IdeState
-> Maybe [PluginCommand IdeState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginDescriptor IdeState -> [PluginCommand IdeState]
forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
pluginCommands) Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
    ([(PluginId, CodeActionProvider IdeState)] -> Plugin Config)
-> (PluginDescriptor IdeState
    -> Maybe (CodeActionProvider IdeState))
-> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, CodeActionProvider IdeState)] -> Plugin Config
codeActionPlugins     PluginDescriptor IdeState -> Maybe (CodeActionProvider IdeState)
forall ideState.
PluginDescriptor ideState -> Maybe (CodeActionProvider ideState)
pluginCodeActionProvider Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
    ([(PluginId, CodeLensProvider IdeState)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe (CodeLensProvider IdeState))
-> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, CodeLensProvider IdeState)] -> Plugin Config
codeLensPlugins       PluginDescriptor IdeState -> Maybe (CodeLensProvider IdeState)
forall ideState.
PluginDescriptor ideState -> Maybe (CodeLensProvider ideState)
pluginCodeLensProvider Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
    -- Note: diagnostics are provided via Rules from pluginDiagnosticProvider

    ([(PluginId, HoverProvider IdeState)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe (HoverProvider IdeState))
-> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, HoverProvider IdeState)] -> Plugin Config
hoverPlugins          PluginDescriptor IdeState -> Maybe (HoverProvider IdeState)
forall ideState.
PluginDescriptor ideState -> Maybe (HoverProvider ideState)
pluginHoverProvider Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
    ([(PluginId, SymbolsProvider IdeState)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe (SymbolsProvider IdeState))
-> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, SymbolsProvider IdeState)] -> Plugin Config
symbolsPlugins        PluginDescriptor IdeState -> Maybe (SymbolsProvider IdeState)
forall ideState.
PluginDescriptor ideState -> Maybe (SymbolsProvider ideState)
pluginSymbolsProvider Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
    ([(PluginId, FormattingProvider IdeState IO)] -> Plugin Config)
-> (PluginDescriptor IdeState
    -> Maybe (FormattingProvider IdeState IO))
-> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, FormattingProvider IdeState IO)] -> Plugin Config
formatterPlugins      PluginDescriptor IdeState -> Maybe (FormattingProvider IdeState IO)
forall ideState.
PluginDescriptor ideState -> Maybe (FormattingProvider ideState IO)
pluginFormattingProvider Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
    ([(PluginId, CompletionProvider IdeState)] -> Plugin Config)
-> (PluginDescriptor IdeState
    -> Maybe (CompletionProvider IdeState))
-> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, CompletionProvider IdeState)] -> Plugin Config
completionsPlugins    PluginDescriptor IdeState -> Maybe (CompletionProvider IdeState)
forall ideState.
PluginDescriptor ideState -> Maybe (CompletionProvider ideState)
pluginCompletionProvider Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
    ([(PluginId, RenameProvider IdeState)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe (RenameProvider IdeState))
-> Plugin Config
forall b.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, RenameProvider IdeState)] -> Plugin Config
renamePlugins         PluginDescriptor IdeState -> Maybe (RenameProvider IdeState)
forall ideState.
PluginDescriptor ideState -> Maybe (RenameProvider ideState)
pluginRenameProvider
    where
        justs :: (a, Maybe b) -> [(a, b)]
justs (a
p, Just b
x)  = [(a
p, b
x)]
        justs (a
_, Maybe b
Nothing) = []

        ls :: [(PluginId, PluginDescriptor IdeState)]
ls = Map PluginId (PluginDescriptor IdeState)
-> [(PluginId, PluginDescriptor IdeState)]
forall k a. Map k a -> [(k, a)]
Map.toList (IdePlugins IdeState -> Map PluginId (PluginDescriptor IdeState)
forall ideState.
IdePlugins ideState -> Map PluginId (PluginDescriptor ideState)
ipMap IdePlugins IdeState
mp)

        mkPlugin :: ([(PluginId, b)] -> Plugin Config) -> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
        mkPlugin :: ([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> Maybe b) -> Plugin Config
mkPlugin [(PluginId, b)] -> Plugin Config
maker PluginDescriptor IdeState -> Maybe b
selector =
          case ((PluginId, PluginDescriptor IdeState) -> [(PluginId, b)])
-> [(PluginId, PluginDescriptor IdeState)] -> [(PluginId, b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(PluginId
pid, PluginDescriptor IdeState
p) -> (PluginId, Maybe b) -> [(PluginId, b)]
forall a b. (a, Maybe b) -> [(a, b)]
justs (PluginId
pid, PluginDescriptor IdeState -> Maybe b
selector PluginDescriptor IdeState
p)) [(PluginId, PluginDescriptor IdeState)]
ls of
            -- If there are no plugins that provide a descriptor, use mempty to

            -- create the plugin – otherwise we we end up declaring handlers for

            -- capabilities that there are no plugins for

            [] -> Plugin Config
forall a. Monoid a => a
mempty
            [(PluginId, b)]
xs -> [(PluginId, b)] -> Plugin Config
maker [(PluginId, b)]
xs

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


rulesPlugins :: [(PluginId, Rules ())] -> Plugin Config
rulesPlugins :: [(PluginId, Rules ())] -> Plugin Config
rulesPlugins [(PluginId, Rules ())]
rs = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
rules PartialHandlers Config
forall a. Monoid a => a
mempty
    where
        rules :: Rules ()
rules = ((PluginId, Rules ()) -> Rules ())
-> [(PluginId, Rules ())] -> Rules ()
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PluginId, Rules ()) -> Rules ()
forall a b. (a, b) -> b
snd [(PluginId, Rules ())]
rs

codeActionPlugins :: [(PluginId, CodeActionProvider IdeState)] -> Plugin Config
codeActionPlugins :: [(PluginId, CodeActionProvider IdeState)] -> Plugin Config
codeActionPlugins [(PluginId, CodeActionProvider IdeState)]
cas = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
codeActionRules ([(PluginId, CodeActionProvider IdeState)] -> PartialHandlers Config
codeActionHandlers [(PluginId, CodeActionProvider IdeState)]
cas)

codeActionRules :: Rules ()
codeActionRules :: Rules ()
codeActionRules = Rules ()
forall a. Monoid a => a
mempty

codeActionHandlers :: [(PluginId, CodeActionProvider IdeState)] -> PartialHandlers Config
codeActionHandlers :: [(PluginId, CodeActionProvider IdeState)] -> PartialHandlers Config
codeActionHandlers [(PluginId, CodeActionProvider IdeState)]
cas = (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage Config -> Handlers -> IO Handlers)
 -> PartialHandlers Config)
-> (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x
    { codeActionHandler :: Maybe (Handler CodeActionRequest)
LSP.codeActionHandler
        = (ResponseMessage (List CAResult) -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> CodeActionParams
    -> IO (Either ResponseError (List CAResult)))
-> Maybe (Handler CodeActionRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List CAResult) -> FromServerMessage
RspCodeAction ([(PluginId, CodeActionProvider IdeState)]
-> LspFuncs Config
-> IdeState
-> CodeActionParams
-> IO (Either ResponseError (List CAResult))
makeCodeAction [(PluginId, CodeActionProvider IdeState)]
cas)
    }

makeCodeAction :: [(PluginId, CodeActionProvider IdeState)]
      -> LSP.LspFuncs Config -> IdeState
      -> CodeActionParams
      -> IO (Either ResponseError (List CAResult))
makeCodeAction :: [(PluginId, CodeActionProvider IdeState)]
-> LspFuncs Config
-> IdeState
-> CodeActionParams
-> IO (Either ResponseError (List CAResult))
makeCodeAction [(PluginId, CodeActionProvider IdeState)]
cas LspFuncs Config
lf IdeState
ideState (CodeActionParams TextDocumentIdentifier
docId Range
range CodeActionContext
context Maybe ProgressToken
_) = do
    let caps :: ClientCapabilities
caps = LspFuncs Config -> ClientCapabilities
forall c. LspFuncs c -> ClientCapabilities
LSP.clientCapabilities LspFuncs Config
lf
        unL :: List a -> [a]
unL (List [a]
ls) = [a]
ls
        makeAction :: (PluginId,
 LspFuncs Config
 -> IdeState
 -> PluginId
 -> TextDocumentIdentifier
 -> Range
 -> CodeActionContext
 -> IO (Either a (List a)))
-> IO (Either a (List a))
makeAction (PluginId
pid,LspFuncs Config
-> IdeState
-> PluginId
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either a (List a))
provider) = do
          PluginConfig
pluginConfig <- LspFuncs Config -> PluginId -> IO PluginConfig
getPluginConfig LspFuncs Config
lf PluginId
pid
          if PluginConfig -> (PluginConfig -> Bool) -> Bool
pluginEnabled PluginConfig
pluginConfig PluginConfig -> Bool
plcCodeActionsOn
            then LspFuncs Config
-> IdeState
-> PluginId
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either a (List a))
provider LspFuncs Config
lf IdeState
ideState PluginId
pid TextDocumentIdentifier
docId Range
range CodeActionContext
context
            else Either a (List a) -> IO (Either a (List a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (List a) -> IO (Either a (List a)))
-> Either a (List a) -> IO (Either a (List a))
forall a b. (a -> b) -> a -> b
$ List a -> Either a (List a)
forall a b. b -> Either a b
Right ([a] -> List a
forall a. [a] -> List a
List [])
    [Either ResponseError (List CAResult)]
r <- ((PluginId, CodeActionProvider IdeState)
 -> IO (Either ResponseError (List CAResult)))
-> [(PluginId, CodeActionProvider IdeState)]
-> IO [Either ResponseError (List CAResult)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PluginId, CodeActionProvider IdeState)
-> IO (Either ResponseError (List CAResult))
forall a a.
(PluginId,
 LspFuncs Config
 -> IdeState
 -> PluginId
 -> TextDocumentIdentifier
 -> Range
 -> CodeActionContext
 -> IO (Either a (List a)))
-> IO (Either a (List a))
makeAction [(PluginId, CodeActionProvider IdeState)]
cas
    let actions :: [CAResult]
actions = (CAResult -> Bool) -> [CAResult] -> [CAResult]
forall a. (a -> Bool) -> [a] -> [a]
filter CAResult -> Bool
wasRequested ([CAResult] -> [CAResult])
-> ([List CAResult] -> [CAResult]) -> [List CAResult] -> [CAResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List CAResult -> [CAResult]) -> [List CAResult] -> [CAResult]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap List CAResult -> [CAResult]
forall a. List a -> [a]
unL ([List CAResult] -> [CAResult]) -> [List CAResult] -> [CAResult]
forall a b. (a -> b) -> a -> b
$ [Either ResponseError (List CAResult)] -> [List CAResult]
forall a b. [Either a b] -> [b]
rights [Either ResponseError (List CAResult)]
r
    List CAResult
res <- ClientCapabilities -> [CAResult] -> IO (List CAResult)
send ClientCapabilities
caps [CAResult]
actions
    Either ResponseError (List CAResult)
-> IO (Either ResponseError (List CAResult))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List CAResult)
 -> IO (Either ResponseError (List CAResult)))
-> Either ResponseError (List CAResult)
-> IO (Either ResponseError (List CAResult))
forall a b. (a -> b) -> a -> b
$ List CAResult -> Either ResponseError (List CAResult)
forall a b. b -> Either a b
Right List CAResult
res
  where
    wasRequested :: CAResult -> Bool
    wasRequested :: CAResult -> Bool
wasRequested (CACommand Command
_) = Bool
True
    wasRequested (CACodeAction CodeAction
ca)
      | Maybe (List CodeActionKind)
Nothing <- CodeActionContext -> Maybe (List CodeActionKind)
only CodeActionContext
context = Bool
True
      | Just (List [CodeActionKind]
allowed) <- CodeActionContext -> Maybe (List CodeActionKind)
only CodeActionContext
context
      , Just CodeActionKind
caKind <- CodeAction
ca CodeAction
-> Getting (Maybe CodeActionKind) CodeAction (Maybe CodeActionKind)
-> Maybe CodeActionKind
forall s a. s -> Getting a s a -> a
^. Getting (Maybe CodeActionKind) CodeAction (Maybe CodeActionKind)
forall s a. HasKind s a => Lens' s a
kind = CodeActionKind
caKind CodeActionKind -> [CodeActionKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CodeActionKind]
allowed
      | Bool
otherwise = Bool
False

    wrapCodeAction :: C.ClientCapabilities -> CAResult -> IO (Maybe CAResult)
    wrapCodeAction :: ClientCapabilities -> CAResult -> IO (Maybe CAResult)
wrapCodeAction ClientCapabilities
_ (CACommand Command
cmd) = Maybe CAResult -> IO (Maybe CAResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CAResult -> IO (Maybe CAResult))
-> Maybe CAResult -> IO (Maybe CAResult)
forall a b. (a -> b) -> a -> b
$ CAResult -> Maybe CAResult
forall a. a -> Maybe a
Just (Command -> CAResult
CACommand Command
cmd)
    wrapCodeAction ClientCapabilities
caps (CACodeAction CodeAction
action) = do

      let (C.ClientCapabilities Maybe WorkspaceClientCapabilities
_ Maybe TextDocumentClientCapabilities
textDocCaps Maybe WindowClientCapabilities
_ Maybe Object
_) = ClientCapabilities
caps
      let literalSupport :: Maybe CodeActionLiteralSupport
literalSupport = Maybe TextDocumentClientCapabilities
textDocCaps Maybe TextDocumentClientCapabilities
-> (TextDocumentClientCapabilities
    -> Maybe CodeActionClientCapabilities)
-> Maybe CodeActionClientCapabilities
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextDocumentClientCapabilities
-> Maybe CodeActionClientCapabilities
C._codeAction Maybe CodeActionClientCapabilities
-> (CodeActionClientCapabilities -> Maybe CodeActionLiteralSupport)
-> Maybe CodeActionLiteralSupport
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeActionClientCapabilities -> Maybe CodeActionLiteralSupport
C._codeActionLiteralSupport

      case Maybe CodeActionLiteralSupport
literalSupport of
        Maybe CodeActionLiteralSupport
Nothing -> do
            let cmdParams :: [Value]
cmdParams = [FallbackCodeActionParams -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Maybe WorkspaceEdit -> Maybe Command -> FallbackCodeActionParams
FallbackCodeActionParams (CodeAction
action CodeAction
-> Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
-> Maybe WorkspaceEdit
forall s a. s -> Getting a s a -> a
^. Getting (Maybe WorkspaceEdit) CodeAction (Maybe WorkspaceEdit)
forall s a. HasEdit s a => Lens' s a
edit) (CodeAction
action CodeAction
-> Getting (Maybe Command) CodeAction (Maybe Command)
-> Maybe Command
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Command) CodeAction (Maybe Command)
forall s a. HasCommand s a => Lens' s a
command))]
            Command
cmd <- PluginId -> CommandId -> Text -> Maybe [Value] -> IO Command
mkLspCommand PluginId
"hls" CommandId
"fallbackCodeAction" (CodeAction
action CodeAction -> Getting Text CodeAction Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text CodeAction Text
forall s a. HasTitle s a => Lens' s a
title) ([Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
cmdParams)
            Maybe CAResult -> IO (Maybe CAResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CAResult -> IO (Maybe CAResult))
-> Maybe CAResult -> IO (Maybe CAResult)
forall a b. (a -> b) -> a -> b
$ CAResult -> Maybe CAResult
forall a. a -> Maybe a
Just (Command -> CAResult
CACommand Command
cmd)
        Just CodeActionLiteralSupport
_ -> Maybe CAResult -> IO (Maybe CAResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe CAResult -> IO (Maybe CAResult))
-> Maybe CAResult -> IO (Maybe CAResult)
forall a b. (a -> b) -> a -> b
$ CAResult -> Maybe CAResult
forall a. a -> Maybe a
Just (CodeAction -> CAResult
CACodeAction CodeAction
action)

    send :: C.ClientCapabilities -> [CAResult] -> IO (List CAResult)
    send :: ClientCapabilities -> [CAResult] -> IO (List CAResult)
send ClientCapabilities
caps [CAResult]
codeActions = [CAResult] -> List CAResult
forall a. [a] -> List a
List ([CAResult] -> List CAResult)
-> ([Maybe CAResult] -> [CAResult])
-> [Maybe CAResult]
-> List CAResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe CAResult] -> [CAResult]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe CAResult] -> List CAResult)
-> IO [Maybe CAResult] -> IO (List CAResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CAResult -> IO (Maybe CAResult))
-> [CAResult] -> IO [Maybe CAResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ClientCapabilities -> CAResult -> IO (Maybe CAResult)
wrapCodeAction ClientCapabilities
caps) [CAResult]
codeActions

data FallbackCodeActionParams =
  FallbackCodeActionParams
    { FallbackCodeActionParams -> Maybe WorkspaceEdit
fallbackWorkspaceEdit :: Maybe WorkspaceEdit
    , FallbackCodeActionParams -> Maybe Command
fallbackCommand       :: Maybe Command
    }
  deriving ((forall x.
 FallbackCodeActionParams -> Rep FallbackCodeActionParams x)
-> (forall x.
    Rep FallbackCodeActionParams x -> FallbackCodeActionParams)
-> Generic FallbackCodeActionParams
forall x.
Rep FallbackCodeActionParams x -> FallbackCodeActionParams
forall x.
FallbackCodeActionParams -> Rep FallbackCodeActionParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep FallbackCodeActionParams x -> FallbackCodeActionParams
$cfrom :: forall x.
FallbackCodeActionParams -> Rep FallbackCodeActionParams x
Generic, [FallbackCodeActionParams] -> Encoding
[FallbackCodeActionParams] -> Value
FallbackCodeActionParams -> Encoding
FallbackCodeActionParams -> Value
(FallbackCodeActionParams -> Value)
-> (FallbackCodeActionParams -> Encoding)
-> ([FallbackCodeActionParams] -> Value)
-> ([FallbackCodeActionParams] -> Encoding)
-> ToJSON FallbackCodeActionParams
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FallbackCodeActionParams] -> Encoding
$ctoEncodingList :: [FallbackCodeActionParams] -> Encoding
toJSONList :: [FallbackCodeActionParams] -> Value
$ctoJSONList :: [FallbackCodeActionParams] -> Value
toEncoding :: FallbackCodeActionParams -> Encoding
$ctoEncoding :: FallbackCodeActionParams -> Encoding
toJSON :: FallbackCodeActionParams -> Value
$ctoJSON :: FallbackCodeActionParams -> Value
J.ToJSON, Value -> Parser [FallbackCodeActionParams]
Value -> Parser FallbackCodeActionParams
(Value -> Parser FallbackCodeActionParams)
-> (Value -> Parser [FallbackCodeActionParams])
-> FromJSON FallbackCodeActionParams
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FallbackCodeActionParams]
$cparseJSONList :: Value -> Parser [FallbackCodeActionParams]
parseJSON :: Value -> Parser FallbackCodeActionParams
$cparseJSON :: Value -> Parser FallbackCodeActionParams
J.FromJSON)

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


codeLensPlugins :: [(PluginId, CodeLensProvider IdeState)] -> Plugin Config
codeLensPlugins :: [(PluginId, CodeLensProvider IdeState)] -> Plugin Config
codeLensPlugins [(PluginId, CodeLensProvider IdeState)]
cas = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
codeLensRules ([(PluginId, CodeLensProvider IdeState)] -> PartialHandlers Config
codeLensHandlers [(PluginId, CodeLensProvider IdeState)]
cas)

codeLensRules :: Rules ()
codeLensRules :: Rules ()
codeLensRules = Rules ()
forall a. Monoid a => a
mempty

codeLensHandlers :: [(PluginId, CodeLensProvider IdeState)] -> PartialHandlers Config
codeLensHandlers :: [(PluginId, CodeLensProvider IdeState)] -> PartialHandlers Config
codeLensHandlers [(PluginId, CodeLensProvider IdeState)]
cas = (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage Config -> Handlers -> IO Handlers)
 -> PartialHandlers Config)
-> (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x
    { codeLensHandler :: Maybe (Handler CodeLensRequest)
LSP.codeLensHandler
        = (ResponseMessage (List CodeLens) -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> CodeLensParams
    -> IO (Either ResponseError (List CodeLens)))
-> Maybe (Handler CodeLensRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List CodeLens) -> FromServerMessage
RspCodeLens ([(PluginId, CodeLensProvider IdeState)]
-> LspFuncs Config
-> IdeState
-> CodeLensParams
-> IO (Either ResponseError (List CodeLens))
makeCodeLens [(PluginId, CodeLensProvider IdeState)]
cas)
    }

makeCodeLens :: [(PluginId, CodeLensProvider IdeState)]
      -> LSP.LspFuncs Config
      -> IdeState
      -> CodeLensParams
      -> IO (Either ResponseError (List CodeLens))
makeCodeLens :: [(PluginId, CodeLensProvider IdeState)]
-> LspFuncs Config
-> IdeState
-> CodeLensParams
-> IO (Either ResponseError (List CodeLens))
makeCodeLens [(PluginId, CodeLensProvider IdeState)]
cas LspFuncs Config
lf IdeState
ideState CodeLensParams
params = do
    Logger -> Text -> IO ()
logInfo (IdeState -> Logger
ideLogger IdeState
ideState) Text
"Plugin.makeCodeLens (ideLogger)" -- AZ

    let
      makeLens :: (PluginId,
 LspFuncs Config
 -> IdeState
 -> PluginId
 -> CodeLensParams
 -> IO (Either a (List a)))
-> IO (PluginId, Either a (List a))
makeLens (PluginId
pid, LspFuncs Config
-> IdeState -> PluginId -> CodeLensParams -> IO (Either a (List a))
provider) = do
          PluginConfig
pluginConfig <- LspFuncs Config -> PluginId -> IO PluginConfig
getPluginConfig LspFuncs Config
lf PluginId
pid
          Either a (List a)
r <- if PluginConfig -> (PluginConfig -> Bool) -> Bool
pluginEnabled PluginConfig
pluginConfig PluginConfig -> Bool
plcCodeLensOn
                 then LspFuncs Config
-> IdeState -> PluginId -> CodeLensParams -> IO (Either a (List a))
provider LspFuncs Config
lf IdeState
ideState PluginId
pid CodeLensParams
params
                 else Either a (List a) -> IO (Either a (List a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (List a) -> IO (Either a (List a)))
-> Either a (List a) -> IO (Either a (List a))
forall a b. (a -> b) -> a -> b
$ List a -> Either a (List a)
forall a b. b -> Either a b
Right ([a] -> List a
forall a. [a] -> List a
List [])
          (PluginId, Either a (List a)) -> IO (PluginId, Either a (List a))
forall (m :: * -> *) a. Monad m => a -> m a
return (PluginId
pid, Either a (List a)
r)
      breakdown :: [(PluginId, Either ResponseError a)] -> ([(PluginId, ResponseError)], [(PluginId, a)])
      breakdown :: [(PluginId, Either ResponseError a)]
-> ([(PluginId, ResponseError)], [(PluginId, a)])
breakdown [(PluginId, Either ResponseError a)]
ls = (((PluginId, Either ResponseError a) -> [(PluginId, ResponseError)])
-> [(PluginId, Either ResponseError a)]
-> [(PluginId, ResponseError)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PluginId, Either ResponseError a) -> [(PluginId, ResponseError)]
forall a b b. (a, Either b b) -> [(a, b)]
doOneLeft [(PluginId, Either ResponseError a)]
ls, ((PluginId, Either ResponseError a) -> [(PluginId, a)])
-> [(PluginId, Either ResponseError a)] -> [(PluginId, a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PluginId, Either ResponseError a) -> [(PluginId, a)]
forall a a b. (a, Either a b) -> [(a, b)]
doOneRight [(PluginId, Either ResponseError a)]
ls)
        where
          doOneLeft :: (a, Either b b) -> [(a, b)]
doOneLeft (a
pid, Left b
err) = [(a
pid,b
err)]
          doOneLeft (a
_, Right b
_) = []

          doOneRight :: (a, Either a b) -> [(a, b)]
doOneRight (a
pid, Right b
a) = [(a
pid,b
a)]
          doOneRight (a
_, Left a
_) = []

    [(PluginId, Either ResponseError (List CodeLens))]
r <- ((PluginId, CodeLensProvider IdeState)
 -> IO (PluginId, Either ResponseError (List CodeLens)))
-> [(PluginId, CodeLensProvider IdeState)]
-> IO [(PluginId, Either ResponseError (List CodeLens))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PluginId, CodeLensProvider IdeState)
-> IO (PluginId, Either ResponseError (List CodeLens))
forall a a.
(PluginId,
 LspFuncs Config
 -> IdeState
 -> PluginId
 -> CodeLensParams
 -> IO (Either a (List a)))
-> IO (PluginId, Either a (List a))
makeLens [(PluginId, CodeLensProvider IdeState)]
cas
    case [(PluginId, Either ResponseError (List CodeLens))]
-> ([(PluginId, ResponseError)], [(PluginId, List CodeLens)])
forall a.
[(PluginId, Either ResponseError a)]
-> ([(PluginId, ResponseError)], [(PluginId, a)])
breakdown [(PluginId, Either ResponseError (List CodeLens))]
r of
        ([],[]) -> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List CodeLens)
 -> IO (Either ResponseError (List CodeLens)))
-> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall a b. (a -> b) -> a -> b
$ List CodeLens -> Either ResponseError (List CodeLens)
forall a b. b -> Either a b
Right (List CodeLens -> Either ResponseError (List CodeLens))
-> List CodeLens -> Either ResponseError (List CodeLens)
forall a b. (a -> b) -> a -> b
$ [CodeLens] -> List CodeLens
forall a. [a] -> List a
List []
        ([(PluginId, ResponseError)]
es,[]) -> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List CodeLens)
 -> IO (Either ResponseError (List CodeLens)))
-> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError (List CodeLens)
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError (List CodeLens))
-> ResponseError -> Either ResponseError (List CodeLens)
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InternalError (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"codeLens failed:" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(PluginId, ResponseError)] -> String
forall a. Show a => a -> String
show [(PluginId, ResponseError)]
es) Maybe Value
forall a. Maybe a
Nothing
        ([(PluginId, ResponseError)]
_,[(PluginId, List CodeLens)]
rs) -> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (List CodeLens)
 -> IO (Either ResponseError (List CodeLens)))
-> Either ResponseError (List CodeLens)
-> IO (Either ResponseError (List CodeLens))
forall a b. (a -> b) -> a -> b
$ List CodeLens -> Either ResponseError (List CodeLens)
forall a b. b -> Either a b
Right (List CodeLens -> Either ResponseError (List CodeLens))
-> List CodeLens -> Either ResponseError (List CodeLens)
forall a b. (a -> b) -> a -> b
$ [CodeLens] -> List CodeLens
forall a. [a] -> List a
List (((PluginId, List CodeLens) -> [CodeLens])
-> [(PluginId, List CodeLens)] -> [CodeLens]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(PluginId
_,List [CodeLens]
cs) -> [CodeLens]
cs) [(PluginId, List CodeLens)]
rs)

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


executeCommandPlugins :: [(PluginId, [PluginCommand IdeState])] -> Plugin Config
executeCommandPlugins :: [(PluginId, [PluginCommand IdeState])] -> Plugin Config
executeCommandPlugins [(PluginId, [PluginCommand IdeState])]
ecs = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
forall a. Monoid a => a
mempty ([(PluginId, [PluginCommand IdeState])] -> PartialHandlers Config
executeCommandHandlers [(PluginId, [PluginCommand IdeState])]
ecs)

executeCommandHandlers :: [(PluginId, [PluginCommand IdeState])] -> PartialHandlers Config
executeCommandHandlers :: [(PluginId, [PluginCommand IdeState])] -> PartialHandlers Config
executeCommandHandlers [(PluginId, [PluginCommand IdeState])]
ecs = (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage Config -> Handlers -> IO Handlers)
 -> PartialHandlers Config)
-> (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{
    executeCommandHandler :: Maybe (Handler ExecuteCommandRequest)
LSP.executeCommandHandler = (ResponseMessage Value -> FromServerMessage)
-> (RequestMessage
      ServerMethod
      ApplyWorkspaceEditParams
      ApplyWorkspaceEditResponseBody
    -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> ExecuteCommandParams
    -> IO
         (Either ResponseError Value,
          Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> Maybe (Handler ExecuteCommandRequest)
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withResponseAndRequest ResponseMessage Value -> FromServerMessage
RspExecuteCommand RequestMessage
  ServerMethod
  ApplyWorkspaceEditParams
  ApplyWorkspaceEditResponseBody
-> FromServerMessage
ReqApplyWorkspaceEdit ([(PluginId, [PluginCommand IdeState])]
-> LspFuncs Config
-> IdeState
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
makeExecuteCommands [(PluginId, [PluginCommand IdeState])]
ecs)
    }

makeExecuteCommands :: [(PluginId, [PluginCommand IdeState])] -> LSP.LspFuncs Config -> ExecuteCommandProvider IdeState
makeExecuteCommands :: [(PluginId, [PluginCommand IdeState])]
-> LspFuncs Config
-> IdeState
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
makeExecuteCommands [(PluginId, [PluginCommand IdeState])]
ecs LspFuncs Config
lf IdeState
ide = (ExecuteCommandParams
 -> IO
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a b.
(a -> IO (Either ResponseError Value, Maybe b))
-> a -> IO (Either ResponseError Value, Maybe b)
wrapUnhandledExceptions ((ExecuteCommandParams
  -> IO
       (Either ResponseError Value,
        Maybe (ServerMethod, ApplyWorkspaceEditParams)))
 -> ExecuteCommandParams
 -> IO
      (Either ResponseError Value,
       Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> (ExecuteCommandParams
    -> IO
         (Either ResponseError Value,
          Maybe (ServerMethod, ApplyWorkspaceEditParams)))
-> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall a b. (a -> b) -> a -> b
$ do
  let
      pluginMap :: Map PluginId [PluginCommand IdeState]
pluginMap = [(PluginId, [PluginCommand IdeState])]
-> Map PluginId [PluginCommand IdeState]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(PluginId, [PluginCommand IdeState])]
ecs
      parseCmdId :: T.Text -> Maybe (PluginId, CommandId)
      parseCmdId :: Text -> Maybe (PluginId, CommandId)
parseCmdId Text
x = case Text -> Text -> [Text]
T.splitOn Text
":" Text
x of
        [Text
plugin, Text
command] -> (PluginId, CommandId) -> Maybe (PluginId, CommandId)
forall a. a -> Maybe a
Just (Text -> PluginId
PluginId Text
plugin, Text -> CommandId
CommandId Text
command)
        [Text
_, Text
plugin, Text
command] -> (PluginId, CommandId) -> Maybe (PluginId, CommandId)
forall a. a -> Maybe a
Just (Text -> PluginId
PluginId Text
plugin, Text -> CommandId
CommandId Text
command)
        [Text]
_ -> Maybe (PluginId, CommandId)
forall a. Maybe a
Nothing

      execCmd :: ExecuteCommandParams -> IO (Either ResponseError J.Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
      execCmd :: ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
execCmd (ExecuteCommandParams Text
cmdId Maybe (List Value)
args Maybe ProgressToken
_) = do
        -- The parameters to the HIE command are always the first element

        let cmdParams :: J.Value
            cmdParams :: Value
cmdParams = case Maybe (List Value)
args of
             Just (J.List (Value
x:[Value]
_)) -> Value
x
             Maybe (List Value)
_ -> Value
J.Null

        case Text -> Maybe (PluginId, CommandId)
parseCmdId Text
cmdId of
          -- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions

          Just (PluginId
"hls", CommandId
"fallbackCodeAction") ->
            case Value -> Result FallbackCodeActionParams
forall a. FromJSON a => Value -> Result a
J.fromJSON Value
cmdParams of
              J.Success (FallbackCodeActionParams Maybe WorkspaceEdit
mEdit Maybe Command
mCmd) -> do

                -- Send off the workspace request if it has one

                Maybe WorkspaceEdit -> (WorkspaceEdit -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe WorkspaceEdit
mEdit ((WorkspaceEdit -> IO ()) -> IO ())
-> (WorkspaceEdit -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WorkspaceEdit
edit -> do
                  let eParams :: ApplyWorkspaceEditParams
eParams = WorkspaceEdit -> ApplyWorkspaceEditParams
J.ApplyWorkspaceEditParams WorkspaceEdit
edit
                  LspId
reqId <- LspFuncs Config -> IO LspId
forall c. LspFuncs c -> IO LspId
LSP.getNextReqId LspFuncs Config
lf
                  LspFuncs Config -> SendFunc
forall c. LspFuncs c -> SendFunc
LSP.sendFunc LspFuncs Config
lf SendFunc -> SendFunc
forall a b. (a -> b) -> a -> b
$ RequestMessage
  ServerMethod
  ApplyWorkspaceEditParams
  ApplyWorkspaceEditResponseBody
-> FromServerMessage
ReqApplyWorkspaceEdit (RequestMessage
   ServerMethod
   ApplyWorkspaceEditParams
   ApplyWorkspaceEditResponseBody
 -> FromServerMessage)
-> RequestMessage
     ServerMethod
     ApplyWorkspaceEditParams
     ApplyWorkspaceEditResponseBody
-> FromServerMessage
forall a b. (a -> b) -> a -> b
$ Text
-> LspId
-> ServerMethod
-> ApplyWorkspaceEditParams
-> RequestMessage
     ServerMethod
     ApplyWorkspaceEditParams
     ApplyWorkspaceEditResponseBody
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"2.0" LspId
reqId ServerMethod
WorkspaceApplyEdit ApplyWorkspaceEditParams
eParams

                case Maybe Command
mCmd of
                  -- If we have a command, continue to execute it

                  Just (J.Command Text
_ Text
innerCmdId Maybe (List Value)
innerArgs)
                      -> ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
execCmd (Text
-> Maybe (List Value)
-> Maybe ProgressToken
-> ExecuteCommandParams
ExecuteCommandParams Text
innerCmdId Maybe (List Value)
innerArgs Maybe ProgressToken
forall a. Maybe a
Nothing)
                  Maybe Command
Nothing -> (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
J.Null, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)

              J.Error String
_str -> (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Either ResponseError Value
forall a b. b -> Either a b
Right Value
J.Null, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)

          -- Just an ordinary HIE command

          Just (PluginId
plugin, CommandId
cmd) -> Map PluginId [PluginCommand IdeState]
-> LspFuncs Config
-> IdeState
-> PluginId
-> CommandId
-> Value
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
runPluginCommand Map PluginId [PluginCommand IdeState]
pluginMap LspFuncs Config
lf IdeState
ide PluginId
plugin CommandId
cmd Value
cmdParams

          -- Couldn't parse the command identifier

          Maybe (PluginId, CommandId)
_ -> (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (ResponseError -> Either ResponseError Value
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError Value)
-> ResponseError -> Either ResponseError Value
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidParams Text
"Invalid command identifier" Maybe Value
forall a. Maybe a
Nothing, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)

  ExecuteCommandParams
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
execCmd


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

wrapUnhandledExceptions ::
    (a -> IO (Either ResponseError J.Value, Maybe b)) ->
       a -> IO (Either ResponseError J.Value, Maybe b)
wrapUnhandledExceptions :: (a -> IO (Either ResponseError Value, Maybe b))
-> a -> IO (Either ResponseError Value, Maybe b)
wrapUnhandledExceptions a -> IO (Either ResponseError Value, Maybe b)
action a
input =
    IO (Either ResponseError Value, Maybe b)
-> (SomeException -> IO (Either ResponseError Value, Maybe b))
-> IO (Either ResponseError Value, Maybe b)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> IO (Either ResponseError Value, Maybe b)
action a
input) ((SomeException -> IO (Either ResponseError Value, Maybe b))
 -> IO (Either ResponseError Value, Maybe b))
-> (SomeException -> IO (Either ResponseError Value, Maybe b))
-> IO (Either ResponseError Value, Maybe b)
forall a b. (a -> b) -> a -> b
$ \(SomeException
e::SomeException) -> do
        let resp :: ResponseError
resp = ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InternalError (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e) Maybe Value
forall a. Maybe a
Nothing
        (Either ResponseError Value, Maybe b)
-> IO (Either ResponseError Value, Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResponseError -> Either ResponseError Value
forall a b. a -> Either a b
Left ResponseError
resp, Maybe b
forall a. Maybe a
Nothing)


-- | Runs a plugin command given a PluginId, CommandId and

-- arguments in the form of a JSON object.

runPluginCommand :: Map.Map PluginId [PluginCommand IdeState]
                 -> LSP.LspFuncs Config
                 -> IdeState
                 -> PluginId
                 -> CommandId
                 -> J.Value
                 -> IO (Either ResponseError J.Value,
                        Maybe (ServerMethod, ApplyWorkspaceEditParams))
runPluginCommand :: Map PluginId [PluginCommand IdeState]
-> LspFuncs Config
-> IdeState
-> PluginId
-> CommandId
-> Value
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
runPluginCommand Map PluginId [PluginCommand IdeState]
m LspFuncs Config
lf IdeState
ide  p :: PluginId
p@(PluginId Text
p') com :: CommandId
com@(CommandId Text
com') Value
arg =
  case PluginId
-> Map PluginId [PluginCommand IdeState]
-> Maybe [PluginCommand IdeState]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PluginId
p Map PluginId [PluginCommand IdeState]
m of
    Maybe [PluginCommand IdeState]
Nothing -> (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return
      (ResponseError -> Either ResponseError Value
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError Value)
-> ResponseError -> Either ResponseError Value
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidRequest (Text
"Plugin " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" doesn't exist") Maybe Value
forall a. Maybe a
Nothing, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)
    Just [PluginCommand IdeState]
xs -> case (PluginCommand IdeState -> Bool)
-> [PluginCommand IdeState] -> Maybe (PluginCommand IdeState)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((CommandId
com CommandId -> CommandId -> Bool
forall a. Eq a => a -> a -> Bool
==) (CommandId -> Bool)
-> (PluginCommand IdeState -> CommandId)
-> PluginCommand IdeState
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginCommand IdeState -> CommandId
forall ideState. PluginCommand ideState -> CommandId
commandId) [PluginCommand IdeState]
xs of
      Maybe (PluginCommand IdeState)
Nothing -> (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (ResponseError -> Either ResponseError Value
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError Value)
-> ResponseError -> Either ResponseError Value
forall a b. (a -> b) -> a -> b
$
        ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidRequest (Text
"Command " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
com' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" isn't defined for plugin " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p'
                                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Legal commands are: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack([CommandId] -> String
forall a. Show a => a -> String
show ([CommandId] -> String) -> [CommandId] -> String
forall a b. (a -> b) -> a -> b
$ (PluginCommand IdeState -> CommandId)
-> [PluginCommand IdeState] -> [CommandId]
forall a b. (a -> b) -> [a] -> [b]
map PluginCommand IdeState -> CommandId
forall ideState. PluginCommand ideState -> CommandId
commandId [PluginCommand IdeState]
xs)) Maybe Value
forall a. Maybe a
Nothing, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)
      Just (PluginCommand CommandId
_ Text
_ CommandFunction IdeState a
f) -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
J.fromJSON Value
arg of
        J.Error String
err -> (Either ResponseError Value,
 Maybe (ServerMethod, ApplyWorkspaceEditParams))
-> IO
     (Either ResponseError Value,
      Maybe (ServerMethod, ApplyWorkspaceEditParams))
forall (m :: * -> *) a. Monad m => a -> m a
return (ResponseError -> Either ResponseError Value
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError Value)
-> ResponseError -> Either ResponseError Value
forall a b. (a -> b) -> a -> b
$
          ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidParams (Text
"error while parsing args for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
com' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in plugin " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p'
                                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err
                                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\narg = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Value -> String
forall a. Show a => a -> String
show Value
arg)) Maybe Value
forall a. Maybe a
Nothing, Maybe (ServerMethod, ApplyWorkspaceEditParams)
forall a. Maybe a
Nothing)
        J.Success a
a -> CommandFunction IdeState a
f LspFuncs Config
lf IdeState
ide a
a

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


mkLspCommand :: PluginId -> CommandId -> T.Text -> Maybe [J.Value] -> IO Command
mkLspCommand :: PluginId -> CommandId -> Text -> Maybe [Value] -> IO Command
mkLspCommand PluginId
plid CommandId
cn Text
title Maybe [Value]
args' = do
  Text
pid <- String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> IO Int -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
getProcessID
  let cmdId :: Text
cmdId = Text -> PluginId -> CommandId -> Text
mkLspCmdId Text
pid PluginId
plid CommandId
cn
  let args :: Maybe (List Value)
args = [Value] -> List Value
forall a. [a] -> List a
List ([Value] -> List Value) -> Maybe [Value] -> Maybe (List Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Value]
args'
  Command -> IO Command
forall (m :: * -> *) a. Monad m => a -> m a
return (Command -> IO Command) -> Command -> IO Command
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe (List Value) -> Command
Command Text
title Text
cmdId Maybe (List Value)
args

mkLspCmdId :: T.Text -> PluginId -> CommandId -> T.Text
mkLspCmdId :: Text -> PluginId -> CommandId -> Text
mkLspCmdId Text
pid (PluginId Text
plid) (CommandId Text
cid)
  = Text
pid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
plid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cid

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


hoverPlugins :: [(PluginId, HoverProvider IdeState)] -> Plugin Config
hoverPlugins :: [(PluginId, HoverProvider IdeState)] -> Plugin Config
hoverPlugins [(PluginId, HoverProvider IdeState)]
hs = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
hoverRules ([(PluginId, HoverProvider IdeState)] -> PartialHandlers Config
hoverHandlers [(PluginId, HoverProvider IdeState)]
hs)

hoverRules :: Rules ()
hoverRules :: Rules ()
hoverRules = Rules ()
forall a. Monoid a => a
mempty

hoverHandlers :: [(PluginId, HoverProvider IdeState)] -> PartialHandlers Config
hoverHandlers :: [(PluginId, HoverProvider IdeState)] -> PartialHandlers Config
hoverHandlers [(PluginId, HoverProvider IdeState)]
hps = (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage Config -> Handlers -> IO Handlers)
 -> PartialHandlers Config)
-> (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x ->
  Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{hoverHandler :: Maybe (Handler HoverRequest)
LSP.hoverHandler = (ResponseMessage (Maybe Hover) -> FromServerMessage)
-> (LspFuncs Config -> HoverProvider IdeState)
-> Maybe (Handler HoverRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (Maybe Hover) -> FromServerMessage
RspHover ([(PluginId, HoverProvider IdeState)]
-> LspFuncs Config -> HoverProvider IdeState
makeHover [(PluginId, HoverProvider IdeState)]
hps)}

makeHover :: [(PluginId, HoverProvider IdeState)]
      -> LSP.LspFuncs Config -> IdeState
      -> TextDocumentPositionParams
      -> IO (Either ResponseError (Maybe Hover))
makeHover :: [(PluginId, HoverProvider IdeState)]
-> LspFuncs Config -> HoverProvider IdeState
makeHover [(PluginId, HoverProvider IdeState)]
hps LspFuncs Config
lf IdeState
ideState TextDocumentPositionParams
params
  = do
      let
        makeHover :: (PluginId,
 IdeState -> TextDocumentPositionParams -> IO (Either a (Maybe a)))
-> IO (Either a (Maybe a))
makeHover(PluginId
pid,IdeState -> TextDocumentPositionParams -> IO (Either a (Maybe a))
p) = do
          PluginConfig
pluginConfig <- LspFuncs Config -> PluginId -> IO PluginConfig
getPluginConfig LspFuncs Config
lf PluginId
pid
          if PluginConfig -> (PluginConfig -> Bool) -> Bool
pluginEnabled PluginConfig
pluginConfig PluginConfig -> Bool
plcHoverOn
             then IdeState -> TextDocumentPositionParams -> IO (Either a (Maybe a))
p IdeState
ideState TextDocumentPositionParams
params
             else Either a (Maybe a) -> IO (Either a (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a (Maybe a) -> IO (Either a (Maybe a)))
-> Either a (Maybe a) -> IO (Either a (Maybe a))
forall a b. (a -> b) -> a -> b
$ Maybe a -> Either a (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
      [Either ResponseError (Maybe Hover)]
mhs <- ((PluginId, HoverProvider IdeState)
 -> IO (Either ResponseError (Maybe Hover)))
-> [(PluginId, HoverProvider IdeState)]
-> IO [Either ResponseError (Maybe Hover)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PluginId, HoverProvider IdeState)
-> IO (Either ResponseError (Maybe Hover))
forall a a.
(PluginId,
 IdeState -> TextDocumentPositionParams -> IO (Either a (Maybe a)))
-> IO (Either a (Maybe a))
makeHover [(PluginId, HoverProvider IdeState)]
hps
      -- TODO: We should support ServerCapabilities and declare that

      -- we don't support hover requests during initialization if we

      -- don't have any hover providers

      -- TODO: maybe only have provider give MarkedString and

      -- work out range here?

      let hs :: [Hover]
hs = [Maybe Hover] -> [Hover]
forall a. [Maybe a] -> [a]
catMaybes ([Either ResponseError (Maybe Hover)] -> [Maybe Hover]
forall a b. [Either a b] -> [b]
rights [Either ResponseError (Maybe Hover)]
mhs)
          r :: Maybe Range
r = [Range] -> Maybe Range
forall a. [a] -> Maybe a
listToMaybe ([Range] -> Maybe Range) -> [Range] -> Maybe Range
forall a b. (a -> b) -> a -> b
$ (Hover -> Maybe Range) -> [Hover] -> [Range]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Hover -> Getting (Maybe Range) Hover (Maybe Range) -> Maybe Range
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Range) Hover (Maybe Range)
forall s a. HasRange s a => Lens' s a
range) [Hover]
hs
          h :: Maybe Hover
h = case (Hover -> HoverContents) -> [Hover] -> HoverContents
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Hover -> Getting HoverContents Hover HoverContents -> HoverContents
forall s a. s -> Getting a s a -> a
^. Getting HoverContents Hover HoverContents
forall s a. HasContents s a => Lens' s a
contents) [Hover]
hs of
            HoverContentsMS (List []) -> Maybe Hover
forall a. Maybe a
Nothing
            HoverContents
hh                        -> Hover -> Maybe Hover
forall a. a -> Maybe a
Just (Hover -> Maybe Hover) -> Hover -> Maybe Hover
forall a b. (a -> b) -> a -> b
$ HoverContents -> Maybe Range -> Hover
Hover HoverContents
hh Maybe Range
r
      Either ResponseError (Maybe Hover)
-> IO (Either ResponseError (Maybe Hover))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError (Maybe Hover)
 -> IO (Either ResponseError (Maybe Hover)))
-> Either ResponseError (Maybe Hover)
-> IO (Either ResponseError (Maybe Hover))
forall a b. (a -> b) -> a -> b
$ Maybe Hover -> Either ResponseError (Maybe Hover)
forall a b. b -> Either a b
Right Maybe Hover
h

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

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


symbolsPlugins :: [(PluginId, SymbolsProvider IdeState)] -> Plugin Config
symbolsPlugins :: [(PluginId, SymbolsProvider IdeState)] -> Plugin Config
symbolsPlugins [(PluginId, SymbolsProvider IdeState)]
hs = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
symbolsRules ([(PluginId, SymbolsProvider IdeState)] -> PartialHandlers Config
symbolsHandlers [(PluginId, SymbolsProvider IdeState)]
hs)

symbolsRules :: Rules ()
symbolsRules :: Rules ()
symbolsRules = Rules ()
forall a. Monoid a => a
mempty

symbolsHandlers :: [(PluginId, SymbolsProvider IdeState)] -> PartialHandlers Config
symbolsHandlers :: [(PluginId, SymbolsProvider IdeState)] -> PartialHandlers Config
symbolsHandlers [(PluginId, SymbolsProvider IdeState)]
hps = (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage Config -> Handlers -> IO Handlers)
 -> PartialHandlers Config)
-> (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x ->
  Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x {documentSymbolHandler :: Maybe (Handler DocumentSymbolRequest)
LSP.documentSymbolHandler = (ResponseMessage DSResult -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> DocumentSymbolParams
    -> IO (Either ResponseError DSResult))
-> Maybe (Handler DocumentSymbolRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage DSResult -> FromServerMessage
RspDocumentSymbols ([(PluginId, SymbolsProvider IdeState)]
-> LspFuncs Config
-> IdeState
-> DocumentSymbolParams
-> IO (Either ResponseError DSResult)
makeSymbols [(PluginId, SymbolsProvider IdeState)]
hps)}

makeSymbols :: [(PluginId, SymbolsProvider IdeState)]
      -> LSP.LspFuncs Config
      -> IdeState
      -> DocumentSymbolParams
      -> IO (Either ResponseError DSResult)
makeSymbols :: [(PluginId, SymbolsProvider IdeState)]
-> LspFuncs Config
-> IdeState
-> DocumentSymbolParams
-> IO (Either ResponseError DSResult)
makeSymbols [(PluginId, SymbolsProvider IdeState)]
sps LspFuncs Config
lf IdeState
ideState DocumentSymbolParams
params
  = do
      let uri' :: Uri
uri' = DocumentSymbolParams
params DocumentSymbolParams -> Getting Uri DocumentSymbolParams Uri -> Uri
forall s a. s -> Getting a s a -> a
^. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> DocumentSymbolParams -> Const Uri DocumentSymbolParams
forall s a. HasTextDocument s a => Lens' s a
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> DocumentSymbolParams -> Const Uri DocumentSymbolParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> Getting Uri DocumentSymbolParams Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
uri
          (C.ClientCapabilities Maybe WorkspaceClientCapabilities
_ Maybe TextDocumentClientCapabilities
tdc Maybe WindowClientCapabilities
_ Maybe Object
_) = LspFuncs Config -> ClientCapabilities
forall c. LspFuncs c -> ClientCapabilities
LSP.clientCapabilities LspFuncs Config
lf
          supportsHierarchy :: Bool
supportsHierarchy = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe TextDocumentClientCapabilities
tdc Maybe TextDocumentClientCapabilities
-> (TextDocumentClientCapabilities
    -> Maybe DocumentSymbolClientCapabilities)
-> Maybe DocumentSymbolClientCapabilities
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextDocumentClientCapabilities
-> Maybe DocumentSymbolClientCapabilities
C._documentSymbol Maybe DocumentSymbolClientCapabilities
-> (DocumentSymbolClientCapabilities -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DocumentSymbolClientCapabilities -> Maybe Bool
C._hierarchicalDocumentSymbolSupport)
          convertSymbols :: [DocumentSymbol] -> DSResult
          convertSymbols :: [DocumentSymbol] -> DSResult
convertSymbols [DocumentSymbol]
symbs
            | Bool
supportsHierarchy = List DocumentSymbol -> DSResult
DSDocumentSymbols (List DocumentSymbol -> DSResult)
-> List DocumentSymbol -> DSResult
forall a b. (a -> b) -> a -> b
$ [DocumentSymbol] -> List DocumentSymbol
forall a. [a] -> List a
List [DocumentSymbol]
symbs
            | Bool
otherwise = List SymbolInformation -> DSResult
DSSymbolInformation ([SymbolInformation] -> List SymbolInformation
forall a. [a] -> List a
List ([SymbolInformation] -> List SymbolInformation)
-> [SymbolInformation] -> List SymbolInformation
forall a b. (a -> b) -> a -> b
$ (DocumentSymbol -> [SymbolInformation])
-> [DocumentSymbol] -> [SymbolInformation]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe Text -> DocumentSymbol -> [SymbolInformation]
go Maybe Text
forall a. Maybe a
Nothing) [DocumentSymbol]
symbs)
            where
                go :: Maybe T.Text -> DocumentSymbol -> [SymbolInformation]
                go :: Maybe Text -> DocumentSymbol -> [SymbolInformation]
go Maybe Text
parent DocumentSymbol
ds =
                  let children' :: [SymbolInformation]
                      children' :: [SymbolInformation]
children' = (DocumentSymbol -> [SymbolInformation])
-> List DocumentSymbol -> [SymbolInformation]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe Text -> DocumentSymbol -> [SymbolInformation]
go (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name')) (List DocumentSymbol
-> Maybe (List DocumentSymbol) -> List DocumentSymbol
forall a. a -> Maybe a -> a
fromMaybe List DocumentSymbol
forall a. Monoid a => a
mempty (DocumentSymbol
ds DocumentSymbol
-> Getting
     (Maybe (List DocumentSymbol))
     DocumentSymbol
     (Maybe (List DocumentSymbol))
-> Maybe (List DocumentSymbol)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (List DocumentSymbol))
  DocumentSymbol
  (Maybe (List DocumentSymbol))
forall s a. HasChildren s a => Lens' s a
children))
                      loc :: Location
loc = Uri -> Range -> Location
Location Uri
uri' (DocumentSymbol
ds DocumentSymbol -> Getting Range DocumentSymbol Range -> Range
forall s a. s -> Getting a s a -> a
^. Getting Range DocumentSymbol Range
forall s a. HasRange s a => Lens' s a
range)
                      name' :: Text
name' = DocumentSymbol
ds DocumentSymbol -> Getting Text DocumentSymbol Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text DocumentSymbol Text
forall s a. HasName s a => Lens' s a
name
                      si :: SymbolInformation
si = Text
-> SymbolKind
-> Maybe Bool
-> Location
-> Maybe Text
-> SymbolInformation
SymbolInformation Text
name' (DocumentSymbol
ds DocumentSymbol
-> Getting SymbolKind DocumentSymbol SymbolKind -> SymbolKind
forall s a. s -> Getting a s a -> a
^. Getting SymbolKind DocumentSymbol SymbolKind
forall s a. HasKind s a => Lens' s a
kind) (DocumentSymbol
ds DocumentSymbol
-> Getting (Maybe Bool) DocumentSymbol (Maybe Bool) -> Maybe Bool
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Bool) DocumentSymbol (Maybe Bool)
forall s a. HasDeprecated s a => Lens' s a
deprecated) Location
loc Maybe Text
parent
                  in [SymbolInformation
si] [SymbolInformation] -> [SymbolInformation] -> [SymbolInformation]
forall a. Semigroup a => a -> a -> a
<> [SymbolInformation]
children'

          makeSymbols :: (PluginId,
 LspFuncs Config
 -> IdeState -> DocumentSymbolParams -> IO (Either a [a]))
-> IO (Either a [a])
makeSymbols (PluginId
pid,LspFuncs Config
-> IdeState -> DocumentSymbolParams -> IO (Either a [a])
p) = do
            PluginConfig
pluginConfig <- LspFuncs Config -> PluginId -> IO PluginConfig
getPluginConfig LspFuncs Config
lf PluginId
pid
            if PluginConfig -> (PluginConfig -> Bool) -> Bool
pluginEnabled PluginConfig
pluginConfig PluginConfig -> Bool
plcSymbolsOn
              then LspFuncs Config
-> IdeState -> DocumentSymbolParams -> IO (Either a [a])
p LspFuncs Config
lf IdeState
ideState DocumentSymbolParams
params
              else Either a [a] -> IO (Either a [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a [a] -> IO (Either a [a]))
-> Either a [a] -> IO (Either a [a])
forall a b. (a -> b) -> a -> b
$ [a] -> Either a [a]
forall a b. b -> Either a b
Right []
      [Either ResponseError [DocumentSymbol]]
mhs <- ((PluginId, SymbolsProvider IdeState)
 -> IO (Either ResponseError [DocumentSymbol]))
-> [(PluginId, SymbolsProvider IdeState)]
-> IO [Either ResponseError [DocumentSymbol]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PluginId, SymbolsProvider IdeState)
-> IO (Either ResponseError [DocumentSymbol])
forall a a.
(PluginId,
 LspFuncs Config
 -> IdeState -> DocumentSymbolParams -> IO (Either a [a]))
-> IO (Either a [a])
makeSymbols [(PluginId, SymbolsProvider IdeState)]
sps
      case [Either ResponseError [DocumentSymbol]] -> [[DocumentSymbol]]
forall a b. [Either a b] -> [b]
rights [Either ResponseError [DocumentSymbol]]
mhs of
          [] -> Either ResponseError DSResult -> IO (Either ResponseError DSResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError DSResult
 -> IO (Either ResponseError DSResult))
-> Either ResponseError DSResult
-> IO (Either ResponseError DSResult)
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError DSResult
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError DSResult)
-> ResponseError -> Either ResponseError DSResult
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError (Text -> ResponseError) -> Text -> ResponseError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [ResponseError] -> String
forall a. Show a => a -> String
show ([ResponseError] -> String) -> [ResponseError] -> String
forall a b. (a -> b) -> a -> b
$ [Either ResponseError [DocumentSymbol]] -> [ResponseError]
forall a b. [Either a b] -> [a]
lefts [Either ResponseError [DocumentSymbol]]
mhs
          [[DocumentSymbol]]
hs -> Either ResponseError DSResult -> IO (Either ResponseError DSResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError DSResult
 -> IO (Either ResponseError DSResult))
-> Either ResponseError DSResult
-> IO (Either ResponseError DSResult)
forall a b. (a -> b) -> a -> b
$ DSResult -> Either ResponseError DSResult
forall a b. b -> Either a b
Right (DSResult -> Either ResponseError DSResult)
-> DSResult -> Either ResponseError DSResult
forall a b. (a -> b) -> a -> b
$ [DocumentSymbol] -> DSResult
convertSymbols ([DocumentSymbol] -> DSResult) -> [DocumentSymbol] -> DSResult
forall a b. (a -> b) -> a -> b
$ [[DocumentSymbol]] -> [DocumentSymbol]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[DocumentSymbol]]
hs


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

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


renamePlugins :: [(PluginId, RenameProvider IdeState)] -> Plugin Config
renamePlugins :: [(PluginId, RenameProvider IdeState)] -> Plugin Config
renamePlugins [(PluginId, RenameProvider IdeState)]
providers = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
rules PartialHandlers Config
handlers
  where
    rules :: Rules ()
rules = Rules ()
forall a. Monoid a => a
mempty
    handlers :: PartialHandlers Config
handlers = (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage Config -> Handlers -> IO Handlers)
 -> PartialHandlers Config)
-> (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x
      { renameHandler :: Maybe (Handler RenameRequest)
LSP.renameHandler = (ResponseMessage WorkspaceEdit -> FromServerMessage)
-> RenameProvider IdeState -> Maybe (Handler RenameRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage WorkspaceEdit -> FromServerMessage
RspRename ([(PluginId, RenameProvider IdeState)] -> RenameProvider IdeState
renameWith [(PluginId, RenameProvider IdeState)]
providers)}

renameWith ::
  [(PluginId, RenameProvider IdeState)] ->
  LSP.LspFuncs Config ->
  IdeState ->
  RenameParams ->
  IO (Either ResponseError WorkspaceEdit)
renameWith :: [(PluginId, RenameProvider IdeState)] -> RenameProvider IdeState
renameWith [(PluginId, RenameProvider IdeState)]
providers LspFuncs Config
lspFuncs IdeState
state RenameParams
params = do
    let
        makeAction :: (PluginId,
 LspFuncs Config
 -> IdeState -> RenameParams -> IO (Either a WorkspaceEdit))
-> IO (Either a WorkspaceEdit)
makeAction (PluginId
pid,LspFuncs Config
-> IdeState -> RenameParams -> IO (Either a WorkspaceEdit)
p) = do
          PluginConfig
pluginConfig <- LspFuncs Config -> PluginId -> IO PluginConfig
getPluginConfig LspFuncs Config
lspFuncs PluginId
pid
          if PluginConfig -> (PluginConfig -> Bool) -> Bool
pluginEnabled PluginConfig
pluginConfig PluginConfig -> Bool
plcRenameOn
             then LspFuncs Config
-> IdeState -> RenameParams -> IO (Either a WorkspaceEdit)
p LspFuncs Config
lspFuncs IdeState
state RenameParams
params
             else Either a WorkspaceEdit -> IO (Either a WorkspaceEdit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a WorkspaceEdit -> IO (Either a WorkspaceEdit))
-> Either a WorkspaceEdit -> IO (Either a WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ WorkspaceEdit -> Either a WorkspaceEdit
forall a b. b -> Either a b
Right (WorkspaceEdit -> Either a WorkspaceEdit)
-> WorkspaceEdit -> Either a WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
forall a. Maybe a
Nothing Maybe (List TextDocumentEdit)
forall a. Maybe a
Nothing
    -- TODO:AZ: we need to consider the right way to combine possible renamers

    [Either ResponseError WorkspaceEdit]
results <- ((PluginId, RenameProvider IdeState)
 -> IO (Either ResponseError WorkspaceEdit))
-> [(PluginId, RenameProvider IdeState)]
-> IO [Either ResponseError WorkspaceEdit]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PluginId, RenameProvider IdeState)
-> IO (Either ResponseError WorkspaceEdit)
forall a.
(PluginId,
 LspFuncs Config
 -> IdeState -> RenameParams -> IO (Either a WorkspaceEdit))
-> IO (Either a WorkspaceEdit)
makeAction [(PluginId, RenameProvider IdeState)]
providers
    case [Either ResponseError WorkspaceEdit]
-> ([ResponseError], [WorkspaceEdit])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either ResponseError WorkspaceEdit]
results of
        ([ResponseError]
errors, []) -> Either ResponseError WorkspaceEdit
-> IO (Either ResponseError WorkspaceEdit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError WorkspaceEdit
 -> IO (Either ResponseError WorkspaceEdit))
-> Either ResponseError WorkspaceEdit
-> IO (Either ResponseError WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError WorkspaceEdit
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError WorkspaceEdit)
-> ResponseError -> Either ResponseError WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError (Text -> ResponseError) -> Text -> ResponseError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [ResponseError] -> String
forall a. Show a => a -> String
show [ResponseError]
errors
        ([ResponseError]
_, [WorkspaceEdit]
edits) -> Either ResponseError WorkspaceEdit
-> IO (Either ResponseError WorkspaceEdit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError WorkspaceEdit
 -> IO (Either ResponseError WorkspaceEdit))
-> Either ResponseError WorkspaceEdit
-> IO (Either ResponseError WorkspaceEdit)
forall a b. (a -> b) -> a -> b
$ WorkspaceEdit -> Either ResponseError WorkspaceEdit
forall a b. b -> Either a b
Right (WorkspaceEdit -> Either ResponseError WorkspaceEdit)
-> WorkspaceEdit -> Either ResponseError WorkspaceEdit
forall a b. (a -> b) -> a -> b
$ [WorkspaceEdit] -> WorkspaceEdit
forall a. Monoid a => [a] -> a
mconcat [WorkspaceEdit]
edits

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

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


formatterPlugins :: [(PluginId, FormattingProvider IdeState IO)] -> Plugin Config
formatterPlugins :: [(PluginId, FormattingProvider IdeState IO)] -> Plugin Config
formatterPlugins [(PluginId, FormattingProvider IdeState IO)]
providers
    = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
formatterRules
             (Map PluginId (FormattingProvider IdeState IO)
-> PartialHandlers Config
formatterHandlers ([(PluginId, FormattingProvider IdeState IO)]
-> Map PluginId (FormattingProvider IdeState IO)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((PluginId
"none",FormattingProvider IdeState IO
forall ideState. FormattingProvider ideState IO
noneProvider)(PluginId, FormattingProvider IdeState IO)
-> [(PluginId, FormattingProvider IdeState IO)]
-> [(PluginId, FormattingProvider IdeState IO)]
forall a. a -> [a] -> [a]
:[(PluginId, FormattingProvider IdeState IO)]
providers)))

formatterRules :: Rules ()
formatterRules :: Rules ()
formatterRules = Rules ()
forall a. Monoid a => a
mempty

formatterHandlers :: Map.Map PluginId (FormattingProvider IdeState IO) -> PartialHandlers Config
formatterHandlers :: Map PluginId (FormattingProvider IdeState IO)
-> PartialHandlers Config
formatterHandlers Map PluginId (FormattingProvider IdeState IO)
providers = (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage Config -> Handlers -> IO Handlers)
 -> PartialHandlers Config)
-> (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x
    { documentFormattingHandler :: Maybe (Handler DocumentFormattingRequest)
LSP.documentFormattingHandler
        = (ResponseMessage (List TextEdit) -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> DocumentFormattingParams
    -> IO (Either ResponseError (List TextEdit)))
-> Maybe (Handler DocumentFormattingRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List TextEdit) -> FromServerMessage
RspDocumentFormatting (Map PluginId (FormattingProvider IdeState IO)
-> LspFuncs Config
-> IdeState
-> DocumentFormattingParams
-> IO (Either ResponseError (List TextEdit))
formatting Map PluginId (FormattingProvider IdeState IO)
providers)
    , documentRangeFormattingHandler :: Maybe (Handler DocumentRangeFormattingRequest)
LSP.documentRangeFormattingHandler
        = (ResponseMessage (List TextEdit) -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> DocumentRangeFormattingParams
    -> IO (Either ResponseError (List TextEdit)))
-> Maybe (Handler DocumentRangeFormattingRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List TextEdit) -> FromServerMessage
RspDocumentRangeFormatting (Map PluginId (FormattingProvider IdeState IO)
-> LspFuncs Config
-> IdeState
-> DocumentRangeFormattingParams
-> IO (Either ResponseError (List TextEdit))
rangeFormatting Map PluginId (FormattingProvider IdeState IO)
providers)
    }

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

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


completionsPlugins :: [(PluginId, CompletionProvider IdeState)] -> Plugin Config
completionsPlugins :: [(PluginId, CompletionProvider IdeState)] -> Plugin Config
completionsPlugins [(PluginId, CompletionProvider IdeState)]
cs = Rules () -> PartialHandlers Config -> Plugin Config
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
completionsRules ([(PluginId, CompletionProvider IdeState)] -> PartialHandlers Config
completionsHandlers [(PluginId, CompletionProvider IdeState)]
cs)

completionsRules :: Rules ()
completionsRules :: Rules ()
completionsRules = Rules ()
forall a. Monoid a => a
mempty

completionsHandlers :: [(PluginId, CompletionProvider IdeState)] -> PartialHandlers Config
completionsHandlers :: [(PluginId, CompletionProvider IdeState)] -> PartialHandlers Config
completionsHandlers [(PluginId, CompletionProvider IdeState)]
cps = (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage Config -> Handlers -> IO Handlers)
 -> PartialHandlers Config)
-> (WithMessage Config -> Handlers -> IO Handlers)
-> PartialHandlers Config
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs Config -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs Config -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x ->
  Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x {completionHandler :: Maybe (Handler CompletionRequest)
LSP.completionHandler = (ResponseMessage CompletionResponseResult -> FromServerMessage)
-> CompletionProvider IdeState -> Maybe (Handler CompletionRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs Config
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage CompletionResponseResult -> FromServerMessage
RspCompletion ([(PluginId, CompletionProvider IdeState)]
-> CompletionProvider IdeState
makeCompletions [(PluginId, CompletionProvider IdeState)]
cps)}

makeCompletions :: [(PluginId, CompletionProvider IdeState)]
      -> LSP.LspFuncs Config
      -> IdeState
      -> CompletionParams
      -> IO (Either ResponseError CompletionResponseResult)
makeCompletions :: [(PluginId, CompletionProvider IdeState)]
-> CompletionProvider IdeState
makeCompletions [(PluginId, CompletionProvider IdeState)]
sps LspFuncs Config
lf IdeState
ideState params :: CompletionParams
params@(CompletionParams (TextDocumentIdentifier Uri
doc) Position
pos Maybe CompletionContext
_context Maybe ProgressToken
_mt)
  = do
      Maybe PosPrefixInfo
mprefix <- LspFuncs Config -> Uri -> Position -> IO (Maybe PosPrefixInfo)
getPrefixAtPos LspFuncs Config
lf Uri
doc Position
pos
      WithSnippets
_snippets <- Bool -> WithSnippets
WithSnippets (Bool -> WithSnippets)
-> (Config -> Bool) -> Config -> WithSnippets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Bool
completionSnippetsOn (Config -> WithSnippets) -> IO Config -> IO WithSnippets
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LspFuncs Config -> IO Config
getClientConfig LspFuncs Config
lf

      let
          combine :: [CompletionResponseResult] -> CompletionResponseResult
          combine :: [CompletionResponseResult] -> CompletionResponseResult
combine [CompletionResponseResult]
cs = CompletionResponseResult
-> [CompletionResponseResult] -> CompletionResponseResult
go (List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List []) [CompletionResponseResult]
cs
              where
                  go :: CompletionResponseResult
-> [CompletionResponseResult] -> CompletionResponseResult
go CompletionResponseResult
acc [] = CompletionResponseResult
acc
                  go (Completions (List [CompletionItem]
ls)) (Completions (List [CompletionItem]
ls2):[CompletionResponseResult]
rest)
                      = CompletionResponseResult
-> [CompletionResponseResult] -> CompletionResponseResult
go (List CompletionItem -> CompletionResponseResult
Completions ([CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List ([CompletionItem]
ls [CompletionItem] -> [CompletionItem] -> [CompletionItem]
forall a. Semigroup a => a -> a -> a
<> [CompletionItem]
ls2))) [CompletionResponseResult]
rest
                  go (Completions (List [CompletionItem]
ls)) (CompletionList (CompletionListType Bool
complete (List [CompletionItem]
ls2)):[CompletionResponseResult]
rest)
                      = CompletionResponseResult
-> [CompletionResponseResult] -> CompletionResponseResult
go (CompletionListType -> CompletionResponseResult
CompletionList (CompletionListType -> CompletionResponseResult)
-> CompletionListType -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ Bool -> List CompletionItem -> CompletionListType
CompletionListType Bool
complete ([CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List ([CompletionItem]
ls [CompletionItem] -> [CompletionItem] -> [CompletionItem]
forall a. Semigroup a => a -> a -> a
<> [CompletionItem]
ls2))) [CompletionResponseResult]
rest
                  go (CompletionList (CompletionListType Bool
complete (List [CompletionItem]
ls))) (CompletionList (CompletionListType Bool
complete2 (List [CompletionItem]
ls2)):[CompletionResponseResult]
rest)
                      = CompletionResponseResult
-> [CompletionResponseResult] -> CompletionResponseResult
go (CompletionListType -> CompletionResponseResult
CompletionList (CompletionListType -> CompletionResponseResult)
-> CompletionListType -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ Bool -> List CompletionItem -> CompletionListType
CompletionListType (Bool
complete Bool -> Bool -> Bool
|| Bool
complete2) ([CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List ([CompletionItem]
ls [CompletionItem] -> [CompletionItem] -> [CompletionItem]
forall a. Semigroup a => a -> a -> a
<> [CompletionItem]
ls2))) [CompletionResponseResult]
rest
                  go (CompletionList (CompletionListType Bool
complete (List [CompletionItem]
ls))) (Completions (List [CompletionItem]
ls2):[CompletionResponseResult]
rest)
                      = CompletionResponseResult
-> [CompletionResponseResult] -> CompletionResponseResult
go (CompletionListType -> CompletionResponseResult
CompletionList (CompletionListType -> CompletionResponseResult)
-> CompletionListType -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ Bool -> List CompletionItem -> CompletionListType
CompletionListType Bool
complete ([CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List ([CompletionItem]
ls [CompletionItem] -> [CompletionItem] -> [CompletionItem]
forall a. Semigroup a => a -> a -> a
<> [CompletionItem]
ls2))) [CompletionResponseResult]
rest
          makeAction :: (PluginId,
 LspFuncs Config
 -> IdeState
 -> CompletionParams
 -> IO (Either a CompletionResponseResult))
-> IO (Either a CompletionResponseResult)
makeAction (PluginId
pid,LspFuncs Config
-> IdeState
-> CompletionParams
-> IO (Either a CompletionResponseResult)
p) = do
            PluginConfig
pluginConfig <- LspFuncs Config -> PluginId -> IO PluginConfig
getPluginConfig LspFuncs Config
lf PluginId
pid
            if PluginConfig -> (PluginConfig -> Bool) -> Bool
pluginEnabled PluginConfig
pluginConfig PluginConfig -> Bool
plcCompletionOn
               then LspFuncs Config
-> IdeState
-> CompletionParams
-> IO (Either a CompletionResponseResult)
p LspFuncs Config
lf IdeState
ideState CompletionParams
params
               else Either a CompletionResponseResult
-> IO (Either a CompletionResponseResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a CompletionResponseResult
 -> IO (Either a CompletionResponseResult))
-> Either a CompletionResponseResult
-> IO (Either a CompletionResponseResult)
forall a b. (a -> b) -> a -> b
$ CompletionResponseResult -> Either a CompletionResponseResult
forall a b. b -> Either a b
Right (CompletionResponseResult -> Either a CompletionResponseResult)
-> CompletionResponseResult -> Either a CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List []

      case Maybe PosPrefixInfo
mprefix of
          Maybe PosPrefixInfo
Nothing -> Either ResponseError CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError CompletionResponseResult
 -> IO (Either ResponseError CompletionResponseResult))
-> Either ResponseError CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall a b. (a -> b) -> a -> b
$ CompletionResponseResult
-> Either ResponseError CompletionResponseResult
forall a b. b -> Either a b
Right (CompletionResponseResult
 -> Either ResponseError CompletionResponseResult)
-> CompletionResponseResult
-> Either ResponseError CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ List CompletionItem -> CompletionResponseResult
Completions (List CompletionItem -> CompletionResponseResult)
-> List CompletionItem -> CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionItem] -> List CompletionItem
forall a. [a] -> List a
List []
          Just PosPrefixInfo
_prefix -> do
            [Either ResponseError CompletionResponseResult]
mhs <- ((PluginId, CompletionProvider IdeState)
 -> IO (Either ResponseError CompletionResponseResult))
-> [(PluginId, CompletionProvider IdeState)]
-> IO [Either ResponseError CompletionResponseResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (PluginId, CompletionProvider IdeState)
-> IO (Either ResponseError CompletionResponseResult)
forall a.
(PluginId,
 LspFuncs Config
 -> IdeState
 -> CompletionParams
 -> IO (Either a CompletionResponseResult))
-> IO (Either a CompletionResponseResult)
makeAction [(PluginId, CompletionProvider IdeState)]
sps
            case [Either ResponseError CompletionResponseResult]
-> [CompletionResponseResult]
forall a b. [Either a b] -> [b]
rights [Either ResponseError CompletionResponseResult]
mhs of
                [] -> Either ResponseError CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError CompletionResponseResult
 -> IO (Either ResponseError CompletionResponseResult))
-> Either ResponseError CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError CompletionResponseResult
forall a b. a -> Either a b
Left (ResponseError -> Either ResponseError CompletionResponseResult)
-> ResponseError -> Either ResponseError CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ Text -> ResponseError
responseError (Text -> ResponseError) -> Text -> ResponseError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [ResponseError] -> String
forall a. Show a => a -> String
show ([ResponseError] -> String) -> [ResponseError] -> String
forall a b. (a -> b) -> a -> b
$ [Either ResponseError CompletionResponseResult] -> [ResponseError]
forall a b. [Either a b] -> [a]
lefts [Either ResponseError CompletionResponseResult]
mhs
                [CompletionResponseResult]
hs -> Either ResponseError CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ResponseError CompletionResponseResult
 -> IO (Either ResponseError CompletionResponseResult))
-> Either ResponseError CompletionResponseResult
-> IO (Either ResponseError CompletionResponseResult)
forall a b. (a -> b) -> a -> b
$ CompletionResponseResult
-> Either ResponseError CompletionResponseResult
forall a b. b -> Either a b
Right (CompletionResponseResult
 -> Either ResponseError CompletionResponseResult)
-> CompletionResponseResult
-> Either ResponseError CompletionResponseResult
forall a b. (a -> b) -> a -> b
$ [CompletionResponseResult] -> CompletionResponseResult
combine [CompletionResponseResult]
hs

getPrefixAtPos :: LSP.LspFuncs Config -> Uri -> Position -> IO (Maybe VFS.PosPrefixInfo)
getPrefixAtPos :: LspFuncs Config -> Uri -> Position -> IO (Maybe PosPrefixInfo)
getPrefixAtPos LspFuncs Config
lf Uri
uri Position
pos = do
  Maybe VirtualFile
mvf <-  LspFuncs Config -> NormalizedUri -> IO (Maybe VirtualFile)
forall c. LspFuncs c -> NormalizedUri -> IO (Maybe VirtualFile)
LSP.getVirtualFileFunc LspFuncs Config
lf (Uri -> NormalizedUri
J.toNormalizedUri Uri
uri)
  case Maybe VirtualFile
mvf of
    Just VirtualFile
vf -> Position -> VirtualFile -> IO (Maybe PosPrefixInfo)
forall (m :: * -> *).
Monad m =>
Position -> VirtualFile -> m (Maybe PosPrefixInfo)
VFS.getCompletionPrefix Position
pos VirtualFile
vf
    Maybe VirtualFile
Nothing -> Maybe PosPrefixInfo -> IO (Maybe PosPrefixInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PosPrefixInfo
forall a. Maybe a
Nothing