Merge pull request #4268 from waddlaw/fix-clean

To prevent download ghc when using `stack clean`.

Integration test attempts to clean with no ghc present and no ghc installation permitted.

ChangeLog.md

@@ -96,7 +96,7 @@ Bug fixes:
 * Fix for git packages to update submodules to the correct state. See
   [#4314](https://github.com/commercialhaskell/stack/pull/4314)
 * Add `--cabal-files` flag to `stack ide targets` command.
-
+* Don't download ghc when using `stack clean`.
 
 ## v1.9.1
 

src/Stack/Config.hs

@@ -616,6 +616,7 @@ loadBuildConfig mproject maresolver mcompiler = do
                 LCSProject _ -> False
                 LCSNoConfig _ -> False
         , bcCurator = projectCurator project
+        , bcDownloadCompiler = WithDownloadCompiler
         }
   where
     getEmptyProject :: Maybe SnapshotLocation -> RIO Config Project

src/Stack/Runners.hs

@@ -11,6 +11,8 @@ module Stack.Runners
     , withMiniConfigAndLock
     , withBuildConfigAndLock
     , withBuildConfigAndLockNoDocker
+    , withBuildConfigAndLockInClean
+    , withBuildConfigAndLockNoDockerInClean
     , withBuildConfig
     , withBuildConfigExt
     , withBuildConfigDot
@@ -127,7 +129,7 @@ withBuildConfigAndLock
     -> (Maybe FileLock -> RIO EnvConfig ())
     -> IO ()
 withBuildConfigAndLock go inner =
-    withBuildConfigExt False go Nothing inner Nothing
+    withBuildConfigExt WithDocker WithDownloadCompiler go Nothing inner Nothing
 
 -- | See issue #2010 for why this exists. Currently just used for the
 -- specific case of "stack clean --full".
@@ -136,10 +138,27 @@ withBuildConfigAndLockNoDocker
     -> (Maybe FileLock -> RIO EnvConfig ())
     -> IO ()
 withBuildConfigAndLockNoDocker go inner =
-    withBuildConfigExt True go Nothing inner Nothing
+    withBuildConfigExt SkipDocker WithDownloadCompiler go Nothing inner Nothing
+
+withBuildConfigAndLockInClean
+    :: GlobalOpts
+    -> (Maybe FileLock -> RIO EnvConfig ())
+    -> IO ()
+withBuildConfigAndLockInClean go inner =
+    withBuildConfigExt WithDocker SkipDownloadCompiler go Nothing inner Nothing
+
+-- | See issue #2010 for why this exists. Currently just used for the
+-- specific case of "stack clean --full".
+withBuildConfigAndLockNoDockerInClean
+    :: GlobalOpts
+    -> (Maybe FileLock -> RIO EnvConfig ())
+    -> IO ()
+withBuildConfigAndLockNoDockerInClean go inner =
+    withBuildConfigExt SkipDocker SkipDownloadCompiler go Nothing inner Nothing
 
 withBuildConfigExt
-    :: Bool
+    :: WithDocker
+    -> WithDownloadCompiler -- ^ bypassed download compiler if SkipDownloadCompiler.
     -> GlobalOpts
     -> Maybe (RIO Config ())
     -- ^ Action to perform before the build.  This will be run on the host
@@ -155,7 +174,7 @@ withBuildConfigExt
     -- available in this action, since that would require build tools to be
     -- installed on the host OS.
     -> IO ()
-withBuildConfigExt skipDocker go@GlobalOpts{..} mbefore inner mafter = loadConfigWithOpts go $ \lc -> do
+withBuildConfigExt skipDocker downloadCompiler go@GlobalOpts{..} mbefore inner mafter = loadConfigWithOpts go $ \lc -> do
     withUserFileLock go (view stackRootL lc) $ \lk0 -> do
       -- A local bit of state for communication between callbacks:
       curLk <- newIORef lk0
@@ -173,25 +192,26 @@ withBuildConfigExt skipDocker go@GlobalOpts{..} mbefore inner mafter = loadConfi
 
       let inner'' lk = do
               bconfig <- lcLoadBuildConfig lc globalCompiler
