Skip to content

Commit

Permalink
Re #6542 Take a direct approach to initialBuildSteps
Browse files Browse the repository at this point in the history
  • Loading branch information
mpilgrem committed Apr 1, 2024
1 parent 4975d5b commit 7fc0371
Show file tree
Hide file tree
Showing 3 changed files with 100 additions and 47 deletions.
3 changes: 3 additions & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
7 changes: 3 additions & 4 deletions doc/stack_root.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
137 changes: 94 additions & 43 deletions src/setup-shim/StackSetupShim.hs
Original file line number Diff line number Diff line change
@@ -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 ::
Expand All @@ -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 ::
Expand All @@ -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

0 comments on commit 7fc0371

Please sign in to comment.