{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogNotifications Log
msg -> forall a ann. Pretty a => a -> Doc ann
pretty Log
msg
    LogCompletions Log
msg   -> forall a ann. Pretty a => a -> Doc ann
pretty Log
msg
    LogTypeLenses Log
msg    -> forall a ann. Pretty a => a -> 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 (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 (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 (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 = (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
  { $sel:pluginHandlers:PluginDescriptor :: PluginHandlers IdeState
pluginHandlers = forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentHover
SMethod_TextDocumentHover PluginMethodHandler IdeState 'Method_TextDocumentHover
hover'
                  forall a. Semigroup a => a -> a -> a
<> forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentDocumentSymbol
SMethod_TextDocumentDocumentSymbol PluginMethodHandler IdeState 'Method_TextDocumentDocumentSymbol
moduleOutline
                  forall a. Semigroup a => a -> a -> a
<> forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentDefinition
SMethod_TextDocumentDefinition (\IdeState
ide PluginId
_ DefinitionParams{Maybe ProgressToken
Position
TextDocumentIdentifier
$sel:_textDocument:DefinitionParams :: DefinitionParams -> TextDocumentIdentifier
$sel:_position:DefinitionParams :: DefinitionParams -> Position
$sel:_workDoneToken:DefinitionParams :: DefinitionParams -> Maybe ProgressToken
$sel:_partialResultToken:DefinitionParams :: DefinitionParams -> Maybe ProgressToken
_partialResultToken :: Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken
_position :: Position
_textDocument :: TextDocumentIdentifier
..} ->
                      forall c.
IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError (LspM c) (MessageResult 'Method_TextDocumentDefinition)
gotoDefinition IdeState
ide TextDocumentPositionParams{Position
TextDocumentIdentifier
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
_position :: Position
_textDocument :: TextDocumentIdentifier
..})
                  forall a. Semigroup a => a -> a -> a
<> forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentTypeDefinition
SMethod_TextDocumentTypeDefinition (\IdeState
ide PluginId
_ TypeDefinitionParams{Maybe ProgressToken
Position
TextDocumentIdentifier
$sel:_textDocument:TypeDefinitionParams :: TypeDefinitionParams -> TextDocumentIdentifier
$sel:_position:TypeDefinitionParams :: TypeDefinitionParams -> Position
$sel:_workDoneToken:TypeDefinitionParams :: TypeDefinitionParams -> Maybe ProgressToken
$sel:_partialResultToken:TypeDefinitionParams :: TypeDefinitionParams -> Maybe ProgressToken
_partialResultToken :: Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken
_position :: Position
_textDocument :: TextDocumentIdentifier
..} ->
                      forall c.
IdeState
-> TextDocumentPositionParams
-> ExceptT
     PluginError
     (LspM c)
     (MessageResult 'Method_TextDocumentTypeDefinition)
gotoTypeDefinition IdeState
ide TextDocumentPositionParams{Position
TextDocumentIdentifier
_position :: Position
_textDocument :: TextDocumentIdentifier
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
..})
                  forall a. Semigroup a => a -> a -> a
<> forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentDocumentHighlight
SMethod_TextDocumentDocumentHighlight (\IdeState
ide PluginId
_ DocumentHighlightParams{Maybe ProgressToken
Position
TextDocumentIdentifier
$sel:_textDocument:DocumentHighlightParams :: DocumentHighlightParams -> TextDocumentIdentifier
$sel:_position:DocumentHighlightParams :: DocumentHighlightParams -> Position
$sel:_workDoneToken:DocumentHighlightParams :: DocumentHighlightParams -> Maybe ProgressToken
$sel:_partialResultToken:DocumentHighlightParams :: DocumentHighlightParams -> Maybe ProgressToken
_partialResultToken :: Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken
_position :: Position
_textDocument :: TextDocumentIdentifier
..} ->
                      forall c.
IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (LspM c) ([DocumentHighlight] |? Null)
documentHighlight IdeState
ide TextDocumentPositionParams{Position
TextDocumentIdentifier
_position :: Position
_textDocument :: TextDocumentIdentifier
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
..})
                  forall a. Semigroup a => a -> a -> a
<> forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentReferences
SMethod_TextDocumentReferences PluginMethodHandler IdeState 'Method_TextDocumentReferences
references
                  forall a. Semigroup a => a -> a -> a
<> forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_WorkspaceSymbol
SMethod_WorkspaceSymbol PluginMethodHandler IdeState 'Method_WorkspaceSymbol
wsSymbols,

    $sel:pluginConfigDescriptor:PluginDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor
  }

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

hover' :: PluginMethodHandler IdeState Method_TextDocumentHover
hover' :: PluginMethodHandler IdeState 'Method_TextDocumentHover
hover' IdeState
ideState PluginId
_ HoverParams{Maybe ProgressToken
Position
TextDocumentIdentifier
$sel:_textDocument:HoverParams :: HoverParams -> TextDocumentIdentifier
$sel:_position:HoverParams :: HoverParams -> Position
$sel:_workDoneToken:HoverParams :: HoverParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken
_position :: Position
_textDocument :: TextDocumentIdentifier
..} = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ideState) Text
"GhcIde.hover entered (ideLogger)" -- AZ
    forall c.
IdeState
-> TextDocumentPositionParams
-> ExceptT PluginError (LspM c) (Hover |? Null)
hover IdeState
ideState TextDocumentPositionParams{Position
TextDocumentIdentifier
_position :: Position
_textDocument :: TextDocumentIdentifier
$sel:_textDocument:TextDocumentPositionParams :: TextDocumentIdentifier
$sel:_position:TextDocumentPositionParams :: Position
..}