Skip to content

Commit

Permalink
port default plugins
Browse files Browse the repository at this point in the history
  • Loading branch information
@wz1000
wz1000 committed Feb 6, 2021
1 parent a60921c commit d40753b
Show file tree
Hide file tree
Showing 8 changed files with 117 additions and 135 deletions.
47 changes: 26 additions & 21 deletions plugins/default/src/Ide/Plugin/Example.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,8 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}

module Ide.Plugin.Example
(
Expand All @@ -30,25 +32,27 @@ import GHC.Generics
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Types
import Language.LSP.Server
import Text.Regex.TDFA.Text()
import Control.Monad.IO.Class

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

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId = (defaultPluginDescriptor plId)
{ pluginRules = exampleRules
, pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]
, pluginCodeActionProvider = Just codeAction
, pluginCodeLensProvider = Just codeLens
, pluginHoverProvider = Just hover
, pluginSymbolsProvider = Just symbols
, pluginCompletionProvider = Just completion
, pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction
<> mkPluginHandler STextDocumentCodeLens codeLens
<> mkPluginHandler STextDocumentHover hover
<> mkPluginHandler STextDocumentDocumentSymbol symbols
<> mkPluginHandler STextDocumentCompletion completion
}

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

hover :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
hover = request "Hover" blah (Right Nothing) foundHover
hover :: PluginMethodHandler IdeState TextDocumentHover
hover ide _ HoverParams{..} = liftIO $ request "Hover" blah (Right Nothing) foundHover ide TextDocumentPositionParams{..}

blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))
blah _ (Position line col)
Expand Down Expand Up @@ -99,8 +103,8 @@ mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)
-- ---------------------------------------------------------------------

-- | Generate code actions.
codeAction :: CodeActionProvider IdeState
codeAction _lf state _pid (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs} = do
codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction
codeAction state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs}) = liftIO $ do
let Just nfp = uriToNormalizedFilePath $ toNormalizedUri uri
Just (ParsedModule{},_) <- runIdeAction "example" (shakeExtras state) $ useWithStaleFast GetParsedModule nfp
let
Expand All @@ -109,12 +113,12 @@ codeAction _lf state _pid (TextDocumentIdentifier uri) _range CodeActionContext{
"-- TODO1 added by Example Plugin directly\n"]
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
pure $ Right $ List
[ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) (Just edit) Nothing ]
[ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing]

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

codeLens :: CodeLensProvider IdeState
codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens
codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do
logInfo (ideLogger ideState) "Example.codeLens entered (ideLogger)" -- AZ
case uriToFilePath' uri of
Just (toNormalizedFilePath -> filePath) -> do
Expand All @@ -141,7 +145,7 @@ data AddTodoParams = AddTodoParams
deriving (Show, Eq, Generic, ToJSON, FromJSON)

addTodoCmd :: CommandFunction IdeState AddTodoParams
addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
addTodoCmd _ide (AddTodoParams uri todoText) = do
let
pos = Position 3 0
textEdits = List
Expand All @@ -151,7 +155,8 @@ addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
res = WorkspaceEdit
(Just $ Map.singleton uri textEdits)
Nothing
return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res))
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ())
return $ Right Null

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

Expand All @@ -170,7 +175,7 @@ request
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError b)
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = do
mbResult <- case uriToFilePath' uri of
Just path -> logAndRunRequest label getResults ide pos path
Nothing -> pure Nothing
Expand All @@ -187,9 +192,9 @@ logAndRunRequest label getResults ide pos path = do

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

symbols :: SymbolsProvider IdeState
symbols _lf _ide (DocumentSymbolParams _doc _mt)
= pure $ Right [r]
symbols :: PluginMethodHandler IdeState TextDocumentDocumentSymbol
symbols _ide _pid (DocumentSymbolParams _ _ _doc)
= pure $ Right $ InL $ List [r]
where
r = DocumentSymbol name detail kind deprecation range selR chList
name = "Example_symbol_name"
Expand All @@ -202,9 +207,9 @@ symbols _lf _ide (DocumentSymbolParams _doc _mt)

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

completion :: CompletionProvider IdeState
completion _lf _ide (CompletionParams _doc _pos _mctxt _mt)
= pure $ Right $ Completions $ List [r]
completion :: PluginMethodHandler IdeState TextDocumentCompletion
completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt)
= pure $ Right $ InL $ List [r]
where
r = CompletionItem label kind tags detail documentation deprecated preselect
sortText filterText insertText insertTextFormat
Expand Down
47 changes: 26 additions & 21 deletions plugins/default/src/Ide/Plugin/Example2.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,8 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}

