Implementation of "--copy-compiler-tool" #2643

ChangeLog.md

@@ -85,6 +85,9 @@ Other enhancements:
 * `stack build` and related commands now allow the user to disable debug symbol stripping
   with new `--no-strip`, `--no-library-stripping`, and `--no-executable-shipping` flags,
   closing [#877](https://github.com/commercialhaskell/stack/issues/877).
+* Addition of `stack build --copy-compiler-tool`, to allow tools like
+  intero to be installed globally for a particular compiler.
+  [#2643](https://github.com/commercialhaskell/stack/issues/2643)
 
 Bug fixes:
 

src/Stack/Build/ConstructPlan.hs

@@ -189,7 +189,8 @@ constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 localDumpPkgs loadPackag
                 , planFinals = M.fromList finals
                 , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason locallyRegistered sourceMap
                 , planInstallExes =
-                    if boptsInstallExes $ bcoBuildOpts baseConfigOpts0
+                    if boptsInstallExes (bcoBuildOpts baseConfigOpts0) ||
+                       boptsInstallCompilerTool (bcoBuildOpts baseConfigOpts0)
                         then installExes
                         else Map.empty
                 }

src/Stack/Build/Execute.hs

@@ -458,7 +458,10 @@ executePlan menv boptsCli baseConfigOpts locals globalPackages snapshotPackages
     unless (Map.null $ planInstallExes plan) $ do
         snapBin <- (</> bindirSuffix) `liftM` installationRootDeps
         localBin <- (</> bindirSuffix) `liftM` installationRootLocal
-        destDir <- asks $ configLocalBin . getConfig
+        destDir <-
+            if boptsInstallCompilerTool bopts
+                then bindirCompilerTools
+                else asks $ configLocalBin . getConfig
         ensureDir destDir
 
         destDir' <- liftIO . D.canonicalizePath . toFilePath $ destDir
@@ -510,45 +513,46 @@ executePlan menv boptsCli baseConfigOpts locals globalPackages snapshotPackages
                 , ":"]
         forM_ installed $ \exe -> $logInfo ("- " <> exe)
 
