Skip to content

Commit 5a60f9f

Browse files
mpilgremmpilgrem
committed
Re #6542 Take a direct approach to initialBuildSteps 
1 parent fa7cd30 commit 5a60f9f

File tree

2 files changed

+100
-45
lines changed

2 files changed

+100
-45
lines changed

‎ChangeLog.md

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,9 @@ Behaviour changes:
1212
version of GHC. Stack no longer supports such Cabal versions before 2.2, which
1313
came with versions of GHC before 8.4. Consequently, the `init` command will
1414
not try LTS Haskell before 12.0.
15+
* Stack's `StackSetupShim` executable, when called with `repl` and
16+
`stack-initial-build-steps`, no longer uses Cabal's `replHook` to apply
17+
`initialBuildSteps` but takes a more direct approach.
1518
* The `init` command initialises `stack.yaml` with a `snapshot` key rather than
1619
a `resolver` key.
1720
* After installing GHC or another tool, Stack deletes the archive file which

‎src/setup-shim/StackSetupShim.hs

Lines changed: 97 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -1,63 +1,70 @@
11
{-# LANGUAGE CPP #-}
22
{-# LANGUAGE PackageImports #-}
33
module StackSetupShim where
4+
45
import Main
5-
#if defined(MIN_VERSION_Cabal)
6-
#if MIN_VERSION_Cabal(3,8,1)
7-
import Distribution.PackageDescription
8-
( PackageDescription, emptyHookedBuildInfo )
9-
#else
10-
import "Cabal" Distribution.PackageDescription
11-
( PackageDescription, emptyHookedBuildInfo )
12-
#endif
13-
#else
14-
import Distribution.PackageDescription
15-
( PackageDescription, emptyHookedBuildInfo )
16-
#endif
17-
import Distribution.Simple
18-
import Distribution.Simple.Build
19-
import Distribution.Simple.Setup
20-
( ReplFlags, fromFlag, replDistPref, replVerbosity )
21-
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo )
22-
-- | Temporary, can be removed if initialBuildSteps restored to Cabal's API.
23-
#if defined(MIN_VERSION_Cabal)
6+
import System.Environment ( getArgs )
7+
8+
-- | We do not need to test for the existence of the MIN_VERSION_Cabal macro, as
9+
-- Stack no longer supports GHC versions before GHC 8.0.
2410
#if MIN_VERSION_Cabal(3,11,0)
11+
12+
import Data.List ( stripPrefix )
13+
import Distribution.Parsec ( eitherParsec )
14+
import Distribution.Simple.Configure ( getPersistBuildConfig )
15+
import Distribution.Simple.Build ( writeBuiltinAutogenFiles )
16+
import Distribution.Simple.Errors ( exceptionMessage )
2517
import Distribution.Simple.LocalBuildInfo
26-
( ComponentLocalBuildInfo, componentBuildDir
18+
( ComponentLocalBuildInfo, LocalBuildInfo, componentBuildDir
2719
, withAllComponentsInBuildOrder
2820
)
29-
import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose )
21+
import Distribution.Simple.PackageDescription ( readGenericPackageDescription )
22+
import Distribution.Simple.Utils
23+
( createDirectoryIfMissingVerbose, findPackageDesc )
24+
import Distribution.Types.GenericPackageDescription
25+
( GenericPackageDescription (..) )
26+
import Distribution.Types.PackageDescription ( PackageDescription )
3027
import Distribution.Verbosity ( Verbosity )
31-
#endif
32-
#endif
33-
import System.Environment ( getArgs )
3428

3529
mainOverride :: IO ()
3630
mainOverride = do
37-
args <- getArgs
38-
if "repl" `elem` args && "stack-initial-build-steps" `elem` args
39-
then do
40-
defaultMainWithHooks simpleUserHooks
41-
{ preRepl = \_ _ -> pure emptyHookedBuildInfo
42-
, replHook = stackReplHook
43-
, postRepl = \_ _ _ _ -> pure ()
44-
}
45-
else main
31+
args <- getArgs
32+
case args of
33+
arg1:arg2:"repl":"stack-initial-build-steps":[] ->
34+
stackReplHook arg1 arg2
35+
_ -> main
4636

47-
stackReplHook :: PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
48-
stackReplHook pkg_descr lbi hooks flags args = do
49-
let distPref = fromFlag (replDistPref flags)
50-
verbosity = fromFlag (replVerbosity flags)
51-
case args of
52-
("stack-initial-build-steps":rest)
53-
| null rest -> initialBuildSteps distPref pkg_descr lbi verbosity
54-
| otherwise ->
55-
fail "Misuse of running Setup.hs with stack-initial-build-steps, expected no arguments"
56-
_ -> replHook simpleUserHooks pkg_descr lbi hooks flags args
37+
-- | The name of the function is a mismomer, but is kept for historical reasons.
38+
stackReplHook :: String -> String -> IO ()
39+
stackReplHook arg1 arg2 = do
40+
let mRawVerbosity = stripPrefix "--verbose=" arg1
41+
mRawBuildDir = stripPrefix "--builddir=" arg2
42+
case (mRawVerbosity, mRawBuildDir) of
43+
(Nothing, _) -> fail $
44+
"Misuse of running Setup.hs with stack-initial-build-steps, expected " <>
45+
"first argument to start --verbose="
46+
(_, Nothing) -> fail $
47+
"Misuse of running Setup.hs with stack-initial-build-steps, expected" <>
48+
"second argument to start --builddir="
49+
(Just rawVerbosity, Just rawBuildDir) -> case eitherParsec rawVerbosity of
50+
Left msg1 -> fail $
51+
"Unexpected happened running Setup.hs with " <>
52+
"stack-initial-build-steps, expected to parse Cabal verbosity: " <> msg1
53+
Right verbosity -> do
54+
eFp <- findPackageDesc ""
55+
case eFp of
56+
Left err -> fail $
57+
"Unexpected happened running Setup.hs with " <>
58+
"stack-initial-build-steps, expected to find a Cabal file: " <>
59+
exceptionMessage err
60+
Right fp -> do
61+
gpd <- readGenericPackageDescription verbosity fp
62+
let pd = packageDescription gpd
63+
lbi <- getPersistBuildConfig rawBuildDir
64+
initialBuildSteps rawBuildDir pd lbi verbosity
5765

5866
-- | Temporary, can be removed if initialBuildSteps restored to Cabal's API.
59-
#if defined(MIN_VERSION_Cabal)
60-
#if MIN_VERSION_Cabal(3,11,0)
67+
6168
-- | Runs 'componentInitialBuildSteps' on every configured component.
6269
initialBuildSteps ::
6370
FilePath -- ^"dist" prefix
@@ -80,5 +87,50 @@ componentInitialBuildSteps ::
8087
componentInitialBuildSteps _distPref pkg_descr lbi clbi verbosity = do
8188
createDirectoryIfMissingVerbose verbosity True (componentBuildDir lbi clbi)
8289
writeBuiltinAutogenFiles verbosity pkg_descr lbi clbi
90+
91+
#else
92+
93+
#if MIN_VERSION_Cabal(3,8,1)
94+
import Distribution.PackageDescription
95+
( PackageDescription, emptyHookedBuildInfo )
96+
#else
97+
import "Cabal" Distribution.PackageDescription
98+
( PackageDescription, emptyHookedBuildInfo )
8399
#endif
100+
import Distribution.Simple
101+
import Distribution.Simple.Build
102+
import Distribution.Simple.Setup
103+
( ReplFlags, fromFlag, replDistPref, replVerbosity )
104+
import Distribution.Simple.LocalBuildInfo ( LocalBuildInfo )
105+
106+
mainOverride :: IO ()
107+
mainOverride = do
108+
args <- getArgs
109+
if "repl" `elem` args && "stack-initial-build-steps" `elem` args
110+
then do
111+
defaultMainWithHooks simpleUserHooks
112+
{ preRepl = \_ _ -> pure emptyHookedBuildInfo
113+
, replHook = stackReplHook
114+
, postRepl = \_ _ _ _ -> pure ()
115+
}
116+
else main
117+
118+
stackReplHook ::
119+
PackageDescription
120+
-> LocalBuildInfo
121+
-> UserHooks
122+
-> ReplFlags
123+
-> [String]
124+
-> IO ()
125+
stackReplHook pkg_descr lbi hooks flags args = do
126+
let distPref = fromFlag (replDistPref flags)
127+
verbosity = fromFlag (replVerbosity flags)
128+
case args of
129+
("stack-initial-build-steps":rest)
130+
| null rest -> initialBuildSteps distPref pkg_descr lbi verbosity
131+
| otherwise -> fail $
132+
"Misuse of running Setup.hs with stack-initial-build-steps, " <>
133+
"expected no arguments"
134+
_ -> replHook simpleUserHooks pkg_descr lbi hooks flags args
135+
84136
#endif

0 commit comments

Comments
 (0)