Cabal: Expose flag assignment to configure script (#8565)

* Cabal: Expose flag assignment to configure script

Here we extend the `build-type: configure` mechanism to allow the
configure script to inspect the flag assignment via the `CABAL_FLAGS`
environment variable.

As suggested in #8564.

* Fix typo in change log

* Make new test failures more informative

* Fix test

flags are no longer called `a` and `b`.

* Add warning for conflicting flag name env vars

* Convert haddocks to regular comments for local vars

Pitty haddocks on local vars broke doc tests CI job.

* Fix warning and, hopefully, tests

Co-authored-by: John Ericson <John.Ericson@Obsidian.Systems>
Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>

Cabal/src/Distribution/Simple.hs

 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE CPP #-}
@@ -111,6 +112,8 @@ import Distribution.Compat.GetShortPathName (getShortPathName)
 
 import Data.List       (unionBy, (\\))
 
+import qualified Data.List.NonEmpty as NonEmpty
+import qualified Data.Map as Map
 
 -- | A simple implementation of @main@ for a Cabal setup script.
 -- It reads the package description file using IO, and performs the
@@ -685,6 +688,45 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
         , " building the package to fail later."
         ]
 
+  let -- Convert a flag name to name of environment variable to represent its
+      -- value for the configure script.
+      flagEnvVar :: FlagName -> String
+      flagEnvVar flag = "CABAL_FLAG_" ++ map f (unFlagName flag)
+        where f c
+                | isAlphaNum c = c
+                | otherwise    = '_'
+      -- A map from such env vars to every flag name and value where the name
+      -- name maps to that that env var.
+      cabalFlagMap :: Map String (NonEmpty (FlagName, Bool))
+      cabalFlagMap = Map.fromListWith (<>)
+                     [ (flagEnvVar flag, (flag, bool) :| [])
+                     | (flag, bool) <- unFlagAssignment $ flagAssignment lbi
+                     ]
+  -- A map from env vars to flag names to the single flag we will go with
+  cabalFlagMapDeconflicted :: Map String (FlagName, Bool) <-
+    flip Map.traverseWithKey cabalFlagMap $ \ envVar -> \case
+      -- No conflict: no problem
+      singleFlag :| [] -> pure singleFlag
+      -- Conflict: warn and discard all but first
+      collidingFlags@(firstFlag :| _ : _) -> do
+        let quote s = "'" ++ s ++ "'"
+            toName = quote . unFlagName . fst
+            renderedList = intercalate ", " $ NonEmpty.toList $ toName <$> collidingFlags
+        warn verbosity $ unwords
+          [ "Flags", renderedList, "all map to the same environment variable"
+          , quote envVar, "causing a collision."
+          , "The value first flag", toName firstFlag, "will be used."
+          ]
+        pure firstFlag
+
+  let cabalFlagEnv = [ (envVar, Just val)
+                     | (envVar, (_, bool)) <- Map.toList cabalFlagMapDeconflicted
+                     , let val = if bool then "1" else "0"
+                     ] ++
+                     [ ( "CABAL_FLAGS"
+                       , Just $ unwords [ showFlagValue fv | fv <- unFlagAssignment $ flagAssignment lbi ]
+                       )
+                     ]
   let extraPath = fromNubList $ configProgramPathExtra flags
   let cflagsEnv = maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags))
                   $ lookup "CFLAGS" env
@@ -692,7 +734,8 @@ runConfigureScript verbosity backwardsCompatHack flags lbi = do
       pathEnv = maybe (intercalate spSep extraPath)
                 ((intercalate spSep extraPath ++ spSep)++) $ lookup "PATH" env
       overEnv = ("CFLAGS", Just cflagsEnv) :
-                [("PATH", Just pathEnv) | not (null extraPath)]
+                [("PATH", Just pathEnv) | not (null extraPath)] ++
+                cabalFlagEnv
       hp = hostPlatform lbi
       maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)]
       args' = configureFile':args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag

cabal-testsuite/PackageTests/Configure/cabal.out

@@ -4,5 +4,6 @@ Build profile: -w ghc-<GHCVER> -O1
 In order, the following will be built:
  - zlib-1.1 (lib:zlib) (first run)
 Configuring zlib-1.1...
