Merge pull request #8534 from blackheaven/package-infos-module

Add PackageInfos_ (#3909)
haskell · Dec 31, 2022 · ffa9f01 · ffa9f01
2 parents 70795f9 + 7c1ce92
commit ffa9f01
Show file tree

Hide file tree

Showing 39 changed files with 382 additions and 24 deletions.
diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal
@@ -89,6 +89,7 @@ library
     Distribution.Simple.Bench
     Distribution.Simple.Build
     Distribution.Simple.Build.Macros
+    Distribution.Simple.Build.PackageInfoModule
     Distribution.Simple.Build.PathsModule
     Distribution.Simple.BuildPaths
     Distribution.Simple.BuildTarget
@@ -319,6 +320,7 @@ library
     Distribution.GetOpt
     Distribution.Lex
     Distribution.Simple.Build.Macros.Z
+    Distribution.Simple.Build.PackageInfoModule.Z
     Distribution.Simple.Build.PathsModule.Z
     Distribution.Simple.GHC.EnvironmentParser
     Distribution.Simple.GHC.Internal

diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs
@@ -50,7 +50,7 @@ import Distribution.PackageDescription
 import Distribution.PackageDescription.Configuration
 import Distribution.Parsec.Warning                   (PWarning, showPWarning)
 import Distribution.Pretty                           (prettyShow)
-import Distribution.Simple.BuildPaths                (autogenPathsModuleName)
+import Distribution.Simple.BuildPaths                (autogenPackageInfoModuleName, autogenPathsModuleName)
 import Distribution.Simple.BuildToolDepends
 import Distribution.Simple.CCompiler
 import Distribution.Simple.Glob
@@ -220,6 +220,7 @@ data CheckExplanation =
         | CVCustomSetup
         | CVExpliticDepsCustomSetup
         | CVAutogenPaths
+        | CVAutogenPackageInfo
         | GlobNoMatch String String
         | GlobExactMatch String String FilePath
         | GlobNoDir String String FilePath
@@ -231,7 +232,8 @@ data CheckExplanation =
         | SuspiciousFlagName [String]
         | DeclaredUsedFlags (Set FlagName) (Set FlagName)
         | NonASCIICustomField [String]
-        | RebindableClash
+        | RebindableClashPaths
+        | RebindableClashPackageInfo
         | WErrorUnneeded String
         | JUnneeded String
         | FDeferTypeErrorsUnneeded String
@@ -648,6 +650,13 @@ ppExplanation CVAutogenPaths =
       ++ "the module does not come with the package and is generated on "
       ++ "setup. Modules built with a custom Setup.hs script also go here "
       ++ "to ensure that commands like sdist don't fail."
+ppExplanation CVAutogenPackageInfo =
+    "Packages using 'cabal-version: 2.0' and the autogenerated "
+      ++ "module PackageInfo_* must include it in 'autogen-modules' as well as"
+      ++ " 'exposed-modules' and 'other-modules'. This specifies that "
+      ++ "the module does not come with the package and is generated on "
+      ++ "setup. Modules built with a custom Setup.hs script also go here "
+      ++ "to ensure that commands like sdist don't fail."
 ppExplanation (GlobNoMatch field glob) =
     "In '" ++ field ++ "': the pattern '" ++ glob ++ "' does not"
       ++ " match any files."
@@ -700,12 +709,18 @@ ppExplanation (NonASCIICustomField nonAsciiXFields) =
     "Non ascii custom fields: " ++ unwords nonAsciiXFields ++ ". "
       ++ "For better compatibility, custom field names "
       ++ "shouldn't contain non-ascii characters."
-ppExplanation RebindableClash =
+ppExplanation RebindableClashPaths =
     "Packages using RebindableSyntax with OverloadedStrings or"
       ++ " OverloadedLists in default-extensions, in conjunction with the"
       ++ " autogenerated module Paths_*, are known to cause compile failures"
       ++ " with Cabal < 2.2. To use these default-extensions with a Paths_*"
       ++ " autogen module, specify at least 'cabal-version: 2.2'."
+ppExplanation RebindableClashPackageInfo =
+    "Packages using RebindableSyntax with OverloadedStrings or"
+      ++ " OverloadedLists in default-extensions, in conjunction with the"
+      ++ " autogenerated module PackageInfo_*, are known to cause compile failures"
+      ++ " with Cabal < 2.2. To use these default-extensions with a PackageInfo_*"
+      ++ " autogen module, specify at least 'cabal-version: 2.2'."
 ppExplanation (WErrorUnneeded fieldName) = addConditionalExp $
     "'" ++ fieldName ++ ": -Werror' makes the package easy to "
       ++ "break with future GHC versions because new GHC versions often "
@@ -851,6 +866,7 @@ checkPackage gpkg mpkg =
   ++ checkUnusedFlags gpkg
   ++ checkUnicodeXFields gpkg
   ++ checkPathsModuleExtensions pkg
+  ++ checkPackageInfoModuleExtensions pkg
   ++ checkSetupVersions gpkg
   ++ checkDuplicateModules gpkg
   where
@@ -1749,6 +1765,11 @@ checkCabalVersion pkg =
            && not (elem (autogenPathsModuleName pkg) allModuleNamesAutogen) ) $
       PackageDistInexcusable CVAutogenPaths
 
