diff --git a/exe/Arguments.hs b/exe/Arguments.hs index e495a82565..f07d8254e5 100644 --- a/exe/Arguments.hs +++ b/exe/Arguments.hs @@ -36,8 +36,8 @@ data Arguments = Arguments -- them to just change the name of the exe and still work. , argsDebugOn :: Bool , argsLogFile :: Maybe String - - } + , argsThread :: Int + } deriving Show getArguments :: String -> IO Arguments getArguments exeName = execParser opts @@ -73,6 +73,13 @@ arguments exeName = Arguments <> metavar "LOGFILE" <> help "File to log to, defaults to stdout" )) + <*> option auto + (short 'j' + <> help "Number of threads (0: automatic)" + <> metavar "NUM" + <> value 1 + <> showDefault + ) -- --------------------------------------------------------------------- -- Set the GHC libdir to the nix libdir if it's present. diff --git a/exe/Main.hs b/exe/Main.hs index 02d865b672..0835c38675 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -48,24 +48,25 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Logger import Development.IDE.Types.Options -import Development.Shake (Action, action) -import DynFlags (gopt_set, gopt_unset, +import Development.Shake (Action, action) +import DynFlags (gopt_set, gopt_unset, updOptLevel) -import DynFlags (PackageFlag(..), PackageArg(..)) -import GHC hiding (def) +import DynFlags (PackageFlag(..), PackageArg(..)) +import GHC hiding (def) import GHC.Check (runTimeVersion, compileTimeVersionFromLibdir) -- import GhcMonad import HIE.Bios.Cradle -import HIE.Bios.Environment (addCmdOpts) +import HIE.Bios.Environment (addCmdOpts) import HIE.Bios.Types -import HscTypes (HscEnv(..), ic_dflags) +import HscTypes (HscEnv(..), ic_dflags) import qualified Language.Haskell.LSP.Core as LSP import Ide.Logger import Ide.Plugin import Ide.Plugin.Config +import Ide.Types (IdePlugins, ipMap) import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.Types (LspId(IdInt)) -import Linker (initDynLinker) +import Language.Haskell.LSP.Types (LspId(IdInt)) +import Linker (initDynLinker) import Module import NameCache import Packages @@ -96,15 +97,16 @@ import Ide.Plugin.Pragmas as Pragmas -- --------------------------------------------------------------------- + + -- | The plugins configured for use in this instance of the language -- server. -- These can be freely added or removed to tailor the available -- features of the server. -idePlugins :: T.Text -> Bool -> (Plugin Config, [T.Text]) -idePlugins pid includeExamples - = (asGhcIdePlugin ps, allLspCmdIds' pid ps) + +idePlugins :: Bool -> IdePlugins +idePlugins includeExamples = pluginDescToIdePlugins allPlugins where - ps = pluginDescToIdePlugins allPlugins allPlugins = if includeExamples then basePlugins ++ examplePlugins else basePlugins @@ -113,7 +115,7 @@ idePlugins pid includeExamples -- applyRefactDescriptor "applyrefact" -- , brittanyDescriptor "brittany" -- , haddockDescriptor "haddock" - -- -- , hareDescriptor "hare" + -- , hareDescriptor "hare" -- , hsimportDescriptor "hsimport" -- , liquidDescriptor "liquid" -- , packageDescriptor "package" @@ -130,6 +132,8 @@ idePlugins pid includeExamples -- ,hfaAlignDescriptor "hfaa" ] +ghcIdePlugins :: T.Text -> IdePlugins -> (Plugin Config, [T.Text]) +ghcIdePlugins pid ps = (asGhcIdePlugin ps, allLspCmdIds' pid ps) -- --------------------------------------------------------------------- @@ -141,14 +145,12 @@ main :: IO () main = do -- WARNING: If you write to stdout before runLanguageServer -- then the language server will not work - Arguments{..} <- getArguments "haskell-language-server" + args@Arguments{..} <- getArguments "haskell-language-server" if argsVersion then ghcideVersion >>= putStrLn >> exitSuccess else hPutStrLn stderr {- see WARNING above -} =<< ghcideVersion - -- LSP.setupLogger (optLogFile opts) ["hie", "hie-bios"] - -- $ if optDebugOn opts then L.DEBUG else L.INFO - LSP.setupLogger argsLogFile ["hie", "hie-bios"] + LSP.setupLogger argsLogFile ["hls", "hie-bios"] $ if argsDebugOn then L.DEBUG else L.INFO -- lock to avoid overlapping output on stdout @@ -162,8 +164,8 @@ main = do pid <- getPid let - (ps, commandIds) = idePlugins pid argsExamplePlugin - -- (ps, commandIds) = idePlugins pid True + idePlugins' = idePlugins argsExamplePlugin + (ps, commandIds) = ghcIdePlugins pid idePlugins' plugins = Completions.plugin <> CodeAction.plugin <> Plugin mempty HoverDefinition.setHandlersDefinition <> ps @@ -174,6 +176,8 @@ main = do if argLSP then do t <- offsetTime hPutStrLn stderr "Starting (haskell-language-server)LSP server..." + hPutStrLn stderr $ " with arguments: " <> show args + hPutStrLn stderr $ " with plugins: " <> show (Map.keys $ ipMap idePlugins') hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps -> do t <- t @@ -183,7 +187,7 @@ main = do , optShakeProfiling = argsShakeProfiling , optTesting = argsTesting , optInterfaceLoadingDiagnostics = argsTesting - , optThreads = 1 + , optThreads = argsThread } debouncer <- newAsyncDebouncer initialise caps (mainRule >> pluginRules plugins >> action kick) diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index f8dcaccf65..395eae6972 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -57,7 +57,7 @@ main = do progName <- getProgName logm $ "run entered for haskell-language-server-wrapper(" ++ progName ++ ") " - ++ hieVersion + ++ hlsVersion d <- getCurrentDirectory logm $ "Current directory:" ++ d logm $ "Operating system:" ++ os @@ -74,12 +74,12 @@ main = do logm $ "Project GHC version:" ++ ghcVersion let - hieBin = "haskell-language-server-" ++ ghcVersion - backupHieBin = + hlsBin = "haskell-language-server-" ++ ghcVersion + backupHlsBin = case dropWhileEnd (/='.') ghcVersion of [] -> "haskell-language-server" xs -> "haskell-language-server-" ++ init xs - candidates' = [hieBin, backupHieBin, "haskell-language-server"] + candidates' = [hlsBin, backupHlsBin, "haskell-language-server"] candidates = map (++ exeExtension) candidates' logm $ "haskell-language-server exe candidates :" ++ show candidates diff --git a/src/Ide/Logger.hs b/src/Ide/Logger.hs index 9bb8468146..bd720ffc20 100644 --- a/src/Ide/Logger.hs +++ b/src/Ide/Logger.hs @@ -29,15 +29,15 @@ hlsLogger = L.Logger $ \pri txt -> -- --------------------------------------------------------------------- logm :: MonadIO m => String -> m () -logm s = liftIO $ infoM "hie" s +logm s = liftIO $ infoM "hls" s debugm :: MonadIO m => String -> m () -debugm s = liftIO $ debugM "hie" s +debugm s = liftIO $ debugM "hls" s warningm :: MonadIO m => String -> m () -warningm s = liftIO $ warningM "hie" s +warningm s = liftIO $ warningM "hls" s errorm :: MonadIO m => String -> m () -errorm s = liftIO $ errorM "hie" s +errorm s = liftIO $ errorM "hls" s -- --------------------------------------------------------------------- diff --git a/src/Ide/Plugin.hs b/src/Ide/Plugin.hs index 10ce65edbd..43c2c8f303 100644 --- a/src/Ide/Plugin.hs +++ b/src/Ide/Plugin.hs @@ -137,7 +137,7 @@ makeCodeAction cas lf ideState (CodeActionParams docId range context _) = do case literalSupport of Nothing -> do let cmdParams = [J.toJSON (FallbackCodeActionParams (action ^. edit) (action ^. command))] - cmd <- mkLspCommand "hie" "fallbackCodeAction" (action ^. title) (Just cmdParams) + cmd <- mkLspCommand "hls" "fallbackCodeAction" (action ^. title) (Just cmdParams) return $ Just (CACommand cmd) Just _ -> return $ Just (CACodeAction action) @@ -224,7 +224,7 @@ makeExecuteCommands ecs lf ide = do case parseCmdId cmdId of -- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions - Just ("hie", "fallbackCodeAction") -> + Just ("hls", "fallbackCodeAction") -> case J.fromJSON cmdParams of J.Success (FallbackCodeActionParams mEdit mCmd) -> do @@ -289,7 +289,7 @@ makeExecuteCommands ecs lf ide = do case parseCmdId cmdId of -- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions - Just ("hie", "fallbackCodeAction") -> do + Just ("hls", "fallbackCodeAction") -> do case A.fromJSON cmdParams of A.Success (FallbackCodeActionParams mEdit mCmd) -> do diff --git a/src/Ide/Version.hs b/src/Ide/Version.hs index bf67aadbaa..2baccfd501 100644 --- a/src/Ide/Version.hs +++ b/src/Ide/Version.hs @@ -17,8 +17,8 @@ import qualified Paths_haskell_language_server as Meta import System.Directory import System.Info -hieVersion :: String -hieVersion = +hlsVersion :: String +hlsVersion = let commitCount = $gitCommitCount in concat $ concat [ [$(simpleVersion Meta.version)] @@ -27,13 +27,13 @@ hieVersion = , [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) && commitCount /= ("UNKNOWN" :: String)] , [" ", display buildArch] - , [" ", hieGhcDisplayVersion] + , [" ", hlsGhcDisplayVersion] ] -- --------------------------------------------------------------------- -hieGhcDisplayVersion :: String -hieGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc +hlsGhcDisplayVersion :: String +hlsGhcDisplayVersion = compilerName ++ "-" ++ VERSION_ghc getProjectGhcVersion :: Bios.Cradle Bios.CabalHelper -> IO String getProjectGhcVersion crdl = @@ -42,8 +42,8 @@ getProjectGhcVersion crdl = (execProjectGhc crdl ["--numeric-version"]) -hieGhcVersion :: String -hieGhcVersion = VERSION_ghc +hlsGhcVersion :: String +hlsGhcVersion = VERSION_ghc -- ---------------------------------------------------------------------