-- 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
    { GhcideArguments -> Command
argsCommand           :: Command
    , GhcideArguments -> Maybe FilePath
argsCwd               :: Maybe FilePath
    , GhcideArguments -> Maybe FilePath
argsShakeProfiling    :: Maybe FilePath
    , GhcideArguments -> Bool
argsTesting           :: Bool
    , GhcideArguments -> Bool
argsExamplePlugin     :: Bool
    , GhcideArguments -> Priority
argsLogLevel          :: Priority
    , GhcideArguments -> Maybe FilePath
argsLogFile           :: Maybe String
    -- ^ the minimum log level to show
    , GhcideArguments -> Bool
argsLogStderr         :: Bool
    , GhcideArguments -> Bool
argsLogClient         :: Bool
    , GhcideArguments -> Int
argsThreads           :: Int
    , GhcideArguments -> Bool
argsProjectGhcVersion :: Bool
    } deriving Int -> GhcideArguments -> ShowS
[GhcideArguments] -> ShowS
GhcideArguments -> FilePath
(Int -> GhcideArguments -> ShowS)
-> (GhcideArguments -> FilePath)
-> ([GhcideArguments] -> ShowS)
-> Show GhcideArguments
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GhcideArguments -> ShowS
showsPrec :: Int -> GhcideArguments -> ShowS
$cshow :: GhcideArguments -> FilePath
show :: GhcideArguments -> FilePath
$cshowList :: [GhcideArguments] -> ShowS
showList :: [GhcideArguments] -> ShowS
Show

data PrintVersion
  = PrintVersion
  | PrintNumericVersion
  deriving (Int -> PrintVersion -> ShowS
[PrintVersion] -> ShowS
PrintVersion -> FilePath
(Int -> PrintVersion -> ShowS)
-> (PrintVersion -> FilePath)
-> ([PrintVersion] -> ShowS)
-> Show PrintVersion
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrintVersion -> ShowS
showsPrec :: Int -> PrintVersion -> ShowS
$cshow :: PrintVersion -> FilePath
show :: PrintVersion -> FilePath
$cshowList :: [PrintVersion] -> ShowS
showList :: [PrintVersion] -> ShowS
Show, PrintVersion -> PrintVersion -> Bool
(PrintVersion -> PrintVersion -> Bool)
-> (PrintVersion -> PrintVersion -> Bool) -> Eq PrintVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrintVersion -> PrintVersion -> Bool
== :: PrintVersion -> PrintVersion -> Bool
$c/= :: PrintVersion -> PrintVersion -> Bool
/= :: PrintVersion -> PrintVersion -> Bool
Eq, Eq PrintVersion
Eq PrintVersion =>
(PrintVersion -> PrintVersion -> Ordering)
-> (PrintVersion -> PrintVersion -> Bool)
-> (PrintVersion -> PrintVersion -> Bool)
-> (PrintVersion -> PrintVersion -> Bool)
-> (PrintVersion -> PrintVersion -> Bool)
-> (PrintVersion -> PrintVersion -> PrintVersion)
-> (PrintVersion -> PrintVersion -> PrintVersion)
-> Ord PrintVersion
PrintVersion -> PrintVersion -> Bool
PrintVersion -> PrintVersion -> Ordering
PrintVersion -> PrintVersion -> PrintVersion
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrintVersion -> PrintVersion -> Ordering
compare :: PrintVersion -> PrintVersion -> Ordering
$c< :: PrintVersion -> PrintVersion -> Bool
< :: PrintVersion -> PrintVersion -> Bool
$c<= :: PrintVersion -> PrintVersion -> Bool
<= :: PrintVersion -> PrintVersion -> Bool
$c> :: PrintVersion -> PrintVersion -> Bool
> :: PrintVersion -> PrintVersion -> Bool
$c>= :: PrintVersion -> PrintVersion -> Bool
>= :: PrintVersion -> PrintVersion -> Bool
$cmax :: PrintVersion -> PrintVersion -> PrintVersion
max :: PrintVersion -> PrintVersion -> PrintVersion
$cmin :: PrintVersion -> PrintVersion -> PrintVersion
min :: PrintVersion -> PrintVersion -> PrintVersion
Ord)