+  , check (specVersion pkg >= CabalSpecV2_0
+           && elem (autogenPackageInfoModuleName pkg) allModuleNames
+           && not (elem (autogenPackageInfoModuleName pkg) allModuleNamesAutogen) ) $
+      PackageDistInexcusable CVAutogenPackageInfo
+
   ]
   where
     -- Perform a check on packages that use a version of the spec less than
@@ -1925,13 +1946,25 @@ checkUnicodeXFields gpd
 
 -- | cabal-version <2.2 + Paths_module + default-extensions: doesn't build.
 checkPathsModuleExtensions :: PackageDescription -> [PackageCheck]
-checkPathsModuleExtensions pd
+checkPathsModuleExtensions = checkAutogenModuleExtensions autogenPathsModuleName RebindableClashPaths
+
+-- | cabal-version <2.2 + PackageInfo_module + default-extensions: doesn't build.
+checkPackageInfoModuleExtensions :: PackageDescription -> [PackageCheck]
+checkPackageInfoModuleExtensions = checkAutogenModuleExtensions autogenPackageInfoModuleName RebindableClashPackageInfo
+
+-- | cabal-version <2.2 + *_module + default-extensions: doesn't build.
+checkAutogenModuleExtensions ::
+  (PackageDescription -> ModuleName) ->
+  CheckExplanation ->
+  PackageDescription ->
+  [PackageCheck]
+checkAutogenModuleExtensions autogenModuleName rebindableClashExplanation pd
     | specVersion pd >= CabalSpecV2_2 = []
     | any checkBI (allBuildInfo pd) || any checkLib (allLibraries pd)
-        = return (PackageBuildImpossible RebindableClash)
+        = return (PackageBuildImpossible rebindableClashExplanation)
     | otherwise = []
   where
-    mn = autogenPathsModuleName pd
+    mn = autogenModuleName pd
 
     checkLib :: Library -> Bool
     checkLib l = mn `elem` exposedModules l && checkExts (l ^. L.defaultExtensions)

diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs
@@ -55,6 +55,7 @@ import qualified Distribution.Simple.HaskellSuite as HaskellSuite
 import qualified Distribution.Simple.PackageIndex as Index
 
 import Distribution.Simple.Build.Macros      (generateCabalMacrosHeader)
+import Distribution.Simple.Build.PackageInfoModule (generatePackageInfoModule)
 import Distribution.Simple.Build.PathsModule (generatePathsModule)
 import qualified Distribution.Simple.Program.HcPkg as HcPkg
 
@@ -773,7 +774,7 @@ componentInitialBuildSteps _distPref pkg_descr lbi clbi verbosity = do
 
   writeAutogenFiles verbosity pkg_descr lbi clbi
 
--- | Generate and write out the Paths_<pkg>.hs and cabal_macros.h files
+-- | Generate and write out the Paths_<pkg>.hs, PackageInfo_<pkg>.hs, and cabal_macros.h files
 --
 writeAutogenFiles :: Verbosity
                   -> PackageDescription
@@ -790,6 +791,13 @@ writeAutogenFiles verbosity pkg lbi clbi = do
   createDirectoryIfMissingVerbose verbosity True pathsModuleDir
   rewriteFileEx verbosity pathsModulePath (generatePathsModule pkg lbi clbi)
 
+  let packageInfoModulePath = autogenComponentModulesDir lbi clbi
+                 </> ModuleName.toFilePath (autogenPackageInfoModuleName pkg) <.> "hs"
+      packageInfoModuleDir = takeDirectory packageInfoModulePath
+  -- Ensure that the directory exists!
+  createDirectoryIfMissingVerbose verbosity True packageInfoModuleDir
+  rewriteFileEx verbosity packageInfoModulePath (generatePackageInfoModule pkg lbi)
+
   --TODO: document what we're doing here, and move it to its own function
   case clbi of
     LibComponentLocalBuildInfo { componentInstantiatedWith = insts } ->

