Add PackageMeta_ autogenerated module (#11755)

Cabal/Cabal.cabal

@@ -112,6 +112,7 @@ library
     Distribution.Simple.Build.Inputs
     Distribution.Simple.Build.Macros
     Distribution.Simple.Build.PackageInfoModule
+    Distribution.Simple.Build.PackageMetaModule
     Distribution.Simple.Build.PathsModule
     Distribution.Simple.BuildPaths
     Distribution.Simple.BuildTarget
@@ -355,6 +356,7 @@ library
     Distribution.PackageDescription.Check.Warning
     Distribution.Simple.Build.Macros.Z
     Distribution.Simple.Build.PackageInfoModule.Z
+    Distribution.Simple.Build.PackageMetaModule.Z
     Distribution.Simple.Build.PathsModule.Z
     Distribution.Simple.GHC.Build
     Distribution.Simple.GHC.Build.ExtraSources

Cabal/src/Distribution/Simple/Build.hs

@@ -77,6 +77,7 @@ import qualified Distribution.Simple.UHC as UHC
 
 import Distribution.Simple.Build.Macros (generateCabalMacrosHeader)
 import Distribution.Simple.Build.PackageInfoModule (generatePackageInfoModule)
+import Distribution.Simple.Build.PackageMetaModule (generatePackageMetaModule)
 import Distribution.Simple.Build.PathsModule (generatePathsModule, pkgPathEnvVar)
 import qualified Distribution.Simple.Program.HcPkg as HcPkg
 
@@ -1157,6 +1158,7 @@ preBuildComponent preBuildHook verbosity lbi tgt = do
 --
 --  - @Paths_<pkg>.hs@,
 --  - @PackageInfo_<pkg>.hs@,
+--  - @PackageMeta_<pkg>.hs@,
 --  - Backpack signature files for components that are not fully instantiated,
 --  - @cabal_macros.h@.
 writeBuiltinAutogenFiles
@@ -1172,6 +1174,7 @@ writeBuiltinAutogenFiles verbosity pkg lbi clbi =
 --
 --  - @Paths_<pkg>.hs@,
 --  - @PackageInfo_<pkg>.hs@,
+--  - @PackageMeta_<pkg>.hs@,
 --  - Backpack signature files for components that are not fully instantiated,
 --  - @cabal_macros.h@.
 builtinAutogenFiles
@@ -1182,13 +1185,19 @@ builtinAutogenFiles
 builtinAutogenFiles pkg lbi clbi =
   Map.insert pathsFile pathsContents $
     Map.insert packageInfoFile packageInfoContents $
-      Map.insert cppHeaderFile cppHeaderContents $
-        emptySignatureModules clbi
+      Map.insert packageMetaFile packageMetaContents $
+        Map.insert cppHeaderFile cppHeaderContents $
+          emptySignatureModules clbi
   where
     pathsFile = AutogenModule (autogenPathsModuleName pkg) (Suffix "hs")
     pathsContents = toUTF8LBS $ generatePathsModule pkg lbi clbi
     packageInfoFile = AutogenModule (autogenPackageInfoModuleName pkg) (Suffix "hs")
     packageInfoContents = toUTF8LBS $ generatePackageInfoModule pkg
+    packageMetaFile = AutogenModule (autogenPackageMetaModuleName pkg) (Suffix "hs")
+    -- TODO: Git revision info requires IO (running git commands) but
+    -- builtinAutogenFiles is pure. Pass empty git info for now; a follow-up
+    -- will wire up the IO-based git revision lookup at the call site.
+    packageMetaContents = toUTF8LBS $ generatePackageMetaModule pkg lbi "" False
     cppHeaderFile = AutogenFile $ toShortText cppHeaderName
     cppHeaderContents = toUTF8LBS $ generateCabalMacrosHeader pkg lbi clbi
 

Cabal/src/Distribution/Simple/Build/PackageMetaModule.hs

@@ -0,0 +1,86 @@
+-----------------------------------------------------------------------------
+
+-- |
+-- Module      :  Distribution.Simple.Build.PackageMetaModule
+-- Copyright   :  Moritz Angermann <moritz.angermann@iohk.io>
+--
+-- Maintainer  :  cabal-devel@haskell.org
+-- Portability :  portable
+--
+-- Generating the PackageMeta_pkgname module.
+--
+-- This is a module that Cabal generates for the benefit of packages. It
+-- enables them to find build-environment metadata such as compiler info,
+-- platform, cabal flags, and git revision.
+module Distribution.Simple.Build.PackageMetaModule
+  ( generatePackageMetaModule
+  ) where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import Distribution.Compiler (CompilerId (..))
+import Distribution.Package
+  ( PackageName
+  , packageName
+  , unPackageName
+  )
+import Distribution.Pretty (prettyShow)
+import Distribution.Simple.Compiler (compilerId)
+import Distribution.System (Platform (..))
+import Distribution.Types.Flag (FlagName, unFlagAssignment, unFlagName)
+import Distribution.Types.LocalBuildInfo (LocalBuildInfo (..))
+import Distribution.Types.PackageDescription (PackageDescription)
+import Distribution.Types.Version (versionNumbers)
+
+import qualified Distribution.Simple.Build.PackageMetaModule.Z as Z
+
+-- ------------------------------------------------------------
+
+-- * Building PackageMeta_<pkg>.hs
+
+-- ------------------------------------------------------------
+
+-- | Generate the source code for the @PackageMeta_<pkgname>@ module.
+--
+-- The @gitRev@ and @gitDirty@ parameters are passed in because computing
+-- them requires IO (running @git@ commands), and this function is pure.
+generatePackageMetaModule
+  :: PackageDescription
+  -> LocalBuildInfo
+  -> String
+  -- ^ Git revision hash (empty string if unavailable)
+  -> Bool
+  -- ^ Whether the working tree has uncommitted changes
+  -> String
+generatePackageMetaModule pkg_descr lbi gitRev gitDirty =
+  Z.render
+    Z.Z
+      { Z.zPackageName = showPkgName $ packageName pkg_descr
+      , Z.zCompilerFlavour = prettyShow flavour
+      , Z.zCompilerName = prettyShow cid
+      , Z.zCompilerVersionDigits = show $ versionNumbers ver
+      , Z.zOs = prettyShow os
+      , Z.zArch = prettyShow arch
+      , Z.zGitRevision = gitRev
+      , Z.zGitDirty = gitDirty
+      , Z.zFlags = map toFlagZ $ unFlagAssignment $ flagAssignment lbi
+      }
+  where
+    cid@(CompilerId flavour ver) = compilerId $ compiler lbi
+    Platform arch os = hostPlatform lbi
+
+    toFlagZ :: (FlagName, Bool) -> Z.FlagZ
+    toFlagZ (fn, val) =
+      Z.FlagZ
+        { Z.zFlagName = unFlagName fn
+        , Z.zFlagHaskellName = "flag_" ++ map fixchar (unFlagName fn)
+        , Z.zFlagValue = val
+        }
+
+showPkgName :: PackageName -> String
+showPkgName = map fixchar . unPackageName
+
+fixchar :: Char -> Char
+fixchar '-' = '_'
+fixchar c = c

Cabal/src/Distribution/Simple/Build/PackageMetaModule/Z.hs

@@ -0,0 +1,124 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+-- |
+-- Module      :  Distribution.Simple.Build.PackageMetaModule.Z
+-- Copyright   :  Moritz Angermann <moritz.angermann@iohk.io>
+--
+-- Maintainer  :  cabal-devel@haskell.org
+-- Portability :  portable
+--
+-- Zinza-style renderer for the @PackageMeta_pkgname@ module.
+module Distribution.Simple.Build.PackageMetaModule.Z (render, Z (..), FlagZ (..)) where
+
+import Distribution.ZinzaPrelude (Generic, execWriter, forM_, tell)
+
+-- | A single cabal flag entry.
+data FlagZ = FlagZ
+  { zFlagName :: String
+  -- ^ Original flag name (e.g. "debug")
+  , zFlagHaskellName :: String
+  -- ^ Haskell-safe name (e.g. "flag_debug")
+  , zFlagValue :: Bool
+  -- ^ Resolved value
+  }
+  deriving (Generic)
+
+-- | Template data for rendering the PackageMeta module.
+data Z = Z
+  { zPackageName :: String
+  , zCompilerFlavour :: String
+  , zCompilerName :: String
+  , zCompilerVersionDigits :: String
+  , zOs :: String
+  , zArch :: String
+  , zGitRevision :: String
+  , zGitDirty :: Bool
+  , zFlags :: [FlagZ]
+  }
+  deriving (Generic)
+
+render :: Z -> String
+render z = execWriter $ do
+  tell "{-# LANGUAGE NoRebindableSyntax #-}\n"
+  tell "{-# OPTIONS_GHC -w #-}\n"
+  tell "\n"
+  tell "{-|\n"
+  tell "Module      : PackageMeta_"
+  tell (zPackageName z)
+  tell "\n"
+  tell "\n"
+  tell "Autogenerated module providing build-environment metadata.\n"
+  tell "-}\n"
+  tell "module PackageMeta_"
+  tell (zPackageName z)
+  tell " (\n"
+  tell "    compiler,\n"
+  tell "    compilerVersion,\n"
+  tell "    os,\n"
+  tell "    arch,\n"
+  tell "    gitRevision,\n"
+  tell "    gitDirty,\n"
+  -- Export flag names
+  forM_ (zFlags z) $ \f -> do
+    tell "    "
+    tell (zFlagHaskellName f)
+    tell ",\n"
+  tell "  ) where\n"
+  tell "\n"
+  tell "import Data.Version (Version(..))\n"
+  tell "import Prelude\n"
+  tell "\n"
+  -- Compiler info
+  tell "-- | The Haskell compiler used to build this package (e.g. @\"ghc\"@).\n"
+  tell "compiler :: String\n"
+  tell "compiler = "
+  tell (show (zCompilerFlavour z))
+  tell "\n"
+  tell "\n"
+  tell "-- | The version of the compiler used to build this package.\n"
+  tell "compilerVersion :: Version\n"
+  tell "compilerVersion = Version "
+  tell (zCompilerVersionDigits z)
+  tell " []\n"
+  tell "\n"
+  -- Platform info
+  tell "-- | The operating system this package was built on (e.g. @\"linux\"@, @\"darwin\"@).\n"
+  tell "os :: String\n"
+  tell "os = "
+  tell (show (zOs z))
+  tell "\n"
+  tell "\n"
+  tell "-- | The CPU architecture this package was built for (e.g. @\"x86_64\"@, @\"aarch64\"@).\n"
+  tell "arch :: String\n"
+  tell "arch = "
+  tell (show (zArch z))
+  tell "\n"
+  tell "\n"
+  -- Git info
+  tell "-- | The VCS revision at build time, or @\"\"@ if unavailable.\n"
+  tell "gitRevision :: String\n"
+  tell "gitRevision = "
+  tell (show (zGitRevision z))
+  tell "\n"
+  tell "\n"
+  tell "-- | Whether the working tree had uncommitted changes at build time.\n"
+  tell "gitDirty :: Bool\n"
+  tell "gitDirty = "
+  if zGitDirty z
+    then tell "True"
+    else tell "False"
+  tell "\n"
+  -- Flag values
+  forM_ (zFlags z) $ \f -> do
+    tell "\n"
+    tell "-- | The value of the @"
+    tell (zFlagName f)
+    tell "@ cabal flag.\n"
+    tell (zFlagHaskellName f)
+    tell " :: Bool\n"
+    tell (zFlagHaskellName f)
+    tell " = "
+    if zFlagValue f
+      then tell "True"
+      else tell "False"
+    tell "\n"

Cabal/src/Distribution/Simple/BuildPaths.hs

@@ -29,6 +29,7 @@ module Distribution.Simple.BuildPaths
   , autogenComponentModulesDir
   , autogenPathsModuleName
   , autogenPackageInfoModuleName
+  , autogenPackageMetaModuleName
   , cppHeaderName
   , haddockPath
   , haddockPackageLibraryName
@@ -184,6 +185,15 @@ autogenPackageInfoModuleName pkg_descr =
     fixchar '-' = '_'
     fixchar c = c
 
+-- | The name of the auto-generated PackageMeta_* module associated with a package
+autogenPackageMetaModuleName :: PackageDescription -> ModuleName
+autogenPackageMetaModuleName pkg_descr =
+  ModuleName.fromString $
+    "PackageMeta_" ++ map fixchar (prettyShow (packageName pkg_descr))
+  where
+    fixchar '-' = '_'
+    fixchar c = c
+
 haddockPath :: PackageDescription -> FilePath
 haddockPath pkg_descr = prettyShow (packageName pkg_descr) <.> "haddock"
 

Cabal/src/Distribution/Simple/SrcDist.hs

@@ -428,9 +428,11 @@ filterAutogenModules pkg_descr0 =
         }
     pathsModule = autogenPathsModuleName pkg_descr0
     packageInfoModule = autogenPackageInfoModuleName pkg_descr0
