Fix #5755 Add --script-no-run-compile flag

Adds a `--script-no-run-compile` flag (disabled by default) that use the `--no-run` option with `stack script` (and forces the `--compile` option).

This enables a command like `stack --script-no-run-compile Script.hs` to behave like `stack script ... --no-run --compile -- Script.hs` but without having to list all the other arguments in the stack interpreter options comment (represented by `...`) on the command line.

Also adds an explanation to the online documentation.

ChangeLog.md

@@ -21,6 +21,14 @@ Other enhancements:
 * Bump to `hpack-0.35.0`.
 * On Windows, the installer now sets `DisplayVersion` in the registry, enabling
   tools like `winget` to properly read the version number.
+* Adds flag `--script-no-run-compile` (disabled by default) that uses the
+  `--no-run` option with `stack script` (and forces the `--compile` option).
+  This enables a command like `stack --script-no-run-compile Script.hs` to
+  behave like `stack script <arguments> --no-run --compile -- Script.hs` but
+  without having to list all the `<arguments>` in the stack interpreter options
+  comment in `Script.hs` on the command line. That may help test that scripts
+  compile in CI (continuous integration). See
+  [#5755](https://github.com/commercialhaskell/stack/issues/5755)
 
 Bug fixes:
 

doc/GUIDE.md

@@ -1278,7 +1278,6 @@ arguments, or by providing a comma or space separated list. For example:
   --package http-client,http-conduit
 -}
 ```
-
 ### Stack configuration for scripts
 
 With the `script` command, all Stack configuration files are ignored to provide
@@ -1315,6 +1314,33 @@ a multi line block comment with ghc options:
 -}
 ```
 
+### Testing scripts
+
+You can use the flag `--script-no-run-compile` on the command line to enable (it
+is disabled by default) the use of the `--no-run` option with `stack script`
+(and forcing the `--compile` option). The flag may help test that scripts
+compile in CI (continuous integration).
+
+For example, consider the following simple script, in a file named `Script.hs`,
+which makes use of the joke package
+[`acme-missiles`](https://hackage.haskell.org/package/acme-missiles):
+```
+{- stack script
+   --resolver lts-19.9
+   --package acme-missiles
+-}
+import Acme.Missiles (launchMissiles)
+
+main :: IO ()
+main = launchMissiles
+```
+The command `stack --script-no-run-compile Script.hs` then behaves as if the
+command
+`stack script --resolver lts-19.9 --package acme-missiles --no-run --compile -- Script.hs`
+had been given (see further below about the `stack script` command). `Script.hs`
+is compiled (without optimisation) and the resulting executable is not run: no
+missiles are launched in the process!
+
 ### Writing independent and reliable scripts
 
 With the release of Stack 1.4.0, there is a new command, `script`, which will

src/Stack/Config.hs

@@ -342,6 +342,7 @@ configFromConfigMonoid
          configHackageBaseUrl = fromFirst "https://hackage.haskell.org/" configMonoidHackageBaseUrl
          configHideSourcePaths = fromFirstTrue configMonoidHideSourcePaths
          configRecommendUpgrade = fromFirstTrue configMonoidRecommendUpgrade
+         configNoRunCompile = fromFirstFalse configMonoidNoRunCompile
 
      configAllowDifferentUser <-
         case getFirst configMonoidAllowDifferentUser of

src/Stack/Options/ConfigParser.hs

@@ -23,7 +23,7 @@ configOptsParser currentDir hide0 =
     (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch
         ghcVariant ghcBuild jobs includes libs preprocs overrideGccPath overrideHpack
         skipGHCCheck skipMsys localBin setupInfoLocations modifyCodePage
-        allowDifferentUser dumpLogs colorWhen snapLoc -> mempty
+        allowDifferentUser dumpLogs colorWhen snapLoc noRunCompile -> mempty
             { configMonoidStackRoot = stackRoot
             , configMonoidWorkDir = workDir
             , configMonoidBuildOpts = buildOpts
@@ -49,6 +49,7 @@ configOptsParser currentDir hide0 =
             , configMonoidDumpLogs = dumpLogs
             , configMonoidColorWhen = colorWhen
             , configMonoidSnapshotLocation = snapLoc
+            , configMonoidNoRunCompile = noRunCompile
             })
     <$> optionalFirst (absDirOption
             ( long stackRootOptionName
@@ -175,6 +176,10 @@ configOptsParser currentDir hide0 =
            <> help "The base location of LTS/Nightly snapshots"
            <> metavar "URL"
             ))
+    <*> firstBoolFlagsFalse
+            "script-no-run-compile"
+            "the use of options `--no-run --compile` with `stack script`"
+            hide
   where
     hide = hideMods (hide0 /= OuterGlobalOpts)
     toDumpLogs (First (Just True)) = First (Just DumpAllLogs)

src/Stack/Script.hs

@@ -75,45 +75,54 @@ scriptCmd opts = do
       SYLNoProject _ -> assert False (return ())
 
     file <- resolveFile' $ soFile opts
+
+    isNoRunCompile <- fromFirstFalse . configMonoidNoRunCompile <$>
+                             view (globalOptsL.to globalConfigMonoid)
+
     let scriptDir = parent file
         modifyGO go = go
             { globalConfigMonoid = (globalConfigMonoid go)
                 { configMonoidInstallGHC = FirstTrue $ Just True
                 }
             , globalStackYaml = SYLNoProject $ soScriptExtraDeps opts
             }
+        (shouldRun, shouldCompile) = if isNoRunCompile
+          then (NoRun, SECompile)
+          else (soShouldRun opts, soCompile opts)
 
-    case soShouldRun opts of
+    case shouldRun of
       YesRun -> pure ()
       NoRun -> do
         unless (null $ soArgs opts) $ throwString "--no-run incompatible with arguments"
-        case soCompile opts of
+        case shouldCompile of
           SEInterpret -> throwString "--no-run requires either --compile or --optimize"
           SECompile -> pure ()
           SEOptimize -> pure ()
 
     -- Optimization: if we're compiling, and the executable is newer
     -- than the source file, run it immediately.
     local (over globalOptsL modifyGO) $
-      case soCompile opts of
-        SEInterpret -> longWay file scriptDir
-        SECompile -> shortCut file scriptDir
-        SEOptimize -> shortCut file scriptDir
+      case shouldCompile of
+        SEInterpret -> longWay shouldRun shouldCompile file scriptDir
+        SECompile -> shortCut shouldRun shouldCompile file scriptDir
+        SEOptimize -> shortCut shouldRun shouldCompile file scriptDir
 
   where
-  runCompiled file = do
+  runCompiled shouldRun file = do
     let exeName = toExeName $ toFilePath file
-    case soShouldRun opts of
+    case shouldRun of
       YesRun -> exec exeName (soArgs opts)
       NoRun -> logInfo $ "Compilation finished, executable available at " <> fromString exeName
-  shortCut file scriptDir = handleIO (const $ longWay file scriptDir) $ do
-    srcMod <- getModificationTime file
-    exeMod <- Dir.getModificationTime $ toExeName $ toFilePath file
-    if srcMod < exeMod
-      then runCompiled file
-      else longWay file scriptDir
+
+  shortCut shouldRun shouldCompile file scriptDir =
+    handleIO (const $ longWay shouldRun shouldCompile file scriptDir) $ do
+      srcMod <- getModificationTime file
+      exeMod <- Dir.getModificationTime $ toExeName $ toFilePath file
+      if srcMod < exeMod
+        then runCompiled shouldRun file
+        else longWay shouldRun shouldCompile file scriptDir
 
-  longWay file scriptDir =
+  longWay shouldRun shouldCompile file scriptDir =
     withConfig YesReexec $
     withDefaultEnvConfig $ do
       config <- view configL
@@ -159,13 +168,13 @@ scriptCmd opts = do
                     $ Set.toList
                     $ Set.insert "base"
                     $ Set.map packageNameString targetsSet
-                , case soCompile opts of
+                , case shouldCompile of
                     SEInterpret -> []
                     SECompile -> []
                     SEOptimize -> ["-O2"]
                 , soGhcOptions opts
                 ]
