{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds         #-}

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

import           Control.Exception            (SomeException)
import           Control.Lens                 ((^.))
import           Control.Monad
import qualified Data.Aeson                   as J
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.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           Development.IDE.Types.Logger
import           Ide.Plugin.Config
import           Ide.PluginUtils              (getClientConfig)
import           Ide.Types                    as HLS
import qualified Language.LSP.Server          as LSP
import           Language.LSP.Types
import qualified Language.LSP.Types           as J
import qualified Language.LSP.Types.Lens      as LSP
import           Language.LSP.VFS
import           Prettyprinter.Render.String  (renderString)
import           Text.Regex.TDFA.Text         ()
import           UnliftIO                     (MonadUnliftIO)
import           UnliftIO.Async               (forConcurrently)
import           UnliftIO.Exception           (catchAny)

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

data Log
    = LogPluginError PluginId ResponseError
    | LogNoPluginForMethod (Some SMethod)
    | LogInvalidCommandIdentifier
instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogPluginError (PluginId Text
pId) ResponseError
err -> forall a ann. Pretty a => a -> Doc ann
pretty Text
pId forall a. Semigroup a => a -> a -> a
<> Doc ann
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a. ResponseError -> Doc a
prettyResponseError ResponseError
err
    LogNoPluginForMethod (Some SMethod a
method) ->
        Doc ann
"No plugin enabled for " forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty (forall a. Show a => a -> String
show SMethod a
method)
    Log
LogInvalidCommandIdentifier-> Doc ann
"Invalid command identifier"

instance Show Log where show :: Log -> String
show = forall ann. SimpleDocStream ann -> String
renderString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann1 ann2. Doc ann1 -> SimpleDocStream ann2
layoutCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty

-- various error message specific builders
prettyResponseError :: ResponseError -> Doc a
prettyResponseError :: forall a. ResponseError -> Doc a
prettyResponseError ResponseError
err = Doc a
errorCode forall a. Semigroup a => a -> a -> a
<> Doc a
":" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc a
errorBody
    where
        errorCode :: Doc a
errorCode = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ ResponseError
err forall s a. s -> Getting a s a -> a
^. forall s a. HasCode s a => Lens' s a
LSP.code
        errorBody :: Doc a
errorBody = forall a ann. Pretty a => a -> Doc ann
pretty forall a b. (a -> b) -> a -> b
$ ResponseError
err forall s a. s -> Getting a s a -> a
^. forall s a. HasMessage s a => Lens' s a
LSP.message

pluginNotEnabled :: SMethod m -> [(PluginId, b, a)] -> Text
pluginNotEnabled :: forall {f :: From} {t :: MethodType} (m :: Method f t) b a.
SMethod m -> [(PluginId, b, a)] -> Text
pluginNotEnabled SMethod m
method [(PluginId, b, a)]
availPlugins =
    Text
"No plugin enabled for " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show SMethod m
method) forall a. Semigroup a => a -> a -> a
<> Text
", available: "
        forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(PluginId Text
plid, b
_, a
_) -> Text
plid) [(PluginId, b, a)]
availPlugins)

pluginDoesntExist :: PluginId -> Text
pluginDoesntExist :: PluginId -> Text
pluginDoesntExist (PluginId Text
pid) = Text
"Plugin " forall a. Semigroup a => a -> a -> a
<> Text
pid 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 " forall a. Semigroup a => a -> a -> a
<> Text
com forall a. Semigroup a => a -> a -> a
<> Text
" isn't defined for plugin " forall a. Semigroup a => a -> a -> a
<> Text
pid forall a. Semigroup a => a -> a -> a
<> Text
". Legal commands are: "
        forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(PluginCommand{commandId :: forall ideState. PluginCommand ideState -> CommandId
commandId = CommandId Text
cid}) -> Text
cid) [PluginCommand ideState]
legalCmds)

