Add explicit-setup-deps option #1110

ChangeLog.md

@@ -33,6 +33,7 @@ Bug fixes:
 * Mark executable-only packages as installed when copied from cache [#1043](https://github.com/commercialhaskell/stack/pull/1043)
 * Canonicalize temporary directory paths [#1047](https://github.com/commercialhaskell/stack/pull/1047)
 * Put code page fix inside the build function itself [#1066](https://github.com/commercialhaskell/stack/issues/1066)
+* Add `explicit-setup-deps` option [#1110](https://github.com/commercialhaskell/stack/issues/1110)
 
 ## 0.1.5.0
 

doc/yaml_configuration.md

@@ -302,3 +302,26 @@ is to modify.
 ```yaml
 modify-code-page: false
 ```
+
+### explicit-setup-deps
+
+(Since 0.1.6)
+
+Decide whether a custom `Setup.hs` script should be run with an explicit list
+of dependencies based on the dependencies of the package itself, or simply
+provided the global package database. This option is most often needed when
+overriding packages in the global database, see [issue
+#1110](https://github.com/commercialhaskell/stack/issues/1110).
+
+Setting the list explicitly can help when a Setup.hs depends on packages in the
+local package database. For more information on that case, see [issue
+#897](https://github.com/commercialhaskell/stack/issues/897).
+
+Note that in the future, this should all disappear once Cabal provides full
+support for explicit Setup.hs dependencies.
+
+```yaml
+explicit-setup-deps:
+    "*": false # change the default
+    entropy: true # override the new default for one package
+```

src/Stack/Build/Execute.hs

@@ -707,7 +707,7 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
                                                           eeCabalPkgVer)
                 packageArgs =
                     case mdeps of
-                        Just deps ->
+                        Just deps | explicitSetupDeps (packageName package) config ->
                             -- Stack always builds with the global Cabal for various
                             -- reproducibility issues.
                             let depsMinusCabal
@@ -736,13 +736,15 @@ withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} md
                         -- 2. This doesn't provide enough packages: we should also
                         -- include the local database when building local packages.
                         --
-                        -- Currently, this branch is only taken via `stack sdist`.
-                        Nothing ->
-                            [ cabalPackageArg
-                            , "-clear-package-db"
-                            , "-global-package-db"
-                            , "-package-db=" ++ toFilePath (bcoSnapDB eeBaseConfigOpts)
-                            ]
+                        -- Currently, this branch is only taken via `stack
+                        -- sdist` or when explicitly requested in the
+                        -- stack.yaml file.
+                        _ ->
+                              cabalPackageArg
+                            : "-clear-package-db"
+                            : "-global-package-db"
+                            : "-package-db=" ++ toFilePath (bcoSnapDB eeBaseConfigOpts)
+                            : map (("-package-db=" ++) . toFilePath) (bcoExtraDBs eeBaseConfigOpts)
 
                 setupArgs = ("--builddir=" ++ toFilePath distRelativeDir') : args
                 runExe exeName fullArgs = do

src/Stack/Config.hs

@@ -186,6 +186,7 @@ configFromConfigMonoid configStackRoot configUserConfigPath mproject configMonoi
          configSetupInfoLocations = configMonoidSetupInfoLocations
          configPvpBounds = fromMaybe PvpBoundsNone configMonoidPvpBounds
          configModifyCodePage = fromMaybe True configMonoidModifyCodePage
+         configExplicitSetupDeps = configMonoidExplicitSetupDeps
 
      return Config {..}
 

src/Stack/Types/Config.hs

@@ -143,6 +143,8 @@ data Config =
          -- ^ How PVP upper bounds should be added to packages
          ,configModifyCodePage      :: !Bool
          -- ^ Force the code page to UTF-8 on Windows
+         ,configExplicitSetupDeps   :: !(Map (Maybe PackageName) Bool)
+         -- ^ See 'explicitSetupDeps'. 'Nothing' provides the default value.
          }
 
 -- | Information on a single package index
@@ -578,6 +580,8 @@ data ConfigMonoid =
     -- ^ See 'configPvpBounds'
     ,configMonoidModifyCodePage      :: !(Maybe Bool)
     -- ^ See 'configModifyCodePage'
+    ,configMonoidExplicitSetupDeps   :: !(Map (Maybe PackageName) Bool)
+    -- ^ See 'configExplicitSetupDeps'
     }
   deriving Show
 
@@ -610,6 +614,7 @@ instance Monoid ConfigMonoid where
     , configMonoidSetupInfoLocations = mempty
     , configMonoidPvpBounds = Nothing
     , configMonoidModifyCodePage = Nothing
+    , configMonoidExplicitSetupDeps = mempty
     }
   mappend l r = ConfigMonoid
     { configMonoidDockerOpts = configMonoidDockerOpts l <> configMonoidDockerOpts r
@@ -640,6 +645,7 @@ instance Monoid ConfigMonoid where
     , configMonoidSetupInfoLocations = configMonoidSetupInfoLocations l ++ configMonoidSetupInfoLocations r
     , configMonoidPvpBounds = configMonoidPvpBounds l <|> configMonoidPvpBounds r
     , configMonoidModifyCodePage = configMonoidModifyCodePage l <|> configMonoidModifyCodePage r
+    , configMonoidExplicitSetupDeps = configMonoidExplicitSetupDeps l <> configMonoidExplicitSetupDeps r
     }
 
 instance FromJSON (ConfigMonoid, [JSONWarning]) where
@@ -696,6 +702,9 @@ parseConfigMonoidJSON obj = do
 
     configMonoidPvpBounds <- obj ..:? "pvp-bounds"
     configMonoidModifyCodePage <- obj ..:? "modify-code-page"
+    configMonoidExplicitSetupDeps <-
+        (obj ..:? "explicit-setup-deps" ..!= mempty)
+        >>= fmap Map.fromList . mapM handleExplicitSetupDep . Map.toList
 
     return ConfigMonoid {..}
   where
@@ -712,6 +721,16 @@ parseConfigMonoidJSON obj = do
             Left e -> fail e
             Right vals -> return (name, map T.pack vals)
 
+    handleExplicitSetupDep :: Monad m => (Text, Bool) -> m (Maybe PackageName, Bool)
+    handleExplicitSetupDep (name', b) = do
+        name <-
+            if name' == "*"
+                then return Nothing
+                else case parsePackageNameFromString $ T.unpack name' of
+                        Left e -> fail $ show e
+                        Right x -> return $ Just x
+        return (name, b)
+
 -- | Newtype for non-orphan FromJSON instance.
 newtype VersionRangeJSON = VersionRangeJSON { unVersionRangeJSON :: VersionRange }
 
@@ -1202,3 +1221,17 @@ instance ToJSON PvpBounds where
   toJSON = toJSON . pvpBoundsText
 instance FromJSON PvpBounds where
   parseJSON = withText "PvpBounds" (either fail return . parsePvpBounds)
+
+-- | Provide an explicit list of package dependencies when running a custom Setup.hs
+explicitSetupDeps :: (MonadReader env m, HasConfig env) => PackageName -> m Bool
+explicitSetupDeps name = do
+    m <- asks $ configExplicitSetupDeps . getConfig
+    return $
+        -- Yes there are far cleverer ways to write this. I honestly consider
+        -- the explicit pattern matching much easier to parse at a glance.
+        case Map.lookup (Just name) m of
+            Just b -> b
+            Nothing ->
+                case Map.lookup Nothing m of
+                    Just b -> b
+                    Nothing -> True -- default value