Merge pull request #6544 from commercialhaskell/re6542

Re #6542 Take a direct approach to `initialBuildSteps`

ChangeLog.md

@@ -12,6 +12,9 @@ Behaviour changes:
   version of GHC. Stack no longer supports such Cabal versions before 2.2, which
   came with versions of GHC before 8.4. Consequently, the `init` command will
   not try LTS Haskell before 12.0.
+* Stack's `StackSetupShim` executable, when called with `repl` and
+  `stack-initial-build-steps`, no longer uses Cabal's `replHook` to apply
+  `initialBuildSteps` but takes a more direct approach.
 * The `init` command initialises `stack.yaml` with a `snapshot` key rather than
   a `resolver` key.
 * After installing GHC or another tool, Stack deletes the archive file which

doc/stack_root.md

@@ -233,10 +233,9 @@ main = defaultMain
 
 The content of the `setup-shim-<hash>.hs` file uses `main` except when the
 executable is called with arguments `repl` and `stack-initial-build-steps`. Then
-Stack makes use of Cabal's `defaultMainWithHooks` and `replHook` field to create
-the autogenerated files for every configured component; the `replHook` function
-is provided with the information that `initialBuildSteps` needs. Stack's
-`stack ghci` or `stack repl` commands call the executable with those arguments.
+Stack uses Cabal (the library) to create the autogenerated files for every
+configured component. Stack's `stack ghci` or `stack repl` commands call the
+executable with those arguments.
 
 ### `snapshots` directory
 

src/setup-shim/StackSetupShim.hs

@@ -1,62 +1,111 @@
 {-# LANGUAGE CPP            #-}
 {-# LANGUAGE PackageImports #-}
+
 module StackSetupShim where
-import Main
-#if defined(MIN_VERSION_Cabal)
+
+-- | Stack no longer supports Cabal < 2.2 and, consequently, GHC versions before
+-- GHC 8.4 or base < 4.11.0.0. Consequently, we do not need to test for the
+-- existence of the MIN_VERSION_Cabal macro (provided from GHC 8.0).
+
+import Data.List ( stripPrefix )
+import Distribution.ReadE ( ReadE (..) )
+import Distribution.Simple.Configure ( getPersistBuildConfig )
+-- | Temporary, can be removed if initialBuildSteps restored to Cabal's API.
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Simple.Build ( writeBuiltinAutogenFiles )
+#else
+import Distribution.Simple.Build ( initialBuildSteps )
+#endif
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Simple.Errors ( exceptionMessage )
+#endif
+-- | Temporary, can be removed if initialBuildSteps restored to Cabal's API.
+#if MIN_VERSION_Cabal(3,11,0)
+import Distribution.Simple.LocalBuildInfo
+         ( componentBuildDir, withAllComponentsInBuildOrder )
+#endif
 #if MIN_VERSION_Cabal(3,8,1)
-import Distribution.PackageDescription
-         ( PackageDescription, emptyHookedBuildInfo )
+import Distribution.Simple.PackageDescription ( readGenericPackageDescription )
 #else
-import "Cabal" Distribution.PackageDescription
-         ( PackageDescription, emptyHookedBuildInfo )
+-- Avoid confusion with Cabal-syntax module of same name
+import "Cabal" Distribution.PackageDescription.Parsec
+         ( readGenericPackageDescription )
 #endif
+import Distribution.Simple.Utils
+         ( createDirectoryIfMissingVerbose, findPackageDesc )
+#if MIN_VERSION_Cabal(3,8,1)
+import Distribution.Types.GenericPackageDescription
+         ( GenericPackageDescription (..) )
 #else
-import Distribution.PackageDescription
-         ( PackageDescription, emptyHookedBuildInfo )
+-- Avoid confusion with Cabal-syntax module of same name
+import "Cabal" Distribution.Types.GenericPackageDescription
+         ( GenericPackageDescription (..) )
 #endif
-import Distribution.Simple
-import Distribution.Simple.Build
-import Distribution.Simple.Setup
-         ( ReplFlags, fromFlag, replDistPref, replVerbosity )
-import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo )
 -- | Temporary, can be removed if initialBuildSteps restored to Cabal's API.
-#if defined(MIN_VERSION_Cabal)
 #if MIN_VERSION_Cabal(3,11,0)
-import Distribution.Simple.LocalBuildInfo
-         ( ComponentLocalBuildInfo, componentBuildDir
-         , withAllComponentsInBuildOrder
-         )
-import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose )
+import Distribution.Types.ComponentLocalBuildInfo ( ComponentLocalBuildInfo )
+import Distribution.Types.LocalBuildInfo ( LocalBuildInfo )
+import Distribution.Types.PackageDescription ( PackageDescription )
 import Distribution.Verbosity ( Verbosity )
 #endif
