-- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above module Ide.Arguments ( Arguments(..) , GhcideArguments(..) , PrintVersion(..) , BiosAction(..) , getArguments , haskellLanguageServerVersion , haskellLanguageServerNumericVersion ) where import Data.Version import Development.IDE (IdeState) import Development.IDE.Main (Command (..), commandP) import GitHash (giHash, tGitInfoCwdTry) import Ide.Logger (Priority (..)) import Ide.Types (IdePlugins) import Options.Applicative import Paths_haskell_language_server import System.Environment -- --------------------------------------------------------------------- data Arguments = VersionMode PrintVersion | ProbeToolsMode | ListPluginsMode | BiosMode BiosAction | Ghcide GhcideArguments | VSCodeExtensionSchemaMode | DefaultConfigurationMode | PrintLibDir data GhcideArguments = GhcideArguments { argsCommand :: Command , argsCwd :: Maybe FilePath , argsShakeProfiling :: Maybe FilePath , argsTesting :: Bool , argsExamplePlugin :: Bool , argsLogLevel :: Priority , argsLogFile :: Maybe String -- ^ the minimum log level to show , argsLogStderr :: Bool , argsLogClient :: Bool , argsThreads :: Int , argsProjectGhcVersion :: Bool } deriving Show data PrintVersion = PrintVersion | PrintNumericVersion deriving (Show, Eq, Ord) data BiosAction = PrintCradleType deriving (Show, Eq, Ord) getArguments :: String -> IdePlugins IdeState -> IO Arguments getArguments exeName plugins = execParser opts where opts = info (( VersionMode <$> printVersionParser exeName <|> probeToolsParser exeName <|> hsubparser ( command "vscode-extension-schema" extensionSchemaCommand <> command "generate-default-config" generateDefaultConfigCommand ) <|> listPluginsParser <|> BiosMode <$> biosParser <|> Ghcide <$> arguments plugins <|> flag' PrintLibDir (long "print-libdir" <> help "Print project GHCs libdir") ) <**> helper) ( fullDesc <> progDesc "Used as a test bed to check your IDE Client will work" <> header (exeName ++ " - GHC Haskell LSP server")) extensionSchemaCommand = info (pure VSCodeExtensionSchemaMode) (fullDesc <> progDesc "Print generic config schema for plugins (used in the package.json of haskell vscode extension)") generateDefaultConfigCommand = info (pure DefaultConfigurationMode) (fullDesc <> progDesc "Print config supported by the server with default values") 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)) biosParser :: Parser BiosAction biosParser = flag' PrintCradleType (long "print-cradle" <> help "Print the project cradle type") probeToolsParser :: String -> Parser Arguments probeToolsParser exeName = flag' ProbeToolsMode (long "probe-tools" <> help ("Show " ++ exeName ++ " version and other tools of interest")) listPluginsParser :: Parser Arguments listPluginsParser = flag' ListPluginsMode (long "list-plugins" <> help "List all available plugins") 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" <> help "Dump profiling reports to this directory") <*> switch (long "test" <> help "Enable additional lsp messages used by the testsuite") <*> switch (long "example" <> help "Include the Example Plugin. For Plugin devs only") <*> (option @Priority auto (long "log-level" <> help "Only show logs at or above this log level" <> metavar "LOG_LEVEL" <> value Info <> showDefault ) <|> flag' Debug (long "debug" <> short 'd' <> help "Sets the log level to Debug, alias for '--log-level Debug'" ) ) -- This option is a little inconsistent with the other log options, since -- it's not a boolean and there is no way to turn it off. That's okay -- since the default is off. <*> (optional (strOption ( long "log-file" <> metavar "LOGFILE" <> help "Send logs to a file" )) <|> (optional (strOption ( long "logfile" <> short 'l' <> metavar "LOGFILE" <> help "Send logs to a file" -- deprecated alias so users don't need to update their CLI calls -- immediately <> internal ))) ) -- Boolean option so we can toggle the default in a consistent way <*> option auto ( long "log-stderr" <> help "Send logs to stderr" <> metavar "BOOL" <> value True <> showDefault ) -- Boolean option so we can toggle the default in a consistent way <*> option auto ( long "log-client" <> help "Send logs to the client using the window/logMessage LSP method" <> metavar "BOOL" -- This is off by default, since some clients will show duplicate logs -- if we log both to stderr and the client <> value False <> showDefault ) <*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault ) <*> switch (long "project-ghc-version" <> help "Work out the project GHC version and print it") where lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP server") checkCommand = Check <$> many (argument str (metavar "FILES/DIRS...")) -- --------------------------------------------------------------------- haskellLanguageServerNumericVersion :: String haskellLanguageServerNumericVersion = showVersion version haskellLanguageServerVersion :: IO String haskellLanguageServerVersion = do path <- getExecutablePath let gi = $$tGitInfoCwdTry gitHashSection = case gi of Right gi -> " (GIT hash: " <> giHash gi <> ")" Left _ -> "" return $ "haskell-language-server version: " <> haskellLanguageServerNumericVersion <> " (GHC: " <> VERSION_ghc <> ") (PATH: " <> path <> ")" <> gitHashSection