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

-- | Exposes the ghcide features as an HLS plugin
module Development.IDE.Plugin.HLS.GhcIde
  (
    descriptors
  , Log(..)
  ) where
import           Control.Monad.IO.Class
import           Development.IDE
import           Development.IDE.LSP.HoverDefinition
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
  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

descriptors :: Recorder (WithPriority Log) -> [PluginDescriptor IdeState]
descriptors :: Recorder (WithPriority Log) -> [PluginDescriptor IdeState]
descriptors Recorder (WithPriority Log)
recorder =
  [ PluginId -> PluginDescriptor IdeState
descriptor 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 :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
desc)
  { pluginHandlers = mkPluginHandler SMethod_TextDocumentHover hover'
                  <> 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
..} ->
                      IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError
     (LspM Config)
     (MessageResult 'Method_TextDocumentDefinition)
forall c.
IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError (LspM c) (MessageResult 'Method_TextDocumentDefinition)
gotoDefinition 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
..} ->
                      IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError
     (LspM Config)
     (MessageResult 'Method_TextDocumentTypeDefinition)
forall c.
IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError
     (LspM c)
     (MessageResult 'Method_TextDocumentTypeDefinition)
gotoTypeDefinition 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
..} ->
                      IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (LspM Config) ([DocumentHighlight] |? Null)
forall c.
IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (LspM c) ([DocumentHighlight] |? Null)
documentHighlight IdeState
ide TextDocumentPositionParams{Position
TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
..})
                  <> mkPluginHandler SMethod_TextDocumentReferences references
                  <> mkPluginHandler SMethod_WorkspaceSymbol wsSymbols,

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

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

hover' :: PluginMethodHandler IdeState Method_TextDocumentHover
hover' :: PluginMethodHandler IdeState 'Method_TextDocumentHover
hover' 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
..} = do
    IO () -> ExceptT PluginError (LspM Config) ()
forall a. IO a -> ExceptT PluginError (LspM Config) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT PluginError (LspM Config) ())
-> IO () -> ExceptT PluginError (LspM Config) ()
forall a b. (a -> b) -> a -> b
$ Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ideState) Text
"GhcIde.hover entered (ideLogger)" -- AZ
    IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (LspM Config) (Hover |? Null)
forall c.
IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (LspM c) (Hover |? Null)
hover IdeState
ideState TextDocumentPositionParams{Position
TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
_position :: Position
..}