mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-10-05 14:47:21 +03:00
Redesign option parsing for executables. Fix #1578
This commit is contained in:
parent
f340cf1a5e
commit
0fc1c7280d
@ -84,8 +84,8 @@ main = do
|
||||
|
||||
let plugins' = plugins (optExamplePlugin opts)
|
||||
|
||||
if optLsp opts
|
||||
then do
|
||||
case optMode opts of
|
||||
LspMode -> do
|
||||
-- Start up in LSP mode
|
||||
logm $ "Run entered for HIE(" ++ progName ++ ") " ++ hieVersion
|
||||
logm $ "Operating as a LSP server on stdio"
|
||||
@ -106,7 +106,7 @@ main = do
|
||||
-- launch the dispatcher.
|
||||
scheduler <- newScheduler plugins' initOpts
|
||||
server scheduler origDir plugins' (optCaptureFile opts)
|
||||
else do
|
||||
ProjectLoadingMode projectLoadingOpts -> do
|
||||
-- Provide debug info
|
||||
cliOut $ "Running HIE(" ++ progName ++ ")"
|
||||
cliOut $ " " ++ hieVersion
|
||||
@ -128,7 +128,7 @@ main = do
|
||||
cliOut $ "Project Ghc version: " ++ projGhc
|
||||
cliOut $ "Libdir: " ++ show mlibdir
|
||||
cliOut "Searching for Haskell source files..."
|
||||
targets <- case optFiles opts of
|
||||
targets <- case optFiles projectLoadingOpts of
|
||||
[] -> findAllSourceFiles origDir
|
||||
xs -> concat <$> mapM findAllSourceFiles xs
|
||||
|
||||
@ -138,7 +138,7 @@ main = do
|
||||
mapM_ cliOut targets
|
||||
cliOut ""
|
||||
|
||||
unless (optDryRun opts) $ do
|
||||
unless (optDryRun projectLoadingOpts) $ do
|
||||
cliOut "\nLoad them all now. This may take a very long time.\n"
|
||||
loadDiagnostics <- runServer mlibdir plugins' targets
|
||||
|
||||
|
@ -203,6 +203,7 @@ test-suite unit-test
|
||||
HsImportSpec
|
||||
JsonSpec
|
||||
LiquidSpec
|
||||
OptionsSpec
|
||||
PackagePluginSpec
|
||||
Spec
|
||||
-- Technically cabal-helper should be a 'run-tool-depends', but that doesn't exist yet
|
||||
@ -225,6 +226,7 @@ test-suite unit-test
|
||||
, hie-plugin-api
|
||||
, hoogle > 5.0.11
|
||||
, hspec
|
||||
, optparse-applicative
|
||||
, process
|
||||
, quickcheck-instances
|
||||
, text
|
||||
|
@ -14,40 +14,66 @@ import System.IO
|
||||
import qualified System.Log.Logger as L
|
||||
import Data.Foldable
|
||||
|
||||
data ProjectLoadingOpts = ProjectLoadingOpts
|
||||
{ optDryRun :: Bool
|
||||
, optFiles :: [FilePath]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data RunMode = LspMode | ProjectLoadingMode ProjectLoadingOpts
|
||||
deriving (Show, Eq)
|
||||
|
||||
data GlobalOpts = GlobalOpts
|
||||
{ optDebugOn :: Bool
|
||||
, optLogFile :: Maybe String
|
||||
, optLsp :: Bool
|
||||
, projectRoot :: Maybe String
|
||||
, optBiosVerbose :: Bool
|
||||
, optCaptureFile :: Maybe FilePath
|
||||
, optExamplePlugin :: Bool
|
||||
, optDryRun :: Bool
|
||||
, optFiles :: [FilePath]
|
||||
} deriving (Show)
|
||||
, optMode :: RunMode
|
||||
} deriving (Show, Eq)
|
||||
|
||||
-- | Introduced as the common prefix of app/HieWrapper.hs/main and app/MainHie.hs/main
|
||||
initApp :: String -> IO GlobalOpts
|
||||
initApp namedesc = do
|
||||
hSetBuffering stderr LineBuffering
|
||||
let numericVersion :: Parser (a -> a)
|
||||
numericVersion = infoOption (showVersion Meta.version)
|
||||
(long "numeric-version" <> help "Show only version number")
|
||||
compiler :: Parser (a -> a)
|
||||
compiler = infoOption hieGhcDisplayVersion
|
||||
(long "compiler" <> help "Show only compiler and version supported")
|
||||
-- Parse the options and run
|
||||
(opts, ()) <- simpleOptions
|
||||
hieVersion
|
||||
namedesc
|
||||
""
|
||||
(numericVersion <*> compiler <*> globalOptsParser)
|
||||
optionParser
|
||||
empty
|
||||
Core.setupLogger (optLogFile opts) ["hie", "hie-bios"]
|
||||
$ if optDebugOn opts then L.DEBUG else L.INFO
|
||||
traverse_ setCurrentDirectory $ projectRoot opts
|
||||
return opts
|
||||
|
||||
optionParser :: Parser GlobalOpts
|
||||
optionParser = numericVersion <*> compiler <*> globalOptsParser
|
||||
|
||||
numericVersion :: Parser (a -> a)
|
||||
numericVersion = infoOption (showVersion Meta.version)
|
||||
(long "numeric-version" <> help "Show only version number")
|
||||
|
||||
compiler :: Parser (a -> a)
|
||||
compiler = infoOption hieGhcDisplayVersion
|
||||
(long "compiler" <> help "Show only compiler and version supported")
|
||||
|
||||
projectLoadingModeParser :: Parser RunMode
|
||||
projectLoadingModeParser =
|
||||
ProjectLoadingMode
|
||||
<$> (ProjectLoadingOpts
|
||||
<$> flag False True
|
||||
( long "dry-run"
|
||||
<> help "Perform a dry-run of loading files. Only searches for Haskell source files to load. Does nothing if run as LSP server."
|
||||
)
|
||||
<*> many
|
||||
( argument str
|
||||
( metavar "FILES..."
|
||||
<> help "Directories and Filepaths to load. Does nothing if run as LSP server.")
|
||||
)
|
||||
)
|
||||
|
||||
globalOptsParser :: Parser GlobalOpts
|
||||
globalOptsParser = GlobalOpts
|
||||
<$> switch
|
||||
@ -61,9 +87,6 @@ globalOptsParser = GlobalOpts
|
||||
<> metavar "LOGFILE"
|
||||
<> help "File to log to, defaults to stdout"
|
||||
))
|
||||
<*> flag False True
|
||||
( long "lsp"
|
||||
<> help "Start HIE as an LSP server. Otherwise it dumps debug info to stdout")
|
||||
<*> optional (strOption
|
||||
( long "project-root"
|
||||
<> short 'r'
|
||||
@ -88,13 +111,9 @@ globalOptsParser = GlobalOpts
|
||||
<*> switch
|
||||
( long "example"
|
||||
<> help "Enable Example2 plugin. Useful for developers only")
|
||||
<*> flag False True
|
||||
( long "dry-run"
|
||||
<> help "Perform a dry-run of loading files. Only searches for Haskell source files to load. Does nothing if run as LSP server."
|
||||
)
|
||||
<*> many
|
||||
( argument str
|
||||
( metavar "FILES..."
|
||||
<> help "Directories and Filepaths to load. Does nothing if run as LSP server.")
|
||||
)
|
||||
|
||||
<*> (flag' LspMode
|
||||
( long "lsp"
|
||||
<> help "Start HIE as an LSP server. Otherwise it dumps debug info to stdout")
|
||||
<|>
|
||||
projectLoadingModeParser
|
||||
)
|
||||
|
70
test/unit/OptionsSpec.hs
Normal file
70
test/unit/OptionsSpec.hs
Normal file
@ -0,0 +1,70 @@
|
||||
module OptionsSpec where
|
||||
|
||||
import Prelude hiding (unzip)
|
||||
import Data.List.NonEmpty(unzip)
|
||||
import Test.Hspec
|
||||
import Options.Applicative
|
||||
import Haskell.Ide.Engine.Options(GlobalOpts(..), RunMode(..), ProjectLoadingOpts(..), optionParser)
|
||||
import System.Exit(ExitCode(..))
|
||||
import Data.List(isPrefixOf)
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
let defaultGlobalOptions = GlobalOpts False Nothing Nothing False Nothing False (ProjectLoadingMode $ ProjectLoadingOpts False [])
|
||||
let getParseFailure (Failure x) = Just (renderFailure x "hie")
|
||||
getParseFailure _ = Nothing
|
||||
let sut = optionParser
|
||||
let parserInfo = info sut mempty
|
||||
let parserPrefs = prefs mempty
|
||||
let runSut :: [String] -> ParserResult GlobalOpts
|
||||
runSut = execParserPure parserPrefs parserInfo
|
||||
|
||||
describe "cmd option parsing" $ do
|
||||
describe "compiler flag" $ do
|
||||
let input = ["--compiler"]
|
||||
let result = runSut input
|
||||
let (maybeMessage, maybeStatusCode) = unzip $ getParseFailure result
|
||||
|
||||
it "should return ghc version" $
|
||||
maybeMessage `shouldSatisfy` any ("ghc" `isPrefixOf`)
|
||||
it "should return exit code 0" $
|
||||
maybeStatusCode `shouldBe` Just ExitSuccess
|
||||
|
||||
describe "numeric version flag" $ do
|
||||
let input = ["--numeric-version"]
|
||||
let result = runSut input
|
||||
let (maybeMessage, maybeStatusCode) = unzip $ getParseFailure result
|
||||
|
||||
it "should return version" $
|
||||
maybeMessage `shouldBe` Just "1.1"
|
||||
it "shoud return exit code 0" $
|
||||
maybeStatusCode `shouldBe` Just ExitSuccess
|
||||
|
||||
describe "not providing arguments" $ do
|
||||
let input = []
|
||||
let result = runSut input
|
||||
let maybeGlobalOptions = getParseResult result
|
||||
|
||||
it "should result in default options" $
|
||||
maybeGlobalOptions `shouldBe` Just defaultGlobalOptions
|
||||
|
||||
describe "lsp flag" $ do
|
||||
let input = ["--lsp"]
|
||||
let result = runSut input
|
||||
let maybeGlobalOptions = getParseResult result
|
||||
|
||||
it "should result in default lsp options" $
|
||||
maybeGlobalOptions `shouldBe` Just (GlobalOpts False Nothing Nothing False Nothing False LspMode)
|
||||
|
||||
describe "providing two unmatching arguments" $ do
|
||||
let input = ["--lsp", "--dry-run"]
|
||||
let result = runSut input
|
||||
let (maybeMessage, maybeStatusCode) = unzip $ getParseFailure result
|
||||
|
||||
it "should return expected error message" $
|
||||
maybeMessage `shouldSatisfy` any ("Invalid option `--dry-run'" `isPrefixOf`)
|
||||
it "should return error exit code 1" $
|
||||
maybeStatusCode `shouldBe` Just (ExitFailure 1)
|
Loading…
Reference in New Issue
Block a user