Re #6531 Add --stack-args

commercialhaskell · Mar 26, 2024 · ad11d0f · ad11d0f
1 parent 36ea8b5
commit ad11d0f
Show file tree

Hide file tree

Showing 2 changed files with 30 additions and 6 deletions.
diff --git a/.github/workflows/integration-tests.yml b/.github/workflows/integration-tests.yml
@@ -217,7 +217,7 @@ jobs:
         # (Note that the online documentation for '--docker-stack-exe image'
         # specifies that the host Stack and image Stack must have the same
         # version number.)
-        /usr/local/bin/stack etc/scripts/release.hs build --alpine --build-args --docker-stack-exe=image
+        /usr/local/bin/stack etc/scripts/release.hs build --alpine --stack-args --docker-stack-exe=image
 
     - name: Upload bindist
       if: needs.configuration.outputs.test-arm64 == 'true'

diff --git a/etc/scripts/release.hs b/etc/scripts/release.hs
@@ -76,6 +76,7 @@ main = shakeArgsWith
         gTestHaddocks = True
         gProjectRoot = "" -- Set to real value below.
         gBuildArgs = ["--flag", "stack:-developer-mode"]
+        gStackArgs = []
         gCertificateName = Nothing
         global0 = foldl
           (flip id)
@@ -90,6 +91,7 @@ main = shakeArgsWith
             , gBinarySuffix
             , gTestHaddocks
             , gBuildArgs
+            , gStackArgs
             , gCertificateName
             }
           flags
@@ -131,13 +133,22 @@ options =
           g { gBuildArgs =
                    gBuildArgs g
                 ++ [ "--flag=stack:static"
-                   , "--docker"
+                   ]
+            , gStackArgs =
+                   gStackArgs g
+                ++ [ "--docker"
                    , "--system-ghc"
                    , "--no-install-ghc"
                    ]
             }
       )
-      "Build a statically linked binary using an Alpine Docker image."
+      "Build a statically-linked binary using an Alpine Linux Docker image."
+  , Option "" [stackArgsOptName]
+      ( ReqArg
+          (\v -> Right $ \g -> g{gStackArgs = gStackArgs g ++ words v})
+          "\"ARG1 ARG2 ...\""
+      )
+      "Additional arguments to pass to 'stack'."
   , Option "" [buildArgsOptName]
       ( ReqArg
           (\v -> Right $ \g -> g{gBuildArgs = gBuildArgs g ++ words v})
@@ -234,7 +245,13 @@ rules global args = do
   releaseDir </> binaryExeFileName %> \out -> do
     need [releaseBinDir </> binaryName </> stackExeFileName]
     (Stdout versionOut) <-
-      cmd (releaseBinDir </> binaryName </> stackExeFileName) "--version"
+      cmd
+        stackProgName -- Use the platform's Stack
+        global.gStackArgs -- Possibly to set up a Docker container
+        ["exec"] -- To execute the target Stack and get its version info
+        (releaseBinDir </> binaryName </> stackExeFileName)
+        ["--"]
+        ["--version"]
     when (not global.gAllowDirty && "dirty" `isInfixOf` lower versionOut) $
       error
         (  "Refusing continue because 'stack --version' reports dirty.  Use --"
@@ -295,10 +312,12 @@ rules global args = do
   releaseBinDir </> binaryName </> stackExeFileName %> \out -> do
     alwaysRerun
     actionOnException
-      ( cmd stackProgName
+      ( cmd
+          stackProgName -- Use the platform's Stack
           (stackArgs global)
           ["--local-bin-path=" ++ takeDirectory out]
-          "install"
+          global.gStackArgs -- Possibly to set up a Docker container
+          "install" -- To build and install Stack to that local bin path
           global.gBuildArgs
           integrationTestFlagArgs
           "--pedantic"
@@ -438,6 +457,10 @@ binaryVariantOptName = "binary-variant"
 noTestHaddocksOptName :: String
 noTestHaddocksOptName = "no-test-haddocks"
 
+-- | @--stack-args@ command-line option name.
+stackArgsOptName :: String
+stackArgsOptName = "stack-args"
+
 -- | @--build-args@ command-line option name.
 buildArgsOptName :: String
 buildArgsOptName = "build-args"
@@ -472,6 +495,7 @@ data Global = Global
   , gBinarySuffix :: !String
   , gTestHaddocks :: !Bool
   , gBuildArgs :: [String]
+  , gStackArgs :: [String]
   , gCertificateName :: !(Maybe String)
   }
   deriving Show