+Warning: Flags 'con_flict', 'con-flict' all map to the same environment variable 'CABAL_FLAG_con_flict' causing a collision. The value first flag 'con_flict' will be used.
 Preprocessing library for zlib-1.1..
 Building library for zlib-1.1..

cabal-testsuite/PackageTests/Configure/configure.ac

@@ -9,6 +9,21 @@ AC_CONFIG_HEADERS([include/HsZlibConfig.h])
 # Check for zlib include
 AC_CHECK_HEADER(zlib.h, [ZLIB_HEADER=yes], [], [])
 
+# Check that flag assignment has been propagated correctly
+if test "$CABAL_FLAG_true_flag" != "1"; then
+    echo "true flag incorrectly set: got '$CABAL_FLAG_true_flag'"
+    exit 1
+fi
+if test "$CABAL_FLAG_false_flag" != "0"; then
+    echo "false flag incorrectly set: got '$CABAL_FLAG_false_flag'"
+    exit 1
+fi
+
+if test "$CABAL_FLAGS" != "+con-flict +con_flict -false-flag +true-flag"; then
+    echo "CABAL_FLAGS incorrectly set: got '$CABAL_FLAGS'"
+    exit 1
+fi
+
 # Build the package if we found X11 stuff
 if test "x$ZLIB_HEADER" = "x"
 then BUILD_PACKAGE_BOOL=False

cabal-testsuite/PackageTests/Configure/setup.cabal.out

 # Setup configure
 Resolving dependencies...
 Configuring zlib-1.1...
+Warning: Flags 'con_flict', 'con-flict' all map to the same environment variable 'CABAL_FLAG_con_flict' causing a collision. The value first flag 'con_flict' will be used.
 # Setup build
 Preprocessing library for zlib-1.1..
 Building library for zlib-1.1..

cabal-testsuite/PackageTests/Configure/setup.out

 # Setup configure
 Configuring zlib-1.1...
+Warning: Flags 'con_flict', 'con-flict' all map to the same environment variable 'CABAL_FLAG_con_flict' causing a collision. The value first flag 'con_flict' will be used.
 # Setup build
 Preprocessing library for zlib-1.1..
 Building library for zlib-1.1..

cabal-testsuite/PackageTests/Configure/zlib.cabal

@@ -6,6 +6,22 @@ maintainer:          ezyang@cs.stanford.edu
 build-type:          Configure
 cabal-version:       >=1.10
 
+flag con-flict
+  description:       A flag that will share an env var
+  default:           True
+
+flag con_flict
+  description:       A flag that will share an env var
+  default:           True
+
+flag true-flag
+  description:       A flag to ensure that flags are correctly passed to @configure@
+  default:           True
+
+flag false-flag
+  description:       A flag to ensure that flags are correctly passed to @configure@
+  default:           False
+
 library
   exposed-modules:     A
   build-depends:       base

changelog.d/issue-8564

+synopsis: The `configure` script of `build-type: configure` packages now has access to the flag assignment of the package being built via the `CABAL_FLAGS` and `CABAL_FLAG_<flag>` environment variables
+packages: Cabal
+prs: #8565
+issues: #8564
+

doc/cabal-package.rst

@@ -3201,6 +3201,20 @@ The :pkg-field:`build-type` ``Configure`` differs from ``Simple`` in two ways:
    generated by the ``configure`` script mentioned above, allowing these
    settings to vary depending on the build environment.
 
+Note that the package's ``extra-source-files`` are available to the
+``configure`` script when it is executed. In typical ``autoconf`` fashion,
+``--host`` flag will be passed to the ``configure`` script to indicate the host
+platform when cross-compiling. Moreover, various bits of build configuration
+will be passed via environment variables:
+
+ - ``CC`` will reflect the path to the C compiler
+ - ``CFLAGS`` will reflect the path to the C compiler
+ - ``CABAL_FLAGS`` will contain the Cabal flag assignment of the current
+   package using traditional Cabal flag syntax (e.g. ``+flagA -flagB``)
+ - ``CABAL_FLAG_<flag>`` will be set to either ``0`` or ``1`` depending upon
+   whether flag ``<flag>`` is enabled. Note that any any non-alpha-numeric
+   characters in the flag name are replaced with ``_``.
+
 The build information file should have the following structure:
 
     *buildinfo*