failedToParseArgs :: CommandId  -- ^ command that failed to parse
                    -> PluginId -- ^ Plugin that created the command
                    -> String   -- ^ The JSON Error message
                    -> J.Value  -- ^ The Argument Values
                    -> Text
failedToParseArgs :: CommandId -> PluginId -> String -> Value -> Text
failedToParseArgs (CommandId Text
com) (PluginId Text
pid) String
err Value
arg =
    Text
"Error while parsing args for " forall a. Semigroup a => a -> a -> a
<> Text
com forall a. Semigroup a => a -> a -> a
<> Text
" in plugin " forall a. Semigroup a => a -> a -> a
<> Text
pid forall a. Semigroup a => a -> a -> a
<> Text
": "
        forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err forall a. Semigroup a => a -> a -> a
<> Text
", arg = " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Value
arg)

-- | Build a ResponseError and log it before returning to the caller
logAndReturnError :: Recorder (WithPriority Log) -> PluginId -> ErrorCode -> Text -> LSP.LspT Config IO (Either ResponseError a)
logAndReturnError :: forall a.
Recorder (WithPriority Log)
-> PluginId
-> ErrorCode
-> Text
-> LspT Config IO (Either ResponseError a)
logAndReturnError Recorder (WithPriority Log)
recorder PluginId
p ErrorCode
errCode Text
msg = do
    let err :: ResponseError
err = ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
errCode Text
msg forall a. Maybe a
Nothing
    forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning forall a b. (a -> b) -> a -> b
$ PluginId -> ResponseError -> Log
LogPluginError PluginId
p ResponseError
err
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ResponseError
err

-- | Map a set of plugins to the underlying ghcide engine.
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) =
    forall {b}.
([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPlugin [(PluginId, Rules ())] -> Plugin Config
rulesPlugins forall ideState. PluginDescriptor ideState -> Rules ()
HLS.pluginRules forall a. Semigroup a => a -> a -> a
<>
    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) forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
HLS.pluginCommands forall a. Semigroup a => a -> a -> a
<>
    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) forall a. a -> a
id forall a. Semigroup a => a -> a -> a
<>
    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) forall a. a -> a
id forall a. Semigroup a => a -> a -> a
<>
    forall b.
