Add drop-packages to stack.yaml commercialhaskell#4567

snoyberg · snoyberg · commit cdbd73628bc0 · 2019-04-01T11:39:24.000+03:00
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -70,6 +70,8 @@ Behavior changes:
 
 * Remove the deprecated `--upgrade-cabal` flag to `stack setup`.
 
+* Support the `drop-packages` field in `stack.yaml`
+
 Other enhancements:
 
 * Defer loading up of files for local packages. This allows us to get
diff --git a/doc/yaml_configuration.md b/doc/yaml_configuration.md
@@ -229,6 +229,29 @@ flags:
 If a specified flag is different than the one specified for a snapshot package,
 then the snapshot package will automatically be promoted to be an extra-dep.
 
+### drop-packages
+
+Packages which, when present in the snapshot specified in `resolver`,
+should not be included in our package. This can be used for a few
+different purposes, e.g.:
+
+* Ensure that packages you don't want used in your project cannot be
+  used in a `package.yaml` file (e.g., for license reasons)
+* Prevent overriding of a global package like `Cabal`. For more
+  information, see
+  [stackage#4425](https://github.com/commercialhaskell/stackage/issues/4425)
+* When using a custom GHC build, avoid incompatible packages (see
+  [this
+  comment](https://github.com/commercialhaskell/stack/pull/4655#issuecomment-477954429)).
+
+```yaml
+drop-packages:
+- Cabal
+- buggy-package
+- package-with-unacceptable-license
+```
+
+Since Stack 2.0
 
 ### user-message
 
diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs
@@ -535,8 +535,10 @@ loadBuildConfig = do
       map (second dpLocation) deps0
 
     let packages1 = Map.fromList packages0
-        snPackages = snapshotPackages snapshot `Map.difference` packages1
+        snPackages = snapshotPackages snapshot
+          `Map.difference` packages1
           `Map.difference` Map.fromList deps0
+          `Map.withoutKeys` projectDropPackages project
 
     snDeps <- Map.traverseWithKey (snapToDepPackage (shouldHaddockDeps bopts)) snPackages
 
@@ -597,6 +599,7 @@ loadBuildConfig = do
         , projectCompiler = Nothing
         , projectExtraPackageDBs = []
         , projectCurator = Nothing
+        , projectDropPackages = mempty
         }
 
 -- | Check if there are any duplicate package names and, if so, throw an
diff --git a/src/Stack/Init.hs b/src/Stack/Init.hs
@@ -130,6 +130,7 @@ initProject currDir initOpts mresolver = do
             , projectCompiler = Nothing
             , projectExtraPackageDBs = []
             , projectCurator = Nothing
+            , projectDropPackages = mempty
             }
 
         makeRel = fmap toFilePath . makeRelativeToCurrentDir
diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs
@@ -614,12 +614,14 @@ data Project = Project
     -- ^ Extra configuration intended exclusively for usage by the
     -- curator tool. In other words, this is /not/ part of the
     -- documented and exposed Stack API. SUBJECT TO CHANGE.
+    , projectDropPackages :: !(Set PackageName)
+    -- ^ Packages to drop from the 'projectResolver'.
     }
   deriving Show
 
 instance ToJSON Project where
     -- Expanding the constructor fully to ensure we don't miss any fields.
-    toJSON (Project userMsg packages extraDeps flags resolver mcompiler extraPackageDBs mcurator) = object $ concat
+    toJSON (Project userMsg packages extraDeps flags resolver mcompiler extraPackageDBs mcurator drops) = object $ concat
       [ maybe [] (\cv -> ["compiler" .= cv]) mcompiler
       , maybe [] (\msg -> ["user-message" .= msg]) userMsg
       , if null extraPackageDBs then [] else ["extra-package-dbs" .= extraPackageDBs]
@@ -628,6 +630,7 @@ instance ToJSON Project where
       , ["packages" .= packages]
       , ["resolver" .= resolver]
       , maybe [] (\c -> ["curator" .= c]) mcurator
+      , if Set.null drops then [] else ["drop-packages" .= Set.map CabalString drops]
       ]
 
 -- | Extra configuration intended exclusively for usage by the
@@ -1444,6 +1447,7 @@ parseProjectAndConfigMonoid rootDir =
         config <- parseConfigMonoidObject rootDir o
         extraPackageDBs <- o ..:? "extra-package-dbs" ..!= []
         mcurator <- jsonSubWarningsT (o ..:? "curator")
+        drops <- o ..:? "drop-packages" ..!= mempty
         return $ do
           deps' <- mapM (resolvePaths (Just rootDir)) deps
           resolver' <- resolvePaths (Just rootDir) resolver
@@ -1456,6 +1460,7 @@ parseProjectAndConfigMonoid rootDir =
                   , projectDependencies = concatMap toList (deps' :: [NonEmpty RawPackageLocation])
                   , projectFlags = flags
                   , projectCurator = mcurator
+                  , projectDropPackages = Set.map unCabalString drops
                   }
           pure $ ProjectAndConfigMonoid project config
 
diff --git a/test/integration/tests/drop-packages/Main.hs b/test/integration/tests/drop-packages/Main.hs
@@ -0,0 +1,4 @@
+import StackTest
+
+main :: IO ()
+main = stackErr ["build"]
diff --git a/test/integration/tests/drop-packages/files/.gitignore b/test/integration/tests/drop-packages/files/.gitignore
@@ -0,0 +1 @@
+*.cabal
diff --git a/test/integration/tests/drop-packages/files/package.yaml b/test/integration/tests/drop-packages/files/package.yaml
@@ -0,0 +1,6 @@
+name: unimportant
+version: 0
+dependencies:
+- base
+- unliftio-core
+library: {}
diff --git a/test/integration/tests/drop-packages/files/stack.yaml b/test/integration/tests/drop-packages/files/stack.yaml
@@ -0,0 +1,3 @@
+resolver: lts-11.22
+drop-packages:
+- unliftio-core

Original file line number	Diff line number	Diff line change
`@@ -130,6 +130,7 @@ initProject currDir initOpts mresolver = do`
`130`	`130`	`, projectCompiler = Nothing`
`131`	`131`	`, projectExtraPackageDBs = []`
`132`	`132`	`, projectCurator = Nothing`
	`133`	`+ , projectDropPackages = mempty`
`133`	`134`	`}`
`134`	`135`
`135`	`136`	`makeRel = fmap toFilePath . makeRelativeToCurrentDir`
Original file line number	Diff line number	Diff line change
`@@ -0,0 +1,3 @@`
	`1`	`+resolver: lts-11.22`
	`2`	`+drop-packages:`
	`3`	`+- unliftio-core`