From 5c10247df96583ec29745b32922b76bb509fc8c0 Mon Sep 17 00:00:00 2001 From: Fendor Date: Sun, 26 Jul 2020 17:24:49 +0200 Subject: [PATCH] Add numeric-version option for wrapper and server Also correctly shuts down the language server if `--version` was given. Minor rework of argument parser. --- exe/Arguments.hs | 40 ++++++++++++++++++++++++++++++++-------- exe/Main.hs | 19 +++++++++++++++---- exe/Wrapper.hs | 16 ++++++++++++++-- 3 files changed, 61 insertions(+), 14 deletions(-) diff --git a/exe/Arguments.hs b/exe/Arguments.hs index 81e388d3de..201d37a89d 100644 --- a/exe/Arguments.hs +++ b/exe/Arguments.hs @@ -9,8 +9,11 @@ module Arguments ( Arguments(..) + , LspArguments(..) + , PrintVersion(..) , getArguments , haskellLanguageServerVersion + , haskellLanguageServerNumericVersion ) where import Data.Version @@ -21,11 +24,15 @@ import System.Environment -- --------------------------------------------------------------------- -data Arguments = Arguments +data Arguments + = VersionMode PrintVersion + | LspMode LspArguments + deriving Show + +data LspArguments = LspArguments {argLSP :: Bool ,argsCwd :: Maybe FilePath ,argFiles :: [FilePath] - ,argsVersion :: Bool ,argsShakeProfiling :: Maybe FilePath ,argsTesting :: Bool ,argsExamplePlugin :: Bool @@ -37,22 +44,36 @@ data Arguments = Arguments , argsProjectGhcVersion :: Bool } deriving Show +data PrintVersion + = PrintVersion + | PrintNumericVersion + deriving (Show, Eq, Ord) + getArguments :: String -> IO Arguments getArguments exeName = execParser opts where - opts = info (arguments exeName <**> helper) + opts = info (( + VersionMode <$> printVersionParser exeName + <|> LspMode <$> arguments) + <**> helper) ( fullDesc <> progDesc "Used as a test bed to check your IDE Client will work" <> header (exeName ++ " - GHC Haskell LSP server")) -arguments :: String -> Parser Arguments -arguments exeName = Arguments +printVersionParser :: String -> Parser PrintVersion +printVersionParser exeName = + flag' PrintVersion + (long "version" <> help ("Show " ++ exeName ++ " and GHC versions")) + <|> + flag' PrintNumericVersion + (long "numeric-version" <> help ("Show numeric version of " ++ exeName)) + +arguments :: Parser LspArguments +arguments = LspArguments <$> switch (long "lsp" <> help "Start talking to an LSP server") <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory") <*> many (argument str (metavar "FILES/DIRS...")) - <*> switch (long "version" - <> help ("Show " ++ exeName ++ " and GHC versions")) <*> optional (strOption $ long "shake-profiling" <> metavar "DIR" <> help "Dump profiling reports to this directory") <*> switch (long "test" @@ -83,13 +104,16 @@ arguments exeName = Arguments -- --------------------------------------------------------------------- +haskellLanguageServerNumericVersion :: String +haskellLanguageServerNumericVersion = showVersion version + haskellLanguageServerVersion :: IO String haskellLanguageServerVersion = do path <- getExecutablePath let gitHashSection = case $(gitHash) of x | x == "UNKNOWN" -> "" x -> " (GIT hash: " <> x <> ")" - return $ "haskell-language-server version: " <> showVersion version + return $ "haskell-language-server version: " <> haskellLanguageServerNumericVersion <> " (GHC: " <> VERSION_ghc <> ") (PATH: " <> path <> ")" <> gitHashSection diff --git a/exe/Main.hs b/exe/Main.hs index 54e2354e8e..081f261cac 100644 --- a/exe/Main.hs +++ b/exe/Main.hs @@ -125,12 +125,23 @@ main :: IO () main = do -- WARNING: If you write to stdout before runLanguageServer -- then the language server will not work - args@Arguments{..} <- getArguments "haskell-language-server" + args <- getArguments "haskell-language-server" hlsVer <- haskellLanguageServerVersion - if argsVersion then putStrLn hlsVer - else hPutStrLn stderr hlsVer {- see WARNING above -} + case args of + VersionMode PrintVersion -> + putStrLn hlsVer + VersionMode PrintNumericVersion -> + putStrLn haskellLanguageServerNumericVersion + + LspMode lspArgs -> do + {- see WARNING above -} + hPutStrLn stderr hlsVer + runLspMode lspArgs + +runLspMode :: LspArguments -> IO () +runLspMode lspArgs@LspArguments {..} = do LSP.setupLogger argsLogFile ["hls", "hie-bios"] $ if argsDebugOn then L.DEBUG else L.INFO @@ -157,7 +168,7 @@ 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 arguments: " <> show lspArgs hPutStrLn stderr $ " with plugins: " <> show (Map.keys $ ipMap idePlugins') hPutStrLn stderr $ " in directory: " <> dir hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!" diff --git a/exe/Wrapper.hs b/exe/Wrapper.hs index 703ceedaf3..17c024f2a7 100644 --- a/exe/Wrapper.hs +++ b/exe/Wrapper.hs @@ -26,8 +26,21 @@ main :: IO () main = do -- WARNING: If you write to stdout before runLanguageServer -- then the language server will not work - Arguments{..} <- getArguments "haskell-language-server-wrapper" + args <- getArguments "haskell-language-server-wrapper" + hlsVer <- haskellLanguageServerVersion + case args of + VersionMode PrintVersion -> + putStrLn hlsVer + + VersionMode PrintNumericVersion -> + putStrLn haskellLanguageServerNumericVersion + + LspMode lspArgs -> + launchHaskellLanguageServer lspArgs + +launchHaskellLanguageServer :: LspArguments -> IO () +launchHaskellLanguageServer LspArguments{..} = do d <- getCurrentDirectory -- Get the cabal directory from the cradle @@ -35,7 +48,6 @@ main = do setCurrentDirectory $ cradleRootDir cradle when argsProjectGhcVersion $ getRuntimeGhcVersion' cradle >>= putStrLn >> exitSuccess - when argsVersion $ haskellLanguageServerVersion >>= putStrLn >> exitSuccess whenJust argsCwd setCurrentDirectory