Merge pull request #7997 from bacchanalia/5698

Add support for cabal.project fields to scripts

Author: mergify[bot]

cabal-install/src/Distribution/Client/ProjectConfig.hs

@@ -29,6 +29,8 @@ module Distribution.Client.ProjectConfig (
     readGlobalConfig,
     readProjectLocalExtraConfig,
     readProjectLocalFreezeConfig,
+    parseProjectConfig,
+    reportParseResult,
     showProjectConfig,
     withProjectOrGlobalConfig,
     writeProjectLocalExtraConfig,

cabal-install/src/Distribution/Client/ScriptUtils.hs

@@ -30,7 +30,8 @@ import Distribution.Client.HashValue
 import Distribution.Client.NixStyleOptions
     ( NixStyleFlags (..) )
 import Distribution.Client.ProjectConfig
-    ( ProjectConfig(..), ProjectConfigShared(..), withProjectOrGlobalConfig )
+    ( ProjectConfig(..), ProjectConfigShared(..)
+    , parseProjectConfig, reportParseResult, withProjectOrGlobalConfig )
 import Distribution.Client.ProjectFlags
     ( flagIgnoreProject )
 import Distribution.Client.Setup
@@ -46,7 +47,7 @@ import Distribution.Fields
 import Distribution.PackageDescription.FieldGrammar
     ( executableFieldGrammar )
 import Distribution.PackageDescription.PrettyPrint
-    ( showGenericPackageDescription, writeGenericPackageDescription )
+    ( showGenericPackageDescription )
 import Distribution.Parsec
     ( Position(..) )
 import Distribution.Simple.Flag
@@ -56,7 +57,7 @@ import Distribution.Simple.PackageDescription
 import Distribution.Simple.Setup
     ( Flag(..) )
 import Distribution.Simple.Utils
-    ( createDirectoryIfMissingVerbose, createTempDirectory, die', handleDoesNotExist, readUTF8File, warn )
+    ( createDirectoryIfMissingVerbose, createTempDirectory, die', handleDoesNotExist, readUTF8File, warn, writeUTF8File )
 import qualified Distribution.SPDX.License as SPDX
 import Distribution.Solver.Types.SourcePackage as SP
     ( SourcePackage(..) )
@@ -214,10 +215,13 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings gl
         let projectRoot = distProjectRootDirectory $ distDirLayout ctx
         writeFile (projectRoot </> "scriptlocation") =<< canonicalizePath script
 
-        executable <- readScriptBlockFromScript verbosity =<< BS.readFile script
+        scriptContents <- BS.readFile script
+        executable     <- readExecutableBlockFromScript verbosity scriptContents
+        projectCfg     <- readProjectBlockFromScript verbosity (takeFileName script) scriptContents
 
         let executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just
-        return (ScriptContext script executable', ctx, defaultTarget)
+            ctx'        = ctx & lProjectConfig %~ (<> projectCfg)
+        return (ScriptContext script executable', ctx', defaultTarget)
       else reportTargetSelectorProblems verbosity err
 
 withTemporaryTempDirectory :: (IO FilePath -> IO a) -> IO a
@@ -236,17 +240,18 @@ withTemporaryTempDirectory act = newEmptyMVar >>= \m -> bracket (getMkTmp m) (rm
 -- | Add the 'SourcePackage' to the context and use it to write a .cabal file.
 updateContextAndWriteProjectFile' :: ProjectBaseContext -> SourcePackage (PackageLocation (Maybe FilePath)) -> IO ProjectBaseContext
 updateContextAndWriteProjectFile' ctx srcPkg = do
-  let projectRoot = distProjectRootDirectory $ distDirLayout ctx
-      projectFile = projectRoot </> fakePackageCabalFileName
-      writeProjectFile = writeGenericPackageDescription (projectRoot </> fakePackageCabalFileName) (srcpkgDescription srcPkg)
-  projectFileExists <- doesFileExist projectFile
+  let projectRoot      = distProjectRootDirectory $ distDirLayout ctx
+      packageFile      = projectRoot </> fakePackageCabalFileName
+      contents         = showGenericPackageDescription (srcpkgDescription srcPkg)
+      writePackageFile = writeUTF8File packageFile contents
   -- TODO This is here to prevent reconfiguration of cached repl packages.
   -- It's worth investigating why it's needed in the first place.
-  if projectFileExists then do
-    contents <- force <$> readUTF8File projectFile
-    when (contents /= showGenericPackageDescription (srcpkgDescription srcPkg))
-      writeProjectFile
-  else writeProjectFile
+  packageFileExists <- doesFileExist packageFile
+  if packageFileExists then do
+    cached <- force <$> readUTF8File packageFile
+    when (cached /= contents)
+      writePackageFile
+  else writePackageFile
   return (ctx & lLocalPackages %~ (++ [SpecificSourcePackage srcPkg]))
 
 -- | Add add the executable metadata to the context and write a .cabal file.
@@ -283,26 +288,41 @@ parseScriptBlock str =
 readScriptBlock :: Verbosity -> BS.ByteString -> IO Executable
 readScriptBlock verbosity = parseString parseScriptBlock verbosity "script block"
 
--- | Extract the first encountered script metadata block started end
--- terminated by the bellow tokens or die.
+-- | Extract the first encountered executable metadata block started and
+-- terminated by the below tokens or die.
 --
 -- * @{- cabal:@
 --
 -- * @-}@
 --
 -- Return the metadata.
-readScriptBlockFromScript :: Verbosity -> BS.ByteString -> IO Executable
-readScriptBlockFromScript verbosity str = do
-    str' <- case extractScriptBlock str of
+readExecutableBlockFromScript :: Verbosity -> BS.ByteString -> IO Executable
+readExecutableBlockFromScript verbosity str = do
+    str' <- case extractScriptBlock "cabal" str of
               Left e -> die' verbosity $ "Failed extracting script block: " ++ e
               Right x -> return x
     when (BS.all isSpace str') $ warn verbosity "Empty script block"
     readScriptBlock verbosity str'
 
+-- | Extract the first encountered project metadata block started and
+-- terminated by the below tokens.
+--
+-- * @{- project:@
+--
+-- * @-}@
+--
+-- Return the metadata.
+readProjectBlockFromScript :: Verbosity -> String -> BS.ByteString -> IO ProjectConfig
+readProjectBlockFromScript verbosity scriptName str = do
+    case extractScriptBlock "project" str of
+        Left  _ -> return mempty
+        Right x -> reportParseResult verbosity "script" scriptName
+                 $ parseProjectConfig scriptName x
+
 -- | Extract the first encountered script metadata block started end
 -- terminated by the tokens
 --
--- * @{- cabal:@
+-- * @{- <header>:@
 --
 -- * @-}@
 --
@@ -311,8 +331,8 @@ readScriptBlockFromScript verbosity str = do
 --
 -- In case of missing or unterminated blocks a 'Left'-error is
 -- returned.
-extractScriptBlock :: BS.ByteString -> Either String BS.ByteString
-extractScriptBlock str = goPre (BS.lines str)
+extractScriptBlock :: BS.ByteString -> BS.ByteString -> Either String BS.ByteString
+extractScriptBlock header str = goPre (BS.lines str)
   where
     isStartMarker = (== startMarker) . stripTrailSpace
     isEndMarker   = (== endMarker) . stripTrailSpace
@@ -330,8 +350,8 @@ extractScriptBlock str = goPre (BS.lines str)
       | otherwise     = goBody (l:acc) ls
 
     startMarker, endMarker :: BS.ByteString
-    startMarker = fromString "{- cabal:"
-    endMarker   = fromString "-}"
+    startMarker = "{- " <> header <> ":"
+    endMarker   = "-}"
 
 -- | The base for making a 'SourcePackage' for a fake project.
 -- It needs a 'Distribution.Types.Library.Library' or 'Executable' depending on the command.
@@ -362,6 +382,10 @@ lLocalPackages :: Lens' ProjectBaseContext [PackageSpecifier UnresolvedSourcePac
 lLocalPackages f s = fmap (\x -> s { localPackages = x }) (f (localPackages s))
 {-# inline lLocalPackages #-}
 
+lProjectConfig :: Lens' ProjectBaseContext ProjectConfig
+lProjectConfig f s = fmap (\x -> s { projectConfig = x }) (f (projectConfig s))
+{-# inline lProjectConfig #-}
+
 -- Character classes
 -- Transcribed from "templates/Lexer.x"
 ccSpace, ccCtrlchar, ccPrintable, ccSymbol', ccParen, ccNamecore :: Set Char

cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out

@@ -0,0 +1,7 @@
+# cabal v2-run
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O2
+In order, the following will be built:
+ - fake-package-0 (exe:cabal-script-s.hs) (first run)
+Configuring executable 'cabal-script-s.hs' for fake-package-0..
+Building executable 'cabal-script-s.hs' for fake-package-0..

cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.test.hs

@@ -0,0 +1,6 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ do
+    -- script is called "s.hs" to avoid Windows long path issue in CI
+    res <- cabal' "v2-run" ["s.hs"]
+    assertOutputContains "Hello World" res

cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/s.hs

@@ -0,0 +1,10 @@
+#!/usr/bin/env cabal
+{- cabal:
+build-depends: base
+-}
+{- project:
+optimization: 2
+-}
+
+main :: IO ()
+main = putStrLn "Hello World"

changelog.d/pr-7851

@@ -1,7 +1,7 @@
 synopsis:  Better support for scripts
 packages: cabal-install
-prs: #7851 #7925 #7938 #7990
-issues: #7842 #7073 #6354 #6149 #5508
+prs: #7851 #7925 #7938 #7990 #7997
+issues: #7842 #7073 #6354 #6149 #5508 #5698
 
 description: {
 
@@ -15,5 +15,7 @@ description: {
 - The name of the generated script executable has been changed from "script" to
   "cabal-script-<your-sanitized-script-name>" for easier process management.
 - Reduce the default verbosity of scripts, so that the build output doesn't interfere with the script output.
+- Scripts now support a project metadata block that allows them to use options
+  that would normally be set in a cabal.project file.
 
 }

doc/cabal-commands.rst

@@ -436,13 +436,15 @@ See `the v2-build section <#cabal-v2-build>`__ for the target syntax.
 
 When ``TARGET`` is one of the following:
 
-- A component target: execute the specified executable, benchmark or test suite
+- A component target: execute the specified executable, benchmark or test suite.
 
 - A package target:
    1. If the package has exactly one executable component, it will be selected.
    2. If the package has multiple executable components, an error is raised.
    3. If the package has exactly one test or benchmark component, it will be selected.
-   4. Otherwise an issue is raised
+   4. Otherwise an issue is raised.
+
+- The path to a script: execute the script at the path.
 
 - Empty target: Same as package target, implicitly using the package from the current
   working directory.
@@ -458,28 +460,38 @@ have to separate them with ``--``.
 
     $ cabal v2-run target -- -a -bcd --argument
 
-``v2-run`` also supports running script files that use a certain format. With
-a script that looks like:
+``v2-run`` supports running script files that use a certain format.
+Scripts look like:
 
 ::
 
     #!/usr/bin/env cabal
     {- cabal:
-    build-depends: base ^>= 4.11
-                , shelly ^>= 1.8.1
+    build-depends: base ^>= 4.14
+                , shelly ^>= 1.10
+    -}
+    {- project:
+    with-compiler: ghc-8.10.7
     -}
 
     main :: IO ()
     main = do
         ...
 
-It can either be executed like any other script, using ``cabal`` as an
-interpreter, or through this command:
+Where there cabal metadata block is mandatory and contains fields from a
+package executable block, and the project metadata block is optional and
+contains fields that would be in the cabal.project file in a regular project.
+
+Only some fields are supported in the metadata blocks, and these fields are
+currently not validated. See
+`#8024 <https://github.com/haskell/cabal/issues/8024>`__ for details.
+
+A script can either be executed directly using `cabal` as an interpreter or
+with the command:
 
 ::
 
     $ cabal v2-run path/to/script
-    $ cabal v2-run path/to/script -- --arg1 # args are passed like this
 
 The executable is cached under the cabal directory, and can be pre-built with
 ``cabal v2-build path/to/script`` and the cache can be removed with