data BiosAction
  = PrintCradleType
  deriving (Int -> BiosAction -> ShowS
[BiosAction] -> ShowS
BiosAction -> FilePath
(Int -> BiosAction -> ShowS)
-> (BiosAction -> FilePath)
-> ([BiosAction] -> ShowS)
-> Show BiosAction
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BiosAction -> ShowS
showsPrec :: Int -> BiosAction -> ShowS
$cshow :: BiosAction -> FilePath
show :: BiosAction -> FilePath
$cshowList :: [BiosAction] -> ShowS
showList :: [BiosAction] -> ShowS
Show, BiosAction -> BiosAction -> Bool
(BiosAction -> BiosAction -> Bool)
-> (BiosAction -> BiosAction -> Bool) -> Eq BiosAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BiosAction -> BiosAction -> Bool
== :: BiosAction -> BiosAction -> Bool
$c/= :: BiosAction -> BiosAction -> Bool
/= :: BiosAction -> BiosAction -> Bool
Eq, Eq BiosAction
Eq BiosAction =>
(BiosAction -> BiosAction -> Ordering)
-> (BiosAction -> BiosAction -> Bool)
-> (BiosAction -> BiosAction -> Bool)
-> (BiosAction -> BiosAction -> Bool)
-> (BiosAction -> BiosAction -> Bool)
-> (BiosAction -> BiosAction -> BiosAction)
-> (BiosAction -> BiosAction -> BiosAction)
-> Ord BiosAction
BiosAction -> BiosAction -> Bool
BiosAction -> BiosAction -> Ordering
BiosAction -> BiosAction -> BiosAction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BiosAction -> BiosAction -> Ordering
compare :: BiosAction -> BiosAction -> Ordering
$c< :: BiosAction -> BiosAction -> Bool
< :: BiosAction -> BiosAction -> Bool
$c<= :: BiosAction -> BiosAction -> Bool
<= :: BiosAction -> BiosAction -> Bool
$c> :: BiosAction -> BiosAction -> Bool
> :: BiosAction -> BiosAction -> Bool
$c>= :: BiosAction -> BiosAction -> Bool
>= :: BiosAction -> BiosAction -> Bool
$cmax :: BiosAction -> BiosAction -> BiosAction
max :: BiosAction -> BiosAction -> BiosAction
$cmin :: BiosAction -> BiosAction -> BiosAction
min :: BiosAction -> BiosAction -> BiosAction
Ord)

getArguments :: String -> IdePlugins IdeState -> IO Arguments
getArguments :: FilePath -> IdePlugins IdeState -> IO Arguments
getArguments FilePath
exeName IdePlugins IdeState
plugins = ParserInfo Arguments -> IO Arguments
forall a. ParserInfo a -> IO a
execParser ParserInfo Arguments
opts
  where
    opts :: ParserInfo Arguments
opts = Parser Arguments -> InfoMod Arguments -> ParserInfo Arguments
forall a. Parser a -> InfoMod a -> ParserInfo a
info ((
      PrintVersion -> Arguments
VersionMode (PrintVersion -> Arguments)
-> Parser PrintVersion -> Parser Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Parser PrintVersion
printVersionParser FilePath
exeName
      Parser Arguments -> Parser Arguments -> Parser Arguments
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Parser Arguments
probeToolsParser FilePath
exeName
      Parser Arguments -> Parser Arguments -> Parser Arguments
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Mod CommandFields Arguments -> Parser Arguments
forall a. Mod CommandFields a -> Parser a
hsubparser
        (  FilePath -> ParserInfo Arguments -> Mod CommandFields Arguments
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"vscode-extension-schema" ParserInfo Arguments
extensionSchemaCommand
        Mod CommandFields Arguments
-> Mod CommandFields Arguments -> Mod CommandFields Arguments
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo Arguments -> Mod CommandFields Arguments
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
"generate-default-config" ParserInfo Arguments
generateDefaultConfigCommand
        )
      Parser Arguments -> Parser Arguments -> Parser Arguments
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Arguments
listPluginsParser
      Parser Arguments -> Parser Arguments -> Parser Arguments
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> BiosAction -> Arguments
BiosMode (BiosAction -> Arguments) -> Parser BiosAction -> Parser Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser BiosAction
biosParser
      Parser Arguments -> Parser Arguments -> Parser Arguments
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> GhcideArguments -> Arguments
Ghcide (GhcideArguments -> Arguments)
-> Parser GhcideArguments -> Parser Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdePlugins IdeState -> Parser GhcideArguments
arguments IdePlugins IdeState
plugins
      Parser Arguments -> Parser Arguments -> Parser Arguments
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Arguments -> Mod FlagFields Arguments -> Parser Arguments
forall a. a -> Mod FlagFields a -> Parser a
flag' Arguments
PrintLibDir (FilePath -> Mod FlagFields Arguments
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"print-libdir" Mod FlagFields Arguments
-> Mod FlagFields Arguments -> Mod FlagFields Arguments
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Arguments
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Print project GHCs libdir")
      )
      Parser Arguments
-> Parser (Arguments -> Arguments) -> Parser Arguments
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Arguments -> Arguments)
forall a. Parser (a -> a)
helper)
      ( InfoMod Arguments
forall a. InfoMod a
fullDesc
     InfoMod Arguments -> InfoMod Arguments -> InfoMod Arguments
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Arguments
forall a. FilePath -> InfoMod a
progDesc FilePath
"Used as a test bed to check your IDE Client will work"
     InfoMod Arguments -> InfoMod Arguments -> InfoMod Arguments
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Arguments
forall a. FilePath -> InfoMod a
header (FilePath
exeName FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" - GHC Haskell LSP server"))

    extensionSchemaCommand :: ParserInfo Arguments
