Fix allow-newer #1579

src/Stack/Build.hs

@@ -16,9 +16,11 @@ module Stack.Build
   ,withLoadPackage
   ,mkBaseConfigOpts
   ,queryBuildInfo
-  ,splitObjsWarning)
+  ,splitObjsWarning
+  ,CabalVersionException(..))
   where
 
+import           Control.Exception (Exception)
 import           Control.Monad
 import           Control.Monad.Catch (MonadCatch, MonadMask)
 import           Control.Monad.IO.Class
@@ -43,6 +45,7 @@ import qualified Data.Text as T
 import           Data.Text.Encoding (decodeUtf8)
 import qualified Data.Text.IO as TIO
 import           Data.Text.Read (decimal)
+import           Data.Typeable (Typeable)
 import qualified Data.Vector as V
 import qualified Data.Yaml as Yaml
 import           Network.HTTP.Client.Conduit (HasHttpManager)
@@ -113,6 +116,7 @@ build setLocalFiles mbuildLk boptsCli = fixCodePage $ do
                            liftIO $ unlockFile lk
       _ -> return ()
 
+    checkCabalVersion
     warnAboutSplitObjs bopts
     warnIfExecutablesWithSameNameCouldBeOverwritten locals plan
 
@@ -137,6 +141,23 @@ allLocal =
     Map.elems .
     planTasks
 
+checkCabalVersion :: M env m => m ()
+checkCabalVersion = do
+    allowNewer <- asks (configAllowNewer . getConfig)
+    cabalVer <- asks (envConfigCabalVersion . getEnvConfig)
+    -- https://github.com/haskell/cabal/issues/2023
+    when (allowNewer && cabalVer < $(mkVersion "1.22")) $ throwM $
+        CabalVersionException $
+            "Error: --allow-newer requires at least Cabal version 1.22, but version " ++
+            versionString cabalVer ++
+            " was found."
+
+data CabalVersionException = CabalVersionException { unCabalVersionException :: String }
+    deriving (Typeable)
+
+instance Show CabalVersionException where show = unCabalVersionException
+instance Exception CabalVersionException
+
 -- | See https://github.com/commercialhaskell/stack/issues/1198.
 warnIfExecutablesWithSameNameCouldBeOverwritten
     :: MonadLogger m => [LocalPackage] -> Plan -> m ()

src/Stack/Build/Execute.hs

@@ -623,10 +623,11 @@ toActions installedMap runInBase ee (mbuild, mfinal) =
     beopts = boptsBenchmarkOpts bopts
 
 -- | Generate the ConfigCache
-getConfigCache :: MonadIO m
+getConfigCache :: M env m
                => ExecuteEnv -> Task -> InstalledMap -> Bool -> Bool
                -> m (Map PackageIdentifier GhcPkgId, ConfigCache)
 getConfigCache ExecuteEnv {..} Task {..} installedMap enableTest enableBench = do
+    useExactConf <- asks (configAllowNewer . getConfig)
     let extra =
             -- We enable tests if the test suite dependencies are already
             -- installed, so that we avoid unnecessary recompilation based on
@@ -635,8 +636,15 @@ getConfigCache ExecuteEnv {..} Task {..} installedMap enableTest enableBench = d
             -- https://github.com/commercialhaskell/stack/issues/805
             case taskType of
                 TTLocal lp -> concat
-                    [ ["--enable-tests" | enableTest || (depsPresent installedMap $ lpTestDeps lp)]
-                    , ["--enable-benchmarks" | enableBench || (depsPresent installedMap $ lpBenchDeps lp)]
+                    -- FIXME: make this work with exact-configuration.
+                    -- Not sure how to plumb the info atm. See
+                    -- https://github.com/commercialhaskell/stack/issues/2049
+                    [ [ "--enable-tests"
+                      | enableTest ||
+                        (not useExactConf && depsPresent installedMap (lpTestDeps lp))]
+                    , [ "--enable-benchmarks"
+                      | enableBench ||
+                        (not useExactConf && depsPresent installedMap (lpBenchDeps lp))]
                     ]
                 _ -> []
     idMap <- liftIO $ readTVarIO eeGhcPkgIds
@@ -707,6 +715,8 @@ ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp = do
             return $ case mpath of
                 Nothing -> []
                 Just x -> return $ concat ["--with-", name, "=", toFilePath x]
+        -- Configure cabal with arguments determined by
+        -- Stack.Types.Build.configureOpts
         cabal False $ "configure" : concat
             [ concat exes
             , dirs

src/Stack/Package.hs

@@ -68,17 +68,19 @@ import           Data.Version (showVersion)
 import           Distribution.Compiler
 import           Distribution.ModuleName (ModuleName)
 import qualified Distribution.ModuleName as Cabal
-import           Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier)
 import qualified Distribution.Package as D
-import           Distribution.PackageDescription hiding (FlagName)
+import           Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier)
 import qualified Distribution.PackageDescription as D
+import           Distribution.PackageDescription hiding (FlagName)
 import           Distribution.PackageDescription.Parse
 import qualified Distribution.PackageDescription.Parse as D
 import           Distribution.ParseUtils
 import           Distribution.Simple.Utils
 import           Distribution.System (OS (..), Arch, Platform (..))
 import           Distribution.Text (display, simpleParse)
 import qualified Distribution.Verbosity as D
+import qualified Hpack
+import qualified Hpack.Config as Hpack
 import           Path as FL
 import           Path.Extra
 import           Path.Find
