diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 5d11072b354..93f465e5074 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -1385,7 +1385,7 @@ checkGhcOptions fieldName getOptions pkg = , checkFlags ["-prof"] $ PackageBuildWarning (OptProf fieldName) - , checkFlags ["-o"] $ + , unlessScript . checkFlags ["-o"] $ PackageBuildWarning (OptO fieldName) , checkFlags ["-hide-package"] $ @@ -1478,6 +1478,10 @@ checkGhcOptions fieldName getOptions pkg = checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck checkFlags flags = check (any (`elem` flags) all_ghc_options) + unlessScript :: Maybe PackageCheck -> Maybe PackageCheck + unlessScript pc | packageId pkg == fakePackageId = Nothing + | otherwise = pc + checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck checkTestAndBenchmarkFlags flags = check (any (`elem` flags) test_and_benchmark_ghc_options) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index fed9aad89cd..472a6e867d8 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -204,6 +204,7 @@ library async >= 2.0 && < 2.3, array >= 0.4 && < 0.6, base16-bytestring >= 0.1.1 && < 1.1.0.0, + base64-bytestring >= 1.0 && < 1.3, binary >= 0.7.3 && < 0.9, bytestring >= 0.10.6.0 && < 0.12, containers >= 0.5.6.2 && < 0.7, diff --git a/cabal-install/src/Distribution/Client/CmdListBin.hs b/cabal-install/src/Distribution/Client/CmdListBin.hs index 27674300849..8993e18e2de 100644 --- a/cabal-install/src/Distribution/Client/CmdListBin.hs +++ b/cabal-install/src/Distribution/Client/CmdListBin.hs @@ -28,7 +28,9 @@ import Distribution.Client.NixStyleOptions import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ScriptUtils - (AcceptNoTargets(..), TargetContext(..), updateContextAndWriteProjectFile, withContextAndSelectors) + ( AcceptNoTargets(..), TargetContext(..) + , updateContextAndWriteProjectFile, withContextAndSelectors + , movedExePath ) import Distribution.Client.Setup (GlobalFlags (..)) import Distribution.Client.TargetProblem (TargetProblem (..)) import Distribution.Simple.BuildPaths (dllExtension, exeExtension) @@ -170,7 +172,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do bin_file c = case c of CD.ComponentExe s - | s == selectedComponent -> [bin_file' s] + | s == selectedComponent -> [moved_bin_file s] CD.ComponentTest s | s == selectedComponent -> [bin_file' s] CD.ComponentBench s @@ -194,6 +196,8 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do then dist_dir "build" prettyShow s ("lib" ++ prettyShow s) <.> dllExtension plat else InstallDirs.bindir (elabInstallDirs elab) ("lib" ++ prettyShow s) <.> dllExtension plat + moved_bin_file s = fromMaybe (bin_file' s) (movedExePath selectedComponent distDirLayout elaboratedSharedConfig elab) + ------------------------------------------------------------------------------- -- Target Problem: the very similar to CmdRun ------------------------------------------------------------------------------- diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs index 64241fd8bbc..5d60decceb0 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -22,22 +22,15 @@ module Distribution.Client.CmdRun ( import Prelude () import Distribution.Client.Compat.Prelude hiding (toList) -import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages ( renderTargetSelector, showTargetSelector, renderTargetProblem, renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs, targetSelectorFilter, renderListCommaAnd, renderListPretty ) -import Distribution.Client.TargetProblem - ( TargetProblem (..) ) - -import Distribution.Client.NixStyleOptions - ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) -import Distribution.Client.Setup - ( GlobalFlags(..), ConfigFlags(..) ) import Distribution.Client.GlobalFlags ( defaultGlobalFlags ) +<<<<<<< HEAD import Distribution.Simple.Flag ( fromFlagOrDefault ) import Distribution.Simple.Command @@ -48,25 +41,58 @@ import Distribution.Verbosity ( normal, silent ) import Distribution.Simple.Utils ( wrapText, die', info, notice, safeHead ) +======= +import Distribution.Client.InstallPlan + ( toList, foldPlanPackage ) +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) +import Distribution.Client.ProjectOrchestration +>>>>>>> a482a63c1 (Shorten script-builds paths (#8898)) import Distribution.Client.ProjectPlanning ( ElaboratedConfiguredPackage(..) , ElaboratedInstallPlan, binDirectoryFor ) import Distribution.Client.ProjectPlanning.Types ( dataDirsEnvironmentForPlan ) -import Distribution.Client.InstallPlan - ( toList, foldPlanPackage ) -import Distribution.Types.UnqualComponentName - ( UnqualComponentName, unUnqualComponentName ) +import Distribution.Client.ScriptUtils + ( AcceptNoTargets(..), TargetContext(..) + , updateContextAndWriteProjectFile, withContextAndSelectors + , movedExePath ) +import Distribution.Client.Setup + ( GlobalFlags(..), ConfigFlags(..) ) +import Distribution.Client.TargetProblem + ( TargetProblem (..) ) +import Distribution.Client.Utils + ( occursOnlyOrBefore, giveRTSWarning ) +import Distribution.Simple.Command + ( CommandUI(..), usageAlternatives ) +import Distribution.Simple.Flag + ( fromFlagOrDefault ) import Distribution.Simple.Program.Run ( runProgramInvocation, ProgramInvocation(..), emptyProgramInvocation ) +import Distribution.Simple.Utils + ( wrapText, die', info, notice, safeHead, warn ) +import Distribution.Types.ComponentName + ( componentNameRaw ) import Distribution.Types.UnitId ( UnitId ) +<<<<<<< HEAD import Distribution.Client.ScriptUtils ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) ) +======= +import Distribution.Types.UnqualComponentName + ( UnqualComponentName, unUnqualComponentName ) +import Distribution.Verbosity + ( normal, silent ) +>>>>>>> a482a63c1 (Shorten script-builds paths (#8898)) import Data.List (group) import qualified Data.Set as Set +<<<<<<< HEAD +======= +import GHC.Environment + ( getFullArgs ) +>>>>>>> a482a63c1 (Shorten script-builds paths (#8898)) import System.Directory ( doesFileExist ) import System.FilePath @@ -216,11 +242,15 @@ runAction flags@NixStyleFlags {..} targetAndArgs globalFlags ++ exeName ++ ":\n" ++ unlines (fmap (\p -> " - in package " ++ prettyShow (elabUnitId p)) elabPkgs) - let exePath = binDirectoryFor (distDirLayout baseCtx) - (elaboratedShared buildCtx) - pkg - exeName - exeName + + let defaultExePath = binDirectoryFor + (distDirLayout baseCtx) + (elaboratedShared buildCtx) + pkg + exeName + exeName + exePath = fromMaybe defaultExePath (movedExePath selectedComponent (distDirLayout baseCtx) (elaboratedShared buildCtx) pkg) + let dryRun = buildSettingDryRun (buildSettings baseCtx) || buildSettingOnlyDownload (buildSettings baseCtx) diff --git a/cabal-install/src/Distribution/Client/HashValue.hs b/cabal-install/src/Distribution/Client/HashValue.hs index 67117b231cc..86281a309ff 100644 --- a/cabal-install/src/Distribution/Client/HashValue.hs +++ b/cabal-install/src/Distribution/Client/HashValue.hs @@ -6,6 +6,7 @@ module Distribution.Client.HashValue ( hashValue, truncateHash, showHashValue, + showHashValueBase64, readFileHashValue, hashFromTUF, ) where @@ -17,6 +18,7 @@ import qualified Hackage.Security.Client as Sec import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS @@ -55,6 +57,9 @@ hashValue = HashValue . SHA256.hashlazy showHashValue :: HashValue -> String showHashValue (HashValue digest) = BS.unpack (Base16.encode digest) +showHashValueBase64 :: HashValue -> String +showHashValueBase64 (HashValue digest) = BS.unpack (Base64.encode digest) + -- | Hash the content of a file. Uses SHA256. -- readFileHashValue :: FilePath -> IO HashValue diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 83184d5902c..e4412c5a7a1 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -31,6 +31,7 @@ module Distribution.Client.ProjectConfig ( readProjectLocalFreezeConfig, reportParseResult, showProjectConfig, + withGlobalConfig, withProjectOrGlobalConfig, writeProjectLocalExtraConfig, writeProjectLocalFreezeConfig, @@ -462,6 +463,27 @@ renderBadProjectRoot :: BadProjectRoot -> String renderBadProjectRoot (BadProjectRootExplicitFile projectFile) = "The given project file '" ++ projectFile ++ "' does not exist." +<<<<<<< HEAD +======= + BadProjectRootDir dir -> + "The given project directory '" <> dir <> "' does not exist." + + BadProjectRootAbsoluteFile file -> + "The given project file '" <> file <> "' does not exist." + + BadProjectRootDirFile dir file -> + "The given project directory/file combination '" <> dir file <> "' does not exist." + +withGlobalConfig + :: Verbosity -- ^ verbosity + -> Flag FilePath -- ^ @--cabal-config@ + -> (ProjectConfig -> IO a) -- ^ with global + -> IO a +withGlobalConfig verbosity gcf with = do + globalConfig <- runRebuild "" $ readGlobalConfig verbosity gcf + with globalConfig + +>>>>>>> a482a63c1 (Shorten script-builds paths (#8898)) withProjectOrGlobalConfig :: Verbosity -- ^ verbosity -> Flag Bool -- ^ whether to ignore local project (--ignore-project flag) diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index db377c8f10a..ce64c8a5ef6 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -9,7 +9,8 @@ module Distribution.Client.ScriptUtils ( getScriptHash, getScriptCacheDirectory, ensureScriptCacheDirectory, withContextAndSelectors, AcceptNoTargets(..), TargetContext(..), updateContextAndWriteProjectFile, updateContextAndWriteProjectFile', - fakeProjectSourcePackage, lSrcpkgDescription + fakeProjectSourcePackage, lSrcpkgDescription, + movedExePath ) where import Prelude () @@ -24,22 +25,24 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.Config ( defaultScriptBuildsDir ) import Distribution.Client.DistDirLayout - ( DistDirLayout(..) ) + ( DistDirLayout(..), DistDirParams(..) ) import Distribution.Client.HashValue - ( hashValue, showHashValue ) + ( hashValue, showHashValueBase64 ) import Distribution.Client.HttpUtils ( HttpTransport, configureTransport ) import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) ) import Distribution.Client.ProjectConfig - ( ProjectConfig(..), ProjectConfigShared(..) - , reportParseResult, withProjectOrGlobalConfig + ( ProjectConfig(..), ProjectConfigShared(..), PackageConfig(..) + , reportParseResult, withGlobalConfig, withProjectOrGlobalConfig , projectConfigHttpTransport ) import Distribution.Client.ProjectConfig.Legacy ( ProjectConfigSkeleton , parseProjectSkeleton, instantiateProjectConfigSkeletonFetchingCompiler ) import Distribution.Client.ProjectFlags ( flagIgnoreProject ) +import Distribution.Client.ProjectPlanning + ( ElaboratedSharedConfig(..), ElaboratedConfiguredPackage(..) ) import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.Setup @@ -48,6 +51,8 @@ import Distribution.Client.TargetSelector ( TargetSelectorProblem(..), TargetString(..) ) import Distribution.Client.Types ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage ) +import Distribution.Compiler + ( CompilerId(..), perCompilerFlavorToList ) import Distribution.FieldGrammar ( parseFieldGrammar, takeFields ) import Distribution.Fields @@ -67,7 +72,7 @@ import Distribution.Simple.PackageDescription import Distribution.Simple.Setup ( Flag(..) ) import Distribution.Simple.Compiler - ( compilerInfo ) + ( Compiler(..), OptimisationLevel(..), compilerInfo ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, createTempDirectory, die', handleDoesNotExist, readUTF8File, warn, writeUTF8File ) import qualified Distribution.SPDX.License as SPDX @@ -77,6 +82,8 @@ import Distribution.System ( Platform(..) ) import Distribution.Types.BuildInfo ( BuildInfo(..) ) +import Distribution.Types.ComponentId + ( mkComponentId ) import Distribution.Types.CondTree ( CondTree(..) ) import Distribution.Types.Executable @@ -87,6 +94,10 @@ import Distribution.Types.PackageDescription ( PackageDescription(..), emptyPackageDescription ) import Distribution.Types.PackageName.Magic ( fakePackageCabalFileName, fakePackageId ) +import Distribution.Types.UnitId + ( newSimpleUnitId ) +import Distribution.Types.UnqualComponentName + ( UnqualComponentName ) import Distribution.Utils.NubList ( fromNubList ) import Distribution.Client.ProjectPlanning @@ -106,7 +117,7 @@ import qualified Data.Set as S import System.Directory ( canonicalizePath, doesFileExist, getTemporaryDirectory, removeDirectoryRecursive ) import System.FilePath - ( (), takeFileName ) + ( (), makeRelative, takeDirectory, takeFileName ) import qualified Text.Parsec as P -- A note on multi-module script support #6787: @@ -125,7 +136,12 @@ import qualified Text.Parsec as P -- 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 +getScriptHash script + -- Base64 is shorter than Base16, which helps avoid long path issues on windows + -- but it can contain /'s which aren't valid in file paths so replace them with + -- %'s. 26 chars / 130 bits is enough to practically avoid collisions. + = map (\c -> if c == '/' then '%' else c) . take 26 + . showHashValueBase64 . hashValue . fromString <$> canonicalizePath script -- | Get the directory for caching a script build. -- @@ -177,7 +193,7 @@ withContextAndSelectors -> IO b withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings globalFlags cmd act = withTemporaryTempDirectory $ \mkTmpDir -> do - (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with (without mkTmpDir) + (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject (withoutProject mkTmpDir) (tc', ctx', sels) <- case targetStrings of -- Only script targets may contain spaces and or end with ':'. @@ -209,19 +225,25 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings gl globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) defaultTarget = [TargetPackage TargetExplicitNamed [fakePackageId] Nothing] - with = do + withProject = do ctx <- establishProjectBaseContext verbosity cliConfig cmd return (ProjectContext, ctx) - without mkDir globalConfig = do - distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) =<< mkDir + withoutProject mkTmpDir globalConfig = do + distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) =<< mkTmpDir ctx <- establishDummyProjectBaseContext verbosity (globalConfig <> cliConfig) distDirLayout [] cmd return (GlobalContext, ctx) + + scriptBaseCtx script globalConfig = do + let noDistDir = mempty { projectConfigShared = mempty { projectConfigDistDir = Flag "" } } + let cfg = noDistDir <> globalConfig <> cliConfig + rootDir <- ensureScriptCacheDirectory verbosity script + distDirLayout <- establishDummyDistDirLayout verbosity cfg rootDir + establishDummyProjectBaseContext verbosity cfg distDirLayout [] cmd + 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) + ctx <- withGlobalConfig verbosity globalConfigFlag (scriptBaseCtx script) let projectRoot = distProjectRootDirectory $ distDirLayout ctx writeFile (projectRoot "scriptlocation") =<< canonicalizePath script @@ -236,14 +258,22 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings gl projectCfgSkeleton <- readProjectBlockFromScript verbosity httpTransport (distDirLayout ctx) (takeFileName script) scriptContents - let fetchCompiler = do - (compiler, Platform arch os, _) <- runRebuild (distProjectRootDirectory . distDirLayout $ ctx) $ configureCompiler verbosity (distDirLayout ctx) ((fst $ ignoreConditions projectCfgSkeleton) <> projectConfig ctx) - pure (os, arch, compilerInfo compiler) + createDirectoryIfMissingVerbose verbosity True (distProjectCacheDirectory $ distDirLayout ctx) + (compiler, platform@(Platform arch os), _) <- runRebuild projectRoot $ configureCompiler verbosity (distDirLayout ctx) (fst (ignoreConditions projectCfgSkeleton) <> projectConfig ctx) + + projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler (pure (os, arch, compilerInfo compiler)) mempty projectCfgSkeleton + + let ctx' = ctx & lProjectConfig %~ (<> projectCfg) - projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectCfgSkeleton + build_dir = distBuildDirectory (distDirLayout ctx') $ (scriptDistDirParams script) ctx' compiler platform + exePath = build_dir "bin" scriptExeFileName script + exePathRel = makeRelative projectRoot exePath + + executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just + & L.buildInfo . L.options %~ fmap (setExePath exePathRel) + + createDirectoryIfMissingVerbose verbosity True (takeDirectory exePath) - let executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just - ctx' = ctx & lProjectConfig %~ (<> projectCfg) return (ScriptContext script executable', ctx', defaultTarget) else reportTargetSelectorProblems verbosity err @@ -260,6 +290,36 @@ withTemporaryTempDirectory act = newEmptyMVar >>= \m -> bracket (getMkTmp m) (rm return tmpDir rmTmp m _ = tryTakeMVar m >>= maybe (return ()) (handleDoesNotExist () . removeDirectoryRecursive) +scriptComponenetName :: IsString s => FilePath -> s +scriptComponenetName scriptPath = fromString cname + where + cname = "script-" ++ map censor (takeFileName scriptPath) + censor c | c `S.member` ccNamecore = c + | otherwise = '_' + +scriptExeFileName :: FilePath -> FilePath +scriptExeFileName scriptPath = "cabal-script-" ++ takeFileName scriptPath + +scriptDistDirParams :: FilePath -> ProjectBaseContext -> Compiler -> Platform -> DistDirParams +scriptDistDirParams scriptPath ctx compiler platform = DistDirParams + { distParamUnitId = newSimpleUnitId cid + , distParamPackageId = fakePackageId + , distParamComponentId = cid + , distParamComponentName = Just $ CExeName cn + , distParamCompilerId = compilerId compiler + , distParamPlatform = platform + , distParamOptimization = fromFlagOrDefault NormalOptimisation optimization + } + where + cn = scriptComponenetName scriptPath + cid = mkComponentId $ prettyShow fakePackageId <> "-inplace-" <> prettyShow cn + optimization = (packageConfigOptimization . projectConfigLocalPackages . projectConfig) ctx + +setExePath :: FilePath -> [String] -> [String] +setExePath exePath options + | "-o" `notElem` options = "-o" : exePath : options + | otherwise = options + -- | 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 @@ -284,15 +344,9 @@ updateContextAndWriteProjectFile ctx scriptPath scriptExecutable = do absScript <- canonicalizePath scriptPath let - -- Replace characters which aren't allowed in the executable component name with '_' - -- Prefix with "cabal-script-" to make it clear to end users that the name may be mangled - scriptExeName = "cabal-script-" ++ map censor (takeFileName scriptPath) - censor c | c `S.member` ccNamecore = c - | otherwise = '_' - sourcePackage = fakeProjectSourcePackage projectRoot & lSrcpkgDescription . L.condExecutables - .~ [(fromString scriptExeName, CondNode executable (targetBuildDepends $ buildInfo executable) [])] + .~ [(scriptComponenetName scriptPath, CondNode executable (targetBuildDepends $ buildInfo executable) [])] executable = scriptExecutable & L.modulePath .~ absScript @@ -395,6 +449,15 @@ fakeProjectSourcePackage projectRoot = sourcePackage , licenseRaw = Left SPDX.NONE } +-- | Find the path of an exe that has been relocated with a "-o" option +movedExePath :: UnqualComponentName -> DistDirLayout -> ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> Maybe FilePath +movedExePath selectedComponent distDirLayout elabShared elabConfigured = do + exe <- find ((== selectedComponent) . exeName) . executables $ elabPkgDescription elabConfigured + let CompilerId flavor _ = (compilerId . pkgConfigCompiler) elabShared + opts <- lookup flavor (perCompilerFlavorToList . options $ buildInfo exe) + let projectRoot = distProjectRootDirectory distDirLayout + fmap (projectRoot ) . lookup "-o" $ reverse (zip opts (drop 1 opts)) + -- Lenses -- | A lens for the 'srcpkgDescription' field of 'SourcePackage' lSrcpkgDescription :: Lens' (SourcePackage loc) GenericPackageDescription diff --git a/cabal-testsuite/PackageTests/ListBin/Script/cabal.out b/cabal-testsuite/PackageTests/ListBin/Script/cabal.out index dcb26e397f1..63d1cab2c01 100644 --- a/cabal-testsuite/PackageTests/ListBin/Script/cabal.out +++ b/cabal-testsuite/PackageTests/ListBin/Script/cabal.out @@ -2,5 +2,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -/cabal.dist/work/./dist/build//ghc-/fake-package-0/x/cabal-script-script.hs/build/cabal-script-script.hs/cabal-script-script.hs + - fake-package-0 (exe:script-script.hs) (first run) +/cabal.dist/work/./dist/build//ghc-/fake-package-0/x/script-script.hs/bin/cabal-script-script.hs diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out index 0c647f80d90..282562011fa 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out index 71653f09844..e492d1b1f88 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out @@ -2,10 +2,10 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-repl Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (ephemeral targets) + - fake-package-0 (exe:script-script.hs) (ephemeral targets) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs index f09f7f8a4fa..9c0f021da5d 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs @@ -1,8 +1,5 @@ import Test.Cabal.Prelude main = cabalTest . void $ do - isWin <- isWindows - ghc94 <- isGhcVersion "== 9.4.*" - expectBrokenIf (isWin && ghc94) 8451 $ do cabal' "v2-build" ["script.hs"] cabalWithStdin "v2-repl" ["script.hs"] "" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out index 208af7b3a0b..097822b36ab 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out @@ -2,7 +2,7 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. -# cabal v2-run \ No newline at end of file + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. +# cabal v2-run diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs index 23d49e3f73f..e46b56d4afd 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs @@ -1,8 +1,5 @@ import Test.Cabal.Prelude main = cabalTest . void $ do - isWin <- isWindows - ghc94 <- isGhcVersion "== 9.4.*" - expectBrokenIf (isWin && ghc94) 8451 $ do cabal' "v2-build" ["script.hs"] cabal' "v2-run" ["script.hs"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out index ff6bbcc5c6e..680900c3692 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out @@ -2,8 +2,8 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-build Up to date diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out index 634c825fcf9..9e0eab19a2b 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out @@ -2,14 +2,14 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' 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:cabal-script-script2.hs) (first run) -Configuring executable 'cabal-script-script2.hs' for fake-package-0.. -Building executable 'cabal-script-script2.hs' for fake-package-0.. + - fake-package-0 (exe:script-script2.hs) (first run) +Configuring executable 'script-script2.hs' for fake-package-0.. +Building executable 'script-script2.hs' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out index 634c825fcf9..9e0eab19a2b 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out @@ -2,14 +2,14 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' 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:cabal-script-script2.hs) (first run) -Configuring executable 'cabal-script-script2.hs' for fake-package-0.. -Building executable 'cabal-script-script2.hs' for fake-package-0.. + - fake-package-0 (exe:script-script2.hs) (first run) +Configuring executable 'script-script2.hs' for fake-package-0.. +Building executable 'script-script2.hs' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out index 9075c0f276a..becc8985243 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out @@ -2,7 +2,7 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out index cba93d1cfd8..369c11213fd 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out @@ -2,5 +2,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out index 135f9694e0e..eb2e5aed262 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out @@ -2,9 +2,9 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. # cabal v2-repl Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) + - fake-package-0 (exe:script-script.hs) (first run) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out index 0cc95e6299f..5379babf9c4 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out index 7520d95a5a0..d0c7fb13eb4 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.lhs) (first run) -Configuring executable 'cabal-script-script.lhs' for fake-package-0.. -Building executable 'cabal-script-script.lhs' for fake-package-0.. + - fake-package-0 (exe:script-script.lhs) (first run) +Configuring executable 'script-script.lhs' for fake-package-0.. +Building executable 'script-script.lhs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs index 1754c7cb4a5..64c858e8d0d 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs @@ -1,8 +1,5 @@ import Test.Cabal.Prelude main = cabalTest $ do - isWin <- isWindows - ghc94 <- isGhcVersion "== 9.4.*" - expectBrokenIf (isWin && ghc94) 8451 $ do res <- cabal' "v2-run" ["script.lhs"] assertOutputContains "Hello World" res diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptNoExtension/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptNoExtension/cabal.out index e0e127886ed..0a3810d6240 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptNoExtension/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptNoExtension/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-with_sp) (first run) -Configuring executable 'cabal-script-with_sp' for fake-package-0.. -Building executable 'cabal-script-with_sp' for fake-package-0.. + - fake-package-0 (exe:script-with_sp) (first run) +Configuring executable 'script-with_sp' for fake-package-0.. +Building executable 'script-with_sp' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out index 5384fa3bbe5..412392689bd 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out @@ -2,7 +2,7 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-run diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out index ec27da9398e..24962dc65ab 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -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.. + - fake-package-0 (exe:script-s.hs) (first run) +Configuring executable 'script-s.hs' for fake-package-0.. +Building executable 'script-s.hs' for fake-package-0.. diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index e3ba1da7cbb..a1181acd945 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -60,7 +60,7 @@ library , aeson ^>= 1.4.2.0 || ^>=1.5.0.0 || ^>= 2.0.0.0 || ^>= 2.1.0.0 , async ^>= 2.2.1 , attoparsec ^>= 0.13.2.2 || ^>=0.14.1 - , base16-bytestring ^>= 0.1.1.6 || ^>= 1.0.0.0 + , base64-bytestring ^>= 1.0.0.0 || ^>= 1.1.0.0 || ^>= 1.2.0.0 , bytestring ^>= 0.10.0.2 || ^>= 0.11.0.0 , containers ^>= 0.5.0.0 || ^>= 0.6.0.1 , cryptohash-sha256 ^>= 0.11.101.0 diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 4ad7b68d116..fd6992d258d 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -52,7 +52,7 @@ 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.Base64 as Base64 import qualified Data.ByteString.Char8 as C import Data.List (isInfixOf, stripPrefix, isPrefixOf, intercalate) import Data.List.NonEmpty (NonEmpty (..)) @@ -841,7 +841,8 @@ 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 + let hash = map (\c -> if c == '/' then '%' else c) . take 26 + . C.unpack . Base64.encode . SHA256.hash . C.pack $ hashinput return $ cabalDir "script-builds" hash ------------------------------------------------------------------------ diff --git a/changelog.d/issue-8841 b/changelog.d/issue-8841 new file mode 100644 index 00000000000..b0bc13c1bc2 --- /dev/null +++ b/changelog.d/issue-8841 @@ -0,0 +1,15 @@ +synopsis: Shorten script-builds paths +packages: Cabal cabal-install +prs: #8898 +issues: #8841 + +description: { + +- Use Base64 hash truncated to 26 chars for script-build cache directories. +- Use the cache directory as the dist directory. +- Use script- as the component name instead of cabal-script-<...>. +- Use cabal-script- for the executable name. +- This change is incompatible with previous cabal versions in terms of cache location, + you should manually remove your old caches once you no longer need them. + +}