-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-} -- To get precise GHC version
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-dodgy-imports #-} -- GHC no longer exports def in GHC 8.6 and above

module Ide.Arguments
  ( Arguments(..)
  , LspArguments(..)
  , PrintVersion(..)
  , getArguments
  , haskellLanguageServerVersion
  , haskellLanguageServerNumericVersion
  ) where

import Data.Version
import Development.GitRev
import Options.Applicative
import Paths_haskell_language_server
import System.Environment

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

data Arguments
  = VersionMode PrintVersion
  | ProbeToolsMode
  | LspMode LspArguments
  deriving Int -> Arguments -> ShowS
[Arguments] -> ShowS
Arguments -> String
(Int -> Arguments -> ShowS)
-> (Arguments -> String)
-> ([Arguments] -> ShowS)
-> Show Arguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arguments] -> ShowS
$cshowList :: [Arguments] -> ShowS
show :: Arguments -> String
$cshow :: Arguments -> String
showsPrec :: Int -> Arguments -> ShowS
$cshowsPrec :: Int -> Arguments -> ShowS
Show

data LspArguments = LspArguments
    {LspArguments -> Bool
argLSP :: Bool
    ,LspArguments -> Maybe String
argsCwd :: Maybe FilePath
    ,LspArguments -> [String]
argFiles :: [FilePath]
    ,LspArguments -> Maybe String
argsShakeProfiling :: Maybe FilePath
    ,LspArguments -> Bool
argsTesting :: Bool
    ,LspArguments -> 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.
    , LspArguments -> Bool
argsDebugOn       :: Bool
    , LspArguments -> Maybe String
argsLogFile       :: Maybe String
    , LspArguments -> Int
argsThreads       :: Int
    , LspArguments -> Bool
argsProjectGhcVersion :: Bool
    } deriving Int -> LspArguments -> ShowS
[LspArguments] -> ShowS
LspArguments -> String
(Int -> LspArguments -> ShowS)
-> (LspArguments -> String)
-> ([LspArguments] -> ShowS)
-> Show LspArguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LspArguments] -> ShowS
$cshowList :: [LspArguments] -> ShowS
show :: LspArguments -> String
$cshow :: LspArguments -> String
showsPrec :: Int -> LspArguments -> ShowS
$cshowsPrec :: Int -> LspArguments -> ShowS
Show

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

getArguments :: String -> IO Arguments
getArguments :: String -> IO Arguments
getArguments String
exeName = 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
<$> String -> Parser PrintVersion
printVersionParser String
exeName
      Parser Arguments -> Parser Arguments -> Parser Arguments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Parser Arguments
probeToolsParser String
exeName
      Parser Arguments -> Parser Arguments -> Parser Arguments
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LspArguments -> Arguments
LspMode (LspArguments -> Arguments)
-> Parser LspArguments -> Parser Arguments
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser LspArguments
arguments)
      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
<> String -> InfoMod Arguments
forall a. String -> InfoMod a
progDesc String
"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
<> String -> InfoMod Arguments
forall a. String -> InfoMod a
header (String
exeName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - GHC Haskell LSP server"))

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

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

arguments :: Parser LspArguments
arguments :: Parser LspArguments
arguments = Bool
-> Maybe String
-> [String]
-> Maybe String
-> Bool
-> Bool
-> Bool
-> Maybe String
-> Int
-> Bool
-> LspArguments
LspArguments
      (Bool
 -> Maybe String
 -> [String]
 -> Maybe String
 -> Bool
 -> Bool
 -> Bool
 -> Maybe String
 -> Int
 -> Bool
 -> LspArguments)
-> Parser Bool
-> Parser
     (Maybe String
      -> [String]
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Int
      -> Bool
      -> LspArguments)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"lsp" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Start talking to an LSP server")
      Parser
  (Maybe String
   -> [String]
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Int
   -> Bool
   -> LspArguments)
-> Parser (Maybe String)
-> Parser
     ([String]
      -> Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Int
      -> Bool
      -> LspArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"cwd" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
                  Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Change to this directory")
      Parser
  ([String]
   -> Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Int
   -> Bool
   -> LspArguments)
-> Parser [String]
-> Parser
     (Maybe String
      -> Bool
      -> Bool
      -> Bool
      -> Maybe String
      -> Int
      -> Bool
      -> LspArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ReadM String -> Mod ArgumentFields String -> Parser String
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM String
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILES/DIRS..."))
      Parser
  (Maybe String
   -> Bool
   -> Bool
   -> Bool
   -> Maybe String
   -> Int
   -> Bool
   -> LspArguments)
-> Parser (Maybe String)
-> Parser
     (Bool
      -> Bool -> Bool -> Maybe String -> Int -> Bool -> LspArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String -> Parser String)
-> Mod OptionFields String -> Parser String
forall a b. (a -> b) -> a -> b
$ String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"shake-profiling" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"DIR"
                  Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Dump profiling reports to this directory")
      Parser
  (Bool
   -> Bool -> Bool -> Maybe String -> Int -> Bool -> LspArguments)
-> Parser Bool
-> Parser
     (Bool -> Bool -> Maybe String -> Int -> Bool -> LspArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"test"
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Enable additional lsp messages used by the testsuite")
      Parser
  (Bool -> Bool -> Maybe String -> Int -> Bool -> LspArguments)
-> Parser Bool
-> Parser (Bool -> Maybe String -> Int -> Bool -> LspArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"example"
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Include the Example Plugin. For Plugin devs only")

      Parser (Bool -> Maybe String -> Int -> Bool -> LspArguments)
-> Parser Bool
-> Parser (Maybe String -> Int -> Bool -> LspArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
           ( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"debug"
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'd'
          Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Generate debug output"
           )
      Parser (Maybe String -> Int -> Bool -> LspArguments)
-> Parser (Maybe String) -> Parser (Int -> Bool -> LspArguments)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
           ( String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"logfile"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"LOGFILE"
          Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"File to log to, defaults to stdout"
           ))
      Parser (Int -> Bool -> LspArguments)
-> Parser Int -> Parser (Bool -> LspArguments)
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
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of threads (0: automatic)"
          Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"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 -> LspArguments) -> Parser Bool -> Parser LspArguments
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"project-ghc-version"
                  Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Work out the project GHC version and print it")

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

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

haskellLanguageServerVersion :: IO String
haskellLanguageServerVersion :: IO String
haskellLanguageServerVersion = do
  String
path <- IO String
getExecutablePath
  let gitHashSection :: String
gitHashSection = case $(String
gitHash) of
        String
x | String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"UNKNOWN" -> String
""
        String
x -> String
" (GIT hash: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
x String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
  String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"haskell-language-server version: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
haskellLanguageServerNumericVersion
             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" (GHC: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> VERSION_ghc
             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") (PATH: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
path String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
             String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
gitHashSection