@@ -92,8 +94,6 @@ import qualified System.Directory as D
 import           System.FilePath (splitExtensions, replaceExtension)
 import qualified System.FilePath as FilePath
 import           System.IO.Error
-import qualified Hpack
-import qualified Hpack.Config as Hpack
 
 -- | Read the raw, unresolved package information.
 readPackageUnresolved :: (MonadIO m, MonadThrow m)
@@ -188,6 +188,8 @@ resolvePackage packageConfig gpkg =
     , packageFiles = pkgFiles
     , packageTools = packageDescTools pkg
     , packageFlags = packageConfigFlags packageConfig
+    , packageDefaultFlags = M.fromList
+      [(fromCabalFlagName (flagName flag), flagDefault flag) | flag <- genPackageFlags gpkg]
     , packageAllDeps = S.fromList (M.keys deps)
     , packageHasLibrary = maybe False (buildable . libBuildInfo) (library pkg)
     , packageTests = M.fromList
@@ -210,8 +212,6 @@ resolvePackage packageConfig gpkg =
           (not . null . exposedModules)
           (library pkg)
     , packageSimpleType = buildType (packageDescription gpkg) == Just Simple
-    , packageDefinedFlags = S.fromList $
-      map (fromCabalFlagName . flagName) $ genPackageFlags gpkg
     }
   where
     pkgFiles = GetPackageFiles $

src/Stack/Types/Build.hs

@@ -639,25 +639,33 @@ configureOptsNoDir econfig bco deps wanted isLocal package = concat
                            then ""
                            else "-") <>
                        flagNameString name)
-                    (Map.toList (packageFlags package))
+                    (Map.toList flags)
     , concatMap (\x -> ["--ghc-options", T.unpack x]) allGhcOptions
     , map (("--extra-include-dirs=" ++) . T.unpack) (Set.toList (configExtraIncludeDirs config))
     , map (("--extra-lib-dirs=" ++) . T.unpack) (Set.toList (configExtraLibDirs config))
     , if whichCompiler (envConfigCompilerVersion econfig) == Ghcjs
         then ["--ghcjs"]
         else []
+    , if useExactConf then ["--exact-configuration"] else []
     ]
   where
     config = getConfig econfig
     bopts = bcoBuildOpts bco
     boptsCli = bcoBuildOptsCLI bco
 
+    -- TODO: instead always enable this when the cabal version is new
+    -- enough. That way we'll detect bugs with --exact-configuration
+    -- earlier. Cabal also might do less work then.
+    useExactConf = envConfigCabalVersion econfig >= $(mkVersion "1.22")
+
+    -- Unioning atop defaults is needed so that all flags are specified
+    -- with --exact-configuration.
+    flags | useExactConf = packageFlags package `Map.union` packageDefaultFlags package
+          | otherwise = packageFlags package
+
     depOptions = map (uncurry toDepOption) $ Map.toList deps
       where
-        toDepOption =
-            if envConfigCabalVersion econfig >= $(mkVersion "1.22")
-                then toDepOption1_22
-                else toDepOption1_18
+        toDepOption = if useExactConf then toDepOption1_22 else toDepOption1_18
 
     toDepOption1_22 ident gid = concat
         [ "--dependency="

src/Stack/Types/Package.hs

@@ -19,6 +19,7 @@ import qualified Data.ByteString as S
 import           Data.Data
 import           Data.Function
 import           Data.List
+import qualified Data.Map as M
 import           Data.Map.Strict (Map)
 import           Data.Maybe
 import           Data.Monoid
@@ -40,8 +41,8 @@ import           Stack.Types.Compiler
 import           Stack.Types.Config
 import           Stack.Types.FlagName
 import           Stack.Types.GhcPkgId
-import           Stack.Types.PackageName
 import           Stack.Types.PackageIdentifier
+import           Stack.Types.PackageName
 import           Stack.Types.Version
 
 -- | All exceptions thrown by the library.
@@ -87,21 +88,24 @@ data Package =
           ,packageTools :: ![Dependency]                  -- ^ A build tool name.
           ,packageAllDeps :: !(Set PackageName)           -- ^ Original dependencies (not sieved).
           ,packageFlags :: !(Map FlagName Bool)           -- ^ Flags used on package.
+          ,packageDefaultFlags :: !(Map FlagName Bool)    -- ^ Defaults for unspecified flags.
           ,packageHasLibrary :: !Bool                     -- ^ does the package have a buildable library stanza?
           ,packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites
           ,packageBenchmarks :: !(Set Text)               -- ^ names of benchmarks
           ,packageExes :: !(Set Text)                     -- ^ names of executables
           ,packageOpts :: !GetPackageOpts                 -- ^ Args to pass to GHC.
           ,packageHasExposedModules :: !Bool              -- ^ Does the package have exposed modules?
           ,packageSimpleType :: !Bool                     -- ^ Does the package of build-type: Simple
-          ,packageDefinedFlags :: !(Set FlagName)         -- ^ All flags defined in the .cabal file
           }
  deriving (Show,Typeable)
 
 packageIdentifier :: Package -> PackageIdentifier
 packageIdentifier pkg =
     PackageIdentifier (packageName pkg) (packageVersion pkg)
 
+packageDefinedFlags :: Package -> Set FlagName
+packageDefinedFlags = M.keysSet . packageDefaultFlags
+
 -- | Files that the package depends on, relative to package directory.
 -- Argument is the location of the .cabal file
 newtype GetPackageOpts = GetPackageOpts