Generate cabal_macros.h from a zinza template

.github/workflows/quick-jobs.yml

@@ -42,6 +42,7 @@ jobs:
           make lexer
           make gen-extra-source-files
           make spdx
+          make templates
           make github-actions
       - name: Check that diff is clean
         run: |

Cabal/Cabal.cabal

@@ -559,10 +559,12 @@ library
     Distribution.GetOpt
     Distribution.Lex
     Distribution.Utils.String
+    Distribution.Simple.Build.Macros.Z
     Distribution.Simple.GHC.EnvironmentParser
     Distribution.Simple.GHC.Internal
     Distribution.Simple.GHC.ImplInfo
     Distribution.Simple.Utils.Json
+    Distribution.ZinzaPrelude
     Paths_Cabal
 
   if flag(bundled-binary-generic)

Cabal/Distribution/Simple/Build/Macros.hs

@@ -35,126 +35,78 @@ import Distribution.Simple.Program.Types
 import Distribution.Types.MungedPackageId
 import Distribution.Types.MungedPackageName
 import Distribution.Types.PackageId
+import Distribution.Types.PackageName (unPackageName)
 import Distribution.Pretty
 
--- ------------------------------------------------------------
--- * Generate cabal_macros.h
--- ------------------------------------------------------------
-
--- Invariant: HeaderLines always has a trailing newline
-type HeaderLines = String
-
-line :: String -> HeaderLines
-line str = str ++ "\n"
-
-ifndef :: String -> HeaderLines -> HeaderLines
-ifndef macro body =
-    line ("#ifndef " ++ macro) ++
-    body ++
-    line ("#endif /* " ++ macro ++ " */")
-
-define :: String -> Maybe [String] -> String -> HeaderLines
-define macro params val =
-    line ("#define " ++ macro ++ f params ++ " " ++ val)
-  where
-    f Nothing = ""
-    f (Just xs) = "(" ++ intercalate "," xs ++ ")"
-
-defineStr :: String -> String -> HeaderLines
-defineStr macro str = define macro Nothing (show str)
-
-ifndefDefine :: String -> Maybe [String] -> String -> HeaderLines
-ifndefDefine macro params str =
-    ifndef macro (define macro params str)
-
-ifndefDefineStr :: String -> String -> HeaderLines
-ifndefDefineStr macro str =
-    ifndef macro (defineStr macro str)
+import qualified Distribution.Simple.Build.Macros.Z as Z
 
 -- | The contents of the @cabal_macros.h@ for the given configured package.
 --
 generateCabalMacrosHeader :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> String
-generateCabalMacrosHeader pkg_descr lbi clbi =
-  "/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n" ++
-  generatePackageVersionMacros
-    (package pkg_descr : map getPid (componentPackageDeps clbi)) ++
-  generateToolVersionMacros (configuredPrograms . withPrograms $ lbi) ++
-  generateComponentIdMacro lbi clbi ++
-  generateCurrentPackageVersion pkg_descr
- where
-  getPid (_, MungedPackageId (MungedPackageName pn _) v) =
-    -- NB: Drop the library name! We're just reporting package versions.
-    -- This would have to be revisited if you are allowed to depend
-    -- on different versions of the same package
-    PackageIdentifier pn v
+generateCabalMacrosHeader pkg_descr lbi clbi = Z.render Z.Z
+    { Z.zPackages        = map mkZPackage $ package pkg_descr : map getPid (componentPackageDeps clbi)
+    , Z.zTools           =
+        [ Z.ZTool
+            { Z.ztoolName    = programId prog
+            , Z.ztoolVersion = ver
+            , Z.ztoolX       = major1
+            , Z.ztoolY       = major2
+            , Z.ztoolZ       = minor
+            }
+        | prog <- configuredPrograms $ withPrograms lbi
+        , ver <- maybeToList (programVersion prog)
+        , let (major1,major2,minor) = majorMinor ver
+        ]
+    , Z.zPackageKey      = case clbi of
+        LibComponentLocalBuildInfo{} -> componentCompatPackageKey clbi
+        _                            -> ""
+    , Z.zComponentId     = prettyShow (componentComponentId clbi)
+    , Z.zPackageVersion  = pkgVersion (package pkg_descr)
+    , Z.zNotNull         = not . null
+    , Z.zManglePkgName   = map fixchar . unPackageName
+    , Z.zMangleStr       = map fixchar
+    }
+  where
+    getPid (_, MungedPackageId (MungedPackageName pn _) v) =
+       -- NB: Drop the library name! We're just reporting package versions.
+       -- This would have to be revisited if you are allowed to depend
+       -- on different versions of the same package
+        PackageIdentifier pn v
 
 -- | Helper function that generates just the @VERSION_pkg@ and @MIN_VERSION_pkg@
 -- macros for a list of package ids (usually used with the specific deps of
 -- a configured package).
 --