diff --git a/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs b/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs
@@ -0,0 +1,56 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Distribution.Simple.Build.PackageInfoModule
+-- Copyright   :
+--
+-- Maintainer  :  [email protected]
+-- Portability :  portable
+--
+-- Generating the PackageInfo_pkgname module.
+--
+-- This is a module that Cabal generates for the benefit of packages. It
+-- enables them to find their package informations.
+--
+module Distribution.Simple.Build.PackageInfoModule (
+    generatePackageInfoModule
+  ) where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import Distribution.Package
+import Distribution.PackageDescription
+import Distribution.Simple.Compiler
+import Distribution.Simple.LocalBuildInfo
+import Distribution.Utils.ShortText
+import Distribution.Version
+
+import qualified Distribution.Simple.Build.PackageInfoModule.Z as Z
+
+-- ------------------------------------------------------------
+-- * Building Paths_<pkg>.hs
+-- ------------------------------------------------------------
+
+generatePackageInfoModule :: PackageDescription -> LocalBuildInfo -> String
+generatePackageInfoModule pkg_descr lbi = Z.render Z.Z
+    { Z.zPackageName   = showPkgName $ packageName pkg_descr
+    , Z.zVersionDigits = show $ versionNumbers $ packageVersion pkg_descr
+    , Z.zSynopsis        = fromShortText $ synopsis pkg_descr
+    , Z.zCopyright       = fromShortText $ copyright pkg_descr
+    , Z.zHomepage        = fromShortText $ homepage pkg_descr
+    , Z.zSupportsNoRebindableSyntax = supports_rebindable_syntax
+    }
+  where
+    supports_rebindable_syntax   = ghc_newer_than (mkVersion [7,0,1])
+
+    ghc_newer_than minVersion =
+        case compilerCompatVersion GHC (compiler lbi) of
+            Nothing      -> False
+            Just version -> version `withinRange` orLaterVersion minVersion
+
+showPkgName :: PackageName -> String
+showPkgName = map fixchar . unPackageName
+
+fixchar :: Char -> Char
+fixchar '-' = '_'
+fixchar c   = c
diff --git a/Cabal/src/Distribution/Simple/Build/PackageInfoModule/Z.hs b/Cabal/src/Distribution/Simple/Build/PackageInfoModule/Z.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Distribution.Simple.Build.PackageInfoModule.Z (render, Z (..)) where
+
+import Distribution.ZinzaPrelude
+
+data Z = Z
+  { zPackageName :: String,
+    zVersionDigits :: String,
+    zSynopsis :: String,
+    zCopyright :: String,
+    zHomepage :: String,
+    zSupportsNoRebindableSyntax :: Bool
+  }
+  deriving (Generic)
+
+render :: Z -> String
+render z_root = execWriter $ do
+  if (zSupportsNoRebindableSyntax z_root)
+  then do
+    tell "{-# LANGUAGE NoRebindableSyntax #-}\n"
+    return ()
+  else do
+    return ()
+  tell "{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}\n"
+  tell "{-# OPTIONS_GHC -w #-}\n"
+  tell "module PackageInfo_"
+  tell (zPackageName z_root)
+  tell " (\n"
+  tell "    name,\n"
+  tell "    version,\n"
+  tell "    synopsis,\n"
+  tell "    copyright,\n"
+  tell "    homepage,\n"
+  tell "  ) where\n"
+  tell "\n"
+  tell "import Data.Version (Version(..))\n"
+  tell "import Prelude\n"
+  tell "\n"
+  tell "name :: String\n"
+  tell "name = "
+  tell (show $ zPackageName z_root)
+  tell "\n"
+  tell "version :: Version\n"
+  tell "version = Version "
+  tell (zVersionDigits z_root)
+  tell " []\n"
+  tell "\n"
+  tell "synopsis :: String\n"
+  tell "synopsis = "
+  tell (show $ zSynopsis z_root)
+  tell "\n"
+  tell "copyright :: String\n"
+  tell "copyright = "
+  tell (show $ zCopyright z_root)
+  tell "\n"
+  tell "homepage :: String\n"
+  tell "homepage = "
+  tell (show $ zHomepage z_root)
+  tell "\n"
diff --git a/Cabal/src/Distribution/Simple/BuildPaths.hs b/Cabal/src/Distribution/Simple/BuildPaths.hs
@@ -20,6 +20,7 @@ module Distribution.Simple.BuildPaths (
     autogenComponentModulesDir,
 
     autogenPathsModuleName,
+    autogenPackageInfoModuleName,
     cppHeaderName,
     haddockName,
 
@@ -105,6 +106,14 @@ autogenPathsModuleName pkg_descr =
   where fixchar '-' = '_'
         fixchar c   = c
 
+-- | The name of the auto-generated PackageInfo_* module associated with a package
+autogenPackageInfoModuleName :: PackageDescription -> ModuleName
+autogenPackageInfoModuleName pkg_descr =
+  ModuleName.fromString $
+    "PackageInfo_" ++ map fixchar (prettyShow (packageName pkg_descr))
+  where fixchar '-' = '_'
+        fixchar c   = c
+
 haddockName :: PackageDescription -> FilePath
 haddockName pkg_descr = prettyShow (packageName pkg_descr) <.> "haddock"
 

diff --git a/Cabal/src/Distribution/Simple/SrcDist.hs b/Cabal/src/Distribution/Simple/SrcDist.hs
@@ -361,8 +361,10 @@ filterAutogenModules pkg_descr0 = mapLib filterAutogenModuleLib $
       otherModules   = filter (filterFunction bi) (otherModules bi)
     }
     pathsModule = autogenPathsModuleName pkg_descr0
