diff --git a/src/Stack/Options/ExecParser.hs b/src/Stack/Options/ExecParser.hs index 21631d9995..c303e5b4a5 100644 --- a/src/Stack/Options/ExecParser.hs +++ b/src/Stack/Options/ExecParser.hs @@ -43,6 +43,7 @@ execOptsExtraParser = eoPlainParser <|> <$> eoEnvSettingsParser <*> eoPackagesParser <*> eoRtsOptionsParser + <*> eoCwdParser where eoEnvSettingsParser :: Parser EnvSettings eoEnvSettingsParser = EnvSettings @@ -70,3 +71,11 @@ execOptsExtraParser = eoPlainParser <|> eoPlainParser = flag' ExecOptsPlain (long "plain" <> help "Use an unmodified environment (only useful with Docker)") + + eoCwdParser :: Parser (Maybe FilePath) + eoCwdParser = optional + (strOption (long "cwd" + <> help "Sets the working directory before executing" + <> metavar "DIR" + <> completer dirCompleter) + ) diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index 44f586510e..6a30721b19 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -430,6 +430,7 @@ data ExecOptsExtra { eoEnvSettings :: !EnvSettings , eoPackages :: ![String] , eoRtsOptions :: ![String] + , eoCwd :: !(Maybe FilePath) } deriving (Show) diff --git a/src/main/Main.hs b/src/main/Main.hs index 2c68d8f382..52183a6711 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -105,7 +105,7 @@ import qualified Stack.Upload as Upload import qualified System.Directory as D import System.Environment (getProgName, getArgs, withArgs) import System.Exit -import System.FilePath (pathSeparator) +import System.FilePath (isValid, pathSeparator) import System.IO (hIsTerminalDevice, stderr, stdin, stdout, hSetBuffering, BufferMode(..), hPutStrLn, hGetEncoding, hSetEncoding) -- | Change the character encoding of the given Handle to transliterate @@ -767,7 +767,8 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = (ExecRunGhc, args) -> getGhcCmd "run" menv eoPackages args munlockFile lk -- Unlock before transferring control away. - exec menv cmd args + + runWithPath eoCwd $ exec menv cmd args where -- return the package-id of the first package in GHC_PACKAGE_PATH getPkgId menv wc name = do @@ -788,6 +789,12 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = pkgopts <- getPkgOpts menv wc pkgs return (prefix ++ compilerExeName wc, pkgopts ++ args) + runWithPath :: Maybe FilePath -> RIO EnvConfig () -> RIO EnvConfig () + runWithPath path callback = case path of + Nothing -> callback + Just p | not (isValid p) -> throwIO $ InvalidPathForExec p + Just p -> withUnliftIO $ \ul -> D.withCurrentDirectory p $ unliftIO ul callback + -- | Evaluate some haskell code inline. evalCmd :: EvalOpts -> GlobalOpts -> IO () evalCmd EvalOpts {..} go@GlobalOpts {..} = execCmd execOpts go @@ -923,6 +930,7 @@ hpcReportCmd hropts go = withBuildConfig go $ generateHpcReportForTargets hropts data MainException = InvalidReExecVersion String String | UpgradeCabalUnusable + | InvalidPathForExec FilePath deriving (Typeable) instance Exception MainException instance Show MainException where @@ -934,3 +942,7 @@ instance Show MainException where , "; found: " , actual] show UpgradeCabalUnusable = "--upgrade-cabal cannot be used when nix is activated" + show (InvalidPathForExec path) = concat + [ "Got an invalid --cwd argument for stack exec (" + , path + , ")"]