Skip to content

Commit

Permalink
Fix hook running on windows
Browse files Browse the repository at this point in the history
  • Loading branch information
hasufell committed Aug 9, 2021
1 parent f81c24d commit cad9878
Show file tree
Hide file tree
Showing 3 changed files with 17 additions and 18 deletions.
27 changes: 13 additions & 14 deletions src/Stack/Setup.hs
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,7 @@ import Stack.Types.Docker
import Stack.Types.SourceMap
import Stack.Types.Version
import qualified System.Directory as D
import System.Environment (getExecutablePath, lookupEnv, getEnvironment)
import System.Environment (getExecutablePath, lookupEnv)
import System.IO.Error (isPermissionError)
import System.FilePath (searchPathSeparator)
import qualified System.FilePath as FP
Expand Down Expand Up @@ -441,21 +441,18 @@ ensureCompilerAndMsys
=> SetupOpts
-> RIO env (CompilerPaths, ExtraDirs)
ensureCompilerAndMsys sopts = do
getSetupInfo' <- memoizeRef getSetupInfo
mmsys2Tool <- ensureMsys sopts getSetupInfo'
msysPaths <- maybe (pure Nothing) (fmap Just . extraDirs) mmsys2Tool

actual <- either throwIO pure $ wantedToActual $ soptsWantedCompiler sopts
didWarn <- warnUnsupportedCompiler $ getGhcVersion actual

getSetupInfo' <- memoizeRef getSetupInfo
(cp, ghcPaths) <- ensureCompiler sopts getSetupInfo'

warnUnsupportedCompilerCabal cp didWarn

mmsys2Tool <- ensureMsys sopts getSetupInfo'
paths <-
case mmsys2Tool of
Nothing -> pure ghcPaths
Just msys2Tool -> do
msys2Paths <- extraDirs msys2Tool
pure $ ghcPaths <> msys2Paths
let paths = maybe ghcPaths (ghcPaths <>) msysPaths
pure (cp, paths)

-- | See <https://github.com/commercialhaskell/stack/issues/4246>
Expand Down Expand Up @@ -607,7 +604,9 @@ ensureCompiler sopts getSetupInfo' = do
wc <- either throwIO (pure . whichCompiler) $ wantedToActual wanted

hook <- ghcInstallHook
hookIsExecutable <- handleIO (\_ -> pure False) $ executable <$> getPermissions hook
hookIsExecutable <- if osIsWindows
then pure True -- can't really detect executable on windows, only file extension
else handleIO (\_ -> pure False) $ executable <$> getPermissions hook

Platform expectedArch _ <- view platformL

Expand Down Expand Up @@ -658,10 +657,10 @@ runGHCInstallHook
runGHCInstallHook sopts hook = do
logDebug "Getting hook installed compiler version"
let wanted = soptsWantedCompiler sopts
curEnv <- Map.fromList . map (T.pack *** T.pack) <$> liftIO getEnvironment
let newEnv = Map.union (wantedCompilerToEnv wanted) curEnv
pCtx <- mkProcessContext newEnv
(exit, out) <- withProcessContext pCtx $ proc "sh" [toFilePath hook] readProcessStdout
menv0 <- view processContextL
menv <- mkProcessContext (Map.union (wantedCompilerToEnv wanted) $
removeHaskellEnvVars (view envVarsL menv0))
(exit, out) <- withProcessContext menv $ proc "sh" [toFilePath hook] readProcessStdout
case exit of
ExitSuccess -> do
let ghcPath = stripNewline . TL.unpack . TL.decodeUtf8With T.lenientDecode $ out
Expand Down
2 changes: 1 addition & 1 deletion test/integration/tests/ghc-install-hooks/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4,4 +4,4 @@ import StackTest
import Control.Monad (unless)

main :: IO ()
main = unless isWindows $ rawSystem "bash" ["run.sh"] >>= throwIO
main = rawSystem "sh" ["run.sh"] >>= throwIO
6 changes: 3 additions & 3 deletions test/integration/tests/ghc-install-hooks/files/run.sh
Original file line number Diff line number Diff line change
@@ -1,14 +1,14 @@
#!/usr/bin/env bash
#!/usr/bin/env sh

set -exuo pipefail
set -exu

stack_bin=$("$STACK_EXE" path --resolver ghc-8.6.5 --compiler-bin)

export STACK_ROOT=$(pwd)/fake-root

mkdir -p "${STACK_ROOT}"/hooks

echo "echo ${stack_bin}/ghc" > "${STACK_ROOT}"/hooks/ghc-install.sh
echo "echo '${stack_bin}/ghc'" > "${STACK_ROOT}"/hooks/ghc-install.sh
chmod +x "${STACK_ROOT}"/hooks/ghc-install.sh

"$STACK_EXE" --no-install-ghc --resolver ghc-8.6.5 ghc -- --info
Expand Down

0 comments on commit cad9878

Please sign in to comment.