Split off process execution into library (#130)

src/Stack/Exec.hs

@@ -0,0 +1,31 @@
+-- | Execute commands within the properly configured Stack
+-- environment.
+
+module Stack.Exec where
+
+import           Control.Monad.Reader
+import           Path
+import           Stack.Types
+import           System.Exit
+import qualified System.Process as P
+import           System.Process.Read
+
+-- | Execute a process within the Stack configured environment.
+exec :: (HasConfig r, MonadReader r m, MonadIO m)
+        => String -> [String] -> m b
+exec cmd args = do
+    config <- asks getConfig
+    liftIO $ do
+        menv <- configEnvOverride config
+                        EnvSettings
+                            { esIncludeLocals = True
+                            , esIncludeGhcPackagePath = True
+                            }
+        cmd' <- join $ System.Process.Read.findExecutable menv cmd
+        let cp = (P.proc (toFilePath cmd') args)
+                { P.env = envHelper menv
+                , P.delegate_ctlc = True
+                }
+        (Nothing, Nothing, Nothing, ph) <- P.createProcess cp
+        ec <- P.waitForProcess ph
+        exitWith ec

src/main/Main.hs

@@ -37,8 +37,9 @@ import           Stack.Build.Types
 import           Stack.Config
 import           Stack.Constants
 import qualified Stack.Docker as Docker
+import           Stack.Exec
 import           Stack.Fetch
-import           Stack.GhcPkg (envHelper,getCabalPkgVer)
+import           Stack.GhcPkg (getCabalPkgVer)
 import qualified Stack.PackageIndex
 import           Stack.Path
 import           Stack.Setup
@@ -49,7 +50,6 @@ import           System.Environment (getArgs, getProgName)
 import           System.Exit
 import           System.FilePath (searchPathSeparator)
 import           System.IO (stderr)
-import qualified System.Process as P
 import qualified System.Process.Read
 
 -- | Commandline dispatcher.
@@ -370,23 +370,10 @@ uploadCmd args0 go = withBuildConfig go ExecStrategy $ do
 
 -- | Execute a command.
 execCmd :: (String, [String]) -> GlobalOpts -> IO ()
-execCmd (cmd, args) go@GlobalOpts{..} = withBuildConfig go ExecStrategy $ do
-      config <- asks getConfig
-      liftIO $ do
-          menv <- configEnvOverride config
-                          EnvSettings
-                              { esIncludeLocals = True
-                              , esIncludeGhcPackagePath = True
-                              }
-          cmd' <- join $ System.Process.Read.findExecutable menv cmd
-          let cp = (P.proc (toFilePath cmd') args)
-                  { P.env = envHelper menv
-                  , P.delegate_ctlc = True
-                  }
+execCmd (cmd,args) go@GlobalOpts{..} =
+    withBuildConfig go ExecStrategy $
+    exec cmd args
 
-          (Nothing, Nothing, Nothing, ph) <- P.createProcess cp
-          ec <- P.waitForProcess ph
-          exitWith ec
 
 -- | Pull the current Docker image.
 dockerPullCmd :: () -> GlobalOpts -> IO ()

stack.cabal

@@ -33,6 +33,7 @@ library
                      Stack.Docker
                      Stack.Docker.GlobalDB
                      Stack.Fetch
+                     Stack.Exec
                      Stack.GhcPkg
                      Stack.Package
                      Stack.PackageDump