diff --git a/install/hie-install.cabal b/install/hie-install.cabal index 287b56f6a..342f87695 100644 --- a/install/hie-install.cabal +++ b/install/hie-install.cabal @@ -21,6 +21,7 @@ library build-depends: base >= 4.9 && < 5 , shake == 0.17.8 , directory + , filepath , extra , text default-extensions: LambdaCase diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index f4699416d..0c0ca380d 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -17,12 +17,14 @@ import Print import Env import Stack - execCabal :: CmdResult r => [String] -> Action r -execCabal = command [] "cabal" +execCabal = execCabalWithOriginalPath execCabal_ :: [String] -> Action () -execCabal_ = command_ [] "cabal" +execCabal_ = execCabalWithOriginalPath + +execCabalWithOriginalPath :: CmdResult r => [String] -> Action r +execCabalWithOriginalPath = withoutStackCachedBinaries . (command [] "cabal") cabalBuildData :: Action () cabalBuildData = do @@ -72,18 +74,17 @@ cabalInstallHie versionNumber = do ++ minorVerExe ++ " to " ++ localBin -installCabal :: Action () -installCabal = do +installCabalWithStack :: Action () +installCabalWithStack = do -- try to find existing `cabal` executable with appropriate version - cabalExeOk <- do - c <- liftIO (findExecutable "cabal") - when (isJust c) checkCabal - return $ isJust c - - -- install `cabal-install` if not already installed - if cabalExeOk - then printLine "There is already a cabal executable in $PATH with the required minimum version." - else execStackShake_ ["install", "cabal-install"] + mbc <- withoutStackCachedBinaries (liftIO (findExecutable "cabal")) + + case mbc of + Just c -> do + checkCabal + printLine "There is already a cabal executable in $PATH with the required minimum version." + -- install `cabal-install` if not already installed + Nothing -> execStackShake_ ["install", "cabal-install"] -- | check `cabal` has the required version checkCabal :: Action () @@ -117,7 +118,7 @@ cabalInstallNotSuportedFailMsg = -- | Error message when the `cabal` binary is an older version cabalInstallIsOldFailMsg :: String -> String cabalInstallIsOldFailMsg cabalVersion = - "The `cabal` executable is outdated.\n" + "The `cabal` executable found in $PATH is outdated.\n" ++ "found version is `" ++ cabalVersion ++ "`.\n" diff --git a/install/src/HieInstall.hs b/install/src/HieInstall.hs index 58ed14138..b05f1714d 100644 --- a/install/src/HieInstall.hs +++ b/install/src/HieInstall.hs @@ -63,7 +63,7 @@ defaultMain = do want ["short-help"] -- general purpose targets phony "submodules" updateSubmodules - phony "cabal" installCabal + phony "cabal" installCabalWithStack phony "short-help" shortHelpMessage phony "all" shortHelpMessage phony "help" (helpMessage versions) @@ -117,9 +117,9 @@ defaultMain = do forM_ ghcVersions (\version -> phony ("cabal-hie-" ++ version) $ do - validateCabalNewInstallIsSupported need ["submodules"] need ["cabal"] + validateCabalNewInstallIsSupported cabalBuildHie version cabalInstallHie version ) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 279bfe9ca..eef3126a6 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -4,13 +4,15 @@ import Development.Shake import Development.Shake.Command import Development.Shake.FilePath import Control.Monad +import Data.List import System.Directory ( copyFile ) - +import System.FilePath ( searchPathSeparator, () ) +import System.Environment ( lookupEnv, setEnv, getEnvironment ) +import BuildSystem import Version import Print import Env - stackBuildHie :: VersionNumber -> Action () stackBuildHie versionNumber = execStackWithGhc_ versionNumber ["build"] `actionOnException` liftIO (putStrLn stackBuildFailMsg) @@ -96,3 +98,36 @@ stackBuildFailMsg = ++ "Try running `stack clean` and restart the build\n" ++ "If this does not work, open an issue at \n" ++ "\thttps://github.com/haskell/haskell-ide-engine" + +-- |Run actions without the stack cached binaries +withoutStackCachedBinaries :: Action a -> Action a +withoutStackCachedBinaries action = do + mbPath <- liftIO (lookupEnv "PATH") + + case (mbPath, isRunFromStack) of + + (Just paths, True) -> do + snapshotDir <- trimmedStdout <$> execStackShake ["path", "--snapshot-install-root"] + localInstallDir <- trimmedStdout <$> execStackShake ["path", "--local-install-root"] + + let cacheBinPaths = [snapshotDir "bin", localInstallDir "bin"] + let origPaths = removePathsContaining cacheBinPaths paths + + liftIO (setEnv "PATH" origPaths) + a <- action + liftIO (setEnv "PATH" paths) + return a + + otherwise -> action + + where removePathsContaining strs path = + joinPaths (filter (not . containsAny) (splitPaths path)) + where containsAny p = any (`isInfixOf` p) strs + + joinPaths = intercalate [searchPathSeparator] + + splitPaths s = + case dropWhile (== searchPathSeparator) s of + "" -> [] + s' -> w : words s'' + where (w, s'') = break (== searchPathSeparator) s'