Redesign option parsing for executables. Fix #1578

Author: gdziadkiewicz

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
 

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

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
+      )

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)