module Ide.Plugin.Class (descriptor, Log(..)) where

import           Development.IDE               (IdeState, Recorder,
                                                WithPriority)
import           Ide.Plugin.Class.CodeAction
import           Ide.Plugin.Class.CodeLens
import           Ide.Plugin.Class.Types
import           Ide.Types
import           Language.LSP.Protocol.Message
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides code actions and lenses for working with typeclasses")
    { pluginCommands = commands plId
    , pluginRules = getInstanceBindTypeSigsRule recorder >> getInstanceBindLensRule recorder
    , pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction (codeAction recorder)
        <> mkPluginHandler SMethod_TextDocumentCodeLens codeLens
        <> mkResolveHandler SMethod_CodeLensResolve codeLensResolve
    }

commands :: PluginId -> [PluginCommand IdeState]
commands :: PluginId -> [PluginCommand IdeState]
commands PluginId
plId
  = [ CommandId
-> Text
-> CommandFunction IdeState AddMinimalMethodsParams
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
codeActionCommandId
        Text
"add placeholders for minimal methods" (PluginId -> CommandFunction IdeState AddMinimalMethodsParams
addMethodPlaceholders PluginId
plId)
    , CommandId
-> Text
-> CommandFunction IdeState InstanceBindLensCommand
-> PluginCommand IdeState
forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand CommandId
typeLensCommandId
        Text
"add type signatures for instance methods" (PluginId -> CommandFunction IdeState InstanceBindLensCommand
codeLensCommandHandler PluginId
plId)
    ]