From 951b2be03cc91de7953ebb8b91194b3655f4362c Mon Sep 17 00:00:00 2001 From: gdziadkiewicz Date: Fri, 14 Feb 2020 13:54:23 +0100 Subject: [PATCH] Redesign option parsing for executables. Fix #1578 --- app/MainHie.hs | 10 ++--- haskell-ide-engine.cabal | 2 + src/Haskell/Ide/Engine/Options.hs | 67 ++++++++++++++++++----------- test/unit/OptionsSpec.hs | 70 +++++++++++++++++++++++++++++++ 4 files changed, 120 insertions(+), 29 deletions(-) create mode 100644 test/unit/OptionsSpec.hs diff --git a/app/MainHie.hs b/app/MainHie.hs index 617695ff3..eb4654a7b 100644 --- a/app/MainHie.hs +++ b/app/MainHie.hs @@ -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 diff --git a/haskell-ide-engine.cabal b/haskell-ide-engine.cabal index 0efc2dbea..d7dfb737f 100644 --- a/haskell-ide-engine.cabal +++ b/haskell-ide-engine.cabal @@ -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 diff --git a/src/Haskell/Ide/Engine/Options.hs b/src/Haskell/Ide/Engine/Options.hs index 4c1917331..1341c87c3 100644 --- a/src/Haskell/Ide/Engine/Options.hs +++ b/src/Haskell/Ide/Engine/Options.hs @@ -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 + ) diff --git a/test/unit/OptionsSpec.hs b/test/unit/OptionsSpec.hs new file mode 100644 index 000000000..ca3862a04 --- /dev/null +++ b/test/unit/OptionsSpec.hs @@ -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)