From 21be704856b0373d8097f81341c4d8334434d25d Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Mon, 1 Apr 2024 11:22:25 +0100 Subject: [PATCH] Re #6542 Take a direct approach to `initialBuildSteps` --- ChangeLog.md | 3 + src/setup-shim/StackSetupShim.hs | 144 ++++++++++++++++++++++--------- 2 files changed, 105 insertions(+), 42 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 51eec97fe1..3f9f2beab4 100644 --- a/ChangeLog.md +++ b/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 diff --git a/src/setup-shim/StackSetupShim.hs b/src/setup-shim/StackSetupShim.hs index c723a6d3f4..11f6c17294 100644 --- a/src/setup-shim/StackSetupShim.hs +++ b/src/setup-shim/StackSetupShim.hs @@ -1,62 +1,120 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE PackageImports #-} + module StackSetupShim where -import Main -#if defined(MIN_VERSION_Cabal) + +import Data.List ( stripPrefix ) +-- | 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). +#if MIN_VERSION_Cabal(3,0,0) #if MIN_VERSION_Cabal(3,8,1) -import Distribution.PackageDescription - ( PackageDescription, emptyHookedBuildInfo ) +import Distribution.Parsec ( eitherParsec ) #else -import "Cabal" Distribution.PackageDescription - ( PackageDescription, emptyHookedBuildInfo ) +-- Avoid confusion with Cabal-syntax module of same name +import "Cabal" Distribution.Parsec ( eitherParsec ) #endif #else -import Distribution.PackageDescription - ( PackageDescription, emptyHookedBuildInfo ) +import Distribution.Parsec.Class ( eitherParsec) +#endif +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 -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.Verbosity ( Verbosity ) + ( componentBuildDir, withAllComponentsInBuildOrder ) +#endif +#if MIN_VERSION_Cabal(3,8,1) +import Distribution.Simple.PackageDescription ( readGenericPackageDescription ) +#else +-- 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 +-- Avoid confusion with Cabal-syntax module of same name +import "Cabal" Distribution.Types.GenericPackageDescription + ( GenericPackageDescription (..) ) #endif +-- | Temporary, can be removed if initialBuildSteps restored to Cabal's API. +#if MIN_VERSION_Cabal(3,11,0) +import Distribution.Types.ComponentLocalBuildInfo ( ComponentLocalBuildInfo ) +import Distribution.Types.LocalBuildInfo ( LocalBuildInfo ) +import Distribution.Types.PackageDescription ( PackageDescription ) +import Distribution.Verbosity ( Verbosity ) #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= +-- --builddir= +-- 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 +124,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 +137,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_.hs, PackageInfo_.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