From 1c0f2e8c403126acecfd6d6cccf2ad0b20f38929 Mon Sep 17 00:00:00 2001
From: Daniel Gröber <dxld@darkboxed.org>
Date: Sat, 11 Jan 2020 05:08:03 +0100
Subject: Unset GHC_ENVIRONMENT and GHC_PACKAGE_PATH before invocing GHC

When we are invoked under Stack (as part of HIE's test suite for example)
our choice of Cabal library when invoking GHC gets interferred with by the
GHC_ENVIRONMENT variable.

Since we're just using boot packages simply unsetting GHC package related
envvars seems like a fairly decent fix here. See the issue below for more
details.

Fixes #78
---
 src/CabalHelper/Compiletime/Process.hs     | 29 +++++++++++++----------------
 src/CabalHelper/Compiletime/Program/GHC.hs |  5 ++++-
 src/CabalHelper/Compiletime/Types.hs       |  5 +++--
 3 files changed, 20 insertions(+), 19 deletions(-)

(limited to 'src/CabalHelper/Compiletime')

diff --git a/src/CabalHelper/Compiletime/Process.hs b/src/CabalHelper/Compiletime/Process.hs
index 9d6604e..a45e354 100644
--- a/src/CabalHelper/Compiletime/Process.hs
+++ b/src/CabalHelper/Compiletime/Process.hs
@@ -20,9 +20,9 @@ module CabalHelper.Compiletime.Process
     , module System.Process
     ) where
 
-import Control.Arrow (second)
 import Data.Char
 import Data.List
+import Data.Maybe
 import qualified Data.Map.Strict as Map
 import GHC.IO.Exception (IOErrorType(OtherError))
 import System.IO
@@ -42,7 +42,7 @@ readProcessStderr :: Verbose => Maybe FilePath -> [(String, EnvOverride)]
                   -> FilePath -> [String] -> String -> IO String
 readProcessStderr mcwd env exe args inp = do
   logProcessCall mcwd env exe args
-  env' <- execEnvOverrides env
+  env' <- execEnvOverrides env <$> getEnvironment
   outp <- readCreateProcess (proc exe args)
     { cwd = mcwd
     , env = if env == [] then Nothing else Just env'
@@ -57,7 +57,7 @@ callProcessStderr'
     -> FilePath -> [String] -> IO ExitCode
 callProcessStderr' mcwd env exe args = do
   logProcessCall mcwd env exe args
-  env' <- execEnvOverrides env
+  env' <- execEnvOverrides env <$> getEnvironment
   (_, _, _, h) <- createProcess (proc exe args)
     { std_out = UseHandle stderr
     , env = if env == [] then Nothing else Just env'
@@ -74,21 +74,18 @@ logProcessCall mcwd env exe args = do
     cd = case mcwd of
       Nothing -> []; Just cwd -> [ "cd", formatProcessArg cwd++";" ]
 
-execEnvOverride :: EnvOverride -> String -> String
-execEnvOverride (EnvPrepend x) y = x ++ y
-execEnvOverride (EnvAppend  y) x = x ++ y
-execEnvOverride (EnvReplace x) _ = x
+execEnvOverride :: EnvOverride -> String -> Maybe String
+execEnvOverride (EnvPrepend x) y = Just (x ++ y)
+execEnvOverride (EnvAppend  y) x = Just (x ++ y)
+execEnvOverride (EnvSet x)     _ = Just x
+execEnvOverride  EnvUnset      _ = Nothing
 
-execEnvOverrides :: [(String, EnvOverride)] -> IO [(String, String)]
-execEnvOverrides overrides = do
-  envs <- getEnvironment
-  return $ do
-    (k,v) <- envs
-    case Map.lookup k overrides_map of
-      Just os -> return (k, foldr execEnvOverride v os)
-      Nothing -> return (k, v)
+execEnvOverrides
+    :: [(String, EnvOverride)] -> [(String, String)] -> [(String, String)]
+execEnvOverrides overrides env =
+    Map.toList $ foldl f (Map.fromList env) overrides
   where
-    overrides_map = Map.fromListWith (++) $ map (second (:[])) overrides
+    f em (k, o) = Map.alter (execEnvOverride o . fromMaybe "") k em
 
 -- | Essentially 'System.Process.callProcess' but with additional options
 -- and logging to stderr when verbosity is enabled.
diff --git a/src/CabalHelper/Compiletime/Program/GHC.hs b/src/CabalHelper/Compiletime/Program/GHC.hs
index b24222f..3baf6d9 100644
--- a/src/CabalHelper/Compiletime/Program/GHC.hs
+++ b/src/CabalHelper/Compiletime/Program/GHC.hs
@@ -134,7 +134,10 @@ cabalVersionExistsInPkgDb cabalVer db@(PackageDbDir db_path) = do
 
 invokeGhc :: Env => GhcInvocation -> IO (Either ExitCode FilePath)
 invokeGhc GhcInvocation {..} = do
-    rv <- callProcessStderr' (Just "/") [] (ghcProgram ?progs) $ concat
+    -- We unset some interferring envvars here for stack, see:
+    -- https://github.com/DanielG/cabal-helper/issues/78#issuecomment-557860898
+    let eos = [("GHC_ENVIRONMENT", EnvUnset), ("GHC_PACKAGE_PATH", EnvUnset)]
+    rv <- callProcessStderr' (Just "/") eos (ghcProgram ?progs) $ concat
       [ [ "-outputdir", giOutDir
         , "-o", giOutput
         ]
diff --git a/src/CabalHelper/Compiletime/Types.hs b/src/CabalHelper/Compiletime/Types.hs
index 99766dd..ab84178 100644
--- a/src/CabalHelper/Compiletime/Types.hs
+++ b/src/CabalHelper/Compiletime/Types.hs
@@ -570,9 +570,10 @@ defaultPrograms =
   Programs "cabal" [] []  "stack" [] [] [] "ghc" "ghc-pkg" "haddock"
 
 data EnvOverride
-    = EnvPrepend String
+    = EnvUnset
+    | EnvSet String
     | EnvAppend String
-    | EnvReplace String
+    | EnvPrepend String
       deriving (Eq, Ord, Show, Read, Generic, Typeable)
 
 data CompileOptions = CompileOptions
-- 
cgit v1.2.3