extensionSchemaCommand =
        Parser Arguments -> InfoMod Arguments -> ParserInfo Arguments
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Arguments -> Parser Arguments
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arguments
VSCodeExtensionSchemaMode)
             (InfoMod Arguments
forall a. InfoMod a
fullDesc InfoMod Arguments -> InfoMod Arguments -> InfoMod Arguments
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Arguments
forall a. FilePath -> InfoMod a
progDesc FilePath
"Print generic config schema for plugins (used in the package.json of haskell vscode extension)")
    generateDefaultConfigCommand :: ParserInfo Arguments
generateDefaultConfigCommand =
        Parser Arguments -> InfoMod Arguments -> ParserInfo Arguments
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Arguments -> Parser Arguments
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Arguments
DefaultConfigurationMode)
             (InfoMod Arguments
forall a. InfoMod a
fullDesc InfoMod Arguments -> InfoMod Arguments -> InfoMod Arguments
forall a. Semigroup a => a -> a -> a
<> FilePath -> InfoMod Arguments
forall a. FilePath -> InfoMod a
progDesc FilePath
"Print config supported by the server with default values")

printVersionParser :: String -> Parser PrintVersion
printVersionParser :: FilePath -> Parser PrintVersion
printVersionParser FilePath
exeName =
  PrintVersion -> Mod FlagFields PrintVersion -> Parser PrintVersion
forall a. a -> Mod FlagFields a -> Parser a
flag' PrintVersion
PrintVersion
    (FilePath -> Mod FlagFields PrintVersion
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"version" Mod FlagFields PrintVersion
-> Mod FlagFields PrintVersion -> Mod FlagFields PrintVersion
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields PrintVersion
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
"Show " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
exeName  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" and GHC versions"))
  Parser PrintVersion -> Parser PrintVersion -> Parser PrintVersion
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  PrintVersion -> Mod FlagFields PrintVersion -> Parser PrintVersion
forall a. a -> Mod FlagFields a -> Parser a
flag' PrintVersion
PrintNumericVersion
    (FilePath -> Mod FlagFields PrintVersion
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"numeric-version" Mod FlagFields PrintVersion
-> Mod FlagFields PrintVersion -> Mod FlagFields PrintVersion
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields PrintVersion
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
"Show numeric version of " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
exeName))

biosParser :: Parser BiosAction
biosParser :: Parser BiosAction
biosParser =
  BiosAction -> Mod FlagFields BiosAction -> Parser BiosAction
forall a. a -> Mod FlagFields a -> Parser a
flag' BiosAction
PrintCradleType
    (FilePath -> Mod FlagFields BiosAction
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"print-cradle" Mod FlagFields BiosAction
-> Mod FlagFields BiosAction -> Mod FlagFields BiosAction
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields BiosAction
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Print the project cradle type")

probeToolsParser :: String -> Parser Arguments
probeToolsParser :: FilePath -> Parser Arguments
probeToolsParser FilePath
exeName =
  Arguments -> Mod FlagFields Arguments -> Parser Arguments
forall a. a -> Mod FlagFields a -> Parser a
flag' Arguments
ProbeToolsMode
    (FilePath -> Mod FlagFields Arguments
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"probe-tools" Mod FlagFields Arguments
-> Mod FlagFields Arguments -> Mod FlagFields Arguments
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Arguments
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
"Show " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
exeName  FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" version and other tools of interest"))

listPluginsParser :: Parser Arguments
listPluginsParser :: Parser Arguments
listPluginsParser =
  Arguments -> Mod FlagFields Arguments -> Parser Arguments
