--no-ghc-package-path flag

commercialhaskell · Jun 24, 2015 · cbde66a · cbde66a
1 parent 2354251
commit cbde66a
Show file tree

Hide file tree

Showing 4 changed files with 28 additions and 17 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -8,6 +8,7 @@
 * stack init in multi-package project should use local packages for dependency checking [#384](https://github.com/commercialhaskell/stack/issues/384)
 * Display information on why a snapshot was rejected [#381](https://github.com/commercialhaskell/stack/issues/381)
 * Give a reason for unregistering packages [#389](https://github.com/commercialhaskell/stack/issues/389)
+* `stack exec` accepts the `--no-ghc-package-path` parameter
 
 ## 0.1.0.0
 

diff --git a/src/Stack/Exec.hs b/src/Stack/Exec.hs
@@ -18,17 +18,19 @@ import           System.Exit
 import qualified System.Process as P
 import           System.Process.Read
 
+-- | Default @EnvSettings@ which includes locals and GHC_PACKAGE_PATH
+defaultEnvSettings :: EnvSettings
+defaultEnvSettings = EnvSettings
+    { esIncludeLocals = True
+    , esIncludeGhcPackagePath = True
+    }
 
 -- | Execute a process within the Stack configured environment.
 exec :: (HasConfig r, MonadReader r m, MonadIO m, MonadLogger m, MonadThrow m)
-        => String -> [String] -> m b
-exec cmd args = do
+        => EnvSettings -> String -> [String] -> m b
+exec envSettings cmd args = do
     config <- asks getConfig
-    menv <- liftIO (configEnvOverride config
-                            EnvSettings
-                                { esIncludeLocals = True
-                                , esIncludeGhcPackagePath = True
-                                })
+    menv <- liftIO (configEnvOverride config envSettings)
     exists <- liftIO $ doesFileExist cmd
     cmd' <-
         if exists

diff --git a/src/Stack/Repl.hs b/src/Stack/Repl.hs
@@ -69,7 +69,7 @@ repl targets useropts ghciPath noload = do
     $logInfo
         ("Configuring GHCi with the following packages: " <>
          T.intercalate ", " (map packageNameText (map _1 pkgs)))
-    exec ghciPath ("--interactive" : pkgopts <> srcfiles <> useropts)
+    exec defaultEnvSettings ghciPath ("--interactive" : pkgopts <> srcfiles <> useropts)
   where
     wanted pwd cabalfp pkg = isInWantedList || targetsEmptyAndInDir
       where

diff --git a/src/main/Main.hs b/src/main/Main.hs
@@ -142,15 +142,22 @@ main =
              addCommand "exec"
                         "Execute a command"
                         execCmd
-                        ((,)
+                        ((,,)
                             <$> strArgument (metavar "CMD")
-                            <*> many (strArgument (metavar "-- ARGS (e.g. stack exec -- ghc --version)")))
+                            <*> many (strArgument (metavar "-- ARGS (e.g. stack exec -- ghc --version)"))
+                            <*> (EnvSettings
+                                    <$> pure True
+                                    <*> boolFlags True
+                                            "ghc-package-path"
+                                            "setting the GHC_PACKAGE_PATH variable for the subprocess"
+                                            idm))
              addCommand "ghc"
                         "Run ghc"
                         execCmd
-                        ((,)
+                        ((,,)
                             <$> pure "ghc"
-                            <*> many (strArgument (metavar "-- ARGS (e.g. stack ghc -- X.hs -o x)")))
+                            <*> many (strArgument (metavar "-- ARGS (e.g. stack ghc -- X.hs -o x)"))
+                            <*> pure defaultEnvSettings)
              addCommand "ghci"
                         "Run ghci in the context of project(s)"
                         replCmd
@@ -172,9 +179,10 @@ main =
              addCommand "runghc"
                         "Run runghc"
                         execCmd
-                        ((,)
+                        ((,,)
                             <$> pure "runghc"
-                            <*> many (strArgument (metavar "-- ARGS (e.g. stack runghc -- X.hs)")))
+                            <*> many (strArgument (metavar "-- ARGS (e.g. stack runghc -- X.hs)"))
+                            <*> pure defaultEnvSettings)
              addCommand "clean"
                         "Clean the local packages"
                         cleanCmd
@@ -498,10 +506,10 @@ uploadCmd args0 go = withBuildConfig go ExecStrategy $ do
         mapM_ (Upload.upload uploader) args
 
 -- | Execute a command.
-execCmd :: (String, [String]) -> GlobalOpts -> IO ()
-execCmd (cmd,args) go@GlobalOpts{..} =
+execCmd :: (String, [String],EnvSettings) -> GlobalOpts -> IO ()
+execCmd (cmd,args,envSettings) go@GlobalOpts{..} =
     withBuildConfig go ExecStrategy $
-    exec cmd args
+    exec envSettings cmd args
 
 -- | Run the REPL in the context of a project, with
 replCmd :: ([Text], [String], FilePath, Bool) -> GlobalOpts -> IO ()