module Ide.Plugin.Example2
(
Expand All @@ -29,25 +31,27 @@ import GHC.Generics
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Types
import Language.LSP.Server
import Text.Regex.TDFA.Text()
import Control.Monad.IO.Class

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

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId = (defaultPluginDescriptor plId)
{ pluginRules = exampleRules
, pluginCommands = [PluginCommand "codelens.todo" "example adding" addTodoCmd]
, pluginCodeActionProvider = Just codeAction
, pluginCodeLensProvider = Just codeLens
, pluginHoverProvider = Just hover
, pluginSymbolsProvider = Just symbols
, pluginCompletionProvider = Just completion
, pluginHandlers = mkPluginHandler STextDocumentCodeAction codeAction
<> mkPluginHandler STextDocumentCodeLens codeLens
<> mkPluginHandler STextDocumentHover hover
<> mkPluginHandler STextDocumentDocumentSymbol symbols
<> mkPluginHandler STextDocumentCompletion completion
}

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

hover :: IdeState -> TextDocumentPositionParams -> IO (Either ResponseError (Maybe Hover))
hover = request "Hover" blah (Right Nothing) foundHover
hover :: PluginMethodHandler IdeState TextDocumentHover
hover ide _ HoverParams{..} = liftIO $ request "Hover" blah (Right Nothing) foundHover ide TextDocumentPositionParams{..}

blah :: NormalizedFilePath -> Position -> Action (Maybe (Maybe Range, [T.Text]))
blah _ (Position line col)
Expand Down Expand Up @@ -98,20 +102,20 @@ mkDiag file diagSource sev loc msg = (file, D.ShowDiag,)
-- ---------------------------------------------------------------------

-- | Generate code actions.
codeAction :: CodeActionProvider IdeState
codeAction _lf _state _pid (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs} = do
codeAction :: PluginMethodHandler IdeState TextDocumentCodeAction
codeAction _state _pid (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=List _xs}) = do
let
title = "Add TODO2 Item"
tedit = [TextEdit (Range (Position 3 0) (Position 3 0))
"-- TODO2 added by Example2 Plugin directly\n"]
edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
pure $ Right $ List
[ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) (Just edit) Nothing ]
[ InR $ CodeAction title (Just CodeActionQuickFix) (Just $ List []) Nothing Nothing (Just edit) Nothing ]

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

codeLens :: CodeLensProvider IdeState
codeLens _lf ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = do
codeLens :: PluginMethodHandler IdeState TextDocumentCodeLens
codeLens ideState plId CodeLensParams{_textDocument=TextDocumentIdentifier uri} = liftIO $ do
logInfo (ideLogger ideState) "Example2.codeLens entered (ideLogger)" -- AZ
case uriToFilePath' uri of
Just (toNormalizedFilePath -> filePath) -> do
Expand All @@ -135,7 +139,7 @@ data AddTodoParams = AddTodoParams
deriving (Show, Eq, Generic, ToJSON, FromJSON)

addTodoCmd :: CommandFunction IdeState AddTodoParams
addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
addTodoCmd _ide (AddTodoParams uri todoText) = do
let
pos = Position 5 0
textEdits = List
Expand All @@ -145,7 +149,8 @@ addTodoCmd _lf _ide (AddTodoParams uri todoText) = do
res = WorkspaceEdit
(Just $ Map.singleton uri textEdits)
Nothing
return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res))
_ <- sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing res) (\_ -> pure ())
return $ Right Null

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

Expand All @@ -164,7 +169,7 @@ request
-> IdeState
-> TextDocumentPositionParams
-> IO (Either ResponseError b)
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos _) = do
request label getResults notFound found ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = do
mbResult <- case uriToFilePath' uri of
Just path -> logAndRunRequest label getResults ide pos path
Nothing -> pure Nothing
Expand All @@ -181,9 +186,9 @@ logAndRunRequest label getResults ide pos path = do

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

symbols :: SymbolsProvider IdeState
symbols _lf _ide (DocumentSymbolParams _doc _mt)
= pure $ Right [r]
symbols :: PluginMethodHandler IdeState TextDocumentDocumentSymbol
symbols _ide _ (DocumentSymbolParams _ _ _doc)
= pure $ Right $ InL $ List [r]
where
r = DocumentSymbol name detail kind deprecation range selR chList
name = "Example2_symbol_name"
Expand All @@ -196,9 +201,9 @@ symbols _lf _ide (DocumentSymbolParams _doc _mt)

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