([(PluginDescriptor IdeState, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPluginFromDescriptor forall c.
[(PluginDescriptor c, DynFlagsModifications)] -> Plugin Config
dynFlagsPlugins forall ideState. PluginDescriptor ideState -> DynFlagsModifications
HLS.pluginModifyDynflags
    where
        mkPlugin :: ([(PluginId, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPlugin [(PluginId, b)] -> Plugin Config
f = forall b.
([(PluginDescriptor IdeState, b)] -> Plugin Config)
-> (PluginDescriptor IdeState -> b) -> Plugin Config
mkPluginFromDescriptor ([(PluginId, b)] -> Plugin Config
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first 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 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
            -- 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
            [] -> 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 = forall a. Monoid a => a
mempty { pluginRules :: Rules ()
P.pluginRules = Rules ()
rules }
    where
        rules :: Rules ()
rules = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap 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 = forall a. Monoid a => a
mempty
  { pluginModifyDynflags :: Config -> DynFlagsModifications
P.pluginModifyDynflags =
      forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [(PluginDescriptor c, DynFlagsModifications)]
rs forall a b. (a -> b) -> a -> b
$ \(PluginDescriptor c
plId, DynFlagsModifications
dflag_mods) Config
cfg ->
        let plg_cfg :: PluginConfig
plg_cfg = 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 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 = forall a. Monoid a => a
mempty { pluginHandlers :: Handlers (ServerM Config)
P.pluginHandlers = Recorder (WithPriority Log)
-> [(PluginId, [PluginCommand IdeState])]
-> Handlers (ServerM Config)
executeCommandHandlers Recorder (WithPriority Log)
recorder [(PluginId, [PluginCommand IdeState])]
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 = forall (m :: Method 'FromClient 'Request) c.
HasTracing (MessageParams m) =>
SMethod m
-> (IdeState
    -> MessageParams m
    -> LspM c (Either ResponseError (ResponseResult m)))
-> Handlers (ServerM c)
requestHandler SMethod 'WorkspaceExecuteCommand
SWorkspaceExecuteCommand IdeState
-> ExecuteCommandParams
-> LspT Config IO (Either ResponseError Value)
execCmd
  where
    pluginMap :: Map PluginId [PluginCommand IdeState]
pluginMap = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) [(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]    -> forall a. a -> Maybe a
Just (Text -> PluginId
PluginId Text
plugin, Text -> CommandId
CommandId Text
command)
      [Text
_, Text
plugin, Text
command] -> forall a. a -> Maybe a
Just (Text -> PluginId
PluginId Text
plugin, Text -> CommandId
CommandId Text
command)
      [Text]
_                    -> forall a. Maybe a
Nothing

    -- The parameters to the HLS command are always the first element

    execCmd :: IdeState
-> ExecuteCommandParams
-> LspT Config IO (Either ResponseError Value)
execCmd IdeState
ide (ExecuteCommandParams Maybe ProgressToken
_ Text
cmdId Maybe (List Value)
args) = do
      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 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
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe WorkspaceEdit
mEdit forall a b. (a -> b) -> a -> b
$ \WorkspaceEdit
edit ->
                forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
edit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

              case Maybe Command
mCmd of
                -- If we have a command, continue to execute it
                Just (J.Command Text
_ Text
innerCmdId Maybe (List Value)
innerArgs)
                    -> IdeState
-> ExecuteCommandParams
-> LspT Config IO (Either ResponseError Value)
execCmd IdeState
ide (Maybe ProgressToken
-> Text -> Maybe (List Value) -> ExecuteCommandParams
ExecuteCommandParams forall a. Maybe a
Nothing Text
innerCmdId Maybe (List Value)
innerArgs)
                Maybe Command
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
J.Null

            J.Error String
_str -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
J.Null

        -- Just an ordinary HIE command
        Just (PluginId
plugin, CommandId
cmd) -> IdeState
-> PluginId
-> CommandId
-> Value
-> LspT Config IO (Either ResponseError Value)
runPluginCommand IdeState
ide PluginId
plugin CommandId
cmd Value
cmdParams

        -- Couldn't parse the command identifier
        Maybe (PluginId, CommandId)
_ -> do
            forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning Log
LogInvalidCommandIdentifier
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidParams Text
"Invalid command identifier" forall a. Maybe a
Nothing

    runPluginCommand :: IdeState
-> PluginId
-> CommandId
-> Value
-> LspT Config IO (Either ResponseError Value)
runPluginCommand IdeState
ide PluginId
p CommandId
com Value
arg =
      case 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 -> forall a.
Recorder (WithPriority Log)
-> PluginId
-> ErrorCode
-> Text
-> LspT Config IO (Either ResponseError a)
logAndReturnError Recorder (WithPriority Log)
recorder PluginId
p ErrorCode
InvalidRequest (PluginId -> Text
pluginDoesntExist PluginId
p)
        Just [PluginCommand IdeState]
xs -> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((CommandId
com forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ideState. PluginCommand ideState -> CommandId
commandId) [PluginCommand IdeState]
xs of
          Maybe (PluginCommand IdeState)
Nothing -> forall a.
Recorder (WithPriority Log)
-> PluginId
-> ErrorCode
-> Text
-> LspT Config IO (Either ResponseError a)
logAndReturnError Recorder (WithPriority Log)
recorder PluginId
p ErrorCode
InvalidRequest (forall ideState.
CommandId -> PluginId -> [PluginCommand ideState] -> Text
commandDoesntExist CommandId
com PluginId
p [PluginCommand IdeState]
xs)
          Just (PluginCommand CommandId
_ Text
_ CommandFunction IdeState a
f) -> case forall a. FromJSON a => Value -> Result a
J.fromJSON Value
arg of
            J.Error String
err -> forall a.
Recorder (WithPriority Log)
-> PluginId
-> ErrorCode
-> Text
-> LspT Config IO (Either ResponseError a)
logAndReturnError Recorder (WithPriority Log)
recorder PluginId
p ErrorCode
InvalidParams (CommandId -> PluginId -> String -> Value -> Text
failedToParseArgs CommandId
com PluginId
p String
err Value
arg)
            J.Success a
a -> CommandFunction IdeState a
f IdeState
ide a
a

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

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)]
xs = forall a. Monoid a => a
mempty { pluginHandlers :: Handlers (ServerM Config)
P.pluginHandlers = Handlers (ServerM Config)
handlers }
  where
    IdeHandlers DMap IdeMethod IdeHandler
handlers' = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (PluginId, PluginDescriptor IdeState) -> IdeHandlers
bakePluginId [(PluginId, PluginDescriptor IdeState)]
xs
    bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeHandlers
    bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeHandlers
bakePluginId (PluginId
pid,PluginDescriptor IdeState
pluginDesc) = DMap IdeMethod IdeHandler -> IdeHandlers
IdeHandlers forall a b. (a -> b) -> a -> b
$ 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
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult v)))
f) -> forall (m :: Method 'FromClient 'Request).
[(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams m
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult m))))]
-> IdeHandler m
IdeHandler [(PluginId
pid,PluginDescriptor IdeState
pluginDesc,PluginId
-> IdeState
-> MessageParams v
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult v)))
f PluginId
pid)])
      DMap IdeMethod (PluginHandler IdeState)
