From 70011f281b0a2e58942dcc133a4a91f6c947de9e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 4 Jul 2021 21:48:44 +0100 Subject: [PATCH 1/6] turn into subcommands and move to Default.Main --- ghcide/exe/Arguments.hs | 22 +++++++++------------- ghcide/exe/Main.hs | 8 -------- ghcide/ghcide.cabal | 2 +- ghcide/src/Development/IDE/Main.hs | 17 +++++++++++++++++ src/Ide/Arguments.hs | 13 +------------ 5 files changed, 28 insertions(+), 34 deletions(-) diff --git a/ghcide/exe/Arguments.hs b/ghcide/exe/Arguments.hs index d88225ff5b..398bb730f6 100644 --- a/ghcide/exe/Arguments.hs +++ b/ghcide/exe/Arguments.hs @@ -7,17 +7,15 @@ import Development.IDE.Main (Command (..), commandP) import Options.Applicative data Arguments = Arguments - {argsCwd :: Maybe FilePath - ,argsVersion :: Bool - ,argsVSCodeExtensionSchema :: Bool - ,argsDefaultConfig :: Bool - ,argsShakeProfiling :: Maybe FilePath - ,argsOTMemoryProfiling :: Bool - ,argsTesting :: Bool - ,argsDisableKick :: Bool - ,argsThreads :: Int - ,argsVerbose :: Bool - ,argsCommand :: Command + {argsCwd :: Maybe FilePath + ,argsVersion :: Bool + ,argsShakeProfiling :: Maybe FilePath + ,argsOTMemoryProfiling :: Bool + ,argsTesting :: Bool + ,argsDisableKick :: Bool + ,argsThreads :: Int + ,argsVerbose :: Bool + ,argsCommand :: Command } getArguments :: IO Arguments @@ -31,8 +29,6 @@ arguments :: Parser Arguments arguments = Arguments <$> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory") <*> switch (long "version" <> help "Show ghcide and GHC versions") - <*> switch (long "vscode-extension-schema" <> help "Print generic config schema for plugins (used in the package.json of haskell vscode extension)") - <*> switch (long "generate-default-config" <> help "Print config supported by the server with default values") <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory") <*> switch (long "ot-memory-profiling" <> help "Record OpenTelemetry info to the eventlog. Needs the -l RTS flag to have an effect") <*> switch (long "test" <> help "Enable additional lsp messages used by the testsuite") diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 472798e99b..9e586fb82a 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -60,14 +60,6 @@ main = do let hlsPlugins = pluginDescToIdePlugins GhcIde.descriptors - when argsVSCodeExtensionSchema $ do - LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToVSCodeExtensionSchema hlsPlugins - exitSuccess - - when argsDefaultConfig $ do - LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToDefaultConfig hlsPlugins - exitSuccess - whenJust argsCwd IO.setCurrentDirectory -- lock to avoid overlapping output on stdout diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 7183c30493..a00d81dcca 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -34,6 +34,7 @@ library default-language: Haskell2010 build-depends: aeson, + aeson-pretty array, async, base == 4.*, @@ -286,7 +287,6 @@ executable ghcide hls-graph, text, unordered-containers, - aeson-pretty other-modules: Arguments Paths_ghcide diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 1003b32c6e..6b4361a7f5 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -13,6 +13,7 @@ import Control.Exception.Safe (Exception (displayExcept catchAny) import Control.Monad.Extra (concatMapM, unless, when) +import qualified Data.Aeson.Encode.Pretty as A import Data.Default (Default (def)) import Data.Foldable (traverse_) import qualified Data.HashMap.Strict as HashMap @@ -21,6 +22,7 @@ import Data.List.Extra (intercalate, isPrefixOf, nub, nubOrd, partition) import Data.Maybe (catMaybes, isJust) import qualified Data.Text as T +import qualified Data.Text.IO as LT import qualified Data.Text.IO as T import Development.IDE (Action, Rules, hDuplicateTo') @@ -97,6 +99,8 @@ data Command | Db {projectRoot :: FilePath, hieOptions :: HieDb.Options, hieCommand :: HieDb.Command} -- ^ Run a command in the hiedb | LSP -- ^ Run the LSP server + | PrintExtensionSchema + | PrintDefaultConfig | Custom {projectRoot :: FilePath, ideCommand :: IdeCommand} -- ^ User defined deriving Show @@ -116,12 +120,20 @@ commandP :: Parser Command commandP = hsubparser (command "typecheck" (info (Check <$> fileCmd) fileInfo) <> command "hiedb" (info (Db "." <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo) <> command "lsp" (info (pure LSP <**> helper) lspInfo) + <> command "vscode-extension-schema" extensionSchemaCommand + <> command "generate-default-config" generateDefaultConfigCommand ) where fileCmd = many (argument str (metavar "FILES/DIRS...")) lspInfo = fullDesc <> progDesc "Start talking to an LSP client" fileInfo = fullDesc <> progDesc "Used as a test bed to check your IDE will work" hieInfo = fullDesc <> progDesc "Query .hie files" + extensionSchemaCommand = + info (pure PrintExtensionSchema) + (fullDesc <> progDesc "Print generic config schema for plugins (used in the package.json of haskell vscode extension)") + generateDefaultConfigCommand = + info (pure PrintDefaultConfig) + (fullDesc <> progDesc "Print config supported by the server with default values") data Arguments = Arguments @@ -198,6 +210,10 @@ defaultMain Arguments{..} = do outH <- argsHandleOut case argCommand of + PrintExtensionSchema -> + LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToVSCodeExtensionSchema hlsPlugins + PrintDefaultConfig -> + LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToDefaultConfig hlsPlugins LSP -> do t <- offsetTime hPutStrLn stderr "Starting LSP server..." @@ -310,6 +326,7 @@ defaultMain Arguments{..} = do case mlibdir of Nothing -> exitWith $ ExitFailure 1 Just libdir -> HieDb.runCommand libdir opts{HieDb.database = dbLoc} cmd + Custom projectRoot (IdeCommand c) -> do dbLoc <- getHieDbLoc projectRoot runWithDb dbLoc $ \hiedb hieChan -> do diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs index 4863c8edc1..833e8fc86e 100644 --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -64,8 +64,7 @@ getArguments exeName = execParser opts <|> probeToolsParser exeName <|> BiosMode <$> biosParser <|> Ghcide <$> arguments - <|> vsCodeExtensionSchemaModeParser - <|> defaultConfigurationModeParser) + ) <**> helper) ( fullDesc <> progDesc "Used as a test bed to check your IDE Client will work" @@ -89,16 +88,6 @@ probeToolsParser exeName = flag' ProbeToolsMode (long "probe-tools" <> help ("Show " ++ exeName ++ " version and other tools of interest")) -vsCodeExtensionSchemaModeParser :: Parser Arguments -vsCodeExtensionSchemaModeParser = - flag' VSCodeExtensionSchemaMode - (long "vscode-extension-schema" <> help "Print generic config schema for plugins (used in the package.json of haskell vscode extension)") - -defaultConfigurationModeParser :: Parser Arguments -defaultConfigurationModeParser = - flag' DefaultConfigurationMode - (long "generate-default-config" <> help "Print config supported by the server with default values") - arguments :: Parser GhcideArguments arguments = GhcideArguments <$> (commandP <|> lspCommand <|> checkCommand) From b16328c071bf71feca6b9f55c051697e9f7d8bee Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 4 Jul 2021 21:49:52 +0100 Subject: [PATCH 2/6] remove redundant logger --- ghcide/exe/Main.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 9e586fb82a..818c7d89b3 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -62,17 +62,9 @@ main = do whenJust argsCwd IO.setCurrentDirectory - -- lock to avoid overlapping output on stdout - lock <- newLock - let logger = Logger $ \pri msg -> when (pri >= logLevel) $ withLock lock $ - T.putStrLn $ T.pack ("[" ++ upper (show pri) ++ "] ") <> msg - logLevel = if argsVerbose then minBound else Info - Main.defaultMain def {Main.argCommand = argsCommand - ,Main.argsLogger = pure logger - ,Main.argsRules = do -- install the main and ghcide-plugin rules mainRule From 8122aff3284a5a63841237f8a62f49d79fc72d39 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 4 Jul 2021 22:03:38 +0100 Subject: [PATCH 3/6] fixup subcommands --- ghcide/exe/Main.hs | 16 ++-------------- ghcide/ghcide.cabal | 2 +- ghcide/src/Development/IDE/Main.hs | 9 ++++++--- 3 files changed, 9 insertions(+), 18 deletions(-) diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 818c7d89b3..73ae1a722e 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -7,19 +7,11 @@ module Main(main) where import Arguments (Arguments (..), getArguments) -import Control.Concurrent.Extra (newLock, withLock) -import Control.Monad.Extra (unless, when, whenJust) -import qualified Data.Aeson.Encode.Pretty as A +import Control.Monad.Extra (unless, whenJust) import Data.Default (Default (def)) -import Data.List.Extra (upper) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Data.Text.Lazy.Encoding (decodeUtf8) -import qualified Data.Text.Lazy.IO as LT import Data.Version (showVersion) import Development.GitRev (gitHash) -import Development.IDE (Logger (Logger), - Priority (Info), action) +import Development.IDE (action) import Development.IDE.Core.OfInterest (kick) import Development.IDE.Core.Rules (mainRule) import Development.IDE.Graph (ShakeOptions (shakeThreads)) @@ -28,8 +20,6 @@ import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde import qualified Development.IDE.Plugin.Test as Test import Development.IDE.Types.Options import Ide.Plugin.Config (Config (checkParents, checkProject)) -import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, - pluginsToVSCodeExtensionSchema) import Ide.PluginUtils (pluginDescToIdePlugins) import Paths_ghcide (version) import qualified System.Directory.Extra as IO @@ -58,8 +48,6 @@ main = do if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion - let hlsPlugins = pluginDescToIdePlugins GhcIde.descriptors - whenJust argsCwd IO.setCurrentDirectory Main.defaultMain def diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index a00d81dcca..8141737570 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -34,7 +34,7 @@ library default-language: Haskell2010 build-depends: aeson, - aeson-pretty + aeson-pretty, array, async, base == 4.*, diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 6b4361a7f5..f678eab22c 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -22,8 +22,9 @@ import Data.List.Extra (intercalate, isPrefixOf, nub, nubOrd, partition) import Data.Maybe (catMaybes, isJust) import qualified Data.Text as T -import qualified Data.Text.IO as LT import qualified Data.Text.IO as T +import Data.Text.Lazy.Encoding (decodeUtf8) +import qualified Data.Text.Lazy.IO as LT import Development.IDE (Action, Rules, hDuplicateTo') import Development.IDE.Core.Debouncer (Debouncer, @@ -73,6 +74,8 @@ import qualified HieDb.Run as HieDb import Ide.Plugin.Config (CheckParents (NeverCheck), Config, getConfigFromNotification) +import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, + pluginsToVSCodeExtensionSchema) import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins) @@ -211,9 +214,9 @@ defaultMain Arguments{..} = do case argCommand of PrintExtensionSchema -> - LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToVSCodeExtensionSchema hlsPlugins + LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToVSCodeExtensionSchema argsHlsPlugins PrintDefaultConfig -> - LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToDefaultConfig hlsPlugins + LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToDefaultConfig argsHlsPlugins LSP -> do t <- offsetTime hPutStrLn stderr "Starting LSP server..." From 4d4013f85d8eb0cccb6382774e5d463a213145e0 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 4 Jul 2021 22:42:24 +0100 Subject: [PATCH 4/6] HLS plugin cli commands --- exe/Main.hs | 2 +- exe/Wrapper.hs | 2 +- ghcide/exe/Arguments.hs | 14 +++++++------ ghcide/exe/Main.hs | 3 ++- ghcide/src/Development/IDE/Main.hs | 32 ++++++++++++++++++----------- hls-plugin-api/hls-plugin-api.cabal | 1 + hls-plugin-api/src/Ide/Types.hs | 12 +++++++++++ src/Ide/Arguments.hs | 14 +++++++------ 8 files changed, 53 insertions(+), 27 deletions(-) diff --git a/exe/Main.hs b/exe/Main.hs index 7c0ef2f90b..e5ba2cb6a7 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -11,7 +11,7 @@ import Plugins main :: IO () main = do - args <- getArguments "haskell-language-server" + args <- getArguments "haskell-language-server" (idePlugins False) let withExamples = case args of diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index c7e1c225b4..2cb2084b0c 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -27,7 +27,7 @@ main :: IO () main = do -- WARNING: If you write to stdout before runLanguageServer -- then the language server will not work - args <- getArguments "haskell-language-server-wrapper" + args <- getArguments "haskell-language-server-wrapper" mempty hlsVer <- haskellLanguageServerVersion case args of diff --git a/ghcide/exe/Arguments.hs b/ghcide/exe/Arguments.hs index 398bb730f6..9f27265dc2 100644 --- a/ghcide/exe/Arguments.hs +++ b/ghcide/exe/Arguments.hs @@ -3,7 +3,9 @@ module Arguments(Arguments(..), getArguments) where +import Development.IDE (IdeState) import Development.IDE.Main (Command (..), commandP) +import Ide.Types (IdePlugins) import Options.Applicative data Arguments = Arguments @@ -18,15 +20,15 @@ data Arguments = Arguments ,argsCommand :: Command } -getArguments :: IO Arguments -getArguments = execParser opts +getArguments :: IdePlugins IdeState -> IO Arguments +getArguments plugins = execParser opts where - opts = info (arguments <**> helper) + opts = info (arguments plugins <**> helper) ( fullDesc <> header "ghcide - the core of a Haskell IDE") -arguments :: Parser Arguments -arguments = Arguments +arguments :: IdePlugins IdeState -> Parser Arguments +arguments plugins = Arguments <$> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory") <*> switch (long "version" <> help "Show ghcide and GHC versions") <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory") @@ -35,7 +37,7 @@ arguments = Arguments <*> switch (long "test-no-kick" <> help "Disable kick. Useful for testing cancellation") <*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault) <*> switch (long "verbose" <> help "Include internal events in logging output") - <*> (commandP <|> lspCommand <|> checkCommand) + <*> (commandP plugins <|> lspCommand <|> checkCommand) where checkCommand = Check <$> many (argument str (metavar "FILES/DIRS...")) lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP client") diff --git a/ghcide/exe/Main.hs b/ghcide/exe/Main.hs index 73ae1a722e..bb3615107d 100644 --- a/ghcide/exe/Main.hs +++ b/ghcide/exe/Main.hs @@ -41,9 +41,10 @@ ghcideVersion = do main :: IO () main = do + let hlsPlugins = pluginDescToIdePlugins GhcIde.descriptors -- WARNING: If you write to stdout before runLanguageServer -- then the language server will not work - Arguments{..} <- getArguments + Arguments{..} <- getArguments hlsPlugins if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index f678eab22c..818feebef8 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -79,7 +79,11 @@ import Ide.Plugin.ConfigUtils (pluginsToDefaultConfig, import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins) -import Ide.Types (IdePlugins) +import Ide.Types (IdeCommand (IdeCommand), + IdePlugins, + PluginDescriptor (PluginDescriptor, pluginCli), + PluginId (PluginId), + ipMap) import qualified Language.LSP.Server as LSP import Options.Applicative hiding (action) import qualified System.Directory.Extra as IO @@ -104,12 +108,9 @@ data Command | LSP -- ^ Run the LSP server | PrintExtensionSchema | PrintDefaultConfig - | Custom {projectRoot :: FilePath, ideCommand :: IdeCommand} -- ^ User defined + | Custom {projectRoot :: FilePath, ideCommand :: IdeCommand IdeState} -- ^ User defined deriving Show -newtype IdeCommand = IdeCommand (IdeState -> IO ()) - -instance Show IdeCommand where show _ = "" -- TODO move these to hiedb deriving instance Show HieDb.Command @@ -119,13 +120,15 @@ isLSP :: Command -> Bool isLSP LSP = True isLSP _ = False -commandP :: Parser Command -commandP = hsubparser (command "typecheck" (info (Check <$> fileCmd) fileInfo) - <> command "hiedb" (info (Db "." <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo) - <> command "lsp" (info (pure LSP <**> helper) lspInfo) - <> command "vscode-extension-schema" extensionSchemaCommand - <> command "generate-default-config" generateDefaultConfigCommand - ) +commandP :: IdePlugins IdeState -> Parser Command +commandP plugins = + hsubparser(command "typecheck" (info (Check <$> fileCmd) fileInfo) + <> command "hiedb" (info (Db "." <$> HieDb.optParser "" True <*> HieDb.cmdParser <**> helper) hieInfo) + <> command "lsp" (info (pure LSP <**> helper) lspInfo) + <> command "vscode-extension-schema" extensionSchemaCommand + <> command "generate-default-config" generateDefaultConfigCommand + <> pluginCommands + ) where fileCmd = many (argument str (metavar "FILES/DIRS...")) lspInfo = fullDesc <> progDesc "Start talking to an LSP client" @@ -138,6 +141,11 @@ commandP = hsubparser (command "typecheck" (info (Check <$> fileCmd) fileInfo) info (pure PrintDefaultConfig) (fullDesc <> progDesc "Print config supported by the server with default values") + pluginCommands = mconcat + [ command (T.unpack pId) (Custom "." <$> p) + | (PluginId pId, PluginDescriptor{pluginCli = Just p}) <- ipMap plugins + ] + data Arguments = Arguments { argsOTMemoryProfiling :: Bool diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 611ad832c9..c5f002e49c 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -55,6 +55,7 @@ library , hls-graph ^>=1.4 , text , unordered-containers + , optparse-applicative if os(windows) build-depends: Win32 diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 00afd5892d..c2c6da2454 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -4,9 +4,11 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -49,6 +51,7 @@ import Language.LSP.Types.Capabilities import Language.LSP.Types.Lens as J hiding (id) import Language.LSP.VFS import OpenTelemetry.Eventlog +import Options.Applicative (ParserInfo) import System.IO.Unsafe import Text.Regex.TDFA.Text () @@ -56,6 +59,7 @@ import Text.Regex.TDFA.Text () newtype IdePlugins ideState = IdePlugins { ipMap :: [(PluginId, PluginDescriptor ideState)]} + deriving newtype (Monoid, Semigroup) -- | Hooks for modifying the 'DynFlags' at different times of the compilation -- process. Plugins can install a 'DynFlagsModifications' via @@ -80,6 +84,10 @@ instance Semigroup DynFlagsModifications where instance Monoid DynFlagsModifications where mempty = DynFlagsModifications id id +-- --------------------------------------------------------------------- + +newtype IdeCommand state = IdeCommand (state -> IO ()) +instance Show (IdeCommand st) where show _ = "" -- --------------------------------------------------------------------- @@ -91,6 +99,7 @@ data PluginDescriptor ideState = , pluginConfigDescriptor :: ConfigDescriptor , pluginNotificationHandlers :: PluginNotificationHandlers ideState , pluginModifyDynflags :: DynFlagsModifications + , pluginCli :: Maybe (ParserInfo (IdeCommand ideState)) } -- | An existential wrapper of 'Properties' @@ -324,6 +333,7 @@ defaultPluginDescriptor plId = defaultConfigDescriptor mempty mempty + Nothing newtype CommandId = CommandId T.Text deriving (Show, Read, Eq, Ord) @@ -446,6 +456,8 @@ instance HasTracing WorkspaceSymbolParams where -- --------------------------------------------------------------------- {-# NOINLINE pROCESS_ID #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} pROCESS_ID :: T.Text pROCESS_ID = unsafePerformIO getPid diff --git a/src/Ide/Arguments.hs b/src/Ide/Arguments.hs index 833e8fc86e..a7c5433ff5 100644 --- a/src/Ide/Arguments.hs +++ b/src/Ide/Arguments.hs @@ -18,7 +18,9 @@ module Ide.Arguments import Data.Version import Development.GitRev +import Development.IDE (IdeState) import Development.IDE.Main (Command (..), commandP) +import Ide.Types (IdePlugins) import Options.Applicative import Paths_haskell_language_server import System.Environment @@ -56,14 +58,14 @@ data BiosAction = PrintCradleType deriving (Show, Eq, Ord) -getArguments :: String -> IO Arguments -getArguments exeName = execParser opts +getArguments :: String -> IdePlugins IdeState -> IO Arguments +getArguments exeName plugins = execParser opts where opts = info (( VersionMode <$> printVersionParser exeName <|> probeToolsParser exeName <|> BiosMode <$> biosParser - <|> Ghcide <$> arguments + <|> Ghcide <$> arguments plugins ) <**> helper) ( fullDesc @@ -88,9 +90,9 @@ probeToolsParser exeName = flag' ProbeToolsMode (long "probe-tools" <> help ("Show " ++ exeName ++ " version and other tools of interest")) -arguments :: Parser GhcideArguments -arguments = GhcideArguments - <$> (commandP <|> lspCommand <|> checkCommand) +arguments :: IdePlugins IdeState -> Parser GhcideArguments +arguments plugins = GhcideArguments + <$> (commandP plugins <|> lspCommand <|> checkCommand) <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory") <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" From 776bc8cff5678c6af9b940294f85fa288daaff71 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 4 Jul 2021 23:11:47 +0100 Subject: [PATCH 5/6] Add an example --- plugins/default/src/Ide/Plugin/Example.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs index 39a676dccd..7cdd793046 100644 --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -33,6 +33,7 @@ import Ide.PluginUtils import Ide.Types import Language.LSP.Server import Language.LSP.Types +import Options.Applicative (ParserInfo, info) import Text.Regex.TDFA.Text () -- --------------------------------------------------------------------- @@ -46,8 +47,13 @@ descriptor plId = (defaultPluginDescriptor plId) <> mkPluginHandler STextDocumentHover hover <> mkPluginHandler STextDocumentDocumentSymbol symbols <> mkPluginHandler STextDocumentCompletion completion + , pluginCli = Just exampleCli } +exampleCli :: ParserInfo (IdeCommand IdeState) +exampleCli = info p mempty + where p = pure $ IdeCommand $ \_ideState -> print "hello HLS" + -- --------------------------------------------------------------------- hover :: PluginMethodHandler IdeState TextDocumentHover From af82a4b0946de8dddeb286d8eb9fa0b19b81db08 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 4 Jul 2021 23:50:56 +0100 Subject: [PATCH 6/6] print -> putStrLn --- plugins/default/src/Ide/Plugin/Example.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/default/src/Ide/Plugin/Example.hs b/plugins/default/src/Ide/Plugin/Example.hs index 7cdd793046..1097c43d0e 100644 --- a/plugins/default/src/Ide/Plugin/Example.hs +++ b/plugins/default/src/Ide/Plugin/Example.hs @@ -52,7 +52,7 @@ descriptor plId = (defaultPluginDescriptor plId) exampleCli :: ParserInfo (IdeCommand IdeState) exampleCli = info p mempty - where p = pure $ IdeCommand $ \_ideState -> print "hello HLS" + where p = pure $ IdeCommand $ \_ideState -> putStrLn "hello HLS" -- ---------------------------------------------------------------------