-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# 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.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
data GhcideArguments = GhcideArguments
{argsCommand :: Command
,argsCwd :: Maybe FilePath
,argsShakeProfiling :: Maybe FilePath
,argsTesting :: Bool
,argsExamplePlugin :: Bool
-- These next two are for compatibility with existing hie clients, allowing
-- them to just change the name of the exe and still work.
, argsDebugOn :: Bool
, argsLogFile :: Maybe String
, 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
<|> listPluginsParser
<|> BiosMode <$> biosParser
<|> Ghcide <$> arguments plugins
)
<**> helper)
( fullDesc
<> progDesc "Used as a test bed to check your IDE Client will work"
<> header (exeName ++ " - GHC Haskell LSP server"))
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")
<*> switch
( long "debug"
<> short 'd'
<> help "Generate debug output"
)
<*> optional (strOption
( long "logfile"
<> short 'l'
<> metavar "LOGFILE"
<> help "File to log to, defaults to stdout"
))
<*> 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