hs
      where
        PluginHandlers DMap IdeMethod (PluginHandler IdeState)
hs = forall ideState.
PluginDescriptor ideState -> PluginHandlers ideState
HLS.pluginHandlers PluginDescriptor IdeState
pluginDesc
    handlers :: Handlers (ServerM Config)
handlers = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ do
      (IdeMethod SMethod a
m :=> IdeHandler [(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams a
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult a))))]
fs') <- forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.assocs DMap IdeMethod IdeHandler
handlers'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromClient 'Request) c.
HasTracing (MessageParams m) =>
SMethod m
-> (IdeState
    -> MessageParams m
    -> LspM c (Either ResponseError (ResponseResult m)))
-> Handlers (ServerM c)
requestHandler SMethod a
m forall a b. (a -> b) -> a -> b
$ \IdeState
ide MessageParams a
params -> do
        Config
config <- forall (m :: * -> *). MonadLsp Config m => m Config
Ide.PluginUtils.getClientConfig
        -- Only run plugins that are allowed to run on this request
        let fs :: [(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams a
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult a))))]
fs = forall a. (a -> Bool) -> [a] -> [a]
filter (\(PluginId
_, PluginDescriptor IdeState
desc, IdeState
-> MessageParams a
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult a)))
_) -> forall (k :: MethodType) (m :: Method 'FromClient k) c.
PluginMethod k m =>
SMethod m
-> MessageParams m -> PluginDescriptor c -> Config -> Bool
pluginEnabled SMethod a
m MessageParams a
params PluginDescriptor IdeState
desc Config
config) [(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams a
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult a))))]
fs'
        -- Clients generally don't display ResponseErrors so instead we log any that we come across
        case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams a
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult a))))]
fs of
          Maybe
  (NonEmpty
     (PluginId, PluginDescriptor IdeState,
      IdeState
      -> MessageParams a
      -> LspM
           Config (NonEmpty (Either ResponseError (ResponseResult a)))))
Nothing -> do
            forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (forall {f :: From} {t :: MethodType}. Some SMethod -> Log
LogNoPluginForMethod forall a b. (a -> b) -> a -> b
$ forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some SMethod a
m)
            let err :: ResponseError
err = ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidRequest Text
msg forall a. Maybe a
Nothing
                msg :: Text
msg = forall {f :: From} {t :: MethodType} (m :: Method f t) b a.
SMethod m -> [(PluginId, b, a)] -> Text
pluginNotEnabled SMethod a
m [(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams a
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult a))))]
fs'
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ResponseError
err
          Just NonEmpty
  (PluginId, PluginDescriptor IdeState,
   IdeState
   -> MessageParams a
   -> LspM
        Config (NonEmpty (Either ResponseError (ResponseResult a))))
fs -> do
            let msg :: SomeException -> PluginId -> Text
msg SomeException
e PluginId
pid = Text
"Exception in plugin " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show PluginId
pid) forall a. Semigroup a => a -> a -> a
<> Text
" while processing " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show SMethod a
m) forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show SomeException
e)
                handlers :: NonEmpty
  (PluginId,
   IdeState
   -> MessageParams a
   -> LspM
        Config (NonEmpty (Either ResponseError (ResponseResult a))))
handlers = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PluginId
plid,PluginDescriptor IdeState
_,IdeState
-> MessageParams a
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult a)))
handler) -> (PluginId
plid,IdeState
-> MessageParams a
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult a)))
handler)) NonEmpty
  (PluginId, PluginDescriptor IdeState,
   IdeState
   -> MessageParams a
   -> LspM
        Config (NonEmpty (Either ResponseError (ResponseResult a))))
fs
            NonEmpty (NonEmpty (Either ResponseError (ResponseResult a)))
es <- forall (m :: * -> *) a b d.
MonadUnliftIO m =>
(SomeException -> PluginId -> Text)
-> String
-> NonEmpty
     (PluginId, a -> b -> m (NonEmpty (Either ResponseError d)))
-> a
-> b
-> m (NonEmpty (NonEmpty (Either ResponseError d)))
runConcurrently SomeException -> PluginId -> Text
msg (forall a. Show a => a -> String
show SMethod a
m) NonEmpty
  (PluginId,
   IdeState
   -> MessageParams a
   -> LspM
        Config (NonEmpty (Either ResponseError (ResponseResult a))))
handlers IdeState
ide MessageParams a
params

            let ([(PluginId, ResponseError)]
errs,[ResponseResult a]
succs) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (\(PluginId
pId,IdeState
-> MessageParams a
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult a)))
_) -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (PluginId
pId,))) NonEmpty
  (PluginId,
   IdeState
   -> MessageParams a
   -> LspM
        Config (NonEmpty (Either ResponseError (ResponseResult a))))
handlers NonEmpty (NonEmpty (Either ResponseError (ResponseResult a)))
es
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PluginId, ResponseError)]
errs) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(PluginId, ResponseError)]
errs forall a b. (a -> b) -> a -> b
$ \(PluginId
pId, ResponseError
err) ->
                forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning forall a b. (a -> b) -> a -> b
$ PluginId -> ResponseError -> Log
LogPluginError PluginId
pId ResponseError
err
            case forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [ResponseResult a]
succs of
              Maybe (NonEmpty (ResponseResult a))
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [ResponseError] -> ResponseError
combineErrors forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(PluginId, ResponseError)]
errs
              Just NonEmpty (ResponseResult a)
xs -> do
                ClientCapabilities
caps <- forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
LSP.getClientCapabilities
                forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromClient 'Request).