completion :: CompletionProvider IdeState
completion _lf _ide (CompletionParams _doc _pos _mctxt _mt)
= pure $ Right $ Completions $ List [r]
completion :: PluginMethodHandler IdeState TextDocumentCompletion
completion _ide _pid (CompletionParams _doc _pos _ _ _mctxt)
= pure $ Right $ InL $ List [r]
where
r = CompletionItem label kind tags detail documentation deprecated preselect
sortText filterText insertText insertTextFormat
Expand Down
9 changes: 5 additions & 4 deletions plugins/default/src/Ide/Plugin/Floskell.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,27 +11,28 @@ where
import qualified Data.ByteString.Lazy as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Development.IDE as D
import Development.IDE as D hiding (pluginHandlers)
import Floskell
import Ide.PluginUtils
import Ide.Types
import Language.LSP.Types
import Text.Regex.TDFA.Text()
import Control.Monad.IO.Class

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

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId = (defaultPluginDescriptor plId)
{ pluginFormattingProvider = Just provider
{ pluginHandlers = mkFormattingHandlers provider
}

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

-- | Format provider of Floskell.
-- Formats the given source in either a given Range or the whole Document.
-- If the provider fails an error is returned that can be displayed to the user.
provider :: FormattingProvider IdeState IO
provider _lf _ideState typ contents fp _ = do
provider :: FormattingHandler IdeState
provider _ideState typ contents fp _ = liftIO $ do
let file = fromNormalizedFilePath fp
config <- findConfigOrDefault file
let (range, selectedContents) = case typ of
Expand Down
36 changes: 15 additions & 21 deletions plugins/default/src/Ide/Plugin/Fourmolu.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,7 @@ import System.FilePath

import Control.Lens ((^.))
import qualified Data.Text as T
import Development.IDE as D
import Development.IDE as D hiding (pluginHandlers)
import qualified DynFlags as D
import qualified EnumSet as S
import GHC (DynFlags, moduleNameString)
Expand All @@ -28,23 +28,24 @@ import Language.LSP.Server
import Language.LSP.Types
import Language.LSP.Types.Lens
import "fourmolu" Ormolu
import Control.Monad.IO.Class

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

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor plId =
(defaultPluginDescriptor plId)
{ pluginFormattingProvider = Just provider
{ pluginHandlers = mkFormattingHandlers provider
}

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

provider :: FormattingProvider IdeState IO
provider lf ideState typ contents fp fo = withIndefiniteProgress lf title Cancellable $ do
ghc <- runAction "Fourmolu" ideState $ use GhcSession fp
provider :: FormattingHandler IdeState
provider ideState typ contents fp fo = withIndefiniteProgress title Cancellable $ do
ghc <- liftIO $ runAction "Fourmolu" ideState $ use GhcSession fp
fileOpts <- case hsc_dflags . hscEnv <$> ghc of
Nothing -> return []
Just df -> convertDynFlags df
Just df -> liftIO $ convertDynFlags df

let format printerOpts =
mapLeft (responseError . ("Fourmolu: " <>) . T.pack . show)
Expand All @@ -61,29 +62,22 @@ provider lf ideState typ contents fp fo = withIndefiniteProgress lf title Cancel
defaultPrinterOpts
}

loadConfigFile fp' >>= \case
ConfigLoaded file opts -> do
liftIO (loadConfigFile fp') >>= \case
ConfigLoaded file opts -> liftIO $ do
putStrLn $ "Loaded Fourmolu config from: " <> file
format opts
ConfigNotFound searchDirs -> do
ConfigNotFound searchDirs -> liftIO $ do
putStrLn
. unlines
$ ("No " ++ show configFileName ++ " found in any of:") :
map (" " ++) searchDirs
format mempty
ConfigParseError f (_, err) -> do
sendFunc lf . ReqShowMessage $
RequestMessage
{ _jsonrpc = ""
, _id = IdString "fourmolu"
, _method = WindowShowMessageRequest
, _params =
ShowMessageRequestParams
{ _xtype = MtError
, _message = errorMessage
, _actions = Nothing
}
}
sendNotification SWindowShowMessage $
ShowMessageParams
{ _xtype = MtError
, _message = errorMessage
}
return . Left $ responseError errorMessage
where
errorMessage = "Failed to load " <> T.pack f <> ": " <> T.pack err
Expand Down
Loading

0 comments on commit d40753b

Please sign in to comment.