-        case soCompile opts of
+        case shouldCompile of
           SEInterpret -> do
             interpret <- view $ compilerPathsL.to cpInterpreter
             exec (toFilePath interpret)
@@ -181,7 +190,7 @@ scriptCmd opts = do
               compilerExeName
               (ghcArgs ++ [toFilePath file])
               (void . readProcessStdout_)
-            runCompiled file
+            runCompiled shouldRun file
 
   toPackageName = reverse . drop 1 . dropWhile (/= '-') . reverse
 

src/Stack/Types/Config.hs

@@ -381,6 +381,8 @@ data Config =
          -- ^ Enable GHC hiding source paths?
          ,configRecommendUpgrade    :: !Bool
          -- ^ Recommend a Stack upgrade?
+         ,configNoRunCompile   :: !Bool
+         -- ^ Use --no-run and --compile options when using `stack script`
          ,configStackDeveloperMode  :: !Bool
          -- ^ Turn on Stack developer mode for additional messages?
          }
@@ -867,6 +869,8 @@ data ConfigMonoid =
     , configMonoidCasaRepoPrefix     :: !(First CasaRepoPrefix)
     , configMonoidSnapshotLocation :: !(First Text)
     -- ^ Custom location of LTS/Nightly snapshots
+    , configMonoidNoRunCompile  :: !FirstFalse
+    -- ^ See: 'configNoRunCompile'
     , configMonoidStackDeveloperMode :: !(First Bool)
     -- ^ See 'configStackDeveloperMode'
     }
@@ -991,6 +995,7 @@ parseConfigMonoidObject rootDir obj = do
 
     configMonoidCasaRepoPrefix <- First <$> obj ..:? configMonoidCasaRepoPrefixName
     configMonoidSnapshotLocation <- First <$> obj ..:? configMonoidSnapshotLocationName
+    configMonoidNoRunCompile <- FirstFalse <$> obj ..:? configMonoidNoRunCompileName
 
     configMonoidStackDeveloperMode <- First <$> obj ..:? configMonoidStackDeveloperModeName
 
@@ -1152,6 +1157,9 @@ configMonoidCasaRepoPrefixName = "casa-repo-prefix"
 configMonoidSnapshotLocationName :: Text
 configMonoidSnapshotLocationName = "snapshot-location-base"
 
+configMonoidNoRunCompileName :: Text
+configMonoidNoRunCompileName = "script-no-run-compile"
+
 configMonoidStackDeveloperModeName :: Text
 configMonoidStackDeveloperModeName = "stack-developer-mode"