Re #6542 Add Well-Typed's patch to the repository, so it is to hand

Setup.hs

@@ -4,24 +4,24 @@ module Main
 
 import           Data.List ( nub, sortOn )
 import           Distribution.InstalledPackageInfo
-                   ( sourcePackageId, installedUnitId )
-import           Distribution.Package ( UnitId, packageVersion, packageName )
+                   ( installedUnitId, sourcePackageId )
+import           Distribution.Package ( UnitId, packageName, packageVersion )
 import           Distribution.PackageDescription
-                   ( PackageDescription (), Executable (..) )
+                   ( Executable (..), PackageDescription )
 import           Distribution.Pretty ( prettyShow )
 import           Distribution.Simple
-                   ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )
+                   ( UserHooks(..), defaultMainWithHooks, simpleUserHooks )
 import           Distribution.Simple.BuildPaths ( autogenPackageModulesDir )
 import           Distribution.Simple.LocalBuildInfo
-                   ( installedPkgs, withLibLBI, withExeLBI, LocalBuildInfo ()
-                   , ComponentLocalBuildInfo (componentPackageDeps)
+                   ( ComponentLocalBuildInfo (..), LocalBuildInfo, installedPkgs
+                   , withExeLBI, withLibLBI
                    )
 import           Distribution.Simple.PackageIndex
                    ( allPackages, dependencyClosure )
 import           Distribution.Simple.Setup
                    ( BuildFlags (..), ReplFlags (..), fromFlag )
 import           Distribution.Simple.Utils
-                   ( rewriteFileEx, createDirectoryIfMissingVerbose )
+                   ( createDirectoryIfMissingVerbose, rewriteFileEx )
 import           Distribution.Types.PackageName ( unPackageName )
 import           Distribution.Types.UnqualComponentName
                    ( unUnqualComponentName )
@@ -41,7 +41,11 @@ main = defaultMainWithHooks simpleUserHooks
       replHook simpleUserHooks pkg lbi hooks flags args
   }
 
-generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
+generateBuildModule ::
+     Verbosity
+  -> PackageDescription
+  -> LocalBuildInfo
+  -> IO ()
 generateBuildModule verbosity pkg lbi = do
   let dir = autogenPackageModulesDir lbi
   createDirectoryIfMissingVerbose verbosity True dir
@@ -60,17 +64,22 @@ generateBuildModule verbosity pkg lbi = do
     formatdeps = map formatone . sortOn unPackageName'
     formatone p = unPackageName' p ++ "-" ++ prettyShow (packageVersion p)
     unPackageName' = unPackageName . packageName
-    transDeps xs ys =
-      either (map sourcePackageId . allPackages) handleDepClosureFailure $ dependencyClosure allInstPkgsIdx availInstPkgIds
-      where
-        allInstPkgsIdx = installedPkgs lbi
-        allInstPkgIds = map installedUnitId $ allPackages allInstPkgsIdx
-        -- instPkgIds includes `stack-X.X.X`, which is not a dependency hence is missing from allInstPkgsIdx. Filter that out.
-        availInstPkgIds = filter (`elem` allInstPkgIds) $ testDeps xs ys
-        handleDepClosureFailure unsatisfied =
-          error $
-            "Computation of transitive dependencies failed." ++
-            if null unsatisfied then "" else " Unresolved dependencies: " ++ show unsatisfied
+    transDeps xs ys = either
+      (map sourcePackageId . allPackages)
+      handleDepClosureFailure $ dependencyClosure allInstPkgsIdx availInstPkgIds
+     where
+      allInstPkgsIdx = installedPkgs lbi
+      allInstPkgIds = map installedUnitId $ allPackages allInstPkgsIdx
+      -- instPkgIds includes `stack-X.X.X`, which is not a dependency hence is
+      -- missing from allInstPkgsIdx. Filter that out.
+      availInstPkgIds = filter (`elem` allInstPkgIds) $ testDeps xs ys
+      handleDepClosureFailure unsatisfied =
+        error $
+             "Computation of transitive dependencies failed."
+          ++ if null unsatisfied
+               then ""
+               else " Unresolved dependencies: " ++ show unsatisfied
 
 testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [UnitId]
-testDeps xs ys = map fst $ nub $ componentPackageDeps xs ++ componentPackageDeps ys
+testDeps xs ys =
+  map fst $ nub $ componentPackageDeps xs ++ componentPackageDeps ys

SetupHooks.hs

