Merge pull request #1406 from jneira/stack-install-cabal

Find and run cabal in user original $PATH

Author: jneira

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

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"

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
       )

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'