Add executable fall-through

ChangeLog.md

@@ -14,6 +14,9 @@ Other enhancements:
   [#1412](https://github.com/commercialhaskell/stack/issues/1412)
 * Add optional GPG signing on `stack upload --sign` or with
   `stack sig sign ...`
+* Support git-style executable fall-through (`stack something` executes
+  `stack-something` if present)
+  [#1433](https://github.com/commercialhaskell/stack/issues/1433)
 
 Bug fixes:
 

src/Options/Applicative/Complicated.hs

@@ -35,13 +35,18 @@ complicatedOptions
   -- ^ program description
   -> Parser a
   -- ^ common settings
+  -> Maybe (ParserFailure ParserHelp -> [String] -> IO (a,(b,a)))
+  -- ^ optional handler for parser failure; 'handleParseResult' is called by
+  -- default
   -> EitherT b (Writer (Mod CommandFields (b,a))) ()
   -- ^ commands (use 'addCommand')
   -> IO (a,b)
-complicatedOptions numericVersion versionString h pd commonParser commandParser =
+complicatedOptions numericVersion versionString h pd commonParser mOnFailure commandParser =
   do args <- getArgs
      (a,(b,c)) <- case execParserPure (prefs noBacktrack) parser args of
        Failure _ | null args -> withArgs ["--help"] (execParser parser)
+       -- call onFailure handler if it's present and parsing options failed
+       Failure f | Just onFailure <- mOnFailure -> onFailure f args
        parseResult -> handleParseResult parseResult
      return (mappend c a,b)
   where parser = info (helpOption <*> versionOptions <*> complicatedParser commonParser commandParser) desc

src/Stack/Exec.hs

@@ -14,6 +14,7 @@ import           Control.Monad.Catch hiding (try)
 import           Control.Monad.Trans.Control (MonadBaseControl)
 import           Stack.Types
 import           System.Process.Log
+import           System.Process.Read (EnvOverride)
 
 #ifdef WINDOWS
 import           Control.Exception.Lifted
@@ -44,11 +45,9 @@ plainEnvSettings = EnvSettings
     }
 
 -- | Execute a process within the Stack configured environment.
-exec :: (HasConfig r, MonadReader r m, MonadIO m, MonadLogger m, MonadThrow m, MonadBaseControl IO m)
-     => EnvSettings -> String -> [String] -> m b
-exec envSettings cmd0 args = do
-    config <- asks getConfig
-    menv <- liftIO (configEnvOverride config envSettings)
+exec :: (MonadIO m, MonadLogger m, MonadThrow m, MonadBaseControl IO m)
+     => EnvOverride -> String -> [String] -> m b
+exec menv cmd0 args = do
     $logProcessRun cmd0 args
 #ifdef WINDOWS
     e <- try (callProcess Nothing menv cmd0 args)

src/Stack/Ghci.hs

@@ -116,8 +116,9 @@ ghci GhciOpts{..} = do
     $logInfo
         ("Configuring GHCi with the following packages: " <>
          T.intercalate ", " (map (packageNameText . ghciPkgName) pkgs))
-    let execGhci extras =
-            exec defaultEnvSettings
+    let execGhci extras = do
+            menv <- liftIO $ configEnvOverride config defaultEnvSettings
+            exec menv
                  (fromMaybe (compilerExeName wc) ghciGhcCommand)
                  ("--interactive" :
                  -- This initial "-i" resets the include directories to not

src/main/Main.hs

@@ -37,7 +37,7 @@ import           Data.Version (showVersion)
 #ifdef USE_GIT_INFO
 import           Development.GitRev (gitCommitCount, gitHash)
 #endif
-import           Distribution.System (buildArch)
+import           Distribution.System (buildArch, buildPlatform)
 import           Distribution.Text (display)
 import           GHC.IO.Encoding (mkTextEncoding, textEncodingName)
 import           Network.HTTP.Client
@@ -84,6 +84,7 @@ import           Stack.Types.StackT
 import           Stack.Upgrade
 import qualified Stack.Upload as Upload
 import           System.Directory (canonicalizePath, doesFileExist, doesDirectoryExist, createDirectoryIfMissing)
+import qualified System.Directory as Directory (findExecutable)
 import           System.Environment (getEnvironment, getProgName)
 import           System.Exit
 import           System.FileLock (lockFile, tryLockFile, unlockFile, SharedExclusive(Exclusive), FileLock)
@@ -147,6 +148,21 @@ main = withInterpreterArgs stackProgName $ \args isInterpreter -> do
          "stack - The Haskell Tool Stack"
          ""
          (globalOpts False)
+         -- when there's a parse failure
+         (Just $ \f as ->
+           -- fall-through to external executables in `git` style if they exist
+           -- (i.e. `stack something` looks for `stack-something` before
+           -- failing with "Invalid argument `something'")
+           case stripPrefix "Invalid argument" (fst (renderFailure f "")) of
+             Just _ -> do
+               mExternalExec <- Directory.findExecutable ("stack-" ++ head as)
+               case mExternalExec of
+                 Just ex -> do
+                   menv <- getEnvOverride buildPlatform
+                   runNoLoggingT (exec menv ex (tail as))
+                 Nothing -> handleParseResult (Failure f)
+             Nothing -> handleParseResult (Failure f)
+         )
          (do addCommand' "build"
                         "Build the package(s) in this directory/configuration"
                         cmdFooter
@@ -912,17 +928,20 @@ execCmd ExecOpts {..} go@GlobalOpts{..} =
                  (ExecRunGhc, args) -> return ("runghc", args)
             (manager,lc) <- liftIO $ loadConfigWithOpts go
             withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk ->
-             runStackTGlobal manager (lcConfig lc) go $
+              runStackTGlobal manager (lcConfig lc) go $
                 Docker.reexecWithOptionalContainer
                     (lcProjectRoot lc)
                     -- Unlock before transferring control away, whether using docker or not:
                     (Just $ munlockFile lk)
-                    (runStackTGlobal manager (lcConfig lc) go $
-                        exec plainEnvSettings cmd args)
+                    (runStackTGlobal manager (lcConfig lc) go $ do
+                        config <- asks getConfig
+                        menv <- liftIO $ configEnvOverride config plainEnvSettings
+                        exec menv cmd args)
                     Nothing
                     Nothing -- Unlocked already above.
         ExecOptsEmbellished {..} ->
            withBuildConfigAndLock go $ \lk -> do
+               config <- asks getConfig
                (cmd, args) <- case (eoCmd, eoArgs) of
                    (ExecCmd cmd, args) -> return (cmd, args)
                    (ExecGhc, args) -> execCompiler "" args
@@ -935,7 +954,8 @@ execCmd ExecOpts {..} go@GlobalOpts{..} =
                        { boptsTargets = map T.pack targets
                        }
                munlockFile lk -- Unlock before transferring control away.
-               exec eoEnvSettings cmd args
+               menv <- liftIO $ configEnvOverride config eoEnvSettings
+               exec menv cmd args
   where
     execCompiler cmdPrefix args = do
         wc <- getWhichCompiler