forall a. a -> Mod FlagFields a -> Parser a
flag' Arguments
ListPluginsMode
    (FilePath -> Mod FlagFields Arguments
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"list-plugins" Mod FlagFields Arguments
-> Mod FlagFields Arguments -> Mod FlagFields Arguments
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Arguments
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"List all available plugins")

arguments :: IdePlugins IdeState -> Parser GhcideArguments
arguments :: IdePlugins IdeState -> Parser GhcideArguments
arguments IdePlugins IdeState
plugins = Command
-> Maybe FilePath
-> Maybe FilePath
-> Bool
-> Bool
-> Priority
-> Maybe FilePath
-> Bool
-> Bool
-> Int
-> Bool
-> GhcideArguments
GhcideArguments
      (Command
 -> Maybe FilePath
 -> Maybe FilePath
 -> Bool
 -> Bool
 -> Priority
 -> Maybe FilePath
 -> Bool
 -> Bool
 -> Int
 -> Bool
 -> GhcideArguments)
-> Parser Command
-> Parser
     (Maybe FilePath
      -> Maybe FilePath
      -> Bool
      -> Bool
      -> Priority
      -> Maybe FilePath
      -> Bool
      -> Bool
      -> Int
      -> Bool
      -> GhcideArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IdePlugins IdeState -> Parser Command
commandP IdePlugins IdeState
plugins Parser Command -> Parser Command -> Parser Command
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
lspCommand Parser Command -> Parser Command -> Parser Command
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
checkCommand)
      Parser
  (Maybe FilePath
   -> Maybe FilePath
   -> Bool
   -> Bool
   -> Priority
   -> Maybe FilePath
   -> Bool
   -> Bool
   -> Int
   -> Bool
   -> GhcideArguments)