@@ -0,0 +1,103 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | See https://github.com/well-typed/hooks-build-type. As part of their work,
+-- Well-Typed reviewed stack-2.13.1 and identified that it used a pre-build hook
+-- to generate, for the stack main library component, a module that lists all
+-- the dependencies of stack (both library and executable), which is used in
+-- `Stack.BuildInfo` to be listed. They also wrote an experimental patch, the
+-- source code of which is below (with some reformatting).
+--
+-- This would be used if Stack's build type was 'Hooks' rather than 'Custom'.
+
+module SetupHooks
+  ( setupHooks
+  ) where
+
+import           Data.List ( nub, sortBy )
+import           Data.Ord ( comparing )
+import           Distribution.InstalledPackageInfo
+                   ( installedUnitId, sourcePackageId )
+import           Distribution.Package
+                   ( PackageId, UnitId, packageName, packageVersion )
+import           Distribution.PackageDescription
+                   ( PackageDescription (..), Executable (..), componentNameRaw
+                   )
+import           Distribution.Pretty ( prettyShow )
+import           Distribution.Simple
+                   ( UserHooks(..), defaultMainWithHooks, simpleUserHooks )
+import           Distribution.Simple.BuildPaths ( autogenComponentModulesDir )
+import           Distribution.Simple.LocalBuildInfo
+import           Distribution.Simple.PackageIndex
+                   ( allPackages, dependencyClosure )
+import           Distribution.Simple.Setup ( BuildFlags (..), fromFlag )
+import           Distribution.Simple.SetupHooks
+import           Distribution.Simple.Utils
+                   ( createDirectoryIfMissingVerbose, rewriteFileEx )
+import           Distribution.Types.PackageName ( PackageName, unPackageName )
+import           Distribution.Types.UnqualComponentName
+                   ( unUnqualComponentName )
+import           Distribution.Verbosity ( Verbosity, normal )
+import           System.FilePath ( (</>) )
+
+setupHooks :: SetupHooks
+setupHooks =
+  noSetupHooks
+    { buildHooks =
+       noBuildHooks
+         { preBuildComponentHook = Just preBuildHook }
+    }
+
+preBuildHook :: BuildingWhat -> LocalBuildInfo -> TargetInfo -> IO ()
+preBuildHook flags lbi tgt
+  | CLibName LMainLibName <- componentName $ targetComponent tgt =
+      generateBuildModule (buildingWhatVerbosity flags) (localPkgDescr lbi)
+        lbi tgt
+  | otherwise = pure ()
+
+generateBuildModule ::
+     Verbosity
+  -> PackageDescription
+  -> LocalBuildInfo
+  -> TargetInfo
+  -> IO ()
+generateBuildModule verbosity pkg lbi mainLibTargetInfo = do
+  -- Generate a module in the stack library component that lists all the
+  -- dependencies of stack (both the library and the executable).
+  createDirectoryIfMissingVerbose verbosity True autogenDir
+  withExeLBI pkg lbi $ \ _ exeCLBI -> do
+    rewriteFileEx normal buildModulePath $ unlines
+      [ "module Build_" ++ pkgNm
+      , "  ( deps"
+      , "  ) where"
+      , ""
+      , "deps :: [String]"
+      , "deps = " ++ (show $ formatdeps (transDeps mainLibCLBI exeCLBI))
+      ]
+  where
+    mainLibCLBI = targetCLBI mainLibTargetInfo
+    autogenDir = autogenComponentModulesDir lbi mainLibCLBI
+    pkgNm :: String
+    pkgNm = unPackageName' $ package pkg
+    buildModulePath = autogenDir </> "Build_" ++ pkgNm ++ ".hs"
+    formatdeps = map formatone . sortBy (comparing unPackageName')
+    formatone p = unPackageName' p ++ "-" ++ prettyShow (packageVersion p)
+    unPackageName' = unPackageName . packageName
+    transDeps xs ys = either
+      (map sourcePackageId . allPackages)
+      handleDepClosureFailure $ dependencyClosure allInstPkgsIdx availInstPkgIds
+     where
+      allInstPkgsIdx = installedPkgs lbi
+      allInstPkgIds = map installedUnitId $ allPackages allInstPkgsIdx
+      -- instPkgIds includes `stack-X.X.X`, which is not a dependency hence is
+      -- missing from allInstPkgsIdx. Filter that out.
+      availInstPkgIds = filter (`elem` allInstPkgIds) $ testDeps xs ys
+      handleDepClosureFailure unsatisfied =
+        error $
+             "Computation of transitive dependencies failed."
+          ++ if null unsatisfied
+               then ""
+               else " Unresolved dependencies: " ++ show unsatisfied
+
+testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [UnitId]
+testDeps xs ys =
+  map fst $ nub $ componentPackageDeps xs ++ componentPackageDeps ys