module Development.IDE.Plugin(Plugin(..), codeActionPlugin, codeActionPluginWithRules,makeLspCommandId,getPid) where

import Data.Default
import qualified Data.Text as T
import Development.Shake
import Development.IDE.LSP.Server

import           Language.Haskell.LSP.Types
import Development.IDE.Compat
import Development.IDE.Core.Rules
import qualified Language.Haskell.LSP.Core as LSP
import Language.Haskell.LSP.Messages


data Plugin c = Plugin
    {Plugin c -> Rules ()
pluginRules :: Rules ()
    ,Plugin c -> PartialHandlers c
pluginHandler :: PartialHandlers c
    }

instance Default (Plugin c) where
    def :: Plugin c
def = Rules () -> PartialHandlers c -> Plugin c
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
forall a. Monoid a => a
mempty PartialHandlers c
forall a. Default a => a
def

instance Semigroup (Plugin c) where
    Plugin Rules ()
x1 PartialHandlers c
y1 <> :: Plugin c -> Plugin c -> Plugin c
<> Plugin Rules ()
x2 PartialHandlers c
y2 = Rules () -> PartialHandlers c -> Plugin c
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin (Rules ()
x1Rules () -> Rules () -> Rules ()
forall a. Semigroup a => a -> a -> a
<>Rules ()
x2) (PartialHandlers c
y1PartialHandlers c -> PartialHandlers c -> PartialHandlers c
forall a. Semigroup a => a -> a -> a
<>PartialHandlers c
y2)

instance Monoid (Plugin c) where
    mempty :: Plugin c
mempty = Plugin c
forall a. Default a => a
def


codeActionPlugin :: (LSP.LspFuncs c -> IdeState -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO (Either ResponseError [CAResult])) -> Plugin c
codeActionPlugin :: (LspFuncs c
 -> IdeState
 -> TextDocumentIdentifier
 -> Range
 -> CodeActionContext
 -> IO (Either ResponseError [CAResult]))
-> Plugin c
codeActionPlugin = Rules ()
-> (LspFuncs c
    -> IdeState
    -> TextDocumentIdentifier
    -> Range
    -> CodeActionContext
    -> IO (Either ResponseError [CAResult]))
-> Plugin c
forall c.
Rules ()
-> (LspFuncs c
    -> IdeState
    -> TextDocumentIdentifier
    -> Range
    -> CodeActionContext
    -> IO (Either ResponseError [CAResult]))
-> Plugin c
codeActionPluginWithRules Rules ()
forall a. Monoid a => a
mempty

codeActionPluginWithRules :: Rules () -> (LSP.LspFuncs c -> IdeState -> TextDocumentIdentifier -> Range -> CodeActionContext -> IO (Either ResponseError [CAResult])) -> Plugin c
codeActionPluginWithRules :: Rules ()
-> (LspFuncs c
    -> IdeState
    -> TextDocumentIdentifier
    -> Range
    -> CodeActionContext
    -> IO (Either ResponseError [CAResult]))
-> Plugin c
codeActionPluginWithRules Rules ()
rr LspFuncs c
-> IdeState
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError [CAResult])
f = Rules () -> PartialHandlers c -> Plugin c
forall c. Rules () -> PartialHandlers c -> Plugin c
Plugin Rules ()
rr (PartialHandlers c -> Plugin c) -> PartialHandlers c -> Plugin c
forall a b. (a -> b) -> a -> b
$ (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x{
    codeActionHandler :: Maybe (Handler CodeActionRequest)
LSP.codeActionHandler = (ResponseMessage (List CAResult) -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> CodeActionParams
    -> IO (Either ResponseError (List CAResult)))
-> Maybe (Handler CodeActionRequest)
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
withResponse ResponseMessage (List CAResult) -> FromServerMessage
RspCodeAction LspFuncs c
-> IdeState
-> CodeActionParams
-> IO (Either ResponseError (List CAResult))
g
    }
    where
      g :: LspFuncs c
-> IdeState
-> CodeActionParams
-> IO (Either ResponseError (List CAResult))
g LspFuncs c
lsp IdeState
state (CodeActionParams TextDocumentIdentifier
a Range
b CodeActionContext
c Maybe ProgressToken
_) = ([CAResult] -> List CAResult)
-> Either ResponseError [CAResult]
-> Either ResponseError (List CAResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [CAResult] -> List CAResult
forall a. [a] -> List a
List (Either ResponseError [CAResult]
 -> Either ResponseError (List CAResult))
-> IO (Either ResponseError [CAResult])
-> IO (Either ResponseError (List CAResult))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LspFuncs c
-> IdeState
-> TextDocumentIdentifier
-> Range
-> CodeActionContext
-> IO (Either ResponseError [CAResult])
f LspFuncs c
lsp IdeState
state TextDocumentIdentifier
a Range
b CodeActionContext
c

-- | Prefix to uniquely identify commands sent to the client.  This
-- has two parts
--
-- - A representation of the process id to make sure that a client has
--   unique commands if it is running multiple servers, since some
--   clients have a global command table and get confused otherwise.
--
-- - A string to identify ghcide, to ease integration into
--   haskell-language-server, which routes commands to plugins based
--   on that.
makeLspCommandId :: T.Text -> IO T.Text
makeLspCommandId :: Text -> IO Text
makeLspCommandId Text
command = do
    Text
pid <- IO Text
getPid
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text
pid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":ghcide:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
command

-- | 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 (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> IO Int -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
getProcessID