-generatePackageVersionMacros :: [PackageId] -> String
-generatePackageVersionMacros pkgids = concat
-  [ line ("/* package " ++ prettyShow pkgid ++ " */")
-  ++ generateMacros "" pkgname version
-  | pkgid@(PackageIdentifier name version) <- pkgids
-  , let pkgname = map fixchar (prettyShow name)
-  ]
-
--- | Helper function that generates just the @TOOL_VERSION_pkg@ and
--- @MIN_TOOL_VERSION_pkg@ macros for a list of configured programs.
---
-generateToolVersionMacros :: [ConfiguredProgram] -> String
-generateToolVersionMacros progs = concat
-  [ line ("/* tool " ++ progid ++ " */")
-  ++ generateMacros "TOOL_" progname version
-  | prog <- progs
-  , isJust . programVersion $ prog
-  , let progid   = programId prog ++ "-" ++ prettyShow version
-        progname = map fixchar (programId prog)
-        version  = fromMaybe version0 (programVersion prog)
-  ]
-
--- | Common implementation of 'generatePackageVersionMacros' and
--- 'generateToolVersionMacros'.
---
-generateMacros :: String -> String -> Version -> String
-generateMacros macro_prefix name version =
-  concat
-  [ifndefDefineStr (macro_prefix ++ "VERSION_" ++ name) (prettyShow version)
-  ,ifndefDefine ("MIN_" ++ macro_prefix ++ "VERSION_" ++ name)
-                (Just ["major1","major2","minor"])
-    $ concat [
-       "(\\\n"
-      ,"  (major1) <  ",major1," || \\\n"
-      ,"  (major1) == ",major1," && (major2) <  ",major2," || \\\n"
-      ,"  (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"
-    ]
-  ,"\n"]
+generatePackageVersionMacros :: Version -> [PackageId] -> String
+generatePackageVersionMacros ver pkgids = Z.render Z.Z
+    { Z.zPackages        = map mkZPackage pkgids
+    , Z.zTools           = []
+    , Z.zPackageKey      = ""
+    , Z.zComponentId     = ""
+    , Z.zPackageVersion  = ver
+    , Z.zNotNull         = not . null
+    , Z.zManglePkgName   = map fixchar . unPackageName
+    , Z.zMangleStr       = map fixchar
+    }
+
+mkZPackage :: PackageId -> Z.ZPackage
+mkZPackage (PackageIdentifier name ver) = Z.ZPackage
+    { Z.zpkgName    = name
+    , Z.zpkgVersion = ver
+    , Z.zpkgX       = major1
+    , Z.zpkgY       = major2
+    , Z.zpkgZ       = minor
+    }
   where
-    (major1,major2,minor) = case map show (versionNumbers version) of
+    (major1,major2,minor) = majorMinor ver
+
+majorMinor :: Version -> (String, String, String)
+majorMinor ver = case map show (versionNumbers ver) of
         []        -> ("0", "0", "0")
         [x]       -> (x,   "0", "0")
         [x,y]     -> (x,   y,   "0")
         (x:y:z:_) -> (x,   y,   z)
 
--- | Generate the @CURRENT_COMPONENT_ID@ definition for the component ID
---   of the current package.
-generateComponentIdMacro :: LocalBuildInfo -> ComponentLocalBuildInfo -> String
-generateComponentIdMacro _lbi clbi =
-  concat $
-      [case clbi of
-        LibComponentLocalBuildInfo{} ->
-          ifndefDefineStr "CURRENT_PACKAGE_KEY" (componentCompatPackageKey clbi)
-        _ -> ""
-      ,ifndefDefineStr "CURRENT_COMPONENT_ID" (prettyShow (componentComponentId clbi))
-      ]
-
--- | Generate the @CURRENT_PACKAGE_VERSION@ definition for the declared version
---   of the current package.
-generateCurrentPackageVersion :: PackageDescription -> String
-generateCurrentPackageVersion pd =
-  ifndefDefineStr "CURRENT_PACKAGE_VERSION" (prettyShow (pkgVersion (package pd)))
-
 fixchar :: Char -> Char
 fixchar '-' = '_'
 fixchar c   = c