-              envConfig <- runRIO bconfig (setupEnv Nothing)
+              let bconfig' = bconfig { bcDownloadCompiler = downloadCompiler }
+              envConfig <- runRIO bconfig' (setupEnv Nothing)
               runRIO envConfig (inner' lk)
 
       let getCompilerVersion = loadCompilerVersion go lc
-      if skipDocker
-          then runRIO (lcConfig lc) $ do
-              forM_ mbefore id
-              Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (inner'' lk0)
-              forM_ mafter id
-          else runRIO (lcConfig lc) $
-              Docker.reexecWithOptionalContainer
-                       (lcProjectRoot lc)
-                       mbefore
-                       (runRIO (lcConfig lc) $
-                          Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (inner'' lk0))
-                       mafter
-                       (Just $ liftIO $
-                            do lk' <- readIORef curLk
-                               munlockFile lk')
+      runRIO (lcConfig lc) $
+        case skipDocker of
+          SkipDocker -> do
+            forM_ mbefore id
+            Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (inner'' lk0)
+            forM_ mafter id
+          WithDocker -> Docker.reexecWithOptionalContainer
+                          (lcProjectRoot lc)
+                          mbefore
+                          (runRIO (lcConfig lc) $
+                              Nix.reexecWithOptionalShell (lcProjectRoot lc) getCompilerVersion (inner'' lk0))
+                          mafter
+                          (Just $ liftIO $
+                                do lk' <- readIORef curLk
+                                   munlockFile lk')
 
 -- | Load the configuration. Convenience function used
 -- throughout this module.

src/Stack/Setup.hs

@@ -234,7 +234,10 @@ setupEnv mResolveMissingGHC = do
             , soptsGHCJSBootOpts = ["--clean"]
             }
 
-    (mghcBin, compilerBuild, _) <- ensureCompiler sopts
+    (mghcBin, mCompilerBuild, _) <-
+      case bcDownloadCompiler bconfig of
+        SkipDownloadCompiler -> return (Nothing, Nothing, False)
+        WithDownloadCompiler -> ensureCompiler sopts
 
     -- Modify the initial environment to include the GHC path, if a local GHC
     -- is being used
@@ -266,7 +269,7 @@ setupEnv mResolveMissingGHC = do
             { envConfigBuildConfig = bc
             , envConfigCabalVersion = cabalVer
             , envConfigCompilerVersion = compilerVer
-            , envConfigCompilerBuild = compilerBuild
+            , envConfigCompilerBuild = mCompilerBuild
             , envConfigLoadedSnapshot = ls
             }
 
@@ -353,7 +356,7 @@ setupEnv mResolveMissingGHC = do
             }
         , envConfigCabalVersion = cabalVer
         , envConfigCompilerVersion = compilerVer
-        , envConfigCompilerBuild = compilerBuild
+        , envConfigCompilerBuild = mCompilerBuild
         , envConfigLoadedSnapshot = ls
         }
 
@@ -371,7 +374,7 @@ addIncludeLib (ExtraDirs _bins includes libs) config = config
 -- | Ensure compiler (ghc or ghcjs) is installed and provide the PATHs to add if necessary
 ensureCompiler :: (HasConfig env, HasGHCVariant env)
                => SetupOpts
-               -> RIO env (Maybe ExtraDirs, CompilerBuild, Bool)
+               -> RIO env (Maybe ExtraDirs, Maybe CompilerBuild, Bool)
 ensureCompiler sopts = do
     let wc = whichCompiler (wantedToActual (soptsWantedCompiler sopts))
     when (getGhcVersion (wantedToActual (soptsWantedCompiler sopts)) < mkVersion [7, 8]) $ do
@@ -529,7 +532,7 @@ ensureCompiler sopts = do
 
     when (soptsSanityCheck sopts) $ withProcessContext menv $ sanityCheck wc
 
-    return (mpaths, compilerBuild, needLocal)
+    return (mpaths, Just compilerBuild, needLocal)
 
 -- | Determine which GHC builds to use depending on which shared libraries are available
 -- on the system.

src/Stack/Types/Config.hs

@@ -81,6 +81,10 @@ module Stack.Types.Config
   ,defaultLogLevel
   -- ** LoadConfig
   ,LoadConfig(..)
+  -- ** WithDocker
+  ,WithDocker(..)
+  -- ** WithDownloadCompiler
+  ,WithDownloadCompiler(..)
 
   -- ** Project & ProjectAndConfigMonoid
   ,Project(..)