+    packageInfoModule = autogenPackageInfoModuleName pkg_descr0
     filterFunction bi = \mn ->
                                    mn /= pathsModule
+                                && mn /= packageInfoModule
                                 && not (mn `elem` autogenModules bi)
 
 -- | Prepare a directory tree of source files for a snapshot version.

diff --git a/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal b/cabal-testsuite/PackageTests/AutogenModules/Package/my.cabal
@@ -17,6 +17,7 @@ Library
     build-depends: base
     exposed-modules:
         MyLibrary
+        PackageInfo_AutogenModules
         Paths_AutogenModules
         MyLibHelperModule
     other-modules:
@@ -30,6 +31,7 @@ Executable Exe
     build-depends: base
     other-modules:
         MyExeModule
+        PackageInfo_AutogenModules
         Paths_AutogenModules
         MyExeHelperModule
     autogen-modules:
@@ -42,6 +44,7 @@ Test-Suite Test
     build-depends: base
     other-modules:
         MyTestModule
+        PackageInfo_AutogenModules
         Paths_AutogenModules
         MyTestHelperModule
     autogen-modules:
@@ -54,6 +57,7 @@ Benchmark Bench
     build-depends: base
     other-modules:
         MyBenchModule
+        PackageInfo_AutogenModules
         Paths_AutogenModules
         MyBenchHelperModule
     autogen-modules:

diff --git a/cabal-testsuite/PackageTests/AutogenModules/Package/setup.cabal.out b/cabal-testsuite/PackageTests/AutogenModules/Package/setup.cabal.out
@@ -14,6 +14,7 @@ On executable 'Exe' an 'autogen-module' is not on 'other-modules'
 On test suite 'Test' an 'autogen-module' is not on 'other-modules'
 On benchmark 'Bench' an 'autogen-module' is not on 'other-modules'
 Packages using 'cabal-version: 2.0' and the autogenerated module Paths_* must include it also on the 'autogen-modules' field besides 'exposed-modules' and 'other-modules'. This specifies that the module does not come with the package and is generated on setup. Modules built with a custom Setup.hs script also go here to ensure that commands like sdist don't fail.
+Packages using 'cabal-version: 2.0' and the autogenerated module PackageInfo_* must include it in 'autogen-modules' as well as 'exposed-modules' and 'other-modules'. This specifies that the module does not come with the package and is generated on setup. Modules built with a custom Setup.hs script also go here to ensure that commands like sdist don't fail.
 The filename './my.cabal' does not match package name (expected: 'AutogenModules.cabal')
 Note: the public hackage server would reject this package.
 Building source dist for AutogenModules-0.1...

diff --git a/cabal-testsuite/PackageTests/AutogenModules/Package/setup.out b/cabal-testsuite/PackageTests/AutogenModules/Package/setup.out
@@ -14,6 +14,7 @@ On executable 'Exe' an 'autogen-module' is not on 'other-modules'
 On test suite 'Test' an 'autogen-module' is not on 'other-modules'
 On benchmark 'Bench' an 'autogen-module' is not on 'other-modules'
 Packages using 'cabal-version: 2.0' and the autogenerated module Paths_* must include it also on the 'autogen-modules' field besides 'exposed-modules' and 'other-modules'. This specifies that the module does not come with the package and is generated on setup. Modules built with a custom Setup.hs script also go here to ensure that commands like sdist don't fail.
+Packages using 'cabal-version: 2.0' and the autogenerated module PackageInfo_* must include it in 'autogen-modules' as well as 'exposed-modules' and 'other-modules'. This specifies that the module does not come with the package and is generated on setup. Modules built with a custom Setup.hs script also go here to ensure that commands like sdist don't fail.
 The filename './my.cabal' does not match package name (expected: 'AutogenModules.cabal')
 Note: the public hackage server would reject this package.
 Building source dist for AutogenModules-0.1...