From 672719afc8dd7e86fbdb9eae8f2ca264b16920ae Mon Sep 17 00:00:00 2001
From: Rodrigo Mesquita <rodrigo.m.mesquita@gmail.com>
Date: Mon, 8 Apr 2024 11:52:39 +0100
Subject: [PATCH] Make Cabal check fail on private deps

Hackage is not yet ready for private dependencies, so we mustn't allow
packages with private deps to be uploaded just yet.

Hackage already rejects packages using too-recent cabal versions,
however, private dependencies is a special case which must be guarded
against until more extensive benchmarks regarding the performance of
solving private dependencies mixed in with a lot of backtracking.

See https://github.com/haskell/cabal/pull/9743
---
 .../src/Distribution/Types/PackageDescription.hs    |  8 ++++++++
 Cabal/src/Distribution/PackageDescription/Check.hs  |  2 ++
 .../PackageDescription/Check/Warning.hs             | 13 +++++++++++++
 3 files changed, 23 insertions(+)

diff --git a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
index b994f9c8813..532049651da 100644
--- a/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
+++ b/Cabal-syntax/src/Distribution/Types/PackageDescription.hs
@@ -34,6 +34,7 @@ module Distribution.Types.PackageDescription
   , buildType
   , emptyPackageDescription
   , hasPublicLib
+  , hasPrivateDependencies
   , hasLibs
   , allLibraries
   , withLib
@@ -59,6 +60,7 @@ module Distribution.Types.PackageDescription
 
 import Distribution.Compat.Prelude
 import Prelude ()
+import qualified Data.List
 
 -- lens
 
@@ -366,6 +368,12 @@ allBuildDepends pd = do
   [(Public, d) | d <- targetBuildDepends bi]
     ++ [(Private p, d) | PrivateDependency p ds <- targetPrivateBuildDepends bi, d <- ds]
 
+-- | Does this package have any private dependencies? At the moment, cabal
+-- check will reject any packages that do.
+hasPrivateDependencies :: PackageDescription -> Bool
+hasPrivateDependencies pd = not . Data.List.null $
+  concatMap targetPrivateBuildDepends (allBuildInfo pd)
+
 -- | Get the combined build-depends entries of all enabled components, per the
 -- given request spec.
 enabledBuildDepends :: PackageDescription -> ComponentRequestedSpec -> [(IsPrivate, Dependency)]
diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
index 79123f7f9df..dc16c1bf6b7 100644
--- a/Cabal/src/Distribution/PackageDescription/Check.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -428,6 +428,8 @@ checkPackageDescription
       (PackageBuildImpossible $ IllegalLibraryName pn)
 
     -- § Fields check.
+    checkP (hasPrivateDependencies pkg)
+      (PackageDistInexcusable HasPrivateDependencies)
     checkNull
       category_
       (PackageDistSuspicious MissingFieldCategory)
diff --git a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs
index 859b3f12c50..ff430d51920 100644
--- a/Cabal/src/Distribution/PackageDescription/Check/Warning.hs
+++ b/Cabal/src/Distribution/PackageDescription/Check/Warning.hs
@@ -279,6 +279,7 @@ data CheckExplanation
   | MissingSourceControl
   | MissingExpectedDocFiles Bool [FilePath]
   | WrongFieldForExpectedDocFiles Bool String [FilePath]
+  | HasPrivateDependencies
   deriving (Eq, Ord, Show)
 
 -- TODO Some checks have a constructor in list form
@@ -441,6 +442,7 @@ data CheckExplanationID
   | CIMissingSourceControl
   | CIMissingExpectedDocFiles
   | CIWrongFieldForExpectedDocFiles
+  | CIHasPrivateDependencies
   deriving (Eq, Ord, Show, Enum, Bounded)
 
 checkExplanationId :: CheckExplanation -> CheckExplanationID
@@ -582,6 +584,7 @@ checkExplanationId (UnknownDirectory{}) = CIUnknownDirectory
 checkExplanationId (MissingSourceControl{}) = CIMissingSourceControl
 checkExplanationId (MissingExpectedDocFiles{}) = CIMissingExpectedDocFiles
 checkExplanationId (WrongFieldForExpectedDocFiles{}) = CIWrongFieldForExpectedDocFiles
+checkExplanationId (HasPrivateDependencies{}) = CIHasPrivateDependencies
 
 type CheckExplanationIDString = String
 
@@ -728,6 +731,7 @@ ppCheckExplanationId CIUnknownDirectory = "unknown-directory"
 ppCheckExplanationId CIMissingSourceControl = "no-repository"
 ppCheckExplanationId CIMissingExpectedDocFiles = "no-docs"
 ppCheckExplanationId CIWrongFieldForExpectedDocFiles = "doc-place"
+ppCheckExplanationId CIHasPrivateDependencies = "has-private-deps"
 
 -- String: the unrecognised 'CheckExplanationIDString' itself.
 readExplanationID
@@ -1460,6 +1464,15 @@ ppExplanation (WrongFieldForExpectedDocFiles extraDocFileSupport field paths) =
       if extraDocFileSupport
         then "extra-doc-files"
         else "extra-source-files"
+-- Private dependencies are a special case which must be guarded
+-- against until more extensive benchmarks regarding the performance of
+-- solving private dependencies mixed in with a lot of backtracking.
+-- See https://github.com/haskell/cabal/pull/9743
+ppExplanation HasPrivateDependencies =
+  "Private dependencies are in a feature-preview state, "
+  ++ "therefore packages using them cannot be uploaded to hackage.\n"
+  ++ "For instance, how would hackage display the private dependencies of the package?"
+
 
 -- * Formatting utilities