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?).
---
 src/CabalHelper/Compiletime/Program/CabalInstall.hs | 10 +++++-----
 src/CabalHelper/Compiletime/Program/GHC.hs          |  4 ++--
 src/CabalHelper/Compiletime/Program/Stack.hs        | 10 +++++-----
 3 files changed, 12 insertions(+), 12 deletions(-)

(limited to 'src/CabalHelper/Compiletime/Program')

diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
index 2af1cdc..7276d81 100644
--- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs
+++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
@@ -130,7 +130,7 @@ callCabalInstall
         , [ "--only-dependencies" ]
       ]
 
-  callProcessStderr (Just "/") (cabalProgram ?progs) cabal_opts
+  callProcessStderr (Just "/") [] (cabalProgram ?progs) cabal_opts
 
   runSetupHs ghcVer db srcdir unpackedCabalVer civ
 
@@ -146,11 +146,11 @@ runSetupHs
     -> IO ()
 runSetupHs ghcVer db srcdir cabalVer CabalInstallVersion {..}
     | cabalInstallVer >= parseVer "1.24" = do
-      go $ \args -> callProcessStderr (Just srcdir) (cabalProgram ?progs) $
+      go $ \args -> callProcessStderr (Just srcdir) [] (cabalProgram ?progs) $
         [ "act-as-setup", "--" ] ++ args
     | otherwise = do
       SetupProgram {..} <- compileSetupHs ghcVer db srcdir
-      go $ callProcessStderr (Just srcdir) setupProgram
+      go $ callProcessStderr (Just srcdir) [] setupProgram
   where
     parmake_opt :: Maybe Int -> [String]
     parmake_opt nproc'
@@ -180,7 +180,7 @@ compileSetupHs (GhcVersion ghcVer) db srcdir = do
 
       file = srcdir </> "Setup"
 
-  callProcessStderr (Just srcdir) (ghcProgram ?progs) $ concat
+  callProcessStderr (Just srcdir) [] (ghcProgram ?progs) $ concat
     [ [ "--make"
       , "-package-conf", db
       ]
@@ -232,7 +232,7 @@ installCabalLibV2 _ghcVer cv (PackageEnvFile env_file) = do
              | ?verbose 4 -> ["-v3"]
              | otherwise -> []
         ]
-    callProcessStderr (Just cwd) (cabalProgram ?progs) cabal_opts
+    callProcessStderr (Just cwd) [] (cabalProgram ?progs) cabal_opts
     hPutStrLn stderr "done"
 
 
diff --git a/src/CabalHelper/Compiletime/Program/GHC.hs b/src/CabalHelper/Compiletime/Program/GHC.hs
index e45d921..a42406c 100644
--- a/src/CabalHelper/Compiletime/Program/GHC.hs
+++ b/src/CabalHelper/Compiletime/Program/GHC.hs
@@ -81,7 +81,7 @@ createPkgDb cabalVer = do
     <- getPrivateCabalPkgDb $ unpackedToResolvedCabalVersion cabalVer
   exists <- doesDirectoryExist db_path
   when (not exists) $
-       callProcessStderr Nothing (ghcPkgProgram ?progs) ["init", db_path]
+       callProcessStderr Nothing [] (ghcPkgProgram ?progs) ["init", db_path]
   return db
 
 getPrivateCabalPkgDb :: (Verbose, Progs) => ResolvedCabalVersion -> IO PackageDbDir
@@ -136,7 +136,7 @@ cabalVersionExistsInPkgDb cabalVer db@(PackageDbDir db_path) = do
 
 invokeGhc :: Env => GhcInvocation -> IO (Either ExitCode FilePath)
 invokeGhc GhcInvocation {..} = do
-    rv <- callProcessStderr' Nothing (ghcProgram ?progs) $ concat
+    rv <- callProcessStderr' (Just "/") [] (ghcProgram ?progs) $ concat
       [ [ "-outputdir", giOutDir
         , "-o", giOutput
         ]
diff --git a/src/CabalHelper/Compiletime/Program/Stack.hs b/src/CabalHelper/Compiletime/Program/Stack.hs
index 3cdf87b..896c73e 100644
--- a/src/CabalHelper/Compiletime/Program/Stack.hs
+++ b/src/CabalHelper/Compiletime/Program/Stack.hs
@@ -112,14 +112,14 @@ listPackageCabalFiles qe@QueryEnv{qeProjLoc=ProjLocStackYaml stack_yaml}
 workdirArg :: QueryEnvI c 'Stack -> [String]
 workdirArg QueryEnv{qeDistDir=DistDirStack mworkdir} =
   maybeToList $ ("--work-dir="++) . unRelativePath <$> mworkdir
-workdirArg QueryEnv{qeDistDir=DistDirCabal{}} =
-  error "workdirArg: TODO: this case is impossible and should not produce an exhaustiveness warning anymore starting with GHC 8.8"
 
-doStackCmd :: (QueryEnvI c 'Stack -> CallProcessWithCwd a)
-           -> QueryEnvI c 'Stack -> Maybe FilePath -> [String] -> IO a
+doStackCmd :: (QueryEnvI c 'Stack -> CallProcessWithCwdAndEnv a)
+           -> QueryEnvI c 'Stack
+           -> Maybe FilePath -> [String] -> IO a
 doStackCmd procfn qe mcwd args =
   let Programs{..} = qePrograms qe in
-  procfn qe mcwd stackProgram $ stackArgsBefore ++ args ++ stackArgsAfter
+  procfn qe mcwd stackEnv stackProgram $
+    stackArgsBefore ++ args ++ stackArgsAfter
 
 readStackCmd :: QueryEnvI c 'Stack -> Maybe FilePath -> [String] -> IO String
 callStackCmd :: QueryEnvI c 'Stack -> Maybe FilePath -> [String] -> IO ()
-- 
cgit v1.2.3