-> Parser (Maybe FilePath)
-> Parser
     (Maybe FilePath
      -> Bool
      -> Bool
      -> Priority
      -> Maybe FilePath
      -> Bool
      -> Bool
      -> Int
      -> Bool
      -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"cwd" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Change to this directory")
      Parser
  (Maybe FilePath
   -> Bool
   -> Bool
   -> Priority
   -> Maybe FilePath
   -> Bool
   -> Bool
   -> Int
   -> Bool
   -> GhcideArguments)
-> Parser (Maybe FilePath)
-> Parser
     (Bool
      -> Bool
      -> Priority
      -> Maybe FilePath
      -> Bool
      -> Bool
      -> Int
      -> Bool
      -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"shake-profiling" Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"DIR"
                  Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Dump profiling reports to this directory")
      Parser
  (Bool
   -> Bool
   -> Priority
   -> Maybe FilePath
   -> Bool
   -> Bool
   -> Int
   -> Bool
   -> GhcideArguments)
-> Parser Bool
-> Parser
     (Bool
      -> Priority
      -> Maybe FilePath
      -> Bool
      -> Bool
      -> Int
      -> Bool
      -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"test"
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enable additional lsp messages used by the testsuite")
      Parser
  (Bool
   -> Priority
   -> Maybe FilePath
   -> Bool
   -> Bool
   -> Int
   -> Bool
   -> GhcideArguments)
-> Parser Bool
-> Parser
     (Priority
      -> Maybe FilePath
      -> Bool
      -> Bool
      -> Int
      -> Bool
      -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"example"
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Include the Example Plugin. For Plugin devs only")

      Parser
  (Priority
   -> Maybe FilePath
   -> Bool
   -> Bool
   -> Int
   -> Bool
   -> GhcideArguments)
-> Parser Priority
-> Parser
     (Maybe FilePath -> Bool -> Bool -> Int -> Bool -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        (forall a. ReadM a -> Mod OptionFields a -> Parser a
option @Priority ReadM Priority
forall a. Read a => ReadM a
auto
          (FilePath -> Mod OptionFields Priority
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"log-level"
          Mod OptionFields Priority
-> Mod OptionFields Priority -> Mod OptionFields Priority
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Priority
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Only show logs at or above this log level"
          Mod OptionFields Priority
-> Mod OptionFields Priority -> Mod OptionFields Priority
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Priority
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LOG_LEVEL"
          Mod OptionFields Priority
-> Mod OptionFields Priority -> Mod OptionFields Priority
forall a. Semigroup a => a -> a -> a
<> Priority -> Mod OptionFields Priority
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Priority
Info
          Mod OptionFields Priority
-> Mod OptionFields Priority -> Mod OptionFields Priority
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Priority
forall a (f :: * -> *). Show a => Mod f a
showDefault
          )
        Parser Priority -> Parser Priority -> Parser Priority
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        Priority -> Mod FlagFields Priority -> Parser Priority
forall a. a -> Mod FlagFields a -> Parser a
flag' Priority
Debug
          (FilePath -> Mod FlagFields Priority
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"debug"
          Mod FlagFields Priority
-> Mod FlagFields Priority -> Mod FlagFields Priority
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Priority
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
          Mod FlagFields Priority
-> Mod FlagFields Priority -> Mod FlagFields Priority
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Priority
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"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.
      Parser
  (Maybe FilePath -> Bool -> Bool -> Int -> Bool -> GhcideArguments)
-> Parser (Maybe FilePath)
-> Parser (Bool -> Bool -> Int -> Bool -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
           ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"log-file"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LOGFILE"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Send logs to a file"
           )) Parser (Maybe FilePath)
-> Parser (Maybe FilePath) -> Parser (Maybe FilePath)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
           ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"logfile"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"LOGFILE"
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Send logs to a file"
          -- deprecated alias so users don't need to update their CLI calls
          -- immediately
          Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields FilePath
forall (f :: * -> *) a. Mod f a
internal
           )))
          )
      -- Boolean option so we can toggle the default in a consistent way
      Parser (Bool -> Bool -> Int -> Bool -> GhcideArguments)
-> Parser Bool -> Parser (Bool -> Int -> Bool -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Bool -> Mod OptionFields Bool -> Parser Bool
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Bool
forall a. Read a => ReadM a
auto
           ( FilePath -> Mod OptionFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"log-stderr"
          Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Send logs to stderr"
          Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Bool
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BOOL"
          Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> Bool -> Mod OptionFields Bool
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Bool
True
          Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
           )
      -- Boolean option so we can toggle the default in a consistent way
      Parser (Bool -> Int -> Bool -> GhcideArguments)
-> Parser Bool -> Parser (Int -> Bool -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Bool -> Mod OptionFields Bool -> Parser Bool
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Bool
forall a. Read a => ReadM a
auto
           ( FilePath -> Mod OptionFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"log-client"
          Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Send logs to the client using the window/logMessage LSP method"
          Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Bool
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BOOL"
          -- This is off by default, since some clients will show duplicate logs
          -- if we log both to stderr and the client
          Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> Bool -> Mod OptionFields Bool
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Bool
False
          Mod OptionFields Bool
-> Mod OptionFields Bool -> Mod OptionFields Bool
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Bool
forall a (f :: * -> *). Show a => Mod f a
showDefault
           )
      Parser (Int -> Bool -> GhcideArguments)
-> Parser Int -> Parser (Bool -> GhcideArguments)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
           (Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'j'
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Number of threads (0: automatic)"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUM"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
0
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault
           )
      Parser (Bool -> GhcideArguments)
-> Parser Bool -> Parser GhcideArguments
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"project-ghc-version"
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Work out the project GHC version and print it")
    where
        lspCommand :: Parser Command
lspCommand = Command
LSP Command -> Parser Bool -> Parser Command
forall a b. a -> Parser b -> Parser a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"lsp" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Start talking to an LSP server")
        checkCommand :: Parser Command
checkCommand = [FilePath] -> Command
Check ([FilePath] -> Command) -> Parser [FilePath] -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ReadM FilePath -> Mod ArgumentFields FilePath -> Parser FilePath
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM FilePath
forall s. IsString s => ReadM s
str (FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILES/DIRS..."))

-- ---------------------------------------------------------------------

haskellLanguageServerNumericVersion :: String
haskellLanguageServerNumericVersion :: FilePath
haskellLanguageServerNumericVersion = Version -> FilePath
showVersion Version
version

haskellLanguageServerVersion :: IO String
haskellLanguageServerVersion :: IO FilePath
haskellLanguageServerVersion = do
  FilePath
path <- IO FilePath
getExecutablePath
  let gi :: Either FilePath GitInfo
gi = $$FilePath
FilePath -> Either FilePath GitInfo
forall a b. a -> Either a b
tGitInfoCwdTry
      gitHashSection :: FilePath
gitHashSection = case Either FilePath GitInfo
gi of
        Right GitInfo
gi -> FilePath
" (GIT hash: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> GitInfo -> FilePath
giHash GitInfo
gi FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
")"
        Left FilePath
_   -> FilePath
""
  FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"haskell-language-server version: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
haskellLanguageServerNumericVersion
             FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" (GHC: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> VERSION_ghc
             FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
") (PATH: " FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
path FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
")"
             FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
gitHashSection