From 0d511e665c07118449b04856aeef00405171174c Mon Sep 17 00:00:00 2001 From: Khan Thompson Date: Sun, 15 Oct 2017 23:24:15 +1100 Subject: [PATCH 1/2] Implement #3264 adding --cwd to exec Welcome for any suggestions as to better methods to use/docs to update. --- src/Stack/Options/ExecParser.hs | 7 +++++++ src/Stack/Types/Config.hs | 1 + src/main/Main.hs | 19 +++++++++++++++++-- 3 files changed, 25 insertions(+), 2 deletions(-) diff --git a/src/Stack/Options/ExecParser.hs b/src/Stack/Options/ExecParser.hs index 21631d9995..b4e894a069 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,9 @@ 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") + ) 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..00898232b0 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 (isRelative, 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,20 @@ execCmd ExecOpts {..} go@GlobalOpts{..} = pkgopts <- getPkgOpts menv wc pkgs return (prefix ++ compilerExeName wc, pkgopts ++ args) + runWithPath path callback = case path of + Nothing -> callback + Just p | not (isValid p) -> callback + Just p -> + if isRelative p + then parseRelDir p >>= runInDirectory + else parseAbsDir p >>= runInDirectory + where + runInDirectory :: (Path t Dir) -> RIO EnvConfig () + runInDirectory directory = + withUnliftIO $ \unlift -> + withCurrentDir directory $ unliftIO unlift callback + + -- | Evaluate some haskell code inline. evalCmd :: EvalOpts -> GlobalOpts -> IO () evalCmd EvalOpts {..} go@GlobalOpts {..} = execCmd execOpts go From 68854704e62e3f3d7e6f8b615d4333039d2c8fcd Mon Sep 17 00:00:00 2001 From: Khan Thompson Date: Wed, 18 Oct 2017 10:34:08 +1100 Subject: [PATCH 2/2] Changes based on feedback * Use System.Directory.withCurrentDirectory * Throw an exception for invalid paths * Add in better options --- src/Stack/Options/ExecParser.hs | 4 +++- src/main/Main.hs | 23 ++++++++++------------- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/src/Stack/Options/ExecParser.hs b/src/Stack/Options/ExecParser.hs index b4e894a069..c303e5b4a5 100644 --- a/src/Stack/Options/ExecParser.hs +++ b/src/Stack/Options/ExecParser.hs @@ -75,5 +75,7 @@ execOptsExtraParser = eoPlainParser <|> eoCwdParser :: Parser (Maybe FilePath) eoCwdParser = optional (strOption (long "cwd" - <> help "Sets the working directory before executing") + <> help "Sets the working directory before executing" + <> metavar "DIR" + <> completer dirCompleter) ) diff --git a/src/main/Main.hs b/src/main/Main.hs index 00898232b0..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 (isRelative, isValid, 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 @@ -789,19 +789,11 @@ 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) -> callback - Just p -> - if isRelative p - then parseRelDir p >>= runInDirectory - else parseAbsDir p >>= runInDirectory - where - runInDirectory :: (Path t Dir) -> RIO EnvConfig () - runInDirectory directory = - withUnliftIO $ \unlift -> - withCurrentDir directory $ unliftIO unlift callback - + 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 () @@ -938,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 @@ -949,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 + , ")"]