+    packageMetaModule = autogenPackageMetaModuleName pkg_descr0
     filterFunction bi = \mn ->
       mn /= pathsModule
         && mn /= packageInfoModule
+        && mn /= packageMetaModule
         && notElem mn (autogenModules bi)
 
 -- | Prepare a directory tree of source files for a snapshot version.

cabal-testsuite/PackageTests/PackageMetaModule/Executable/Main.hs

@@ -0,0 +1,12 @@
+module Main where
+
+import PackageMeta_PackageMetaModule (compiler, compilerVersion, os, arch, gitRevision, gitDirty)
+
+main :: IO ()
+main = do
+  putStrLn compiler
+  print compilerVersion
+  putStrLn os
+  putStrLn arch
+  putStrLn gitRevision
+  print gitDirty

cabal-testsuite/PackageTests/PackageMetaModule/Executable/my.cabal

@@ -0,0 +1,18 @@
+Cabal-version: 3.12
+name: PackageMetaModule
+version: 0.1
+license: BSD-3-Clause
+author: Moritz Angermann
+stability: stable
+category: PackageTests
+build-type: Simple
+
+description:
+    Check that the generated package meta module compiles.
+
+Executable TestPackageMetaModule
+    main-is: Main.hs
+    other-modules:
+        PackageMeta_PackageMetaModule
+        Paths_PackageMetaModule
+    build-depends: base

