From bbc11f1c71651e910976c16498bc4871d7b416ea Mon Sep 17 00:00:00 2001 From: Mel Zuser Date: Fri, 31 Dec 2021 13:20:05 -0500 Subject: [PATCH] Better support for running scripts. (#7851) * Add support for script build caching to cabal run Enable caching of script builds by changing the location of the fake package directory from a tmp directory to: /scipt-builds/abs/path/to/script/ Resolves: #6354 WIP: #7842 * Add support for scripts to cabal build. Added module Distribution.Client.ScriptUtils for code to deal with scripts that is common between commands. WIP: #7842 * Add script support to cabal clean. This changes the behaviour of cabal clean to accept extra args, which it now interprets as script files. The behaviour of cabal clean is the same when given extra args. When given extra args it instead removes the caches for those scripts and also any orphaned caches (caches for which the script no longer exists) In addition this commit changes the cache to use hashes of paths because this significantly simplifies the implementation of clean, and more importantly it prevents collisions when a script has the name of the subdirectory of a previously cached script. WIP: #7842 * Add script support to cabal repl repl starts in the correct directory and points directly to rather than a dummy, so that reloading works properly. There is a downside to the current approach which is that it uses a different fake-project.cabal file from run and build, so it cannot share the same cache with them. WIP: #7842 WIP: #6149 * Added changelog for pr #7851 * Fix `cabal run script.hs` issue with --builddir Fixes tests: cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs * Fixes for `build script` and `repl script` - Fix build issue introduced in 079c5f0e, where build was being passed the wrong target filter - Fix repl issue where script didn't work in a project context. - Refactor code to share logic between repl and build/run - Ensure temp directories are only created when needed * Bug fixes relating to script support ScriptUtils: - Hash prefix for cache dirs was applied incorrectly. - Overwriting fake-package files causes repeated work in some cases. CmdClean: - Clean distdir for script when --builddir is passed - Always clean orphans because because there is no good way to specify they should be cleaned. This may be bad behaviour in some obscure cases (a cache is temporarily orphaned and an unrelated clean is run), but at worst results in a cache rebuild. * Add tests for improved script support - Basic script support for build/repl/clean which checks for cached project files - Add check for cached project files to basic run script test - No repeated work for build/build, build/run, run/run, and repl/repl - Clean does not remove cache for existing scripts - Clean does remove orphaned script caches * Fix clean bug uncovered by 5fad1214 - clean was trying to read source-builds even if it didn't exist - add test specific to this case with other clean tests * Update documentation for better script support Ready for review: #7851 May close: #7842, #6354, #6149 * Attempt to fix `repl script` on Windows PR #7851 * Attempt to fix remote test failures Test logs showed that the failures where because the tests depended on a module from cabal-install that some ghc versions could not find. Instead of depending on cabal-install, I copied the needed function into Test.Cabal.Prelude (It seemed like an acceptable place for it) PR #7851 * Attempt to fix `repl script` on Windows PR #7851 * Attempt to fix tests on old ghc versions Tests failing on pre-AMP ghcs due to unsanctioned use of (<$>) PR #7851 * Feedback: Update docs and formatting PR #7851 * Feedback: code style changes - remove partial selectors - make a constant for fake-package.cabal PR #7851 * Feedback: make hidden control flow explicit PR #7851 * Feedback: add expected fail script run tests PR #7851 * Fix `repl script` when cwd is deeper than cachedir PR #7851 * Use script in-place for build or run - Set the hs-source-dir to the location of the script for build and run, the same as with repl - This removes the need to copy the script - repl no longer needs a separate cache because all three commands use identical project files - Adds multi-module support to scripts for free (#6787) - Add new build/repl test and run multi-module test PR #7851 * Fix file-locking issue on Windows PR #7851 * Fix script recompilation based on cwd - Pass info about cwd to repl through --repl-options instead of hacking it into the project file. - Improve paths output by makeRelativeCanonical, makeRelativeToDir, and makeRelativeToCwd. - Script multi-module support works, but with warning in repl. - Remove script multi-module mention support in docs. PR #7851 * Make `repl script` respect --repl-no-load * Feedback: minor refactor Move argument truncation from targetStrings out of withScriptContextAndSelectors to runAction PR #7851 * Feedback: refactor and comments for repl options PR #7851 * Don't use hs-source-dirs for scripts. - instead pass absolute path to script in main-is - resolves issue with relative paths on Windows - simplifies code and gives prettier build output - update tests because build output has changed - removes ability to use multi-module scripts (which was never officially endorsed) - remove test for multi-module scripts - add checks for unsupported fields in scripts PR #7851 * Update changelog for PR #7851 --- .../Distribution/Types/PackageName/Magic.hs | 6 +- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/CmdBuild.hs | 16 +- .../src/Distribution/Client/CmdClean.hs | 43 ++- .../src/Distribution/Client/CmdRepl.hs | 216 +++++------ .../src/Distribution/Client/CmdRun.hs | 222 +---------- .../src/Distribution/Client/ScriptUtils.hs | 346 ++++++++++++++++++ .../src/Distribution/Client/Utils.hs | 7 +- .../NewBuild/CmdBuild/Script/cabal.out | 8 + .../NewBuild/CmdBuild/Script/cabal.test.hs | 10 + .../NewBuild/CmdBuild/Script/script.hs | 6 + .../CmdBuild/ScriptBuildRepl/cabal.out | 13 + .../CmdBuild/ScriptBuildRepl/cabal.test.hs | 5 + .../CmdBuild/ScriptBuildRepl/script.hs | 6 + .../CmdBuild/ScriptBuildRun/cabal.out | 10 + .../CmdBuild/ScriptBuildRun/cabal.test.hs | 5 + .../CmdBuild/ScriptBuildRun/script.hs | 6 + .../NewBuild/CmdBuild/ScriptRerun/cabal.out | 10 + .../CmdBuild/ScriptRerun/cabal.test.hs | 5 + .../NewBuild/CmdBuild/ScriptRerun/script.hs | 6 + .../CleanScriptWithNoScriptsBuilt/cabal.out | 2 + .../cabal.test.hs | 5 + .../CleanScriptWithNoScriptsBuilt/script.hs | 6 + .../NewBuild/CmdClean/Keep/cabal.out | 17 + .../NewBuild/CmdClean/Keep/cabal.test.hs | 18 + .../NewBuild/CmdClean/Keep/script.hs | 6 + .../NewBuild/CmdClean/Orphan/cabal.out | 17 + .../NewBuild/CmdClean/Orphan/cabal.test.hs | 18 + .../NewBuild/CmdClean/Orphan/script.hs | 6 + .../NewBuild/CmdClean/Script/cabal.out | 9 + .../NewBuild/CmdClean/Script/cabal.test.hs | 11 + .../NewBuild/CmdClean/Script/script.hs | 6 + .../NewBuild/CmdRepl/Script/cabal.out | 7 + .../NewBuild/CmdRepl/Script/cabal.test.hs | 11 + .../NewBuild/CmdRepl/Script/script.hs | 6 + .../NewBuild/CmdRepl/ScriptRerun/cabal.out | 12 + .../CmdRepl/ScriptRerun/cabal.test.hs | 5 + .../NewBuild/CmdRepl/ScriptRerun/script.hs | 6 + .../NewBuild/CmdRun/RunMainBad/Main.hs | 1 + .../CmdRun/RunMainBad/RunMainBad.cabal | 9 + .../NewBuild/CmdRun/RunMainBad/cabal.out | 3 + .../NewBuild/CmdRun/RunMainBad/cabal.project | 1 + .../NewBuild/CmdRun/RunMainBad/cabal.test.hs | 4 + .../NewBuild/CmdRun/Script/cabal.test.hs | 6 + .../NewBuild/CmdRun/ScriptBad/cabal.out | 2 + .../NewBuild/CmdRun/ScriptBad/cabal.project | 1 + .../NewBuild/CmdRun/ScriptBad/cabal.test.hs | 4 + .../NewBuild/CmdRun/ScriptBad/script.cabal | 4 + .../NewBuild/CmdRun/ScriptBad/script.hs | 9 + .../NewBuild/CmdRun/ScriptRerun/cabal.out | 10 + .../NewBuild/CmdRun/ScriptRerun/cabal.test.hs | 5 + .../NewBuild/CmdRun/ScriptRerun/script.hs | 6 + cabal-testsuite/src/Test/Cabal/Prelude.hs | 26 +- changelog.d/pr-7851 | 15 + doc/cabal-commands.rst | 36 +- 55 files changed, 905 insertions(+), 352 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/ScriptUtils.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.project create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/script.cabal create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/script.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/script.hs create mode 100644 changelog.d/pr-7851 diff --git a/Cabal/src/Distribution/Types/PackageName/Magic.hs b/Cabal/src/Distribution/Types/PackageName/Magic.hs index 35c464729e9..022a62468b1 100644 --- a/Cabal/src/Distribution/Types/PackageName/Magic.hs +++ b/Cabal/src/Distribution/Types/PackageName/Magic.hs @@ -11,10 +11,14 @@ import Distribution.Types.Version nonExistentPackageThisIsCabalBug :: PackageName nonExistentPackageThisIsCabalBug = mkPackageName "nonexistent-package-this-is-a-cabal-bug" --- | Used by @cabal new-repl@ and @cabal new-run@ +-- | Used by @cabal new-repl@, @cabal new-run@ and @cabal new-build@ fakePackageName :: PackageName fakePackageName = mkPackageName "fake-package" +-- | Used by @cabal new-run@ and @cabal new-build@ +fakePackageCabalFileName :: FilePath +fakePackageCabalFileName = "fake-package.cabal" + -- | 'fakePackageName' with 'version0'. fakePackageId :: PackageId fakePackageId = PackageIdentifier fakePackageName version0 diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 1a5c282e7cf..552e70f70f1 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -159,6 +159,7 @@ library Distribution.Client.Sandbox Distribution.Client.Sandbox.PackageEnvironment Distribution.Client.SavedFlags + Distribution.Client.ScriptUtils Distribution.Client.Security.DNS Distribution.Client.Security.HTTP Distribution.Client.Setup diff --git a/cabal-install/src/Distribution/Client/CmdBuild.hs b/cabal-install/src/Distribution/Client/CmdBuild.hs index ea59acfff19..e3b1f4459a8 100644 --- a/cabal-install/src/Distribution/Client/CmdBuild.hs +++ b/cabal-install/src/Distribution/Client/CmdBuild.hs @@ -32,6 +32,8 @@ import Distribution.Verbosity ( normal ) import Distribution.Simple.Utils ( wrapText, die' ) +import Distribution.Client.ScriptUtils + ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) ) import qualified Data.Map as Map @@ -95,7 +97,8 @@ defaultBuildFlags = BuildFlags -- "Distribution.Client.ProjectOrchestration" -- buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO () -buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings globalFlags = do +buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings globalFlags + = withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do -- TODO: This flags defaults business is ugly let onlyConfigure = fromFlag (buildOnlyConfigure defaultBuildFlags <> buildOnlyConfigure buildFlags) @@ -103,11 +106,10 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo | onlyConfigure = TargetActionConfigure | otherwise = TargetActionBuild - baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand - - targetSelectors <- - either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings + baseCtx <- case targetCtx of + ProjectContext -> return ctx + GlobalContext -> return ctx + ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta buildCtx <- runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do @@ -141,8 +143,6 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - cliConfig = commandLineFlagsToProjectConfig globalFlags flags - mempty -- ClientInstallFlags, not needed here -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, diff --git a/cabal-install/src/Distribution/Client/CmdClean.hs b/cabal-install/src/Distribution/Client/CmdClean.hs index 956552b3f06..a0eee3e33fa 100644 --- a/cabal-install/src/Distribution/Client/CmdClean.hs +++ b/cabal-install/src/Distribution/Client/CmdClean.hs @@ -8,6 +8,8 @@ import Distribution.Client.DistDirLayout ( DistDirLayout(..), defaultDistDirLayout ) import Distribution.Client.ProjectConfig ( findProjectRoot ) +import Distribution.Client.ScriptUtils + ( getScriptCacheDirectoryRoot ) import Distribution.Client.Setup ( GlobalFlags ) import Distribution.ReadE ( succeedReadE ) @@ -22,9 +24,14 @@ import Distribution.Simple.Utils import Distribution.Verbosity ( normal ) +import Control.Monad + ( forM, forM_, mapM ) +import qualified Data.Set as Set import System.Directory ( removeDirectoryRecursive, removeFile - , doesDirectoryExist, getDirectoryContents ) + , doesDirectoryExist, doesFileExist + , getDirectoryContents, listDirectory + , canonicalizePath ) import System.FilePath ( () ) @@ -80,16 +87,21 @@ cleanAction CleanFlags{..} extraArgs _ = do mdistDirectory = flagToMaybe cleanDistDir mprojectFile = flagToMaybe cleanProjectFile - unless (null extraArgs) $ - die' verbosity $ "'clean' doesn't take any extra arguments: " - ++ unwords extraArgs + -- TODO interpret extraArgs as targets and clean those targets only (issue #7506) + -- + -- For now assume all files passed are the names of scripts + notScripts <- filterM (fmap not . doesFileExist) extraArgs + unless (null notScripts) $ + die' verbosity $ "'clean' extra arguments should be script files: " + ++ unwords notScripts projectRoot <- either throwIO return =<< findProjectRoot Nothing mprojectFile let distLayout = defaultDistDirLayout projectRoot mdistDirectory - if saveConfig - then do + -- Do not clean a project if just running a script in it's directory + when (null extraArgs || isJust mdistDirectory) $ do + if saveConfig then do let buildRoot = distBuildRootDirectory distLayout buildRootExists <- doesDirectoryExist buildRoot @@ -103,7 +115,24 @@ cleanAction CleanFlags{..} extraArgs _ = do info verbosity ("Deleting dist-newstyle (" ++ distRoot ++ ")") handleDoesNotExist () $ removeDirectoryRecursive distRoot - removeEnvFiles (distProjectRootDirectory distLayout) + removeEnvFiles (distProjectRootDirectory distLayout) + + -- Clean specified script build caches and orphaned caches. + -- There is currently no good way to specify to only clean orphaned caches. + -- It would be better as part of an explicit gc step (see issue #3333) + toClean <- Set.fromList <$> mapM canonicalizePath extraArgs + cacheDir <- getScriptCacheDirectoryRoot + existsCD <- doesDirectoryExist cacheDir + caches <- if existsCD then listDirectory cacheDir else return [] + paths <- fmap concat . forM caches $ \cache -> do + let locFile = cacheDir cache "scriptlocation" + exists <- doesFileExist locFile + if exists then pure . (,) (cacheDir cache) <$> readFile locFile else return [] + forM_ paths $ \(cache, script) -> do + exists <- doesFileExist script + when (not exists || script `Set.member` toClean) $ do + info verbosity ("Deleting cache (" ++ cache ++ ") for script (" ++ script ++ ")") + removeDirectoryRecursive cache removeEnvFiles :: FilePath -> IO () removeEnvFiles dir = diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs index fc7880b2370..bf89e7b10dd 100644 --- a/cabal-install/src/Distribution/Client/CmdRepl.hs +++ b/cabal-install/src/Distribution/Client/CmdRepl.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} -- | cabal-install CLI command: repl -- @@ -23,6 +23,8 @@ import Distribution.Client.Compat.Prelude import Distribution.Compat.Lens import qualified Distribution.Types.Lens as L +import Distribution.Client.DistDirLayout + ( DistDirLayout(..) ) import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.CmdErrorMessages @@ -36,21 +38,20 @@ import Distribution.Client.TargetProblem import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.ProjectBuilding ( rebuildTargetsDryRun, improveInstallPlanWithUpToDatePackages ) -import Distribution.Client.ProjectConfig - ( ProjectConfig(..), withProjectOrGlobalConfig - , projectConfigConfigFile ) -import Distribution.Client.ProjectFlags - ( flagIgnoreProject ) import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning ( ElaboratedSharedConfig(..), ElaboratedInstallPlan ) import Distribution.Client.ProjectPlanning.Types ( elabOrderExeDependencies ) +import Distribution.Client.ScriptUtils + ( AcceptNoTargets(..), withContextAndSelectors, TargetContext(..) + , updateContextAndWriteProjectFile, updateContextAndWriteProjectFile' + , fakeProjectSourcePackage, lSrcpkgDescription ) import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..) ) import qualified Distribution.Client.Setup as Client import Distribution.Client.Types - ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage ) + ( PackageSpecifier(..), UnresolvedSourcePackage ) import Distribution.Simple.Setup ( fromFlagOrDefault, ReplOptions(..), replOptions , Flag(..), toFlag, falseArg ) @@ -60,15 +61,13 @@ import Distribution.Simple.Command import Distribution.Compiler ( CompilerFlavor(GHC) ) import Distribution.Simple.Compiler - ( compilerCompatVersion ) + ( Compiler, compilerCompatVersion ) import Distribution.Package ( Package(..), packageName, UnitId, installedUnitId ) -import Distribution.PackageDescription.PrettyPrint import Distribution.Parsec ( parsecCommaList ) import Distribution.ReadE ( ReadE, parsecToReadE ) -import qualified Distribution.SPDX.License as SPDX import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) import Distribution.Types.BuildInfo @@ -79,16 +78,10 @@ import Distribution.Types.CondTree ( CondTree(..), traverseCondTreeC ) import Distribution.Types.Dependency ( Dependency(..), mainLibSet ) -import Distribution.Types.GenericPackageDescription - ( emptyGenericPackageDescription ) -import Distribution.Types.PackageDescription - ( PackageDescription(..), emptyPackageDescription ) -import Distribution.Types.PackageName.Magic - ( fakePackageId ) import Distribution.Types.Library ( Library(..), emptyLibrary ) import Distribution.Types.Version - ( mkVersion ) + ( Version, mkVersion ) import Distribution.Types.VersionRange ( anyVersion ) import Distribution.Utils.Generic @@ -96,18 +89,16 @@ import Distribution.Utils.Generic import Distribution.Verbosity ( normal, lessVerbose ) import Distribution.Simple.Utils - ( wrapText, die', debugNoWrap, createTempDirectory, handleDoesNotExist ) + ( wrapText, die', debugNoWrap ) import Language.Haskell.Extension ( Language(..) ) -import Distribution.CabalSpecVersion - ( CabalSpecVersion (..) ) import Data.List ( (\\) ) import qualified Data.Map as Map import qualified Data.Set as Set import System.Directory - ( getCurrentDirectory, getTemporaryDirectory, removeDirectoryRecursive ) + ( doesFileExist, getCurrentDirectory ) import System.FilePath ( () ) @@ -195,19 +186,42 @@ replCommand = Client.installCommand { -- "Distribution.Client.ProjectOrchestration" -- replAction :: NixStyleFlags (ReplOptions, EnvFlags) -> [String] -> GlobalFlags -> IO () -replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetStrings globalFlags = do - let - with = withProject cliConfig verbosity targetStrings - without globalConfig = withoutProject (globalConfig <> cliConfig) verbosity targetStrings - - (baseCtx, targetSelectors, finalizer, replType) <- - withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with without - - when (buildSettingOnlyDeps (buildSettings baseCtx)) $ +replAction flags@NixStyleFlags { extraFlags = (replOpts, envFlags), ..} targetStrings globalFlags + = withContextAndSelectors AcceptNoTargets (Just LibKind) flags targetStrings globalFlags $ \targetCtx ctx targetSelectors -> do + when (buildSettingOnlyDeps (buildSettings ctx)) $ die' verbosity $ "The repl command does not support '--only-dependencies'. " ++ "You may wish to use 'build --only-dependencies' and then " ++ "use 'repl'." + let projectRoot = distProjectRootDirectory $ distDirLayout ctx + + baseCtx <- case targetCtx of + ProjectContext -> return ctx + GlobalContext -> do + unless (null targetStrings) $ + die' verbosity $ "'repl' takes no arguments or a script argument outside a project: " ++ unwords targetStrings + + let + sourcePackage = fakeProjectSourcePackage projectRoot + & lSrcpkgDescription . L.condLibrary + .~ Just (CondNode library [baseDep] []) + library = emptyLibrary { libBuildInfo = lBuildInfo } + lBuildInfo = emptyBuildInfo + { targetBuildDepends = [baseDep] + , defaultLanguage = Just Haskell2010 + } + baseDep = Dependency "base" anyVersion mainLibSet + + updateContextAndWriteProjectFile' ctx sourcePackage + ScriptContext scriptPath scriptExecutable -> do + unless (length targetStrings == 1) $ + die' verbosity $ "'repl' takes a single argument which should be a script: " ++ unwords targetStrings + existsScriptPath <- doesFileExist scriptPath + unless existsScriptPath $ + die' verbosity $ "'repl' takes a single argument which should be a script: " ++ unwords targetStrings + + updateContextAndWriteProjectFile ctx scriptPath scriptExecutable + (originalComponent, baseCtx') <- if null (envPackages envFlags) then return (Nothing, baseCtx) else @@ -235,7 +249,7 @@ replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetS -- In addition, to avoid a *third* trip through the solver, we are -- replicating the second half of 'runProjectPreBuildPhase' by hand -- here. - (buildCtx, replFlags'') <- withInstallPlan verbosity baseCtx' $ + (buildCtx, compiler, replOpts') <- withInstallPlan verbosity baseCtx' $ \elaboratedPlan elaboratedShared' -> do let ProjectBaseContext{..} = baseCtx' @@ -267,36 +281,23 @@ replAction flags@NixStyleFlags { extraFlags = (replFlags, envFlags), ..} targetS ElaboratedSharedConfig { pkgConfigCompiler = compiler } = elaboratedShared' - -- First version of GHC where GHCi supported the flag we need. - -- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html - minGhciScriptVersion = mkVersion [7, 6] - - replFlags' = case originalComponent of + replFlags = case originalComponent of Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci Nothing -> [] - replFlags'' = case replType of - GlobalRepl scriptPath - | Just version <- compilerCompatVersion GHC compiler - , version >= minGhciScriptVersion -> ("-ghci-script" ++ scriptPath) : replFlags' - _ -> replFlags' - - return (buildCtx, replFlags'') - - let buildCtx' = buildCtx - { elaboratedShared = (elaboratedShared buildCtx) - { pkgConfigReplOptions = replFlags - { replOptionsFlags = (replOptionsFlags replFlags) ++ replFlags'' - } } } + + return (buildCtx, compiler, replOpts & lReplOptionsFlags %~ (++ replFlags)) + + replOpts'' <- case targetCtx of + ProjectContext -> return replOpts' + _ -> usingGhciScript compiler projectRoot replOpts' + + let buildCtx' = buildCtx & lElaboratedShared . lPkgConfigReplOptions .~ replOpts'' printPlan verbosity baseCtx' buildCtx' buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx' runProjectPostBuildPhase verbosity baseCtx' buildCtx' buildOutcomes - finalizer where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - ignoreProject = flagIgnoreProject projectFlags - cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here - globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) validatedTargets elaboratedPlan targetSelectors = do -- Interpret the targets on the command line as repl targets @@ -324,78 +325,6 @@ data OriginalComponentInfo = OriginalComponentInfo } deriving (Show) --- | Tracks what type of GHCi instance we're creating. -data ReplType = ProjectRepl - | GlobalRepl FilePath -- ^ The 'FilePath' argument is path to a GHCi - -- script responsible for changing to the - -- correct directory. Only works on GHC geq - -- 7.6, though. 🙁 - deriving (Show, Eq) - -withProject :: ProjectConfig -> Verbosity -> [String] - -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType) -withProject cliConfig verbosity targetStrings = do - baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand - - targetSelectors <- either (reportTargetSelectorProblems verbosity) return - =<< readTargetSelectors (localPackages baseCtx) (Just LibKind) targetStrings - - return (baseCtx, targetSelectors, return (), ProjectRepl) - -withoutProject :: ProjectConfig -> Verbosity -> [String] - -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType) -withoutProject config verbosity extraArgs = do - unless (null extraArgs) $ - die' verbosity $ "'repl' doesn't take any extra arguments when outside a project: " ++ unwords extraArgs - - globalTmp <- getTemporaryDirectory - tempDir <- createTempDirectory globalTmp "cabal-repl." - - -- We need to create a dummy package that lives in our dummy project. - let - sourcePackage = SourcePackage - { srcpkgPackageId = pkgId - , srcpkgDescription = genericPackageDescription - , srcpkgSource = LocalUnpackedPackage tempDir - , srcpkgDescrOverride = Nothing - } - genericPackageDescription = emptyGenericPackageDescription - & L.packageDescription .~ packageDescription - & L.condLibrary .~ Just (CondNode library [baseDep] []) - packageDescription = emptyPackageDescription - { package = pkgId - , specVersion = CabalSpecV2_2 - , licenseRaw = Left SPDX.NONE - } - library = emptyLibrary { libBuildInfo = buildInfo } - buildInfo = emptyBuildInfo - { targetBuildDepends = [baseDep] - , defaultLanguage = Just Haskell2010 - } - baseDep = Dependency "base" anyVersion mainLibSet - pkgId = fakePackageId - - writeGenericPackageDescription (tempDir "fake-package.cabal") genericPackageDescription - - let ghciScriptPath = tempDir "setcwd.ghci" - cwd <- getCurrentDirectory - writeFile ghciScriptPath (":cd " ++ cwd) - - distDirLayout <- establishDummyDistDirLayout verbosity config tempDir - baseCtx <- - establishDummyProjectBaseContext - verbosity - config - distDirLayout - [SpecificSourcePackage sourcePackage] - OtherCommand - - let - targetSelectors = [TargetPackage TargetExplicitNamed [pkgId] Nothing] - finalizer = handleDoesNotExist () (removeDirectoryRecursive tempDir) - - return (baseCtx, targetSelectors, finalizer, GlobalRepl ghciScriptPath) - addDepsToProjectTarget :: [Dependency] -> PackageId -> ProjectBaseContext @@ -432,6 +361,28 @@ generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = f flags = fmap (("-package-id " ++) . prettyShow) . (\\ exeDeps) $ if includeTransitive then trans' else deps' +-- | Add repl options to ensure the repl actually starts in the current working directory. +-- +-- In a global or script context, when we are using a fake package, @cabal repl@ +-- starts in the fake package directory instead of the directory it was called from, +-- so we need to tell ghci to change back to the correct directory. +-- +-- The @-ghci-script@ flag is path to the ghci script responsible for changing to the +-- correct directory. Only works on GHC >= 7.6, though. 🙁 +usingGhciScript :: Compiler -> FilePath -> ReplOptions -> IO ReplOptions +usingGhciScript compiler projectRoot replOpts + | compilerCompatVersion GHC compiler >= Just minGhciScriptVersion = do + let ghciScriptPath = projectRoot "setcwd.ghci" + cwd <- getCurrentDirectory + writeFile ghciScriptPath (":cd " ++ cwd) + return $ replOpts & lReplOptionsFlags %~ (("-ghci-script" ++ ghciScriptPath) :) + | otherwise = return replOpts + +-- | First version of GHC where GHCi supported the flag we need. +-- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html +minGhciScriptVersion :: Version +minGhciScriptVersion = mkVersion [7, 6] + -- | This defines what a 'TargetSelector' means for the @repl@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, -- or otherwise classifies the problem. @@ -579,3 +530,16 @@ explanationSingleComponentLimitation = "The reason for this limitation is that current versions of ghci do not " ++ "support loading multiple components as source. Load just one component " ++ "and when you make changes to a dependent component then quit and reload." + +-- Lenses +lElaboratedShared :: Lens' ProjectBuildContext ElaboratedSharedConfig +lElaboratedShared f s = fmap (\x -> s { elaboratedShared = x }) (f (elaboratedShared s)) +{-# inline lElaboratedShared #-} + +lPkgConfigReplOptions :: Lens' ElaboratedSharedConfig ReplOptions +lPkgConfigReplOptions f s = fmap (\x -> s { pkgConfigReplOptions = x }) (f (pkgConfigReplOptions s)) +{-# inline lPkgConfigReplOptions #-} + +lReplOptionsFlags :: Lens' ReplOptions [String] +lReplOptionsFlags f s = fmap (\x -> s { replOptionsFlags = x }) (f (replOptionsFlags s)) +{-# inline lReplOptionsFlags #-} diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs index 38da29108db..220b3ec3255 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -42,24 +42,15 @@ import Distribution.Simple.Command ( CommandUI(..), usageAlternatives ) import Distribution.Types.ComponentName ( showComponentName ) -import Distribution.CabalSpecVersion (CabalSpecVersion (..), cabalSpecLatest) import Distribution.Verbosity ( normal ) import Distribution.Simple.Utils - ( wrapText, warn, die', info, notice - , createTempDirectory, handleDoesNotExist ) -import Distribution.Client.ProjectConfig - ( ProjectConfig(..), ProjectConfigShared(..) - , withProjectOrGlobalConfig ) -import Distribution.Client.ProjectFlags - ( flagIgnoreProject ) + ( wrapText, die', info, notice ) import Distribution.Client.ProjectPlanning ( ElaboratedConfiguredPackage(..) , ElaboratedInstallPlan, binDirectoryFor ) import Distribution.Client.ProjectPlanning.Types ( dataDirsEnvironmentForPlan ) -import Distribution.Client.TargetSelector - ( TargetSelectorProblem(..), TargetString(..) ) import Distribution.Client.InstallPlan ( toList, foldPlanPackage ) import Distribution.Types.UnqualComponentName @@ -69,45 +60,14 @@ import Distribution.Simple.Program.Run emptyProgramInvocation ) import Distribution.Types.UnitId ( UnitId ) +import Distribution.Client.ScriptUtils + ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) ) -import Distribution.Client.Types - ( PackageLocation(..), PackageSpecifier(..) ) -import Distribution.FieldGrammar - ( takeFields, parseFieldGrammar ) -import Distribution.PackageDescription.FieldGrammar - ( executableFieldGrammar ) -import Distribution.PackageDescription.PrettyPrint - ( writeGenericPackageDescription ) -import Distribution.Parsec - ( Position(..) ) -import Distribution.Fields - ( ParseResult, parseString, parseFatalFailure, readFields ) -import qualified Distribution.SPDX.License as SPDX -import Distribution.Solver.Types.SourcePackage as SP - ( SourcePackage(..) ) -import Distribution.Types.BuildInfo - ( BuildInfo(..) ) -import Distribution.Types.CondTree - ( CondTree(..) ) -import Distribution.Types.Executable - ( Executable(..) ) -import Distribution.Types.GenericPackageDescription as GPD - ( GenericPackageDescription(..), emptyGenericPackageDescription ) -import Distribution.Types.PackageDescription - ( PackageDescription(..), emptyPackageDescription ) -import Distribution.Types.PackageName.Magic - ( fakePackageId ) -import Language.Haskell.Extension - ( Language(..) ) - -import qualified Data.ByteString.Char8 as BS import qualified Data.Set as Set -import qualified Text.Parsec as P import System.Directory - ( getTemporaryDirectory, removeDirectoryRecursive, doesFileExist ) + ( doesFileExist ) import System.FilePath - ( (), isValid, isPathSeparator, takeExtension ) - + ( (), isValid, isPathSeparator ) runCommand :: CommandUI (NixStyleFlags ()) runCommand = CommandUI @@ -158,44 +118,17 @@ runCommand = CommandUI -- "Distribution.Client.ProjectOrchestration" -- runAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO () -runAction flags@NixStyleFlags {..} targetStrings globalFlags = do - globalTmp <- getTemporaryDirectory - tmpDir <- createTempDirectory globalTmp "cabal-repl." - - let - with = - establishProjectBaseContext verbosity cliConfig OtherCommand - without globalConfig = do - distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) tmpDir - establishDummyProjectBaseContext verbosity (globalConfig <> cliConfig) distDirLayout [] OtherCommand - - baseCtx <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with without - - let - scriptOrError script err = do - exists <- doesFileExist script - let pol | takeExtension script == ".lhs" = LiterateHaskell - | otherwise = PlainHaskell - if exists - then BS.readFile script >>= handleScriptCase verbosity pol baseCtx tmpDir - else reportTargetSelectorProblems verbosity err - - (baseCtx', targetSelectors) <- - readTargetSelectors (localPackages baseCtx) (Just ExeKind) (take 1 targetStrings) - >>= \case - Left err@(TargetSelectorNoTargetsInProject:_) - | (script:_) <- targetStrings -> scriptOrError script err - Left err@(TargetSelectorNoSuch t _:_) - | TargetString1 script <- t -> scriptOrError script err - Left err@(TargetSelectorExpected t _ _:_) - | TargetString1 script <- t -> scriptOrError script err - Left err -> reportTargetSelectorProblems verbosity err - Right sels -> return (baseCtx, sels) +runAction flags@NixStyleFlags {..} targetAndArgs globalFlags + = withContextAndSelectors RejectNoTargets (Just ExeKind) flags targetStr globalFlags $ \targetCtx ctx targetSelectors -> do + baseCtx <- case targetCtx of + ProjectContext -> return ctx + GlobalContext -> return ctx + ScriptContext path exemeta -> updateContextAndWriteProjectFile ctx path exemeta buildCtx <- - runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do + runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do - when (buildSettingOnlyDeps (buildSettings baseCtx')) $ + when (buildSettingOnlyDeps (buildSettings baseCtx)) $ die' verbosity $ "The run command does not support '--only-dependencies'. " ++ "You may wish to use 'build --only-dependencies' and then " @@ -237,10 +170,10 @@ runAction flags@NixStyleFlags {..} targetStrings globalFlags = do ++ "phase has been reached. This is a bug.") $ targetsMap buildCtx - printPlan verbosity baseCtx' buildCtx + printPlan verbosity baseCtx buildCtx - buildOutcomes <- runProjectBuildPhase verbosity baseCtx' buildCtx - runProjectPostBuildPhase verbosity baseCtx' buildCtx buildOutcomes + buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx + runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes let elaboratedPlan = elaboratedPlanToExecute buildCtx @@ -283,8 +216,7 @@ runAction flags@NixStyleFlags {..} targetStrings globalFlags = do pkg exeName exeName - let args = drop 1 targetStrings - dryRun = buildSettingDryRun (buildSettings baseCtx) + let dryRun = buildSettingDryRun (buildSettings baseCtx) || buildSettingOnlyDownload (buildSettings baseCtx) if dryRun @@ -299,13 +231,9 @@ runAction flags@NixStyleFlags {..} targetStrings globalFlags = do (distDirLayout baseCtx) elaboratedPlan } - - handleDoesNotExist () (removeDirectoryRecursive tmpDir) where verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - ignoreProject = flagIgnoreProject projectFlags - cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here - globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) + (targetStr, args) = splitAt 1 targetAndArgs -- | Used by the main CLI parser as heuristic to decide whether @cabal@ was -- invoked as a script interpreter, i.e. via @@ -333,120 +261,6 @@ handleShebang :: FilePath -> [String] -> IO () handleShebang script args = runAction (commandDefaultFlags runCommand) (script:args) defaultGlobalFlags -parseScriptBlock :: BS.ByteString -> ParseResult Executable -parseScriptBlock str = - case readFields str of - Right fs -> do - let (fields, _) = takeFields fs - parseFieldGrammar cabalSpecLatest fields (executableFieldGrammar "script") - Left perr -> parseFatalFailure pos (show perr) where - ppos = P.errorPos perr - pos = Position (P.sourceLine ppos) (P.sourceColumn ppos) - -readScriptBlock :: Verbosity -> BS.ByteString -> IO Executable -readScriptBlock verbosity = parseString parseScriptBlock verbosity "script block" - -readScriptBlockFromScript :: Verbosity -> PlainOrLiterate -> BS.ByteString -> IO (Executable, BS.ByteString) -readScriptBlockFromScript verbosity pol str = do - str' <- case extractScriptBlock pol 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" - (\x -> (x, noShebang)) <$> readScriptBlock verbosity str' - where - noShebang = BS.unlines . filter (not . BS.isPrefixOf "#!") . BS.lines $ str - --- | Extract the first encountered script metadata block started end --- terminated by the tokens --- --- * @{- cabal:@ --- --- * @-}@ --- --- appearing alone on lines (while tolerating trailing whitespace). --- These tokens are not part of the 'Right' result. --- --- In case of missing or unterminated blocks a 'Left'-error is --- returned. -extractScriptBlock :: PlainOrLiterate -> BS.ByteString -> Either String BS.ByteString -extractScriptBlock _pol str = goPre (BS.lines str) - where - isStartMarker = (== startMarker) . stripTrailSpace - isEndMarker = (== endMarker) . stripTrailSpace - - stripTrailSpace = fst . BS.spanEnd isSpace - - -- before start marker - goPre ls = case dropWhile (not . isStartMarker) ls of - [] -> Left $ "`" ++ BS.unpack startMarker ++ "` start marker not found" - (_:ls') -> goBody [] ls' - - goBody _ [] = Left $ "`" ++ BS.unpack endMarker ++ "` end marker not found" - goBody acc (l:ls) - | isEndMarker l = Right $! BS.unlines $ reverse acc - | otherwise = goBody (l:acc) ls - - startMarker, endMarker :: BS.ByteString - startMarker = fromString "{- cabal:" - endMarker = fromString "-}" - -data PlainOrLiterate - = PlainHaskell - | LiterateHaskell - -handleScriptCase - :: Verbosity - -> PlainOrLiterate - -> ProjectBaseContext - -> FilePath - -> BS.ByteString - -> IO (ProjectBaseContext, [TargetSelector]) -handleScriptCase verbosity pol baseCtx tmpDir scriptContents = do - (executable, contents') <- readScriptBlockFromScript verbosity pol scriptContents - - -- We need to create a dummy package that lives in our dummy project. - let - mainName = case pol of - PlainHaskell -> "Main.hs" - LiterateHaskell -> "Main.lhs" - - sourcePackage = SourcePackage - { srcpkgPackageId = pkgId - , srcpkgDescription = genericPackageDescription - , srcpkgSource = LocalUnpackedPackage tmpDir - , srcpkgDescrOverride = Nothing - } - genericPackageDescription = emptyGenericPackageDescription - { GPD.packageDescription = packageDescription - , condExecutables = [("script", CondNode executable' targetBuildDepends [])] - } - executable' = executable - { modulePath = mainName - , buildInfo = binfo - { defaultLanguage = - case defaultLanguage of - just@(Just _) -> just - Nothing -> Just Haskell2010 - } - } - binfo@BuildInfo{..} = buildInfo executable - packageDescription = emptyPackageDescription - { package = pkgId - , specVersion = CabalSpecV2_2 - , licenseRaw = Left SPDX.NONE - } - pkgId = fakePackageId - - writeGenericPackageDescription (tmpDir "fake-package.cabal") genericPackageDescription - BS.writeFile (tmpDir mainName) contents' - - let - baseCtx' = baseCtx - { localPackages = localPackages baseCtx ++ [SpecificSourcePackage sourcePackage] } - targetSelectors = [TargetPackage TargetExplicitNamed [pkgId] Nothing] - - return (baseCtx', targetSelectors) - singleExeOrElse :: IO (UnitId, UnqualComponentName) -> TargetsMap -> IO (UnitId, UnqualComponentName) singleExeOrElse action targetsMap = case Set.toList . distinctTargetComponents $ targetsMap diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs new file mode 100644 index 00000000000..61a3364c777 --- /dev/null +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -0,0 +1,346 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +-- | Utilities to help commands with scripts +-- +module Distribution.Client.ScriptUtils ( + getScriptCacheDirectoryRoot, getScriptHash, getScriptCacheDirectory, ensureScriptCacheDirectory, + withContextAndSelectors, AcceptNoTargets(..), TargetContext(..), + updateContextAndWriteProjectFile, updateContextAndWriteProjectFile', + fakeProjectSourcePackage, lSrcpkgDescription + ) where + +import Prelude () +import Distribution.Client.Compat.Prelude hiding (toList) + +import Distribution.Compat.Lens +import qualified Distribution.Types.Lens as L + +import Distribution.CabalSpecVersion + ( CabalSpecVersion (..), cabalSpecLatest) +import Distribution.Client.ProjectOrchestration +import Distribution.Client.Config + ( getCabalDir ) +import Distribution.Client.DistDirLayout + ( DistDirLayout(..) ) +import Distribution.Client.HashValue + ( hashValue, showHashValue ) +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..) ) +import Distribution.Client.ProjectConfig + ( ProjectConfig(..), ProjectConfigShared(..), withProjectOrGlobalConfig ) +import Distribution.Client.ProjectFlags + ( flagIgnoreProject ) +import Distribution.Client.Setup + ( ConfigFlags(..), GlobalFlags(..) ) +import Distribution.Client.TargetSelector + ( TargetSelectorProblem(..), TargetString(..) ) +import Distribution.Client.Types + ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage ) +import Distribution.FieldGrammar + ( parseFieldGrammar, takeFields ) +import Distribution.Fields + ( ParseResult, parseFatalFailure, parseString, readFields ) +import Distribution.PackageDescription.FieldGrammar + ( executableFieldGrammar ) +import Distribution.PackageDescription.PrettyPrint + ( showGenericPackageDescription, writeGenericPackageDescription ) +import Distribution.Parsec + ( Position(..) ) +import Distribution.Simple.Flag + ( fromFlagOrDefault ) +import Distribution.Simple.Setup + ( Flag(..) ) +import Distribution.Simple.Utils + ( createDirectoryIfMissingVerbose, createTempDirectory, die', handleDoesNotExist, readUTF8File, warn ) +import qualified Distribution.SPDX.License as SPDX +import Distribution.Solver.Types.SourcePackage as SP + ( SourcePackage(..) ) +import Distribution.Types.BuildInfo + ( BuildInfo(..) ) +import Distribution.Types.CondTree + ( CondTree(..) ) +import Distribution.Types.Executable + ( Executable(..) ) +import Distribution.Types.GenericPackageDescription as GPD + ( GenericPackageDescription(..), emptyGenericPackageDescription ) +import Distribution.Types.PackageDescription + ( PackageDescription(..), emptyPackageDescription ) +import Distribution.Types.PackageName.Magic + ( fakePackageCabalFileName, fakePackageId ) +import Distribution.Verbosity + ( normal ) +import Language.Haskell.Extension + ( Language(..) ) + +import Control.Concurrent.MVar + ( newEmptyMVar, putMVar, tryTakeMVar ) +import Control.Exception + ( bracket ) +import qualified Data.ByteString.Char8 as BS +import Data.ByteString.Lazy () +import System.Directory + ( canonicalizePath, doesFileExist, getTemporaryDirectory, removeDirectoryRecursive ) +import System.FilePath + ( () ) +import qualified Text.Parsec as P + +-- A note on multi-module script support #6787: +-- Multi-module scripts are not supported and support is non-trivial. +-- What you want to do is pass the absolute path to the script's directory in hs-source-dirs, +-- but hs-source-dirs only accepts relative paths. This leaves you with several options none +-- of which are particularly appealing. +-- 1) Loosen the requirement that hs-source-dirs take relative paths +-- 2) Add a field to BuildInfo that acts like an hs-source-dir, but accepts an absolute path +-- 3) Use a path relative to the project root in hs-source-dirs, and pass extra flags to the +-- repl to deal with the fact that the repl is relative to the working directory and not +-- the project root. + +-- | Get the directory where script builds are cached. +-- +-- @CABAL_DIR\/script-builds\/@ +getScriptCacheDirectoryRoot :: IO FilePath +getScriptCacheDirectoryRoot = do + cabalDir <- getCabalDir + return $ cabalDir "script-builds" + +-- | Get the hash of a script's absolute path) +-- +-- Two hashes will be the same as long as the absolute paths +-- are the same. +getScriptHash :: FilePath -> IO String +getScriptHash script = showHashValue . hashValue . fromString <$> canonicalizePath script + +-- | Get the directory for caching a script build. +-- +-- The only identity of a script is it's absolute path, so append the +-- hashed path to @CABAL_DIR\/script-builds\/@ to get the cache directory. +getScriptCacheDirectory :: FilePath -> IO FilePath +getScriptCacheDirectory script = () <$> getScriptCacheDirectoryRoot <*> getScriptHash script + +-- | Get the directory for caching a script build and ensure it exists. +-- +-- The only identity of a script is it's absolute path, so append the +-- hashed path to @CABAL_DIR\/script-builds\/@ to get the cache directory. +ensureScriptCacheDirectory :: Verbosity -> FilePath -> IO FilePath +ensureScriptCacheDirectory verbosity script = do + cacheDir <- getScriptCacheDirectory script + createDirectoryIfMissingVerbose verbosity True cacheDir + return cacheDir + +-- | What your command should do when no targets are found. +data AcceptNoTargets + = RejectNoTargets -- ^ die on 'TargetSelectorNoTargetsInProject' + | AcceptNoTargets -- ^ return a default 'TargetSelector' + deriving (Eq, Show) + +-- | Information about the context in which we found the 'TargetSelector's. +data TargetContext + = ProjectContext -- ^ The target selectors are part of a project. + | GlobalContext -- ^ The target selectors are from the global context. + | ScriptContext FilePath Executable + -- ^ The target selectors refer to a script. Contains the path to the script and + -- the executable metadata parsed from the script + deriving (Eq, Show) + +-- | Determine whether the targets represent regular targets or a script +-- and return the proper context and target selectors. +-- Die with an error message if selectors are valid as neither regular targets or as a script. +-- +-- In the case that the context refers to a temporary directory, +-- delete it after the action finishes. +withContextAndSelectors + :: AcceptNoTargets -- ^ What your command should do when no targets are found. + -> Maybe ComponentKind -- ^ A target filter + -> NixStyleFlags a -- ^ Command line flags + -> [String] -- ^ Target strings or a script and args. + -> GlobalFlags -- ^ Global flags. + -> (TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO b) + -- ^ The body of your command action. + -> IO b +withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings globalFlags act + = withTemporaryTempDirectory $ \mkTmpDir -> do + (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with (without mkTmpDir) + + -- In the case where a selector is both a valid target and script, assume it is a target, + -- because you can disambiguate the script with "./script" + (tc', ctx', sels) <- readTargetSelectors (localPackages ctx) kind targetStrings >>= \case + Left err@(TargetSelectorNoTargetsInProject:_) + | [] <- targetStrings + , AcceptNoTargets <- noTargets -> return (tc, ctx, defaultTarget) + | (script:_) <- targetStrings -> scriptOrError script err + Left err@(TargetSelectorNoSuch t _:_) + | TargetString1 script <- t -> scriptOrError script err + Left err@(TargetSelectorExpected t _ _:_) + | TargetString1 script <- t -> scriptOrError script err + Left err -> reportTargetSelectorProblems verbosity err + Right sels -> return (tc, ctx, sels) + + act tc' ctx' sels + where + verbosity = fromFlagOrDefault normal (configVerbosity configFlags) + ignoreProject = flagIgnoreProject projectFlags + cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty + globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) + defaultTarget = [TargetPackage TargetExplicitNamed [fakePackageId] Nothing] + + with = do + ctx <- establishProjectBaseContext verbosity cliConfig OtherCommand + return (ProjectContext, ctx) + without mkDir globalConfig = do + distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) =<< mkDir + ctx <- establishDummyProjectBaseContext verbosity (globalConfig <> cliConfig) distDirLayout [] OtherCommand + return (GlobalContext, ctx) + scriptOrError script err = do + exists <- doesFileExist script + if exists then do + -- In the script case we always want a dummy context even when ignoreProject is False + let mkCacheDir = ensureScriptCacheDirectory verbosity script + (_, ctx) <- withProjectOrGlobalConfig verbosity (Flag True) globalConfigFlag with (without mkCacheDir) + + let projectRoot = distProjectRootDirectory $ distDirLayout ctx + writeFile (projectRoot "scriptlocation") =<< canonicalizePath script + + executable <- readScriptBlockFromScript verbosity =<< BS.readFile script + + let executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just + return (ScriptContext script executable', ctx, defaultTarget) + else reportTargetSelectorProblems verbosity err + +withTemporaryTempDirectory :: (IO FilePath -> IO a) -> IO a +withTemporaryTempDirectory act = newEmptyMVar >>= \m -> bracket (getMkTmp m) (rmTmp m) act + where + -- We return an (IO Filepath) instead of a FilePath for two reasons: + -- 1) To give the consumer the discretion to not create the tmpDir, + -- but still grantee that it's deleted if they do create it + -- 2) Because the path returned by createTempDirectory is not predicable + getMkTmp m = return $ do + tmpDir <- getTemporaryDirectory >>= flip createTempDirectory "cabal-repl." + putMVar m tmpDir + return tmpDir + rmTmp m _ = tryTakeMVar m >>= maybe (return ()) (handleDoesNotExist () . removeDirectoryRecursive) + +-- | 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 + -- 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 + return (ctx & lLocalPackages %~ (++ [SpecificSourcePackage srcPkg])) + +-- | Add add the executable metadata to the context and write a .cabal file. +updateContextAndWriteProjectFile :: ProjectBaseContext -> FilePath -> Executable -> IO ProjectBaseContext +updateContextAndWriteProjectFile ctx scriptPath scriptExecutable = do + let projectRoot = distProjectRootDirectory $ distDirLayout ctx + + absScript <- canonicalizePath scriptPath + let + sourcePackage = fakeProjectSourcePackage projectRoot + & lSrcpkgDescription . L.condExecutables + .~ [("script", CondNode executable (targetBuildDepends $ buildInfo executable) [])] + executable = scriptExecutable + & L.modulePath .~ absScript + + updateContextAndWriteProjectFile' ctx sourcePackage + +parseScriptBlock :: BS.ByteString -> ParseResult Executable +parseScriptBlock str = + case readFields str of + Right fs -> do + let (fields, _) = takeFields fs + parseFieldGrammar cabalSpecLatest fields (executableFieldGrammar "script") + Left perr -> parseFatalFailure pos (show perr) where + ppos = P.errorPos perr + pos = Position (P.sourceLine ppos) (P.sourceColumn ppos) + +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. +-- +-- * @{- cabal:@ +-- +-- * @-}@ +-- +-- Return the metadata. +readScriptBlockFromScript :: Verbosity -> BS.ByteString -> IO Executable +readScriptBlockFromScript verbosity str = do + str' <- case extractScriptBlock 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 script metadata block started end +-- terminated by the tokens +-- +-- * @{- cabal:@ +-- +-- * @-}@ +-- +-- appearing alone on lines (while tolerating trailing whitespace). +-- These tokens are not part of the 'Right' result. +-- +-- 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) + where + isStartMarker = (== startMarker) . stripTrailSpace + isEndMarker = (== endMarker) . stripTrailSpace + + stripTrailSpace = fst . BS.spanEnd isSpace + + -- before start marker + goPre ls = case dropWhile (not . isStartMarker) ls of + [] -> Left $ "`" ++ BS.unpack startMarker ++ "` start marker not found" + (_:ls') -> goBody [] ls' + + goBody _ [] = Left $ "`" ++ BS.unpack endMarker ++ "` end marker not found" + goBody acc (l:ls) + | isEndMarker l = Right $! BS.unlines $ reverse acc + | otherwise = goBody (l:acc) ls + + startMarker, endMarker :: BS.ByteString + startMarker = fromString "{- cabal:" + endMarker = fromString "-}" + +-- | The base for making a 'SourcePackage' for a fake project. +-- It needs a 'Distribution.Types.Library.Library' or 'Executable' depending on the command. +fakeProjectSourcePackage :: FilePath -> SourcePackage (PackageLocation loc) +fakeProjectSourcePackage projectRoot = sourcePackage + where + sourcePackage = SourcePackage + { srcpkgPackageId = fakePackageId + , srcpkgDescription = genericPackageDescription + , srcpkgSource = LocalUnpackedPackage projectRoot + , srcpkgDescrOverride = Nothing + } + genericPackageDescription = emptyGenericPackageDescription + { GPD.packageDescription = packageDescription } + packageDescription = emptyPackageDescription + { package = fakePackageId + , specVersion = CabalSpecV2_2 + , licenseRaw = Left SPDX.NONE + } + +-- Lenses +-- | A lens for the 'srcpkgDescription' field of 'SourcePackage' +lSrcpkgDescription :: Lens' (SourcePackage loc) GenericPackageDescription +lSrcpkgDescription f s = fmap (\x -> s { srcpkgDescription = x }) (f (srcpkgDescription s)) +{-# inline lSrcpkgDescription #-} + +lLocalPackages :: Lens' ProjectBaseContext [PackageSpecifier UnresolvedSourcePackage] +lLocalPackages f s = fmap (\x -> s { localPackages = x }) (f (localPackages s)) +{-# inline lLocalPackages #-} diff --git a/cabal-install/src/Distribution/Client/Utils.hs b/cabal-install/src/Distribution/Client/Utils.hs index c3c3031d7d3..e4296bf09ef 100644 --- a/cabal-install/src/Distribution/Client/Utils.hs +++ b/cabal-install/src/Distribution/Client/Utils.hs @@ -237,9 +237,10 @@ makeRelativeCanonical path dir | takeDrive path /= takeDrive dir = path | otherwise = go (splitPath path) (splitPath dir) where - go (p:ps) (d:ds) | p == d = go ps ds - go [] [] = "./" - go ps ds = joinPath (replicate (length ds) ".." ++ ps) + go (p:ps) (d:ds) | p' == d' = go ps ds + where (p', d') = (dropTrailingPathSeparator p, dropTrailingPathSeparator d) + go [] [] = "./" + go ps ds = joinPath (replicate (length ds) ".." ++ ps) -- | Convert a 'FilePath' to a lazy 'ByteString'. Each 'Char' is -- encoded as a little-endian 'Word32'. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out new file mode 100644 index 00000000000..732deece540 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out @@ -0,0 +1,8 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.test.hs new file mode 100644 index 00000000000..db31636dc42 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.test.hs @@ -0,0 +1,10 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabal' "v2-build" ["script.hs"] + + env <- getTestEnv + cacheDir <- getScriptCacheDirectory $ testCurrentDir env "script.hs" + + shouldExist $ cacheDir "fake-package.cabal" + shouldExist $ cacheDir "scriptlocation" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out new file mode 100644 index 00000000000..84e095157e1 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out @@ -0,0 +1,13 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-repl +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (ephemeral targets) +Preprocessing executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs new file mode 100644 index 00000000000..9c0f021da5d --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabal' "v2-build" ["script.hs"] + cabalWithStdin "v2-repl" ["script.hs"] "" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out new file mode 100644 index 00000000000..238ec82dc8a --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out @@ -0,0 +1,10 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-run +Up to date diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs new file mode 100644 index 00000000000..e46b56d4afd --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabal' "v2-build" ["script.hs"] + cabal' "v2-run" ["script.hs"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out new file mode 100644 index 00000000000..a3a2453901c --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out @@ -0,0 +1,10 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-build +Up to date diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.test.hs new file mode 100644 index 00000000000..18c1becba42 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabal' "v2-build" ["script.hs"] + cabal' "v2-build" ["script.hs"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/cabal.out new file mode 100644 index 00000000000..72b3832a636 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/cabal.out @@ -0,0 +1,2 @@ +# cabal v2-clean +# cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/cabal.test.hs new file mode 100644 index 00000000000..79dbb04e549 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabal' "v2-clean" [] + cabal' "v2-clean" ["script.hs"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/CleanScriptWithNoScriptsBuilt/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out new file mode 100644 index 00000000000..4d11e547d3e --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out @@ -0,0 +1,17 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (configuration changed) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.test.hs new file mode 100644 index 00000000000..8063d229034 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.test.hs @@ -0,0 +1,18 @@ +import Test.Cabal.Prelude +import System.Directory (copyFile, removeFile) + +main = cabalTest . void $ do + env <- getTestEnv + let td = testCurrentDir env + + cabal' "v2-build" ["script.hs"] + liftIO $ copyFile (td "script.hs") (td "script2.hs") + cabal' "v2-build" ["script2.hs"] + liftIO $ removeFile (td "script2.hs") + cabal' "v2-clean" [] + + cacheDir <- getScriptCacheDirectory (td "script.hs") + cacheDir2 <- getScriptCacheDirectory (td "script2.hs") + + shouldDirectoryExist cacheDir + shouldDirectoryNotExist cacheDir2 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out new file mode 100644 index 00000000000..4d11e547d3e --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out @@ -0,0 +1,17 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (configuration changed) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.test.hs new file mode 100644 index 00000000000..39ba5185e94 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.test.hs @@ -0,0 +1,18 @@ +import Test.Cabal.Prelude +import System.Directory (copyFile, removeFile) + +main = cabalTest . void $ do + env <- getTestEnv + let td = testCurrentDir env + + cabal' "v2-build" ["script.hs"] + liftIO $ copyFile (td "script.hs") (td "script2.hs") + cabal' "v2-build" ["script2.hs"] + liftIO $ removeFile (td "script2.hs") + cabal' "v2-clean" ["script.hs"] + + cacheDir <- getScriptCacheDirectory (td "script.hs") + cacheDir2 <- getScriptCacheDirectory (td "script2.hs") + + shouldDirectoryNotExist cacheDir + shouldDirectoryNotExist cacheDir2 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out new file mode 100644 index 00000000000..7fe551a7e71 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out @@ -0,0 +1,9 @@ +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.test.hs new file mode 100644 index 00000000000..d3870ce1520 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.test.hs @@ -0,0 +1,11 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabal' "v2-build" ["script.hs"] + cabal' "v2-clean" ["script.hs"] + + env <- getTestEnv + cacheDir <- getScriptCacheDirectory (testCurrentDir env "script.hs") + + shouldDirectoryNotExist cacheDir + shouldDirectoryNotExist (testDistDir env) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out new file mode 100644 index 00000000000..09411fe70a7 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out @@ -0,0 +1,7 @@ +# cabal v2-repl +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.test.hs new file mode 100644 index 00000000000..f453256b186 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.test.hs @@ -0,0 +1,11 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + res <- cabalWithStdin "v2-repl" ["script.hs"] ":main" + assertOutputContains "Hello World" res + + env <- getTestEnv + cacheDir <- getScriptCacheDirectory $ testCurrentDir env "script.hs" + + shouldExist $ cacheDir "fake-package.cabal" + shouldExist $ cacheDir "scriptlocation" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out new file mode 100644 index 00000000000..7df4356db59 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out @@ -0,0 +1,12 @@ +# cabal v2-repl +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +# cabal v2-repl +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Preprocessing executable 'script' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.test.hs new file mode 100644 index 00000000000..4167c48b5ec --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabalWithStdin "v2-repl" ["script.hs"] "" + cabalWithStdin "v2-repl" ["script.hs"] "" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs new file mode 100644 index 00000000000..73566f6f203 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/Main.hs @@ -0,0 +1 @@ +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal new file mode 100644 index 00000000000..22a27144592 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/RunMainBad.cabal @@ -0,0 +1,9 @@ +name: RunMainBad +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 + +executable foo + main-is: Main.hs + build-depends: base + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out new file mode 100644 index 00000000000..b5da78510a4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.out @@ -0,0 +1,3 @@ +# cabal v2-run +Resolving dependencies... +Error: cabal: The run command can only run an executable as a whole, not files or modules within them, but the target 'Main.hs' refers to the file Main.hs in the executable foo. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs new file mode 100644 index 00000000000..88370b0fae4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/RunMainBad/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + void . fails $ cabal' "v2-run" ["./Main.hs"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs index ee9110853e8..045c88117d7 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.test.hs @@ -3,3 +3,9 @@ import Test.Cabal.Prelude main = cabalTest $ do res <- cabal' "v2-run" ["script.hs"] assertOutputContains "Hello World" res + + env <- getTestEnv + cacheDir <- getScriptCacheDirectory (testCurrentDir env "script.hs") + + shouldExist $ cacheDir "fake-package.cabal" + shouldExist $ cacheDir "scriptlocation" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out new file mode 100644 index 00000000000..a86629db957 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.out @@ -0,0 +1,2 @@ +# cabal v2-run +Error: cabal: Failed extracting script block: `{- cabal:` start marker not found diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.project b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.test.hs new file mode 100644 index 00000000000..f1a7e4780d1 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/cabal.test.hs @@ -0,0 +1,4 @@ +import Test.Cabal.Prelude + +main = cabalTest $ do + void . fails $ cabal' "v2-run" ["script.hs"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/script.cabal b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/script.cabal new file mode 100644 index 00000000000..56b2e9feb60 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/script.cabal @@ -0,0 +1,4 @@ +name: script +version: 1.0 +build-type: Simple +cabal-version: >= 1.10 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/script.hs new file mode 100644 index 00000000000..d2c47303a4f --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/script.hs @@ -0,0 +1,9 @@ +#! /usr/bin/env cabal +{- +build-depends: base >= 4.3 && <5 +-} + +import Prelude + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out new file mode 100644 index 00000000000..65fdda7f736 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out @@ -0,0 +1,10 @@ +# cabal v2-run +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - fake-package-0 (exe:script) (first run) +Configuring executable 'script' for fake-package-0.. +Preprocessing executable 'script' for fake-package-0.. +Building executable 'script' for fake-package-0.. +# cabal v2-run +Up to date diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.test.hs new file mode 100644 index 00000000000..7df7f1451bc --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.test.hs @@ -0,0 +1,5 @@ +import Test.Cabal.Prelude + +main = cabalTest . void $ do + cabal' "v2-run" ["script.hs"] + cabal' "v2-run" ["script.hs"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/script.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/script.hs new file mode 100644 index 00000000000..cd2fae4e8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/script.hs @@ -0,0 +1,6 @@ +{- cabal: +build-depends: base +-} + +main :: IO () +main = putStrLn "Hello World" diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index baab736e852..18715f3e315 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -52,6 +52,8 @@ import qualified Data.ByteString.Lazy as BSL import Control.Monad (unless, when, void, forM_, liftM2, liftM4) import Control.Monad.Trans.Reader (withReaderT, runReaderT) import Control.Monad.IO.Class (MonadIO (..)) +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as C import Data.List (isInfixOf, stripPrefix, isPrefixOf, intercalate) import Data.List.NonEmpty (NonEmpty (..)) @@ -61,7 +63,7 @@ import System.Exit (ExitCode (..)) import System.FilePath ((), takeExtensions, takeDrive, takeDirectory, normalise, splitPath, joinPath, splitFileName, (<.>), dropTrailingPathSeparator) import Control.Concurrent (threadDelay) import qualified Data.Char as Char -import System.Directory (getTemporaryDirectory, getCurrentDirectory, copyFile, removeFile, copyFile, doesFileExist, createDirectoryIfMissing, getDirectoryContents) +import System.Directory (getTemporaryDirectory, getCurrentDirectory, canonicalizePath, copyFile, removeFile, copyFile, doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getDirectoryContents) #ifndef mingw32_HOST_OS import Control.Monad.Catch ( bracket_ ) @@ -292,6 +294,10 @@ cabalGArgs global_args cmd args input = do | cmd == "v2-sdist" = [ "--project-file", testCabalProjectFile env ] + | cmd == "v2-clean" + = [ "--builddir", testDistDir env + , "--project-file", testCabalProjectFile env ] + | "v2-" `isPrefixOf` cmd = [ "--builddir", testDistDir env , "--project-file", testCabalProjectFile env @@ -666,6 +672,16 @@ shouldNotExist path = withFrozenCallStack $ liftIO $ doesFileExist path >>= assertBool (path ++ " should exist") . not +shouldDirectoryExist :: MonadIO m => WithCallStack (FilePath -> m ()) +shouldDirectoryExist path = + withFrozenCallStack $ + liftIO $ doesDirectoryExist path >>= assertBool (path ++ " should exist") + +shouldDirectoryNotExist :: MonadIO m => WithCallStack (FilePath -> m ()) +shouldDirectoryNotExist path = + withFrozenCallStack $ + liftIO $ doesDirectoryExist path >>= assertBool (path ++ " should exist") . not + assertRegex :: MonadIO m => String -> String -> Result -> m () assertRegex msg regex r = withFrozenCallStack $ @@ -735,6 +751,14 @@ assertFileDoesNotContain path needle = concatOutput :: String -> String concatOutput = unwords . lines . filter ((/=) '\r') +-- | The directory where script build artifacts are expected to be cached +getScriptCacheDirectory :: FilePath -> TestM FilePath +getScriptCacheDirectory script = do + cabalDir <- testCabalDir `fmap` getTestEnv + hashinput <- liftIO $ canonicalizePath script + let hash = C.unpack . Base16.encode . SHA256.hash . C.pack $ hashinput + return $ cabalDir "script-builds" hash + ------------------------------------------------------------------------ -- * Skipping tests diff --git a/changelog.d/pr-7851 b/changelog.d/pr-7851 new file mode 100644 index 00000000000..c68a91c021b --- /dev/null +++ b/changelog.d/pr-7851 @@ -0,0 +1,15 @@ +synopsis: Better support for scripts +packages: cabal-install +prs: #7851 +issues: #7842 #6354 #6149. + +description: { + +- Script support improved or added across relevant commands. +- `cabal run script` will now cache results and will not do a fresh build every time. +- `cabal build script` added. It will build the cache for script. +- `cabal repl script` added. It will open a repl for script using the cache if available. +- `cabal clean script` added. It will clean the cache for script. +- `cabal clean` will now remove script caches for which there is no marching script. + +} diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 250a2bfa04e..11c080a1a42 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -236,6 +236,10 @@ A cabal command target can take any of the following forms: - A filepath target: ``[package:][ctype:]filepath``, which specifies that the component of which the given filepath is a part of will be built. +- A script target: ``path/to/script``, which specifies the path to a script + file. This is supported by ``build``, ``repl``, ``run``, and ``clean``. + Script targets are not part of a package. + cabal v2-build --------------- @@ -262,6 +266,7 @@ Some example targets: # "app/Main.hs" $ cabal v2-build Lib # build the library component to # which the module "Lib" belongs + $ cabal v2-build path/to/script # build the script as an executable Beyond a list of targets, ``cabal v2-build`` accepts all the flags that ``cabal v2-configure`` takes. Most of these flags are only taken into @@ -270,6 +275,9 @@ cause extra store packages to be built (for example, ``--enable-profiling`` will automatically make sure profiling libraries for all transitive dependencies are built and installed.) +When building a script, the executable is cached under the cabal directory. +See ``cabal v2-run`` for more information on scripts. + In addition ``cabal v2-build`` accepts these flags: - ``--only-configure``: When given we will forego performing a full build and @@ -323,6 +331,16 @@ cannot be excluded for technical reasons). $ cabal v2-repl --build-depends vector --no-transitive-deps +``v2-repl`` can open scripts by passing the path to the script as the target. + +:: + + $ cabal v2-repl path/to/script + +The configuration information for the script is cached under the cabal directory +and can be pre-built with ``cabal v2-build path/to/script``. +See ``cabal v2-run`` for more information on scripts. + cabal v2-run ------------- @@ -377,8 +395,16 @@ interpreter, or through this command: :: - $ cabal v2-run script.hs - $ cabal v2-run script.hs -- --arg1 # args are passed like this + $ 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 +``cabal v2-clean path/to/script``. + +A note on targets: Whenever a command takes a script target and it matches the +name of another target, the other target is preferred. To load the script +instead pass it as an explicit path: ./script cabal v2-freeze ---------------- @@ -543,6 +569,12 @@ and caches if the ``--save-config`` option is given, in which case it only remov the build artefacts (``.hi``, ``.o`` along with any other temporary files generated by the compiler, along with the build output). +``cabal v2-clean [FLAGS] path/to/script`` cleans up the temporary files and build +artifacts for the script, which are stored under the .cabal/script-builds directory. + +In addition when clean is invoked it will remove all script build artifacts for +which the corresponding script no longer exists. + cabal v2-sdist ---------------