-        searchPath <- liftIO FP.getSearchPath
-        destDirIsInPATH <- liftIO $
-            anyM (\dir -> D.doesDirectoryExist dir &&^ fmap (FP.equalFilePath destDir') (D.canonicalizePath dir)) searchPath
-        if destDirIsInPATH
-            then forM_ installed $ \exe -> do
-                mexePath <- (liftIO . D.findExecutable . T.unpack) exe
-                case mexePath of
-                    Just exePath -> do
-                        exeDir <- (liftIO . fmap FP.takeDirectory . D.canonicalizePath) exePath
-                        unless (exeDir `FP.equalFilePath` destDir') $ do
+        unless (boptsInstallCompilerTool bopts) $ do
+            searchPath <- liftIO FP.getSearchPath
+            destDirIsInPATH <- liftIO $
+                anyM (\dir -> D.doesDirectoryExist dir &&^ fmap (FP.equalFilePath destDir') (D.canonicalizePath dir)) searchPath
+            if destDirIsInPATH
+                then forM_ installed $ \exe -> do
+                    mexePath <- (liftIO . D.findExecutable . T.unpack) exe
+                    case mexePath of
+                        Just exePath -> do
+                            exeDir <- (liftIO . fmap FP.takeDirectory . D.canonicalizePath) exePath
+                            unless (exeDir `FP.equalFilePath` destDir') $ do
+                                $logWarn ""
+                                $logWarn $ T.concat
+                                    [ "WARNING: The \""
+                                    , exe
+                                    , "\" executable found on the PATH environment variable is "
+                                    , T.pack exePath
+                                    , ", and not the version that was just installed."
+                                    ]
+                                $logWarn $ T.concat
+                                    [ "This means that \""
+                                    , exe
+                                    , "\" calls on the command line will not use this version."
+                                    ]
+                        Nothing -> do
                             $logWarn ""
                             $logWarn $ T.concat
-                                [ "WARNING: The \""
+                                [ "WARNING: Installation path "
+                                , T.pack destDir'
+                                , " is on the PATH but the \""
                                 , exe
-                                , "\" executable found on the PATH environment variable is "
-                                , T.pack exePath
-                                , ", and not the version that was just installed."
+                                , "\" executable that was just installed could not be found on the PATH."
                                 ]
-                            $logWarn $ T.concat
-                                [ "This means that \""
-                                , exe
-                                , "\" calls on the command line will not use this version."
-                                ]
-                    Nothing -> do
-                        $logWarn ""
-                        $logWarn $ T.concat
-                            [ "WARNING: Installation path "
-                            , T.pack destDir'
-                            , " is on the PATH but the \""
-                            , exe
-                            , "\" executable that was just installed could not be found on the PATH."
-                            ]
-            else do
-                $logWarn ""
-                $logWarn $ T.concat
-                    [ "WARNING: Installation path "
-                    , T.pack destDir'
-                    , " not found on the PATH environment variable"
-                    ]
+                else do
+                    $logWarn ""
+                    $logWarn $ T.concat
+                        [ "WARNING: Installation path "
+                        , T.pack destDir'
+                        , " not found on the PATH environment variable"
+                        ]
 
     config <- asks getConfig
     menv' <- liftIO $ configEnvOverride config EnvSettings

src/Stack/Config/Build.hs

@@ -35,6 +35,9 @@ buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts
     , boptsInstallExes = fromFirst
           (boptsInstallExes defaultBuildOpts)
           buildMonoidInstallExes
+    , boptsInstallCompilerTool = fromFirst
+          (boptsInstallCompilerTool defaultBuildOpts)
+          buildMonoidInstallCompilerTool
     , boptsPreFetch = fromFirst
           (boptsPreFetch defaultBuildOpts)
           buildMonoidPreFetch

src/Stack/Options/BuildMonoidParser.hs

@@ -37,7 +37,7 @@ buildOptsMonoidParser hide0 =
                   additionalArgs
                 }
               }
-          | noStripping = 
+          | noStripping =
               opts
               { buildMonoidLibStrip = First (Just False)
               , buildMonoidExeStrip = First (Just False)
@@ -96,9 +96,9 @@ buildOptsMonoidParser hide0 =
 
     options =
         BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> libStripping <*>
-        exeStripping <*> haddock <*> haddockOptsParser hideBool <*> 
+        exeStripping <*> haddock <*> haddockOptsParser hideBool <*>
         openHaddocks <*> haddockDeps <*> haddockInternal <*> copyBins <*>
-        preFetch <*> keepGoing <*> forceDirty <*> tests <*>
+        copyCompilerTool <*> preFetch <*> keepGoing <*> forceDirty <*> tests <*>
         testOptsParser hideBool <*> benches <*> benchOptsParser hideBool <*>
         reconfigure <*> cabalVerbose <*> splitObjs
 
@@ -144,6 +144,11 @@ buildOptsMonoidParser hide0 =
             "copy-bins"
             "copying binaries to the local-bin-path (see 'stack path')"
             hide
+    copyCompilerTool =
+        firstBoolFlags
+            "copy-compiler-tool"
+            "copying binaries of targets to compiler-tools-bin (see 'stack path')"
+            hide
     keepGoing =
         firstBoolFlags
             "keep-going"

src/Stack/Path.hs

@@ -51,6 +51,7 @@ path keys =
        global <- GhcPkg.getGlobalDB menv =<< getWhichCompiler
        snaproot <- installationRootDeps
        localroot <- installationRootLocal
+       toolsDir <- bindirCompilerTools
        distDir <- distRelativeDir
        hpcDir <- hpcReportDir
        compiler <- getCompilerPath =<< getWhichCompiler
@@ -84,6 +85,7 @@ path keys =
                                global
                                snaproot
                                localroot
+                               toolsDir
                                distDir
                                hpcDir
                                extra
@@ -108,6 +110,7 @@ data PathInfo = PathInfo
     , piGlobalDb     :: Path Abs Dir
     , piSnapRoot     :: Path Abs Dir
     , piLocalRoot    :: Path Abs Dir
+    , piToolsDir     :: Path Abs Dir
     , piDistDir      :: Path Rel Dir
     , piHpcDir       :: Path Abs Dir
     , piExtraDbs     :: [Path Abs Dir]
@@ -146,6 +149,9 @@ paths =
     , ( "Directory containing the compiler binary (e.g. ghc)"
       , "compiler-bin"
       , T.pack . toFilePathNoTrailingSep . parent . piCompiler )
+    , ( "Directory containing binaries specific to a particular compiler (e.g. intero)"
+      , "compiler-tools-bin"
+      , T.pack . toFilePathNoTrailingSep . piToolsDir )
     , ( "Local bin dir where stack installs executables (e.g. ~/.local/bin)"
       , "local-bin"
       , T.pack . toFilePathNoTrailingSep . configLocalBin . bcConfig . piBuildConfig )

src/Stack/Types/Config.hs

@@ -123,6 +123,7 @@ module Stack.Types.Config
   ,hpcReportDir
   ,installationRootDeps
   ,installationRootLocal
+  ,bindirCompilerTools
   ,hoogleRoot
   ,hoogleDatabasePath
   ,packageDatabaseDeps
@@ -1274,6 +1275,20 @@ installationRootLocal = do
     psc <- useShaPathOnWindows =<< platformSnapAndCompilerRel
     return $ getProjectWorkDir bc </> $(mkRelDir "install") </> psc
 
+-- | Installation root for compiler tools
+bindirCompilerTools :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir)
+bindirCompilerTools = do
+    config <- asks getConfig
+    platform <- platformGhcRelDir
+    compilerVersion <- asks (envConfigCompilerVersion . getEnvConfig)
+    compiler <- parseRelDir $ compilerVersionString compilerVersion
+    return $
+        configStackRoot config </>
+        $(mkRelDir "compiler-tools") </>
+        platform </>
+        compiler </>
+        bindirSuffix
+
 -- | Hoogle directory.
 hoogleRoot :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir)
 hoogleRoot = do
@@ -1406,9 +1421,10 @@ extraBinDirs :: (MonadThrow m, MonadReader env m, HasEnvConfig env)
 extraBinDirs = do
     deps <- installationRootDeps
     local <- installationRootLocal
+    tools <- bindirCompilerTools
     return $ \locals -> if locals
-        then [local </> bindirSuffix, deps </> bindirSuffix]
-        else [deps </> bindirSuffix]
+        then [local </> bindirSuffix, deps </> bindirSuffix, tools]
+        else [deps </> bindirSuffix, tools]
 
 -- | Get the minimal environment override, useful for just calling external
 -- processes like git or ghc

src/Stack/Types/Config/Build.hs

@@ -58,6 +58,8 @@ data BuildOpts =
             -- ^ Build haddocks for all symbols and packages, like @cabal haddock --internal@
             ,boptsInstallExes :: !Bool
             -- ^ Install executables to user path after building?
+            ,boptsInstallCompilerTool :: !Bool
+            -- ^ Install executables to compiler tools path after building?
             ,boptsPreFetch :: !Bool
             -- ^ Fetch all packages immediately
             -- ^ Watch files for changes and automatically rebuild
@@ -98,6 +100,7 @@ defaultBuildOpts = BuildOpts
     , boptsHaddockDeps = Nothing
     , boptsHaddockInternal = False
     , boptsInstallExes = False
+    , boptsInstallCompilerTool = False
     , boptsPreFetch = False
     , boptsKeepGoing = Nothing
     , boptsForceDirty = False
@@ -159,6 +162,7 @@ data BuildOptsMonoid = BuildOptsMonoid
     , buildMonoidHaddockDeps :: !(First Bool)
     , buildMonoidHaddockInternal :: !(First Bool)
     , buildMonoidInstallExes :: !(First Bool)
+    , buildMonoidInstallCompilerTool :: !(First Bool)
     , buildMonoidPreFetch :: !(First Bool)
     , buildMonoidKeepGoing :: !(First Bool)
     , buildMonoidForceDirty :: !(First Bool)
@@ -183,6 +187,7 @@ instance FromJSON (WithJSONWarnings BuildOptsMonoid) where
               buildMonoidHaddockDeps <- First <$> o ..:? buildMonoidHaddockDepsArgName
               buildMonoidHaddockInternal <- First <$> o ..:? buildMonoidHaddockInternalArgName
               buildMonoidInstallExes <- First <$> o ..:? buildMonoidInstallExesArgName
+              buildMonoidInstallCompilerTool <- First <$> o ..:? buildMonoidInstallCompilerToolArgName
               buildMonoidPreFetch <- First <$> o ..:? buildMonoidPreFetchArgName
               buildMonoidKeepGoing <- First <$> o ..:? buildMonoidKeepGoingArgName
               buildMonoidForceDirty <- First <$> o ..:? buildMonoidForceDirtyArgName
@@ -225,6 +230,9 @@ buildMonoidHaddockInternalArgName = "haddock-internal"
 buildMonoidInstallExesArgName :: Text
 buildMonoidInstallExesArgName = "copy-bins"
 
+buildMonoidInstallCompilerToolArgName :: Text
+buildMonoidInstallCompilerToolArgName = "copy-compiler-tool"
+
 buildMonoidPreFetchArgName :: Text
 buildMonoidPreFetchArgName = "prefetch"