diff --git a/ChangeLog.md b/ChangeLog.md index ebf9c4b560..7f38fec63e 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -31,6 +31,7 @@ Bug fixes: * Create missing directories for `stack sdist` * Don't ignore .cabal files with extra periods [#895](https://github.com/commercialhaskell/stack/issues/895) * Deprecate unused `--optimizations` flag +* Hacky workaround for optparse-applicative issue with `stack exec --help` [#806](https://github.com/commercialhaskell/stack/issues/806) ## 0.1.3.1 diff --git a/src/Stack/Options.hs b/src/Stack/Options.hs index d5c77540a0..61342d87b3 100644 --- a/src/Stack/Options.hs +++ b/src/Stack/Options.hs @@ -445,18 +445,19 @@ execOptsParser :: Maybe String -- ^ command -> Parser ExecOpts execOptsParser mcmd = ExecOpts - <$> maybe eoCmdParser pure mcmd + <$> pure mcmd <*> eoArgsParser <*> (eoPlainParser <|> ExecOptsEmbellished <$> eoEnvSettingsParser <*> eoPackagesParser) where - eoCmdParser :: Parser String - eoCmdParser = strArgument (metavar "CMD") - eoArgsParser :: Parser [String] - eoArgsParser = many (strArgument (metavar "-- ARGS (e.g. stack ghc -- X.hs -o x)")) + eoArgsParser = many (strArgument (metavar meta)) + where + meta = + (maybe ("CMD ") (const "") mcmd) ++ + "-- ARGS (e.g. stack ghc -- X.hs -o x)" eoEnvSettingsParser :: Parser EnvSettings eoEnvSettingsParser = EnvSettings diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index 7c3e42f8b5..6b7b8fc448 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -196,7 +196,10 @@ data EnvSettings = EnvSettings deriving (Show, Eq, Ord) data ExecOpts = ExecOpts - { eoCmd :: !String + { eoCmd :: !(Maybe String) + -- ^ Usage of @Maybe@ here is nothing more than a hack, to avoid some weird + -- bug in optparse-applicative. See: + -- https://github.com/commercialhaskell/stack/issues/806 , eoArgs :: ![String] , eoExtra :: !ExecOptsExtra } diff --git a/src/main/Main.hs b/src/main/Main.hs index 23050a140e..8e078c21c9 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -761,7 +761,12 @@ sdistCmd dirs go = -- | Execute a command. execCmd :: ExecOpts -> GlobalOpts -> IO () -execCmd ExecOpts {..} go@GlobalOpts{..} = +execCmd ExecOpts {..} go@GlobalOpts{..} = do + (cmd, args) <- + case (eoCmd, eoArgs) of + (Just cmd, args) -> return (cmd, args) + (Nothing, cmd:args) -> return (cmd, args) + (Nothing, []) -> error "You must provide a command to exec, e.g. 'stack exec echo Hello World'" case eoExtra of ExecOptsPlain -> do (manager,lc) <- liftIO $ loadConfigWithOpts go @@ -769,11 +774,11 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = runStackTGlobal manager (lcConfig lc) go $ Docker.execWithOptionalContainer (lcProjectRoot lc) - (return (eoCmd, eoArgs, [], id)) + (return (cmd, args, [], id)) -- Unlock before transferring control away, whether using docker or not: (Just $ liftIO $ unlockFile lk) (runStackTGlobal manager (lcConfig lc) go $ do - exec plainEnvSettings eoCmd eoArgs) + exec plainEnvSettings cmd args) Nothing Nothing -- Unlocked already above. ExecOptsEmbellished {..} -> @@ -784,7 +789,7 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = { boptsTargets = map T.pack targets } liftIO $ unlockFile lk -- Unlock before transferring control away. - exec eoEnvSettings eoCmd eoArgs + exec eoEnvSettings cmd args -- | Run GHCi in the context of a project. ghciCmd :: GhciOpts -> GlobalOpts -> IO ()