Cabal: Expose --allow-{newer,older} for configure command

Author: maralorn

Cabal/src/Distribution/Simple/Configure.hs

@@ -164,7 +164,9 @@ import Text.PrettyPrint
 
 import qualified Data.Maybe as M
 import qualified Data.Set as Set
+import Distribution.AllowNewer (RelaxKind (..), relaxPackageDeps)
 import qualified Distribution.Compat.NonEmptySet as NES
+import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..))
 import Distribution.Types.AnnotatedId
 
 type UseExternalInternalDeps = Bool
@@ -966,7 +968,8 @@ configure (pkg_descr0, pbi) cfg = do
   -- in scripts that *really* want ${pkgroot}. See haskell/cabal/#4872
   unless
     ( isAbsolute (prefix dirs)
-        || "${pkgroot}" `isPrefixOf` prefix dirs
+        || "${pkgroot}"
+          `isPrefixOf` prefix dirs
     )
     $ die' verbosity
     $ "expected an absolute directory name for --prefix: " ++ prefix dirs
@@ -1227,7 +1230,14 @@ configureFinalizedPackage
   satisfies
   comp
   compPlatform
-  pkg_descr0 = do
+  pkg_descr_before_relaxed_bounds = do
+    let
+      AllowNewer relaxNewer = configAllowNewer cfg
+      AllowOlder relaxOlder = configAllowOlder cfg
+      pkg_descr0 =
+        relaxPackageDeps RelaxLower relaxOlder
+          . relaxPackageDeps RelaxUpper relaxNewer
+          $ pkg_descr_before_relaxed_bounds
     (pkg_descr0', flags) <-
       case finalizePD
         (configConfigurationsFlags cfg)
@@ -2211,11 +2221,15 @@ checkForeignDeps pkg lbi verbosity =
       let relIncDirs = filter (not . isAbsolute) (collectField includeDirs)
           isHeader = isSuffixOf ".h"
       genHeaders <- for relIncDirs $ \dir ->
-        fmap (dir </>) . filter isHeader
-          <$> listDirectory (buildDir lbi </> dir) `catchIO` (\_ -> return [])
+        fmap (dir </>)
+          . filter isHeader
+          <$> listDirectory (buildDir lbi </> dir)
+            `catchIO` (\_ -> return [])
       srcHeaders <- for relIncDirs $ \dir ->
-        fmap (dir </>) . filter isHeader
-          <$> listDirectory (baseDir lbi </> dir) `catchIO` (\_ -> return [])
+        fmap (dir </>)
+          . filter isHeader
+          <$> listDirectory (baseDir lbi </> dir)
+            `catchIO` (\_ -> return [])
       let commonHeaders = concat genHeaders `intersect` concat srcHeaders
       for_ commonHeaders $ \hdr -> do
         warn verbosity $

Cabal/src/Distribution/Simple/Setup/Config.hs

@@ -62,6 +62,7 @@ import Distribution.Compat.Semigroup (Last' (..), Option' (..))
 import Distribution.Compat.Stack
 
 import Distribution.Simple.Setup.Common
+import Distribution.Types.AllowNewer (AllowNewer (..), AllowOlder (..), RelaxDeps (..), isRelaxDeps)
 
 -- ------------------------------------------------------------
 
@@ -220,6 +221,10 @@ data ConfigFlags = ConfigFlags
   -- ^ Allow depending on private sublibraries. This is used by external
   -- tools (like cabal-install) so they can add multiple-public-libraries
   -- compatibility to older ghcs by checking visibility externally.
+  , configAllowNewer :: AllowNewer
+  -- ^ Ignore upper bounds on all or some dependencies.
+  , configAllowOlder :: AllowOlder
+  -- ^ Ignore lower bounds on all or some dependencies.
   }
   deriving (Generic, Read, Show, Typeable)
 
@@ -288,6 +293,8 @@ instance Eq ConfigFlags where
       && equal configDebugInfo
       && equal configDumpBuildInfo
       && equal configUseResponseFiles
+      && equal configAllowNewer
+      && equal configAllowOlder
     where
       equal f = on (==) f a b
 
@@ -342,6 +349,8 @@ defaultConfigFlags progDb =
     , configDebugInfo = Flag NoDebugInfo
     , configDumpBuildInfo = NoFlag
     , configUseResponseFiles = NoFlag
+    , configAllowNewer = AllowNewer mempty
+    , configAllowOlder = AllowOlder mempty
     }
 {- FOURMOLU_ENABLE -}
 
@@ -828,8 +837,40 @@ configureOptions showOrParseArgs =
           configAllowDependingOnPrivateLibs
           (\v flags -> flags{configAllowDependingOnPrivateLibs = v})
           trueArg
+       , option
+          ""
+          ["allow-older"]
+          "Allow older dependencies."
+          configAllowOlder
+          (\v flags -> flags{configAllowOlder = v})
+          ( optArg
+              "PKG1:DEP1,PKG2:DEP2,..."
+              (fmap AllowOlder parseRelaxDeps)
+              (AllowOlder RelaxDepsAll)
+              ((: []) . Just . show . isRelaxDeps . unAllowOlder)
+          )
+       , option
+          ""
+          ["allow-newer"]
+          "Allow newer dependencies."
+          configAllowNewer
+          (\v flags -> flags{configAllowNewer = v})
+          ( optArg
+              "PKG1:DEP1,PKG2:DEP2,..."
+              (fmap AllowNewer parseRelaxDeps)
+              (AllowNewer RelaxDepsAll)
+              ((: []) . Just . show . isRelaxDeps . unAllowNewer)
+          )
        ]
   where
+    toRelaxDeps True = RelaxDepsAll
+    toRelaxDeps False = mempty
+
+    parseRelaxDeps =
+      parsecToReadE ("Not a valid list of dependencies: " ++) $
+        fmap toRelaxDeps parsec
+          <|> fmap RelaxDepsSome (parsecOptCommaList parsec)
+
     liftInstallDirs =
       liftOption configInstallDirs (\v flags -> flags{configInstallDirs = v})