{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings     #-}

-- | Exposes the ghcide features as an HLS plugin
module Development.IDE.Plugin.HLS.GhcIde
  (
    descriptors
  , Log(..)
  ) where

import           Development.IDE
import qualified Development.IDE.LSP.HoverDefinition as Hover
import qualified Development.IDE.LSP.Notifications   as Notifications
import           Development.IDE.LSP.Outline
import qualified Development.IDE.Plugin.Completions  as Completions
import qualified Development.IDE.Plugin.TypeLenses   as TypeLenses
import           Ide.Types
import           Language.LSP.Protocol.Message
import           Language.LSP.Protocol.Types
import           Text.Regex.TDFA.Text                ()

data Log
  = LogNotifications Notifications.Log
  | LogCompletions Completions.Log
  | LogTypeLenses TypeLenses.Log
  | LogHover Hover.Log
  deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogNotifications Log
msg -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg
    LogCompletions Log
msg   -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg
    LogTypeLenses Log
msg    -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg
    LogHover Log
msg         -> Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
msg

descriptors :: Recorder (WithPriority Log) -> [PluginDescriptor IdeState]
descriptors :: Recorder (WithPriority Log) -> [PluginDescriptor IdeState]
descriptors Recorder (WithPriority Log)
recorder =
  [ Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogHover Recorder (WithPriority Log)
recorder) PluginId
"ghcide-hover-and-symbols",
    Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Completions.descriptor ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogCompletions Recorder (WithPriority Log)
recorder) PluginId
"ghcide-completions",
    Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
TypeLenses.descriptor ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogTypeLenses Recorder (WithPriority Log)
recorder) PluginId
"ghcide-type-lenses",
    Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
Notifications.descriptor ((Log -> Log)
-> Recorder (WithPriority Log) -> Recorder (WithPriority Log)
forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogNotifications Recorder (WithPriority Log)
recorder) PluginId
"ghcide-core"
  ]

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

descriptor :: Recorder (WithPriority Hover.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
desc)
  { pluginHandlers = mkPluginHandler SMethod_TextDocumentHover (hover' recorder)
                  <> mkPluginHandler SMethod_TextDocumentDocumentSymbol moduleOutline
                  <> mkPluginHandler SMethod_TextDocumentDefinition (\IdeState
ide PluginId
_ DefinitionParams{Maybe ProgressToken
Position
TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
_workDoneToken :: Maybe ProgressToken
_partialResultToken :: Maybe ProgressToken
$sel:_partialResultToken:DefinitionParams :: DefinitionParams -> Maybe ProgressToken
$sel:_position:DefinitionParams :: DefinitionParams -> Position
$sel:_textDocument:DefinitionParams :: DefinitionParams -> TextDocumentIdentifier
$sel:_workDoneToken:DefinitionParams :: DefinitionParams -> Maybe ProgressToken
..} ->
                      Recorder (WithPriority Log)
-> IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentDefinition)
forall c.
Recorder (WithPriority Log)
-> IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError
     (HandlerM c)
     (MessageResult 'Method_TextDocumentDefinition)
Hover.gotoDefinition Recorder (WithPriority Log)
recorder IdeState
ide TextDocumentPositionParams{Position
TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
$sel:_position:TextDocumentPositionParams :: Position
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
..})
                  <> mkPluginHandler SMethod_TextDocumentTypeDefinition (\IdeState
ide PluginId
_ TypeDefinitionParams{Maybe ProgressToken
Position
TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
_workDoneToken :: Maybe ProgressToken
_partialResultToken :: Maybe ProgressToken
$sel:_partialResultToken:TypeDefinitionParams :: TypeDefinitionParams -> Maybe ProgressToken
$sel:_position:TypeDefinitionParams :: TypeDefinitionParams -> Position
$sel:_textDocument:TypeDefinitionParams :: TypeDefinitionParams -> TextDocumentIdentifier
$sel:_workDoneToken:TypeDefinitionParams :: TypeDefinitionParams -> Maybe ProgressToken
..} ->
                      Recorder (WithPriority Log)
-> IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError
     (HandlerM Config)
     (MessageResult 'Method_TextDocumentTypeDefinition)
forall c.
Recorder (WithPriority Log)
-> IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError
     (HandlerM c)
     (MessageResult 'Method_TextDocumentTypeDefinition)
Hover.gotoTypeDefinition Recorder (WithPriority Log)
recorder IdeState
ide TextDocumentPositionParams{Position
TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
..})
                  <> mkPluginHandler SMethod_TextDocumentDocumentHighlight (\IdeState
ide PluginId
_ DocumentHighlightParams{Maybe ProgressToken
Position
TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
_workDoneToken :: Maybe ProgressToken
_partialResultToken :: Maybe ProgressToken
$sel:_partialResultToken:DocumentHighlightParams :: DocumentHighlightParams -> Maybe ProgressToken
$sel:_position:DocumentHighlightParams :: DocumentHighlightParams -> Position
$sel:_textDocument:DocumentHighlightParams :: DocumentHighlightParams -> TextDocumentIdentifier
$sel:_workDoneToken:DocumentHighlightParams :: DocumentHighlightParams -> Maybe ProgressToken
..} ->
                      Recorder (WithPriority Log)
-> IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError (HandlerM Config) ([DocumentHighlight] |? Null)
forall c.
Recorder (WithPriority Log)
-> IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (HandlerM c) ([DocumentHighlight] |? Null)
Hover.documentHighlight Recorder (WithPriority Log)
recorder IdeState
ide TextDocumentPositionParams{Position
TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
..})
                  <> mkPluginHandler SMethod_TextDocumentReferences (Hover.references recorder)
                  <> mkPluginHandler SMethod_WorkspaceSymbol (Hover.wsSymbols recorder),

    pluginConfigDescriptor = defaultConfigDescriptor
  }
  where
    desc :: Text
desc = Text
"Provides core IDE features for Haskell"

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

hover' :: Recorder (WithPriority Hover.Log) -> PluginMethodHandler IdeState Method_TextDocumentHover
hover' :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentHover
hover' Recorder (WithPriority Log)
recorder IdeState
ideState PluginId
_ HoverParams{Maybe ProgressToken
Position
TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
_workDoneToken :: Maybe ProgressToken
$sel:_position:HoverParams :: HoverParams -> Position
$sel:_textDocument:HoverParams :: HoverParams -> TextDocumentIdentifier
$sel:_workDoneToken:HoverParams :: HoverParams -> Maybe ProgressToken
..} =
    Recorder (WithPriority Log)
-> IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (HandlerM Config) (Hover |? Null)
forall c.
Recorder (WithPriority Log)
-> IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (HandlerM c) (Hover |? Null)
Hover.hover Recorder (WithPriority Log)
recorder IdeState
ideState TextDocumentPositionParams{Position
TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
..}