cabal-testsuite/PackageTests/PackageMetaModule/Executable/setup.cabal.out

@@ -0,0 +1,5 @@
+# Setup configure
+Configuring PackageMetaModule-0.1...
+# Setup build
+Preprocessing executable 'TestPackageMetaModule' for PackageMetaModule-0.1...
+Building executable 'TestPackageMetaModule' for PackageMetaModule-0.1...

cabal-testsuite/PackageTests/PackageMetaModule/Executable/setup.out

@@ -0,0 +1,5 @@
+# Setup configure
+Configuring PackageMetaModule-0.1...
+# Setup build
+Preprocessing executable 'TestPackageMetaModule' for PackageMetaModule-0.1...
+Building executable 'TestPackageMetaModule' for PackageMetaModule-0.1...

cabal-testsuite/PackageTests/PackageMetaModule/Executable/setup.test.hs

@@ -0,0 +1,3 @@
+import Test.Cabal.Prelude
+-- Test that PackageMeta module is generated and available for executables.
+main = setupAndCabalTest $ setup_build []

cabal-testsuite/PackageTests/PackageMetaModule/Library/my.cabal

@@ -0,0 +1,36 @@
+Cabal-version: 3.12
+name: PackageMetaModule
+version: 0.1
+license: BSD-3-Clause
+author: Moritz Angermann
+stability: stable
+category: PackageTests
+build-type: Simple
+
+description:
+    Check that the generated package meta module compiles.
+
+Library
+    exposed-modules:
+        PackageMeta_PackageMetaModule
+        Paths_PackageMetaModule
+    build-depends: base
+    default-language: Haskell2010
+    default-extensions:
+        -- This is a non-exhaustive list of extensions that can cause code to
+        -- not compile when it would if the extension was disabled. This ensures
+        -- that autogen modules are compatible with default extensions.
+        NoImplicitPrelude
+        CPP
+        TemplateHaskell
+        QuasiQuotes
+        Arrows
+        OverloadedStrings
+    if impl(ghc >= 6.12)
+       default-extensions: MonoLocalBinds
+    if impl(ghc >= 7.0.1)
+       default-extensions: RebindableSyntax
+    if impl(ghc >= 7.4.1)
+       default-extensions: NoTraditionalRecordSyntax
+    if impl(ghc >= 7.8.1)
+       default-extensions: OverloadedLists