{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
module Development.IDE.Plugin.HLS
(
asGhcIdePlugin
, toResponseError
, Log(..)
) where
import Control.Exception (SomeException)
import Control.Monad
import Control.Monad.Trans.Except (runExceptT)
import qualified Data.Aeson as A
import Data.Bifunctor (first)
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.Dependent.Sum
import Data.Either
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty, nonEmpty, toList)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map as Map
import Data.Maybe (mapMaybe)
import Data.Some
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE.Core.Shake hiding (Log)
import Development.IDE.Core.Tracing
import Development.IDE.Graph (Rules)
import Development.IDE.LSP.Server
import Development.IDE.Plugin
import qualified Development.IDE.Plugin as P
import Ide.Logger
import Ide.Plugin.Config
import Ide.Plugin.Error
import Ide.Plugin.HandleRequestTypes
import Ide.PluginUtils (getClientConfig)
import Ide.Types as HLS
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import qualified Language.LSP.Server as LSP
import Language.LSP.VFS
import Prettyprinter.Render.String (renderString)
import Text.Regex.TDFA.Text ()
import UnliftIO (MonadUnliftIO, liftIO)
import UnliftIO.Async (forConcurrently)
import UnliftIO.Exception (catchAny)
data Log
= LogPluginError PluginId PluginError
| forall m . A.ToJSON (ErrorData m) => LogResponseError PluginId (TResponseError m)
| LogNoPluginForMethod (Some SMethod)
| LogInvalidCommandIdentifier
| ExceptionInPlugin PluginId (Some SMethod) SomeException
instance Pretty Log where
pretty :: forall ann. Log -> Doc ann
pretty = \case
LogPluginError (PluginId Text
pId) PluginError
err ->
Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
pId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> PluginError -> Doc ann
forall ann. PluginError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty PluginError
err
LogResponseError (PluginId Text
pId) TResponseError m
err ->
Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
pId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
":" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TResponseError m -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. TResponseError m -> Doc ann
pretty TResponseError m
err
LogNoPluginForMethod (Some SMethod a
method) ->
Doc ann
"No plugin handles this " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SMethod a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SMethod a -> Doc ann
pretty SMethod a
method Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" request."
Log
LogInvalidCommandIdentifier-> Doc ann
"Invalid command identifier"
ExceptionInPlugin PluginId
plId (Some SMethod a
method) SomeException
exception ->
Doc ann
"Exception in plugin " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> PluginId -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow PluginId
plId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" while processing "
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SMethod a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. SMethod a -> Doc ann
pretty SMethod a
method Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
": " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> SomeException -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow SomeException
exception
instance Show Log where show :: Log -> String
show = SimpleDocStream Any -> String
forall ann. SimpleDocStream ann -> String
renderString (SimpleDocStream Any -> String)
-> (Log -> SimpleDocStream Any) -> Log -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> SimpleDocStream Any
forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact (Doc Any -> SimpleDocStream Any)
-> (Log -> Doc Any) -> Log -> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Log -> Doc Any
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty
noPluginHandles :: Recorder (WithPriority Log) -> SMethod m -> [(PluginId, HandleRequestResult)] -> IO (Either (TResponseError m) c)
noPluginHandles :: forall {f :: MessageDirection} (m :: Method f 'Request) c.
Recorder (WithPriority Log)
-> SMethod m
-> [(PluginId, HandleRequestResult)]
-> IO (Either (TResponseError m) c)
noPluginHandles Recorder (WithPriority Log)
recorder SMethod m
m [(PluginId, HandleRequestResult)]
fs' = do
Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (Some SMethod -> Log
forall {f :: MessageDirection} {t :: MessageKind}.
Some SMethod -> Log
LogNoPluginForMethod (Some SMethod -> Log) -> Some SMethod -> Log
forall a b. (a -> b) -> a -> b
$ SMethod m -> Some SMethod
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some SMethod m
m)
let err :: TResponseError m
err = (LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
forall (f :: MessageDirection) (m :: Method f 'Request).
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
TResponseError (ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_MethodNotFound) Text
msg Maybe (ErrorData m)
forall a. Maybe a
Nothing
msg :: Text
msg = SMethod m -> [(PluginId, HandleRequestResult)] -> Text
forall {f :: MessageDirection} {t :: MessageKind}
(m :: Method f t).
SMethod m -> [(PluginId, HandleRequestResult)] -> Text
noPluginHandlesMsg SMethod m
m [(PluginId, HandleRequestResult)]
fs'
Either (TResponseError m) c -> IO (Either (TResponseError m) c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (TResponseError m) c -> IO (Either (TResponseError m) c))
-> Either (TResponseError m) c -> IO (Either (TResponseError m) c)
forall a b. (a -> b) -> a -> b
$ TResponseError m -> Either (TResponseError m) c
forall a b. a -> Either a b
Left TResponseError m
err
where noPluginHandlesMsg :: SMethod m -> [(PluginId, HandleRequestResult)] -> Text
noPluginHandlesMsg :: forall {f :: MessageDirection} {t :: MessageKind}
(m :: Method f t).
SMethod m -> [(PluginId, HandleRequestResult)] -> Text
noPluginHandlesMsg SMethod m
method [] = Text
"No plugins are available to handle this " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SMethod m -> String
forall a. Show a => a -> String
show SMethod m
method) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" request."
noPluginHandlesMsg SMethod m
method [(PluginId, HandleRequestResult)]
availPlugins =
Text
"No plugins are available to handle this " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SMethod m -> String
forall a. Show a => a -> String
show SMethod m
method) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" request.\n Plugins installed for this method, but not available to handle this request are:\n"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
((PluginId, HandleRequestResult) -> Text)
-> [(PluginId, HandleRequestResult)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(PluginId Text
plid, HandleRequestResult
pluginStatus) ->
Text
plid
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (SimpleDocStream Any -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream Any -> Text)
-> (HandleRequestResult -> SimpleDocStream Any)
-> HandleRequestResult
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> SimpleDocStream Any
forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact (Doc Any -> SimpleDocStream Any)
-> (HandleRequestResult -> Doc Any)
-> HandleRequestResult
-> SimpleDocStream Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HandleRequestResult -> Doc Any
forall ann. HandleRequestResult -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty) HandleRequestResult
pluginStatus)
[(PluginId, HandleRequestResult)]
availPlugins)
pluginDoesntExist :: PluginId -> Text
pluginDoesntExist :: PluginId -> Text
pluginDoesntExist (PluginId Text
pid) = Text
"Plugin " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" doesn't exist"
commandDoesntExist :: CommandId -> PluginId -> [PluginCommand ideState] -> Text
commandDoesntExist :: forall ideState.
CommandId -> PluginId -> [PluginCommand ideState] -> Text
commandDoesntExist (CommandId Text
com) (PluginId Text
pid) [PluginCommand ideState]
legalCmds =
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
pid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Legal commands are: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (PluginCommand ideState -> Text)
-> [PluginCommand ideState] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(PluginCommand{$sel:commandId:PluginCommand :: forall ideState. PluginCommand ideState -> CommandId
commandId = CommandId Text
cid}) -> Text
cid) [PluginCommand ideState]
legalCmds)
failedToParseArgs :: CommandId
-> PluginId
-> String
-> A.Value
-> Text
failedToParseArgs :: CommandId -> PluginId -> String -> Value -> Text
failedToParseArgs (CommandId Text
com) (PluginId Text
pid) String
err Value
arg =
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
pid 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
", arg = " 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)
exceptionInPlugin :: PluginId -> SMethod m -> SomeException -> Text
exceptionInPlugin :: forall {f :: MessageDirection} {t :: MessageKind}
(m :: Method f t).
PluginId -> SMethod m -> SomeException -> Text
exceptionInPlugin PluginId
plId SMethod m
method SomeException
exception =
Text
"Exception in plugin " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PluginId -> String
forall a. Show a => a -> String
show PluginId
plId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" while processing "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SMethod m -> String
forall a. Show a => a -> String
show SMethod m
method) 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 (SomeException -> String
forall a. Show a => a -> String
show SomeException
exception)
logAndReturnError :: A.ToJSON (ErrorData m) => Recorder (WithPriority Log) -> PluginId -> (LSPErrorCodes |? ErrorCodes) -> Text -> LSP.LspT Config IO (Either (TResponseError m) a)
logAndReturnError :: forall {f :: MessageDirection} (m :: Method f 'Request) a.
ToJSON (ErrorData m) =>
Recorder (WithPriority Log)
-> PluginId
-> (LSPErrorCodes |? ErrorCodes)
-> Text
-> LspT Config IO (Either (TResponseError m) a)
logAndReturnError Recorder (WithPriority Log)
recorder PluginId
p LSPErrorCodes |? ErrorCodes
errCode Text
msg = do
let err :: TResponseError m
err = (LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
forall (f :: MessageDirection) (m :: Method f 'Request).
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
TResponseError LSPErrorCodes |? ErrorCodes
errCode Text
msg Maybe (ErrorData m)
forall a. Maybe a
Nothing
Recorder (WithPriority Log) -> Priority -> Log -> LspT Config IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (Log -> LspT Config IO ()) -> Log -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ PluginId -> TResponseError m -> Log
forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
PluginId -> TResponseError m -> Log
LogResponseError PluginId
p TResponseError m
err
Either (TResponseError m) a
-> LspT Config IO (Either (TResponseError m) a)
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TResponseError m) a
-> LspT Config IO (Either (TResponseError m) a))
-> Either (TResponseError m) a
-> LspT Config IO (Either (TResponseError m) a)
forall a b. (a -> b) -> a -> b
$ TResponseError m -> Either (TResponseError m) a
forall a b. a -> Either a b
Left TResponseError m
err
asGhcIdePlugin :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Plugin Config
asGhcIdePlugin :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Plugin Config
asGhcIdePlugin Recorder (WithPriority Log)
recorder (IdePlugins [PluginDescriptor IdeState]
ls) =
([(PluginId, Rules ())] -> Plugin Config)
-> (PluginDescriptor IdeState -> Rules ()) -> Plugin Config
forall {b}.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPlugin [(PluginId, Rules ())] -> Plugin Config
rulesPlugins 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 -> [PluginCommand IdeState])
-> Plugin Config
forall {b}.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPlugin (Recorder (WithPriority Log)
-> [(PluginId, [PluginCommand IdeState])] -> Plugin Config
executeCommandPlugins Recorder (WithPriority Log)
recorder) PluginDescriptor IdeState -> [PluginCommand IdeState]
forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
HLS.pluginCommands Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
([(PluginId, PluginDescriptor IdeState)] -> Plugin Config)
-> (PluginDescriptor IdeState -> PluginDescriptor IdeState)
-> Plugin Config
forall {b}.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPlugin (Recorder (WithPriority Log)
-> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config
extensiblePlugins Recorder (WithPriority Log)
recorder) PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a. a -> a
id Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
([(PluginId, PluginDescriptor IdeState)] -> Plugin Config)
-> (PluginDescriptor IdeState -> PluginDescriptor IdeState)
-> Plugin Config
forall {b}.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPlugin (Recorder (WithPriority Log)
-> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config
extensibleNotificationPlugins Recorder (WithPriority Log)
recorder) PluginDescriptor IdeState -> PluginDescriptor IdeState
forall a. a -> a
id Plugin Config -> Plugin Config -> Plugin Config
forall a. Semigroup a => a -> a -> a
<>
([(PluginDescriptor IdeState, DynFlagsModifications)]
-> Plugin Config)
-> (PluginDescriptor IdeState -> DynFlagsModifications)
-> Plugin Config
forall b.
([(PluginDescriptor IdeState, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPluginFromDescriptor [(PluginDescriptor IdeState, DynFlagsModifications)]
-> Plugin Config
forall c.
[(PluginDescriptor c, DynFlagsModifications)] -> Plugin Config
dynFlagsPlugins PluginDescriptor IdeState -> DynFlagsModifications
forall ideState. PluginDescriptor ideState -> DynFlagsModifications
HLS.pluginModifyDynflags
where
mkPlugin :: ([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPlugin [(PluginId, b)] -> Plugin Config
f = ([(PluginDescriptor IdeState, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
forall b.
([(PluginDescriptor IdeState, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPluginFromDescriptor ([(PluginId, b)] -> Plugin Config
f ([(PluginId, b)] -> Plugin Config)
-> ([(PluginDescriptor IdeState, b)] -> [(PluginId, b)])
-> [(PluginDescriptor IdeState, b)]
-> Plugin Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PluginDescriptor IdeState, b) -> (PluginId, b))
-> [(PluginDescriptor IdeState, b)] -> [(PluginId, b)]
forall a b. (a -> b) -> [a] -> [b]
map ((PluginDescriptor IdeState -> PluginId)
-> (PluginDescriptor IdeState, b) -> (PluginId, b)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first PluginDescriptor IdeState -> PluginId
forall ideState. PluginDescriptor ideState -> PluginId
pluginId))
mkPluginFromDescriptor
:: ([(PluginDescriptor IdeState, b)]
-> Plugin Config)
-> (PluginDescriptor IdeState -> b)
-> Plugin Config
mkPluginFromDescriptor :: forall b.
([(PluginDescriptor IdeState, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPluginFromDescriptor [(PluginDescriptor IdeState, b)] -> Plugin Config
maker PluginDescriptor IdeState -> b
selector =
case (PluginDescriptor IdeState -> (PluginDescriptor IdeState, b))
-> [PluginDescriptor IdeState] -> [(PluginDescriptor IdeState, b)]
forall a b. (a -> b) -> [a] -> [b]
map (\PluginDescriptor IdeState
p -> (PluginDescriptor IdeState
p, PluginDescriptor IdeState -> b
selector PluginDescriptor IdeState
p)) [PluginDescriptor IdeState]
ls of
[] -> Plugin Config
forall a. Monoid a => a
mempty
[(PluginDescriptor IdeState, b)]
xs -> [(PluginDescriptor IdeState, b)] -> Plugin Config
maker [(PluginDescriptor IdeState, b)]
xs
rulesPlugins :: [(PluginId, Rules ())] -> Plugin Config
rulesPlugins :: [(PluginId, Rules ())] -> Plugin Config
rulesPlugins [(PluginId, Rules ())]
rs = Plugin Config
forall a. Monoid a => a
mempty { P.pluginRules = rules }
where
rules :: Rules ()
rules = ((PluginId, Rules ()) -> Rules ())
-> [(PluginId, Rules ())] -> Rules ()
forall m a. Monoid m => (a -> m) -> [a] -> m
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
dynFlagsPlugins :: [(PluginDescriptor c, DynFlagsModifications)] -> Plugin Config
dynFlagsPlugins :: forall c.
[(PluginDescriptor c, DynFlagsModifications)] -> Plugin Config
dynFlagsPlugins [(PluginDescriptor c, DynFlagsModifications)]
rs = Plugin Config
forall a. Monoid a => a
mempty
{ P.pluginModifyDynflags =
flip foldMap rs $ \(PluginDescriptor c
plId, DynFlagsModifications
dflag_mods) Config
cfg ->
let plg_cfg :: PluginConfig
plg_cfg = Config -> PluginDescriptor c -> PluginConfig
forall c. Config -> PluginDescriptor c -> PluginConfig
configForPlugin Config
cfg PluginDescriptor c
plId
in if PluginConfig -> Bool
plcGlobalOn PluginConfig
plg_cfg
then DynFlagsModifications
dflag_mods
else DynFlagsModifications
forall a. Monoid a => a
mempty
}
executeCommandPlugins :: Recorder (WithPriority Log) -> [(PluginId, [PluginCommand IdeState])] -> Plugin Config
executeCommandPlugins :: Recorder (WithPriority Log)
-> [(PluginId, [PluginCommand IdeState])] -> Plugin Config
executeCommandPlugins Recorder (WithPriority Log)
recorder [(PluginId, [PluginCommand IdeState])]
ecs = Plugin Config
forall a. Monoid a => a
mempty { P.pluginHandlers = executeCommandHandlers recorder ecs }
executeCommandHandlers :: Recorder (WithPriority Log) -> [(PluginId, [PluginCommand IdeState])] -> LSP.Handlers (ServerM Config)
executeCommandHandlers :: Recorder (WithPriority Log)
-> [(PluginId, [PluginCommand IdeState])]
-> Handlers (ServerM Config)
executeCommandHandlers Recorder (WithPriority Log)
recorder [(PluginId, [PluginCommand IdeState])]
ecs = SMethod 'Method_WorkspaceExecuteCommand
-> (IdeState
-> MessageParams 'Method_WorkspaceExecuteCommand
-> LspM
Config
(Either
(TResponseError 'Method_WorkspaceExecuteCommand)
(MessageResult 'Method_WorkspaceExecuteCommand)))
-> Handlers (ServerM Config)
forall (m :: Method 'ClientToServer 'Request) c.
PluginMethod 'Request m =>
SMethod m
-> (IdeState
-> MessageParams m
-> LspM c (Either (TResponseError m) (MessageResult m)))
-> Handlers (ServerM c)
requestHandler SMethod 'Method_WorkspaceExecuteCommand
SMethod_WorkspaceExecuteCommand IdeState
-> ExecuteCommandParams
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
IdeState
-> MessageParams 'Method_WorkspaceExecuteCommand
-> LspM
Config
(Either
(TResponseError 'Method_WorkspaceExecuteCommand)
(MessageResult 'Method_WorkspaceExecuteCommand))
execCmd
where
pluginMap :: Map PluginId [PluginCommand IdeState]
pluginMap = ([PluginCommand IdeState]
-> [PluginCommand IdeState] -> [PluginCommand IdeState])
-> [(PluginId, [PluginCommand IdeState])]
-> Map PluginId [PluginCommand IdeState]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [PluginCommand IdeState]
-> [PluginCommand IdeState] -> [PluginCommand IdeState]
forall a. [a] -> [a] -> [a]
(++) [(PluginId, [PluginCommand IdeState])]
ecs
parseCmdId :: T.Text -> Maybe (PluginId, CommandId)
parseCmdId :: Text -> Maybe (PluginId, CommandId)
parseCmdId Text
x = case HasCallStack => Text -> Text -> [Text]
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 :: IdeState -> ExecuteCommandParams -> LSP.LspT Config IO (Either (TResponseError Method_WorkspaceExecuteCommand) (A.Value |? Null))
execCmd :: IdeState
-> ExecuteCommandParams
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
execCmd IdeState
ide (ExecuteCommandParams Maybe ProgressToken
mtoken Text
cmdId Maybe [Value]
args) = do
let cmdParams :: A.Value
cmdParams :: Value
cmdParams = case Maybe [Value]
args of
Just ((Value
x:[Value]
_)) -> Value
x
Maybe [Value]
_ -> Value
A.Null
case Text -> Maybe (PluginId, CommandId)
parseCmdId Text
cmdId of
Just (PluginId
"hls", CommandId
"fallbackCodeAction") ->
case Value -> Result FallbackCodeActionParams
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
cmdParams of
A.Success (FallbackCodeActionParams Maybe WorkspaceEdit
mEdit Maybe Command
mCmd) -> do
Maybe WorkspaceEdit
-> (WorkspaceEdit
-> LspT Config IO (LspId 'Method_WorkspaceApplyEdit))
-> LspT Config IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe WorkspaceEdit
mEdit ((WorkspaceEdit
-> LspT Config IO (LspId 'Method_WorkspaceApplyEdit))
-> LspT Config IO ())
-> (WorkspaceEdit
-> LspT Config IO (LspId 'Method_WorkspaceApplyEdit))
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ \WorkspaceEdit
edit ->
SServerMethod 'Method_WorkspaceApplyEdit
-> MessageParams 'Method_WorkspaceApplyEdit
-> (Either
(TResponseError 'Method_WorkspaceApplyEdit)
(MessageResult 'Method_WorkspaceApplyEdit)
-> LspT Config IO ())
-> LspT Config IO (LspId 'Method_WorkspaceApplyEdit)
forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either (TResponseError m) (MessageResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams Maybe Text
forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either
(TResponseError 'Method_WorkspaceApplyEdit)
(MessageResult 'Method_WorkspaceApplyEdit)
_ -> () -> LspT Config IO ()
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
case Maybe Command
mCmd of
Just (Command Text
_ Text
innerCmdId Maybe [Value]
innerArgs)
-> IdeState
-> ExecuteCommandParams
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
execCmd IdeState
ide (Maybe ProgressToken
-> Text -> Maybe [Value] -> ExecuteCommandParams
ExecuteCommandParams Maybe ProgressToken
forall a. Maybe a
Nothing Text
innerCmdId Maybe [Value]
innerArgs)
Maybe Command
Nothing -> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a. a -> LspT Config IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)))
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a b. (a -> b) -> a -> b
$ (Value |? Null)
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. b -> Either a b
Right ((Value |? Null)
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
-> (Value |? Null)
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> Value |? Null
forall a b. b -> a |? b
InR Null
Null
A.Error String
_str -> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a. a -> LspT Config IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)))
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a b. (a -> b) -> a -> b
$ (Value |? Null)
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. b -> Either a b
Right ((Value |? Null)
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
-> (Value |? Null)
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Null -> Value |? Null
forall a b. b -> a |? b
InR Null
Null
Just (PluginId
plugin, CommandId
cmd) -> IdeState
-> PluginId
-> CommandId
-> Maybe ProgressToken
-> Value
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
runPluginCommand IdeState
ide PluginId
plugin CommandId
cmd Maybe ProgressToken
mtoken Value
cmdParams
Maybe (PluginId, CommandId)
_ -> do
Recorder (WithPriority Log) -> Priority -> Log -> LspT Config IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning Log
LogInvalidCommandIdentifier
Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a. a -> LspT Config IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)))
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseError 'Method_WorkspaceExecuteCommand
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. a -> Either a b
Left (TResponseError 'Method_WorkspaceExecuteCommand
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
-> TResponseError 'Method_WorkspaceExecuteCommand
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ (LSPErrorCodes |? ErrorCodes)
-> Text
-> Maybe (ErrorData 'Method_WorkspaceExecuteCommand)
-> TResponseError 'Method_WorkspaceExecuteCommand
forall (f :: MessageDirection) (m :: Method f 'Request).
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
TResponseError (ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidParams) Text
"Invalid command identifier" Maybe (Maybe Void)
Maybe (ErrorData 'Method_WorkspaceExecuteCommand)
forall a. Maybe a
Nothing
runPluginCommand :: IdeState -> PluginId -> CommandId -> Maybe ProgressToken -> A.Value -> LSP.LspT Config IO (Either (TResponseError Method_WorkspaceExecuteCommand) (A.Value |? Null))
runPluginCommand :: IdeState
-> PluginId
-> CommandId
-> Maybe ProgressToken
-> Value
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
runPluginCommand IdeState
ide PluginId
p CommandId
com Maybe ProgressToken
mtoken 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]
pluginMap of
Maybe [PluginCommand IdeState]
Nothing -> Recorder (WithPriority Log)
-> PluginId
-> (LSPErrorCodes |? ErrorCodes)
-> Text
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall {f :: MessageDirection} (m :: Method f 'Request) a.
ToJSON (ErrorData m) =>
Recorder (WithPriority Log)
-> PluginId
-> (LSPErrorCodes |? ErrorCodes)
-> Text
-> LspT Config IO (Either (TResponseError m) a)
logAndReturnError Recorder (WithPriority Log)
recorder PluginId
p (ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidRequest) (PluginId -> Text
pluginDoesntExist PluginId
p)
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 -> 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 -> Recorder (WithPriority Log)
-> PluginId
-> (LSPErrorCodes |? ErrorCodes)
-> Text
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall {f :: MessageDirection} (m :: Method f 'Request) a.
ToJSON (ErrorData m) =>
Recorder (WithPriority Log)
-> PluginId
-> (LSPErrorCodes |? ErrorCodes)
-> Text
-> LspT Config IO (Either (TResponseError m) a)
logAndReturnError Recorder (WithPriority Log)
recorder PluginId
p (ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidRequest) (CommandId -> PluginId -> [PluginCommand IdeState] -> Text
forall ideState.
CommandId -> PluginId -> [PluginCommand ideState] -> Text
commandDoesntExist CommandId
com PluginId
p [PluginCommand IdeState]
xs)
Just (PluginCommand CommandId
_ Text
_ CommandFunction IdeState a
f) -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
arg of
A.Error String
err -> Recorder (WithPriority Log)
-> PluginId
-> (LSPErrorCodes |? ErrorCodes)
-> Text
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall {f :: MessageDirection} (m :: Method f 'Request) a.
ToJSON (ErrorData m) =>
Recorder (WithPriority Log)
-> PluginId
-> (LSPErrorCodes |? ErrorCodes)
-> Text
-> LspT Config IO (Either (TResponseError m) a)
logAndReturnError Recorder (WithPriority Log)
recorder PluginId
p (ErrorCodes -> LSPErrorCodes |? ErrorCodes
forall a b. b -> a |? b
InR ErrorCodes
ErrorCodes_InvalidParams) (CommandId -> PluginId -> String -> Value -> Text
failedToParseArgs CommandId
com PluginId
p String
err Value
arg)
A.Success a
a -> do
Either PluginError (Value |? Null)
res <- HandlerM Config (Either PluginError (Value |? Null))
-> LspM Config (Either PluginError (Value |? Null))
forall config a. HandlerM config a -> LspM config a
runHandlerM (ExceptT PluginError (HandlerM Config) (Value |? Null)
-> HandlerM Config (Either PluginError (Value |? Null))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (CommandFunction IdeState a
f IdeState
ide Maybe ProgressToken
mtoken a
a)) LspM Config (Either PluginError (Value |? Null))
-> (SomeException
-> LspM Config (Either PluginError (Value |? Null)))
-> LspM Config (Either PluginError (Value |? Null))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny`
(\SomeException
e -> Either PluginError (Value |? Null)
-> LspM Config (Either PluginError (Value |? Null))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError (Value |? Null)
-> LspM Config (Either PluginError (Value |? Null)))
-> Either PluginError (Value |? Null)
-> LspM Config (Either PluginError (Value |? Null))
forall a b. (a -> b) -> a -> b
$ PluginError -> Either PluginError (Value |? Null)
forall a b. a -> Either a b
Left (PluginError -> Either PluginError (Value |? Null))
-> PluginError -> Either PluginError (Value |? Null)
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError (PluginId
-> SMethod 'Method_WorkspaceExecuteCommand -> SomeException -> Text
forall {f :: MessageDirection} {t :: MessageKind}
(m :: Method f t).
PluginId -> SMethod m -> SomeException -> Text
exceptionInPlugin PluginId
p SMethod 'Method_WorkspaceExecuteCommand
SMethod_WorkspaceExecuteCommand SomeException
e))
case Either PluginError (Value |? Null)
res of
(Left (PluginRequestRefused RejectionReason
r)) ->
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)))
-> IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log)
-> SMethod 'Method_WorkspaceExecuteCommand
-> [(PluginId, HandleRequestResult)]
-> IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall {f :: MessageDirection} (m :: Method f 'Request) c.
Recorder (WithPriority Log)
-> SMethod m
-> [(PluginId, HandleRequestResult)]
-> IO (Either (TResponseError m) c)
noPluginHandles Recorder (WithPriority Log)
recorder SMethod 'Method_WorkspaceExecuteCommand
SMethod_WorkspaceExecuteCommand [(PluginId
p,RejectionReason -> HandleRequestResult
DoesNotHandleRequest RejectionReason
r)]
(Left PluginError
pluginErr) -> do
IO () -> LspT Config IO ()
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log) -> [(PluginId, PluginError)] -> IO ()
logErrors Recorder (WithPriority Log)
recorder [(PluginId
p, PluginError
pluginErr)]
Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)))
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a b. (a -> b) -> a -> b
$ TResponseError 'Method_WorkspaceExecuteCommand
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. a -> Either a b
Left (TResponseError 'Method_WorkspaceExecuteCommand
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
-> TResponseError 'Method_WorkspaceExecuteCommand
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. (a -> b) -> a -> b
$ (PluginId, PluginError)
-> TResponseError 'Method_WorkspaceExecuteCommand
forall {f :: MessageDirection} (m :: Method f 'Request).
(PluginId, PluginError) -> TResponseError m
toResponseError (PluginId
p, PluginError
pluginErr)
(Right Value |? Null
result) -> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)))
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
-> LspT
Config
IO
(Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null))
forall a b. (a -> b) -> a -> b
$ (Value |? Null)
-> Either
(TResponseError 'Method_WorkspaceExecuteCommand) (Value |? Null)
forall a b. b -> Either a b
Right Value |? Null
result
extensiblePlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config
extensiblePlugins :: Recorder (WithPriority Log)
-> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config
extensiblePlugins Recorder (WithPriority Log)
recorder [(PluginId, PluginDescriptor IdeState)]
plugins = Plugin Config
forall a. Monoid a => a
mempty { P.pluginHandlers = handlers }
where
IdeHandlers DMap IdeMethod IdeHandler
handlers' = ((PluginId, PluginDescriptor IdeState) -> IdeHandlers)
-> [(PluginId, PluginDescriptor IdeState)] -> IdeHandlers
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PluginId, PluginDescriptor IdeState) -> IdeHandlers
bakePluginId [(PluginId, PluginDescriptor IdeState)]
plugins
bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeHandlers
bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeHandlers
bakePluginId (PluginId
pid,PluginDescriptor IdeState
pluginDesc) = DMap IdeMethod IdeHandler -> IdeHandlers
IdeHandlers (DMap IdeMethod IdeHandler -> IdeHandlers)
-> DMap IdeMethod IdeHandler -> IdeHandlers
forall a b. (a -> b) -> a -> b
$ (forall (v :: Method 'ClientToServer 'Request).
PluginHandler IdeState v -> IdeHandler v)
-> DMap IdeMethod (PluginHandler IdeState)
-> DMap IdeMethod IdeHandler
forall {k1} (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map
(\(PluginHandler PluginId
-> IdeState
-> MessageParams v
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult v)))
f) -> [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams v
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult v))))]
-> IdeHandler v
forall (m :: Method 'ClientToServer 'Request).
[(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
-> IdeHandler m
IdeHandler [(PluginId
pid,PluginDescriptor IdeState
pluginDesc,PluginId
-> IdeState
-> MessageParams v
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult v)))
f PluginId
pid)])
DMap IdeMethod (PluginHandler IdeState)
hs
where
PluginHandlers DMap IdeMethod (PluginHandler IdeState)
hs = PluginDescriptor IdeState -> PluginHandlers IdeState
forall ideState.
PluginDescriptor ideState -> PluginHandlers ideState
HLS.pluginHandlers PluginDescriptor IdeState
pluginDesc
handlers :: Handlers (ServerM Config)
handlers = [Handlers (ServerM Config)] -> Handlers (ServerM Config)
forall a. Monoid a => [a] -> a
mconcat ([Handlers (ServerM Config)] -> Handlers (ServerM Config))
-> [Handlers (ServerM Config)] -> Handlers (ServerM Config)
forall a b. (a -> b) -> a -> b
$ do
(IdeMethod SMethod a
m :=> IdeHandler [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
fs') <- DMap IdeMethod IdeHandler -> [DSum IdeMethod IdeHandler]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.assocs DMap IdeMethod IdeHandler
handlers'
Handlers (ServerM Config) -> [Handlers (ServerM Config)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handlers (ServerM Config) -> [Handlers (ServerM Config)])
-> Handlers (ServerM Config) -> [Handlers (ServerM Config)]
forall a b. (a -> b) -> a -> b
$ SMethod a
-> (IdeState
-> MessageParams a
-> LspM Config (Either (TResponseError a) (MessageResult a)))
-> Handlers (ServerM Config)
forall (m :: Method 'ClientToServer 'Request) c.
PluginMethod 'Request m =>
SMethod m
-> (IdeState
-> MessageParams m
-> LspM c (Either (TResponseError m) (MessageResult m)))
-> Handlers (ServerM c)
requestHandler SMethod a
m ((IdeState
-> MessageParams a
-> LspM Config (Either (TResponseError a) (MessageResult a)))
-> Handlers (ServerM Config))
-> (IdeState
-> MessageParams a
-> LspM Config (Either (TResponseError a) (MessageResult a)))
-> Handlers (ServerM Config)
forall a b. (a -> b) -> a -> b
$ \IdeState
ide MessageParams a
params -> do
Config
config <- LspT Config IO Config
forall (m :: * -> *). MonadLsp Config m => m Config
Ide.PluginUtils.getClientConfig
let ([(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
fs, [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
dfs) = ((PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
-> Bool)
-> [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
-> ([(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))],
[(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (\(PluginId
_, PluginDescriptor IdeState
desc, IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a)))
_) -> SMethod a
-> MessageParams a
-> PluginDescriptor IdeState
-> Config
-> HandleRequestResult
forall c.
SMethod a
-> MessageParams a
-> PluginDescriptor c
-> Config
-> HandleRequestResult
forall (k :: MessageKind) (m :: Method 'ClientToServer k) c.
PluginMethod k m =>
SMethod m
-> MessageParams m
-> PluginDescriptor c
-> Config
-> HandleRequestResult
handlesRequest SMethod a
m MessageParams a
params PluginDescriptor IdeState
desc Config
config HandleRequestResult -> HandleRequestResult -> Bool
forall a. Eq a => a -> a -> Bool
== HandleRequestResult
HandlesRequest) [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
fs'
let disabledPluginsReason :: [(PluginId, HandleRequestResult)]
disabledPluginsReason = (\(PluginId
x, PluginDescriptor IdeState
desc, IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a)))
_) -> (PluginId
x, SMethod a
-> MessageParams a
-> PluginDescriptor IdeState
-> Config
-> HandleRequestResult
forall c.
SMethod a
-> MessageParams a
-> PluginDescriptor c
-> Config
-> HandleRequestResult
forall (k :: MessageKind) (m :: Method 'ClientToServer k) c.
PluginMethod k m =>
SMethod m
-> MessageParams m
-> PluginDescriptor c
-> Config
-> HandleRequestResult
handlesRequest SMethod a
m MessageParams a
params PluginDescriptor IdeState
desc Config
config)) ((PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
-> (PluginId, HandleRequestResult))
-> [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
-> [(PluginId, HandleRequestResult)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
dfs
case [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
-> Maybe
(NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a)))))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))]
fs of
Maybe
(NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a)))))
Nothing -> IO (Either (TResponseError a) (MessageResult a))
-> LspM Config (Either (TResponseError a) (MessageResult a))
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (TResponseError a) (MessageResult a))
-> LspM Config (Either (TResponseError a) (MessageResult a)))
-> IO (Either (TResponseError a) (MessageResult a))
-> LspM Config (Either (TResponseError a) (MessageResult a))
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log)
-> SMethod a
-> [(PluginId, HandleRequestResult)]
-> IO (Either (TResponseError a) (MessageResult a))
forall {f :: MessageDirection} (m :: Method f 'Request) c.
Recorder (WithPriority Log)
-> SMethod m
-> [(PluginId, HandleRequestResult)]
-> IO (Either (TResponseError m) c)
noPluginHandles Recorder (WithPriority Log)
recorder SMethod a
m [(PluginId, HandleRequestResult)]
disabledPluginsReason
Just NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
neFs -> do
let plidsAndHandlers :: NonEmpty
(PluginId,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
plidsAndHandlers = ((PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
-> (PluginId,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a)))))
-> NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
-> NonEmpty
(PluginId,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PluginId
plid,PluginDescriptor IdeState
_,IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a)))
handler) -> (PluginId
plid,IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a)))
handler)) NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
neFs
NonEmpty (NonEmpty (Either PluginError (MessageResult a)))
es <- HandlerM
Config (NonEmpty (NonEmpty (Either PluginError (MessageResult a))))
-> LspM
Config (NonEmpty (NonEmpty (Either PluginError (MessageResult a))))
forall config a. HandlerM config a -> LspM config a
runHandlerM (HandlerM
Config (NonEmpty (NonEmpty (Either PluginError (MessageResult a))))
-> LspM
Config
(NonEmpty (NonEmpty (Either PluginError (MessageResult a)))))
-> HandlerM
Config (NonEmpty (NonEmpty (Either PluginError (MessageResult a))))
-> LspM
Config (NonEmpty (NonEmpty (Either PluginError (MessageResult a))))
forall a b. (a -> b) -> a -> b
$ (PluginId -> SMethod a -> SomeException -> Text)
-> SMethod a
-> NonEmpty
(PluginId,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
-> IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (NonEmpty (Either PluginError (MessageResult a))))
forall {f :: MessageDirection} {t :: MessageKind} (m :: * -> *)
(method :: Method f t) a b d.
MonadUnliftIO m =>
(PluginId -> SMethod method -> SomeException -> Text)
-> SMethod method
-> NonEmpty
(PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
-> a
-> b
-> m (NonEmpty (NonEmpty (Either PluginError d)))
runConcurrently PluginId -> SMethod a -> SomeException -> Text
forall {f :: MessageDirection} {t :: MessageKind}
(m :: Method f t).
PluginId -> SMethod m -> SomeException -> Text
exceptionInPlugin SMethod a
m NonEmpty
(PluginId,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
plidsAndHandlers IdeState
ide MessageParams a
params
ClientCapabilities
caps <- LspT Config IO ClientCapabilities
forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
LSP.getClientCapabilities
let ([(PluginId, PluginError)]
errs,[MessageResult a]
succs) = [Either (PluginId, PluginError) (MessageResult a)]
-> ([(PluginId, PluginError)], [MessageResult a])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (PluginId, PluginError) (MessageResult a)]
-> ([(PluginId, PluginError)], [MessageResult a]))
-> [Either (PluginId, PluginError) (MessageResult a)]
-> ([(PluginId, PluginError)], [MessageResult a])
forall a b. (a -> b) -> a -> b
$ NonEmpty (Either (PluginId, PluginError) (MessageResult a))
-> [Either (PluginId, PluginError) (MessageResult a)]
forall a. NonEmpty a -> [a]
toList (NonEmpty (Either (PluginId, PluginError) (MessageResult a))
-> [Either (PluginId, PluginError) (MessageResult a)])
-> NonEmpty (Either (PluginId, PluginError) (MessageResult a))
-> [Either (PluginId, PluginError) (MessageResult a)]
forall a b. (a -> b) -> a -> b
$ NonEmpty
(NonEmpty (Either (PluginId, PluginError) (MessageResult a)))
-> NonEmpty (Either (PluginId, PluginError) (MessageResult a))
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (NonEmpty
(NonEmpty (Either (PluginId, PluginError) (MessageResult a)))
-> NonEmpty (Either (PluginId, PluginError) (MessageResult a)))
-> NonEmpty
(NonEmpty (Either (PluginId, PluginError) (MessageResult a)))
-> NonEmpty (Either (PluginId, PluginError) (MessageResult a))
forall a b. (a -> b) -> a -> b
$ ((PluginId,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
-> NonEmpty (Either PluginError (MessageResult a))
-> NonEmpty (Either (PluginId, PluginError) (MessageResult a)))
-> NonEmpty
(PluginId,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
-> NonEmpty (NonEmpty (Either PluginError (MessageResult a)))
-> NonEmpty
(NonEmpty (Either (PluginId, PluginError) (MessageResult a)))
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (\(PluginId
pId,IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a)))
_) -> (Either PluginError (MessageResult a)
-> Either (PluginId, PluginError) (MessageResult a))
-> NonEmpty (Either PluginError (MessageResult a))
-> NonEmpty (Either (PluginId, PluginError) (MessageResult a))
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((PluginError -> (PluginId, PluginError))
-> Either PluginError (MessageResult a)
-> Either (PluginId, PluginError) (MessageResult a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (PluginId
pId,))) NonEmpty
(PluginId,
IdeState
-> MessageParams a
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult a))))
plidsAndHandlers NonEmpty (NonEmpty (Either PluginError (MessageResult a)))
es
IO () -> LspT Config IO ()
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(PluginId, PluginError)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PluginId, PluginError)]
errs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log) -> [(PluginId, PluginError)] -> IO ()
logErrors Recorder (WithPriority Log)
recorder [(PluginId, PluginError)]
errs
case [MessageResult a] -> Maybe (NonEmpty (MessageResult a))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [MessageResult a]
succs of
Maybe (NonEmpty (MessageResult a))
Nothing -> do
let noRefused :: (a, PluginError) -> Bool
noRefused (a
_, PluginRequestRefused RejectionReason
_) = Bool
False
noRefused (a
_, PluginError
_) = Bool
True
([(PluginId, PluginError)]
asErrors, [(PluginId, PluginError)]
asRefused) = ((PluginId, PluginError) -> Bool)
-> [(PluginId, PluginError)]
-> ([(PluginId, PluginError)], [(PluginId, PluginError)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.partition (PluginId, PluginError) -> Bool
forall {a}. (a, PluginError) -> Bool
noRefused [(PluginId, PluginError)]
errs
convertPRR :: (a, PluginError) -> Maybe (a, HandleRequestResult)
convertPRR (a
pId, PluginRequestRefused RejectionReason
r) = (a, HandleRequestResult) -> Maybe (a, HandleRequestResult)
forall a. a -> Maybe a
Just (a
pId, RejectionReason -> HandleRequestResult
DoesNotHandleRequest RejectionReason
r)
convertPRR (a, PluginError)
_ = Maybe (a, HandleRequestResult)
forall a. Maybe a
Nothing
asRefusedReason :: [(PluginId, HandleRequestResult)]
asRefusedReason = ((PluginId, PluginError) -> Maybe (PluginId, HandleRequestResult))
-> [(PluginId, PluginError)] -> [(PluginId, HandleRequestResult)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PluginId, PluginError) -> Maybe (PluginId, HandleRequestResult)
forall {a}. (a, PluginError) -> Maybe (a, HandleRequestResult)
convertPRR [(PluginId, PluginError)]
asRefused
case [(PluginId, PluginError)]
-> Maybe (NonEmpty (PluginId, PluginError))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(PluginId, PluginError)]
asErrors of
Maybe (NonEmpty (PluginId, PluginError))
Nothing -> IO (Either (TResponseError a) (MessageResult a))
-> LspM Config (Either (TResponseError a) (MessageResult a))
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (TResponseError a) (MessageResult a))
-> LspM Config (Either (TResponseError a) (MessageResult a)))
-> IO (Either (TResponseError a) (MessageResult a))
-> LspM Config (Either (TResponseError a) (MessageResult a))
forall a b. (a -> b) -> a -> b
$ Recorder (WithPriority Log)
-> SMethod a
-> [(PluginId, HandleRequestResult)]
-> IO (Either (TResponseError a) (MessageResult a))
forall {f :: MessageDirection} (m :: Method f 'Request) c.
Recorder (WithPriority Log)
-> SMethod m
-> [(PluginId, HandleRequestResult)]
-> IO (Either (TResponseError m) c)
noPluginHandles Recorder (WithPriority Log)
recorder SMethod a
m ([(PluginId, HandleRequestResult)]
disabledPluginsReason [(PluginId, HandleRequestResult)]
-> [(PluginId, HandleRequestResult)]
-> [(PluginId, HandleRequestResult)]
forall a. Semigroup a => a -> a -> a
<> [(PluginId, HandleRequestResult)]
asRefusedReason)
Just NonEmpty (PluginId, PluginError)
xs -> Either (TResponseError a) (MessageResult a)
-> LspM Config (Either (TResponseError a) (MessageResult a))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TResponseError a) (MessageResult a)
-> LspM Config (Either (TResponseError a) (MessageResult a)))
-> Either (TResponseError a) (MessageResult a)
-> LspM Config (Either (TResponseError a) (MessageResult a))
forall a b. (a -> b) -> a -> b
$ TResponseError a -> Either (TResponseError a) (MessageResult a)
forall a b. a -> Either a b
Left (TResponseError a -> Either (TResponseError a) (MessageResult a))
-> TResponseError a -> Either (TResponseError a) (MessageResult a)
forall a b. (a -> b) -> a -> b
$ NonEmpty (PluginId, PluginError) -> TResponseError a
forall {f :: MessageDirection} (m :: Method f 'Request).
NonEmpty (PluginId, PluginError) -> TResponseError m
combineErrors NonEmpty (PluginId, PluginError)
xs
Just NonEmpty (MessageResult a)
xs -> do
Either (TResponseError a) (MessageResult a)
-> LspM Config (Either (TResponseError a) (MessageResult a))
forall a. a -> LspT Config IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (TResponseError a) (MessageResult a)
-> LspM Config (Either (TResponseError a) (MessageResult a)))
-> Either (TResponseError a) (MessageResult a)
-> LspM Config (Either (TResponseError a) (MessageResult a))
forall a b. (a -> b) -> a -> b
$ MessageResult a -> Either (TResponseError a) (MessageResult a)
forall a b. b -> Either a b
Right (MessageResult a -> Either (TResponseError a) (MessageResult a))
-> MessageResult a -> Either (TResponseError a) (MessageResult a)
forall a b. (a -> b) -> a -> b
$ SMethod a
-> Config
-> ClientCapabilities
-> MessageParams a
-> NonEmpty (MessageResult a)
-> MessageResult a
forall (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SMethod m
-> Config
-> ClientCapabilities
-> MessageParams m
-> NonEmpty (MessageResult m)
-> MessageResult m
combineResponses SMethod a
m Config
config ClientCapabilities
caps MessageParams a
params NonEmpty (MessageResult a)
xs
extensibleNotificationPlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config
extensibleNotificationPlugins :: Recorder (WithPriority Log)
-> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config
extensibleNotificationPlugins Recorder (WithPriority Log)
recorder [(PluginId, PluginDescriptor IdeState)]
xs = Plugin Config
forall a. Monoid a => a
mempty { P.pluginHandlers = handlers }
where
IdeNotificationHandlers DMap IdeNotification IdeNotificationHandler
handlers' = ((PluginId, PluginDescriptor IdeState) -> IdeNotificationHandlers)
-> [(PluginId, PluginDescriptor IdeState)]
-> IdeNotificationHandlers
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PluginId, PluginDescriptor IdeState) -> IdeNotificationHandlers
bakePluginId [(PluginId, PluginDescriptor IdeState)]
xs
bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeNotificationHandlers
bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeNotificationHandlers
bakePluginId (PluginId
pid,PluginDescriptor IdeState
pluginDesc) = DMap IdeNotification IdeNotificationHandler
-> IdeNotificationHandlers
IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler
-> IdeNotificationHandlers)
-> DMap IdeNotification IdeNotificationHandler
-> IdeNotificationHandlers
forall a b. (a -> b) -> a -> b
$ (forall (v :: Method 'ClientToServer 'Notification).
PluginNotificationHandler IdeState v -> IdeNotificationHandler v)
-> DMap IdeNotification (PluginNotificationHandler IdeState)
-> DMap IdeNotification IdeNotificationHandler
forall {k1} (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map
(\(PluginNotificationHandler PluginId -> IdeState -> VFS -> MessageParams v -> LspT Config IO ()
f) -> [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams v -> LspT Config IO ())]
-> IdeNotificationHandler v
forall (m :: Method 'ClientToServer 'Notification).
[(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
-> IdeNotificationHandler m
IdeNotificationHandler [(PluginId
pid,PluginDescriptor IdeState
pluginDesc,PluginId -> IdeState -> VFS -> MessageParams v -> LspT Config IO ()
f PluginId
pid)])
DMap IdeNotification (PluginNotificationHandler IdeState)
hs
where PluginNotificationHandlers DMap IdeNotification (PluginNotificationHandler IdeState)
hs = PluginDescriptor IdeState -> PluginNotificationHandlers IdeState
forall ideState.
PluginDescriptor ideState -> PluginNotificationHandlers ideState
HLS.pluginNotificationHandlers PluginDescriptor IdeState
pluginDesc
handlers :: Handlers (ServerM Config)
handlers = [Handlers (ServerM Config)] -> Handlers (ServerM Config)
forall a. Monoid a => [a] -> a
mconcat ([Handlers (ServerM Config)] -> Handlers (ServerM Config))
-> [Handlers (ServerM Config)] -> Handlers (ServerM Config)
forall a b. (a -> b) -> a -> b
$ do
(IdeNotification SMethod a
m :=> IdeNotificationHandler [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
fs') <- DMap IdeNotification IdeNotificationHandler
-> [DSum IdeNotification IdeNotificationHandler]
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.assocs DMap IdeNotification IdeNotificationHandler
handlers'
Handlers (ServerM Config) -> [Handlers (ServerM Config)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handlers (ServerM Config) -> [Handlers (ServerM Config)])
-> Handlers (ServerM Config) -> [Handlers (ServerM Config)]
forall a b. (a -> b) -> a -> b
$ SMethod a
-> (IdeState -> VFS -> MessageParams a -> LspT Config IO ())
-> Handlers (ServerM Config)
forall (m :: Method 'ClientToServer 'Notification) c.
PluginMethod 'Notification m =>
SMethod m
-> (IdeState -> VFS -> MessageParams m -> LspM c ())
-> Handlers (ServerM c)
notificationHandler SMethod a
m ((IdeState -> VFS -> MessageParams a -> LspT Config IO ())
-> Handlers (ServerM Config))
-> (IdeState -> VFS -> MessageParams a -> LspT Config IO ())
-> Handlers (ServerM Config)
forall a b. (a -> b) -> a -> b
$ \IdeState
ide VFS
vfs MessageParams a
params -> do
Config
config <- LspT Config IO Config
forall (m :: * -> *). MonadLsp Config m => m Config
Ide.PluginUtils.getClientConfig
let fs :: [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
fs = ((PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())
-> Bool)
-> [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
-> [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PluginId
_, PluginDescriptor IdeState
desc, IdeState -> VFS -> MessageParams a -> LspT Config IO ()
_) -> SMethod a
-> MessageParams a
-> PluginDescriptor IdeState
-> Config
-> HandleRequestResult
forall c.
SMethod a
-> MessageParams a
-> PluginDescriptor c
-> Config
-> HandleRequestResult
forall (k :: MessageKind) (m :: Method 'ClientToServer k) c.
PluginMethod k m =>
SMethod m
-> MessageParams m
-> PluginDescriptor c
-> Config
-> HandleRequestResult
handlesRequest SMethod a
m MessageParams a
params PluginDescriptor IdeState
desc Config
config HandleRequestResult -> HandleRequestResult -> Bool
forall a. Eq a => a -> a -> Bool
== HandleRequestResult
HandlesRequest) [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
fs'
case [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
-> Maybe
(NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ()))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
fs of
Maybe
(NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ()))
Nothing -> do
Recorder (WithPriority Log) -> Priority -> Log -> LspT Config IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (Some SMethod -> Log
forall {f :: MessageDirection} {t :: MessageKind}.
Some SMethod -> Log
LogNoPluginForMethod (Some SMethod -> Log) -> Some SMethod -> Log
forall a b. (a -> b) -> a -> b
$ SMethod a -> Some SMethod
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some SMethod a
m)
Just NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())
neFs -> do
((PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())
-> LspT Config IO ())
-> NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())
-> LspT Config IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(PluginId
pid,PluginDescriptor IdeState
_,IdeState -> VFS -> MessageParams a -> LspT Config IO ()
f) -> PluginId -> ByteString -> LspT Config IO () -> LspT Config IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
PluginId -> ByteString -> m a -> m a
otTracedProvider PluginId
pid (String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ SMethod a -> String
forall a. Show a => a -> String
show SMethod a
m) (LspT Config IO () -> LspT Config IO ())
-> LspT Config IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ IdeState -> VFS -> MessageParams a -> LspT Config IO ()
f IdeState
ide VFS
vfs MessageParams a
params
LspT Config IO ()
-> (SomeException -> LspT Config IO ()) -> LspT Config IO ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny`
(\SomeException
e -> Recorder (WithPriority Log) -> Priority -> Log -> LspT Config IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (PluginId -> Some SMethod -> SomeException -> Log
forall {f :: MessageDirection} {t :: MessageKind}.
PluginId -> Some SMethod -> SomeException -> Log
ExceptionInPlugin PluginId
pid (SMethod a -> Some SMethod
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some SMethod a
m) SomeException
e))) NonEmpty
(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams a -> LspT Config IO ())
neFs
runConcurrently
:: MonadUnliftIO m
=> (PluginId -> SMethod method -> SomeException -> T.Text)
-> SMethod method
-> NonEmpty (PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
-> a
-> b
-> m (NonEmpty(NonEmpty (Either PluginError d)))
runConcurrently :: forall {f :: MessageDirection} {t :: MessageKind} (m :: * -> *)
(method :: Method f t) a b d.
MonadUnliftIO m =>
(PluginId -> SMethod method -> SomeException -> Text)
-> SMethod method
-> NonEmpty
(PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
-> a
-> b
-> m (NonEmpty (NonEmpty (Either PluginError d)))
runConcurrently PluginId -> SMethod method -> SomeException -> Text
msg SMethod method
method NonEmpty (PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
fs a
a b
b = NonEmpty (PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
-> ((PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
-> m (NonEmpty (Either PluginError d)))
-> m (NonEmpty (NonEmpty (Either PluginError d)))
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
t a -> (a -> m b) -> m (t b)
forConcurrently NonEmpty (PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
fs (((PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
-> m (NonEmpty (Either PluginError d)))
-> m (NonEmpty (NonEmpty (Either PluginError d))))
-> ((PluginId, a -> b -> m (NonEmpty (Either PluginError d)))
-> m (NonEmpty (Either PluginError d)))
-> m (NonEmpty (NonEmpty (Either PluginError d)))
forall a b. (a -> b) -> a -> b
$ \(PluginId
pid,a -> b -> m (NonEmpty (Either PluginError d))
f) -> PluginId
-> ByteString
-> m (NonEmpty (Either PluginError d))
-> m (NonEmpty (Either PluginError d))
forall (m :: * -> *) a.
MonadUnliftIO m =>
PluginId -> ByteString -> m a -> m a
otTracedProvider PluginId
pid (String -> ByteString
forall a. IsString a => String -> a
fromString (SMethod method -> String
forall a. Show a => a -> String
show SMethod method
method)) (m (NonEmpty (Either PluginError d))
-> m (NonEmpty (Either PluginError d)))
-> m (NonEmpty (Either PluginError d))
-> m (NonEmpty (Either PluginError d))
forall a b. (a -> b) -> a -> b
$ do
a -> b -> m (NonEmpty (Either PluginError d))
f a
a b
b
m (NonEmpty (Either PluginError d))
-> (SomeException -> m (NonEmpty (Either PluginError d)))
-> m (NonEmpty (Either PluginError d))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` (\SomeException
e -> NonEmpty (Either PluginError d)
-> m (NonEmpty (Either PluginError d))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty (Either PluginError d)
-> m (NonEmpty (Either PluginError d)))
-> NonEmpty (Either PluginError d)
-> m (NonEmpty (Either PluginError d))
forall a b. (a -> b) -> a -> b
$ Either PluginError d -> NonEmpty (Either PluginError d)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either PluginError d -> NonEmpty (Either PluginError d))
-> Either PluginError d -> NonEmpty (Either PluginError d)
forall a b. (a -> b) -> a -> b
$ PluginError -> Either PluginError d
forall a b. a -> Either a b
Left (PluginError -> Either PluginError d)
-> PluginError -> Either PluginError d
forall a b. (a -> b) -> a -> b
$ Text -> PluginError
PluginInternalError (PluginId -> SMethod method -> SomeException -> Text
msg PluginId
pid SMethod method
method SomeException
e))
combineErrors :: NonEmpty (PluginId, PluginError) -> TResponseError m
combineErrors :: forall {f :: MessageDirection} (m :: Method f 'Request).
NonEmpty (PluginId, PluginError) -> TResponseError m
combineErrors ((PluginId, PluginError)
x NE.:| []) = (PluginId, PluginError) -> TResponseError m
forall {f :: MessageDirection} (m :: Method f 'Request).
(PluginId, PluginError) -> TResponseError m
toResponseError (PluginId, PluginError)
x
combineErrors NonEmpty (PluginId, PluginError)
xs = (PluginId, PluginError) -> TResponseError m
forall {f :: MessageDirection} (m :: Method f 'Request).
(PluginId, PluginError) -> TResponseError m
toResponseError ((PluginId, PluginError) -> TResponseError m)
-> (PluginId, PluginError) -> TResponseError m
forall a b. (a -> b) -> a -> b
$ NonEmpty (PluginId, PluginError) -> (PluginId, PluginError)
forall a. NonEmpty a -> a
NE.last (NonEmpty (PluginId, PluginError) -> (PluginId, PluginError))
-> NonEmpty (PluginId, PluginError) -> (PluginId, PluginError)
forall a b. (a -> b) -> a -> b
$ ((PluginId, PluginError) -> Priority)
-> NonEmpty (PluginId, PluginError)
-> NonEmpty (PluginId, PluginError)
forall o a. Ord o => (a -> o) -> NonEmpty a -> NonEmpty a
NE.sortWith (PluginError -> Priority
toPriority (PluginError -> Priority)
-> ((PluginId, PluginError) -> PluginError)
-> (PluginId, PluginError)
-> Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PluginId, PluginError) -> PluginError
forall a b. (a, b) -> b
snd) NonEmpty (PluginId, PluginError)
xs
toResponseError :: (PluginId, PluginError) -> TResponseError m
toResponseError :: forall {f :: MessageDirection} (m :: Method f 'Request).
(PluginId, PluginError) -> TResponseError m
toResponseError (PluginId Text
plId, PluginError
err) =
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
forall (f :: MessageDirection) (m :: Method f 'Request).
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
TResponseError (PluginError -> LSPErrorCodes |? ErrorCodes
toErrorCode PluginError
err) (Text
plId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PluginError -> Text
tPretty PluginError
err) Maybe (ErrorData m)
forall a. Maybe a
Nothing
where tPretty :: PluginError -> Text
tPretty = String -> Text
T.pack (String -> Text) -> (PluginError -> String) -> PluginError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> String)
-> (PluginError -> Doc Any) -> PluginError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginError -> Doc Any
forall ann. PluginError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty
logErrors :: Recorder (WithPriority Log) -> [(PluginId, PluginError)] -> IO ()
logErrors :: Recorder (WithPriority Log) -> [(PluginId, PluginError)] -> IO ()
logErrors Recorder (WithPriority Log)
recorder [(PluginId, PluginError)]
errs = do
[(PluginId, PluginError)]
-> ((PluginId, PluginError) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(PluginId, PluginError)]
errs (((PluginId, PluginError) -> IO ()) -> IO ())
-> ((PluginId, PluginError) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(PluginId
pId, PluginError
err) ->
PluginId -> PluginError -> IO ()
logIndividualErrors PluginId
pId PluginError
err
where logIndividualErrors :: PluginId -> PluginError -> IO ()
logIndividualErrors PluginId
plId PluginError
err =
Recorder (WithPriority Log) -> Priority -> Log -> IO ()
forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder (PluginError -> Priority
toPriority PluginError
err) (Log -> IO ()) -> Log -> IO ()
forall a b. (a -> b) -> a -> b
$ PluginId -> PluginError -> Log
LogPluginError PluginId
plId PluginError
err
newtype IdeHandler (m :: Method ClientToServer Request)
= IdeHandler [(PluginId, PluginDescriptor IdeState, IdeState -> MessageParams m -> HandlerM Config (NonEmpty (Either PluginError (MessageResult m))))]
newtype IdeNotificationHandler (m :: Method ClientToServer Notification)
= IdeNotificationHandler [(PluginId, PluginDescriptor IdeState, IdeState -> VFS -> MessageParams m -> LSP.LspM Config ())]
newtype IdeHandlers = IdeHandlers (DMap IdeMethod IdeHandler)
newtype IdeNotificationHandlers = IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler)
instance Semigroup IdeHandlers where
(IdeHandlers DMap IdeMethod IdeHandler
a) <> :: IdeHandlers -> IdeHandlers -> IdeHandlers
<> (IdeHandlers DMap IdeMethod IdeHandler
b) = DMap IdeMethod IdeHandler -> IdeHandlers
IdeHandlers (DMap IdeMethod IdeHandler -> IdeHandlers)
-> DMap IdeMethod IdeHandler -> IdeHandlers
forall a b. (a -> b) -> a -> b
$ (forall (v :: Method 'ClientToServer 'Request).
IdeMethod v -> IdeHandler v -> IdeHandler v -> IdeHandler v)
-> DMap IdeMethod IdeHandler
-> DMap IdeMethod IdeHandler
-> DMap IdeMethod IdeHandler
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> f v -> f v)
-> DMap k2 f -> DMap k2 f -> DMap k2 f
DMap.unionWithKey IdeMethod v -> IdeHandler v -> IdeHandler v -> IdeHandler v
forall (v :: Method 'ClientToServer 'Request).
IdeMethod v -> IdeHandler v -> IdeHandler v -> IdeHandler v
forall {m :: Method 'ClientToServer 'Request}
{m :: Method 'ClientToServer 'Request}
{m :: Method 'ClientToServer 'Request} {p}.
(MessageResult m ~ MessageResult m,
MessageResult m ~ MessageResult m,
MessageParams m ~ MessageParams m,
MessageParams m ~ MessageParams m) =>
p -> IdeHandler m -> IdeHandler m -> IdeHandler m
go DMap IdeMethod IdeHandler
a DMap IdeMethod IdeHandler
b
where
go :: p -> IdeHandler m -> IdeHandler m -> IdeHandler m
go p
_ (IdeHandler [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
c) (IdeHandler [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
d) = [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
-> IdeHandler m
forall (m :: Method 'ClientToServer 'Request).
[(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
-> IdeHandler m
IdeHandler ([(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
[(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
c [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
-> [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
-> [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
forall a. Semigroup a => a -> a -> a
<> [(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
[(PluginId, PluginDescriptor IdeState,
IdeState
-> MessageParams m
-> HandlerM
Config (NonEmpty (Either PluginError (MessageResult m))))]
d)
instance Monoid IdeHandlers where
mempty :: IdeHandlers
mempty = DMap IdeMethod IdeHandler -> IdeHandlers
IdeHandlers DMap IdeMethod IdeHandler
forall a. Monoid a => a
mempty
instance Semigroup IdeNotificationHandlers where
(IdeNotificationHandlers DMap IdeNotification IdeNotificationHandler
a) <> :: IdeNotificationHandlers
-> IdeNotificationHandlers -> IdeNotificationHandlers
<> (IdeNotificationHandlers DMap IdeNotification IdeNotificationHandler
b) = DMap IdeNotification IdeNotificationHandler
-> IdeNotificationHandlers
IdeNotificationHandlers (DMap IdeNotification IdeNotificationHandler
-> IdeNotificationHandlers)
-> DMap IdeNotification IdeNotificationHandler
-> IdeNotificationHandlers
forall a b. (a -> b) -> a -> b
$ (forall (v :: Method 'ClientToServer 'Notification).
IdeNotification v
-> IdeNotificationHandler v
-> IdeNotificationHandler v
-> IdeNotificationHandler v)
-> DMap IdeNotification IdeNotificationHandler
-> DMap IdeNotification IdeNotificationHandler
-> DMap IdeNotification IdeNotificationHandler
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> f v -> f v)
-> DMap k2 f -> DMap k2 f -> DMap k2 f
DMap.unionWithKey IdeNotification v
-> IdeNotificationHandler v
-> IdeNotificationHandler v
-> IdeNotificationHandler v
forall (v :: Method 'ClientToServer 'Notification).
IdeNotification v
-> IdeNotificationHandler v
-> IdeNotificationHandler v
-> IdeNotificationHandler v
forall {m :: Method 'ClientToServer 'Notification}
{m :: Method 'ClientToServer 'Notification}
{m :: Method 'ClientToServer 'Notification} {p}.
(MessageParams m ~ MessageParams m,
MessageParams m ~ MessageParams m) =>
p
-> IdeNotificationHandler m
-> IdeNotificationHandler m
-> IdeNotificationHandler m
go DMap IdeNotification IdeNotificationHandler
a DMap IdeNotification IdeNotificationHandler
b
where
go :: p
-> IdeNotificationHandler m
-> IdeNotificationHandler m
-> IdeNotificationHandler m
go p
_ (IdeNotificationHandler [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
c) (IdeNotificationHandler [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
d) = [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
-> IdeNotificationHandler m
forall (m :: Method 'ClientToServer 'Notification).
[(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
-> IdeNotificationHandler m
IdeNotificationHandler ([(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
[(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
c [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
-> [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
-> [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
forall a. Semigroup a => a -> a -> a
<> [(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
[(PluginId, PluginDescriptor IdeState,
IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
d)
instance Monoid IdeNotificationHandlers where
mempty :: IdeNotificationHandlers
mempty = DMap IdeNotification IdeNotificationHandler
-> IdeNotificationHandlers
IdeNotificationHandlers DMap IdeNotification IdeNotificationHandler
forall a. Monoid a => a
mempty