Merge pull request #903 from commercialhaskell/806-exec-help-hack

Hacky workaround for optparse-applicative issue with stack exec --help
commercialhaskell · Sep 2, 2015 · c17c5a6 · c17c5a6
2 parents 1c2db32 + d36a58a
commit c17c5a6
Show file tree

Hide file tree

Showing 4 changed files with 21 additions and 10 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -11,6 +11,8 @@ Other enhancements:
 
 Bug fixes:
 
+* Hacky workaround for optparse-applicative issue with `stack exec --help` [#806](https://github.com/commercialhaskell/stack/issues/806)
+
 ## 0.1.4.0
 
 Major changes:

diff --git 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
@@ -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
@@ -769,19 +769,24 @@ 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
             withUserFileLock (configStackRoot $ lcConfig lc) $ \lk ->
              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 {..} ->
@@ -792,7 +797,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 ()