Cabal/Distribution/Simple/Build/Macros/Z.hs

@@ -0,0 +1,140 @@
+{-# LANGUAGE DeriveGeneric #-}
+module Distribution.Simple.Build.Macros.Z (render, Z(..), ZPackage (..), ZTool (..)) where
+import Distribution.ZinzaPrelude
+data Z
+    = Z {zPackages :: ([ZPackage]),
+         zTools :: ([ZTool]),
+         zPackageKey :: String,
+         zComponentId :: String,
+         zPackageVersion :: Version,
+         zNotNull :: (String -> Bool),
+         zManglePkgName :: (PackageName -> String),
+         zMangleStr :: (String -> String)}
+    deriving Generic
+data ZPackage
+    = ZPackage {zpkgName :: PackageName,
+                zpkgVersion :: Version,
+                zpkgX :: String,
+                zpkgY :: String,
+                zpkgZ :: String}
+    deriving Generic
+data ZTool
+    = ZTool {ztoolName :: String,
+             ztoolVersion :: Version,
+             ztoolX :: String,
+             ztoolY :: String,
+             ztoolZ :: String}
+    deriving Generic
+render :: Z -> String
+render z_root = execWriter $ do
+  tell "/* DO NOT EDIT: This file is automatically generated by Cabal */\n"
+  tell "\n"
+  forM_ (zPackages z_root) $ \z_var0_pkg -> do
+    tell "/* package "
+    tell (prettyShow (zpkgName z_var0_pkg))
+    tell "-"
+    tell (prettyShow (zpkgVersion z_var0_pkg))
+    tell " */\n"
+    tell "#ifndef VERSION_"
+    tell (zManglePkgName z_root (zpkgName z_var0_pkg))
+    tell "\n"
+    tell "#define VERSION_"
+    tell (zManglePkgName z_root (zpkgName z_var0_pkg))
+    tell " \""
+    tell (prettyShow (zpkgVersion z_var0_pkg))
+    tell "\"\n"
+    tell "#endif /* VERSION_"
+    tell (zManglePkgName z_root (zpkgName z_var0_pkg))
+    tell " */\n"
+    tell "#ifndef MIN_VERSION_"
+    tell (zManglePkgName z_root (zpkgName z_var0_pkg))
+    tell "\n"
+    tell "#define MIN_VERSION_"
+    tell (zManglePkgName z_root (zpkgName z_var0_pkg))
+    tell "(major1,major2,minor) (\\\n"
+    tell "  (major1) <  "
+    tell (zpkgX z_var0_pkg)
+    tell " || \\\n"
+    tell "  (major1) == "
+    tell (zpkgX z_var0_pkg)
+    tell " && (major2) <  "
+    tell (zpkgY z_var0_pkg)
+    tell " || \\\n"
+    tell "  (major1) == "
+    tell (zpkgX z_var0_pkg)
+    tell " && (major2) == "
+    tell (zpkgY z_var0_pkg)
+    tell " && (minor) <= "
+    tell (zpkgZ z_var0_pkg)
+    tell ")\n"
+    tell "#endif /* MIN_VERSION_"
+    tell (zManglePkgName z_root (zpkgName z_var0_pkg))
+    tell " */\n"
+  tell "\n"
+  forM_ (zTools z_root) $ \z_var1_tool -> do
+    tell "/* package "
+    tell (ztoolName z_var1_tool)
+    tell "-"
+    tell (prettyShow (ztoolVersion z_var1_tool))
+    tell " */\n"
+    tell "#ifndef TOOL_VERSION_"
+    tell (zMangleStr z_root (ztoolName z_var1_tool))
+    tell "\n"
+    tell "#define TOOL_VERSION_"
+    tell (zMangleStr z_root (ztoolName z_var1_tool))
+    tell " \""
+    tell (prettyShow (ztoolVersion z_var1_tool))
+    tell "\"\n"
+    tell "#endif /* VERSION_"
+    tell (zMangleStr z_root (ztoolName z_var1_tool))
+    tell " */\n"
+    tell "#ifndef MIN_TOOL_VERSION_"
+    tell (zMangleStr z_root (ztoolName z_var1_tool))
+    tell "\n"
+    tell "#define MIN_TOOL_VERSION_"
+    tell (zMangleStr z_root (ztoolName z_var1_tool))
+    tell "(major1,major2,minor) (\\\n"
+    tell "  (major1) <  "
+    tell (ztoolX z_var1_tool)
+    tell " || \\\n"
+    tell "  (major1) == "
+    tell (ztoolX z_var1_tool)
+    tell " && (major2) <  "
+    tell (ztoolY z_var1_tool)
+    tell " || \\\n"
+    tell "  (major1) == "
+    tell (ztoolX z_var1_tool)
+    tell " && (major2) == "
+    tell (ztoolY z_var1_tool)
+    tell " && (minor) <= "
+    tell (ztoolZ z_var1_tool)
+    tell ")\n"
+    tell "#endif /* MIN_VERSION_"
+    tell (zMangleStr z_root (ztoolName z_var1_tool))
+    tell " */\n"
+  tell "\n"
+  if (zNotNull z_root (zPackageKey z_root))
+  then do
+    tell "#ifndef CURRENT_packageKey\n"
+    tell "#define CURRENT_packageKey \""
+    tell (zPackageKey z_root)
+    tell "\"\n"
+    tell "#endif /* CURRENT_packageKey */\n"
+    return ()
+  else do
+    return ()
+  if (zNotNull z_root (zComponentId z_root))
+  then do
+    tell "#ifndef CURRENT_COMPONENT_ID\n"
+    tell "#define CURRENT_COMPONENT_ID \""
+    tell (zComponentId z_root)
+    tell "\"\n"
+    tell "#endif /* CURRENT_COMPONENT_ID */\n"
+    return ()
+  else do
+    return ()
+  tell "#ifndef CURRENT_PACKAGE_VERSION\n"
+  tell "#define CURRENT_PACKAGE_VERSION \""
+  tell (prettyShow (zPackageVersion z_root))
+  tell "\"\n"
+  tell "#endif /* CURRENT_PACKAGE_VERSION */\n"

Cabal/Distribution/Simple/Utils.hs

@@ -250,7 +250,7 @@ cabalVersion = mkVersion' Paths_Cabal.version
 #elif defined(CABAL_VERSION)
 cabalVersion = mkVersion [CABAL_VERSION]
 #else
-cabalVersion = mkVersion [1,9999]  --used when bootstrapping
+cabalVersion = mkVersion [3,0]  --used when bootstrapping
 #endif
 
 -- ----------------------------------------------------------------------------

Cabal/Distribution/ZinzaPrelude.hs

@@ -0,0 +1,43 @@
+-- | A small prelude used in @zinza@ generated
+-- template modules.
+module Distribution.ZinzaPrelude (
+    Writer,
+    execWriter,
+    tell,
+    -- * Re-exports
+    forM_,
+    Generic,
+    PackageName,
+    Version,
+    prettyShow
+    ) where
+
+import Distribution.Compat.Prelude
+import Prelude ()
+
+import Control.Monad                  (forM_)
+import Distribution.Pretty            (prettyShow)
+import Distribution.Types.PackageName (PackageName)
+import Distribution.Types.Version     (Version)
+
+newtype Writer a = W { unW :: ShowS -> (ShowS, a) }
+
+instance Functor Writer where
+    fmap = liftM
+
+instance Applicative Writer where
+    pure x = W $ \ss -> (ss, x)
+    (<*>) = ap
+
+instance Monad Writer where
+    return = pure
+    m >>= k = W $ \s1 ->
+        let (s2, x) = unW m s1
+        in unW (k x) s2
+    {-# INLINE (>>=) #-}
+
+execWriter :: Writer a -> String
+execWriter w = fst (unW w id) ""
+
+tell :: String -> Writer ()
+tell s = W $ \s' -> (s' . showString s, ())