From 006b8f34a2bf5cd2f5ee82197bcc25f9b41ff3ec Mon Sep 17 00:00:00 2001 From: Liang-Ting Chen Date: Mon, 7 Aug 2023 13:12:06 +0800 Subject: [PATCH] Use Zinza to generate `.../PackageInfoModule/z.hs` --- .../Simple/Build/PackageInfoModule.hs | 12 +-- .../Simple/Build/PackageInfoModule/Z.hs | 69 +++++++------- Makefile | 6 +- cabal-dev-scripts/cabal-dev-scripts.cabal | 18 +++- cabal-dev-scripts/src/GenPackageInfoModule.hs | 89 +++++++++++++++++++ templates/PackageInfo_pkg.template.hs | 35 ++++++++ 6 files changed, 188 insertions(+), 41 deletions(-) create mode 100644 cabal-dev-scripts/src/GenPackageInfoModule.hs create mode 100644 templates/PackageInfo_pkg.template.hs diff --git a/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs b/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs index 1a91ede107b..0dbf2c847aa 100644 --- a/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs +++ b/Cabal/src/Distribution/Simple/Build/PackageInfoModule.hs @@ -38,13 +38,15 @@ generatePackageInfoModule :: PackageDescription -> LocalBuildInfo -> String generatePackageInfoModule pkg_descr lbi = Z.render Z.Z - { Z.zPackageName = showPkgName $ packageName pkg_descr + { Z.zPackageName = packageName pkg_descr , Z.zVersionDigits = show $ versionNumbers $ packageVersion pkg_descr - , Z.zSynopsis = fromShortText $ synopsis pkg_descr - , Z.zCopyright = fromShortText $ copyright pkg_descr - , Z.zLicense = prettyShow $ license pkg_descr - , Z.zHomepage = fromShortText $ homepage pkg_descr + , Z.zSynopsis = show $ fromShortText $ synopsis pkg_descr + , Z.zCopyright = show $ fromShortText $ copyright pkg_descr + , Z.zLicense = show $ prettyShow $ license pkg_descr + , Z.zHomepage = show $ fromShortText $ homepage pkg_descr , Z.zSupportsNoRebindableSyntax = supports_rebindable_syntax + , Z.zManglePkgName = showPkgName + , Z.zShow = show } where supports_rebindable_syntax = ghc_newer_than (mkVersion [7, 0, 1]) diff --git a/Cabal/src/Distribution/Simple/Build/PackageInfoModule/Z.hs b/Cabal/src/Distribution/Simple/Build/PackageInfoModule/Z.hs index 0f87b149161..702697edf4f 100644 --- a/Cabal/src/Distribution/Simple/Build/PackageInfoModule/Z.hs +++ b/Cabal/src/Distribution/Simple/Build/PackageInfoModule/Z.hs @@ -1,39 +1,37 @@ +{- FOURMOLU_DISABLE -} {-# LANGUAGE DeriveGeneric #-} - -module Distribution.Simple.Build.PackageInfoModule.Z (render, Z (..)) where - +module Distribution.Simple.Build.PackageInfoModule.Z (render, Z(..)) where import Distribution.ZinzaPrelude - -data Z = Z - { zPackageName :: String - , zVersionDigits :: String - , zSynopsis :: String - , zCopyright :: String - , zLicense :: String - , zHomepage :: String - , zSupportsNoRebindableSyntax :: Bool - } - deriving (Generic) - +data Z + = Z {zPackageName :: PackageName, + zVersionDigits :: String, + zSynopsis :: String, + zCopyright :: String, + zLicense :: String, + zHomepage :: String, + zSupportsNoRebindableSyntax :: Bool, + zManglePkgName :: (PackageName -> String), + zShow :: (String -> String)} + deriving Generic render :: Z -> String render z_root = execWriter $ do if (zSupportsNoRebindableSyntax z_root) - then do - tell "{-# LANGUAGE NoRebindableSyntax #-}\n" - return () - else do - return () + 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 " license, \n" - tell " homepage,\n" + tell (zManglePkgName z_root (zPackageName z_root)) + tell "\n" + tell " ( name\n" + tell " , version\n" + tell " , synopsis\n" + tell " , copyright\n" + tell " , license\n" + tell " , homepage\n" tell " ) where\n" tell "\n" tell "import Data.Version (Version(..))\n" @@ -41,7 +39,8 @@ render z_root = execWriter $ do tell "\n" tell "name :: String\n" tell "name = " - tell (show $ zPackageName z_root) + tell (zShow z_root (zManglePkgName z_root (zPackageName z_root))) + tell "\n" tell "\n" tell "version :: Version\n" tell "version = Version " @@ -50,17 +49,21 @@ render z_root = execWriter $ do tell "\n" tell "synopsis :: String\n" tell "synopsis = " - tell (show $ zSynopsis z_root) + tell (zSynopsis z_root) + tell "\n" tell "\n" tell "copyright :: String\n" tell "copyright = " - tell (show $ zCopyright z_root) + tell (zCopyright z_root) + tell "\n" tell "\n" tell "license :: String\n" tell "license = " - tell (show $ zLicense z_root) + tell (zLicense z_root) + tell "\n" tell "\n" tell "homepage :: String\n" tell "homepage = " - tell (show $ zHomepage z_root) + tell (zHomepage z_root) + tell "\n" tell "\n" diff --git a/Makefile b/Makefile index 3ca0bf58fb4..5d77e6101a3 100644 --- a/Makefile +++ b/Makefile @@ -44,8 +44,9 @@ $(SPDX_EXCEPTION_HS) : templates/SPDX.LicenseExceptionId.template.hs cabal-dev-s TEMPLATE_MACROS:=Cabal/src/Distribution/Simple/Build/Macros/Z.hs TEMPLATE_PATHS:=Cabal/src/Distribution/Simple/Build/PathsModule/Z.hs +TEMPLATE_PKGINFO:=Cabal/src/Distribution/Simple/Build/PackageInfoModule/Z.hs -templates : phony $(TEMPLATE_MACROS) $(TEMPLATE_PATHS) +templates : phony $(TEMPLATE_MACROS) $(TEMPLATE_PATHS) $(TEMPLATE_PKGINFO) $(TEMPLATE_MACROS) : templates/cabal_macros.template.h cabal-dev-scripts/src/GenCabalMacros.hs cabal run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-cabal-macros -- $< $@ @@ -53,6 +54,9 @@ $(TEMPLATE_MACROS) : templates/cabal_macros.template.h cabal-dev-scripts/src/Gen $(TEMPLATE_PATHS) : templates/Paths_pkg.template.hs cabal-dev-scripts/src/GenPathsModule.hs cabal run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-paths-module -- $< $@ +$(TEMPLATE_PKGINFO) : templates/PackageInfo_pkg.template.hs cabal-dev-scripts/src/GenPackageInfoModule.hs + cabal run --builddir=dist-newstyle-meta --project-file=cabal.project.meta gen-pkg-info-module -- $< $@ + # generated docs buildinfo-fields-reference : phony diff --git a/cabal-dev-scripts/cabal-dev-scripts.cabal b/cabal-dev-scripts/cabal-dev-scripts.cabal index dcf40f84371..a4d7d8eab7e 100644 --- a/cabal-dev-scripts/cabal-dev-scripts.cabal +++ b/cabal-dev-scripts/cabal-dev-scripts.cabal @@ -18,7 +18,7 @@ executable gen-spdx ghc-options: -Wall build-depends: , aeson ^>=1.4.1.0 || ^>=1.5.2.0 || ^>=2.1.1.0 - , base >=4.10 && <4.17 + , base >=4.10 , bytestring , containers , Diff ^>=0.4 @@ -35,7 +35,7 @@ executable gen-spdx-exc ghc-options: -Wall build-depends: , aeson ^>=1.4.1.0 || ^>=1.5.2.0 || ^>=2.1.1.0 - , base >=4.10 && <4.17 + , base >=4.10 , bytestring , containers , Diff ^>=0.4 @@ -84,6 +84,20 @@ executable gen-paths-module , template-haskell , zinza ^>=0.2 +executable gen-pkg-info-module + default-language: Haskell2010 + main-is: GenPackageInfoModule.hs + other-modules: Capture + hs-source-dirs: src + ghc-options: -Wall + build-depends: + , base + , bytestring + , Cabal + , syb ^>=0.7.1 + , template-haskell + , zinza ^>=0.2 + executable gen-cabal-install-cabal default-language: Haskell2010 main-is: GenCabalInstallCabal.hs diff --git a/cabal-dev-scripts/src/GenPackageInfoModule.hs b/cabal-dev-scripts/src/GenPackageInfoModule.hs new file mode 100644 index 00000000000..2e0eecd1816 --- /dev/null +++ b/cabal-dev-scripts/src/GenPackageInfoModule.hs @@ -0,0 +1,89 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-orphans #-} +module Main (main) where + +import Control.Exception (SomeException (..), catch, displayException) +import Distribution.Types.PackageName (PackageName) +import GHC.Generics (Generic) +import System.Environment (getArgs) +import System.Exit (exitFailure) +import Zinza + (ModuleConfig (..), Ty (..), Zinza (..), genericFromValueSFP, genericToTypeSFP, + genericToValueSFP, parseAndCompileModuleIO) + +import Capture + +------------------------------------------------------------------------------- +-- Inputs +------------------------------------------------------------------------------- + +$(capture "decls" [d| + data Z = Z + { zPackageName :: PackageName + , zVersionDigits :: String + , zSynopsis :: String + , zCopyright :: String + , zLicense :: String + , zHomepage :: String + + , zSupportsNoRebindableSyntax :: Bool + + , zManglePkgName :: PackageName -> String + , zShow :: String -> String + } + deriving (Generic) + |]) + +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + +withIO :: (FilePath -> FilePath -> IO a) -> IO a +withIO k = do + args <- getArgs + case args of + [src,tgt] -> k src tgt `catch` \(SomeException e) -> do + putStrLn $ "Exception: " ++ displayException e + exitFailure + _ -> do + putStrLn "Usage cabal run ... source.temeplate.ext target.ext" + exitFailure + +main :: IO () +main = withIO $ \src tgt -> do + mdl <- parseAndCompileModuleIO config src + writeFile tgt mdl + +config :: ModuleConfig Z +config = ModuleConfig + { mcRender = "render" + , mcHeader = + [ "{- FOURMOLU_DISABLE -}" + , "{-# LANGUAGE DeriveGeneric #-}" + , "module Distribution.Simple.Build.PackageInfoModule.Z (render, Z(..)) where" + , "import Distribution.ZinzaPrelude" + , decls + , "render :: Z -> String" + ] + } + +------------------------------------------------------------------------------- +-- Zinza instances +------------------------------------------------------------------------------- + +instance Zinza Z where + toType = genericToTypeSFP + toValue = genericToValueSFP + fromValue = genericFromValueSFP + +------------------------------------------------------------------------------- +-- Orphans +------------------------------------------------------------------------------- + +instance Zinza PackageName where + toType _ = TyString (Just "prettyShow") + toValue _ = error "not needed" + fromValue _ = error "not needed" diff --git a/templates/PackageInfo_pkg.template.hs b/templates/PackageInfo_pkg.template.hs new file mode 100644 index 00000000000..5acc59c7ef9 --- /dev/null +++ b/templates/PackageInfo_pkg.template.hs @@ -0,0 +1,35 @@ +{% if supportsNoRebindableSyntax %} +{-# LANGUAGE NoRebindableSyntax #-} +{% endif %} +{-# OPTIONS_GHC -fno-warn-missing-import-lists #-} +{-# OPTIONS_GHC -w #-} +module PackageInfo_{{ manglePkgName packageName }} + ( name + , version + , synopsis + , copyright + , license + , homepage + ) where + +import Data.Version (Version(..)) +import Prelude + +name :: String +name = {{ show (manglePkgName packageName) }} + +version :: Version +version = Version {{ versionDigits }} [] + +synopsis :: String +synopsis = {{ synopsis }} + +copyright :: String +copyright = {{ copyright }} + +license :: String +license = {{ license }} + +homepage :: String +homepage = {{ homepage }} +