PluginRequestMethod m =>
SMethod m
-> Config
-> ClientCapabilities
-> MessageParams m
-> NonEmpty (ResponseResult m)
-> ResponseResult m
combineResponses SMethod a
m Config
config ClientCapabilities
caps MessageParams a
params NonEmpty (ResponseResult 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 = forall a. Monoid a => a
mempty { pluginHandlers :: Handlers (ServerM Config)
P.pluginHandlers = Handlers (ServerM Config)
handlers }
  where
    IdeNotificationHandlers DMap IdeNotification IdeNotificationHandler
handlers' = 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 forall a b. (a -> b) -> a -> b
$ 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) -> forall (m :: Method 'FromClient '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 = forall ideState.
PluginDescriptor ideState -> PluginNotificationHandlers ideState
HLS.pluginNotificationHandlers PluginDescriptor IdeState
pluginDesc
    handlers :: Handlers (ServerM Config)
handlers = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ do
      (IdeNotification SMethod a
m :=> IdeNotificationHandler [(PluginId, PluginDescriptor IdeState,
  IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
fs') <- forall {k1} (k2 :: k1 -> *) (f :: k1 -> *).
DMap k2 f -> [DSum k2 f]
DMap.assocs DMap IdeNotification IdeNotificationHandler
handlers'
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromClient 'Notification) c.
HasTracing (MessageParams m) =>
SMethod m
-> (IdeState -> VFS -> MessageParams m -> LspM c ())
-> Handlers (ServerM c)
notificationHandler SMethod a
m forall a b. (a -> b) -> a -> b
$ \IdeState
ide VFS
vfs MessageParams a
params -> do
        Config
config <- forall (m :: * -> *). MonadLsp Config m => m Config
Ide.PluginUtils.getClientConfig
        -- Only run plugins that are allowed to run on this request
        let fs :: [(PluginId, PluginDescriptor IdeState,
  IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
fs = forall a. (a -> Bool) -> [a] -> [a]
filter (\(PluginId
_, PluginDescriptor IdeState
desc, IdeState -> VFS -> MessageParams a -> LspT Config IO ()
_) -> forall (k :: MethodType) (m :: Method 'FromClient k) c.
PluginMethod k m =>
SMethod m
-> MessageParams m -> PluginDescriptor c -> Config -> Bool
pluginEnabled SMethod a
m MessageParams a
params PluginDescriptor IdeState
desc Config
config) [(PluginId, PluginDescriptor IdeState,
  IdeState -> VFS -> MessageParams a -> LspT Config IO ())]
fs'
        case 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
            forall (m :: * -> *) msg.
(HasCallStack, MonadIO m) =>
Recorder (WithPriority msg) -> Priority -> msg -> m ()
logWith Recorder (WithPriority Log)
recorder Priority
Warning (forall {f :: From} {t :: MethodType}. Some SMethod -> Log
LogNoPluginForMethod forall a b. (a -> b) -> a -> b
$ 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 ())
fs -> do
            -- We run the notifications in order, so the core ghcide provider
            -- (which restarts the shake process) hopefully comes last
            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) -> forall (m :: * -> *) a.
MonadUnliftIO m =>
PluginId -> ByteString -> m a -> m a
otTracedProvider PluginId
pid (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show SMethod a
m) forall a b. (a -> b) -> a -> b
$ IdeState -> VFS -> MessageParams a -> LspT Config IO ()
f IdeState
ide VFS
vfs MessageParams a
params) NonEmpty
  (PluginId, PluginDescriptor IdeState,
   IdeState -> VFS -> MessageParams a -> LspT Config IO ())
fs

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

runConcurrently
  :: MonadUnliftIO m
  => (SomeException -> PluginId -> T.Text)
  -> String -- ^ label
  -> NonEmpty (PluginId, a -> b -> m (NonEmpty (Either ResponseError d)))
  -- ^ Enabled plugin actions that we are allowed to run
  -> a
  -> b
  -> m (NonEmpty(NonEmpty (Either ResponseError d)))
runConcurrently :: forall (m :: * -> *) a b d.
MonadUnliftIO m =>
(SomeException -> PluginId -> Text)
-> String
-> NonEmpty
     (PluginId, a -> b -> m (NonEmpty (Either ResponseError d)))
-> a
-> b
-> m (NonEmpty (NonEmpty (Either ResponseError d)))
runConcurrently SomeException -> PluginId -> Text
msg String
method NonEmpty
  (PluginId, a -> b -> m (NonEmpty (Either ResponseError d)))
fs a
a b
b = 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 ResponseError d)))
fs forall a b. (a -> b) -> a -> b
$ \(PluginId
pid,a -> b -> m (NonEmpty (Either ResponseError d))
f) -> forall (m :: * -> *) a.
MonadUnliftIO m =>
PluginId -> ByteString -> m a -> m a
otTracedProvider PluginId
pid (forall a. IsString a => String -> a
fromString String
method) forall a b. (a -> b) -> a -> b
$ do
  a -> b -> m (NonEmpty (Either ResponseError d))
f a
a b
b
     forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` (\SomeException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InternalError (SomeException -> PluginId -> Text
msg SomeException
e PluginId
pid) forall a. Maybe a
Nothing)

combineErrors :: [ResponseError] -> ResponseError
combineErrors :: [ResponseError] -> ResponseError
combineErrors [ResponseError
x] = ResponseError
x
combineErrors [ResponseError]
xs  = ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InternalError (String -> Text
T.pack (forall a. Show a => a -> String
show [ResponseError]
xs)) forall a. Maybe a
Nothing

-- | Combine the 'PluginHandler' for all plugins
newtype IdeHandler (m :: J.Method FromClient Request)
  = IdeHandler [(PluginId, PluginDescriptor IdeState, IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either ResponseError (ResponseResult m))))]

-- | Combine the 'PluginHandler' for all plugins
newtype IdeNotificationHandler (m :: J.Method FromClient Notification)
  = IdeNotificationHandler [(PluginId, PluginDescriptor IdeState, IdeState -> VFS -> MessageParams m -> LSP.LspM Config ())]
-- type NotificationHandler (m :: Method FromClient Notification) = MessageParams m -> IO ()`

-- | Combine the 'PluginHandlers' for all plugins
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 forall a b. (a -> b) -> a -> b
$ 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 forall {m :: Method 'FromClient 'Request}
       {m :: Method 'FromClient 'Request}
       {m :: Method 'FromClient 'Request} {p}.
(ResponseResult m ~ ResponseResult m,
 ResponseResult m ~ ResponseResult 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
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult m))))]
a) (IdeHandler [(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams m
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult m))))]
b) = forall (m :: Method 'FromClient 'Request).
[(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams m
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult m))))]
-> IdeHandler m
IdeHandler ([(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams m
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult m))))]
a forall a. Semigroup a => a -> a -> a
<> [(PluginId, PluginDescriptor IdeState,
  IdeState
  -> MessageParams m
  -> LspM
       Config (NonEmpty (Either ResponseError (ResponseResult m))))]
b)
instance Monoid IdeHandlers where
  mempty :: IdeHandlers
mempty = DMap IdeMethod IdeHandler -> IdeHandlers
IdeHandlers 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 forall a b. (a -> b) -> a -> b
$ 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 forall {m :: Method 'FromClient 'Notification}
       {m :: Method 'FromClient 'Notification}
       {m :: Method 'FromClient '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 ())]
a) (IdeNotificationHandler [(PluginId, PluginDescriptor IdeState,
  IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
b) = forall (m :: Method 'FromClient 'Notification).
[(PluginId, PluginDescriptor IdeState,
  IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
-> IdeNotificationHandler m
IdeNotificationHandler ([(PluginId, PluginDescriptor IdeState,
  IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
a forall a. Semigroup a => a -> a -> a
<> [(PluginId, PluginDescriptor IdeState,
  IdeState -> VFS -> MessageParams m -> LspT Config IO ())]
b)
instance Monoid IdeNotificationHandlers where
  mempty :: IdeNotificationHandlers
mempty = DMap IdeNotification IdeNotificationHandler
-> IdeNotificationHandlers
IdeNotificationHandlers forall a. Monoid a => a
mempty