@@ -507,8 +511,17 @@ data BuildConfig = BuildConfig
       -- ^ Are we loading from the implicit global stack.yaml? This is useful
       -- for providing better error messages.
     , bcCurator :: !(Maybe Curator)
+    , bcDownloadCompiler :: !WithDownloadCompiler
     }
 
+data WithDocker
+  = SkipDocker
+  | WithDocker
+
+data WithDownloadCompiler
+  = SkipDownloadCompiler
+  | WithDownloadCompiler
+
 stackYamlL :: HasBuildConfig env => Lens' env (Path Abs File)
 stackYamlL = buildConfigL.lens bcStackYaml (\x y -> x { bcStackYaml = y })
 
@@ -530,7 +543,7 @@ data EnvConfig = EnvConfig
     -- ^ The actual version of the compiler to be used, as opposed to
     -- 'wantedCompilerL', which provides the version specified by the
     -- build plan.
-    ,envConfigCompilerBuild :: !CompilerBuild
+    ,envConfigCompilerBuild :: !(Maybe CompilerBuild)
     ,envConfigLoadedSnapshot :: !LoadedSnapshot
     -- ^ The fully resolved snapshot information.
     }
@@ -1269,9 +1282,9 @@ platformGhcRelDir
     => m (Path Rel Dir)
 platformGhcRelDir = do
     ec <- view envConfigL
+    let cbSuffix = maybe "" compilerBuildSuffix $ envConfigCompilerBuild ec
     verOnly <- platformGhcVerOnlyRelDirStr
-    parseRelDir (mconcat [ verOnly
-                         , compilerBuildSuffix (envConfigCompilerBuild ec)])
+    parseRelDir (mconcat [ verOnly, cbSuffix ])
 
 -- | Relative directory for the platform and GHC identifier without GHC bindist build
 platformGhcVerOnlyRelDir

src/main/Main.hs

@@ -635,8 +635,8 @@ cleanCmd opts go =
   -- See issues #2010 and #3468 for why "stack clean --full" is not used
   -- within docker.
   case opts of
-    CleanFull{} -> withBuildConfigAndLockNoDocker go (const (clean opts))
-    CleanShallow{} -> withBuildConfigAndLock go (const (clean opts))
+    CleanFull{} -> withBuildConfigAndLockNoDockerInClean go (const (clean opts))
+    CleanShallow{} -> withBuildConfigAndLockInClean go (const (clean opts))
 
 -- | Helper for build and install commands
 buildCmd :: BuildOptsCLI -> GlobalOpts -> IO ()
@@ -963,7 +963,8 @@ imgDockerCmd :: (Bool, [Text]) -> GlobalOpts -> IO ()
 imgDockerCmd (rebuild,images) go@GlobalOpts{..} = loadConfigWithOpts go $ \lc -> do
     let mProjectRoot = lcProjectRoot lc
     withBuildConfigExt
-        False
+        WithDocker
+        WithDownloadCompiler
         go
         Nothing
         (\lk ->

test/integration/tests/4181-clean-wo-dl-ghc/Main.hs

@@ -0,0 +1,12 @@
+-- |
+-- The integration tests have no ghc present, initially. Stack should not
+-- require ghc present to run the `clean` command.
+
+import StackTest
+
+main :: IO ()
+main = do
+  -- `stack clean` should succeed even though there is no ghc available.
+  -- See the stack.yaml file for how this works.
+  stack ["clean"]
+  stack ["clean", "--full"]

test/integration/tests/4181-clean-wo-dl-ghc/files/foo.cabal

@@ -0,0 +1,13 @@
+cabal-version: >= 1.10
+
+-- This file has been generated from package.yaml by hpack version 0.29.6.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 941a1ab4bea2f0ee229dd6ab7fe9730517a0397fb9141fe2841a0f9748dbfd57
+
+name:           foo
+version:        0.1.0.0
+build-type:     Simple
+
+library

test/integration/tests/4181-clean-wo-dl-ghc/files/stack.yaml

@@ -0,0 +1,8 @@
+# Update the resolver as necessary
+resolver: ghc-8.22
+# Do not use the system ghc, as ghc must not be available
+system-ghc: false
+# Do not install any other ghc, as ghc must not be available
+install-ghc: false
+packages:
+- '.'