Fix #6531 Allow cross-operating system release.hs

Author: mpilgrem

etc/scripts/release.hs

@@ -28,7 +28,7 @@ import           Development.Shake
                    ( Action, Change (..), pattern Chatty, CmdOption (..), Rules
                    , ShakeOptions (..), Stdout (..), (%>), actionOnException
                    , alwaysRerun, cmd, command_, copyFileChanged
-                   , getDirectoryFiles, liftIO, need, phony, putNormal
+                   , getDirectoryFiles, liftIO, need, phony, putInfo
                    , removeFilesAfter, shakeArgsWith, shakeOptions, want
                    )
 import           Development.Shake.FilePath
@@ -72,10 +72,12 @@ main = shakeArgsWith
     let gAllowDirty = False
         Platform arch _ = buildPlatform
         gArch = arch
+        gTargetOS = platformOS
         gBinarySuffix = ""
         gTestHaddocks = True
         gProjectRoot = "" -- Set to real value below.
         gBuildArgs = ["--flag", "stack:-developer-mode"]
+        gStackArgs = []
         gCertificateName = Nothing
         global0 = foldl
           (flip id)
@@ -87,9 +89,11 @@ main = shakeArgsWith
             , gProjectRoot
             , gHomeDir
             , gArch
+            , gTargetOS
             , gBinarySuffix
             , gTestHaddocks
             , gBuildArgs
+            , gStackArgs
             , gCertificateName
             }
           flags
@@ -131,13 +135,23 @@ options =
           g { gBuildArgs =
                    gBuildArgs g
                 ++ [ "--flag=stack:static"
-                   , "--docker"
+                   ]
+            , gStackArgs =
+                   gStackArgs g
+                ++ [ "--docker"
                    , "--system-ghc"
                    , "--no-install-ghc"
                    ]
+            , gTargetOS = Linux
             }
       )
-      "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})
@@ -184,25 +198,28 @@ rules global args = do
           stackExeFileName
       ]
       (stackArgs global)
+      global.gStackArgs
       ["build"]
       global.gBuildArgs
       integrationTestFlagArgs
       ["--pedantic", "--no-haddock-deps", "--test"]
       ["--haddock" | global.gTestHaddocks]
       ["stack"]
     () <- cmd
-      [ global.gProjectRoot </> releaseBinDir </> binaryName </>
-          stackExeFileName
-      ]
-      ["exec"]
-      [ global.gProjectRoot </> releaseBinDir </> binaryName </>
-          "stack-integration-test"
-      ]
+        [ global.gProjectRoot </> releaseBinDir </> binaryName </>
+            stackExeFileName
+        ]
+        (stackArgs global)
+        global.gStackArgs
+        ["exec"]
+        [ global.gProjectRoot </> releaseBinDir </> binaryName </>
+            "stack-integration-test"
+        ]
     copyFileChanged (releaseBinDir </> binaryName </> stackExeFileName) out
 
   releaseDir </> binaryPkgZipFileName %> \out -> do
     stageFiles <- getBinaryPkgStageFiles
-    putNormal $ "zip " ++ out
+    putInfo $ "zip " ++ out
     liftIO $ do
       entries <- forM stageFiles $ \stageFile -> do
         Zip.readEntry
@@ -233,14 +250,23 @@ rules global args = do
 
   releaseDir </> binaryExeFileName %> \out -> do
     need [releaseBinDir </> binaryName </> stackExeFileName]
-    (Stdout versionOut) <-
-      cmd (releaseBinDir </> binaryName </> stackExeFileName) "--version"
-    when (not global.gAllowDirty && "dirty" `isInfixOf` lower versionOut) $
-      error
-        (  "Refusing continue because 'stack --version' reports dirty.  Use --"
-        ++ allowDirtyOptName
-        ++ " option to continue anyway."
-        )
+    if platformOS == global.gTargetOS
+      then do
+        (Stdout versionOut) <-
+          cmd (releaseBinDir </> binaryName </> stackExeFileName) "--version"
+        when (not global.gAllowDirty && "dirty" `isInfixOf` lower versionOut) $
+          error
+            (  "Refusing continue because 'stack --version' reports dirty.  Use --"
+            ++ allowDirtyOptName
+            ++ " option to continue anyway."
+            )
+      else
+        putInfo $
+             "The current and target operating systems differ ("
+          <> show platformOS
+          <> ", "
+          <> show global.gTargetOS
+          <> "). Not checking if 'stack --version' reports dirty."
     case platformOS of
       Windows -> do
         -- Windows doesn't have or need a 'strip' command, so skip it.
@@ -298,6 +324,7 @@ rules global args = do
       ( cmd stackProgName
           (stackArgs global)
           ["--local-bin-path=" ++ takeDirectory out]
+          global.gStackArgs
           "install"
           global.gBuildArgs
           integrationTestFlagArgs
@@ -336,7 +363,7 @@ rules global args = do
   releaseBinDir = releaseDir </> "bin"
 
   binaryPkgFileNames =
-    case platformOS of
+    case global.gTargetOS of
       Windows ->
         [ binaryExeFileName
         , binaryPkgZipFileName
@@ -357,7 +384,7 @@ rules global args = do
     , "-"
     , stackVersionStr global
     , "-"
-    , display platformOS
+    , display global.gTargetOS
     , "-"
     , display global.gArch
     , if null global.gBinarySuffix then "" else "-" ++ global.gBinarySuffix
@@ -438,6 +465,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"
@@ -469,9 +500,11 @@ data Global = Global
   , gProjectRoot :: !FilePath
   , gHomeDir :: !FilePath
   , gArch :: !Arch
+  , gTargetOS :: !OS
   , gBinarySuffix :: !String
   , gTestHaddocks :: !Bool
   , gBuildArgs :: [String]
+  , gStackArgs :: [String]
   , gCertificateName :: !(Maybe String)
   }
   deriving Show