-#endif
+import Distribution.Verbosity ( flagToVerbosity )
+import Main
 import System.Environment ( getArgs )
 
 mainOverride :: IO ()
 mainOverride = do
-    args <- getArgs
-    if "repl" `elem` args && "stack-initial-build-steps" `elem` args
-        then do
-            defaultMainWithHooks simpleUserHooks
-                { preRepl = \_ _ -> pure emptyHookedBuildInfo
-                , replHook = stackReplHook
-                , postRepl = \_ _ _ _ -> pure ()
-                }
-        else main
+  args <- getArgs
+  case args of
+    [arg1, arg2, "repl", "stack-initial-build-steps"] -> stackReplHook arg1 arg2
+    _ -> main
 
-stackReplHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
-stackReplHook pkg_descr lbi hooks flags args = do
-    let distPref = fromFlag (replDistPref flags)
-        verbosity = fromFlag (replVerbosity flags)
-    case args of
-        ("stack-initial-build-steps":rest)
-            | null rest -> initialBuildSteps distPref pkg_descr lbi verbosity
-            | otherwise ->
-                fail "Misuse of running Setup.hs with stack-initial-build-steps, expected no arguments"
-        _ -> replHook simpleUserHooks pkg_descr lbi hooks flags args
+-- | The name of the function is a mismomer, but is kept for historical reasons.
+-- This function relies on Stack calling the 'setup' executable with:
+--
+-- --verbose=<Cabal_verbosity>
+-- --builddir=<path_to_dist_prefix>
+-- repl
+-- stack-initial-build-steps
+stackReplHook :: String -> String -> IO ()
+stackReplHook arg1 arg2 = do
+  let mRawVerbosity = stripPrefix "--verbose=" arg1
+      mRawBuildDir = stripPrefix "--builddir=" arg2
+  case (mRawVerbosity, mRawBuildDir) of
+    (Nothing, _) -> fail $
+      "Misuse of running Setup.hs with stack-initial-build-steps, expected " <>
+      "first argument to start --verbose="
+    (_, Nothing) -> fail $
+      "Misuse of running Setup.hs with stack-initial-build-steps, expected" <>
+      "second argument to start --builddir="
+    (Just rawVerbosity, Just rawBuildDir) -> do
+        let eVerbosity = runReadE flagToVerbosity rawVerbosity
+        case eVerbosity of
+          Left msg1 -> fail $
+            "Unexpected happened running Setup.hs with " <>
+            "stack-initial-build-steps, expected to parse Cabal verbosity: " <>
+            msg1
+          Right verbosity -> do
+            eFp <- findPackageDesc ""
+            case eFp of
+              Left err -> fail $
+                "Unexpected happened running Setup.hs with " <>
+                "stack-initial-build-steps, expected to find a Cabal file: " <>
+                msg2
+               where
+#if MIN_VERSION_Cabal(3,11,0)
+                -- The type of findPackageDesc changed in Cabal-3.11.0.0.
+                msg2 = exceptionMessage err
+#else
+                msg2 = err
+#endif
+              Right fp -> do
+                gpd <- readGenericPackageDescription verbosity fp
+                let pd = packageDescription gpd
+                lbi <- getPersistBuildConfig rawBuildDir
+                initialBuildSteps rawBuildDir pd lbi verbosity
 
 -- | Temporary, can be removed if initialBuildSteps restored to Cabal's API.
-#if defined(MIN_VERSION_Cabal)
+-- Based on the functions of the same name provided by Cabal-3.10.3.0.
 #if MIN_VERSION_Cabal(3,11,0)
 -- | Runs 'componentInitialBuildSteps' on every configured component.
 initialBuildSteps ::
@@ -66,8 +115,8 @@ initialBuildSteps ::
   -> Verbosity -- ^The verbosity to use
   -> IO ()
 initialBuildSteps distPref pkg_descr lbi verbosity =
-    withAllComponentsInBuildOrder pkg_descr lbi $ \_comp clbi ->
-        componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity
+  withAllComponentsInBuildOrder pkg_descr lbi $ \_comp clbi ->
+    componentInitialBuildSteps distPref pkg_descr lbi clbi verbosity
 
 -- | Creates the autogenerated files for a particular configured component.
 componentInitialBuildSteps ::
@@ -79,6 +128,8 @@ componentInitialBuildSteps ::
   -> IO ()
 componentInitialBuildSteps _distPref pkg_descr lbi clbi verbosity = do
   createDirectoryIfMissingVerbose verbosity True (componentBuildDir lbi clbi)
+  -- Cabal-3.10.3.0 used writeAutogenFiles, that generated and wrote out the
+  -- Paths_<pkg>.hs, PackageInfo_<pkg>.hs, and cabal_macros.h files. This
+  -- appears to be the equivalent function for Cabal-3.11.0.0.
   writeBuiltinAutogenFiles verbosity pkg_descr lbi clbi
 #endif
-#endif