From 23864c59abfc6dad5a6b137941d618903817e1e3 Mon Sep 17 00:00:00 2001
From: Daniel Gröber <dxld@darkboxed.org>
Date: Sun, 4 Aug 2019 21:14:45 +0200
Subject: Allow passing override-env to process functions

Unfortunately we need this to pass a custom GHC executable path to stack,
since it doesn't have an option to override it on the commandline (yet?).
---
 lib/Distribution/Helper.hs | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

(limited to 'lib')

diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index c269a5c..209eb09 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -196,12 +196,16 @@ mkQueryEnv
 mkQueryEnv projloc distdir = do
   cr <- newIORef $ QueryCache Nothing Map.empty
   return $ QueryEnv
-    { qeReadProcess = \stdin mcwd exe args ->
-        readCreateProcess (proc exe args){ cwd = mcwd } stdin
-    , qeCallProcess  = \mcwd exe args -> do
+    { qeReadProcess = \stdin mcwd env exe args ->
+        let cp = (proc exe args)
+                   { cwd = mcwd
+                   , env = if env == [] then Nothing else Just env
+                   }
+        in readCreateProcess cp stdin
+    , qeCallProcess  = \mcwd env exe args -> do
         let ?verbose = \_ -> False -- TODO: we should get this from env or
                                    -- something
-        callProcessStderr mcwd exe args
+        callProcessStderr mcwd env exe args
     , qePrograms     = defaultPrograms
     , qeProjLoc      = projloc
     , qeDistDir      = distdir
@@ -378,13 +382,13 @@ shallowReconfigureProject QueryEnv
   { qeProjLoc = ProjLocV2File projfile
   , qeDistDir = DistDirCabal SCV2 _distdirv2, .. } = do
     let projdir = takeDirectory projfile
-    _ <- qeCallProcess (Just projdir) (cabalProgram qePrograms)
+    _ <- qeCallProcess (Just projdir) [] (cabalProgram qePrograms)
            ["new-build", "--dry-run", "--project-file="++projfile, "all"]
     return ()
 shallowReconfigureProject QueryEnv
   { qeProjLoc = ProjLocV2Dir projdir
   , qeDistDir = DistDirCabal SCV2 _distdirv2, .. } = do
-    _ <- qeCallProcess (Just projdir) (cabalProgram qePrograms)
+    _ <- qeCallProcess (Just projdir) [] (cabalProgram qePrograms)
            ["new-build", "--dry-run", "all"]
     return ()
 shallowReconfigureProject QueryEnv
@@ -403,7 +407,7 @@ reconfigureUnit
   QueryEnv{qeProjLoc=ProjLocV2File projfile, ..}
   Unit{uPackageDir, uImpl}
   = do
-  _ <- qeCallProcess (Just uPackageDir) (cabalProgram qePrograms)
+  _ <- qeCallProcess (Just uPackageDir) [] (cabalProgram qePrograms)
         (["new-build", "--project-file="++projfile]
          ++ uiV2Components uImpl)
   return ()
@@ -411,7 +415,7 @@ reconfigureUnit
   QueryEnv{qeProjLoc=ProjLocV2Dir{}, ..}
   Unit{uPackageDir, uImpl}
   = do
-  _ <- qeCallProcess (Just uPackageDir) (cabalProgram qePrograms)
+  _ <- qeCallProcess (Just uPackageDir) [] (cabalProgram qePrograms)
         (["new-build"] ++ uiV2Components uImpl)
         -- TODO: version check for --only-configure
   return ()
@@ -546,7 +550,7 @@ invokeHelper
   args0
   = do
     let args1 = cabal_file_path : distdir : args0
-    evaluate =<< qeReadProcess "" Nothing exe args1 `E.catch`
+    evaluate =<< qeReadProcess "" Nothing [] exe args1 `E.catch`
       \(_ :: E.IOException) ->
         panicIO $ concat
           ["invokeHelper", ": ", exe, " "
-- 
cgit v1.2.3