Shorten script-builds paths (backport haskell#8898) (haskell#8970)

Co-authored-by: Mel Zuser <mel@mzero.dev> Co-authored-by: Artem Pelenitsyn <a.pelenitsyn@gmail.com>
Kleidukos · May 30, 2023 · 6baf1e4 · 6baf1e4
1 parent 21a68a3
commit 6baf1e4
Show file tree

Hide file tree

Showing 32 changed files with 223 additions and 135 deletions.
diff --git 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
@@ -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
@@ -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
@@ -22,48 +22,50 @@ 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 )
-import Distribution.Simple.Flag
-         ( fromFlagOrDefault )
-import Distribution.Simple.Command
-         ( CommandUI(..), usageAlternatives )
-import Distribution.Types.ComponentName
-         ( componentNameRaw )
-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
 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.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 )
+import Distribution.Types.ComponentName
+         ( componentNameRaw )
 import Distribution.Types.UnitId
          ( UnitId )
-import Distribution.Client.ScriptUtils
-         ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) )
+
+import Distribution.Types.UnqualComponentName
+         ( UnqualComponentName, unUnqualComponentName )
+import Distribution.Verbosity
+         ( normal, silent )
 
 import Data.List (group)
 import qualified Data.Set as Set
@@ -216,11 +218,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
@@ -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
@@ -31,6 +31,7 @@ module Distribution.Client.ProjectConfig (
     readProjectLocalFreezeConfig,
     reportParseResult,
     showProjectConfig,
+    withGlobalConfig,
     withProjectOrGlobalConfig,
     writeProjectLocalExtraConfig,
     writeProjectLocalFreezeConfig,
@@ -462,6 +463,15 @@ renderBadProjectRoot :: BadProjectRoot -> String
 renderBadProjectRoot (BadProjectRootExplicitFile projectFile) =
     "The given project file '" ++ projectFile ++ "' 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
+
 withProjectOrGlobalConfig
     :: Verbosity                  -- ^ verbosity
     -> Flag Bool                  -- ^ whether to ignore local project (--ignore-project flag)