{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE ViewPatterns               #-}

module Ide.Types
( PluginDescriptor(..), defaultPluginDescriptor, defaultCabalPluginDescriptor
, defaultPluginPriority
, IdeCommand(..)
, IdeMethod(..)
, IdeNotification(..)
, IdePlugins(IdePlugins, ipMap)
, DynFlagsModifications(..)
, ConfigDescriptor(..), defaultConfigDescriptor, configForPlugin, pluginEnabledConfig
, CustomConfig(..), mkCustomConfig
, FallbackCodeActionParams(..)
, FormattingType(..), FormattingMethod, FormattingHandler, mkFormattingHandlers
, HasTracing(..)
, PluginCommand(..), CommandId(..), CommandFunction, mkLspCommand, mkLspCmdId
, PluginId(..)
, PluginHandler(..), mkPluginHandler
, PluginHandlers(..)
, PluginMethod(..)
, PluginMethodHandler
, PluginNotificationHandler(..), mkPluginNotificationHandler
, PluginNotificationHandlers(..)
, PluginRequestMethod(..)
, getProcessID, getPid
, installSigUsr1Handler
, responseError
, lookupCommandProvider
)
    where

#ifdef mingw32_HOST_OS
import qualified System.Win32.Process            as P (getCurrentProcessId)
#else
import           Control.Monad                   (void)
import qualified System.Posix.Process            as P (getProcessID)
import           System.Posix.Signals
#endif
import           Control.Arrow                   ((&&&))
import           Control.Lens                    ((^.))
import           Data.Aeson                      hiding (defaultOptions)
import qualified Data.Default
import           Data.Dependent.Map              (DMap)
import qualified Data.Dependent.Map              as DMap
import qualified Data.DList                      as DList
import           Data.GADT.Compare
import           Data.Hashable                   (Hashable)
import           Data.HashMap.Strict             (HashMap)
import qualified Data.HashMap.Strict             as HashMap
import           Data.List.Extra                 (sortOn, find)
import           Data.List.NonEmpty              (NonEmpty (..), toList)
import qualified Data.Map                        as Map
import           Data.Maybe
import           Data.Ord
import           Data.Semigroup
import           Data.String
import qualified Data.Text                       as T
import           Data.Text.Encoding              (encodeUtf8)
import           Development.IDE.Graph
import           GHC                             (DynFlags)
import           GHC.Generics
import           Ide.Plugin.Config
import           Ide.Plugin.Properties
import           Language.LSP.Server             (LspM, getVirtualFile)
import           Language.LSP.Types              hiding
                                                 (SemanticTokenAbsolute (length, line),
                                                  SemanticTokenRelative (length),
                                                  SemanticTokensEdit (_start))
import           Language.LSP.Types.Capabilities (ClientCapabilities (ClientCapabilities),
                                                  TextDocumentClientCapabilities (_codeAction, _documentSymbol))
import           Language.LSP.Types.Lens         as J (HasChildren (children),
                                                       HasCommand (command),
                                                       HasContents (contents),
                                                       HasDeprecated (deprecated),
                                                       HasEdit (edit),
                                                       HasKind (kind),
                                                       HasName (name),
                                                       HasOptions (..),
                                                       HasRange (range),
                                                       HasTextDocument (..),
                                                       HasTitle (title),
                                                       HasUri (..))
import           Language.LSP.VFS
import           Numeric.Natural
import           OpenTelemetry.Eventlog
import           Options.Applicative             (ParserInfo)
import           System.FilePath
import           System.IO.Unsafe
import           Text.Regex.TDFA.Text            ()
import           Control.Applicative             ((<|>))

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

data IdePlugins ideState = IdePlugins_
  { forall ideState.
IdePlugins ideState -> HashMap PluginId (PluginDescriptor ideState)
ipMap_ :: HashMap PluginId (PluginDescriptor ideState)
  , forall ideState. IdePlugins ideState -> CommandId -> Maybe PluginId
lookupCommandProvider :: CommandId -> Maybe PluginId
  }

-- | Smart constructor that deduplicates plugins
pattern IdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
pattern $bIdePlugins :: forall ideState. [PluginDescriptor ideState] -> IdePlugins ideState
$mIdePlugins :: forall {r} {ideState}.
IdePlugins ideState
-> ([PluginDescriptor ideState] -> r) -> ((# #) -> r) -> r
IdePlugins{forall ideState. IdePlugins ideState -> [PluginDescriptor ideState]
ipMap} <- IdePlugins_ (sortOn (Down . pluginPriority) . HashMap.elems -> ipMap) _
  where
    IdePlugins [PluginDescriptor ideState]
ipMap = IdePlugins_{ipMap_ :: HashMap PluginId (PluginDescriptor ideState)
ipMap_ = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall a b. (a -> b) -> a -> b
$ (forall ideState. PluginDescriptor ideState -> PluginId
pluginId forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PluginDescriptor ideState]
ipMap
                                  , lookupCommandProvider :: CommandId -> Maybe PluginId
lookupCommandProvider = forall a. [PluginDescriptor a] -> CommandId -> Maybe PluginId
lookupPluginId [PluginDescriptor ideState]
ipMap
                                  }
{-# COMPLETE IdePlugins #-}

instance Semigroup (IdePlugins a) where
  (IdePlugins_ HashMap PluginId (PluginDescriptor a)
a CommandId -> Maybe PluginId
f) <> :: IdePlugins a -> IdePlugins a -> IdePlugins a
<> (IdePlugins_ HashMap PluginId (PluginDescriptor a)
b CommandId -> Maybe PluginId
g) = forall ideState.
HashMap PluginId (PluginDescriptor ideState)
-> (CommandId -> Maybe PluginId) -> IdePlugins ideState
IdePlugins_ (HashMap PluginId (PluginDescriptor a)
a forall a. Semigroup a => a -> a -> a
<> HashMap PluginId (PluginDescriptor a)
b) (\CommandId
x -> CommandId -> Maybe PluginId
f CommandId
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CommandId -> Maybe PluginId
g CommandId
x)

instance Monoid (IdePlugins a) where
  mempty :: IdePlugins a
mempty = forall ideState.
HashMap PluginId (PluginDescriptor ideState)
-> (CommandId -> Maybe PluginId) -> IdePlugins ideState
IdePlugins_ forall a. Monoid a => a
mempty (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)

-- | Lookup the plugin that exposes a particular command
lookupPluginId :: [PluginDescriptor a] -> CommandId -> Maybe PluginId
lookupPluginId :: forall a. [PluginDescriptor a] -> CommandId -> Maybe PluginId
lookupPluginId [PluginDescriptor a]
ls CommandId
cmd = forall ideState. PluginDescriptor ideState -> PluginId
pluginId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find PluginDescriptor a -> Bool
go [PluginDescriptor a]
ls
  where
    go :: PluginDescriptor a -> Bool
go PluginDescriptor a
desc = CommandId
cmd forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall a b. (a -> b) -> [a] -> [b]
map forall ideState. PluginCommand ideState -> CommandId
commandId (forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
pluginCommands PluginDescriptor a
desc)

-- | Hooks for modifying the 'DynFlags' at different times of the compilation
-- process. Plugins can install a 'DynFlagsModifications' via
-- 'pluginModifyDynflags' in their 'PluginDescriptor'.
data DynFlagsModifications =
  DynFlagsModifications
    { -- | Invoked immediately at the package level. Changes to the 'DynFlags'
      -- made in 'dynFlagsModifyGlobal' are guaranteed to be seen everywhere in
      -- the compilation pipeline.
      DynFlagsModifications -> DynFlags -> DynFlags
dynFlagsModifyGlobal :: DynFlags -> DynFlags
      -- | Invoked just before the parsing step, and reset immediately
      -- afterwards. 'dynFlagsModifyParser' allows plugins to enable language
      -- extensions only during parsing. for example, to let them enable
      -- certain pieces of syntax.
    , DynFlagsModifications -> DynFlags -> DynFlags
dynFlagsModifyParser :: DynFlags -> DynFlags
    }

instance Semigroup DynFlagsModifications where
  DynFlagsModifications DynFlags -> DynFlags
g1 DynFlags -> DynFlags
p1 <> :: DynFlagsModifications
-> DynFlagsModifications -> DynFlagsModifications
<> DynFlagsModifications DynFlags -> DynFlags
g2 DynFlags -> DynFlags
p2 =
    (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlagsModifications
DynFlagsModifications (DynFlags -> DynFlags
g2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> DynFlags
g1) (DynFlags -> DynFlags
p2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> DynFlags
p1)

instance Monoid DynFlagsModifications where
  mempty :: DynFlagsModifications
mempty = (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlagsModifications
DynFlagsModifications forall a. a -> a
id forall a. a -> a
id

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

newtype IdeCommand state = IdeCommand (state -> IO ())
instance Show (IdeCommand st) where show :: IdeCommand st -> String
show IdeCommand st
_ = String
"<ide command>"

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

data PluginDescriptor (ideState :: *) =
  PluginDescriptor { forall ideState. PluginDescriptor ideState -> PluginId
pluginId           :: !PluginId
                   -- ^ Unique identifier of the plugin.
                   , forall ideState. PluginDescriptor ideState -> Natural
pluginPriority     :: Natural
                   -- ^ Plugin handlers are called in priority order, higher priority first
                   , forall ideState. PluginDescriptor ideState -> Rules ()
pluginRules        :: !(Rules ())
                   , forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
pluginCommands     :: ![PluginCommand ideState]
                   , forall ideState.
PluginDescriptor ideState -> PluginHandlers ideState
pluginHandlers     :: PluginHandlers ideState
                   , forall ideState. PluginDescriptor ideState -> ConfigDescriptor
pluginConfigDescriptor :: ConfigDescriptor
                   , forall ideState.
PluginDescriptor ideState -> PluginNotificationHandlers ideState
pluginNotificationHandlers :: PluginNotificationHandlers ideState
                   , forall ideState. PluginDescriptor ideState -> DynFlagsModifications
pluginModifyDynflags :: DynFlagsModifications
                   , forall ideState.
PluginDescriptor ideState
-> Maybe (ParserInfo (IdeCommand ideState))
pluginCli            :: Maybe (ParserInfo (IdeCommand ideState))
                   , forall ideState. PluginDescriptor ideState -> [Text]
pluginFileType       :: [T.Text]
                   -- ^ File extension of the files the plugin is responsible for.
                   --   The plugin is only allowed to handle files with these extensions
                   --   When writing handlers, etc. for this plugin it can be assumed that all handled files are of this type.
                   --   The file extension must have a leading '.'.
                   }

-- | Check whether the given plugin descriptor is responsible for the file with the given path.
--   Compares the file extension of the file at the given path with the file extension
--   the plugin is responsible for.
pluginResponsible :: Uri -> PluginDescriptor c -> Bool
pluginResponsible :: forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
    | Just String
fp <- Maybe String
mfp
    , String -> Text
T.pack (ShowS
takeExtension String
fp) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall ideState. PluginDescriptor ideState -> [Text]
pluginFileType PluginDescriptor c
pluginDesc = Bool
True
    | Bool
otherwise = Bool
False
    where
      mfp :: Maybe String
mfp = Uri -> Maybe String
uriToFilePath Uri
uri

-- | An existential wrapper of 'Properties'
data CustomConfig = forall r. CustomConfig (Properties r)

-- | Describes the configuration a plugin.
-- A plugin may be configurable in such form:
--
-- @
-- {
--  "plugin-id": {
--    "globalOn": true,
--    "codeActionsOn": true,
--    "codeLensOn": true,
--    "config": {
--      "property1": "foo"
--     }
--   }
-- }
-- @
--
-- @globalOn@, @codeActionsOn@, and @codeLensOn@ etc. are called generic configs,
-- which can be inferred from handlers registered by the plugin.
-- @config@ is called custom config, which is defined using 'Properties'.
data ConfigDescriptor = ConfigDescriptor {
  -- | Whether or not to generate generic configs.
  ConfigDescriptor -> Bool
configEnableGenericConfig :: Bool,
  -- | Whether or not to generate @diagnosticsOn@ config.
  -- Diagnostics emit in arbitrary shake rules,
  -- so we can't know statically if the plugin produces diagnostics
  ConfigDescriptor -> Bool
configHasDiagnostics      :: Bool,
  -- | Custom config.
  ConfigDescriptor -> CustomConfig
configCustomConfig        :: CustomConfig
}

mkCustomConfig :: Properties r -> CustomConfig
mkCustomConfig :: forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig = forall (r :: [PropertyKey]). Properties r -> CustomConfig
CustomConfig

defaultConfigDescriptor :: ConfigDescriptor
defaultConfigDescriptor :: ConfigDescriptor
defaultConfigDescriptor = Bool -> Bool -> CustomConfig -> ConfigDescriptor
ConfigDescriptor Bool
True Bool
False (forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig Properties '[]
emptyProperties)

-- | Methods that can be handled by plugins.
-- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method
-- Only methods for which we know how to combine responses can be instances of 'PluginMethod'
class HasTracing (MessageParams m) => PluginMethod (k :: MethodType) (m :: Method FromClient k) where

  -- | Parse the configuration to check if this plugin is enabled.
  -- Perform sanity checks on the message to see whether plugin is enabled
  -- for this message in particular.
  -- If a plugin is not enabled, its handlers, commands, etc... will not be
  -- run for the given message.
  --
  -- Semantically, this method described whether a Plugin is enabled configuration wise
  -- and is allowed to respond to the message. This might depend on the URI that is
  -- associated to the Message Parameters, but doesn't have to. There are requests
  -- with no associated URI that, consequentially, can't inspect the URI.
  --
  -- Common reason why a plugin might not be allowed to respond although it is enabled:
  --   * Plugin can not handle requests associated to the specific URI
  --     * Since the implementation of [cabal plugins](https://github.com/haskell/haskell-language-server/issues/2940)
  --       HLS knows plugins specific for Haskell and specific for [Cabal file descriptions](https://cabal.readthedocs.io/en/3.6/cabal-package.html)
  --
  -- Strictly speaking, we are conflating two concepts here:
  --   * Dynamically enabled (e.g. enabled on a per-message basis)
  --   * Statically enabled (e.g. by configuration in the lsp-client)
  --     * Strictly speaking, this might also change dynamically
  --
  -- But there is no use to split it up currently into two different methods for now.
  pluginEnabled
    :: SMethod m
    -- ^ Method type.
    -> MessageParams m
    -- ^ Whether a plugin is enabled might depend on the message parameters
    --   eg 'pluginFileType' specifies what file extension a plugin is allowed to handle
    -> PluginDescriptor c
    -- ^ Contains meta information such as PluginId and what file types this
    -- plugin is able to handle.
    -> Config
    -- ^ Generic config description, expected to hold 'PluginConfig' configuration
    -- for this plugin
    -> Bool
    -- ^ Is this plugin enabled and allowed to respond to the given request
    -- with the given parameters?

  default pluginEnabled :: (HasTextDocument (MessageParams m) doc, HasUri doc Uri)
                              => SMethod m -> MessageParams m -> PluginDescriptor c -> Config -> Bool
  pluginEnabled SMethod m
_ MessageParams m
params PluginDescriptor c
desc Config
conf = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
desc Bool -> Bool -> Bool
&& PluginConfig -> Bool
plcGlobalOn (Config -> PluginId -> PluginConfig
configForPlugin Config
conf (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
desc))
    where
        uri :: Uri
uri = MessageParams m
params forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

-- ---------------------------------------------------------------------
-- Plugin Requests
-- ---------------------------------------------------------------------

class PluginMethod Request m => PluginRequestMethod (m :: Method FromClient Request) where
  -- | How to combine responses from different plugins.
  --
  -- For example, for Hover requests, we might have multiple producers of
  -- Hover information, we do not want to decide which one to display to the user
  -- but allow here to define how to merge two hover request responses into one
  -- glorious hover box.
  --
  -- However, sometimes only one handler of a request can realistically exist,
  -- such as TextDocumentFormatting, it is safe to just unconditionally report
  -- back one arbitrary result (arbitrary since it should only be one anyway).
  combineResponses
    :: SMethod m
    -> Config -- ^ IDE Configuration
    -> ClientCapabilities
    -> MessageParams m
    -> NonEmpty (ResponseResult m) -> ResponseResult m

  default combineResponses :: Semigroup (ResponseResult m)
    => SMethod m -> Config -> ClientCapabilities -> MessageParams m -> NonEmpty (ResponseResult m) -> ResponseResult m
  combineResponses SMethod m
_method Config
_config ClientCapabilities
_caps MessageParams m
_params = forall a. Semigroup a => NonEmpty a -> a
sconcat

instance PluginMethod Request TextDocumentCodeAction where
  pluginEnabled :: forall c.
SMethod 'TextDocumentCodeAction
-> MessageParams 'TextDocumentCodeAction
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentCodeAction
_ MessageParams 'TextDocumentCodeAction
msgParams PluginDescriptor c
pluginDesc Config
config =
    forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc Bool -> Bool -> Bool
&& (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcCodeActionsOn (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc) Config
config
    where
      uri :: Uri
uri = MessageParams 'TextDocumentCodeAction
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginRequestMethod TextDocumentCodeAction where
  combineResponses :: SMethod 'TextDocumentCodeAction
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentCodeAction
-> NonEmpty (ResponseResult 'TextDocumentCodeAction)
-> ResponseResult 'TextDocumentCodeAction
combineResponses SMethod 'TextDocumentCodeAction
_method Config
_config (ClientCapabilities Maybe WorkspaceClientCapabilities
_ Maybe TextDocumentClientCapabilities
textDocCaps Maybe WindowClientCapabilities
_ Maybe GeneralClientCapabilities
_ Maybe Object
_) (CodeActionParams Maybe ProgressToken
_ Maybe ProgressToken
_ TextDocumentIdentifier
_ Range
_ CodeActionContext
context) NonEmpty (ResponseResult 'TextDocumentCodeAction)
resps =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Command |? CodeAction) -> Command |? CodeAction
compat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Command |? CodeAction) -> Bool
wasRequested forall a b. (a -> b) -> a -> b
$ (\(List [Command |? CodeAction]
x) -> [Command |? CodeAction]
x) forall a b. (a -> b) -> a -> b
$ forall a. Semigroup a => NonEmpty a -> a
sconcat NonEmpty (ResponseResult 'TextDocumentCodeAction)
resps
    where
      compat :: (Command |? CodeAction) -> (Command |? CodeAction)
      compat :: (Command |? CodeAction) -> Command |? CodeAction
compat x :: Command |? CodeAction
x@(InL Command
_) = Command |? CodeAction
x
      compat x :: Command |? CodeAction
x@(InR CodeAction
action)
        | Just CodeActionLiteralSupport
_ <- Maybe TextDocumentClientCapabilities
textDocCaps forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextDocumentClientCapabilities
-> Maybe CodeActionClientCapabilities
_codeAction forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CodeActionClientCapabilities -> Maybe CodeActionLiteralSupport
_codeActionLiteralSupport
        = Command |? CodeAction
x
        | Bool
otherwise = forall a b. a -> a |? b
InL Command
cmd
        where
          cmd :: Command
cmd = PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
"hls" CommandId
"fallbackCodeAction" (CodeAction
action forall s a. s -> Getting a s a -> a
^. forall s a. HasTitle s a => Lens' s a
title) (forall a. a -> Maybe a
Just [Value]
cmdParams)
          cmdParams :: [Value]
cmdParams = [forall a. ToJSON a => a -> Value
toJSON (Maybe WorkspaceEdit -> Maybe Command -> FallbackCodeActionParams
FallbackCodeActionParams (CodeAction
action forall s a. s -> Getting a s a -> a
^. forall s a. HasEdit s a => Lens' s a
edit) (CodeAction
action forall s a. s -> Getting a s a -> a
^. forall s a. HasCommand s a => Lens' s a
command))]

      wasRequested :: (Command |? CodeAction) -> Bool
      wasRequested :: (Command |? CodeAction) -> Bool
wasRequested (InL Command
_) = Bool
True
      wasRequested (InR CodeAction
ca)
        | Maybe (List CodeActionKind)
Nothing <- CodeActionContext -> Maybe (List CodeActionKind)
_only CodeActionContext
context = Bool
True
        | Just (List [CodeActionKind]
allowed) <- CodeActionContext -> Maybe (List CodeActionKind)
_only CodeActionContext
context
        -- See https://github.com/microsoft/language-server-protocol/issues/970
        -- This is somewhat vague, but due to the hierarchical nature of action kinds, we
        -- should check whether the requested kind is a *prefix* of the action kind.
        -- That means, for example, we will return actions with kinds `quickfix.import` and
        -- `quickfix.somethingElse` if the requested kind is `quickfix`.
        , Just CodeActionKind
caKind <- CodeAction
ca forall s a. s -> Getting a s a -> a
^. forall s a. HasKind s a => Lens' s a
kind = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\CodeActionKind
k -> CodeActionKind
k CodeActionKind -> CodeActionKind -> Bool
`codeActionKindSubsumes` CodeActionKind
caKind) [CodeActionKind]
allowed
        | Bool
otherwise = Bool
False

instance PluginMethod Request TextDocumentDefinition where
  pluginEnabled :: forall c.
SMethod 'TextDocumentDefinition
-> MessageParams 'TextDocumentDefinition
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentDefinition
_ MessageParams 'TextDocumentDefinition
msgParams PluginDescriptor c
pluginDesc Config
_ =
    forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
    where
      uri :: Uri
uri = MessageParams 'TextDocumentDefinition
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginMethod Request TextDocumentTypeDefinition where
  pluginEnabled :: forall c.
SMethod 'TextDocumentTypeDefinition
-> MessageParams 'TextDocumentTypeDefinition
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentTypeDefinition
_ MessageParams 'TextDocumentTypeDefinition
msgParams PluginDescriptor c
pluginDesc Config
_ =
    forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
    where
      uri :: Uri
uri = MessageParams 'TextDocumentTypeDefinition
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginMethod Request TextDocumentDocumentHighlight where
  pluginEnabled :: forall c.
SMethod 'TextDocumentDocumentHighlight
-> MessageParams 'TextDocumentDocumentHighlight
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentDocumentHighlight
_ MessageParams 'TextDocumentDocumentHighlight
msgParams PluginDescriptor c
pluginDesc Config
_ =
    forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
    where
      uri :: Uri
uri = MessageParams 'TextDocumentDocumentHighlight
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginMethod Request TextDocumentReferences where
  pluginEnabled :: forall c.
SMethod 'TextDocumentReferences
-> MessageParams 'TextDocumentReferences
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentReferences
_ MessageParams 'TextDocumentReferences
msgParams PluginDescriptor c
pluginDesc Config
_ =
    forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
    where
      uri :: Uri
uri = MessageParams 'TextDocumentReferences
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginMethod Request WorkspaceSymbol where
  -- Unconditionally enabled, but should it really be?
  pluginEnabled :: forall c.
SMethod 'WorkspaceSymbol
-> MessageParams 'WorkspaceSymbol
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'WorkspaceSymbol
_ MessageParams 'WorkspaceSymbol
_ PluginDescriptor c
_ Config
_ = Bool
True

instance PluginMethod Request TextDocumentCodeLens where
  pluginEnabled :: forall c.
SMethod 'TextDocumentCodeLens
-> MessageParams 'TextDocumentCodeLens
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentCodeLens
_ MessageParams 'TextDocumentCodeLens
msgParams PluginDescriptor c
pluginDesc Config
config = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
      Bool -> Bool -> Bool
&& (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcCodeLensOn (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc) Config
config
    where
      uri :: Uri
uri = MessageParams 'TextDocumentCodeLens
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginMethod Request TextDocumentRename where
  pluginEnabled :: forall c.
SMethod 'TextDocumentRename
-> MessageParams 'TextDocumentRename
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentRename
_ MessageParams 'TextDocumentRename
msgParams PluginDescriptor c
pluginDesc Config
config = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
      Bool -> Bool -> Bool
&& (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcRenameOn (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc) Config
config
   where
      uri :: Uri
uri = MessageParams 'TextDocumentRename
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri
instance PluginMethod Request TextDocumentHover where
  pluginEnabled :: forall c.
SMethod 'TextDocumentHover
-> MessageParams 'TextDocumentHover
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentHover
_ MessageParams 'TextDocumentHover
msgParams PluginDescriptor c
pluginDesc Config
config = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
      Bool -> Bool -> Bool
&& (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcHoverOn (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc) Config
config
   where
      uri :: Uri
uri = MessageParams 'TextDocumentHover
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginMethod Request TextDocumentDocumentSymbol where
  pluginEnabled :: forall c.
SMethod 'TextDocumentDocumentSymbol
-> MessageParams 'TextDocumentDocumentSymbol
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentDocumentSymbol
_ MessageParams 'TextDocumentDocumentSymbol
msgParams PluginDescriptor c
pluginDesc Config
config = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
      Bool -> Bool -> Bool
&& (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcSymbolsOn (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc) Config
config
    where
      uri :: Uri
uri = MessageParams 'TextDocumentDocumentSymbol
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginMethod Request TextDocumentCompletion where
  pluginEnabled :: forall c.
SMethod 'TextDocumentCompletion
-> MessageParams 'TextDocumentCompletion
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentCompletion
_ MessageParams 'TextDocumentCompletion
msgParams PluginDescriptor c
pluginDesc Config
config = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
      Bool -> Bool -> Bool
&& (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcCompletionOn (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc) Config
config
    where
      uri :: Uri
uri = MessageParams 'TextDocumentCompletion
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri

instance PluginMethod Request TextDocumentFormatting where
  pluginEnabled :: forall c.
SMethod 'TextDocumentFormatting
-> MessageParams 'TextDocumentFormatting
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentFormatting
STextDocumentFormatting MessageParams 'TextDocumentFormatting
msgParams PluginDescriptor c
pluginDesc Config
conf =
    forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc Bool -> Bool -> Bool
&& Text -> PluginId
PluginId (Config -> Text
formattingProvider Config
conf) forall a. Eq a => a -> a -> Bool
== PluginId
pid
    where
      uri :: Uri
uri = MessageParams 'TextDocumentFormatting
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri
      pid :: PluginId
pid = forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc

instance PluginMethod Request TextDocumentRangeFormatting where
  pluginEnabled :: forall c.
SMethod 'TextDocumentRangeFormatting
-> MessageParams 'TextDocumentRangeFormatting
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentRangeFormatting
_ MessageParams 'TextDocumentRangeFormatting
msgParams PluginDescriptor c
pluginDesc Config
conf = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
      Bool -> Bool -> Bool
&& Text -> PluginId
PluginId (Config -> Text
formattingProvider Config
conf) forall a. Eq a => a -> a -> Bool
== PluginId
pid
    where
      uri :: Uri
uri = MessageParams 'TextDocumentRangeFormatting
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri
      pid :: PluginId
pid = forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc

instance PluginMethod Request TextDocumentPrepareCallHierarchy where
  pluginEnabled :: forall c.
SMethod 'TextDocumentPrepareCallHierarchy
-> MessageParams 'TextDocumentPrepareCallHierarchy
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentPrepareCallHierarchy
_ MessageParams 'TextDocumentPrepareCallHierarchy
msgParams PluginDescriptor c
pluginDesc Config
conf = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
      Bool -> Bool -> Bool
&& (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcCallHierarchyOn PluginId
pid Config
conf
    where
      uri :: Uri
uri = MessageParams 'TextDocumentPrepareCallHierarchy
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri
      pid :: PluginId
pid = forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc

instance PluginMethod Request TextDocumentSelectionRange where
  pluginEnabled :: forall c.
SMethod 'TextDocumentSelectionRange
-> MessageParams 'TextDocumentSelectionRange
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'TextDocumentSelectionRange
_ MessageParams 'TextDocumentSelectionRange
msgParams PluginDescriptor c
pluginDesc Config
conf = forall c. Uri -> PluginDescriptor c -> Bool
pluginResponsible Uri
uri PluginDescriptor c
pluginDesc
      Bool -> Bool -> Bool
&& (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcSelectionRangeOn PluginId
pid Config
conf
    where
      uri :: Uri
uri = MessageParams 'TextDocumentSelectionRange
msgParams forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri
      pid :: PluginId
pid = forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc

instance PluginMethod Request CallHierarchyIncomingCalls where
  -- This method has no URI parameter, thus no call to 'pluginResponsible'
  pluginEnabled :: forall c.
SMethod 'CallHierarchyIncomingCalls
-> MessageParams 'CallHierarchyIncomingCalls
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'CallHierarchyIncomingCalls
_ MessageParams 'CallHierarchyIncomingCalls
_ PluginDescriptor c
pluginDesc Config
conf = (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcCallHierarchyOn PluginId
pid Config
conf
    where
      pid :: PluginId
pid = forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc

instance PluginMethod Request CallHierarchyOutgoingCalls where
  -- This method has no URI parameter, thus no call to 'pluginResponsible'
  pluginEnabled :: forall c.
SMethod 'CallHierarchyOutgoingCalls
-> MessageParams 'CallHierarchyOutgoingCalls
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'CallHierarchyOutgoingCalls
_ MessageParams 'CallHierarchyOutgoingCalls
_ PluginDescriptor c
pluginDesc Config
conf = (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
plcCallHierarchyOn PluginId
pid Config
conf
    where
      pid :: PluginId
pid = forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
pluginDesc

instance PluginMethod Request CustomMethod where
  pluginEnabled :: forall c.
SMethod 'CustomMethod
-> MessageParams 'CustomMethod
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'CustomMethod
_ MessageParams 'CustomMethod
_ PluginDescriptor c
_ Config
_ = Bool
True

---
instance PluginRequestMethod TextDocumentDefinition where
  combineResponses :: SMethod 'TextDocumentDefinition
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentDefinition
-> NonEmpty (ResponseResult 'TextDocumentDefinition)
-> ResponseResult 'TextDocumentDefinition
combineResponses SMethod 'TextDocumentDefinition
_ Config
_ ClientCapabilities
_ MessageParams 'TextDocumentDefinition
_ (ResponseResult 'TextDocumentDefinition
x :| [ResponseResult 'TextDocumentDefinition]
_) = ResponseResult 'TextDocumentDefinition
x

instance PluginRequestMethod TextDocumentTypeDefinition where
  combineResponses :: SMethod 'TextDocumentTypeDefinition
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentTypeDefinition
-> NonEmpty (ResponseResult 'TextDocumentTypeDefinition)
-> ResponseResult 'TextDocumentTypeDefinition
combineResponses SMethod 'TextDocumentTypeDefinition
_ Config
_ ClientCapabilities
_ MessageParams 'TextDocumentTypeDefinition
_ (ResponseResult 'TextDocumentTypeDefinition
x :| [ResponseResult 'TextDocumentTypeDefinition]
_) = ResponseResult 'TextDocumentTypeDefinition
x

instance PluginRequestMethod TextDocumentDocumentHighlight where

instance PluginRequestMethod TextDocumentReferences where

instance PluginRequestMethod WorkspaceSymbol where

instance PluginRequestMethod TextDocumentCodeLens where

instance PluginRequestMethod TextDocumentRename where

instance PluginRequestMethod TextDocumentHover where
  combineResponses :: SMethod 'TextDocumentHover
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentHover
-> NonEmpty (ResponseResult 'TextDocumentHover)
-> ResponseResult 'TextDocumentHover
combineResponses SMethod 'TextDocumentHover
_ Config
_ ClientCapabilities
_ MessageParams 'TextDocumentHover
_ (forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
toList -> [Hover]
hs) = Maybe Hover
h
    where
      r :: Maybe Range
r = forall a. [a] -> Maybe a
listToMaybe forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
range) [Hover]
hs
      h :: Maybe Hover
h = case forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall s a. s -> Getting a s a -> a
^. forall s a. HasContents s a => Lens' s a
contents) [Hover]
hs of
            HoverContentsMS (List []) -> forall a. Maybe a
Nothing
            HoverContents
hh                        -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ HoverContents -> Maybe Range -> Hover
Hover HoverContents
hh Maybe Range
r

instance PluginRequestMethod TextDocumentDocumentSymbol where
  combineResponses :: SMethod 'TextDocumentDocumentSymbol
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentDocumentSymbol
-> NonEmpty (ResponseResult 'TextDocumentDocumentSymbol)
-> ResponseResult 'TextDocumentDocumentSymbol
combineResponses SMethod 'TextDocumentDocumentSymbol
_ Config
_ (ClientCapabilities Maybe WorkspaceClientCapabilities
_ Maybe TextDocumentClientCapabilities
tdc Maybe WindowClientCapabilities
_ Maybe GeneralClientCapabilities
_ Maybe Object
_) MessageParams 'TextDocumentDocumentSymbol
params NonEmpty (ResponseResult 'TextDocumentDocumentSymbol)
xs = List DocumentSymbol |? List SymbolInformation
res
    where
      uri' :: Uri
uri' = MessageParams 'TextDocumentDocumentSymbol
params forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
uri
      supportsHierarchy :: Bool
supportsHierarchy = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== (Maybe TextDocumentClientCapabilities
tdc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TextDocumentClientCapabilities
-> Maybe DocumentSymbolClientCapabilities
_documentSymbol forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DocumentSymbolClientCapabilities -> Maybe Bool
_hierarchicalDocumentSymbolSupport)
      dsOrSi :: NonEmpty (Either (List DocumentSymbol) (List SymbolInformation))
dsOrSi = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a |? b) -> Either a b
toEither NonEmpty (ResponseResult 'TextDocumentDocumentSymbol)
xs
      res :: List DocumentSymbol |? List SymbolInformation
res
        | Bool
supportsHierarchy = forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolInformation -> DocumentSymbol
siToDs)) NonEmpty (Either (List DocumentSymbol) (List SymbolInformation))
dsOrSi
        | Bool
otherwise = forall a b. b -> a |? b
InR forall a b. (a -> b) -> a -> b
$ forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. [a] -> List a
List forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DocumentSymbol -> [SymbolInformation]
dsToSi) forall a. a -> a
id) NonEmpty (Either (List DocumentSymbol) (List SymbolInformation))
dsOrSi
      siToDs :: SymbolInformation -> DocumentSymbol
siToDs (SymbolInformation Text
name SymbolKind
kind Maybe (List SymbolTag)
_tags Maybe Bool
dep (Location Uri
_uri Range
range) Maybe Text
cont)
        = Text
-> Maybe Text
-> SymbolKind
-> Maybe (List SymbolTag)
-> Maybe Bool
-> Range
-> Range
-> Maybe (List DocumentSymbol)
-> DocumentSymbol
DocumentSymbol Text
name Maybe Text
cont SymbolKind
kind forall a. Maybe a
Nothing Maybe Bool
dep Range
range Range
range forall a. Maybe a
Nothing
      dsToSi :: DocumentSymbol -> [SymbolInformation]
dsToSi = Maybe Text -> DocumentSymbol -> [SymbolInformation]
go forall a. Maybe a
Nothing
      go :: Maybe T.Text -> DocumentSymbol -> [SymbolInformation]
      go :: Maybe Text -> DocumentSymbol -> [SymbolInformation]
go Maybe Text
parent DocumentSymbol
ds =
        let children' :: [SymbolInformation]
            children' :: [SymbolInformation]
children' = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Maybe Text -> DocumentSymbol -> [SymbolInformation]
go (forall a. a -> Maybe a
Just Text
name')) (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (DocumentSymbol
ds forall s a. s -> Getting a s a -> a
^. forall s a. HasChildren s a => Lens' s a
children))
            loc :: Location
loc = Uri -> Range -> Location
Location Uri
uri' (DocumentSymbol
ds forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
range)
            name' :: Text
name' = DocumentSymbol
ds forall s a. s -> Getting a s a -> a
^. forall s a. HasName s a => Lens' s a
name
            si :: SymbolInformation
si = Text
-> SymbolKind
-> Maybe (List SymbolTag)
-> Maybe Bool
-> Location
-> Maybe Text
-> SymbolInformation
SymbolInformation Text
name' (DocumentSymbol
ds forall s a. s -> Getting a s a -> a
^. forall s a. HasKind s a => Lens' s a
kind) forall a. Maybe a
Nothing (DocumentSymbol
ds forall s a. s -> Getting a s a -> a
^. forall s a. HasDeprecated s a => Lens' s a
deprecated) Location
loc Maybe Text
parent
        in [SymbolInformation
si] forall a. Semigroup a => a -> a -> a
<> [SymbolInformation]
children'

instance PluginRequestMethod TextDocumentCompletion where
  combineResponses :: SMethod 'TextDocumentCompletion
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentCompletion
-> NonEmpty (ResponseResult 'TextDocumentCompletion)
-> ResponseResult 'TextDocumentCompletion
combineResponses SMethod 'TextDocumentCompletion
_ Config
conf ClientCapabilities
_ MessageParams 'TextDocumentCompletion
_ (forall a. NonEmpty a -> [a]
toList -> [List CompletionItem |? CompletionList]
xs) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Int
-> (List CompletionItem |? CompletionList)
-> (Int, List CompletionItem |? CompletionList)
consumeCompletionResponse Int
limit forall a b. (a -> b) -> a -> b
$ [List CompletionItem |? CompletionList]
-> List CompletionItem |? CompletionList
combine [List CompletionItem |? CompletionList]
xs
      where
        limit :: Int
limit = Config -> Int
maxCompletions Config
conf
        combine :: [List CompletionItem |? CompletionList] -> (List CompletionItem |? CompletionList)
        combine :: [List CompletionItem |? CompletionList]
-> List CompletionItem |? CompletionList
combine [List CompletionItem |? CompletionList]
cs = forall {a}.
Bool
-> DList CompletionItem
-> [List CompletionItem |? CompletionList]
-> a |? CompletionList
go Bool
True forall a. Monoid a => a
mempty [List CompletionItem |? CompletionList]
cs

        go :: Bool
-> DList CompletionItem
-> [List CompletionItem |? CompletionList]
-> a |? CompletionList
go !Bool
comp DList CompletionItem
acc [] =
          forall a b. b -> a |? b
InR (Bool -> List CompletionItem -> CompletionList
CompletionList Bool
comp (forall a. [a] -> List a
List forall a b. (a -> b) -> a -> b
$ forall a. DList a -> [a]
DList.toList DList CompletionItem
acc))
        go Bool
comp DList CompletionItem
acc (InL (List [CompletionItem]
ls) : [List CompletionItem |? CompletionList]
rest) =
          Bool
-> DList CompletionItem
-> [List CompletionItem |? CompletionList]
-> a |? CompletionList
go Bool
comp (DList CompletionItem
acc forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DList.fromList [CompletionItem]
ls) [List CompletionItem |? CompletionList]
rest
        go Bool
comp DList CompletionItem
acc (InR (CompletionList Bool
comp' (List [CompletionItem]
ls)) : [List CompletionItem |? CompletionList]
rest) =
          Bool
-> DList CompletionItem
-> [List CompletionItem |? CompletionList]
-> a |? CompletionList
go (Bool
comp Bool -> Bool -> Bool
&& Bool
comp') (DList CompletionItem
acc forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> DList a
DList.fromList [CompletionItem]
ls) [List CompletionItem |? CompletionList]
rest

        -- boolean disambiguators
        isCompleteResponse, isIncompleteResponse :: Bool
        isIncompleteResponse :: Bool
isIncompleteResponse = Bool
True
        isCompleteResponse :: Bool
isCompleteResponse = Bool
False

        consumeCompletionResponse :: Int
-> (List CompletionItem |? CompletionList)
-> (Int, List CompletionItem |? CompletionList)
consumeCompletionResponse Int
limit it :: List CompletionItem |? CompletionList
it@(InR (CompletionList Bool
_ (List [CompletionItem]
xx))) =
          case forall a. Int -> [a] -> ([a], [a])
splitAt Int
limit [CompletionItem]
xx of
            -- consumed all the items, return the result as is
            ([CompletionItem]
_, []) -> (Int
limit forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length [CompletionItem]
xx, List CompletionItem |? CompletionList
it)
            -- need to crop the response, set the 'isIncomplete' flag
            ([CompletionItem]
xx', [CompletionItem]
_) -> (Int
0, forall a b. b -> a |? b
InR (Bool -> List CompletionItem -> CompletionList
CompletionList Bool
isIncompleteResponse (forall a. [a] -> List a
List [CompletionItem]
xx')))
        consumeCompletionResponse Int
n (InL (List [CompletionItem]
xx)) =
          Int
-> (List CompletionItem |? CompletionList)
-> (Int, List CompletionItem |? CompletionList)
consumeCompletionResponse Int
n (forall a b. b -> a |? b
InR (Bool -> List CompletionItem -> CompletionList
CompletionList Bool
isCompleteResponse (forall a. [a] -> List a
List [CompletionItem]
xx)))

instance PluginRequestMethod TextDocumentFormatting where
  combineResponses :: SMethod 'TextDocumentFormatting
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentFormatting
-> NonEmpty (ResponseResult 'TextDocumentFormatting)
-> ResponseResult 'TextDocumentFormatting
combineResponses SMethod 'TextDocumentFormatting
_ Config
_ ClientCapabilities
_ MessageParams 'TextDocumentFormatting
_ (ResponseResult 'TextDocumentFormatting
x :| [ResponseResult 'TextDocumentFormatting]
_) = ResponseResult 'TextDocumentFormatting
x

instance PluginRequestMethod TextDocumentRangeFormatting where
  combineResponses :: SMethod 'TextDocumentRangeFormatting
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentRangeFormatting
-> NonEmpty (ResponseResult 'TextDocumentRangeFormatting)
-> ResponseResult 'TextDocumentRangeFormatting
combineResponses SMethod 'TextDocumentRangeFormatting
_ Config
_ ClientCapabilities
_ MessageParams 'TextDocumentRangeFormatting
_ (ResponseResult 'TextDocumentRangeFormatting
x :| [ResponseResult 'TextDocumentRangeFormatting]
_) = ResponseResult 'TextDocumentRangeFormatting
x

instance PluginRequestMethod TextDocumentPrepareCallHierarchy where

instance PluginRequestMethod TextDocumentSelectionRange where
  combineResponses :: SMethod 'TextDocumentSelectionRange
-> Config
-> ClientCapabilities
-> MessageParams 'TextDocumentSelectionRange
-> NonEmpty (ResponseResult 'TextDocumentSelectionRange)
-> ResponseResult 'TextDocumentSelectionRange
combineResponses SMethod 'TextDocumentSelectionRange
_ Config
_ ClientCapabilities
_ MessageParams 'TextDocumentSelectionRange
_ (ResponseResult 'TextDocumentSelectionRange
x :| [ResponseResult 'TextDocumentSelectionRange]
_) = ResponseResult 'TextDocumentSelectionRange
x

instance PluginRequestMethod CallHierarchyIncomingCalls where

instance PluginRequestMethod CallHierarchyOutgoingCalls where

instance PluginRequestMethod CustomMethod where
  combineResponses :: SMethod 'CustomMethod
-> Config
-> ClientCapabilities
-> MessageParams 'CustomMethod
-> NonEmpty (ResponseResult 'CustomMethod)
-> ResponseResult 'CustomMethod
combineResponses SMethod 'CustomMethod
_ Config
_ ClientCapabilities
_ MessageParams 'CustomMethod
_ (ResponseResult 'CustomMethod
x :| [ResponseResult 'CustomMethod]
_) = ResponseResult 'CustomMethod
x

-- ---------------------------------------------------------------------
-- Plugin Notifications
-- ---------------------------------------------------------------------

-- | Plugin Notification methods. No specific methods at the moment, but
-- might contain more in the future.
class PluginMethod Notification m => PluginNotificationMethod (m :: Method FromClient Notification)  where


instance PluginMethod Notification TextDocumentDidOpen where

instance PluginMethod Notification TextDocumentDidChange where

instance PluginMethod Notification TextDocumentDidSave where

instance PluginMethod Notification TextDocumentDidClose where

instance PluginMethod Notification WorkspaceDidChangeWatchedFiles where
  -- This method has no URI parameter, thus no call to 'pluginResponsible'.
  pluginEnabled :: forall c.
SMethod 'WorkspaceDidChangeWatchedFiles
-> MessageParams 'WorkspaceDidChangeWatchedFiles
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'WorkspaceDidChangeWatchedFiles
_ MessageParams 'WorkspaceDidChangeWatchedFiles
_ PluginDescriptor c
desc Config
conf = PluginConfig -> Bool
plcGlobalOn forall a b. (a -> b) -> a -> b
$ Config -> PluginId -> PluginConfig
configForPlugin Config
conf (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
desc)

instance PluginMethod Notification WorkspaceDidChangeWorkspaceFolders where
  -- This method has no URI parameter, thus no call to 'pluginResponsible'.
  pluginEnabled :: forall c.
SMethod 'WorkspaceDidChangeWorkspaceFolders
-> MessageParams 'WorkspaceDidChangeWorkspaceFolders
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'WorkspaceDidChangeWorkspaceFolders
_ MessageParams 'WorkspaceDidChangeWorkspaceFolders
_ PluginDescriptor c
desc Config
conf = PluginConfig -> Bool
plcGlobalOn forall a b. (a -> b) -> a -> b
$ Config -> PluginId -> PluginConfig
configForPlugin Config
conf (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
desc)

instance PluginMethod Notification WorkspaceDidChangeConfiguration where
  -- This method has no URI parameter, thus no call to 'pluginResponsible'.
  pluginEnabled :: forall c.
SMethod 'WorkspaceDidChangeConfiguration
-> MessageParams 'WorkspaceDidChangeConfiguration
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'WorkspaceDidChangeConfiguration
_ MessageParams 'WorkspaceDidChangeConfiguration
_ PluginDescriptor c
desc Config
conf = PluginConfig -> Bool
plcGlobalOn forall a b. (a -> b) -> a -> b
$ Config -> PluginId -> PluginConfig
configForPlugin Config
conf (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
desc)

instance PluginMethod Notification Initialized where
  -- This method has no URI parameter, thus no call to 'pluginResponsible'.
  pluginEnabled :: forall c.
SMethod 'Initialized
-> MessageParams 'Initialized
-> PluginDescriptor c
-> Config
-> Bool
pluginEnabled SMethod 'Initialized
_ MessageParams 'Initialized
_ PluginDescriptor c
desc Config
conf = PluginConfig -> Bool
plcGlobalOn forall a b. (a -> b) -> a -> b
$ Config -> PluginId -> PluginConfig
configForPlugin Config
conf (forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor c
desc)


instance PluginNotificationMethod TextDocumentDidOpen where

instance PluginNotificationMethod TextDocumentDidChange where

instance PluginNotificationMethod TextDocumentDidSave where

instance PluginNotificationMethod TextDocumentDidClose where

instance PluginNotificationMethod WorkspaceDidChangeWatchedFiles where

instance PluginNotificationMethod WorkspaceDidChangeWorkspaceFolders where

instance PluginNotificationMethod WorkspaceDidChangeConfiguration where

instance PluginNotificationMethod Initialized where

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

-- | Methods which have a PluginMethod instance
data IdeMethod (m :: Method FromClient Request) = PluginRequestMethod m => IdeMethod (SMethod m)
instance GEq IdeMethod where
  geq :: forall (a :: Method 'FromClient 'Request)
       (b :: Method 'FromClient 'Request).
IdeMethod a -> IdeMethod b -> Maybe (a :~: b)
geq (IdeMethod SMethod a
a) (IdeMethod SMethod b
b) = forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SMethod a
a SMethod b
b
instance GCompare IdeMethod where
  gcompare :: forall (a :: Method 'FromClient 'Request)
       (b :: Method 'FromClient 'Request).
IdeMethod a -> IdeMethod b -> GOrdering a b
gcompare (IdeMethod SMethod a
a) (IdeMethod SMethod b
b) = forall k (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> GOrdering a b
gcompare SMethod a
a SMethod b
b

-- | Methods which have a PluginMethod instance
data IdeNotification (m :: Method FromClient Notification) = PluginNotificationMethod m => IdeNotification (SMethod m)
instance GEq IdeNotification where
  geq :: forall (a :: Method 'FromClient 'Notification)
       (b :: Method 'FromClient 'Notification).
IdeNotification a -> IdeNotification b -> Maybe (a :~: b)
geq (IdeNotification SMethod a
a) (IdeNotification SMethod b
b) = forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SMethod a
a SMethod b
b
instance GCompare IdeNotification where
  gcompare :: forall (a :: Method 'FromClient 'Notification)
       (b :: Method 'FromClient 'Notification).
IdeNotification a -> IdeNotification b -> GOrdering a b
gcompare (IdeNotification SMethod a
a) (IdeNotification SMethod b
b) = forall k (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> GOrdering a b
gcompare SMethod a
a SMethod b
b

-- | Combine handlers for the
newtype PluginHandler a (m :: Method FromClient Request)
  = PluginHandler (PluginId -> a -> MessageParams m -> LspM Config (NonEmpty (Either ResponseError (ResponseResult m))))

newtype PluginNotificationHandler a (m :: Method FromClient Notification)
  = PluginNotificationHandler (PluginId -> a -> VFS -> MessageParams m -> LspM Config ())

newtype PluginHandlers a             = PluginHandlers             (DMap IdeMethod       (PluginHandler a))
newtype PluginNotificationHandlers a = PluginNotificationHandlers (DMap IdeNotification (PluginNotificationHandler a))
instance Semigroup (PluginHandlers a) where
  (PluginHandlers DMap IdeMethod (PluginHandler a)
a) <> :: PluginHandlers a -> PluginHandlers a -> PluginHandlers a
<> (PluginHandlers DMap IdeMethod (PluginHandler a)
b) = forall a. DMap IdeMethod (PluginHandler a) -> PluginHandlers a
PluginHandlers 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} {a}.
(ResponseResult m ~ ResponseResult m,
 ResponseResult m ~ ResponseResult m,
 MessageParams m ~ MessageParams m,
 MessageParams m ~ MessageParams m) =>
p -> PluginHandler a m -> PluginHandler a m -> PluginHandler a m
go DMap IdeMethod (PluginHandler a)
a DMap IdeMethod (PluginHandler a)
b
    where
      go :: p -> PluginHandler a m -> PluginHandler a m -> PluginHandler a m
go p
_ (PluginHandler PluginId
-> a
-> MessageParams m
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult m)))
f) (PluginHandler PluginId
-> a
-> MessageParams m
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult m)))
g) = forall a (m :: Method 'FromClient 'Request).
(PluginId
 -> a
 -> MessageParams m
 -> LspM
      Config (NonEmpty (Either ResponseError (ResponseResult m))))
-> PluginHandler a m
PluginHandler forall a b. (a -> b) -> a -> b
$ \PluginId
pid a
ide MessageParams m
params ->
        forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PluginId
-> a
-> MessageParams m
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult m)))
f PluginId
pid a
ide MessageParams m
params forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PluginId
-> a
-> MessageParams m
-> LspM Config (NonEmpty (Either ResponseError (ResponseResult m)))
g PluginId
pid a
ide MessageParams m
params

instance Monoid (PluginHandlers a) where
  mempty :: PluginHandlers a
mempty = forall a. DMap IdeMethod (PluginHandler a) -> PluginHandlers a
PluginHandlers forall a. Monoid a => a
mempty

instance Semigroup (PluginNotificationHandlers a) where
  (PluginNotificationHandlers DMap IdeNotification (PluginNotificationHandler a)
a) <> :: PluginNotificationHandlers a
-> PluginNotificationHandlers a -> PluginNotificationHandlers a
<> (PluginNotificationHandlers DMap IdeNotification (PluginNotificationHandler a)
b) = forall a.
DMap IdeNotification (PluginNotificationHandler a)
-> PluginNotificationHandlers a
PluginNotificationHandlers 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} {a}.
(MessageParams m ~ MessageParams m,
 MessageParams m ~ MessageParams m) =>
p
-> PluginNotificationHandler a m
-> PluginNotificationHandler a m
-> PluginNotificationHandler a m
go DMap IdeNotification (PluginNotificationHandler a)
a DMap IdeNotification (PluginNotificationHandler a)
b
    where
      go :: p
-> PluginNotificationHandler a m
-> PluginNotificationHandler a m
-> PluginNotificationHandler a m
go p
_ (PluginNotificationHandler PluginId -> a -> VFS -> MessageParams m -> LspM Config ()
f) (PluginNotificationHandler PluginId -> a -> VFS -> MessageParams m -> LspM Config ()
g) = forall a (m :: Method 'FromClient 'Notification).
(PluginId -> a -> VFS -> MessageParams m -> LspM Config ())
-> PluginNotificationHandler a m
PluginNotificationHandler forall a b. (a -> b) -> a -> b
$ \PluginId
pid a
ide VFS
vfs MessageParams m
params ->
        PluginId -> a -> VFS -> MessageParams m -> LspM Config ()
f PluginId
pid a
ide VFS
vfs MessageParams m
params forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PluginId -> a -> VFS -> MessageParams m -> LspM Config ()
g PluginId
pid a
ide VFS
vfs MessageParams m
params

instance Monoid (PluginNotificationHandlers a) where
  mempty :: PluginNotificationHandlers a
mempty = forall a.
DMap IdeNotification (PluginNotificationHandler a)
-> PluginNotificationHandlers a
PluginNotificationHandlers forall a. Monoid a => a
mempty

type PluginMethodHandler a m = a -> PluginId -> MessageParams m -> LspM Config (Either ResponseError (ResponseResult m))

type PluginNotificationMethodHandler a m = a -> VFS -> PluginId -> MessageParams m -> LspM Config ()

-- | Make a handler for plugins with no extra data
mkPluginHandler
  :: PluginRequestMethod m
  => SClientMethod m
  -> PluginMethodHandler ideState m
  -> PluginHandlers ideState
mkPluginHandler :: forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod m
m PluginMethodHandler ideState m
f = forall a. DMap IdeMethod (PluginHandler a) -> PluginHandlers a
PluginHandlers forall a b. (a -> b) -> a -> b
$ forall {k1} (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> DMap k2 f
DMap.singleton (forall (m :: Method 'FromClient 'Request).
PluginRequestMethod m =>
SMethod m -> IdeMethod m
IdeMethod SClientMethod m
m) (forall a (m :: Method 'FromClient 'Request).
(PluginId
 -> a
 -> MessageParams m
 -> LspM
      Config (NonEmpty (Either ResponseError (ResponseResult m))))
-> PluginHandler a m
PluginHandler PluginId
-> ideState
-> MessageParams m
-> LspT
     Config IO (NonEmpty (Either ResponseError (ResponseResult m)))
f')
  where
    f' :: PluginId
-> ideState
-> MessageParams m
-> LspT
     Config IO (NonEmpty (Either ResponseError (ResponseResult m)))
f' PluginId
pid ideState
ide MessageParams m
params = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PluginMethodHandler ideState m
f ideState
ide PluginId
pid MessageParams m
params

-- | Make a handler for plugins with no extra data
mkPluginNotificationHandler
  :: PluginNotificationMethod m
  => SClientMethod (m :: Method FromClient Notification)
  -> PluginNotificationMethodHandler ideState m
  -> PluginNotificationHandlers ideState
mkPluginNotificationHandler :: forall (m :: Method 'FromClient 'Notification) ideState.
PluginNotificationMethod m =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod m
m PluginNotificationMethodHandler ideState m
f
    = forall a.
DMap IdeNotification (PluginNotificationHandler a)
-> PluginNotificationHandlers a
PluginNotificationHandlers forall a b. (a -> b) -> a -> b
$ forall {k1} (k2 :: k1 -> *) (v :: k1) (f :: k1 -> *).
k2 v -> f v -> DMap k2 f
DMap.singleton (forall (m :: Method 'FromClient 'Notification).
PluginNotificationMethod m =>
SMethod m -> IdeNotification m
IdeNotification SClientMethod m
m) (forall a (m :: Method 'FromClient 'Notification).
(PluginId -> a -> VFS -> MessageParams m -> LspM Config ())
-> PluginNotificationHandler a m
PluginNotificationHandler PluginId -> ideState -> VFS -> MessageParams m -> LspM Config ()
f')
  where
    f' :: PluginId -> ideState -> VFS -> MessageParams m -> LspM Config ()
f' PluginId
pid ideState
ide VFS
vfs = PluginNotificationMethodHandler ideState m
f ideState
ide VFS
vfs PluginId
pid

defaultPluginPriority :: Natural
defaultPluginPriority :: Natural
defaultPluginPriority = Natural
1000

-- | Set up a plugin descriptor, initialized with default values.
-- This is plugin descriptor is prepared for @haskell@ files, such as
--
--   * @.hs@
--   * @.lhs@
--   * @.hs-boot@
--
-- and handlers will be enabled for files with the appropriate file
-- extensions.
defaultPluginDescriptor :: PluginId -> PluginDescriptor ideState
defaultPluginDescriptor :: forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId =
  forall ideState.
PluginId
-> Natural
-> Rules ()
-> [PluginCommand ideState]
-> PluginHandlers ideState
-> ConfigDescriptor
-> PluginNotificationHandlers ideState
-> DynFlagsModifications
-> Maybe (ParserInfo (IdeCommand ideState))
-> [Text]
-> PluginDescriptor ideState
PluginDescriptor
    PluginId
plId
    Natural
defaultPluginPriority
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    ConfigDescriptor
defaultConfigDescriptor
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. Maybe a
Nothing
    [Text
".hs", Text
".lhs", Text
".hs-boot"]

-- | Set up a plugin descriptor, initialized with default values.
-- This is plugin descriptor is prepared for @.cabal@ files and as such,
-- will only respond / run when @.cabal@ files are currently in scope.
--
-- Handles files with the following extensions:
--   * @.cabal@
defaultCabalPluginDescriptor :: PluginId -> PluginDescriptor ideState
defaultCabalPluginDescriptor :: forall ideState. PluginId -> PluginDescriptor ideState
defaultCabalPluginDescriptor PluginId
plId =
  forall ideState.
PluginId
-> Natural
-> Rules ()
-> [PluginCommand ideState]
-> PluginHandlers ideState
-> ConfigDescriptor
-> PluginNotificationHandlers ideState
-> DynFlagsModifications
-> Maybe (ParserInfo (IdeCommand ideState))
-> [Text]
-> PluginDescriptor ideState
PluginDescriptor
    PluginId
plId
    Natural
defaultPluginPriority
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    ConfigDescriptor
defaultConfigDescriptor
    forall a. Monoid a => a
mempty
    forall a. Monoid a => a
mempty
    forall a. Maybe a
Nothing
    [Text
".cabal"]

newtype CommandId = CommandId T.Text
  deriving (Int -> CommandId -> ShowS
[CommandId] -> ShowS
CommandId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandId] -> ShowS
$cshowList :: [CommandId] -> ShowS
show :: CommandId -> String
$cshow :: CommandId -> String
showsPrec :: Int -> CommandId -> ShowS
$cshowsPrec :: Int -> CommandId -> ShowS
Show, ReadPrec [CommandId]
ReadPrec CommandId
Int -> ReadS CommandId
ReadS [CommandId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CommandId]
$creadListPrec :: ReadPrec [CommandId]
readPrec :: ReadPrec CommandId
$creadPrec :: ReadPrec CommandId
readList :: ReadS [CommandId]
$creadList :: ReadS [CommandId]
readsPrec :: Int -> ReadS CommandId
$creadsPrec :: Int -> ReadS CommandId
Read, CommandId -> CommandId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandId -> CommandId -> Bool
$c/= :: CommandId -> CommandId -> Bool
== :: CommandId -> CommandId -> Bool
$c== :: CommandId -> CommandId -> Bool
Eq, Eq CommandId
CommandId -> CommandId -> Bool
CommandId -> CommandId -> Ordering
CommandId -> CommandId -> CommandId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CommandId -> CommandId -> CommandId
$cmin :: CommandId -> CommandId -> CommandId
max :: CommandId -> CommandId -> CommandId
$cmax :: CommandId -> CommandId -> CommandId
>= :: CommandId -> CommandId -> Bool
$c>= :: CommandId -> CommandId -> Bool
> :: CommandId -> CommandId -> Bool
$c> :: CommandId -> CommandId -> Bool
<= :: CommandId -> CommandId -> Bool
$c<= :: CommandId -> CommandId -> Bool
< :: CommandId -> CommandId -> Bool
$c< :: CommandId -> CommandId -> Bool
compare :: CommandId -> CommandId -> Ordering
$ccompare :: CommandId -> CommandId -> Ordering
Ord)
instance IsString CommandId where
  fromString :: String -> CommandId
fromString = Text -> CommandId
CommandId forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

data PluginCommand ideState = forall a. (FromJSON a) =>
  PluginCommand { forall ideState. PluginCommand ideState -> CommandId
commandId   :: CommandId
                , forall ideState. PluginCommand ideState -> Text
commandDesc :: T.Text
                , ()
commandFunc :: CommandFunction ideState a
                }

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

type CommandFunction ideState a
  = ideState
  -> a
  -> LspM Config (Either ResponseError Value)

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

newtype PluginId = PluginId T.Text
  deriving (Int -> PluginId -> ShowS
[PluginId] -> ShowS
PluginId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PluginId] -> ShowS
$cshowList :: [PluginId] -> ShowS
show :: PluginId -> String
$cshow :: PluginId -> String
showsPrec :: Int -> PluginId -> ShowS
$cshowsPrec :: Int -> PluginId -> ShowS
Show, ReadPrec [PluginId]
ReadPrec PluginId
Int -> ReadS PluginId
ReadS [PluginId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PluginId]
$creadListPrec :: ReadPrec [PluginId]
readPrec :: ReadPrec PluginId
$creadPrec :: ReadPrec PluginId
readList :: ReadS [PluginId]
$creadList :: ReadS [PluginId]
readsPrec :: Int -> ReadS PluginId
$creadsPrec :: Int -> ReadS PluginId
Read, PluginId -> PluginId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PluginId -> PluginId -> Bool
$c/= :: PluginId -> PluginId -> Bool
== :: PluginId -> PluginId -> Bool
$c== :: PluginId -> PluginId -> Bool
Eq, Eq PluginId
PluginId -> PluginId -> Bool
PluginId -> PluginId -> Ordering
PluginId -> PluginId -> PluginId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PluginId -> PluginId -> PluginId
$cmin :: PluginId -> PluginId -> PluginId
max :: PluginId -> PluginId -> PluginId
$cmax :: PluginId -> PluginId -> PluginId
>= :: PluginId -> PluginId -> Bool
$c>= :: PluginId -> PluginId -> Bool
> :: PluginId -> PluginId -> Bool
$c> :: PluginId -> PluginId -> Bool
<= :: PluginId -> PluginId -> Bool
$c<= :: PluginId -> PluginId -> Bool
< :: PluginId -> PluginId -> Bool
$c< :: PluginId -> PluginId -> Bool
compare :: PluginId -> PluginId -> Ordering
$ccompare :: PluginId -> PluginId -> Ordering
Ord)
  deriving newtype (Value -> Parser [PluginId]
Value -> Parser PluginId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PluginId]
$cparseJSONList :: Value -> Parser [PluginId]
parseJSON :: Value -> Parser PluginId
$cparseJSON :: Value -> Parser PluginId
FromJSON, Eq PluginId
Int -> PluginId -> Int
PluginId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: PluginId -> Int
$chash :: PluginId -> Int
hashWithSalt :: Int -> PluginId -> Int
$chashWithSalt :: Int -> PluginId -> Int
Hashable)

instance IsString PluginId where
  fromString :: String -> PluginId
fromString = Text -> PluginId
PluginId forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

configForPlugin :: Config -> PluginId -> PluginConfig
configForPlugin :: Config -> PluginId -> PluginConfig
configForPlugin Config
config (PluginId Text
plugin)
    = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Default a => a
Data.Default.def Text
plugin (Config -> Map Text PluginConfig
plugins Config
config)

-- | Checks that a given plugin is both enabled and the specific feature is
-- enabled
pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig :: (PluginConfig -> Bool) -> PluginId -> Config -> Bool
pluginEnabledConfig PluginConfig -> Bool
f PluginId
pid Config
config = PluginConfig -> Bool
plcGlobalOn PluginConfig
pluginConfig Bool -> Bool -> Bool
&& PluginConfig -> Bool
f PluginConfig
pluginConfig
  where
    pluginConfig :: PluginConfig
pluginConfig = Config -> PluginId -> PluginConfig
configForPlugin Config
config PluginId
pid

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

-- | Format the given Text as a whole or only a @Range@ of it.
-- Range must be relative to the text to format.
-- To format the whole document, read the Text from the file and use 'FormatText'
-- as the FormattingType.
data FormattingType = FormatText
                    | FormatRange Range


type FormattingMethod m =
  ( J.HasOptions (MessageParams m) FormattingOptions
  , J.HasTextDocument (MessageParams m) TextDocumentIdentifier
  , ResponseResult m ~ List TextEdit
  )

type FormattingHandler a
  =  a
  -> FormattingType
  -> T.Text
  -> NormalizedFilePath
  -> FormattingOptions
  -> LspM Config (Either ResponseError (List TextEdit))

mkFormattingHandlers :: forall a. FormattingHandler a -> PluginHandlers a
mkFormattingHandlers :: forall a. FormattingHandler a -> PluginHandlers a
mkFormattingHandlers FormattingHandler a
f = forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentFormatting
STextDocumentFormatting (forall {f :: From} (m :: Method f 'Request).
FormattingMethod m =>
SMethod m -> PluginMethodHandler a m
provider SMethod 'TextDocumentFormatting
STextDocumentFormatting)
                      forall a. Semigroup a => a -> a -> a
<> forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentRangeFormatting
STextDocumentRangeFormatting (forall {f :: From} (m :: Method f 'Request).
FormattingMethod m =>
SMethod m -> PluginMethodHandler a m
provider SMethod 'TextDocumentRangeFormatting
STextDocumentRangeFormatting)
  where
    provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler a m
    provider :: forall {f :: From} (m :: Method f 'Request).
FormattingMethod m =>
SMethod m -> PluginMethodHandler a m
provider SMethod m
m a
ide PluginId
_pid MessageParams m
params
      | Just NormalizedFilePath
nfp <- NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri = do
        Maybe VirtualFile
mf <- forall config (m :: * -> *).
MonadLsp config m =>
NormalizedUri -> m (Maybe VirtualFile)
getVirtualFile forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri
        case Maybe VirtualFile
mf of
          Just VirtualFile
vf -> do
            let typ :: FormattingType
typ = case SMethod m
m of
                  SMethod m
STextDocumentFormatting -> FormattingType
FormatText
                  SMethod m
STextDocumentRangeFormatting -> Range -> FormattingType
FormatRange (MessageParams m
params forall s a. s -> Getting a s a -> a
^. forall s a. HasRange s a => Lens' s a
J.range)
                  SMethod m
_ -> forall a. HasCallStack => String -> a
error String
"mkFormattingHandlers: impossible"
            FormattingHandler a
f a
ide FormattingType
typ (VirtualFile -> Text
virtualFileText VirtualFile
vf) NormalizedFilePath
nfp FormattingOptions
opts
          Maybe VirtualFile
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
$ Text -> ResponseError
responseError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Formatter plugin: could not get file contents for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Uri
uri

      | Bool
otherwise = 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
$ Text -> ResponseError
responseError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Formatter plugin: uriToFilePath failed for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Uri
uri
      where
        uri :: Uri
uri = MessageParams m
params forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri
        opts :: FormattingOptions
opts = MessageParams m
params forall s a. s -> Getting a s a -> a
^. forall s a. HasOptions s a => Lens' s a
J.options

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

responseError :: T.Text -> ResponseError
responseError :: Text -> ResponseError
responseError Text
txt = ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidParams Text
txt forall a. Maybe a
Nothing

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

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

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

otSetUri :: SpanInFlight -> Uri -> IO ()
otSetUri :: SpanInFlight -> Uri -> IO ()
otSetUri SpanInFlight
sp (Uri Text
t) = forall (m :: * -> *).
MonadIO m =>
SpanInFlight -> ByteString -> ByteString -> m ()
setTag SpanInFlight
sp ByteString
"uri" (Text -> ByteString
encodeUtf8 Text
t)

class HasTracing a where
  traceWithSpan :: SpanInFlight -> a -> IO ()
  traceWithSpan SpanInFlight
_ a
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance {-# OVERLAPPABLE #-} (HasTextDocument a doc, HasUri doc Uri) => HasTracing a where
  traceWithSpan :: SpanInFlight -> a -> IO ()
traceWithSpan SpanInFlight
sp a
a = SpanInFlight -> Uri -> IO ()
otSetUri SpanInFlight
sp (a
a forall s a. s -> Getting a s a -> a
^. forall s a. HasTextDocument s a => Lens' s a
J.textDocument forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasUri s a => Lens' s a
J.uri)

instance HasTracing Value
instance HasTracing ExecuteCommandParams
instance HasTracing DidChangeWatchedFilesParams where
  traceWithSpan :: SpanInFlight -> DidChangeWatchedFilesParams -> IO ()
traceWithSpan SpanInFlight
sp DidChangeWatchedFilesParams{List FileEvent
$sel:_changes:DidChangeWatchedFilesParams :: DidChangeWatchedFilesParams -> List FileEvent
_changes :: List FileEvent
_changes} =
      forall (m :: * -> *).
MonadIO m =>
SpanInFlight -> ByteString -> ByteString -> m ()
setTag SpanInFlight
sp ByteString
"changes" (Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show List FileEvent
_changes)
instance HasTracing DidChangeWorkspaceFoldersParams
instance HasTracing DidChangeConfigurationParams
instance HasTracing InitializeParams
instance HasTracing (Maybe InitializedParams)
instance HasTracing WorkspaceSymbolParams where
  traceWithSpan :: SpanInFlight -> WorkspaceSymbolParams -> IO ()
traceWithSpan SpanInFlight
sp (WorkspaceSymbolParams Maybe ProgressToken
_ Maybe ProgressToken
_ Text
query) = forall (m :: * -> *).
MonadIO m =>
SpanInFlight -> ByteString -> ByteString -> m ()
setTag SpanInFlight
sp ByteString
"query" (Text -> ByteString
encodeUtf8 Text
query)
instance HasTracing CallHierarchyIncomingCallsParams
instance HasTracing CallHierarchyOutgoingCallsParams

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

{-# NOINLINE pROCESS_ID #-}
pROCESS_ID :: T.Text
pROCESS_ID :: Text
pROCESS_ID = forall a. IO a -> a
unsafePerformIO IO Text
getPid

mkLspCommand :: PluginId -> CommandId -> T.Text -> Maybe [Value] -> Command
mkLspCommand :: PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
plid CommandId
cn Text
title Maybe [Value]
args' = Text -> Text -> Maybe (List Value) -> Command
Command Text
title Text
cmdId Maybe (List Value)
args
  where
    cmdId :: Text
cmdId = Text -> PluginId -> CommandId -> Text
mkLspCmdId Text
pROCESS_ID PluginId
plid CommandId
cn
    args :: Maybe (List Value)
args = forall a. [a] -> List a
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Value]
args'

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

-- | Get the operating system process id for the running server
-- instance. This should be the same for the lifetime of the instance,
-- and different from that of any other currently running instance.
getPid :: IO T.Text
getPid :: IO Text
getPid = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
getProcessID

getProcessID :: IO Int
installSigUsr1Handler :: IO () -> IO ()

#ifdef mingw32_HOST_OS
getProcessID = fromIntegral <$> P.getCurrentProcessId
installSigUsr1Handler _ = return ()

#else
getProcessID :: IO Int
getProcessID = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ProcessID
P.getProcessID

installSigUsr1Handler :: IO () -> IO ()
installSigUsr1Handler IO ()
h = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigUSR1 (IO () -> Handler
Catch IO ()
h) forall a. Maybe a
Nothing
#endif