From d5c50b995b9d650b8c6916ba1c57363e5220dbcf Mon Sep 17 00:00:00 2001 From: jneira Date: Wed, 9 Oct 2019 14:58:29 +0200 Subject: [PATCH 1/6] Install and run cabal found in user original $PATH --- install/hie-install.cabal | 1 + install/src/Cabal.hs | 13 +++++++++---- install/src/Stack.hs | 36 ++++++++++++++++++++++++++++++++++-- 3 files changed, 44 insertions(+), 6 deletions(-) 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..edcc90d1e 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -12,17 +12,21 @@ import System.Directory ( findExecutable , copyFile ) +import BuildSystem import Version import Print import Env import Stack - +import Debug.Trace 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 = withOriginalPath . (command [] "cabal") cabalBuildData :: Action () cabalBuildData = do @@ -76,7 +80,8 @@ installCabal :: Action () installCabal = do -- try to find existing `cabal` executable with appropriate version cabalExeOk <- do - c <- liftIO (findExecutable "cabal") + c <- withOriginalPath (liftIO (findExecutable "cabal")) + liftIO $ traceIO $ show c when (isJust c) checkCabal return $ isJust c diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 279bfe9ca..1ad8c192b 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,33 @@ 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 with the original user path, without stack additions +withOriginalPath :: Action a -> Action a +withOriginalPath action = do + mbPath <- liftIO (lookupEnv "PATH") + + case (mbPath,isRunFromStack) of + + (Just paths, True) -> do + snapshotDir <- trimmedStdout <$> execStackShake ["path", "--snapshot-install-root"] + + let origPaths = removePathsContaining snapshotDir paths + + liftIO (setEnv "PATH" origPaths) + + a <- action + + liftIO (setEnv "PATH" paths) + + return a + + otherwise -> action + + where removePathsContaining str path = + intercalate [searchPathSeparator] (filter (not.(isInfixOf str)) (splitPaths path)) + splitPaths s = + case dropWhile (== searchPathSeparator) s of + "" -> [] + s' -> w : words s'' + where (w, s'') = break (== searchPathSeparator) s' From 5e216282c0518baa0e23c601e91d1d8724286ae0 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 10 Oct 2019 11:20:32 +0200 Subject: [PATCH 2/6] Some refactorings --- install/src/Cabal.hs | 25 +++++++++++-------------- install/src/HieInstall.hs | 2 +- install/src/Stack.hs | 5 +++-- 3 files changed, 15 insertions(+), 17 deletions(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index edcc90d1e..48487cf37 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -17,7 +17,6 @@ import Version import Print import Env import Stack -import Debug.Trace execCabal :: CmdResult r => [String] -> Action r execCabal = execCabalWithOriginalPath @@ -76,19 +75,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 <- withOriginalPath (liftIO (findExecutable "cabal")) - liftIO $ traceIO $ show c - 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 <- withOriginalPath (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 () @@ -122,7 +119,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..50773c7a1 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) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 1ad8c192b..a1163cc7e 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -104,7 +104,7 @@ withOriginalPath :: Action a -> Action a withOriginalPath action = do mbPath <- liftIO (lookupEnv "PATH") - case (mbPath,isRunFromStack) of + case (mbPath, isRunFromStack) of (Just paths, True) -> do snapshotDir <- trimmedStdout <$> execStackShake ["path", "--snapshot-install-root"] @@ -122,7 +122,8 @@ withOriginalPath action = do otherwise -> action where removePathsContaining str path = - intercalate [searchPathSeparator] (filter (not.(isInfixOf str)) (splitPaths path)) + joinPaths (filter (not.(isInfixOf str)) (splitPaths path)) + joinPaths = intercalate [searchPathSeparator] splitPaths s = case dropWhile (== searchPathSeparator) s of "" -> [] From 0037450d7f61d63f8b4a1c0a7862e1c270af7d0a Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 10 Oct 2019 11:35:55 +0200 Subject: [PATCH 3/6] Remove unused import --- install/src/Cabal.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 48487cf37..17709f0b2 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -12,7 +12,6 @@ import System.Directory ( findExecutable , copyFile ) -import BuildSystem import Version import Print import Env From da3f7771a9cfb721b0632b77ceff83a1976ba354 Mon Sep 17 00:00:00 2001 From: jneira Date: Thu, 10 Oct 2019 12:36:36 +0200 Subject: [PATCH 4/6] Validate cabal after trying to install it --- install/src/HieInstall.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/install/src/HieInstall.hs b/install/src/HieInstall.hs index 50773c7a1..b05f1714d 100644 --- a/install/src/HieInstall.hs +++ b/install/src/HieInstall.hs @@ -117,9 +117,9 @@ defaultMain = do forM_ ghcVersions (\version -> phony ("cabal-hie-" ++ version) $ do - validateCabalNewInstallIsSupported need ["submodules"] need ["cabal"] + validateCabalNewInstallIsSupported cabalBuildHie version cabalInstallHie version ) From d1e442b6083848b3586a15e16ecb3a4bdcedb659 Mon Sep 17 00:00:00 2001 From: jneira Date: Fri, 11 Oct 2019 06:36:35 +0200 Subject: [PATCH 5/6] Take in account local cache dir --- install/src/Stack.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/install/src/Stack.hs b/install/src/Stack.hs index a1163cc7e..1d90dd589 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -6,7 +6,7 @@ import Development.Shake.FilePath import Control.Monad import Data.List import System.Directory ( copyFile ) -import System.FilePath ( searchPathSeparator ) +import System.FilePath ( searchPathSeparator, () ) import System.Environment ( lookupEnv, setEnv, getEnvironment ) import BuildSystem import Version @@ -108,22 +108,24 @@ withOriginalPath action = do (Just paths, True) -> do snapshotDir <- trimmedStdout <$> execStackShake ["path", "--snapshot-install-root"] - - let origPaths = removePathsContaining snapshotDir paths + localInstallDir <- trimmedStdout <$> execStackShake ["path", "--local-install-dir"] - liftIO (setEnv "PATH" origPaths) + 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 str path = - joinPaths (filter (not.(isInfixOf str)) (splitPaths path)) + 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 "" -> [] From b5e388af80c829bdab8cdc749db8d28492cbff7a Mon Sep 17 00:00:00 2001 From: jneira Date: Mon, 14 Oct 2019 13:16:23 +0200 Subject: [PATCH 6/6] Correct stack local install path and use a more precise name for the ugly hack --- install/src/Cabal.hs | 4 ++-- install/src/Stack.hs | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/install/src/Cabal.hs b/install/src/Cabal.hs index 17709f0b2..0c0ca380d 100644 --- a/install/src/Cabal.hs +++ b/install/src/Cabal.hs @@ -24,7 +24,7 @@ execCabal_ :: [String] -> Action () execCabal_ = execCabalWithOriginalPath execCabalWithOriginalPath :: CmdResult r => [String] -> Action r -execCabalWithOriginalPath = withOriginalPath . (command [] "cabal") +execCabalWithOriginalPath = withoutStackCachedBinaries . (command [] "cabal") cabalBuildData :: Action () cabalBuildData = do @@ -77,7 +77,7 @@ cabalInstallHie versionNumber = do installCabalWithStack :: Action () installCabalWithStack = do -- try to find existing `cabal` executable with appropriate version - mbc <- withOriginalPath (liftIO (findExecutable "cabal")) + mbc <- withoutStackCachedBinaries (liftIO (findExecutable "cabal")) case mbc of Just c -> do diff --git a/install/src/Stack.hs b/install/src/Stack.hs index 1d90dd589..eef3126a6 100644 --- a/install/src/Stack.hs +++ b/install/src/Stack.hs @@ -99,16 +99,16 @@ stackBuildFailMsg = ++ "If this does not work, open an issue at \n" ++ "\thttps://github.com/haskell/haskell-ide-engine" --- | Run actions with the original user path, without stack additions -withOriginalPath :: Action a -> Action a -withOriginalPath action = do +-- |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-dir"] + localInstallDir <- trimmedStdout <$> execStackShake ["path", "--local-install-root"] let cacheBinPaths = [snapshotDir "bin", localInstallDir "bin"] let origPaths = removePathsContaining cacheBinPaths paths