Cabal 3.16.1.0 → 3.18.1.0

raw patch · 116 files changed

+4481/−3735 lines, 116 filesdep ~Cabal-syntaxdep ~Win32dep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Cabal-syntax, Win32, base, bytestring, containers, deepseq, directory, filepath, process, transformers

API changes (from Hackage documentation)

Files

• Cabal.cabal +24/−22
• ChangeLog.md +4/−1
• LICENSE +1/−1
• src/Distribution/Backpack/Configure.hs +84/−21
• src/Distribution/Backpack/ConfiguredComponent.hs +1/−1
• src/Distribution/Backpack/LinkedComponent.hs +15/−7
• src/Distribution/Backpack/MixLink.hs +3/−4
• src/Distribution/Backpack/ReadyComponent.hs +5/−6
• src/Distribution/Backpack/UnifyM.hs +2/−4
• src/Distribution/Compat/CopyFile.hs +17/−137
• src/Distribution/Compat/Directory.hs +0/−48
• src/Distribution/Compat/Environment.hs +2/−59
• src/Distribution/Compat/FilePath.hs +0/−26
• src/Distribution/Compat/GetShortPathName.hs +17/−45
• src/Distribution/Compat/Internal/TempFile.hs +17/−12
• src/Distribution/Compat/ResponseFile.hs +8/−14
• src/Distribution/Compat/SnocList.hs +0/−34
• src/Distribution/Compat/Stack.hs +1/−19
• src/Distribution/Compat/SysInfo.hs +15/−0
• src/Distribution/Compat/Time.hs +6/−139
• src/Distribution/GetOpt.hs +1/−1
• src/Distribution/Make.hs +0/−201
• src/Distribution/PackageDescription/Check.hs +74/−34
• src/Distribution/PackageDescription/Check/Common.hs +3/−2
• src/Distribution/PackageDescription/Check/Conditional.hs +34/−44
• src/Distribution/PackageDescription/Check/Monad.hs +19/−6
• src/Distribution/PackageDescription/Check/Target.hs +16/−31
• src/Distribution/PackageDescription/Check/Warning.hs +18/−7
• src/Distribution/Simple.hs +271/−183
• src/Distribution/Simple/Bench.hs +4/−2
• src/Distribution/Simple/Build.hs +163/−113
• src/Distribution/Simple/Build/Inputs.hs +1/−1
• src/Distribution/Simple/Build/PackageInfoModule.hs +10/−15
• src/Distribution/Simple/Build/PackageInfoModule/Z.hs +2/−9
• src/Distribution/Simple/Build/PathsModule.hs +0/−11
• src/Distribution/Simple/Build/PathsModule/Z.hs +4/−42
• src/Distribution/Simple/BuildPaths.hs +17/−2
• src/Distribution/Simple/BuildTarget.hs +28/−21
• src/Distribution/Simple/BuildWay.hs +15/−8
• src/Distribution/Simple/Command.hs +5/−4
• src/Distribution/Simple/Compiler.hs +86/−21
• src/Distribution/Simple/Configure.hs +582/−400
• src/Distribution/Simple/ConfigureScript.hs +8/−8
• src/Distribution/Simple/Errors.hs +15/−13
• src/Distribution/Simple/FileMonitor/Types.hs +2/−1
• src/Distribution/Simple/GHC.hs +124/−130
• src/Distribution/Simple/GHC/Build.hs +42/−10
• src/Distribution/Simple/GHC/Build/ExtraSources.hs +23/−17
• src/Distribution/Simple/GHC/Build/Link.hs +83/−136
• src/Distribution/Simple/GHC/Build/Modules.hs +42/−18
• src/Distribution/Simple/GHC/Build/Utils.hs +37/−7
• src/Distribution/Simple/GHC/EnvironmentParser.hs +4/−3
• src/Distribution/Simple/GHC/ImplInfo.hs +11/−37
• src/Distribution/Simple/GHC/Internal.hs +205/−220
• src/Distribution/Simple/GHCJS.hs +28/−91
• src/Distribution/Simple/Glob.hs +6/−7
• src/Distribution/Simple/Glob/Internal.hs +15/−8
• src/Distribution/Simple/Haddock.hs +119/−100
• src/Distribution/Simple/Install.hs +16/−11
• src/Distribution/Simple/InstallDirs.hs +106/−10
• src/Distribution/Simple/InstallDirs/Internal.hs +6/−0
• src/Distribution/Simple/LocalBuildInfo.hs +3/−3
• src/Distribution/Simple/PackageDescription.hs +27/−22
• src/Distribution/Simple/PackageIndex.hs +7/−11
• src/Distribution/Simple/PreProcess.hs +99/−99
• src/Distribution/Simple/Program/Ar.hs +6/−6
• src/Distribution/Simple/Program/Builtin.hs +11/−23
• src/Distribution/Simple/Program/Db.hs +63/−7
• src/Distribution/Simple/Program/Find.hs +1/−24
• src/Distribution/Simple/Program/GHC.hs +67/−91
• src/Distribution/Simple/Program/HcPkg.hs +155/−200
• src/Distribution/Simple/Program/Internal.hs +1/−1
• src/Distribution/Simple/Program/ResponseFile.hs +1/−2
• src/Distribution/Simple/Program/Run.hs +2/−5
• src/Distribution/Simple/Program/Script.hs +1/−1
• src/Distribution/Simple/Program/Strip.hs +2/−2
• src/Distribution/Simple/Register.hs +57/−41
• src/Distribution/Simple/Setup.hs +2/−2
• src/Distribution/Simple/Setup/Benchmark.hs +1/−1
• src/Distribution/Simple/Setup/Build.hs +14/−14
• src/Distribution/Simple/Setup/Clean.hs +1/−1
• src/Distribution/Simple/Setup/Common.hs +4/−5
• src/Distribution/Simple/Setup/Config.hs +26/−19
• src/Distribution/Simple/Setup/Copy.hs +7/−5
• src/Distribution/Simple/Setup/Global.hs +9/−0
• src/Distribution/Simple/Setup/Haddock.hs +9/−11
• src/Distribution/Simple/Setup/Hscolour.hs +2/−2
• src/Distribution/Simple/Setup/Install.hs +3/−2
• src/Distribution/Simple/Setup/Register.hs +76/−76
• src/Distribution/Simple/Setup/Repl.hs +1/−1
• src/Distribution/Simple/Setup/SDist.hs +1/−1
• src/Distribution/Simple/Setup/Test.hs +6/−5
• src/Distribution/Simple/SetupHooks/Errors.hs +4/−20
• src/Distribution/Simple/SetupHooks/HooksMain.hs +407/−0
• src/Distribution/Simple/SetupHooks/Internal.hs +265/−61
• src/Distribution/Simple/SetupHooks/Rule.hs +60/−7
• src/Distribution/Simple/ShowBuildInfo.hs +1/−1
• src/Distribution/Simple/SrcDist.hs +16/−15
• src/Distribution/Simple/Test.hs +12/−12
• src/Distribution/Simple/Test/ExeV10.hs +23/−25
• src/Distribution/Simple/Test/LibV09.hs +12/−18
• src/Distribution/Simple/UHC.hs +18/−20
• src/Distribution/Simple/UserHooks.hs +2/−2
• src/Distribution/Simple/Utils.hs +264/−139
• src/Distribution/Types/DumpBuildInfo.hs +11/−0
• src/Distribution/Types/LocalBuildConfig.hs +22/−19
• src/Distribution/Types/LocalBuildInfo.hs +5/−3
• src/Distribution/Types/ParStrat.hs +7/−0
• src/Distribution/Utils/LogProgress.hs +20/−8
• src/Distribution/Utils/MapAccum.hs +3/−2
• src/Distribution/Utils/NubList.hs +3/−0
• src/Distribution/Utils/Progress.hs +1/−1
• src/Distribution/Utils/UnionFind.hs +14/−16
• src/Distribution/Verbosity.hs +174/−97
• src/Distribution/Verbosity/Internal.hs +2/−0
• src/Distribution/ZinzaPrelude.hs +3/−1

@@ -1,7 +1,7 @@-cabal-version: 3.6+cabal-version: 3.8 name:          Cabal-version:       3.16.1.0-copyright:     2003-2025, Cabal Development Team (see AUTHORS file)+version:       3.18.1.0+copyright:     2003-2026, Cabal Development Team (see AUTHORS file) license:       BSD-3-Clause license-file:  LICENSE author:        Cabal Development Team <cabal-devel@haskell.org>@@ -13,7 +13,7 @@   The Haskell Common Architecture for Building Applications and   Libraries: a framework defining a common interface for authors to more   easily build their Haskell applications in a portable way.-  .+   The Haskell Cabal is part of a larger infrastructure for distributing,   organizing, and cataloging Haskell libraries and tools. category:       Distribution@@ -39,25 +39,29 @@   hs-source-dirs: src    build-depends:-    , Cabal-syntax ^>= 3.16.1.0+    , Cabal-syntax ^>= 3.18     , array      >= 0.4.0.1  && < 0.6-    , base       >= 4.13     && < 5-    , bytestring >= 0.10.0.0 && < 0.13-    , containers >= 0.5.0.0  && < 0.9-    , deepseq    >= 1.3.0.1  && < 1.7-    , directory  >= 1.2      && < 1.4-    , filepath   >= 1.3.0.1  && < 1.6+    , base       >= 4.17     && < 5+    , bytestring >= 0.10.8   && < 0.13+    , containers >= 0.5.8.2  && < 0.9+    , deepseq    >= 1.4      && < 1.7+    , directory  >= 1.2.7    && < 1.4+    , filepath   >= 1.4.2    && < 1.6     , pretty     >= 1.1.1    && < 1.2-    , process    >= 1.2.1.0  && < 1.7-    , time       >= 1.4.0.1  && < 1.16+    , process    >= 1.6.20.0 && < 1.6.24 || == 1.6.26.0 || >= 1.6.26.2 && < 1.7+    , time       >= 1.4.0.1  && < 1.17    if os(windows)     build-depends:-      , Win32 >= 2.3.0.0 && < 2.15+      , Win32 >= 2.4.0.0 && < 2.15   else     build-depends:       , unix  >= 2.8.6.0 && < 2.9 +  if os(darwin)+    build-depends:+      , process >= 1.6.29.0+   if flag(git-rev)     build-depends:       , githash ^>= 0.1.7.0@@ -77,6 +81,9 @@   if impl(ghc >= 8.0) && impl(ghc < 8.8)     ghc-options: -Wnoncanonical-monadfail-instances +  if impl(ghc >= 9.14)+    ghc-options: -Wno-pattern-namespace-specifier -Wno-incomplete-record-selectors+   exposed-modules:     Distribution.Backpack.Configure     Distribution.Backpack.ComponentsGraph@@ -91,16 +98,14 @@     Distribution.Utils.LogProgress     Distribution.Utils.MapAccum     Distribution.Compat.CreatePipe-    Distribution.Compat.Directory     Distribution.Compat.Environment-    Distribution.Compat.FilePath     Distribution.Compat.Internal.TempFile     Distribution.Compat.ResponseFile     Distribution.Compat.Prelude.Internal     Distribution.Compat.Process     Distribution.Compat.Stack+    Distribution.Compat.SysInfo     Distribution.Compat.Time-    Distribution.Make     Distribution.PackageDescription.Check     Distribution.ReadE     Distribution.Simple@@ -162,6 +167,7 @@     Distribution.Simple.UHC     Distribution.Simple.UserHooks     Distribution.Simple.SetupHooks.Errors+    Distribution.Simple.SetupHooks.HooksMain     Distribution.Simple.SetupHooks.Internal     Distribution.Simple.SetupHooks.Rule     Distribution.Simple.Utils@@ -194,7 +200,6 @@     Distribution.Compat.Exception,     Distribution.Compat.Graph,     Distribution.Compat.Lens,-    Distribution.Compat.MonadFail,     Distribution.Compat.Newtype,     Distribution.Compat.NonEmptySet,     Distribution.Compat.Parsing,@@ -328,9 +333,7 @@    -- Parsec parser-related modules   build-depends:-    -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity-    -- See also https://github.com/ekmett/transformers-compat/issues/35-    , transformers (>= 0.3      && < 0.4) || (>=0.4.1.0 && <0.7)+    , transformers  >= 0.5.6    && < 0.7     , mtl           >= 2.1      && < 2.4     , parsec        >= 3.1.13.0 && < 3.2 @@ -345,7 +348,6 @@     Distribution.Compat.Async     Distribution.Compat.CopyFile     Distribution.Compat.GetShortPathName-    Distribution.Compat.SnocList     Distribution.GetOpt     Distribution.Lex     Distribution.PackageDescription.Check.Common

@@ -1,3 +1,6 @@+# 3.18.1.0 [Artem Pelenitsyn](mailto:a@pelenitsyn.top) July 2026+* See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.18.1.0.md+ # 3.16.1.0 [Artem Pelenitsyn](mailto:a@pelenitsyn.top) December 2025 * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.16.1.0.md @@ -589,7 +592,7 @@   * Support module thinning and renaming (#2038).   * Add a new license type: UnspecifiedLicense (#2141).   * Remove support for Hugs and nhc98 (#2168).-  * Invoke `tar` with `--formar ustar` if possible in `sdist` (#1903).+  * Invoke `tar` with `--format ustar` if possible in `sdist` (#1903).   * Replace `--enable-library-coverage` with `--enable-coverage`, which   enables program coverage for all components (#1945).   * Suggest that `ExitFailure 9` is probably due to memory

@@ -1,4 +1,4 @@-Copyright (c) 2003-2025, Cabal Development Team.+Copyright (c) 2003-2026, Cabal Development Team. See the AUTHORS file for the full list of copyright holders.  See */LICENSE for the copyright holders of the subcomponents.

@@ -31,6 +31,7 @@ import Distribution.InstalledPackageInfo   ( InstalledPackageInfo   , emptyInstalledPackageInfo+  , requiredSignatures   ) import qualified Distribution.InstalledPackageInfo as Installed import Distribution.ModuleName@@ -261,6 +262,19 @@       packageDependsIndex = PackageIndex.fromList (lefts local_graph)       fullIndex = Graph.fromDistinctList local_graph +    let+      -- Map from dependency UnitId to its PackageId, built from includes+      -- of all ready components.  Used to resolve opaque hashed UnitIds+      -- in broken-package error messages.+      depPkgMap :: Map UnitId PackageId+      depPkgMap =+        Map.fromList+          [ (unDefUnitId (ci_id ci), ci_pkgid ci)+          | rc <- graph+          , Right instc <- [rc_i rc]+          , ci <- instc_includes instc+          ]+     case Graph.broken fullIndex of       [] -> return ()       -- If there are promised dependencies, we don't know what the dependencies@@ -270,26 +284,33 @@       broken         | not (null promisedPkgDeps) -> return ()         | otherwise ->-            -- TODO: ppr this-            dieProgress . text $-              "The following packages are broken because other"-                ++ " packages they depend on are missing. These broken "-                ++ "packages must be rebuilt before they can be used.\n"-                -- TODO: Undupe.-                ++ unlines-                  [ "installed package "-                    ++ prettyShow (packageId pkg)-                    ++ " is broken due to missing package "-                    ++ intercalate ", " (map prettyShow deps)-                  | (Left pkg, deps) <- broken-                  ]-                ++ unlines-                  [ "planned package "-                    ++ prettyShow (packageId pkg)-                    ++ " is broken due to missing package "-                    ++ intercalate ", " (map prettyShow deps)-                  | (Right pkg, deps) <- broken-                  ]+            dieProgress $+              text "The following packages are broken because other"+                <+> text "packages they depend on are missing. These broken"+                <+> text "packages must be rebuilt before they can be used."+                $$ nest+                  2+                  ( vcat $+                      [ hang+                        (text "installed package" <+> pretty (packageId pkg))+                        4+                        ( text "is broken due to missing package"+                            <+> hsep (punctuate comma (map pretty deps))+                        )+                      | (Left pkg, deps) <- broken+                      ]+                        ++ [ hang+                            (text "planned package" <+> pretty (packageId pkg))+                            4+                            ( vcat $+                                text "is broken due to missing package"+                                  : [ nest 2 (dispMissingDep installedPackageSet depPkgMap dep)+                                    | dep <- deps+                                    ]+                            )+                           | (Right pkg, deps) <- broken+                           ]+                  )      -- In this section, we'd like to look at the 'packageDependsIndex'     -- and see if we've picked multiple versions of the same@@ -338,6 +359,48 @@     -- forM clbis $ \(clbi,deps) -> info verbosity $ "UNIT" ++ hashUnitId (componentUnitId clbi) ++ "\n" ++ intercalate "\n" (map hashUnitId deps)     return (clbis, packageDependsIndex) +-- | Pretty-print a missing dependency, resolving opaque hashed 'UnitId's+-- to their human-readable package id and signature info when possible.+--+-- When an indefinite Backpack package is installed separately (e.g. via+-- nix callCabal2nix), only the indefinite variant (with unfilled signatures)+-- exists in the package DB.  The consumer needs an instantiated variant+-- which was never built.  The fix is to add both packages to the same+-- cabal project so cabal can fill the signatures.+dispMissingDep+  :: InstalledPackageIndex+  -- ^ all installed packages+  -> Map UnitId PackageId+  -- ^ dep UnitId to its PackageId (from includes)+  -> UnitId+  -- ^ the missing dependency+  -> Doc+dispMissingDep installedPkgSet depPkgMap uid =+  case Map.lookup uid depPkgMap of+    Just pkgid ->+      let ipiSigs =+            [ sigs+            | ipi <- PackageIndex.lookupSourcePackageId installedPkgSet pkgid+            , let sigs = requiredSignatures ipi+            , not (Set.null sigs)+            ]+       in case ipiSigs of+            (sigs : _) ->+              pretty pkgid+                <+> parens+                  ( text "has unfilled"+                      <+> (if Set.size sigs > 1 then text "signatures:" else text "signature:")+                      <+> hsep (punctuate comma (map pretty (Set.toList sigs)))+                  )+                $$ nest+                  2+                  ( text "The package is installed as indefinite."+                      $$ text "To use it, rebuild it in the same cabal project as the"+                      <+> text "consumer so cabal can fill the signatures."+                  )+            [] -> pretty pkgid <+> parens (pretty uid)+    Nothing -> pretty uid+ -- Build ComponentLocalBuildInfo for each component we are going -- to build. --@@ -353,7 +416,7 @@     go rc =       case rc_component rc of         CLib lib ->-          let convModuleExport (modname', (Module uid modname))+          let convModuleExport (modname', Module uid modname)                 | this_uid == unDefUnitId uid                 , modname' == modname =                     Installed.ExposedModule modname' Nothing

@@ -83,7 +83,7 @@     (text "component" <+> pretty (cc_cid cc))     4     ( vcat-        [ hsep $+        [ hsep           [ text "include"           , pretty (ci_id incl)           , pretty (ci_renaming incl)

@@ -161,9 +161,7 @@        lookupUid :: ComponentId -> (OpenUnitId, ModuleShape)       lookupUid cid =-        fromMaybe-          (error "linkComponent: lookupUid")-          (Map.lookup cid pkg_map)+        Map.findWithDefault (error "linkComponent: lookupUid") cid pkg_map      let orErr (Right x) = return x         orErr (Left [err]) = dieProgress err@@ -260,7 +258,17 @@         hang           (text "Non-library component has unfilled requirements:")           4-          (vcat [pretty req | req <- Set.toList reqs])+          ( vcat+              [ case Map.lookup req (modScopeRequires linked_shape0) of+                Just srcs@(_ : _) ->+                  hang+                    (pretty req)+                    4+                    (vcat [text "brought into scope by" <+> dispModuleSource (getSource src) | src <- srcs])+                _ -> pretty req+              | req <- Set.toList reqs+              ]+          )      -- NB: do NOT include hidden modules here: GHC 7.10's ghc-pkg     -- won't allow it (since someone could directly synthesize@@ -290,7 +298,7 @@                   (text "Problem with module re-exports:")                   2                   (vcat [hang (text "-") 2 l | l <- ls])-    reexports_list <- hdl . (flip map) src_reexports $ \reex@(ModuleReexport mb_pn from to) -> do+    reexports_list <- hdl . flip map src_reexports $ \reex@(ModuleReexport mb_pn from to) -> do       case Map.lookup from (modScopeProvides linked_shape) of         Just cands@(x0 : xs0) -> do           -- Make sure there is at least one candidate@@ -331,7 +339,7 @@         -- TODO: doublecheck we have checked for         -- src_provs duplicates already!         -- These are normal module exports.-        [(mod_name, (OpenModule this_uid mod_name)) | mod_name <- src_provs]+        [(mod_name, OpenModule this_uid mod_name) | mod_name <- src_provs]           ++           -- These are reexports, which we managed to resolve to something in an external package.           [(mn_new, om) | (mn_new, Just om) <- reexports_list]@@ -373,7 +381,7 @@         , lc_component = component         , lc_public = is_public         , -- These must be executables-          lc_exe_deps = map (fmap (\cid -> IndefFullUnitId cid Map.empty)) exe_deps+          lc_exe_deps = map (fmap (`IndefFullUnitId` Map.empty)) exe_deps         , lc_shape = final_linked_shape         , lc_includes = linked_includes         , lc_sig_includes = linked_sig_includes

@@ -115,10 +115,9 @@     reqs_doc       | null reqs = dispModuleSource (getSource req)       | otherwise =-          ( text "   "-              <+> dispModuleSource (getSource req)-              $$ vcat [text "and" <+> dispModuleSource (getSource r) | r <- reqs]-          )+          text "   "+            <+> dispModuleSource (getSource req)+            $$ vcat [text "and" <+> dispModuleSource (getSource r) | r <- reqs] linkProvision _ _ _ = error "linkProvision"  -----------------------------------------------------------------------

@@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-}  -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>@@ -210,7 +211,7 @@      in (f x, s')  instance Applicative InstM where-  pure a = InstM $ \s -> (a, s)+  pure a = InstM (a,)   InstM f <*> InstM x = InstM $ \s ->     let (f', s') = f s         (x', s'') = x s'@@ -402,11 +403,9 @@       -- Top-level instantiation per subst0       | not (Map.null subst0)       , [lc] <- filter lc_public (Map.elems cmap) =-          do-            _ <- instantiateUnitId (lc_cid lc) subst0-            return ()+          void $ instantiateUnitId (lc_cid lc) subst0       | otherwise =           forM_ (Map.elems cmap) $ \lc ->             if null (lc_insts lc)-              then instantiateUnitId (lc_cid lc) Map.empty >> return ()-              else indefiniteUnitId (lc_cid lc) >> return ()+              then void $ instantiateUnitId (lc_cid lc) Map.empty+              else void $ indefiniteUnitId (lc_cid lc)

@@ -186,7 +186,7 @@ failIfErrs = do   env <- getUnifEnv   errs <- liftST $ readSTRef (unify_errs env)-  when (not (null errs)) failM+  unless (null errs) failM  tryM :: UnifyM s a -> UnifyM s (Maybe a) tryM m =@@ -535,9 +535,7 @@               <+> vcat (map pretty (v : vs))           return v -    let req_rename_fn k = case Map.lookup k req_rename of-          Nothing -> k-          Just v -> v+    let req_rename_fn k = Map.findWithDefault k k req_rename      -- Requirement substitution.     --

@@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} +{- HLINT ignore "Use fewer imports" -}+ module Distribution.Compat.CopyFile   ( copyFile   , copyFileChanged@@ -15,23 +17,29 @@ import Distribution.Compat.Prelude import Prelude () -#ifndef mingw32_HOST_OS-import Distribution.Compat.Internal.TempFile+import qualified Data.ByteString.Lazy as BSL+import System.Directory+  ( doesFileExist+  )+import System.IO+  ( IOMode (ReadMode)+  , hFileSize+  , withBinaryFile+  ) +#ifndef mingw32_HOST_OS import Control.Exception          ( bracketOnError )-import qualified Data.ByteString.Lazy as BSL import Data.Bits          ( (.|.) ) import System.IO.Error          ( ioeSetLocation ) import System.Directory-         ( doesFileExist, renameFile, removeFile )+         ( renameFile, removeFile ) import System.FilePath          ( takeDirectory ) import System.IO-         ( IOMode(ReadMode), hClose, hGetBuf, hPutBuf, hFileSize-         , withBinaryFile )+         ( hClose, hGetBuf, hPutBuf, openBinaryTempFile ) import Foreign          ( allocaBytes ) @@ -42,28 +50,9 @@  #else /* else mingw32_HOST_OS */ -import qualified Data.ByteString.Lazy as BSL-import System.IO.Error-  ( ioeSetLocation ) import System.Directory-  ( doesFileExist )-import System.FilePath-  ( addTrailingPathSeparator-  , hasTrailingPathSeparator-  , isPathSeparator-  , isRelative-  , joinDrive-  , joinPath-  , pathSeparator-  , pathSeparators-  , splitDirectories-  , splitDrive-  )-import System.IO-  ( IOMode(ReadMode), hFileSize-  , withBinaryFile )+  ( copyFileWithMetadata ) -import qualified System.Win32.File as Win32 ( copyFile ) #endif /* mingw32_HOST_OS */  copyOrdinaryFile, copyExecutableFile :: FilePath -> FilePath -> IO ()@@ -91,11 +80,11 @@ -- | Copies a file to a new destination. -- Often you should use `copyFileChanged` instead. copyFile :: FilePath -> FilePath -> IO ()+#ifndef mingw32_HOST_OS copyFile fromFPath toFPath =   copy     `catchIO` (\ioe -> throwIO (ioeSetLocation ioe "copyFile"))   where-#ifndef mingw32_HOST_OS       copy = withBinaryFile fromFPath ReadMode $ \hFrom ->              bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->              do allocaBytes bufferSize $ copyContents hFrom hTmp@@ -113,116 +102,7 @@                       hPutBuf hTo buffer count                       copyContents hFrom hTo buffer #else-      copy = Win32.copyFile (toExtendedLengthPath fromFPath)-                            (toExtendedLengthPath toFPath)-                            False---- NOTE: Shamelessly lifted from System.Directory.Internal.Windows---- | Add the @"\\\\?\\"@ prefix if necessary or possible.  The path remains--- unchanged if the prefix is not added.  This function can sometimes be used--- to bypass the @MAX_PATH@ length restriction in Windows API calls.------ See Note [Path normalization].-toExtendedLengthPath :: FilePath -> FilePath-toExtendedLengthPath path-  | isRelative path = path-  | otherwise =-      case normalisedPath of-        '\\' : '?'  : '?' : '\\' : _ -> normalisedPath-        '\\' : '\\' : '?' : '\\' : _ -> normalisedPath-        '\\' : '\\' : '.' : '\\' : _ -> normalisedPath-        '\\' : subpath@('\\' : _)    -> "\\\\?\\UNC" <> subpath-        _                            -> "\\\\?\\" <> normalisedPath-    where normalisedPath = simplifyWindows path---- | Similar to 'normalise' but:------ * empty paths stay empty,--- * parent dirs (@..@) are expanded, and--- * paths starting with @\\\\?\\@ are preserved.------ The goal is to preserve the meaning of paths better than 'normalise'.------ Note [Path normalization]--- 'normalise' doesn't simplify path names but will convert / into \\--- this would normally not be a problem as once the path hits the RTS we would--- have simplified the path then.  However since we're calling the WIn32 API--- directly we have to do the simplification before the call.  Without this the--- path Z:// would become Z:\\\\ and when converted to a device path the path--- becomes \\?\Z:\\\\ which is an invalid path.------ This is not a bug in normalise as it explicitly states that it won't simplify--- a FilePath.-simplifyWindows :: FilePath -> FilePath-simplifyWindows "" = ""-simplifyWindows path =-  case drive' of-    "\\\\?\\" -> drive' <> subpath-    _ -> simplifiedPath-  where-    simplifiedPath = joinDrive drive' subpath'-    (drive, subpath) = splitDrive path-    drive' = upperDrive (normaliseTrailingSep (normalisePathSeps drive))-    subpath' = appendSep . avoidEmpty . prependSep . joinPath .-               stripPardirs . expandDots . skipSeps .-               splitDirectories $ subpath--    upperDrive d = case d of-      c : ':' : s | isAlpha c && all isPathSeparator s -> toUpper c : ':' : s-      _ -> d-    skipSeps = filter (not . (`elem` (pure <$> pathSeparators)))-    stripPardirs | pathIsAbsolute || subpathIsAbsolute = dropWhile (== "..")-                 | otherwise = id-    prependSep | subpathIsAbsolute = (pathSeparator :)-               | otherwise = id-    avoidEmpty | not pathIsAbsolute-                 && (null drive || hasTrailingPathSep) -- prefer "C:" over "C:."-                 = emptyToCurDir-               | otherwise = id-    appendSep p | hasTrailingPathSep-                  && not (pathIsAbsolute && null p)-                  = addTrailingPathSeparator p-                | otherwise = p-    pathIsAbsolute = not (isRelative path)-    subpathIsAbsolute = any isPathSeparator (take 1 subpath)-    hasTrailingPathSep = hasTrailingPathSeparator subpath---- | Given a list of path segments, expand @.@ and @..@.  The path segments--- must not contain path separators.-expandDots :: [FilePath] -> [FilePath]-expandDots = reverse . go []-  where-    go ys' xs' =-      case xs' of-        [] -> ys'-        x : xs ->-          case x of-            "." -> go ys' xs-            ".." ->-              case ys' of-                [] -> go (x : ys') xs-                ".." : _ -> go (x : ys') xs-                _ : ys -> go ys xs-            _ -> go (x : ys') xs---- | Convert to the right kind of slashes.-normalisePathSeps :: FilePath -> FilePath-normalisePathSeps p = (\ c -> if isPathSeparator c then pathSeparator else c) <$> p---- | Remove redundant trailing slashes and pick the right kind of slash.-normaliseTrailingSep :: FilePath -> FilePath-normaliseTrailingSep path = do-  let path' = reverse path-  let (sep, path'') = span isPathSeparator path'-  let addSep = if null sep then id else (pathSeparator :)-  reverse (addSep path'')---- | Convert empty paths to the current directory, otherwise leave it--- unchanged.-emptyToCurDir :: FilePath -> FilePath-emptyToCurDir ""   = "."-emptyToCurDir path = path+copyFile = copyFileWithMetadata #endif /* mingw32_HOST_OS */  -- | Like `copyFile`, but does not touch the target if source and destination

@@ -1,48 +0,0 @@-{-# LANGUAGE CPP #-}--module Distribution.Compat.Directory-  ( listDirectory-  , makeAbsolute-  , doesPathExist-  ) where--#if MIN_VERSION_directory(1,2,7)-import System.Directory as Dir hiding (doesPathExist)-import System.Directory (doesPathExist)-#else-import System.Directory as Dir-#endif-#if !MIN_VERSION_directory(1,2,2)-import System.FilePath as Path-#endif--#if !MIN_VERSION_directory(1,2,5)--listDirectory :: FilePath -> IO [FilePath]-listDirectory path =-  filter f `fmap` Dir.getDirectoryContents path-  where f filename = filename /= "." && filename /= ".."--#endif--#if !MIN_VERSION_directory(1,2,2)--makeAbsolute :: FilePath -> IO FilePath-makeAbsolute p | Path.isAbsolute p = return p-               | otherwise         = do-    cwd <- Dir.getCurrentDirectory-    return $ cwd </> p--#endif--#if !MIN_VERSION_directory(1,2,7)--doesPathExist :: FilePath -> IO Bool-doesPathExist path = do-    -- not using Applicative, as this way we can do less IO-    e <- doesDirectoryExist path-    if e-    then return True-    else doesFileExist path--#endif

@@ -1,6 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-} {-# OPTIONS_HADDOCK hide #-}  module Distribution.Compat.Environment (getEnvironment, lookupEnv, setEnv, unsetEnv)@@ -8,22 +6,10 @@  import Distribution.Compat.Prelude import Prelude ()-import qualified Prelude  import System.Environment (lookupEnv, unsetEnv) import qualified System.Environment as System--import Distribution.Compat.Stack--#ifdef mingw32_HOST_OS-import Foreign.C-import GHC.Windows-#else-import Foreign.C.Types-import Foreign.C.String-import Foreign.C.Error (throwErrnoIfMinus1_)-import System.Posix.Internals ( withFilePath )-#endif /* mingw32_HOST_OS */+import qualified System.Environment.Blank as Blank (setEnv)  getEnvironment :: IO [(String, String)] #ifdef mingw32_HOST_OS@@ -39,48 +25,5 @@ #endif  -- | @setEnv name value@ sets the specified environment variable to @value@.------ Throws `Control.Exception.IOException` if either @name@ or @value@ is the--- empty string or contains an equals sign. setEnv :: String -> String -> IO ()-setEnv key value_ = setEnv_ key value-  where-    -- NOTE: Anything that follows NUL is ignored on both POSIX and Windows. We-    -- still strip it manually so that the null check above succeeds if a value-    -- starts with NUL.-    value = takeWhile (/= '\NUL') value_--setEnv_ :: String -> String -> IO ()--#ifdef mingw32_HOST_OS--setEnv_ key value = withCWString key $ \k -> withCWString value $ \v -> do-  success <- c_SetEnvironmentVariable k v-  unless success (throwGetLastError "setEnv")- where-  _ = callStack -- TODO: attach CallStack to exception--{- FOURMOLU_DISABLE -}-# if defined(i386_HOST_ARCH)-#  define WINDOWS_CCONV stdcall-# elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH)-#  define WINDOWS_CCONV ccall-# else-#  error Unknown mingw32 arch-# endif /* i386_HOST_ARCH */--foreign import WINDOWS_CCONV unsafe "windows.h SetEnvironmentVariableW"-  c_SetEnvironmentVariable :: LPTSTR -> LPTSTR -> Prelude.IO Bool-#else-setEnv_ key value = do-  withFilePath key $ \ keyP ->-    withFilePath value $ \ valueP ->-      throwErrnoIfMinus1_ "setenv" $-        c_setenv keyP valueP (fromIntegral (fromEnum True))- where-  _ = callStack -- TODO: attach CallStack to exception--foreign import ccall unsafe "setenv"-   c_setenv :: CString -> CString -> CInt -> Prelude.IO CInt-#endif /* mingw32_HOST_OS */-{- FOURMOLU_ENABLE -}+setEnv key value = Blank.setEnv key value True

@@ -1,26 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -Wno-unused-imports #-}--module Distribution.Compat.FilePath-  ( isExtensionOf-  , stripExtension-  ) where--import Data.List (isSuffixOf, stripPrefix)-import System.FilePath--#if !MIN_VERSION_filepath(1,4,2)-isExtensionOf :: String -> FilePath -> Bool-isExtensionOf ext@('.':_) = isSuffixOf ext . takeExtensions-isExtensionOf ext         = isSuffixOf ('.':ext) . takeExtensions-#endif--#if !MIN_VERSION_filepath(1,4,1)-stripExtension :: String -> FilePath -> Maybe FilePath-stripExtension []        path = Just path-stripExtension ext@(x:_) path = stripSuffix dotExt path- where-  dotExt = if isExtSeparator x then ext else '.':ext-  stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]-  stripSuffix xs ys = fmap reverse $ stripPrefix (reverse xs) (reverse ys)-#endif

@@ -1,56 +1,29 @@ {-# LANGUAGE CPP #-} ---------------------------------------------------------------------------------- |--- Module      :  Distribution.Compat.GetShortPathName+-- | Win32 API 'GetShortPathName' function, which returns MS DOS short path name+-- (up to 8 characters for file name + 3 for file extension). ----- Maintainer  :  cabal-devel@haskell.org--- Portability :  Windows-only+-- What's going on here? Why do we care about MS DOS?+-- In practice the short name serves as an alternative name,+-- which does not contain spaces even if the original name does.+-- Some applications (including certain versions of Autoconf) do not like+-- spaces in filenames, so getting a short path name gives us+-- a chance to work around it. That's not bullet proof though:+-- some objects might not have a short name. ----- Win32 API 'GetShortPathName' function.+-- Writing this comment in 2026, I don't know whether the aforementioned+-- issue with Autoconf and spaces remains relevant. It's possible+-- that things have improved during the last 10 years+-- since https://github.com/haskell/cabal/issues/3185 was merged.+--+-- Compare to the similar functionality in Stack:+-- https://hackage.haskell.org/package/stack-3.3.1/docs/src/Stack.Config.html#local-6989586621679973356 module Distribution.Compat.GetShortPathName (getShortPathName) where -import Distribution.Compat.Prelude-import Prelude ()- #ifdef mingw32_HOST_OS -import qualified Prelude-import qualified System.Win32 as Win32-import System.Win32          (LPCTSTR, LPTSTR, DWORD)-import Foreign.Marshal.Array (allocaArray)--{- FOURMOLU_DISABLE -}-#if defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH)-#define WINAPI ccall-#else-#define WINAPI stdcall-#endif--foreign import WINAPI unsafe "windows.h GetShortPathNameW"-  c_GetShortPathName :: LPCTSTR -> LPTSTR -> DWORD -> Prelude.IO DWORD---- | On Windows, retrieves the short path form of the specified path. On--- non-Windows, does nothing. See https://github.com/haskell/cabal/issues/3185.------ From MS's GetShortPathName docs:------      Passing NULL for [the second] parameter and zero for cchBuffer---      will always return the required buffer size for a---      specified lpszLongPath.----getShortPathName :: FilePath -> IO FilePath-getShortPathName path =-  Win32.withTString path $ \c_path -> do-    c_len <- Win32.failIfZero "GetShortPathName #1 failed!" $-      c_GetShortPathName c_path Win32.nullPtr 0-    let arr_len = fromIntegral c_len-    allocaArray arr_len $ \c_out -> do-      void $ Win32.failIfZero "GetShortPathName #2 failed!" $-        c_GetShortPathName c_path c_out c_len-      Win32.peekTString c_out+import System.Win32.Info (getShortPathName)  #else @@ -58,4 +31,3 @@ getShortPathName path = return path  #endif-{- FOURMOLU_ENABLE -}

@@ -10,10 +10,11 @@  import Distribution.Compat.Exception +import GHC.IORef (IORef, atomicModifyIORef'_, newIORef) import System.FilePath ((</>))- import System.IO (Handle, openBinaryTempFile, openBinaryTempFileWithDefaultPermissions, openTempFile) import System.IO.Error (isAlreadyExistsError)+import System.IO.Unsafe (unsafePerformIO) import System.Posix.Internals (c_getpid)  #if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)@@ -28,17 +29,21 @@ createTempDirectory :: FilePath -> String -> IO FilePath createTempDirectory dir template = do   pid <- c_getpid-  findTempName pid-  where-    findTempName x = do-      let relpath = template ++ "-" ++ show x-          dirpath = dir </> relpath-      r <- tryIO $ mkPrivateDir dirpath-      case r of-        Right _ -> return relpath-        Left e-          | isAlreadyExistsError e -> findTempName (x + 1)-          | otherwise -> ioError e+  let findTempName = do+        (counter, _) <- atomicModifyIORef'_ tempDirectoryCounter (+ 1)+        let relpath = template ++ "-" ++ show pid ++ show counter+            dirpath = dir </> relpath+        r <- tryIO $ mkPrivateDir dirpath+        case r of+          Right _ -> pure relpath+          Left e+            | isAlreadyExistsError e -> findTempName+            | otherwise -> ioError e+  findTempName++tempDirectoryCounter :: IORef Word+tempDirectoryCounter = unsafePerformIO $ newIORef 0+{-# NOINLINE tempDirectoryCounter #-}  mkPrivateDir :: String -> IO () #if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS)

@@ -1,9 +1,3 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}---- Compatibility layer for GHC.ResponseFile--- Implementation from base 4.12.0 is used.--- http://hackage.haskell.org/package/base-4.12.0.0/src/LICENSE module Distribution.Compat.ResponseFile (expandResponse, escapeArgs) where  import Distribution.Compat.Prelude@@ -16,12 +10,12 @@ import System.IO (hPutStrLn, stderr) import System.IO.Error --- | The arg file / response file parser.------ This is not a well-documented capability, and is a bit eccentric--- (try @cabal \@foo \@bar@ to see what that does), but is crucial--- for allowing complex arguments to cabal and cabal-install when--- using command prompts with strongly-limited argument length.+-- | This is a more elaborate version of 'GHC.ResponseFile.expandResponse',+-- which not only substitute @\@foo@ with the contents of file @foo@,+-- but performs such substitution recursively.+-- In doing so we keep closer to the reference implementation+-- of @expandargv@ in @argv.c@ from @binutils@, although this additional functionality+-- likely remains unused by Haskell tooling. expandResponse :: [String] -> IO [String] expandResponse = go recursionLimit "."   where@@ -33,8 +27,8 @@       | otherwise = const $ hPutStrLn stderr "Error: response file recursion limit exceeded." >> exitFailure      expand :: Int -> FilePath -> String -> IO [String]-    expand n dir arg@('@' : f) = readRecursively n (dir </> f) `catchIOError` const (print "?" >> return [arg])+    expand n dir arg@('@' : f) = readRecursively n (dir </> f) `catchIOError` const (return [arg])     expand _n _dir x = return [x]      readRecursively :: Int -> FilePath -> IO [String]-    readRecursively n f = go (n - 1) (takeDirectory f) =<< unescapeArgs <$> readFile f+    readRecursively n f = go (n - 1) (takeDirectory f) . unescapeArgs =<< readFile f

@@ -1,34 +0,0 @@---------------------------------------------------------------------------------- |--- Module      :  Distribution.Compat.SnocList--- License     :  BSD3------ Maintainer  :  cabal-dev@haskell.org--- Stability   :  experimental--- Portability :  portable------ A very reversed list. Has efficient `snoc`-module Distribution.Compat.SnocList-  ( SnocList-  , runSnocList-  , snoc-  ) where--import Distribution.Compat.Prelude-import Prelude ()--newtype SnocList a = SnocList [a]--snoc :: SnocList a -> a -> SnocList a-snoc (SnocList xs) x = SnocList (x : xs)--runSnocList :: SnocList a -> [a]-runSnocList (SnocList xs) = reverse xs--instance Semigroup (SnocList a) where-  SnocList xs <> SnocList ys = SnocList (ys <> xs)--instance Monoid (SnocList a) where-  mempty = SnocList []-  mappend = (<>)

@@ -4,7 +4,6 @@ module Distribution.Compat.Stack   ( WithCallStack   , CallStack-  , annotateCallStackIO   , withFrozenCallStack   , withLexicalCallStack   , callStack@@ -13,15 +12,13 @@   ) where  import GHC.Stack-import System.IO.Error  type WithCallStack a = HasCallStack => a  -- | Give the *parent* of the person who invoked this; -- so it's most suitable for being called from a utility function. -- You probably want to call this using 'withFrozenCallStack'; otherwise--- it's not very useful.  We didn't implement this for base-4.8.1--- because we cannot rely on freezing to have taken place.+-- it's not very useful. parentSrcLocPrefix :: WithCallStack String parentSrcLocPrefix =   case getCallStack callStack of@@ -37,18 +34,3 @@ withLexicalCallStack f =   let stk = ?callStack    in \x -> let ?callStack = stk in f x---- | This function is for when you *really* want to add a call--- stack to raised IO, but you don't have a--- 'Distribution.Verbosity.Verbosity' so you can't use--- 'Distribution.Simple.Utils.annotateIO'.  If you have a 'Verbosity',--- please use that function instead.-annotateCallStackIO :: WithCallStack (IO a -> IO a)-annotateCallStackIO = modifyIOError f-  where-    f ioe =-      ioeSetErrorString ioe-        . wrapCallStack-        $ ioeGetErrorString ioe-    wrapCallStack s =-      prettyCallStack callStack ++ "\n" ++ s

@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}++module Distribution.Compat.SysInfo+  ( fullCompilerVersion+  ) where++import Data.Version (Version)+import qualified System.Info as SI++fullCompilerVersion :: Version+#if MIN_VERSION_base(4,15,0)+fullCompilerVersion = SI.fullCompilerVersion+#else+fullCompilerVersion = SI.compilerVersion+#endif

@@ -1,17 +1,11 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}  module Distribution.Compat.Time-  ( ModTime (..) -- Needed for testing+  ( ModTime   , getModTime   , getFileAge   , getCurTime-  , posixSecondsToModTime-  , calibrateMtimeChangeDelay   ) where @@ -20,39 +14,10 @@  import System.Directory (getModificationTime) -import Distribution.Simple.Utils (withTempDirectoryCwd)-import Distribution.Utils.Path (getSymbolicPath, sameDirectory)-import Distribution.Verbosity (silent)--import System.FilePath- import Data.Time (diffUTCTime, getCurrentTime)-import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixDayLength)--#if defined mingw32_HOST_OS--import qualified Prelude-import Data.Bits          ((.|.), unsafeShiftL)-import Data.Bits          (finiteBitSize)--import Foreign            ( allocaBytes, peekByteOff )-import System.IO.Error    ( mkIOError, doesNotExistErrorType )-import System.Win32.Types ( BOOL, DWORD, LPCTSTR, LPVOID, withTString )--#else--import System.Posix.Files-  ( FileStatus, getFileStatus-#if MIN_VERSION_unix(2,6,0)-  , modificationTimeHiRes-#else-  , modificationTime-#endif-  )--#endif+import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime, posixDayLength, utcTimeToPOSIXSeconds) --- | An opaque type representing a file's modification time, represented+-- | File's modification time, represented -- internally as a 64-bit unsigned integer in the Windows UTC format. newtype ModTime = ModTime Word64   deriving (Binary, Generic, Bounded, Eq, Ord)@@ -65,83 +30,14 @@ instance Read ModTime where   readsPrec p str = map (first ModTime) (readsPrec p str) --- | Return modification time of the given file. Works around the low clock--- resolution problem that 'getModificationTime' has on GHC < 7.8.------ This is a modified version of the code originally written for Shake by Neil--- Mitchell. See module Development.Shake.FileInfo.+-- | Return modification time of the given file. getModTime :: FilePath -> IO ModTime--#if defined mingw32_HOST_OS---- Directly against the Win32 API.-getModTime path = allocaBytes size_WIN32_FILE_ATTRIBUTE_DATA $ \info -> do-  res <- getFileAttributesEx path info-  if not res-    then do-      let err = mkIOError doesNotExistErrorType-                "Distribution.Compat.Time.getModTime"-                Nothing (Just path)-      ioError err-    else do-      dwLow  <- peekByteOff info-                index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime-      dwHigh <- peekByteOff info-                index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwHighDateTime-      let qwTime =-            (fromIntegral (dwHigh :: DWORD) `unsafeShiftL` finiteBitSize dwHigh)-            .|. (fromIntegral (dwLow :: DWORD))-      return $! ModTime (qwTime :: Word64)--{- FOURMOLU_DISABLE -}-#if defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH)-#define CALLCONV ccall-#else-#define CALLCONV stdcall-#endif--foreign import CALLCONV "windows.h GetFileAttributesExW"-  c_getFileAttributesEx :: LPCTSTR -> Int32 -> LPVOID -> Prelude.IO BOOL--getFileAttributesEx :: String -> LPVOID -> IO BOOL-getFileAttributesEx path lpFileInformation =-  withTString path $ \c_path ->-      c_getFileAttributesEx c_path getFileExInfoStandard lpFileInformation--getFileExInfoStandard :: Int32-getFileExInfoStandard = 0--size_WIN32_FILE_ATTRIBUTE_DATA :: Int-size_WIN32_FILE_ATTRIBUTE_DATA = 36--index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime :: Int-index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime = 20--index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwHighDateTime :: Int-index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwHighDateTime = 24--#else---- Directly against the unix library.-getModTime path = do-    st <- getFileStatus path-    return $! (extractFileTime st)--extractFileTime :: FileStatus -> ModTime-extractFileTime x = posixTimeToModTime (modificationTimeHiRes x)--#endif-{- FOURMOLU_ENABLE -}+getModTime = fmap (posixTimeToModTime . utcTimeToPOSIXSeconds) . getModificationTime  windowsTick, secToUnixEpoch :: Word64 windowsTick = 10000000 secToUnixEpoch = 11644473600 --- | Convert POSIX seconds to ModTime.-posixSecondsToModTime :: Int64 -> ModTime-posixSecondsToModTime s =-  ModTime $ ((fromIntegral s :: Word64) + secToUnixEpoch) * windowsTick- -- | Convert 'POSIXTime' to 'ModTime'. posixTimeToModTime :: POSIXTime -> ModTime posixTimeToModTime p =@@ -158,33 +54,4 @@  -- | Return the current time as 'ModTime'. getCurTime :: IO ModTime-getCurTime = posixTimeToModTime `fmap` getPOSIXTime -- Uses 'gettimeofday'.---- | Based on code written by Neil Mitchell for Shake. See--- 'sleepFileTimeCalibrate' in 'Test.Type'.  Returns a pair--- of microsecond values: first, the maximum delay seen, and the--- recommended delay to use before testing for file modification change.--- The returned delay is never smaller--- than 10 ms, but never larger than 1 second.-calibrateMtimeChangeDelay :: IO (Int, Int)-calibrateMtimeChangeDelay =-  withTempDirectoryCwd silent Nothing sameDirectory "calibration-" $ \dir -> do-    let fileName = getSymbolicPath dir </> "probe"-    mtimes <- for [1 .. 25] $ \(i :: Int) -> time $ do-      writeFile fileName $ show i-      t0 <- getModTime fileName-      let spin j = do-            writeFile fileName $ show (i, j)-            t1 <- getModTime fileName-            unless (t0 < t1) (spin $ j + 1)-      spin (0 :: Int)-    let mtimeChange = maximum mtimes-        mtimeChange' = min 1000000 $ (max 10000 mtimeChange) * 2-    return (mtimeChange, mtimeChange')-  where-    time :: IO () -> IO Int-    time act = do-      t0 <- getCurrentTime-      act-      t1 <- getCurrentTime-      return . ceiling $! (t1 `diffUTCTime` t0) * 1e6 -- microseconds+getCurTime = posixTimeToModTime `fmap` getPOSIXTime

@@ -230,7 +230,7 @@  -- take a look at the next cmd line arg and decide what to do with it getNext :: String -> [String] -> [OptDescr a] -> (OptKind a, [String])-getNext ('-' : '-' : []) rest _ = (EndOfOpts, rest)+getNext ['-', '-'] rest _ = (EndOfOpts, rest) getNext ('-' : '-' : xs) rest optDescr = longOpt xs rest optDescr getNext ('-' : x : xs) rest optDescr = shortOpt x xs rest optDescr getNext a rest _ = (NonOpt a, rest)

@@ -1,201 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}-----------------------------------------------------------------------------------                      copy :---                              $(MAKE) install prefix=$(destdir)/$(prefix) \---                                              bindir=$(destdir)/$(bindir) \---- |--- Module      :  Distribution.Make--- Copyright   :  Martin Sj&#xF6;gren 2004--- License     :  BSD3------ Maintainer  :  cabal-devel@haskell.org--- Portability :  portable------ This is an alternative build system that delegates everything to the @make@--- program. All the commands just end up calling @make@ with appropriate--- arguments. The intention was to allow preexisting packages that used--- makefiles to be wrapped into Cabal packages. In practice essentially all--- such packages were converted over to the \"Simple\" build system instead.--- Consequently this module is not used much and it certainly only sees cursory--- maintenance and no testing. Perhaps at some point we should stop pretending--- that it works.------ Uses the parsed command-line from "Distribution.Simple.Setup" in order to build--- Haskell tools using a back-end build system based on make. Obviously we--- assume that there is a configure script, and that after the ConfigCmd has--- been run, there is a Makefile. Further assumptions:------ [ConfigCmd] We assume the configure script accepts---              @--with-hc@,---              @--with-hc-pkg@,---              @--prefix@,---              @--bindir@,---              @--libdir@,---              @--libexecdir@,---              @--datadir@.------ [BuildCmd] We assume that the default Makefile target will build everything.------ [InstallCmd] We assume there is an @install@ target. Note that we assume that--- this does *not* register the package!------ [CopyCmd]    We assume there is a @copy@ target, and a variable @$(destdir)@.---              The @copy@ target should probably just invoke @make install@---              recursively (e.g. @$(MAKE) install prefix=$(destdir)\/$(prefix)---              bindir=$(destdir)\/$(bindir)@. The reason we can\'t invoke @make---              install@ directly here is that we don\'t know the value of @$(prefix)@.------ [SDistCmd] We assume there is a @dist@ target.------ [RegisterCmd] We assume there is a @register@ target and a variable @$(user)@.------ [UnregisterCmd] We assume there is an @unregister@ target.------ [HaddockCmd] We assume there is a @docs@ or @doc@ target.-module Distribution.Make-  ( module Distribution.Package-  , License (..)-  , Version-  , defaultMain-  , defaultMainArgs-  ) where--import Distribution.Compat.Prelude-import Prelude ()---- local-import Distribution.License-import Distribution.Package-import Distribution.Pretty-import Distribution.Simple.Command-import Distribution.Simple.Program-import Distribution.Simple.Setup-import Distribution.Simple.Utils-import Distribution.Version--import System.Environment (getArgs, getProgName)--defaultMain :: IO ()-defaultMain = getArgs >>= defaultMainArgs--defaultMainArgs :: [String] -> IO ()-defaultMainArgs = defaultMainHelper--defaultMainHelper :: [String] -> IO ()-defaultMainHelper args = do-  command <- commandsRun (globalCommand commands) commands args-  case command of-    CommandHelp help -> printHelp help-    CommandList opts -> printOptionsList opts-    CommandErrors errs -> printErrors errs-    CommandReadyToGo (flags, commandParse) ->-      case commandParse of-        _-          | fromFlag (globalVersion flags) -> printVersion-          | fromFlag (globalNumericVersion flags) -> printNumericVersion-        CommandHelp help -> printHelp help-        CommandList opts -> printOptionsList opts-        CommandErrors errs -> printErrors errs-        CommandReadyToGo action -> action-  where-    printHelp help = getProgName >>= putStr . help-    printOptionsList = putStr . unlines-    printErrors errs = do-      putStr (intercalate "\n" errs)-      exitWith (ExitFailure 1)-    printNumericVersion = putStrLn $ prettyShow cabalVersion-    printVersion =-      putStrLn $-        "Cabal library version "-          ++ prettyShow cabalVersion-    progs = defaultProgramDb-    commands =-      [ configureCommand progs `commandAddAction` configureAction-      , buildCommand progs `commandAddAction` buildAction-      , installCommand `commandAddAction` installAction-      , copyCommand `commandAddAction` copyAction-      , haddockCommand `commandAddAction` haddockAction-      , cleanCommand `commandAddAction` cleanAction-      , sdistCommand `commandAddAction` sdistAction-      , registerCommand `commandAddAction` registerAction-      , unregisterCommand `commandAddAction` unregisterAction-      ]--configureAction :: ConfigFlags -> [String] -> IO ()-configureAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ configVerbosity flags-      mbWorkDir = flagToMaybe $ configWorkingDir flags-  rawSystemExit verbosity mbWorkDir "sh" $-    "configure"-      : configureArgs backwardsCompatHack flags-  where-    backwardsCompatHack = True--copyAction :: CopyFlags -> [String] -> IO ()-copyAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ copyVerbosity flags-      mbWorkDir = flagToMaybe $ copyWorkingDir flags-      destArgs = case fromFlag $ copyDest flags of-        NoCopyDest -> ["install"]-        CopyTo path -> ["copy", "destdir=" ++ path]-        CopyToDb _ -> error "CopyToDb not supported via Make"--  rawSystemExit verbosity mbWorkDir "make" destArgs--installAction :: InstallFlags -> [String] -> IO ()-installAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ installVerbosity flags-      mbWorkDir = flagToMaybe $ installWorkingDir flags-  rawSystemExit verbosity mbWorkDir "make" ["install"]-  rawSystemExit verbosity mbWorkDir "make" ["register"]--haddockAction :: HaddockFlags -> [String] -> IO ()-haddockAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ haddockVerbosity flags-      mbWorkDir = flagToMaybe $ haddockWorkingDir flags-  rawSystemExit verbosity mbWorkDir "make" ["docs"]-    `catchIO` \_ ->-      rawSystemExit verbosity mbWorkDir "make" ["doc"]--buildAction :: BuildFlags -> [String] -> IO ()-buildAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ buildVerbosity flags-      mbWorkDir = flagToMaybe $ buildWorkingDir flags-  rawSystemExit verbosity mbWorkDir "make" []--cleanAction :: CleanFlags -> [String] -> IO ()-cleanAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ cleanVerbosity flags-      mbWorkDir = flagToMaybe $ cleanWorkingDir flags-  rawSystemExit verbosity mbWorkDir "make" ["clean"]--sdistAction :: SDistFlags -> [String] -> IO ()-sdistAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ sDistVerbosity flags-      mbWorkDir = flagToMaybe $ sDistWorkingDir flags-  rawSystemExit verbosity mbWorkDir "make" ["dist"]--registerAction :: RegisterFlags -> [String] -> IO ()-registerAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ registerVerbosity flags-      mbWorkDir = flagToMaybe $ registerWorkingDir flags-  rawSystemExit verbosity mbWorkDir "make" ["register"]--unregisterAction :: RegisterFlags -> [String] -> IO ()-unregisterAction flags args = do-  noExtraFlags args-  let verbosity = fromFlag $ registerVerbosity flags-      mbWorkDir = flagToMaybe $ registerWorkingDir flags-  rawSystemExit verbosity mbWorkDir "make" ["unregister"]

@@ -47,10 +47,13 @@ import Prelude ()  import Data.List (group)+import qualified Data.List as L import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.Compiler+import Distribution.FieldGrammar.Parsec (freeTextIgnoreDotlineVers) import Distribution.License+import Distribution.ModuleName (toFilePath) import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Check.Common@@ -79,12 +82,15 @@ import qualified Distribution.SPDX as SPDX import qualified System.Directory as System -import qualified System.Directory (getDirectoryContents)+import qualified System.Directory (listDirectory) import qualified System.FilePath.Windows as FilePath.Windows (isValid)  import qualified Data.Set as Set import qualified Distribution.Utils.ShortText as ShortText+import qualified Distribution.Utils.String as String +import qualified Distribution.Compat.Lens as L+import qualified Distribution.Types.BuildInfo.Lens as L import qualified Distribution.Types.GenericPackageDescription.Lens as L  import Control.Monad@@ -171,14 +177,14 @@       CheckPackageContentOps         { doesFileExist = System.doesFileExist . relative         , doesDirectoryExist = System.doesDirectoryExist . relative-        , getDirectoryContents = System.Directory.getDirectoryContents . relative+        , listDirectory = System.Directory.listDirectory . relative         , getFileContents = BS.readFile . relative         }      checkPreIO =       CheckPreDistributionOps         { runDirFileGlobM = \fp g -> runDirFileGlob verbosity (Just . specVersion $ packageDescription gpd) (root </> fp) g-        , getDirectoryContentsM = System.Directory.getDirectoryContents . relative+        , listDirectoryM = System.Directory.listDirectory . relative         }      relative :: FilePath -> FilePath@@ -239,7 +245,7 @@       -- Targets should be present...       let condAllLibraries =             maybeToList condLibrary_-              ++ (map snd condSubLibraries_)+              ++ map snd condSubLibraries_       checkP         ( and             [ null condExecutables_@@ -348,6 +354,18 @@        -- Duplicate modules.       mapM_ tellP (checkDuplicateModules gpd)++      -- Module name checks (path validity on Windows and tar).+      -- We collect all unique module names from the GPD and check each+      -- once, rather than re-checking in every conditional branch.+      let allModuleNames =+            Set.fromList $+              maybe [] (explicitLibModules . ignoreConditions) condLibrary_+                ++ concatMap (explicitLibModules . ignoreConditions . snd) condSubLibraries_+                ++ concatMap (exeModules . ignoreConditions . snd) condExecutables_+                ++ concatMap (testModules . ignoreConditions . snd) condTestSuites_+                ++ concatMap (benchmarkModules . ignoreConditions . snd) condBenchmarks_+      mapM_ (\m -> checkPackageFileNamesWithGlob PathKindFile (toFilePath m)) allModuleNames     where       -- todo is this caught at parse time?       checkFlagName :: Monad m => PackageFlag -> CheckM m ()@@ -423,7 +441,7 @@     -- But it is OK for executables to have the same name.     nsubs <- asksCM (pnSubLibs . ccNames)     checkP-      (any (== prettyShow pn) (prettyShow <$> nsubs))+      (prettyShow pn `elem` (prettyShow <$> nsubs))       (PackageBuildImpossible $ IllegalLibraryName pn)      -- § Fields check.@@ -451,6 +469,20 @@       )       (PackageDistSuspicious ShortDesc) +    -- § Freeform fields no longer include "dotlines". Generally taken from+    -- Distribution.PackageDescription.FieldGrammar fields that use some+    -- freeTextField parser.+    checkDotline "author" _author_+    checkDotline "bug-reports" _bugReports_+    checkDotline "category" category_+    checkDotline "copyright" _copyright_+    checkDotline "description" description_+    checkDotline "homepage" _homepage_+    checkDotline "maintainer" maintainer_+    checkDotline "package-url" _pkgUrl_+    checkDotline "stability" _stability_+    checkDotline "synopsis" synopsis_+     -- § Paths.     mapM_ (checkPath False "extra-source-files" PathKindGlob . getSymbolicPath) extraSrcFiles_     mapM_ (checkPath False "extra-tmp-files" PathKindFile . getSymbolicPath) extraTmpFiles_@@ -507,7 +539,7 @@       ( isNothing setupBuildInfo_           && buildTypeRaw_ == Just Custom       )-      (PackageDistSuspiciousWarn CVExpliticDepsCustomSetup)+      (PackageDistSuspiciousWarn CVExplicitDepsCustomSetup)     checkP       (isNothing buildTypeRaw_ && specVersion_ < CabalSpecV2_2)       (PackageBuildWarning NoBuildType)@@ -557,6 +589,19 @@              in tellP (PackageDistInexcusable (InvalidTestWith dep))           ) +-- | Issue a warning if the text contains any "dotlines".+checkDotline :: Monad m => String -> ShortText.ShortText -> CheckM m ()+checkDotline fieldName fieldVal = do+  checkSpecVerGte+    freeTextIgnoreDotlineVers+    (hasDotline fieldVal)+    (PackageDistSuspiciousWarn $ FreeTextDotline fieldName)+  where+    hasDotline =+      L.any ((== ".") . String.trim)+        . L.lines+        . ShortText.fromShortText+ checkSetupBuildInfo :: Monad m => Maybe SetupBuildInfo -> CheckM m () checkSetupBuildInfo Nothing = return () checkSetupBuildInfo (Just (SetupBuildInfo ds _)) = do@@ -586,8 +631,7 @@   checkP     (not . FilePath.Windows.isValid . prettyShow $ pkgName_)     (PackageDistInexcusable $ InvalidNameWin pkgName_)-  checkP (isPrefixOf "z-" . prettyShow $ pkgName_) $-    (PackageDistInexcusable ZPrefix)+  checkP (isPrefixOf "z-" . prettyShow $ pkgName_) (PackageDistInexcusable ZPrefix)  checkNewLicense :: Monad m => SPDX.License -> CheckM m () checkNewLicense lic = do@@ -629,7 +673,7 @@         -- licenses so don't need license files.         nullLicFiles     )-    $ (PackageDistSuspicious NoLicenseFile)+    (PackageDistSuspicious NoLicenseFile)   case unknownLicenseVersion lic of     Just knownVersions ->       tellP@@ -706,7 +750,7 @@         checkP           (any isAbsoluteOnAnyPlatform repoSubdir_)           (PackageDistInexcusable SubdirRelPath)-        case join . fmap isGoodRelativeDirectoryPath $ repoSubdir_ of+        case isGoodRelativeDirectoryPath =<< repoSubdir_ of           Just err ->             tellP               (PackageDistInexcusable $ SubdirGoodRelPath err)@@ -754,7 +798,7 @@ findPackageDesc :: Monad m => CheckPackageContentOps m -> m [FilePath] findPackageDesc ops = do   let dir = "."-  files <- getDirectoryContents ops dir+  files <- listDirectory ops dir   -- to make sure we do not mistake a ~/.cabal/ dir for a <name>.cabal   -- file we filter to exclude dirs and null base file names:   cabalFiles <-@@ -833,7 +877,9 @@     ( \ops -> do         ba <- doesFileExist ops "Setup.hs"         bb <- doesFileExist ops "Setup.lhs"-        return (not $ ba || bb)+        bc <- doesFileExist ops "SetupHooks.hs"+        bd <- doesFileExist ops "SetupHooks.lhs"+        return (not $ ba || bb || bc || bd)     )     (PackageDistInexcusable MissingSetupFile) @@ -882,7 +928,7 @@   -- one).   -> [GlobResult FilePath] -- List of glob results.   -> [PackageCheck]-checkGlobResult title fp rs = dirCheck ++ catMaybes (map getWarning rs)+checkGlobResult title fp rs = dirCheck ++ mapMaybe getWarning rs   where     dirCheck       | all (not . withoutNoMatchesWarning) rs =@@ -936,14 +982,14 @@ -- each of those branch will be checked one by one. extractAssocDeps   :: UnqualComponentName -- Name of the target library-  -> CondTree ConfVar [Dependency] Library+  -> CondTree ConfVar Library   -> AssocDep extractAssocDeps n ct =   let a = ignoreConditions ct    in -- Merging is fine here, remember the specific       -- library dependencies will be checked branch       -- by branch.-      (n, snd a)+      (n, L.view L.targetBuildDepends a)  -- | August 2022: this function is an oddity due to the historical -- GenericPackageDescription/PackageDescription split (check@@ -979,8 +1025,8 @@         }      -- From target to simple, unconditional CondTree.-    t2c :: a -> CondTree ConfVar [Dependency] a-    t2c a = CondNode a [] []+    t2c :: a -> CondTree ConfVar a+    t2c a = CondNode a []      -- From named target to unconditional CondTree. Notice we have     -- a function to extract the name *and* a function to modify@@ -990,7 +1036,7 @@       :: (a -> UnqualComponentName)       -> (a -> a)       -> a-      -> (UnqualComponentName, CondTree ConfVar [Dependency] a)+      -> (UnqualComponentName, CondTree ConfVar a)     t2cName nf mf a = (nf a, t2c . mf $ a)      ln :: Library -> UnqualComponentName@@ -1022,8 +1068,8 @@     ciPreDistOps     ( \ops -> do         -- 1. Get root files, see if they are interesting to us.-        rootContents <- getDirectoryContentsM ops "."-        -- Recall getDirectoryContentsM arg is relative to root path.+        rootContents <- listDirectoryM ops "."+        -- Recall listDirectoryM arg is relative to root path.         let des = filter isDesirableExtraDocFile rootContents          -- 2. Realise Globs.@@ -1060,13 +1106,10 @@       -> [FilePath] -- Actuals.       -> [PackageCheck]     checkDoc b ds as =-      let fds = map ("." </>) $ filter (flip notElem as) ds-       in if null fds-            then []-            else-              [ PackageDistSuspiciousWarn $-                  MissingExpectedDocFiles b fds-              ]+      [ PackageDistSuspiciousWarn $ MissingExpectedDocFiles b fds+      | let fds = map ("." </>) $ filter (`notElem` as) ds+      , not (null fds)+      ]      checkDocMove       :: Bool -- Cabal spec ≥ 1.18?@@ -1075,13 +1118,10 @@       -> [FilePath] -- Actuals.       -> [PackageCheck]     checkDocMove b field ds as =-      let fds = filter (flip elem as) ds-       in if null fds-            then []-            else-              [ PackageDistSuspiciousWarn $-                  WrongFieldForExpectedDocFiles b field fds-              ]+      [ PackageDistSuspiciousWarn $ WrongFieldForExpectedDocFiles b field fds+      | let fds = filter (`elem` as) ds+      , not (null fds)+      ]  -- Predicate for desirable documentation file on Hackage server. isDesirableExtraDocFile :: FilePath -> Bool

@@ -26,6 +26,7 @@ import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Check.Monad+import Distribution.Simple.Utils (ordNub) import Distribution.Utils.Generic (isAscii) import Distribution.Version @@ -61,7 +62,7 @@ -- be used together with checkPVP. Important: usually “base” or “Cabal”, -- as the error is slightly different. -- Note that `partitionDeps` will also filter out dependencies which are--- already present in a inherithed fashion (e.g. an exe which imports the+-- already present in a inherited fashion (e.g. an exe which imports the -- main library will not need to specify upper bounds on shared dependencies, -- hence we do not return those). --@@ -80,7 +81,7 @@     -- shared targets that match     fads = filter (flip elem dqs . fst) ads     -- the names of such targets-    inName = nub $ map fst fads :: [UnqualComponentName]+    inName = ordNub $ map fst fads :: [UnqualComponentName]     -- the dependencies of such targets     inDep = concatMap snd fads :: [Dependency] 

@@ -1,4 +1,6 @@+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}  -- | -- Module      :  Distribution.PackageDescription.Check.Conditional@@ -21,7 +23,6 @@  import Distribution.Compiler import Distribution.ModuleName (ModuleName)-import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Check.Monad import Distribution.System@@ -61,21 +62,18 @@    . (Eq a, Monoid a)   => [PackageFlag] -- User flags.   -> TargetAnnotation a-  -> CondTree ConfVar [Dependency] a-  -> CondTree ConfVar [Dependency] (TargetAnnotation a)-annotateCondTree fs ta (CondNode a c bs) =+  -> CondTree ConfVar a+  -> CondTree ConfVar (TargetAnnotation a)+annotateCondTree fs ta (CondNode a bs) =   let ta' = updateTargetAnnotation a ta       bs' = map (annotateBranch ta') bs       bs'' = crossAnnotateBranches defTrueFlags bs'-   in CondNode ta' c bs''+   in CondNode ta' bs''   where     annotateBranch       :: TargetAnnotation a-      -> CondBranch ConfVar [Dependency] a-      -> CondBranch-          ConfVar-          [Dependency]-          (TargetAnnotation a)+      -> CondBranch ConfVar a+      -> CondBranch ConfVar (TargetAnnotation a)     annotateBranch wta (CondBranch k t mf) =       let uf = isPkgFlagCond k           wta' = wta{taPackageFlag = taPackageFlag wta || uf}@@ -92,7 +90,7 @@     -- \*off* by default.     isPkgFlagCond :: Condition ConfVar -> Bool     isPkgFlagCond (Lit _) = False-    isPkgFlagCond (Var (PackageFlag f)) = elem f defOffFlags+    isPkgFlagCond (Var (PackageFlag f)) = f `elem` defOffFlags     isPkgFlagCond (Var _) = False     isPkgFlagCond (CNot cn) = not (isPkgFlagCond cn)     isPkgFlagCond (CAnd ca cb) = isPkgFlagCond ca || isPkgFlagCond cb@@ -117,13 +115,13 @@   :: forall a    . (Eq a, Monoid a)   => [PackageFlag] -- `default: true` flags.-  -> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]-  -> [CondBranch ConfVar [Dependency] (TargetAnnotation a)]+  -> [CondBranch ConfVar (TargetAnnotation a)]+  -> [CondBranch ConfVar (TargetAnnotation a)] crossAnnotateBranches fs bs = map crossAnnBranch bs   where     crossAnnBranch-      :: CondBranch ConfVar [Dependency] (TargetAnnotation a)-      -> CondBranch ConfVar [Dependency] (TargetAnnotation a)+      :: CondBranch ConfVar (TargetAnnotation a)+      -> CondBranch ConfVar (TargetAnnotation a)     crossAnnBranch wr =       let         rs = filter (/= wr) bs@@ -131,24 +129,23 @@        in         updateTargetAnnBranch (mconcat ts) wr -    realiseBranch :: CondBranch ConfVar [Dependency] (TargetAnnotation a) -> Maybe a+    realiseBranch :: CondBranch ConfVar (TargetAnnotation a) -> Maybe a     realiseBranch b =       let         -- We are only interested in True by default package flags.         realiseBranchFunction :: ConfVar -> Either ConfVar Bool         realiseBranchFunction (PackageFlag n) | elem n (map flagName fs) = Right True         realiseBranchFunction _ = Right False-        ms = simplifyCondBranch realiseBranchFunction (fmap taTarget b)        in-        fmap snd ms+        simplifyCondBranch realiseBranchFunction (fmap taTarget b)      updateTargetAnnBranch       :: a-      -> CondBranch ConfVar [Dependency] (TargetAnnotation a)-      -> CondBranch ConfVar [Dependency] (TargetAnnotation a)+      -> CondBranch ConfVar (TargetAnnotation a)+      -> CondBranch ConfVar (TargetAnnotation a)     updateTargetAnnBranch a (CondBranch k t mt) =-      let updateTargetAnnTree (CondNode ka c wbs) =-            (CondNode (updateTargetAnnotation a ka) c wbs)+      let updateTargetAnnTree (CondNode ka wbs) =+            CondNode (updateTargetAnnotation a ka) wbs        in CondBranch k (updateTargetAnnTree t) (updateTargetAnnTree <$> mt)  -- | A conditional target is a library, exe, benchmark etc., destructured@@ -163,7 +160,7 @@   -- Naming function (some targets   -- need to have their name   -- spoonfed to them.-  -> (UnqualComponentName, CondTree ConfVar [Dependency] a)+  -> (UnqualComponentName, CondTree ConfVar a)   -- Target name/condtree.   -> CheckM m () checkCondTarget fs cf nf (unqualName, ct) =@@ -172,9 +169,9 @@     -- Walking the tree. Remember that CondTree is not a binary     -- tree but a /rose/tree.     wTree-      :: CondTree ConfVar [Dependency] (TargetAnnotation a)+      :: CondTree ConfVar (TargetAnnotation a)       -> CheckM m ()-    wTree (CondNode ta _ bs)+    wTree (CondNode ta bs)       -- There are no branches ([] == True) *or* every branch       -- is “simple” (i.e. missing a 'condBranchIfFalse' part).       -- This is convenient but not necessarily correct in all@@ -190,13 +187,13 @@           mapM_ wBranch bs      isSimple-      :: CondBranch ConfVar [Dependency] (TargetAnnotation a)+      :: CondBranch ConfVar (TargetAnnotation a)       -> Bool     isSimple (CondBranch _ _ Nothing) = True     isSimple (CondBranch _ _ (Just _)) = False      wBranch-      :: CondBranch ConfVar [Dependency] (TargetAnnotation a)+      :: CondBranch ConfVar (TargetAnnotation a)       -> CheckM m ()     wBranch (CondBranch k t mf) = do       checkCondVars k@@ -228,38 +225,31 @@ checkDuplicateModules :: GenericPackageDescription -> [PackageCheck] checkDuplicateModules pkg =   concatMap checkLib (maybe id (:) (condLibrary pkg) . map snd $ condSubLibraries pkg)-    ++ concatMap checkExe (map snd $ condExecutables pkg)-    ++ concatMap checkTest (map snd $ condTestSuites pkg)-    ++ concatMap checkBench (map snd $ condBenchmarks pkg)+    ++ concatMap (checkExe . snd) (condExecutables pkg)+    ++ concatMap (checkTest . snd) (condTestSuites pkg)+    ++ concatMap (checkBench . snd) (condBenchmarks pkg)   where     -- the duplicate modules check is has not been thoroughly vetted for backpack     checkLib = checkDups "library" (\l -> explicitLibModules l ++ map moduleReexportName (reexportedModules l))     checkExe = checkDups "executable" exeModules     checkTest = checkDups "test suite" testModules     checkBench = checkDups "benchmark" benchmarkModules-    checkDups :: String -> (a -> [ModuleName]) -> CondTree v c a -> [PackageCheck]+    checkDups :: String -> (a -> [ModuleName]) -> CondTree v a -> [PackageCheck]     checkDups s getModules t =       let sumPair (x, x') (y, y') = (x + x' :: Int, y + y' :: Int)           mergePair (x, x') (y, y') = (x + x', max y y')           maxPair (x, x') (y, y') = (max x x', max y y')+          libMap :: Map ModuleName (Int, Int)           libMap =             foldCondTree               Map.empty-              (\(_, v) -> Map.fromListWith sumPair . map (\x -> (x, (1, 1))) $ getModules v)+              (\v -> Map.fromListWith sumPair . map (,(1, 1)) $ getModules v)               (Map.unionWith mergePair) -- if a module may occur in nonexclusive branches count it twice strictly and once loosely.               (Map.unionWith maxPair) -- a module occurs the max of times it might appear in exclusive branches               t           dupLibsStrict = Map.keys $ Map.filter ((> 1) . fst) libMap           dupLibsLax = Map.keys $ Map.filter ((> 1) . snd) libMap-       in if not (null dupLibsLax)-            then-              [ PackageBuildImpossible-                  (DuplicateModule s dupLibsLax)-              ]-            else-              if not (null dupLibsStrict)-                then-                  [ PackageDistSuspicious-                      (PotentialDupModule s dupLibsStrict)-                  ]-                else []+       in if+              | not (null dupLibsLax) -> [PackageBuildImpossible (DuplicateModule s dupLibsLax)]+              | not (null dupLibsStrict) -> [PackageDistSuspicious (PotentialDupModule s dupLibsStrict)]+              | otherwise -> []

@@ -39,6 +39,7 @@   , liftInt   , tellP   , checkSpecVer+  , checkSpecVerGte   ) where  import Distribution.Compat.Prelude@@ -92,7 +93,7 @@ data CheckPackageContentOps m = CheckPackageContentOps   { doesFileExist :: FilePath -> m Bool   , doesDirectoryExist :: FilePath -> m Bool-  , getDirectoryContents :: FilePath -> m [FilePath]+  , listDirectory :: FilePath -> m [FilePath]   , getFileContents :: FilePath -> m BS.ByteString   } @@ -102,7 +103,7 @@ -- (e.g. a VCS work tree). data CheckPreDistributionOps m = CheckPreDistributionOps   { runDirFileGlobM :: FilePath -> Glob -> m [GlobResult FilePath]-  , getDirectoryContentsM :: FilePath -> m [FilePath]+  , listDirectoryM :: FilePath -> m [FilePath]   }  -- | Context to perform checks (will be the Reader part in your monad).@@ -135,8 +136,7 @@ -- | Creates a pristing 'CheckCtx'. With pristine we mean everything that -- can be deduced by GPD but *not* user flags information. pristineCheckCtx-  :: Monad m-  => CheckInterface m+  :: CheckInterface m   -> GenericPackageDescription   -> CheckCtx m pristineCheckCtx ci gpd =@@ -150,7 +150,7 @@  -- | Adds useful bits to 'CheckCtx' (as now, whether we are operating under -- a user off-by-default flag).-initCheckCtx :: Monad m => TargetAnnotation a -> CheckCtx m -> CheckCtx m+initCheckCtx :: TargetAnnotation a -> CheckCtx m -> CheckCtx m initCheckCtx t c = c{ccFlag = taPackageFlag t}  -- | 'TargetAnnotation' collects contextual information on the target we are@@ -322,7 +322,7 @@   po <- asksCM (acc . ccInterface)   maybe (return ()) (lc . mck) po   where-    lc :: Monad m => m (Maybe PackageCheck) -> CheckM m ()+    lc :: m (Maybe PackageCheck) -> CheckM m ()     lc wmck = do       b <- liftCM wmck       maybe (return ()) (check True) b@@ -369,3 +369,16 @@ checkSpecVer vc cond c = do   vp <- asksCM ccSpecVersion   unless (vp >= vc) (checkP cond c)++-- | Like 'checkSpecVer', except performs the check when our+-- spec version >= the param.+checkSpecVerGte+  :: Monad m+  => CabalSpecVersion -- Perform this check only if our+  -- spec version is >= than this.+  -> Bool -- Check condition.+  -> PackageCheck -- Check message.+  -> CheckM m ()+checkSpecVerGte vc cond c = do+  vp <- asksCM ccSpecVersion+  when (vp >= vc) (checkP cond c)

@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ -- | -- Module      :  Distribution.PackageDescription.Check.Target -- Copyright   :  Lennart Kolmodin 2008, Francesco Ariis 2023@@ -21,7 +23,7 @@ import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.Compiler-import Distribution.ModuleName (ModuleName, toFilePath)+import Distribution.ModuleName (ModuleName) import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Check.Common@@ -61,8 +63,6 @@           _libVisibility_           libBuildInfo_         ) = do-    mapM_ checkModuleName (explicitLibModules lib)-     checkP       (libName_ == LMainLibName && isSub)       (PackageBuildImpossible UnnamedInternal)@@ -79,7 +79,7 @@     checkP       ( not $           all-            (flip elem (explicitLibModules lib))+            (`elem` explicitLibModules lib)             (libModulesAutogen lib)       )       (PackageBuildImpossible AutogenNotExposed)@@ -91,7 +91,7 @@             (flip elem (allExplicitIncludes lib) . getSymbolicPath)             (view L.autogenIncludes lib)       )-      $ (PackageBuildImpossible AutogenIncludesNotIncluded)+      (PackageBuildImpossible AutogenIncludesNotIncluded)      -- § Build infos.     checkBuildInfo@@ -146,8 +146,6 @@     let cet = CETExecutable exeName_         modulePath_ = getSymbolicPath symbolicModulePath_ -    mapM_ checkModuleName (exeModules exe)-     -- § Exe specific checks     checkP       (null modulePath_)@@ -157,7 +155,7 @@     checkP       ( pid /= fakePackageId           && not (null modulePath_)-          && not (fileExtensionSupportedLanguage $ modulePath_)+          && not (fileExtensionSupportedLanguage modulePath_)       )       (PackageBuildImpossible NoHsLhsMain) @@ -172,7 +170,7 @@     -- Alas exeModules ad exeModulesAutogen (exported from     -- Distribution.Types.Executable) take `Executable` as a parameter.     checkP-      (not $ all (flip elem (exeModules exe)) (exeModulesAutogen exe))+      (not $ all (`elem` exeModules exe) (exeModulesAutogen exe))       (PackageBuildImpossible $ AutogenNoOther cet)     checkP       ( not $@@ -209,16 +207,13 @@       TestSuiteUnsupported tt ->         tellP (PackageBuildWarning $ TestsuiteNotSupported tt)       _ -> return ()--    mapM_ checkModuleName (testModules ts)-     checkP       mainIsWrongExt       (PackageBuildImpossible NoHsLhsMain)     checkP       ( not $           all-            (flip elem (testModules ts))+            (`elem` testModules ts)             (testModulesAutogen ts)       )       (PackageBuildImpossible $ AutogenNoOther cet)@@ -264,8 +259,6 @@     -- Target type/name (benchmark).     let cet = CETBenchmark benchmarkName_ -    mapM_ checkModuleName (benchmarkModules bm)-     -- § Interface & bm specific tests.     case benchmarkInterface_ of       BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) ->@@ -280,7 +273,7 @@     checkP       ( not $           all-            (flip elem (benchmarkModules bm))+            (`elem` benchmarkModules bm)             (benchmarkModulesAutogen bm)       )       (PackageBuildImpossible $ AutogenNoOther cet)@@ -303,11 +296,6 @@           BenchmarkExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]           _ -> False --- | Check if a module name is valid on both Windows and Posix systems-checkModuleName :: Monad m => ModuleName -> CheckM m ()-checkModuleName moduleName =-  checkPackageFileNamesWithGlob PathKindFile (toFilePath moduleName)- -- ------------------------------------------------------------ -- Build info -- ------------------------------------------------------------@@ -395,7 +383,7 @@   mapM_ checkIntDep (targetBuildDepends bi)   df <- asksCM ccDesugar   -- This way we can use the same function for legacy&non exedeps.-  let ds = buildToolDepends bi ++ catMaybes (map df $ buildTools bi)+  let ds = buildToolDepends bi ++ mapMaybe df (buildTools bi)   mapM_ checkBTDep ds   where     checkLang :: Monad m => Language -> CheckM m ()@@ -540,8 +528,7 @@     (not . null $ extraDynLibFlavours bi)     (PackageDistInexcusable $ CVExtraDynamic [extraDynLibFlavours bi])   -- virtual-modules requires ≥ 2.2-  checkSpecVer CabalSpecV2_2 (not . null $ virtualModules bi) $-    (PackageDistInexcusable CVVirtualModules)+  checkSpecVer CabalSpecV2_2 (not . null $ virtualModules bi) (PackageDistInexcusable CVVirtualModules)   -- Check use of thinning and renaming.   checkSpecVer     CabalSpecV2_0@@ -572,8 +559,8 @@ checkBuildInfoExtensions :: Monad m => BuildInfo -> CheckM m () checkBuildInfoExtensions bi = do   let exts = allExtensions bi-      extCabal1_2 = nub $ filter (`elem` compatExtensionsExtra) exts-      extCabal1_4 = nub $ filter (`notElem` compatExtensions) exts+      extCabal1_2 = ordNub $ filter (`elem` compatExtensionsExtra) exts+      extCabal1_4 = ordNub $ filter (`notElem` compatExtensions) exts   -- As of Cabal-1.4 we can add new extensions without worrying   -- about breaking old versions of cabal.   checkSpecVer@@ -655,9 +642,7 @@         , DeriveDataTypeable         , ConstrainedClassMethods         ]-        ++ map-          DisableExtension-          [MonoPatBinds]+        ++ [DisableExtension MonoPatBinds]  -- Autogenerated modules (Paths_, PackageInfo_) checks. We could pass this -- function something more specific than the whole BuildInfo, but it would be@@ -692,7 +677,7 @@   -- PackageBuildImpossible and not merely PackageDistInexcusable.   checkSpecVer     CabalSpecV3_12-    (elem autoInfoModuleName allModsForAuto)+    (autoInfoModuleName `elem` allModsForAuto)     (PackageBuildImpossible CVAutogenPackageInfoGuard)   where     allModsForAuto :: [ModuleName]@@ -970,7 +955,7 @@         )         (PackageDistInexcusable . DynamicUnneeded)       checkFlagsP-        ( \opt -> case opt of+        ( \case             "-j" -> True             ('-' : 'j' : d : _) -> isDigit d             _ -> False

@@ -170,6 +170,7 @@   | UnknownExtensions [String]   | LanguagesAsExtension [String]   | DeprecatedExtensions [(Extension, Maybe Extension)]+  | FreeTextDotline String   | MissingFieldCategory   | MissingFieldMaintainer   | MissingFieldSynopsis@@ -244,7 +245,7 @@   | CVSourceRepository   | CVExtensions CabalSpecVersion [Extension]   | CVCustomSetup-  | CVExpliticDepsCustomSetup+  | CVExplicitDepsCustomSetup   | CVAutogenPaths   | CVAutogenPackageInfo   | CVAutogenPackageInfoGuard@@ -337,6 +338,7 @@   | CIUnknownExtensions   | CILanguagesAsExtension   | CIDeprecatedExtensions+  | CIFreeTextDotline   | CIMissingFieldCategory   | CIMissingFieldMaintainer   | CIMissingFieldSynopsis@@ -411,7 +413,7 @@   | CICVSourceRepository   | CICVExtensions   | CICVCustomSetup-  | CICVExpliticDepsCustomSetup+  | CICVExplicitDepsCustomSetup   | CICVAutogenPaths   | CICVAutogenPackageInfo   | CICVAutogenPackageInfoGuard@@ -483,6 +485,7 @@ checkExplanationId (UnknownExtensions{}) = CIUnknownExtensions checkExplanationId (LanguagesAsExtension{}) = CILanguagesAsExtension checkExplanationId (DeprecatedExtensions{}) = CIDeprecatedExtensions+checkExplanationId (FreeTextDotline{}) = CIFreeTextDotline checkExplanationId (MissingFieldCategory{}) = CIMissingFieldCategory checkExplanationId (MissingFieldMaintainer{}) = CIMissingFieldMaintainer checkExplanationId (MissingFieldSynopsis{}) = CIMissingFieldSynopsis@@ -557,7 +560,7 @@ checkExplanationId (CVSourceRepository{}) = CICVSourceRepository checkExplanationId (CVExtensions{}) = CICVExtensions checkExplanationId (CVCustomSetup{}) = CICVCustomSetup-checkExplanationId (CVExpliticDepsCustomSetup{}) = CICVExpliticDepsCustomSetup+checkExplanationId (CVExplicitDepsCustomSetup{}) = CICVExplicitDepsCustomSetup checkExplanationId (CVAutogenPaths{}) = CICVAutogenPaths checkExplanationId (CVAutogenPackageInfo{}) = CICVAutogenPackageInfo checkExplanationId (CVAutogenPackageInfoGuard{}) = CICVAutogenPackageInfoGuard@@ -636,6 +639,7 @@ ppCheckExplanationId CIUnknownExtensions = "unknown-extension" ppCheckExplanationId CILanguagesAsExtension = "languages-as-extensions" ppCheckExplanationId CIDeprecatedExtensions = "deprecated-extensions"+ppCheckExplanationId CIFreeTextDotline = "free-text-dotline" ppCheckExplanationId CIMissingFieldCategory = "no-category" ppCheckExplanationId CIMissingFieldMaintainer = "no-maintainer" ppCheckExplanationId CIMissingFieldSynopsis = "no-synopsis"@@ -710,7 +714,7 @@ ppCheckExplanationId CICVSourceRepository = "source-repository" ppCheckExplanationId CICVExtensions = "incompatible-extension" ppCheckExplanationId CICVCustomSetup = "no-setup-depends"-ppCheckExplanationId CICVExpliticDepsCustomSetup = "dependencies-setup"+ppCheckExplanationId CICVExplicitDepsCustomSetup = "dependencies-setup" ppCheckExplanationId CICVAutogenPaths = "no-autogen-paths" ppCheckExplanationId CICVAutogenPackageInfo = "no-autogen-pinfo" ppCheckExplanationId CICVAutogenPackageInfoGuard = "autogen-guard"@@ -910,6 +914,11 @@         ++ "'."       | (ext, Just replacement) <- ourDeprecatedExtensions       ]+ppExplanation (FreeTextDotline field) =+  "Empty lines with a dot '.' in field '"+    ++ field+    ++ "' are unnecessary for creating newlines "+    ++ "(and treated literally) in cabal 3.0+" ppExplanation MissingFieldCategory = "No 'category' field." ppExplanation MissingFieldMaintainer = "No 'maintainer' field." ppExplanation MissingFieldSynopsis = "No 'synopsis' field."@@ -926,7 +935,8 @@     ++ "(e.g. 'cabal info', Haddock, Hackage) below the 'synopsis' which "     ++ "serves as a headline. "     ++ "Please refer to <https://cabal.readthedocs.io/en/stable/"-    ++ "cabal-package.html#package-properties> for more details."+    ++ "cabal-package-description-file.html#package-properties> "+    ++ "for more details." ppExplanation (InvalidTestWith testedWithImpossibleRanges) =   "Invalid 'tested-with' version range: "     ++ commaSep (map prettyShow testedWithImpossibleRanges)@@ -1248,7 +1258,7 @@     ++ "that specifies the dependencies of the Setup.hs script itself. "     ++ "The 'setup-depends' field uses the same syntax as 'build-depends', "     ++ "so a simple example would be 'setup-depends: base, Cabal'."-ppExplanation CVExpliticDepsCustomSetup =+ppExplanation CVExplicitDepsCustomSetup =   "From version 1.24 cabal supports specifying explicit dependencies "     ++ "for Custom setup scripts. Consider using 'cabal-version: 1.24' or "     ++ "higher and adding a 'custom-setup' section with a 'setup-depends' "@@ -1463,7 +1473,8 @@     ++ quote (getSymbolicPath file)     ++ " which does not exist." ppExplanation MissingSetupFile =-  "The package is missing a Setup.hs or Setup.lhs script."+  "The package is missing a Setup.hs or Setup.lhs or SetupHooks.hs "+    ++ "or SetupHooks.lhs script." ppExplanation MissingConfigureScript =   "The 'build-type' is 'Configure' but there is no 'configure' script. "     ++ "You probably need to run 'autoreconf -i' to generate it."

@@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- {- Work around this warning:@@ -13,7 +14,6 @@              Deprecated: "Please use the new testing interface instead!" -} {-# OPTIONS_GHC -Wno-deprecations #-}-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  -- | -- Module      :  Distribution.Simple@@ -38,8 +38,7 @@ -- simple software. -- -- The original idea was that there could be different build systems that all--- presented the same compatible command line interfaces. There is still a--- "Distribution.Make" system but in practice no packages use it.+-- presented the same compatible command line interfaces. module Distribution.Simple   ( module Distribution.Package   , module Distribution.Version@@ -51,6 +50,7 @@   , defaultMain   , defaultMainNoRead   , defaultMainArgs+  , defaultMainArgsWithHandles      -- * Customization   , UserHooks (..)@@ -64,9 +64,25 @@      -- ** Standard sets of hooks   , simpleUserHooks+  , simpleUserHooksWithHandles   , autoconfUserHooks   , autoconfSetupHooks   , emptyUserHooks++    -- ** Simple actions (library interface)+  , configureAction+  , buildAction+  , replAction+  , installAction+  , copyAction+  , haddockAction+  , cleanAction+  , sdistAction+  , hscolourAction+  , registerAction+  , unregisterAction+  , testAction+  , benchAction   ) where  import Control.Exception (try)@@ -117,13 +133,9 @@  -- Base import Data.List (unionBy, (\\))-import System.Directory-  ( doesDirectoryExist-  , doesFileExist-  , removeDirectoryRecursive-  , removeFile-  )+import System.Directory (removePathForcibly) import System.Environment (getArgs, getProgName)+import System.IO (hPutStr, hPutStrLn)  -- | A simple implementation of @main@ for a Cabal setup script. -- It reads the package description file using IO, and performs the@@ -136,12 +148,17 @@ defaultMainArgs :: [String] -> IO () defaultMainArgs = defaultMainHelper simpleUserHooks +-- | A version of 'defaultMainArgs' that allows passing explicit verbosity handles.+defaultMainArgsWithHandles :: VerbosityHandles -> [String] -> IO ()+defaultMainArgsWithHandles verbHandles =+  defaultMainHelperWithHandles verbHandles simpleUserHooks+ defaultMainWithSetupHooks :: SetupHooks -> IO ()-defaultMainWithSetupHooks setup_hooks =-  getArgs >>= defaultMainWithSetupHooksArgs setup_hooks+defaultMainWithSetupHooks setupHooks =+  getArgs >>= defaultMainWithSetupHooksArgs setupHooks defaultVerbosityHandles -defaultMainWithSetupHooksArgs :: SetupHooks -> [String] -> IO ()-defaultMainWithSetupHooksArgs setupHooks =+defaultMainWithSetupHooksArgs :: SetupHooks -> VerbosityHandles -> [String] -> IO ()+defaultMainWithSetupHooksArgs setupHooks verbHandles =   defaultMainHelper $     simpleUserHooks       { confHook = setup_confHook@@ -153,13 +170,24 @@       , hscolourHook = setup_hscolourHook       }   where+    preBuildHook =+      case SetupHooks.preBuildComponentRules (SetupHooks.buildHooks setupHooks) of+        Nothing -> const $ return []+        Just pbcRules -> \pbci -> runPreBuildHooks verbHandles pbci pbcRules+    postBuildHook =+      case SetupHooks.postBuildComponentHook (SetupHooks.buildHooks setupHooks) of+        Nothing -> const $ return ()+        Just hk -> hk+     setup_confHook       :: (GenericPackageDescription, HookedBuildInfo)       -> ConfigFlags       -> IO LocalBuildInfo-    setup_confHook =+    setup_confHook p =       configure_setupHooks         (SetupHooks.configureHooks setupHooks)+        p+        verbHandles      setup_buildHook       :: PackageDescription@@ -168,12 +196,14 @@       -> BuildFlags       -> IO ()     setup_buildHook pkg_descr lbi hooks flags =-      build_setupHooks-        (SetupHooks.buildHooks setupHooks)-        pkg_descr-        lbi-        flags-        (allSuffixHandlers hooks)+      void $+        build_setupHooks+          (preBuildHook, postBuildHook)+          verbHandles+          pkg_descr+          lbi+          flags+          (allSuffixHandlers hooks)      setup_copyHook       :: PackageDescription@@ -184,6 +214,7 @@     setup_copyHook pkg_descr lbi _hooks flags =       install_setupHooks         (SetupHooks.installHooks setupHooks)+        verbHandles         pkg_descr         lbi         flags@@ -197,6 +228,7 @@     setup_installHook =       defaultInstallHook_setupHooks         (SetupHooks.installHooks setupHooks)+        verbHandles      setup_replHook       :: PackageDescription@@ -206,13 +238,15 @@       -> [String]       -> IO ()     setup_replHook pkg_descr lbi hooks flags args =-      repl_setupHooks-        (SetupHooks.buildHooks setupHooks)-        pkg_descr-        lbi-        flags-        (allSuffixHandlers hooks)-        args+      void $+        repl_setupHooks+          preBuildHook+          verbHandles+          pkg_descr+          lbi+          flags+          (allSuffixHandlers hooks)+          args      setup_haddockHook       :: PackageDescription@@ -221,12 +255,14 @@       -> HaddockFlags       -> IO ()     setup_haddockHook pkg_descr lbi hooks flags =-      haddock_setupHooks-        (SetupHooks.buildHooks setupHooks)-        pkg_descr-        lbi-        (allSuffixHandlers hooks)-        flags+      void $+        haddock_setupHooks+          preBuildHook+          verbHandles+          pkg_descr+          lbi+          (allSuffixHandlers hooks)+          flags      setup_hscolourHook       :: PackageDescription@@ -235,12 +271,14 @@       -> HscolourFlags       -> IO ()     setup_hscolourHook pkg_descr lbi hooks flags =-      hscolour_setupHooks-        (SetupHooks.buildHooks setupHooks)-        pkg_descr-        lbi-        (allSuffixHandlers hooks)-        flags+      void $+        hscolour_setupHooks+          preBuildHook+          verbHandles+          pkg_descr+          lbi+          (allSuffixHandlers hooks)+          flags  -- | A customizable version of 'defaultMain'. defaultMainWithHooks :: UserHooks -> IO ()@@ -281,38 +319,59 @@ -- getting 'CommandParse' data back, which is then pattern-matched into -- IO actions for execution, with arguments applied by the parser. defaultMainHelper :: UserHooks -> Args -> IO ()-defaultMainHelper hooks args = topHandler $ do-  args' <- expandResponse args-  command <- commandsRun (globalCommand commands) commands args'-  case command of-    CommandHelp help -> printHelp help-    CommandList opts -> printOptionsList opts-    CommandErrors errs -> printErrors errs-    CommandReadyToGo (globalFlags, commandParse) ->-      case commandParse of-        _-          | fromFlag (globalVersion globalFlags) -> printVersion-          | fromFlag (globalNumericVersion globalFlags) -> printNumericVersion-        CommandHelp help -> printHelp help-        CommandList opts -> printOptionsList opts-        CommandErrors errs -> printErrors errs-        CommandReadyToGo action -> action globalFlags+defaultMainHelper = defaultMainHelperWithHandles defaultVerbosityHandles++-- | A version of 'defaultMainHelper' that allows setting the logging handles.+defaultMainHelperWithHandles :: VerbosityHandles -> UserHooks -> Args -> IO ()+defaultMainHelperWithHandles verbHandles hooks args =+  topHandler (isUserException (Proxy @(VerboseException CabalException))) $ do+    args' <- expandResponse args+    command <- commandsRun (globalCommand commands) commands args'+    case command of+      CommandHelp help -> printHelp help+      CommandList opts -> printOptionsList opts+      CommandErrors errs -> printErrors errs+      CommandReadyToGo (globalFlags, commandParse) ->+        case commandParse of+          _+            | fromFlag (globalVersion globalFlags) -> printVersion+            | fromFlag (globalFullVersion globalFlags) -> printFullVersion+            | fromFlag (globalNumericVersion globalFlags) -> printNumericVersion+          CommandHelp help -> printHelp help+          CommandList opts -> printOptionsList opts+          CommandErrors errs -> printErrors errs+          CommandReadyToGo action -> action globalFlags   where-    printHelp help = getProgName >>= putStr . help-    printOptionsList = putStr . unlines+    outHandle = vStdoutHandle verbHandles+    printHelp help = getProgName >>= hPutStr outHandle . help+    printOptionsList = hPutStr outHandle . unlines     printErrors errs = do-      putStr (intercalate "\n" errs)+      hPutStr outHandle (intercalate "\n" errs)       exitWith (ExitFailure 1)-    printNumericVersion = putStrLn $ prettyShow cabalVersion+    printNumericVersion =+      hPutStrLn outHandle $ prettyShow cabalVersion     printVersion =-      putStrLn $+      hPutStrLn outHandle $         "Cabal library version "           ++ prettyShow cabalVersion-+    printFullVersion =+      hPutStrLn outHandle $+        "Cabal library version "+          ++ prettyShow cabalVersion+          ++ cabalGitInfo'+          ++ "\nwith "+          ++ cabalCompilerInfo+    cabalGitInfo'+      | null cabalGitInfo = []+      | otherwise = ' ' : cabalGitInfo     progs = addKnownPrograms (hookedPrograms hooks) defaultProgramDb-    addAction :: CommandUI flags -> (GlobalFlags -> UserHooks -> flags -> [String] -> IO res) -> Command (GlobalFlags -> IO ())+    addAction+      :: CommandUI flags+      -> (VerbosityHandles -> GlobalFlags -> UserHooks -> flags -> [String] -> IO res)+      -> Command (GlobalFlags -> IO ())     addAction cmd action =-      cmd `commandAddAction` \flags as globalFlags -> void $ action globalFlags hooks flags as+      cmd `commandAddAction` \flags as globalFlags ->+        void $ action verbHandles globalFlags hooks flags as     commands :: [Command (GlobalFlags -> IO ())]     commands =       [ configureCommand progs `addAction` configureAction@@ -341,8 +400,8 @@     overridesPP :: [PPSuffixHandler] -> [PPSuffixHandler] -> [PPSuffixHandler]     overridesPP = unionBy (\x y -> fst x == fst y) -configureAction :: GlobalFlags -> UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo-configureAction globalFlags hooks flags args = do+configureAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo+configureAction verbHandles globalFlags hooks flags args = do   distPref <- findDistPrefOrDefault (setupDistPref $ configCommonFlags flags)   let commonFlags = configCommonFlags flags       commonFlags' =@@ -356,7 +415,7 @@           { configCommonFlags = commonFlags'           }       mbWorkDir = flagToMaybe $ setupWorkingDir commonFlags'-      verbosity = fromFlag $ setupVerbosity commonFlags'+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity commonFlags')    -- See docs for 'HookedBuildInfo'   pbi <- preConf hooks args flags'@@ -404,17 +463,18 @@       return (Just pdfile, descr)  getCommonFlags-  :: GlobalFlags+  :: VerbosityHandles+  -> GlobalFlags   -> UserHooks   -> CommonSetupFlags   -> Args   -> IO (LocalBuildInfo, CommonSetupFlags)-getCommonFlags globalFlags hooks commonFlags args = do+getCommonFlags verbHandles globalFlags hooks commonFlags args = do   distPref <- findDistPrefOrDefault (setupDistPref commonFlags)-  let verbosity = fromFlag $ setupVerbosity commonFlags+  let verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity commonFlags)   lbi <- getBuildConfig globalFlags hooks verbosity distPref   let common' = configCommonFlags $ configFlags lbi-  return $+  return     ( lbi     , commonFlags         { setupDistPref = toFlag distPref@@ -427,11 +487,11 @@         }     ) -buildAction :: GlobalFlags -> UserHooks -> BuildFlags -> Args -> IO ()-buildAction globalFlags hooks flags args = do+buildAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> BuildFlags -> Args -> IO ()+buildAction verbHandles globalFlags hooks flags args = do   let common = buildCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{buildCommonFlags = common'}    progs <-@@ -451,11 +511,11 @@     flags'     args -replAction :: GlobalFlags -> UserHooks -> ReplFlags -> Args -> IO ()-replAction globalFlags hooks flags args = do+replAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> ReplFlags -> Args -> IO ()+replAction verbHandles globalFlags hooks flags args = do   let common = replCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{replCommonFlags = common'}   progs <-     reconfigurePrograms@@ -479,11 +539,11 @@   replHook hooks pkg_descr lbi' hooks flags' args   postRepl hooks args flags' pkg_descr lbi' -hscolourAction :: GlobalFlags -> UserHooks -> HscolourFlags -> Args -> IO ()-hscolourAction globalFlags hooks flags args = do+hscolourAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> HscolourFlags -> Args -> IO ()+hscolourAction verbHandles globalFlags hooks flags args = do   let common = hscolourCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (_lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{hscolourCommonFlags = common'}       distPref = fromFlag $ setupDistPref common' @@ -497,11 +557,11 @@     flags'     args -haddockAction :: GlobalFlags -> UserHooks -> HaddockFlags -> Args -> IO ()-haddockAction globalFlags hooks flags args = do+haddockAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> HaddockFlags -> Args -> IO ()+haddockAction verbHandles globalFlags hooks flags args = do   let common = haddockCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{haddockCommonFlags = common'}    progs <-@@ -521,10 +581,10 @@     flags'     args -cleanAction :: GlobalFlags -> UserHooks -> CleanFlags -> Args -> IO ()-cleanAction globalFlags hooks flags args = do+cleanAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> CleanFlags -> Args -> IO ()+cleanAction verbHandles globalFlags hooks flags args = do   let common = cleanCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)   distPref <- findDistPrefOrDefault (setupDistPref common)   elbi <- tryGetBuildConfig globalFlags hooks verbosity distPref   let common' =@@ -569,11 +629,11 @@   cleanHook hooks pkg_descr () hooks flags'   postClean hooks args flags' pkg_descr () -copyAction :: GlobalFlags -> UserHooks -> CopyFlags -> Args -> IO ()-copyAction globalFlags hooks flags args = do+copyAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> CopyFlags -> Args -> IO ()+copyAction verbHandles globalFlags hooks flags args = do   let common = copyCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (_lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{copyCommonFlags = common'}       distPref = fromFlag $ setupDistPref common'   hookedAction@@ -586,11 +646,11 @@     flags'     args -installAction :: GlobalFlags -> UserHooks -> InstallFlags -> Args -> IO ()-installAction globalFlags hooks flags args = do+installAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> InstallFlags -> Args -> IO ()+installAction verbHandles globalFlags hooks flags args = do   let common = installCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (_lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{installCommonFlags = common'}       distPref = fromFlag $ setupDistPref common'   hookedAction@@ -604,20 +664,20 @@     args  -- Since Cabal-3.4 UserHooks are completely ignored-sdistAction :: GlobalFlags -> UserHooks -> SDistFlags -> Args -> IO ()-sdistAction _globalFlags _hooks flags _args = do+sdistAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> SDistFlags -> Args -> IO ()+sdistAction verbHandles _globalFlags _hooks flags _args = do   let mbWorkDir = flagToMaybe $ sDistWorkingDir flags   (_, ppd) <- confPkgDescr emptyUserHooks verbosity mbWorkDir Nothing   let pkg_descr = flattenPackageDescription ppd-  sdist pkg_descr flags srcPref knownSuffixHandlers+  sdist verbHandles pkg_descr flags srcPref knownSuffixHandlers   where-    verbosity = fromFlag (setupVerbosity $ sDistCommonFlags flags)+    verbosity = mkVerbosity verbHandles $ fromFlag (setupVerbosity $ sDistCommonFlags flags) -testAction :: GlobalFlags -> UserHooks -> TestFlags -> Args -> IO ()-testAction globalFlags hooks flags args = do+testAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> TestFlags -> Args -> IO ()+testAction verbHandles globalFlags hooks flags args = do   let common = testCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (_lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{testCommonFlags = common'}       distPref = fromFlag $ setupDistPref common'   hookedActionWithArgs@@ -630,11 +690,11 @@     flags'     args -benchAction :: GlobalFlags -> UserHooks -> BenchmarkFlags -> Args -> IO ()-benchAction globalFlags hooks flags args = do+benchAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> BenchmarkFlags -> Args -> IO ()+benchAction verbHandles globalFlags hooks flags args = do   let common = benchmarkCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (_lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{benchmarkCommonFlags = common'}       distPref = fromFlag $ setupDistPref common'   hookedActionWithArgs@@ -647,11 +707,11 @@     flags'     args -registerAction :: GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()-registerAction globalFlags hooks flags args = do+registerAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()+registerAction verbHandles globalFlags hooks flags args = do   let common = registerCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (_lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{registerCommonFlags = common'}       distPref = fromFlag $ setupDistPref common'   hookedAction@@ -664,11 +724,11 @@     flags'     args -unregisterAction :: GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()-unregisterAction globalFlags hooks flags args = do+unregisterAction :: VerbosityHandles -> GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()+unregisterAction verbHandles globalFlags hooks flags args = do   let common = registerCommonFlags flags-      verbosity = fromFlag $ setupVerbosity common-  (_lbi, common') <- getCommonFlags globalFlags hooks common args+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  (_lbi, common') <- getCommonFlags verbHandles globalFlags hooks common args   let flags' = flags{registerCommonFlags = common'}       distPref = fromFlag $ setupDistPref common'   hookedAction@@ -758,14 +818,14 @@   verbosity   (PackageDescription{library = Nothing})   (Just _, _) =-    dieWithException verbosity $ NoLibraryForPackage+    dieWithException verbosity NoLibraryForPackage sanityCheckHookedBuildInfo verbosity pkg_descr (_, hookExes)-  | exe1 : _ <- nonExistant =+  | exe1 : _ <- nonExistent =       dieWithException verbosity $ SanityCheckHookedBuildInfo exe1   where-    pkgExeNames = nub (map exeName (executables pkg_descr))-    hookExeNames = nub (map fst hookExes)-    nonExistant = hookExeNames \\ pkgExeNames+    pkgExeNames = ordNub (map exeName (executables pkg_descr))+    hookExeNames = ordNub (map fst hookExes)+    nonExistent = hookExeNames \\ pkgExeNames sanityCheckHookedBuildInfo _ _ _ = return ()  -- | Try to read the 'localBuildInfoFile'@@ -826,18 +886,18 @@               , configCommonFlags =                   (configCommonFlags cFlags)                     { -- Use the current, not saved verbosity level:-                      setupVerbosity = Flag verbosity+                      setupVerbosity = Flag $ verbosityFlags verbosity                     }               }-      configureAction globalFlags hooks cFlags' (extraConfigArgs lbi)+      configureAction (verbosityHandles verbosity) globalFlags hooks cFlags' (extraConfigArgs lbi)  -- -------------------------------------------------------------------------- -- Cleaning -clean :: PackageDescription -> CleanFlags -> IO ()-clean pkg_descr flags = do+clean :: VerbosityHandles -> PackageDescription -> CleanFlags -> IO ()+clean verbHandles pkg_descr flags = do   let common = cleanCommonFlags flags-      verbosity = fromFlag (setupVerbosity common)+      verbosity = mkVerbosity verbHandles (fromFlag (setupVerbosity common))       distPref = fromFlagOrDefault defaultDistPref $ setupDistPref common       mbWorkDir = flagToMaybe $ setupWorkingDir common       i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path@@ -851,23 +911,14 @@    -- remove the whole dist/ directory rather than tracking exactly what files   -- we created in there.-  chattyTry "removing dist/" $ do-    exists <- doesDirectoryExist distPath-    when exists (removeDirectoryRecursive distPath)+  chattyTry verbosity "removing dist/" $ do+    removePathForcibly distPath    -- Any extra files the user wants to remove-  traverse_ (removeFileOrDirectory . i) (extraTmpFiles pkg_descr)+  traverse_ (removePathForcibly . i) (extraTmpFiles pkg_descr)    -- If the user wanted to save the config, write it back   traverse_ (writePersistBuildConfig mbWorkDir distPref) maybeConfig-  where-    removeFileOrDirectory :: FilePath -> IO ()-    removeFileOrDirectory fname = do-      isDir <- doesDirectoryExist fname-      isFile <- doesFileExist fname-      if isDir-        then removeDirectoryRecursive fname-        else when isFile $ removeFile fname  -- -------------------------------------------------------------------------- -- Default hooks@@ -875,28 +926,38 @@ -- | Hooks that correspond to a plain instantiation of the -- \"simple\" build system simpleUserHooks :: UserHooks-simpleUserHooks =+simpleUserHooks = simpleUserHooksWithHandles defaultVerbosityHandles++-- | A version of 'simpleUserHooks' that allows setting custom logging handles.+simpleUserHooksWithHandles :: VerbosityHandles -> UserHooks+simpleUserHooksWithHandles verbHandles =   emptyUserHooks-    { confHook = configure+    { confHook = \p -> configure_setupHooks SetupHooks.noConfigureHooks p verbHandles     , postConf = finalChecks-    , buildHook = defaultBuildHook-    , replHook = defaultReplHook-    , copyHook = \desc lbi _ f -> install desc lbi f+    , buildHook = defaultBuildHook verbHandles+    , replHook = defaultReplHook verbHandles+    , copyHook = \desc lbi _ f -> install_setupHooks SetupHooks.noInstallHooks verbHandles desc lbi f     , -- 'install' has correct 'copy' behavior with params-      instHook = defaultInstallHook-    , testHook = defaultTestHook-    , benchHook = defaultBenchHook-    , cleanHook = \p _ _ f -> clean p f-    , hscolourHook = \p l h f -> hscolour p l (allSuffixHandlers h) f-    , haddockHook = \p l h f -> haddock p l (allSuffixHandlers h) f-    , regHook = defaultRegHook-    , unregHook = \p l _ f -> unregister p l f+      instHook = defaultInstallHook verbHandles+    , testHook = defaultTestHook verbHandles+    , benchHook = defaultBenchHook verbHandles+    , cleanHook = \p _ _ f -> clean verbHandles p f+    , hscolourHook = \p l h f -> void $ hscolour_setupHooks noBuildHooks verbHandles p l (allSuffixHandlers h) f+    , haddockHook = \p l h f -> void $ haddock_setupHooks noBuildHooks verbHandles p l (allSuffixHandlers h) f+    , regHook = defaultRegHook verbHandles+    , unregHook = \p l _ f -> unregisterWithHandles verbHandles p l f     }   where+    noBuildHooks pbci@(SetupHooks.PreBuildComponentInputs{SetupHooks.localBuildInfo = lbi}) =+      builtinPreBuildHooks+        (buildType (localPkgDescr lbi))+        pbci     finalChecks _args flags pkg_descr lbi =-      checkForeignDeps pkg_descr lbi (lessVerbose verbosity)+      checkForeignDeps pkg_descr lbi (modifyVerbosityFlags lessVerbose verbosity)       where-        verbosity = fromFlag (setupVerbosity $ configCommonFlags flags)+        verbosity =+          mkVerbosity verbHandles $+            fromFlag (setupVerbosity $ configCommonFlags flags)  -- | Basic autoconf 'UserHooks': --@@ -933,9 +994,10 @@     defaultPostConf args flags pkg_descr lbi =       do         let common = configCommonFlags flags-            verbosity = fromFlag $ setupVerbosity common+            verbosity = mkVerbosity defaultVerbosityHandles (fromFlag $ setupVerbosity common)             mbWorkDir = flagToMaybe $ setupWorkingDir common         runConfigureScript+          defaultVerbosityHandles           flags           (flagAssignment lbi)           (withPrograms lbi)@@ -953,7 +1015,7 @@       -> IO HookedBuildInfo     readHookWithArgs get_common_flags _args flags = do       let common = get_common_flags flags-          verbosity = fromFlag (setupVerbosity common)+          verbosity = mkVerbosity defaultVerbosityHandles (fromFlag (setupVerbosity common))           mbWorkDir = flagToMaybe $ setupWorkingDir common           distPref = setupDistPref common       dist_dir <- findDistPrefOrDefault distPref@@ -966,7 +1028,7 @@       -> IO HookedBuildInfo     readHook get_common_flags args flags = do       let common = get_common_flags flags-          verbosity = fromFlag (setupVerbosity common)+          verbosity = mkVerbosity defaultVerbosityHandles (fromFlag (setupVerbosity common))           mbWorkDir = flagToMaybe $ setupWorkingDir common           distPref = setupDistPref common       noExtraFlags args@@ -1010,7 +1072,7 @@               , LBC.hostPlatform = plat               }           }-        ) = runConfigureScript cfg flags progs plat+        ) = runConfigureScript defaultVerbosityHandles cfg flags progs plat      pre_conf_comp       :: SetupHooks.PreConfComponentInputs@@ -1025,7 +1087,7 @@           , SetupHooks.component = component           }         ) = do-        let verbosity = fromFlag $ configVerbosity cfg+        let verbosity = mkVerbosity defaultVerbosityHandles (fromFlag $ configVerbosity cfg)             mbWorkDir = flagToMaybe $ configWorkingDir cfg             distPref = configDistPref cfg         dist_dir <- findDistPrefOrDefault distPref@@ -1046,48 +1108,52 @@             }  defaultTestHook-  :: Args+  :: VerbosityHandles+  -> Args   -> PackageDescription   -> LocalBuildInfo   -> UserHooks   -> TestFlags   -> IO ()-defaultTestHook args pkg_descr localbuildinfo _ flags =-  test args pkg_descr localbuildinfo flags+defaultTestHook verbHandles args pkg_descr localbuildinfo _ flags =+  test args verbHandles pkg_descr localbuildinfo flags  defaultBenchHook-  :: Args+  :: VerbosityHandles+  -> Args   -> PackageDescription   -> LocalBuildInfo   -> UserHooks   -> BenchmarkFlags   -> IO ()-defaultBenchHook args pkg_descr localbuildinfo _ flags =-  bench args pkg_descr localbuildinfo flags+defaultBenchHook verbHandles args pkg_descr localbuildinfo _ flags =+  bench args verbHandles pkg_descr localbuildinfo flags  defaultInstallHook-  :: PackageDescription+  :: VerbosityHandles+  -> PackageDescription   -> LocalBuildInfo   -> UserHooks   -> InstallFlags   -> IO ()-defaultInstallHook =-  defaultInstallHook_setupHooks SetupHooks.noInstallHooks+defaultInstallHook verbHandles =+  defaultInstallHook_setupHooks SetupHooks.noInstallHooks verbHandles  defaultInstallHook_setupHooks   :: SetupHooks.InstallHooks+  -> VerbosityHandles   -> PackageDescription   -> LocalBuildInfo   -> UserHooks   -> InstallFlags   -> IO ()-defaultInstallHook_setupHooks inst_hooks pkg_descr localbuildinfo _ flags = do+defaultInstallHook_setupHooks inst_hooks verbHandles pkg_descr localbuildinfo _ flags = do   let copyFlags =         defaultCopyFlags           { copyDest = installDest flags           , copyCommonFlags = installCommonFlags flags           }-  install_setupHooks inst_hooks pkg_descr localbuildinfo copyFlags+  install_setupHooks inst_hooks verbHandles pkg_descr localbuildinfo copyFlags   let registerFlags =         defaultRegisterFlags           { regInPlace = installInPlace flags@@ -1095,38 +1161,60 @@           , registerCommonFlags = installCommonFlags flags           }   when (hasLibs pkg_descr) $-    register pkg_descr localbuildinfo registerFlags+    registerWithHandles verbHandles pkg_descr localbuildinfo registerFlags  defaultBuildHook-  :: PackageDescription+  :: VerbosityHandles+  -> PackageDescription   -> LocalBuildInfo   -> UserHooks   -> BuildFlags   -> IO ()-defaultBuildHook pkg_descr localbuildinfo hooks flags =-  build pkg_descr localbuildinfo flags (allSuffixHandlers hooks)+defaultBuildHook verbHandles pkg_descr localbuildinfo hooks flags =+  void $+    build_setupHooks+      (builtinPreBuildHooks (buildType pkg_descr), const $ pure ())+      verbHandles+      pkg_descr+      localbuildinfo+      flags+      (allSuffixHandlers hooks)  defaultReplHook-  :: PackageDescription+  :: VerbosityHandles+  -> PackageDescription   -> LocalBuildInfo   -> UserHooks   -> ReplFlags   -> [String]   -> IO ()-defaultReplHook pkg_descr localbuildinfo hooks flags args =-  repl pkg_descr localbuildinfo flags (allSuffixHandlers hooks) args+defaultReplHook verbHandles pkg_descr localbuildinfo hooks flags args =+  void $+    repl_setupHooks+      (builtinPreBuildHooks (buildType pkg_descr))+      verbHandles+      pkg_descr+      localbuildinfo+      flags+      (allSuffixHandlers hooks)+      args  defaultRegHook-  :: PackageDescription+  :: VerbosityHandles+  -> PackageDescription   -> LocalBuildInfo   -> UserHooks   -> RegisterFlags   -> IO ()-defaultRegHook pkg_descr localbuildinfo _ flags =-  if hasLibs pkg_descr-    then register pkg_descr localbuildinfo flags-    else+defaultRegHook verbHandles pkg_descr localbuildinfo _ flags+  | hasLibs pkg_descr =+      registerWithHandles verbHandles pkg_descr localbuildinfo flags+  | otherwise =       setupMessage-        (fromFlag (setupVerbosity $ registerCommonFlags flags))+        verbosity         "Package contains no library to register:"         (packageId pkg_descr)+  where+    verbosity =+      mkVerbosity verbHandles $+        fromFlag (setupVerbosity $ registerCommonFlags flags)

@@ -41,6 +41,7 @@ import Distribution.Types.Benchmark (Benchmark (benchmarkBuildInfo)) import Distribution.Types.UnqualComponentName import Distribution.Utils.Path+import Distribution.Verbosity  import System.Directory (doesFileExist) @@ -48,6 +49,7 @@ bench   :: Args   -- ^ positional command-line arguments+  -> VerbosityHandles   -> PD.PackageDescription   -- ^ information from the .cabal file   -> LBI.LocalBuildInfo@@ -55,9 +57,9 @@   -> BenchmarkFlags   -- ^ flags sent to benchmark   -> IO ()-bench args pkg_descr lbi flags = do+bench args verbHandles pkg_descr lbi flags = do   curDir <- LBI.absoluteWorkingDirLBI lbi-  let verbosity = fromFlag $ benchmarkVerbosity flags+  let verbosity = mkVerbosity verbHandles (fromFlag $ benchmarkVerbosity flags)       benchmarkNames = args       pkgBenchmarks = PD.benchmarks pkg_descr       enabledBenchmarks = LBI.enabledBenchLBIs pkg_descr lbi

@@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} @@ -25,6 +26,7 @@   ( -- * Build     build   , build_setupHooks+  , buildComponent      -- * Repl   , repl@@ -33,6 +35,8 @@      -- * Build preparation   , preBuildComponent+  , runPreBuildHooks+  , builtinPreBuildHooks   , AutogenFile (..)   , AutogenFileContents   , writeBuiltinAutogenFiles@@ -91,6 +95,7 @@ import Distribution.Simple.BuildTarget import Distribution.Simple.BuildToolDepends import Distribution.Simple.Configure+import Distribution.Simple.Errors import Distribution.Simple.Flag import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PreProcess@@ -104,9 +109,8 @@ import Distribution.Simple.Setup.Config import Distribution.Simple.Setup.Repl import Distribution.Simple.SetupHooks.Internal-  ( BuildHooks (..)-  , BuildingWhat (..)-  , noBuildHooks+  ( BuildingWhat (..)+  , buildingWhatVerbosity   ) import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks import qualified Distribution.Simple.SetupHooks.Rule as SetupHooks@@ -126,8 +130,7 @@ import Control.Monad import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map-import Distribution.Simple.Errors-import System.Directory (doesFileExist, removeFile)+ import System.FilePath (takeDirectory)  -- -----------------------------------------------------------------------------@@ -143,10 +146,17 @@   -> [PPSuffixHandler]   -- ^ preprocessors to run before compiling   -> IO ()-build = build_setupHooks noBuildHooks+build pkg lbi flags pps =+  void $ build_setupHooks noHooks defaultVerbosityHandles pkg lbi flags pps+  where+    noHooks = (const $ return [], const $ return ())  build_setupHooks-  :: BuildHooks+  :: ( SetupHooks.PreBuildComponentInputs -> IO [SetupHooks.MonitorFilePath]+     , SetupHooks.PostBuildComponentInputs -> IO ()+     )+  -- ^ build hooks+  -> VerbosityHandles   -> PackageDescription   -- ^ Mostly information from the .cabal file   -> LocalBuildInfo@@ -155,15 +165,20 @@   -- ^ Flags that the user passed to build   -> [PPSuffixHandler]   -- ^ preprocessors to run before compiling-  -> IO ()+  -> IO [SetupHooks.MonitorFilePath] build_setupHooks-  (BuildHooks{preBuildComponentRules = mbPbcRules, postBuildComponentHook = mbPostBuild})+  (preBuildHook, postBuildHook)+  verbHandles   pkg_descr   lbi   flags   suffixHandlers = do+    let verbosity = mkVerbosity verbHandles (fromFlag $ buildVerbosity flags)+        distPref = fromFlag $ buildDistPref flags     checkSemaphoreSupport verbosity (compiler lbi) flags+     targets <- readTargetInfos verbosity pkg_descr lbi (buildTargets flags)+     let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)     info verbosity $       "Component build order: "@@ -188,7 +203,7 @@     curDir <- absoluteWorkingDirLBI lbi      -- Now do the actual building-    (\f -> foldM_ f (installedPkgs lbi) componentsToBuild) $ \index target -> do+    (mons, _) <- (\f -> foldM f ([], installedPkgs lbi) componentsToBuild) $ \(monsAcc, index) target -> do       let comp = targetComponent target           clbi = targetCLBI target           bi = componentBuildInfo comp@@ -200,24 +215,14 @@               , withPackageDB = withPackageDB lbi ++ [internalPackageDB]               , installedPkgs = index               }-          runPreBuildHooks :: LocalBuildInfo -> TargetInfo -> IO ()-          runPreBuildHooks lbi2 tgt =-            let inputs =-                  SetupHooks.PreBuildComponentInputs-                    { SetupHooks.buildingWhat = BuildNormal flags-                    , SetupHooks.localBuildInfo = lbi2-                    , SetupHooks.targetInfo = tgt-                    }-             in for_ mbPbcRules $ \pbcRules -> do-                  (ruleFromId, _mons) <- SetupHooks.computeRules verbosity inputs pbcRules-                  SetupHooks.executeRules verbosity lbi2 tgt ruleFromId-      preBuildComponent runPreBuildHooks verbosity lbi' target+          pbci = SetupHooks.PreBuildComponentInputs (BuildNormal flags) lbi' target+      mons <- preBuildComponent (preBuildHook pbci) verbosity lbi' target       let numJobs = buildNumJobs flags       par_strat <-         toFlag <$> case buildUseSemaphore flags of           Flag sem_name -> case numJobs of             Flag{} -> do-              warn verbosity $ "Ignoring -j due to --semaphore"+              warn verbosity "Ignoring -j due to --semaphore"               return $ UseSem sem_name             NoFlag -> return $ UseSem sem_name           NoFlag -> return $ case numJobs of@@ -225,6 +230,7 @@             NoFlag -> Serial       mb_ipi <-         buildComponent+          verbHandles           flags           par_strat           pkg_descr@@ -239,19 +245,16 @@               , SetupHooks.localBuildInfo = lbi'               , SetupHooks.targetInfo = target               }-      for_ mbPostBuild ($ postBuildInputs)-      return (maybe index (Index.insert `flip` index) mb_ipi)+      postBuildHook postBuildInputs+      return (monsAcc <> mons, maybe index (`Index.insert` index) mb_ipi) -    return ()-    where-      distPref = fromFlag (buildDistPref flags)-      verbosity = fromFlag (buildVerbosity flags)+    return mons  -- | Check for conditions that would prevent the build from succeeding. checkSemaphoreSupport   :: Verbosity -> Compiler -> BuildFlags -> IO () checkSemaphoreSupport verbosity comp flags = do-  unless (jsemSupported comp || (isNothing (flagToMaybe (buildUseSemaphore flags)))) $+  unless (jsemSupported comp || isNothing (flagToMaybe (buildUseSemaphore flags))) $     dieWithException verbosity CheckSemaphoreSupport  -- | Write available build information for 'LocalBuildInfo' to disk.@@ -301,10 +304,9 @@           ++ unlines warns     LBS.writeFile buildInfoFile buildInfoText -  when (not shouldDumpBuildInfo) $ do+  unless shouldDumpBuildInfo $     -- Remove existing build-info.json as it might be outdated now.-    exists <- doesFileExist buildInfoFile-    when exists $ removeFile buildInfoFile+    removeFileForcibly buildInfoFile   where     buildInfoFile = interpretSymbolicPathLBI lbi $ buildInfoPref distPref     shouldDumpBuildInfo = fromFlagOrDefault NoDumpBuildInfo dumpBuildInfoFlag == DumpBuildInfo@@ -329,11 +331,21 @@   -- ^ preprocessors to run before compiling   -> [String]   -> IO ()-repl = repl_setupHooks noBuildHooks+repl pkg lbi flags pps args =+  void $+    repl_setupHooks+      (const $ return [])+      defaultVerbosityHandles+      pkg+      lbi+      flags+      pps+      args  repl_setupHooks-  :: BuildHooks-  -- ^ build hook+  :: (SetupHooks.PreBuildComponentInputs -> IO [SetupHooks.MonitorFilePath])+  -- ^ pre-build hook+  -> VerbosityHandles   -> PackageDescription   -- ^ Mostly information from the .cabal file   -> LocalBuildInfo@@ -343,25 +355,26 @@   -> [PPSuffixHandler]   -- ^ preprocessors to run before compiling   -> [String]-  -> IO ()+  -> IO [SetupHooks.MonitorFilePath] repl_setupHooks-  (BuildHooks{preBuildComponentRules = mbPbcRules})+  preBuildHook+  verbHandles   pkg_descr   lbi   flags   suffixHandlers   args = do     let distPref = fromFlag (replDistPref flags)-        verbosity = fromFlag (replVerbosity flags)+        verbosity = mkVerbosity verbHandles $ fromFlag (replVerbosity flags)      target <--      readTargetInfos verbosity pkg_descr lbi args >>= \r -> case r of+      readTargetInfos verbosity pkg_descr lbi args >>= \case         -- This seems DEEPLY questionable.         [] -> case allTargetsInBuildOrder' pkg_descr lbi of           (target : _) -> return target-          [] -> dieWithException verbosity $ FailedToDetermineTarget+          [] -> dieWithException verbosity FailedToDetermineTarget         [target] -> return target-        _ -> dieWithException verbosity $ NoMultipleTargets+        _ -> dieWithException verbosity NoMultipleTargets     let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi [nodeKey target]     debug verbosity $       "Component build order: "@@ -388,27 +401,19 @@                     (componentBuildInfo comp)                     (withPrograms lbi')               }-        runPreBuildHooks :: LocalBuildInfo -> TargetInfo -> IO ()-        runPreBuildHooks lbi2 tgt =-          let inputs =-                SetupHooks.PreBuildComponentInputs-                  { SetupHooks.buildingWhat = BuildRepl flags-                  , SetupHooks.localBuildInfo = lbi2-                  , SetupHooks.targetInfo = tgt-                  }-           in for_ mbPbcRules $ \pbcRules -> do-                (ruleFromId, _mons) <- SetupHooks.computeRules verbosity inputs pbcRules-                SetupHooks.executeRules verbosity lbi2 tgt ruleFromId+        pbci lbi' tgt = SetupHooks.PreBuildComponentInputs (BuildRepl flags) lbi' tgt -    -- build any dependent components-    sequence_-      [ do-        let clbi = targetCLBI subtarget-            comp = targetComponent subtarget-        lbi' <- lbiForComponent comp lbi-        preBuildComponent runPreBuildHooks verbosity lbi' subtarget+    -- build any dependent components and collect their monitored file paths+    depMonitors <- fmap concat $ for (safeInit componentsToBuild) $ \subtarget -> do+      let clbi = targetCLBI subtarget+          comp = targetComponent subtarget+      lbi' <- lbiForComponent comp lbi+      monitors <- preBuildComponent (preBuildHook (pbci lbi' subtarget)) verbosity lbi' subtarget++      _mb_ipi <-         buildComponent-          (mempty{buildCommonFlags = mempty{setupVerbosity = toFlag verbosity}})+          verbHandles+          (mempty{buildCommonFlags = mempty{setupVerbosity = toFlag $ verbosityFlags verbosity}})           NoFlag           pkg_descr           lbi'@@ -416,16 +421,21 @@           comp           clbi           distPref-      | subtarget <- safeInit componentsToBuild-      ] +      return monitors+     -- REPL for target components     let clbi = targetCLBI target         comp = targetComponent target     lbi' <- lbiForComponent comp lbi-    preBuildComponent runPreBuildHooks verbosity lbi' target++    targetMonitors <-+      preBuildComponent (preBuildHook (pbci lbi' target)) verbosity lbi' target+     replComponent flags verbosity pkg_descr lbi' suffixHandlers comp clbi distPref +    return (depMonitors <> targetMonitors)+ -- | Start an interpreter without loading any package files. startInterpreter   :: Verbosity@@ -441,7 +451,8 @@     _ -> dieWithException verbosity REPLNotSupported  buildComponent-  :: BuildFlags+  :: VerbosityHandles+  -> BuildFlags   -> Flag ParStrat   -> PackageDescription   -> LocalBuildInfo@@ -450,13 +461,14 @@   -> ComponentLocalBuildInfo   -> SymbolicPath Pkg (Dir Dist)   -> IO (Maybe InstalledPackageInfo)-buildComponent flags _ _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =-  dieWithException (fromFlag $ buildVerbosity flags) $+buildComponent verbHandles flags _ _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =+  dieWithException (mkVerbosity verbHandles $ fromFlag $ buildVerbosity flags) $     NoSupportBuildingTestSuite tt-buildComponent flags _ _ _ _ (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt}) _ _ =-  dieWithException (fromFlag $ buildVerbosity flags) $+buildComponent verbHandles flags _ _ _ _ (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt}) _ _ =+  dieWithException (mkVerbosity verbHandles $ fromFlag $ buildVerbosity flags) $     NoSupportBuildingBenchMark tt buildComponent+  verbHandles   flags   numJobs   pkg_descr@@ -473,7 +485,7 @@   distPref =     do       inplaceDir <- absoluteWorkingDirLBI lbi0-      let verbosity = fromFlag $ buildVerbosity flags+      let verbosity = mkVerbosity verbHandles $ fromFlag $ buildVerbosity flags       let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =             testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 inplaceDir distPref       preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers@@ -487,7 +499,7 @@         (maybeComponentInstantiatedWith clbi)       let libbi = libBuildInfo lib           lib' = lib{libBuildInfo = addSrcDir (addExtraOtherModules libbi generatedExtras) genDir}-      buildLib flags numJobs pkg lbi lib' libClbi+      buildLib verbHandles flags numJobs pkg lbi lib' libClbi       -- NB: need to enable multiple instances here, because on 7.10+       -- the package name is the same as the library, and we still       -- want the registration to go through.@@ -509,6 +521,7 @@       buildExe verbosity numJobs pkg_descr lbi exe' exeClbi       return Nothing -- Can't depend on test suite buildComponent+  verbHandles   flags   numJobs   pkg_descr@@ -518,7 +531,7 @@   clbi   distPref =     do-      let verbosity = fromFlag $ buildVerbosity flags+      let verbosity = mkVerbosity verbHandles $ fromFlag $ buildVerbosity flags       preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers       extras <- preprocessExtras verbosity comp lbi       setupMessage'@@ -537,18 +550,17 @@                         flip addExtraCmmSources extras $                           flip addExtraCxxSources extras $                             flip addExtraCSources extras $-                              flip addExtraJsSources extras $-                                libbi+                              addExtraJsSources libbi extras                   } -          buildLib flags numJobs pkg_descr lbi lib' clbi+          buildLib verbHandles flags numJobs pkg_descr lbi lib' clbi            let oneComponentRequested (OneComponentRequestedSpec _) = True               oneComponentRequested _ = False           -- Don't register inplace if we're only building a single component;           -- it's not necessary because there won't be any subsequent builds           -- that need to tag us-          if (not (oneComponentRequested (componentEnabledSpec lbi)))+          if not (oneComponentRequested (componentEnabledSpec lbi))             then do               -- Register the library in-place, so exes can depend               -- on internally defined libraries.@@ -566,7 +578,7 @@                     lib'                     lbi                     clbi-              debug verbosity $ "Registering inplace:\n" ++ (IPI.showInstalledPackageInfo installedPkgInfo)+              debug verbosity $ "Registering inplace:\n" ++ IPI.showInstalledPackageInfo installedPkgInfo               registerPackage                 verbosity                 (compiler lbi)@@ -615,8 +627,8 @@   -> Verbosity   -> IO (SymbolicPath Pkg (Dir Source), [ModuleName.ModuleName]) generateCode codeGens nm pdesc bi lbi clbi verbosity = do-  when (not . null $ codeGens) $ createDirectoryIfMissingVerbose verbosity True $ i tgtDir-  (\x -> (tgtDir, x)) . concat <$> mapM go codeGens+  unless (null codeGens) $ createDirectoryIfMissingVerbose verbosity True $ i tgtDir+  (tgtDir,) . concat <$> mapM go codeGens   where     allLibs = (maybe id (:) $ library pdesc) (subLibraries pdesc)     dependencyLibs = filter (const True) allLibs -- intersect with componentPackageDeps of clbi@@ -625,6 +637,7 @@     mbWorkDir = mbWorkDirLBI lbi     i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path     tgtDir = buildDir lbi </> makeRelativePathEx (nm' </> nm' ++ "-gen")+    verbLevel = verbosityLevel verbosity     go :: String -> IO [ModuleName.ModuleName]     go codeGenProg =       fmap fromString . lines@@ -635,7 +648,7 @@           (withPrograms lbi)           ( map interpretSymbolicPathCWD (tgtDir : srcDirs)               ++ ( "--"-                    : GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) (GHC.componentGhcOptions verbosity lbi bi clbi tgtDir)+                    : GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) (GHC.componentGhcOptions verbLevel lbi bi clbi tgtDir)                  )           ) @@ -719,7 +732,7 @@     extras <- preprocessExtras verbosity comp lbi     let libbi = libBuildInfo lib         lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}-    replLib replFlags pkg lbi lib' libClbi+    replLib (verbosityHandles verbosity) replFlags pkg lbi lib' libClbi replComponent   replFlags   verbosity@@ -730,29 +743,30 @@   clbi   _ =     do+      let verbHandles = verbosityHandles verbosity       preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers       extras <- preprocessExtras verbosity comp lbi       case comp of         CLib lib -> do           let libbi = libBuildInfo lib               lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}-          replLib replFlags pkg_descr lbi lib' clbi+          replLib verbHandles replFlags pkg_descr lbi lib' clbi         CFLib flib ->-          replFLib replFlags pkg_descr lbi flib clbi+          replFLib verbHandles replFlags pkg_descr lbi flib clbi         CExe exe -> do           let ebi = buildInfo exe               exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}-          replExe replFlags pkg_descr lbi exe' clbi+          replExe verbHandles replFlags pkg_descr lbi exe' clbi         CTest test@TestSuite{testInterface = TestSuiteExeV10{}} -> do           let exe = testSuiteExeV10AsExe test           let ebi = buildInfo exe               exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}-          replExe replFlags pkg_descr lbi exe' clbi+          replExe verbHandles replFlags pkg_descr lbi exe' clbi         CBench bm@Benchmark{benchmarkInterface = BenchmarkExeV10{}} -> do           let exe = benchmarkExeV10asExe bm           let ebi = buildInfo exe               exe' = exe{buildInfo = ebi{cSources = cSources ebi ++ extras}}-          replExe replFlags pkg_descr lbi exe' clbi+          replExe verbHandles replFlags pkg_descr lbi exe' clbi #if __GLASGOW_HASKELL__ < 811 -- silence pattern-match warnings prior to GHC 9.0         _ -> error "impossible"@@ -874,13 +888,12 @@       -- that exposes the relevant test suite library.       deps =         (IPI.installedUnitId ipi, mungedId ipi)-          : ( filter-                ( \(_, x) ->-                    let name = prettyShow $ mungedName x-                     in name == "Cabal" || name == "base"-                )-                (componentPackageDeps clbi)+          : filter+            ( \(_, x) ->+                let name = prettyShow $ mungedName x+                 in name == "Cabal" || name == "base"             )+            (componentPackageDeps clbi)       exeClbi =         ExeComponentLocalBuildInfo           { -- TODO: this is a hack, but as long as this is unique@@ -909,7 +922,7 @@ createInternalPackageDB verbosity lbi distPref = do   existsAlready <- doesPackageDBExist dbPath   when existsAlready $ deletePackageDB dbPath-  createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath+  createPackageDB verbosity (compiler lbi) (withPrograms lbi) dbPath   return (SpecificPackageDB dbRelPath)   where     dbRelPath = internalPackageDBPath lbi distPref@@ -961,17 +974,18 @@ -- TODO: build separate libs in separate dirs so that we can build -- multiple libs, e.g. for 'LibTest' library-style test suites buildLib-  :: BuildFlags+  :: VerbosityHandles+  -> BuildFlags   -> Flag ParStrat   -> PackageDescription   -> LocalBuildInfo   -> Library   -> ComponentLocalBuildInfo   -> IO ()-buildLib flags numJobs pkg_descr lbi lib clbi =-  let verbosity = fromFlag $ buildVerbosity flags+buildLib verbHandles flags numJobs pkg_descr lbi lib clbi =+  let verbosity = mkVerbosity verbHandles $ fromFlag $ buildVerbosity flags    in case compilerFlavor (compiler lbi) of-        GHC -> GHC.buildLib flags numJobs pkg_descr lbi lib clbi+        GHC -> GHC.buildLib verbHandles flags numJobs pkg_descr lbi lib clbi         GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi         UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi         _ -> dieWithException verbosity BuildingNotSupportedWithCompiler@@ -1009,33 +1023,35 @@     _ -> dieWithException verbosity BuildingNotSupportedWithCompiler  replLib-  :: ReplFlags+  :: VerbosityHandles+  -> ReplFlags   -> PackageDescription   -> LocalBuildInfo   -> Library   -> ComponentLocalBuildInfo   -> IO ()-replLib replFlags pkg_descr lbi lib clbi =-  let verbosity = fromFlag $ replVerbosity replFlags+replLib verbHandles replFlags pkg_descr lbi lib clbi =+  let verbosity = mkVerbosity verbHandles (fromFlag $ replVerbosity replFlags)       opts = replReplOptions replFlags    in case compilerFlavor (compiler lbi) of         -- 'cabal repl' doesn't need to support 'ghc --make -j', so we just pass         -- NoFlag as the numJobs parameter.-        GHC -> GHC.replLib replFlags NoFlag pkg_descr lbi lib clbi+        GHC -> GHC.replLib verbHandles replFlags NoFlag pkg_descr lbi lib clbi         GHCJS -> GHCJS.replLib (replOptionsFlags opts) verbosity NoFlag pkg_descr lbi lib clbi         _ -> dieWithException verbosity REPLNotSupported  replExe-  :: ReplFlags+  :: VerbosityHandles+  -> ReplFlags   -> PackageDescription   -> LocalBuildInfo   -> Executable   -> ComponentLocalBuildInfo   -> IO ()-replExe flags pkg_descr lbi exe clbi =-  let verbosity = fromFlag $ replVerbosity flags+replExe verbHandles flags pkg_descr lbi exe clbi =+  let verbosity = mkVerbosity verbHandles $ fromFlag $ replVerbosity flags    in case compilerFlavor (compiler lbi) of-        GHC -> GHC.replExe flags NoFlag pkg_descr lbi exe clbi+        GHC -> GHC.replExe verbHandles flags NoFlag pkg_descr lbi exe clbi         GHCJS ->           GHCJS.replExe             (replOptionsFlags $ replReplOptions flags)@@ -1048,16 +1064,17 @@         _ -> dieWithException verbosity REPLNotSupported  replFLib-  :: ReplFlags+  :: VerbosityHandles+  -> ReplFlags   -> PackageDescription   -> LocalBuildInfo   -> ForeignLib   -> ComponentLocalBuildInfo   -> IO ()-replFLib flags pkg_descr lbi exe clbi =-  let verbosity = fromFlag $ replVerbosity flags+replFLib verbHandles flags pkg_descr lbi exe clbi =+  let verbosity = mkVerbosity verbHandles (fromFlag $ replVerbosity flags)    in case compilerFlavor (compiler lbi) of-        GHC -> GHC.replFLib flags NoFlag pkg_descr lbi exe clbi+        GHC -> GHC.replFLib verbHandles flags NoFlag pkg_descr lbi exe clbi         _ -> dieWithException verbosity REPLNotSupported  -- | Runs 'componentInitialBuildSteps' on every configured component.@@ -1118,21 +1135,54 @@ -- | Creates the autogenerated files for a particular configured component, -- and runs the pre-build hook. preBuildComponent-  :: (LocalBuildInfo -> TargetInfo -> IO ())+  :: IO r   -- ^ pre-build hook   -> Verbosity   -> LocalBuildInfo   -- ^ Configuration information   -> TargetInfo-  -> IO ()+  -> IO r preBuildComponent preBuildHook verbosity lbi tgt = do   let pkg_descr = localPkgDescr lbi       clbi = targetCLBI tgt       compBuildDir = interpretSymbolicPathLBI lbi $ componentBuildDir lbi clbi   createDirectoryIfMissingVerbose verbosity True compBuildDir   writeBuiltinAutogenFiles verbosity pkg_descr lbi clbi-  preBuildHook lbi tgt+  preBuildHook +-- | Compute and execute 'PreBuildComponentRules', returning the monitored+-- files declared by the rules.+runPreBuildHooks+  :: VerbosityHandles+  -> SetupHooks.PreBuildComponentInputs+  -> SetupHooks.PreBuildComponentRules+  -> IO [SetupHooks.MonitorFilePath]+runPreBuildHooks+  verbHandles+  pbci@( SetupHooks.PreBuildComponentInputs+          { SetupHooks.buildingWhat = what+          , SetupHooks.localBuildInfo = lbi+          , SetupHooks.targetInfo = tgt+          }+        )+  pbcRules = do+    let verbosity = mkVerbosity verbHandles $ buildingWhatVerbosity what+    (rules, mons) <- SetupHooks.computeRules verbosity pbci pbcRules+    SetupHooks.executeRules verbosity lbi tgt rules+    return mons++-- | Built-in pre-build 'SetupHooks' for a given 'BuildType'.+builtinPreBuildHooks+  :: BuildType+  -> SetupHooks.PreBuildComponentInputs+  -> IO [SetupHooks.MonitorFilePath]+builtinPreBuildHooks _ =+  -- NB: currently there are no built-in pre-build hooks.+  --+  -- In the future, we may want to migrate built-in preprocessors (such as+  -- @hsc2hs@, @alex@, @happy@) to pre-build hooks.+  const (return [])+ -- | Generate and write to disk all built-in autogenerated files -- for the specified component. These files will be put in the -- autogenerated module directory for this component@@ -1173,7 +1223,7 @@     pathsFile = AutogenModule (autogenPathsModuleName pkg) (Suffix "hs")     pathsContents = toUTF8LBS $ generatePathsModule pkg lbi clbi     packageInfoFile = AutogenModule (autogenPackageInfoModuleName pkg) (Suffix "hs")-    packageInfoContents = toUTF8LBS $ generatePackageInfoModule pkg lbi+    packageInfoContents = toUTF8LBS $ generatePackageInfoModule pkg     cppHeaderFile = AutogenFile $ toShortText cppHeaderName     cppHeaderContents = toUTF8LBS $ generateCabalMacrosHeader pkg lbi clbi 

@@ -44,7 +44,7 @@   }  -- | Get the @'Verbosity'@ from the context the component being built is in.-buildVerbosity :: PreBuildComponentInputs -> Verbosity+buildVerbosity :: PreBuildComponentInputs -> VerbosityFlags buildVerbosity = buildingWhatVerbosity . buildingWhat  -- | Get the @'Component'@ being built.

@@ -19,11 +19,14 @@ import Prelude ()  import Distribution.Package-import Distribution.PackageDescription-import Distribution.Simple.Compiler-import Distribution.Simple.LocalBuildInfo-import Distribution.Utils.ShortText-import Distribution.Version+  ( PackageName+  , packageName+  , packageVersion+  , unPackageName+  )+import Distribution.Types.PackageDescription (PackageDescription (..))+import Distribution.Types.Version (versionNumbers)+import Distribution.Utils.ShortText (fromShortText)  import qualified Distribution.Simple.Build.PackageInfoModule.Z as Z @@ -33,8 +36,8 @@  -- ------------------------------------------------------------ -generatePackageInfoModule :: PackageDescription -> LocalBuildInfo -> String-generatePackageInfoModule pkg_descr lbi =+generatePackageInfoModule :: PackageDescription -> String+generatePackageInfoModule pkg_descr =   Z.render     Z.Z       { Z.zPackageName = showPkgName $ packageName pkg_descr@@ -42,15 +45,7 @@       , Z.zSynopsis = fromShortText $ synopsis pkg_descr       , Z.zCopyright = fromShortText $ copyright pkg_descr       , Z.zHomepage = fromShortText $ homepage pkg_descr-      , Z.zSupportsNoRebindableSyntax = supports_rebindable_syntax       }-  where-    supports_rebindable_syntax = ghc_newer_than (mkVersion [7, 0, 1])--    ghc_newer_than minVersion =-      case compilerCompatVersion GHC (compiler lbi) of-        Nothing -> False-        Just version -> version `withinRange` orLaterVersion minVersion  showPkgName :: PackageName -> String showPkgName = map fixchar . unPackageName

@@ -2,7 +2,7 @@  module Distribution.Simple.Build.PackageInfoModule.Z (render, Z (..)) where -import Distribution.ZinzaPrelude+import Distribution.ZinzaPrelude (Generic, execWriter, tell)  data Z = Z   { zPackageName :: String@@ -10,19 +10,12 @@   , zSynopsis :: String   , zCopyright :: String   , zHomepage :: String-  , zSupportsNoRebindableSyntax :: Bool   }   deriving (Generic)  render :: Z -> String render z_root = execWriter $ do-  if (zSupportsNoRebindableSyntax z_root)-    then do-      tell "{-# LANGUAGE NoRebindableSyntax #-}\n"-      return ()-    else do-      return ()-  tell "{-# OPTIONS_GHC -Wno-missing-import-lists #-}\n"+  tell "{-# LANGUAGE NoRebindableSyntax #-}\n"   tell "{-# OPTIONS_GHC -w #-}\n"   tell "\n"   tell "{-|\n"

@@ -44,8 +44,6 @@     Z.Z       { Z.zPackageName = packageName pkg_descr       , Z.zVersionDigits = show $ versionNumbers $ packageVersion pkg_descr-      , Z.zSupportsCpp = supports_cpp-      , Z.zSupportsNoRebindableSyntax = supports_rebindable_syntax       , Z.zAbsolute = absolute       , Z.zRelocatable = relocatable lbi       , Z.zIsWindows = isWindows@@ -63,15 +61,6 @@       , Z.zSysconfdir = zSysconfdir       }   where-    supports_cpp = supports_language_pragma-    supports_rebindable_syntax = ghc_newer_than (mkVersion [7, 0, 1])-    supports_language_pragma = ghc_newer_than (mkVersion [6, 6, 1])--    ghc_newer_than minVersion =-      case compilerCompatVersion GHC (compiler lbi) of-        Nothing -> False-        Just version -> version `withinRange` orLaterVersion minVersion-     -- In several cases we cannot make relocatable installations     absolute =       hasLibs pkg_descr -- we can only make progs relocatable

@@ -5,8 +5,6 @@ data Z     = Z {zPackageName :: PackageName,          zVersionDigits :: String,-         zSupportsCpp :: Bool,-         zSupportsNoRebindableSyntax :: Bool,          zAbsolute :: Bool,          zRelocatable :: Bool,          zIsWindows :: Bool,@@ -25,33 +23,14 @@     deriving Generic render :: Z -> String render z_root = execWriter $ do-  if (zSupportsCpp z_root)-  then do-    tell "{-# LANGUAGE CPP #-}\n"-    return ()-  else do-    return ()-  if (zSupportsNoRebindableSyntax z_root)-  then do-    tell "{-# LANGUAGE NoRebindableSyntax #-}\n"-    return ()-  else do-    return ()+  tell "{-# LANGUAGE CPP #-}\n"+  tell "{-# LANGUAGE NoRebindableSyntax #-}\n"   if (zNot z_root (zAbsolute z_root))   then do     tell "{-# LANGUAGE ForeignFunctionInterface #-}\n"     return ()   else do     return ()-  if (zSupportsCpp z_root)-  then do-    tell "#if __GLASGOW_HASKELL__ >= 810\n"-    tell "{-# OPTIONS_GHC -Wno-prepositive-qualified-module #-}\n"-    tell "#endif\n"-    return ()-  else do-    return ()-  tell "{-# OPTIONS_GHC -Wno-missing-import-lists #-}\n"   tell "{-# OPTIONS_GHC -w #-}\n"   tell "\n"   tell "{-|\n"@@ -100,25 +79,8 @@   else do     return ()   tell "\n"-  if (zSupportsCpp z_root)-  then do-    tell "#if defined(VERSION_base)\n"-    tell "\n"-    tell "#if MIN_VERSION_base(4,0,0)\n"-    tell "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"-    tell "#else\n"-    tell "catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a\n"-    tell "#endif\n"-    tell "\n"-    tell "#else\n"-    tell "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"-    tell "#endif\n"-    tell "catchIO = Exception.catch\n"-    return ()-  else do-    tell "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"-    tell "catchIO = Exception.catch\n"-    return ()+  tell "catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a\n"+  tell "catchIO = Exception.catch\n"   tell "\n"   tell "-- |The package version.\n"   tell "version :: Version\n"

@@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TupleSections #-}  ----------------------------------------------------------------------------- @@ -26,6 +27,7 @@   , haddockPref   , autogenPackageModulesDir   , autogenComponentModulesDir+  , preBuildRulesCacheFile   , autogenPathsModuleName   , autogenPackageInfoModuleName   , cppHeaderName@@ -41,6 +43,7 @@   , mkSharedLibName   , mkProfSharedLibName   , mkStaticLibName+  , mkBytecodeLibName   , mkGenericSharedBundledLibName   , exeExtension   , objExtension@@ -158,6 +161,15 @@ autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Source) autogenComponentModulesDir lbi clbi = componentBuildDir lbi clbi </> makeRelativePathEx "autogen" +-- | The path to the pre-build rules cache file for a component, used to+-- compute rule staleness across runs.+preBuildRulesCacheFile+  :: LocalBuildInfo+  -> ComponentLocalBuildInfo+  -> SymbolicPath Pkg File+preBuildRulesCacheFile lbi clbi =+  componentBuildDir lbi clbi </> makeRelativePathEx "setup-hooks-rules.cache"+ -- NB: Look at 'checkForeignDeps' for where a simplified version of this -- has been copy-pasted. @@ -320,8 +332,8 @@   -> [SymbolicPathX allowAbsolute Pkg (Dir Source)]   -> [ModuleName.ModuleName]   -> IO [(ModuleName.ModuleName, SymbolicPathX allowAbsolute Pkg File)]-getSourceFiles verbosity mbWorkDir dirs modules = flip traverse modules $ \m ->-  fmap ((,) m) $+getSourceFiles verbosity mbWorkDir dirs modules = for modules $ \m ->+  fmap (m,) $     findFileCwdWithExtension       mbWorkDir       builtinHaskellSuffixes@@ -407,6 +419,9 @@   "lib" ++ getHSLibraryName lib ++ "-" ++ comp <.> staticLibExtension platform   where     comp = prettyShow compilerFlavor ++ prettyShow compilerVersion++mkBytecodeLibName :: CompilerId -> UnitId -> String+mkBytecodeLibName _comp lib = getHSLibraryName lib <.> ".bytecodelib"  -- | Create a library name for a bundled shared library from a given name. -- This matches the naming convention for shared libraries as implemented in

@@ -3,6 +3,8 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TupleSections #-}  ----------------------------------------------------------------------------- @@ -40,6 +42,7 @@   , reportBuildTargetProblems   ) where +import Data.Bifunctor (second) import Distribution.Compat.Prelude import Prelude () @@ -130,6 +133,9 @@     BuildTargetFile ComponentName FilePath   deriving (Eq, Show, Generic) +-- | @since 3.18+deriving instance Ord BuildTarget+ instance Binary BuildTarget  buildTargetComponentName :: BuildTarget -> ComponentName@@ -228,12 +234,12 @@      tokens :: CabalParsing m => m (String, Maybe (String, Maybe String))     tokens =-      (\s -> (s, Nothing)) <$> parsecHaskellString+      (,Nothing) <$> parsecHaskellString         <|> (,) <$> token <*> P.optional (P.char ':' *> tokens2)      tokens2 :: CabalParsing m => m (String, Maybe String)     tokens2 =-      (\s -> (s, Nothing)) <$> parsecHaskellString+      (,Nothing) <$> parsecHaskellString         <|> (,) <$> token <*> P.optional (P.char ':' *> (parsecHaskellString <|> token))      token :: CabalParsing m => m String@@ -326,7 +332,7 @@               (things, got :| _) = unzip' expected'            in BuildTargetExpected userTarget (NE.toList things) got       | not (null nosuch) = BuildTargetNoSuch userTarget nosuch-      | otherwise = error $ "resolveBuildTarget: internal error in matching"+      | otherwise = error "resolveBuildTarget: internal error in matching"       where         expected = [(thing, got) | MatchErrorExpected thing got <- errs]         nosuch = [(thing, got) | MatchErrorNoSuch thing got <- errs]@@ -353,9 +359,9 @@       where         (amb, unamb) = step ql ts -    userTargetQualLevel (UserBuildTargetSingle _) = QL1-    userTargetQualLevel (UserBuildTargetDouble _ _) = QL2-    userTargetQualLevel (UserBuildTargetTriple _ _ _) = QL3+    userTargetQualLevel UserBuildTargetSingle{} = QL1+    userTargetQualLevel UserBuildTargetDouble{} = QL2+    userTargetQualLevel UserBuildTargetTriple{} = QL3      step       :: QualLevel@@ -407,7 +413,7 @@     targets ->       dieWithException verbosity $         UnknownBuildTarget $-          map (\(target, nosuch) -> (showUserBuildTarget target, nosuch)) targets+          map (first showUserBuildTarget) targets    case [(t, ts) | BuildTargetAmbiguous t ts <- problems] of     [] -> return ()@@ -417,7 +423,7 @@           map             ( \(target, amb) ->                 ( showUserBuildTarget target-                , (map (\(ut, bt) -> (showUserBuildTarget ut, showBuildTargetKind bt)) amb)+                , map (\(ut, bt) -> (showUserBuildTarget ut, showBuildTargetKind bt)) amb                 )             )             targets@@ -652,7 +658,7 @@   orNoSuchThing (showComponentKind ckind ++ " component") str $     increaseConfidenceFor $       matchInexactly-        (\(ck, cn) -> (ck, caseFold cn))+        (second caseFold)         [((cinfoKind c, cinfoStrName c), c) | c <- cs]         (ckind, str) @@ -853,6 +859,9 @@   | MatchErrorNoSuch String String   deriving (Show, Eq) +-- | @since 3.18+deriving instance Ord MatchError+ instance Alternative Match where   empty = mzero   (<|>) = mplus@@ -905,10 +914,10 @@   NoMatch d ms >>= _ = NoMatch d ms   ExactMatch d xs >>= f =     addDepth d $-      foldr matchPlus matchZero (map f xs)+      foldr (matchPlus . f) matchZero xs   InexactMatch d xs >>= f =     addDepth d . forceInexact $-      foldr matchPlus matchZero (map f xs)+      foldr (matchPlus . f) matchZero xs  addDepth :: Confidence -> Match a -> Match a addDepth d' (NoMatch d msgs) = NoMatch (d' + d) msgs@@ -941,13 +950,13 @@ increaseConfidenceFor :: Match a -> Match a increaseConfidenceFor m = m >>= \r -> increaseConfidence >> return r -nubMatches :: Eq a => Match a -> Match a+nubMatches :: Ord a => Match a -> Match a nubMatches (NoMatch d msgs) = NoMatch d msgs-nubMatches (ExactMatch d xs) = ExactMatch d (nub xs)-nubMatches (InexactMatch d xs) = InexactMatch d (nub xs)+nubMatches (ExactMatch d xs) = ExactMatch d (ordNub xs)+nubMatches (InexactMatch d xs) = InexactMatch d (ordNub xs)  nubMatchErrors :: Match a -> Match a-nubMatchErrors (NoMatch d msgs) = NoMatch d (nub msgs)+nubMatchErrors (NoMatch d msgs) = NoMatch d (ordNub msgs) nubMatchErrors (ExactMatch d xs) = ExactMatch d xs nubMatchErrors (InexactMatch d xs) = InexactMatch d xs @@ -968,14 +977,14 @@ -- | Given a matcher and a key to look up, use the matcher to find all the -- possible matches. There may be 'None', a single 'Unambiguous' match or -- you may have an 'Ambiguous' match with several possibilities.-findMatch :: Eq b => Match b -> MaybeAmbiguous b+findMatch :: Ord b => Match b -> MaybeAmbiguous b findMatch match =   case match of-    NoMatch _ msgs -> None (nub msgs)+    NoMatch _ msgs -> None (ordNub msgs)     ExactMatch _ xs -> checkAmbiguous xs     InexactMatch _ xs -> checkAmbiguous xs   where-    checkAmbiguous xs = case nub xs of+    checkAmbiguous xs = case ordNub xs of       [x] -> Unambiguous x       xs' -> Ambiguous xs' @@ -1016,9 +1025,7 @@ matchInexactly cannonicalise xs =   \x -> case Map.lookup x m of     Just ys -> exactMatches ys-    Nothing -> case Map.lookup (cannonicalise x) m' of-      Just ys -> inexactMatches ys-      Nothing -> matchZero+    Nothing -> maybe matchZero inexactMatches (Map.lookup (cannonicalise x) m')   where     m = Map.fromListWith (++) [(k, [x]) | (k, x) <- xs] 

@@ -1,14 +1,21 @@ {-# LANGUAGE LambdaCase #-} -module Distribution.Simple.BuildWay where+module Distribution.Simple.BuildWay+  ( BuildWay (..)+  , buildWayObjectExtension+  , buildWayInterfaceExtension+  ) where  data BuildWay = StaticWay | DynWay | ProfWay | ProfDynWay   deriving (Eq, Ord, Show, Read, Enum) --- | Returns the object/interface extension prefix for the given build way (e.g. "dyn_" for 'DynWay')-buildWayPrefix :: BuildWay -> String-buildWayPrefix = \case-  StaticWay -> ""-  ProfWay -> "p_"-  DynWay -> "dyn_"-  ProfDynWay -> "p_dyn_"+-- | Returns the object extension for the given build way (e.g. "dyn_o" for 'DynWay' on ELF)+buildWayObjectExtension :: String -> BuildWay -> String+buildWayObjectExtension ext = \case+  StaticWay -> ext+  ProfWay -> "p_" ++ ext+  DynWay -> "dyn_" ++ ext+  ProfDynWay -> "p_dyn_" ++ ext++buildWayInterfaceExtension :: BuildWay -> String+buildWayInterfaceExtension = buildWayObjectExtension "hi"

@@ -91,6 +91,7 @@ import Prelude ()  import qualified Data.Array as Array+import Data.Either (rights) import qualified Data.List as List import Distribution.Compat.Lens (ALens', (#~), (^#)) import qualified Distribution.GetOpt as GetOpt@@ -394,7 +395,7 @@ liftOptDescr :: (b -> a) -> (a -> (b -> b)) -> OptDescr a -> OptDescr b liftOptDescr get' set' (ChoiceOpt opts) =   ChoiceOpt-    [ (d, ff, liftSet get' set' set, (get . get'))+    [ (d, ff, liftSet get' set' set, get . get')     | (d, ff, set, get) <- opts     ] liftOptDescr get' set' (OptArg d ff ad set (dv, mkDef) get) =@@ -589,11 +590,11 @@     -- Note: It is crucial to use reverse function composition here or to     -- reverse the flags here as we want to process the flags left to right     -- but data flow in function composition is right to left.-    accum flags = foldr (flip (.)) id [f | Right f <- flags]+    accum flags = foldr (flip (.)) id (rights flags)     unrecognised opts =       [ "unrecognized "         ++ "'"-        ++ (commandName command)+        ++ commandName command         ++ "'"         ++ " option `"         ++ opt@@ -719,7 +720,7 @@         CommandList list -> pure $ CommandList (list ++ commandNames)         CommandErrors _ -> pure $ CommandHelp globalHelp         CommandReadyToGo (_, []) -> pure $ CommandHelp globalHelp-        CommandReadyToGo (_, (name : cmdArgs')) ->+        CommandReadyToGo (_, name : cmdArgs') ->           case lookupCommand name of             [Command _ _ action _] ->               case action ("--help" : cmdArgs') of

@@ -50,6 +50,7 @@   , interpretPackageDBStack   , coercePackageDB   , coercePackageDBStack+  , readPackageDb      -- * Support for optimisation levels   , OptimisationLevel (..)@@ -78,12 +79,14 @@   , profilingVanillaSupported   , profilingVanillaSupportedOrUnknown   , dynamicSupported+  , bytecodeArtifactsSupported   , backpackSupported   , arResponseFilesSupported   , arDashLSupported   , libraryDynDirSupported   , libraryVisibilitySupported   , jsemSupported+  , jsemVersion   , reexportedAsSupported      -- * Support for profiling detail levels@@ -93,17 +96,22 @@   , showProfDetailLevel   ) where +import Distribution.Compat.CharParsing import Distribution.Compat.Prelude+import Distribution.Parsec import Distribution.Pretty import Prelude ()  import Distribution.Compiler+import Distribution.Package (PackageName) import Distribution.Simple.Utils+import Distribution.Types.UnitId (UnitId) import Distribution.Utils.Path import Distribution.Version  import Language.Haskell.Extension +import Data.Bool (bool) import qualified Data.Map as Map (lookup) import System.Directory (canonicalizePath) @@ -120,12 +128,19 @@   -- ^ Supported language standards.   , compilerExtensions :: [(Extension, Maybe CompilerFlag)]   -- ^ Supported extensions.+  , compilerWiredInUnitIds :: Maybe [(PackageName, UnitId)]+  -- ^ 'UnitId's that the compiler doesn't support reinstalling.+  -- For instance, when using GHC plugins, one wants to use the exact same+  -- version of the `ghc` package as the one the compiler was linked against.+  -- 'Nothing' indicates that the compiler hasn't supplied this+  -- information and that we should act pessimistically.   , compilerProperties :: Map String String   -- ^ A key-value map for properties not covered by the above fields.   }   deriving (Eq, Generic, Show, Read)  instance Binary Compiler+instance NFData Compiler instance Structured Compiler  showCompilerId :: Compiler -> String@@ -178,6 +193,7 @@     (Just . compilerCompat $ c)     (Just . map fst . compilerLanguages $ c)     (Just . map fst . compilerExtensions $ c)+    (compilerWiredInUnitIds c)  -- ------------------------------------------------------------ @@ -201,8 +217,18 @@   deriving (Eq, Generic, Ord, Show, Read, Functor, Foldable, Traversable)  instance Binary fp => Binary (PackageDBX fp)+instance NFData fp => NFData (PackageDBX fp) instance Structured fp => Structured (PackageDBX fp) +-- | Parse a PackageDB stack entry+--+-- @since 3.7.0.0+readPackageDb :: String -> Maybe PackageDB+readPackageDb "clear" = Nothing+readPackageDb "global" = Just GlobalPackageDB+readPackageDb "user" = Just UserPackageDB+readPackageDb other = Just (SpecificPackageDB (makeSymbolicPath other))+ -- | We typically get packages from several databases, and stack them -- together. This type lets us be explicit about that stacking. For example -- typical stacks include:@@ -292,22 +318,39 @@   deriving (Bounded, Enum, Eq, Generic, Read, Show)  instance Binary OptimisationLevel+instance NFData OptimisationLevel instance Structured OptimisationLevel +instance Parsec OptimisationLevel where+  parsec = parsecOptimisationLevel++parsecOptimisationLevel :: CabalParsing m => m OptimisationLevel+parsecOptimisationLevel = boolParser <|> intParser+  where+    boolParser = bool NoOptimisation NormalOptimisation <$> parsec+    intParser = intToOptimisationLevel <$> integral+ flagToOptimisationLevel :: Maybe String -> OptimisationLevel flagToOptimisationLevel Nothing = NormalOptimisation flagToOptimisationLevel (Just s) = case reads s of-  [(i, "")]-    | i >= fromEnum (minBound :: OptimisationLevel)-        && i <= fromEnum (maxBound :: OptimisationLevel) ->-        toEnum i-    | otherwise ->-        error $-          "Bad optimisation level: "-            ++ show i-            ++ ". Valid values are 0..2"+  [(i, "")] -> intToOptimisationLevel i   _ -> error $ "Can't parse optimisation level " ++ s +intToOptimisationLevel :: Int -> OptimisationLevel+intToOptimisationLevel i+  | i >= minLevel && i <= maxLevel = toEnum i+  | otherwise =+      error $+        "Bad optimisation level: "+          ++ show i+          ++ ". Valid values are "+          ++ show minLevel+          ++ ".."+          ++ show maxLevel+  where+    minLevel = fromEnum (minBound :: OptimisationLevel)+    maxLevel = fromEnum (maxBound :: OptimisationLevel)+ -- ------------------------------------------------------------  -- * Debug info levels@@ -325,8 +368,15 @@   deriving (Bounded, Enum, Eq, Generic, Read, Show)  instance Binary DebugInfoLevel+instance NFData DebugInfoLevel instance Structured DebugInfoLevel +instance Parsec DebugInfoLevel where+  parsec = parsecDebugInfoLevel++parsecDebugInfoLevel :: CabalParsing m => m DebugInfoLevel+parsecDebugInfoLevel = flagToDebugInfoLevel . pure <$> parsecToken+ flagToDebugInfoLevel :: Maybe String -> DebugInfoLevel flagToDebugInfoLevel Nothing = NormalDebugInfo flagToDebugInfoLevel (Just s) = case reads s of@@ -355,8 +405,7 @@ languageToFlags :: Compiler -> Maybe Language -> [CompilerFlag] languageToFlags comp =   filter (not . null)-    . catMaybes-    . map (languageToFlag comp)+    . mapMaybe (languageToFlag comp)     . maybe [Haskell98] (\x -> [x])  languageToFlag :: Compiler -> Language -> Maybe CompilerFlag@@ -375,8 +424,7 @@ extensionsToFlags comp =   nub     . filter (not . null)-    . catMaybes-    . map (extensionToFlag comp)+    . mapMaybe (extensionToFlag comp)  -- | Looks up the flag for a given extension, for a given compiler. -- Ignores the subtlety of extensions which lack associated flags.@@ -433,6 +481,15 @@   where     v = compilerVersion comp +-- | What semaphore protocol version does this compiler use?+--+-- Returns @Nothing@ for compilers that don't report a "Semaphore version"+-- field in @ghc --info@ (i.e. GHC 9.8–9.14, which use v1).+jsemVersion :: Compiler -> Maybe Int+jsemVersion comp = case compilerFlavor comp of+  GHC -> Map.lookup "Semaphore version" (compilerProperties comp) >>= readMaybe+  _ -> Nothing+ -- | Does the compiler support the -reexported-modules "A as B" syntax reexportedAsSupported :: Compiler -> Bool reexportedAsSupported comp = case compilerFlavor comp of@@ -445,15 +502,8 @@ -- "dynamic-library-dirs"? libraryDynDirSupported :: Compiler -> Bool libraryDynDirSupported comp = case compilerFlavor comp of-  GHC ->-    -- Not just v >= mkVersion [8,0,1,20161022], as there-    -- are many GHC 8.1 nightlies which don't support this.-    ( (v >= mkVersion [8, 0, 1, 20161022] && v < mkVersion [8, 1])-        || v >= mkVersion [8, 1, 20161021]-    )+  GHC -> True   _ -> False-  where-    v = compilerVersion comp  -- | Does this compiler's "ar" command supports response file -- arguments (i.e. @file-style arguments).@@ -527,6 +577,14 @@ dynamicSupported :: Compiler -> Maybe Bool dynamicSupported comp = waySupported "dyn" comp +-- | Does the compiler support producing bytecode objects and bytecode libraries?+bytecodeArtifactsSupported :: Compiler -> Bool+bytecodeArtifactsSupported comp+  | GHC <- compilerFlavor comp+  , compilerVersion comp >= mkVersion [9, 15, 0] =+      True+  | otherwise = False+ -- | Does this compiler support a package database entry with: -- "visibility"? libraryVisibilitySupported :: Compiler -> Bool@@ -572,7 +630,14 @@   deriving (Eq, Generic, Read, Show)  instance Binary ProfDetailLevel+instance NFData ProfDetailLevel instance Structured ProfDetailLevel++instance Parsec ProfDetailLevel where+  parsec = parsecProfDetailLevel++parsecProfDetailLevel :: CabalParsing m => m ProfDetailLevel+parsecProfDetailLevel = flagToProfDetailLevel <$> parsecToken  flagToProfDetailLevel :: String -> ProfDetailLevel flagToProfDetailLevel "" = ProfDetailDefault

@@ -5,6 +5,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}  ----------------------------------------------------------------------------- @@ -32,6 +33,19 @@ module Distribution.Simple.Configure   ( configure   , configure_setupHooks+  , computePackageInfo+  , computePackageInfoFromIndex+  , configureFinal+  , runPreConfPackageHook+  , runPostConfPackageHook+  , runPreConfComponentHook+  , configurePackage+  , PackageInfo (..)+  , mkProgramDb+  , finalCheckPackage+  , configureComponents+  , mkPromisedDepsSet+  , combinedConstraints   , writePersistBuildConfig   , getConfigStateFile   , getPersistBuildConfig@@ -53,6 +67,9 @@   , configCompilerAuxEx   , configCompilerProgDb   , computeEffectiveProfiling+  , adjustBuildOptions+  , buildOptionsAdjustmentWarnings+  , adjustBuildOptionsAndWarn   , ccLdOptionsBuildInfo   , checkForeignDeps   , interpretPackageDbFlags@@ -77,7 +94,7 @@ import qualified Distribution.InstalledPackageInfo as IPI import Distribution.Package import Distribution.PackageDescription-import Distribution.PackageDescription.Check hiding (doesFileExist)+import Distribution.PackageDescription.Check hiding (doesFileExist, listDirectory) import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.PrettyPrint import Distribution.Simple.BuildTarget@@ -136,10 +153,6 @@   ) import qualified Data.List.NonEmpty as NEL import qualified Data.Map as Map-import Distribution.Compat.Directory-  ( doesPathExist-  , listDirectory-  ) import Distribution.Compat.Environment (lookupEnv) import Distribution.Parsec   ( simpleParsec@@ -157,7 +170,8 @@   ( canonicalizePath   , createDirectoryIfMissing   , doesFileExist-  , removeFile+  , doesPathExist+  , listDirectory   ) import System.FilePath   ( isAbsolute@@ -314,7 +328,7 @@   -- ^ The @dist@ directory path.   -> IO (Maybe LocalBuildInfo) maybeGetPersistBuildConfig mbWorkDir =-  liftM (either (const Nothing) Just) . tryGetPersistBuildConfig mbWorkDir+  fmap (either (const Nothing) Just) . tryGetPersistBuildConfig mbWorkDir  -- | After running configure, output the 'LocalBuildInfo' to the -- 'localBuildInfoFile'.@@ -424,7 +438,7 @@   -- ^ override \"dist\" prefix   -> IO (SymbolicPath Pkg (Dir Dist)) findDistPref defDistPref overrideDistPref = do-  envDistPref <- liftM parseEnvDistPref (lookupEnv "CABAL_BUILDDIR")+  envDistPref <- parseEnvDistPref <$> lookupEnv "CABAL_BUILDDIR"   return $ fromFlagOrDefault defDistPref (mappend envDistPref overrideDistPref)   where     parseEnvDistPref env =@@ -445,111 +459,247 @@ findDistPrefOrDefault = findDistPref defaultDistPref  -- | Perform the \"@.\/setup configure@\" action.---  Returns the @.setup-config@ file.+--+-- Returns the @LocalBuildInfo@, also writing it to the @setup-config@ file. configure   :: (GenericPackageDescription, HookedBuildInfo)   -> ConfigFlags   -> IO LocalBuildInfo-configure = configure_setupHooks noConfigureHooks+configure p cfg = do+  lbi <- configure_setupHooks noConfigureHooks p defaultVerbosityHandles cfg+  -- Write the 'LocalBuildInfo' to the @setup-config@ file.+  --+  -- NB: the shared 'configure_setupHooks'/'configureFinal' functions deliberately+  -- don't include this logic, as it is the responsibility of each top-level+  -- configure entry point.+  let distPref = fromFlag $ configDistPref cfg+      mbWorkDir = flagToMaybe $ configWorkingDir cfg+  writePersistBuildConfig mbWorkDir distPref lbi+  return lbi +-- | Run the @Cabal@ library configure phase.+--+-- NB: this function does /not/ persist the resulting 'LocalBuildInfo' to the+-- @setup-config@ file; that is the responsibility of callers. configure_setupHooks   :: ConfigureHooks   -> (GenericPackageDescription, HookedBuildInfo)+  -> VerbosityHandles   -> ConfigFlags   -> IO LocalBuildInfo configure_setupHooks-  (ConfigureHooks{preConfPackageHook, postConfPackageHook, preConfComponentHook})+  confHooks@(ConfigureHooks{preConfPackageHook})   (g_pkg_descr, hookedBuildInfo)+  verbHandles   cfg = do-    -- Cabal pre-configure-    let verbosity = fromFlag (configVerbosity cfg)-        distPref = fromFlag $ configDistPref cfg-        mbWorkDir = flagToMaybe $ configWorkingDir cfg-    (lbc0, comp, platform, enabledComps) <- preConfigurePackage cfg g_pkg_descr+    (lbc0, comp, platform, enabledComps) <- preConfigurePackage verbHandles cfg g_pkg_descr      -- Package-wide pre-configure hook     lbc1 <--      case preConfPackageHook of-        Nothing -> return lbc0-        Just pre_conf -> do-          let programDb0 = LBC.withPrograms lbc0-              programDb0' = programDb0{unconfiguredProgs = Map.empty}-              input =-                SetupHooks.PreConfPackageInputs-                  { SetupHooks.configFlags = cfg-                  , SetupHooks.localBuildConfig = lbc0{LBC.withPrograms = programDb0'}-                  , -- Unconfigured programs are not supplied to the hook,-                    -- as these cannot be passed over a serialisation boundary-                    -- (see the "Binary ProgramDb" instance).-                    SetupHooks.compiler = comp-                  , SetupHooks.platform = platform-                  }-          SetupHooks.PreConfPackageOutputs-            { SetupHooks.buildOptions = opts1-            , SetupHooks.extraConfiguredProgs = progs1-            } <--            pre_conf input-          -- The package-wide pre-configure hook returns BuildOptions that-          -- overrides the one it was passed in, as well as an update to-          -- the ProgramDb in the form of new configured programs to add-          -- to the program database.-          return $-            lbc0-              { LBC.withBuildOptions = opts1-              , LBC.withPrograms =-                  updateConfiguredProgs-                    (`Map.union` progs1)-                    programDb0-              }+      maybe+        (return lbc0)+        (runPreConfPackageHook cfg comp platform lbc0)+        preConfPackageHook      -- Cabal package-wide configure-    (lbc2, pbd2, pkg_info) <--      finalizeAndConfigurePackage cfg lbc1 g_pkg_descr comp platform enabledComps+    (allConstraints, pkgInfo) <-+      computePackageInfo verbHandles cfg lbc1 g_pkg_descr comp+    (packageDbs, pkg_descr0, flags) <-+      finalizePackageDescription+        verbHandles+        cfg+        g_pkg_descr+        comp+        platform+        enabledComps+        allConstraints+        pkgInfo -    -- Package-wide post-configure hook-    for_ postConfPackageHook $ \postConfPkg -> do-      let input =-            SetupHooks.PostConfPackageInputs-              { SetupHooks.localBuildConfig = lbc2-              , SetupHooks.packageBuildDescr = pbd2-              }-      postConfPkg input+    configureFinal+      verbHandles+      confHooks+      hookedBuildInfo+      cfg+      lbc1+      (g_pkg_descr, pkg_descr0)+      flags+      enabledComps+      comp+      platform+      packageDbs+      pkgInfo -    -- Per-component pre-configure hook-    pkg_descr <- do-      let pkg_descr2 = LBC.localPkgDescr pbd2-      applyComponentDiffs-        verbosity-        ( \c -> for preConfComponentHook $ \computeDiff -> do-            let input =-                  SetupHooks.PreConfComponentInputs-                    { SetupHooks.localBuildConfig = lbc2-                    , SetupHooks.packageBuildDescr = pbd2-                    , SetupHooks.component = c-                    }-            SetupHooks.PreConfComponentOutputs-              { SetupHooks.componentDiff = diff-              } <--              computeDiff input-            return diff-        )-        pkg_descr2-    let pbd3 = pbd2{LBC.localPkgDescr = pkg_descr}+configureFinal+  :: VerbosityHandles+  -> ConfigureHooks+  -> HookedBuildInfo+  -> ConfigFlags+  -> LBC.LocalBuildConfig+  -> (GenericPackageDescription, PackageDescription)+  -> FlagAssignment+  -> ComponentRequestedSpec+  -> Compiler+  -> Platform+  -> PackageDBStack+  -> PackageInfo+  -> IO LocalBuildInfo+configureFinal+  verbHandles+  (ConfigureHooks{postConfPackageHook, preConfComponentHook})+  hookedBuildInfo+  cfg+  lbc0+  (gpkgDescr, pkgDescr0)+  flags+  enabledComps+  comp+  platform+  packageDbs+  pkgInfo@PackageInfo+    { installedPackageSet = installedPkgSet+    , promisedDepsSet = promisedDeps+    } =+    do+      let verbosity = mkVerbosity verbHandles (fromFlag (configVerbosity cfg)) -    -- Cabal per-component configure-    externalPkgDeps <- finalCheckPackage g_pkg_descr pbd3 hookedBuildInfo pkg_info-    lbi <- configureComponents lbc2 pbd3 pkg_info externalPkgDeps+      -- Apply compiler capability checks to the incoming build options+      -- (idempotent).+      lbc1 <- do+        let opts = LBC.withBuildOptions lbc0+        opts' <- adjustBuildOptionsAndWarn verbosity comp (LBC.withPrograms lbc0) opts+        return lbc0{LBC.withBuildOptions = opts'} -    writePersistBuildConfig mbWorkDir distPref lbi+      -- Cabal package-wide configure+      (lbc2, pbd2) <-+        configurePackage verbHandles cfg lbc1 pkgDescr0 flags enabledComps comp platform packageDbs -    return lbi+      -- Package-wide post-configure hook+      for_ postConfPackageHook $ runPostConfPackageHook lbc2 pbd2 -preConfigurePackage+      -- Per-component pre-configure hooks+      pkgDescr <- do+        let pkgDescr2 = LBC.localPkgDescr pbd2+        applyComponentDiffs+          verbosity+          (for preConfComponentHook . runPreConfComponentHook lbc2 pbd2)+          pkgDescr2+      let pbd3 = pbd2{LBC.localPkgDescr = pkgDescr}++      -- Cabal per-component configure+      finalCheckPackage verbHandles gpkgDescr pbd3 hookedBuildInfo++      let+        use_external_internal_deps =+          case enabledComps of+            OneComponentRequestedSpec{} -> True+            ComponentRequestedSpec{} -> False+      -- The list of 'InstalledPackageInfo' recording the selected+      -- dependencies on external packages.+      --+      -- Invariant: For any package name, there is at most one package+      -- in externalPackageDeps which has that name.+      --+      -- NB: The dependency selection is global over ALL components+      -- in the package (similar to how allConstraints and+      -- requiredDepsMap are global over all components).  In particular,+      -- if *any* component (post-flag resolution) has an unsatisfiable+      -- dependency, we will fail.  This can sometimes be undesirable+      -- for users, see #1786 (benchmark conflicts with executable),+      --+      -- In the presence of Backpack, these package dependencies are+      -- NOT complete: they only ever include the INDEFINITE+      -- dependencies.  After we apply an instantiation, we'll get+      -- definite references which constitute extra dependencies.+      -- (Why not have cabal-install pass these in explicitly?+      -- For one it's deterministic; for two, we need to associate+      -- them with renamings which would require a far more complicated+      -- input scheme than what we have today.)+      externalPkgDeps <-+        selectDependencies+          verbosity+          use_external_internal_deps+          pkgInfo+          pkgDescr+          enabledComps+      configureComponents verbHandles lbc2 pbd3 installedPkgSet promisedDeps externalPkgDeps++runPreConfPackageHook   :: ConfigFlags+  -> Compiler+  -> Platform+  -> LBC.LocalBuildConfig+  -> (SetupHooks.PreConfPackageInputs -> IO SetupHooks.PreConfPackageOutputs)+  -> IO LBC.LocalBuildConfig+runPreConfPackageHook cfg comp platform lbc0 pre_conf = do+  let programDb0 = LBC.withPrograms lbc0+      programDb0' = programDb0{unconfiguredProgs = Map.empty}+      input =+        SetupHooks.PreConfPackageInputs+          { SetupHooks.configFlags = cfg+          , SetupHooks.localBuildConfig = lbc0{LBC.withPrograms = programDb0'}+          , -- Unconfigured programs are not supplied to the hook,+            -- as these cannot be passed over a serialisation boundary+            -- (see the "Binary ProgramDb" instance).+            SetupHooks.compiler = comp+          , SetupHooks.platform = platform+          }+  SetupHooks.PreConfPackageOutputs+    { SetupHooks.buildOptions = opts1+    , SetupHooks.extraConfiguredProgs = progs1+    } <-+    pre_conf input+  -- The package-wide pre-configure hook returns a 'BuildOptions' that+  -- overrides the one it was passed in, as well as an update to+  -- the 'ProgramDb' in the form of new configured programs to add+  -- to the program database.+  return $+    lbc0+      { LBC.withBuildOptions = opts1+      , LBC.withPrograms =+          updateConfiguredProgs+            (`Map.union` progs1)+            programDb0+      }++runPostConfPackageHook+  :: LBC.LocalBuildConfig+  -> LBC.PackageBuildDescr+  -> (SetupHooks.PostConfPackageInputs -> IO ())+  -> IO ()+runPostConfPackageHook lbc2 pbd2 postConfPkg =+  let input =+        SetupHooks.PostConfPackageInputs+          { SetupHooks.localBuildConfig = lbc2+          , SetupHooks.packageBuildDescr = pbd2+          }+   in postConfPkg input++runPreConfComponentHook+  :: LBC.LocalBuildConfig+  -> LBC.PackageBuildDescr+  -> Component+  -> (SetupHooks.PreConfComponentInputs -> IO SetupHooks.PreConfComponentOutputs)+  -> IO SetupHooks.ComponentDiff+runPreConfComponentHook lbc pbd c hook = do+  let input =+        SetupHooks.PreConfComponentInputs+          { SetupHooks.localBuildConfig = lbc+          , SetupHooks.packageBuildDescr = pbd+          , SetupHooks.component = c+          }+  SetupHooks.PreConfComponentOutputs+    { SetupHooks.componentDiff = diff+    } <-+    hook input+  return diff++preConfigurePackage+  :: VerbosityHandles+  -> ConfigFlags   -> GenericPackageDescription   -> IO (LBC.LocalBuildConfig, Compiler, Platform, ComponentRequestedSpec)-preConfigurePackage cfg g_pkg_descr = do-  let verbosity = fromFlag $ configVerbosity cfg+preConfigurePackage verbHandles cfg g_pkg_descr = do+  let verbosity = mkVerbosity verbHandles (fromFlag $ configVerbosity cfg)    -- Determine the component we are configuring, if a user specified   -- one on the command line.  We use a fake, flattened version of@@ -584,9 +734,8 @@    -- Make a data structure describing what components are enabled.   let enabled :: ComponentRequestedSpec-      enabled = case mb_cname of-        Just cname -> OneComponentRequestedSpec cname-        Nothing ->+      enabled =+        maybe           ComponentRequestedSpec             { -- The flag name (@--enable-tests@) is a               -- little bit of a misnomer, because@@ -596,9 +745,10 @@               -- @buildable: False@ might make it               -- not possible to enable.               testsRequested = fromFlag (configTests cfg)-            , benchmarksRequested =-                fromFlag (configBenchmarks cfg)+            , benchmarksRequested = fromFlag (configBenchmarks cfg)             }+          OneComponentRequestedSpec+          mb_cname   -- Some sanity checks related to enabling components.   when     ( isJust mb_cname@@ -609,7 +759,7 @@   checkDeprecatedFlags verbosity cfg   checkExactConfiguration verbosity g_pkg_descr cfg -  programDbPre <- mkProgramDb cfg (configPrograms cfg)+  programDbPre <- mkProgramDb verbHandles cfg (configPrograms cfg)   -- comp:            the compiler we're building with   -- compPlatform:    the platform we're building for   -- programDb:  location and args of all programs we're@@ -623,7 +773,7 @@       (flagToMaybe (configHcPath cfg))       (flagToMaybe (configHcPkg cfg))       programDbPre-      (lessVerbose verbosity)+      (modifyVerbosityFlags lessVerbose verbosity)    -- Where to build the package   let builddir :: SymbolicPath Pkg (Dir Build) -- e.g. dist/build@@ -632,74 +782,42 @@   -- NB: create this directory now so that all configure hooks get   -- to see it. (In practice, the Configure build-type needs it before   -- the postConfPackageHook runs.)-  createDirectoryIfMissingVerbose (lessVerbose verbosity) True $+  createDirectoryIfMissingVerbose (modifyVerbosityFlags lessVerbose verbosity) True $     interpretSymbolicPath mbWorkDir builddir -  lbc <- computeLocalBuildConfig cfg comp programDb00+  lbc <- computeLocalBuildConfig verbHandles cfg comp programDb00   return (lbc, comp, compPlatform, enabled)  computeLocalBuildConfig-  :: ConfigFlags+  :: VerbosityHandles+  -> ConfigFlags   -> Compiler   -> ProgramDb   -> IO LBC.LocalBuildConfig-computeLocalBuildConfig cfg comp programDb = do+computeLocalBuildConfig verbHandles cfg comp programDb = do   let common = configCommonFlags cfg-      verbosity = fromFlag $ setupVerbosity common-  -- Decide if we're going to compile with split sections.-  split_sections :: Bool <--    if not (fromFlag $ configSplitSections cfg)-      then return False-      else case compilerFlavor comp of-        GHC-          | compilerVersion comp >= mkVersion [8, 0] ->-              return True-        GHCJS ->-          return True-        _ -> do-          warn-            verbosity-            ( "this compiler does not support "-                ++ "--enable-split-sections; ignoring"-            )-          return False--  -- Decide if we're going to compile with split objects.-  split_objs :: Bool <--    if not (fromFlag $ configSplitObjs cfg)-      then return False-      else case compilerFlavor comp of-        _ | split_sections ->-          do-            warn-              verbosity-              ( "--enable-split-sections and "-                  ++ "--enable-split-objs are mutually "-                  ++ "exclusive; ignoring the latter"-              )-            return False-        GHC ->-          return True-        GHCJS ->-          return True-        _ -> do-          warn-            verbosity-            ( "this compiler does not support "-                ++ "--enable-split-objs; ignoring"-            )-          return False+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+  rawBuildOptions <- buildOptionsFromConfigFlags verbosity cfg comp+  buildOptions <- adjustBuildOptionsAndWarn verbosity comp programDb rawBuildOptions+  return $+    LBC.LocalBuildConfig+      { extraConfigArgs = []+      , -- Currently configure does not+        -- take extra args, but if it+        -- did they would go here.+        withPrograms = programDb+      , withBuildOptions = buildOptions+      } -  -- Basically yes/no/unknown.-  let linkerSupportsRelocations :: Maybe Bool-      linkerSupportsRelocations =-        case lookupProgramByName "ld" programDb of-          Nothing -> Nothing-          Just ld ->-            case Map.lookup "Supports relocatable output" $ programProperties ld of-              Just "YES" -> Just True-              Just "NO" -> Just False-              _other -> Nothing+-- | Compute a default 'LBC.BuildOptions' from 'ConfigFlags', applying+-- compiler-specific defaults but without compiler capability checks+-- (see 'adjustBuildOptionsAndWarn' for that).+buildOptionsFromConfigFlags+  :: Verbosity+  -> ConfigFlags+  -> Compiler+  -> IO LBC.BuildOptions+buildOptionsFromConfigFlags verbosity cfg comp = do   let ghciLibByDefault =         case compilerId comp of           CompilerId GHC _ ->@@ -711,22 +829,11 @@             -- rely on them. By the time that bug was fixed, ghci had             -- been changed to read shared libraries instead of archive             -- files (see next code block).-            not (GHC.compilerBuildWay comp `elem` [DynWay, ProfDynWay])+            GHC.compilerBuildWay comp `notElem` [DynWay, ProfDynWay]           CompilerId GHCJS _ ->             not (GHCJS.isDynamic comp)           _ -> False -  withGHCiLib_ <--    case fromFlagOrDefault ghciLibByDefault (configGHCiLib cfg) of-      -- NOTE: If linkerSupportsRelocations is Nothing this may still fail if the-      -- linker does not support -r.-      True | not (fromMaybe True linkerSupportsRelocations) -> do-        warn verbosity $-          "--enable-library-for-ghci is not supported with the current"-            ++ "  linker; ignoring..."-        return False-      v -> return v-   let sharedLibsByDefault         | fromFlag (configDynExe cfg) =             -- build a shared library if dynamically-linked@@ -752,6 +859,10 @@         -- into a huge .a archive) via GHCs -staticlib flag.         fromFlagOrDefault False $ configStaticLib cfg +      -- See doc/internal/bytecode-libraries.md for the end-to-end story.+      withBytecodeLib_ =+        fromFlagOrDefault False $ configBytecodeLib cfg+       withDynExe_ = fromFlag $ configDynExe cfg        withFullyStaticExe_ = fromFlag $ configFullyStaticExe cfg@@ -779,75 +890,191 @@   strip_lib <- strip_libexe "library" configStripLibs   strip_exe <- strip_libexe "executable" configStripExes -  let buildOptions =-        setCoverage . setProfiling $-          LBC.BuildOptions-            { withVanillaLib = fromFlag $ configVanillaLib cfg-            , withSharedLib = withSharedLib_-            , withStaticLib = withStaticLib_-            , withDynExe = withDynExe_-            , withFullyStaticExe = withFullyStaticExe_-            , withProfLib = False-            , withProfLibShared = False-            , withProfLibDetail = ProfDetailNone-            , withProfExe = False-            , withProfExeDetail = ProfDetailNone-            , withOptimization = fromFlag $ configOptimization cfg-            , withDebugInfo = fromFlag $ configDebugInfo cfg-            , withGHCiLib = withGHCiLib_-            , splitSections = split_sections-            , splitObjs = split_objs-            , stripExes = strip_exe-            , stripLibs = strip_lib-            , exeCoverage = False-            , libCoverage = False-            , relocatable = fromFlagOrDefault False $ configRelocatable cfg-            }+  return $+    setCoverage . setProfiling $+      LBC.BuildOptions+        { withVanillaLib = fromFlag $ configVanillaLib cfg+        , withSharedLib = withSharedLib_+        , withStaticLib = withStaticLib_+        , withBytecodeLib = withBytecodeLib_+        , withDynExe = withDynExe_+        , withFullyStaticExe = withFullyStaticExe_+        , withProfLib = False+        , withProfLibShared = False+        , withProfLibDetail = ProfDetailNone+        , withProfExe = False+        , withProfExeDetail = ProfDetailNone+        , withOptimization = fromFlag $ configOptimization cfg+        , withDebugInfo = fromFlag $ configDebugInfo cfg+        , withGHCiLib = fromFlagOrDefault ghciLibByDefault (configGHCiLib cfg)+        , splitSections = fromFlagOrDefault False $ configSplitSections cfg+        , splitObjs = fromFlagOrDefault False $ configSplitObjs cfg+        , stripExes = strip_exe+        , stripLibs = strip_lib+        , exeCoverage = False+        , libCoverage = False+        , relocatable = fromFlagOrDefault False $ configRelocatable cfg+        } -  -- Dynamic executable, but no shared vanilla libraries-  when (LBC.withDynExe buildOptions && not (LBC.withProfExe buildOptions) && not (LBC.withSharedLib buildOptions)) $-    warn verbosity $-      "Executables will use dynamic linking, but a shared library "-        ++ "is not being built. Linking will fail if any executables "-        ++ "depend on the library."+-- | Adjust 'LBC.BuildOptions' to be compatible with the given 'Compiler' and+-- 'ProgramDb'.+--+-- See also 'adjustBuildOptionsAndWarn', which additionally informs the user+-- of unavailable requested features via warning messages.+adjustBuildOptions :: Compiler -> ProgramDb -> LBC.BuildOptions -> LBC.BuildOptions+adjustBuildOptions comp programDb opts =+  opts+    { LBC.splitSections = splitSec+    , LBC.splitObjs = splitObj+    , LBC.withGHCiLib = ghciLib+    , LBC.withBytecodeLib = bytecodeLib+    , LBC.exeCoverage = exeCov+    , LBC.libCoverage = libCov+    }+  where+    splitSec+      | not (LBC.splitSections opts) = False+      | GHC <- compilerFlavor comp+      , compilerVersion comp >= mkVersion [8, 0] =+          True+      | GHCJS <- compilerFlavor comp = True+      | otherwise = False -- not supported by this compiler+    splitObj+      | not (LBC.splitObjs opts) = False+      | splitSec = False -- mutually exclusive with split-sections+      | GHC <- compilerFlavor comp = True+      | GHCJS <- compilerFlavor comp = True+      | otherwise = False -- not supported by this compiler+    linkerSupportsRelocations :: Maybe Bool+    linkerSupportsRelocations =+      case lookupProgramByName "ld" programDb of+        Nothing -> Nothing+        Just ld ->+          case Map.lookup "Supports relocatable output" $ programProperties ld of+            Just "YES" -> Just True+            Just "NO" -> Just False+            _other -> Nothing -  -- Profiled dynamic executable, but no shared profiling libraries-  when (LBC.withDynExe buildOptions && LBC.withProfExe buildOptions && not (LBC.withProfLibShared buildOptions)) $-    warn verbosity $-      "Executables will use profiled dynamic linking, but a profiled shared library "-        ++ "is not being built. Linking will fail if any executables "-        ++ "depend on the library."+    ghciLib+      | LBC.withGHCiLib opts+      , not (fromMaybe True linkerSupportsRelocations) =+          False+      | otherwise = LBC.withGHCiLib opts -  return $-    LBC.LocalBuildConfig-      { extraConfigArgs = [] -- Currently configure does not-      -- take extra args, but if it-      -- did they would go here.-      , withPrograms = programDb-      , withBuildOptions = buildOptions-      }+    bytecodeLib+      | LBC.withBytecodeLib opts+      , not (bytecodeArtifactsSupported comp) =+          False+      | otherwise = LBC.withBytecodeLib opts +    exeCov+      | LBC.exeCoverage opts, not (coverageSupported comp) = False+      | otherwise = LBC.exeCoverage opts++    libCov+      | LBC.libCoverage opts, not (coverageSupported comp) = False+      | otherwise = LBC.libCoverage opts++-- | Warnings to emit after downgrading 'LBC.BuildOptions' when the+-- compiler (or another toolchain program) doesn't support a requested feature.+buildOptionsAdjustmentWarnings+  :: Compiler+  -> LBC.BuildOptions+  -- ^ original options+  -> LBC.BuildOptions+  -- ^ adjusted options (result of 'adjustBuildOptions')+  -> [String]+buildOptionsAdjustmentWarnings comp opts0 opts1 =+  [ "This compiler does not support bytecode libraries; ignoring --enable-library-bytecode"+  | LBC.withBytecodeLib opts0+  , not (LBC.withBytecodeLib opts1)+  ]+    ++ [ "this compiler does not support --enable-split-sections; ignoring"+       | LBC.splitSections opts0+       , not (LBC.splitSections opts1)+       ]+    ++ [ if LBC.splitSections opts1+        then+          "--enable-split-sections and --enable-split-objs are mutually "+            ++ "exclusive; ignoring the latter"+        else "this compiler does not support --enable-split-objs; ignoring"+       | LBC.splitObjs opts0+       , not (LBC.splitObjs opts1)+       ]+    ++ [ "--enable-library-for-ghci is not supported with the current"+        ++ "  linker; ignoring..."+       | LBC.withGHCiLib opts0+       , not (LBC.withGHCiLib opts1)+       ]+    ++ [ "The compiler "+        ++ showCompilerId comp+        ++ " does not support "+        ++ "program coverage. Program coverage has been disabled."+       | LBC.exeCoverage opts0+       , not (LBC.exeCoverage opts1)+       ]++-- | Like 'adjustBuildOptions', but includes warnings for downgraded+-- build options.+adjustBuildOptionsAndWarn+  :: Verbosity+  -> Compiler+  -> ProgramDb+  -> LBC.BuildOptions+  -> IO LBC.BuildOptions+adjustBuildOptionsAndWarn verbosity comp programDb opts0 = do+  let opts1 = adjustBuildOptions comp programDb opts0+  mapM_ (warn verbosity) (buildOptionsAdjustmentWarnings comp opts0 opts1)++  -- Also warn for any inconsistencies found in BuildOptions.+  when+    ( LBC.withDynExe opts1+        && not (LBC.withProfExe opts1)+        && not (LBC.withSharedLib opts1)+    )+    $ warn verbosity+    $ "Executables will use dynamic linking, but a shared library "+      ++ "is not being built. Linking will fail if any executables "+      ++ "depend on the library."+  when+    ( LBC.withDynExe opts1+        && LBC.withProfExe opts1+        && not (LBC.withProfLibShared opts1)+    )+    $ warn verbosity+    $ "Executables will use profiled dynamic linking, but a profiled shared library "+      ++ "is not being built. Linking will fail if any executables "+      ++ "depend on the library."+  return opts1+ data PackageInfo = PackageInfo   { internalPackageSet :: Set LibraryName+  -- ^ Libraries internal to the package   , promisedDepsSet :: Map (PackageName, ComponentName) PromisedComponent+  -- ^ Collection of components that are promised, i.e. are not installed already.+  --+  -- See 'PromisedDependency' for more details.   , installedPackageSet :: InstalledPackageIndex+  -- ^ Installed packages   , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo+  -- ^ Packages for which we have been given specific deps to use   }  configurePackage-  :: ConfigFlags+  :: VerbosityHandles+  -> ConfigFlags   -> LBC.LocalBuildConfig   -> PackageDescription   -> FlagAssignment   -> ComponentRequestedSpec   -> Compiler   -> Platform-  -> ProgramDb   -> PackageDBStack   -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr)-configurePackage cfg lbc0 pkg_descr00 flags enabled comp platform programDb0 packageDbs = do+configurePackage verbHandles cfg lbc0 pkg_descr00 flags enabled comp platform packageDbs = do   let common = configCommonFlags cfg-      verbosity = fromFlag $ setupVerbosity common+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+      programDb0 = LBC.withPrograms lbc0        -- add extra include/lib dirs as specified in cfg       pkg_descr0 = addExtraIncludeLibDirsFromConfigFlags pkg_descr00 cfg@@ -883,12 +1110,12 @@             let unknownBuildTools =                   [ buildTool                   | buildTool <- buildTools bi-                  , Nothing == desugarBuildTool pkg_descr0 buildTool+                  , isNothing (desugarBuildTool pkg_descr0 buildTool)                   ]             externBuildToolDeps ++ unknownBuildTools    programDb1 <--    configureAllKnownPrograms (lessVerbose verbosity) programDb0+    configureAllKnownPrograms (modifyVerbosityFlags lessVerbose verbosity) programDb0       >>= configureRequiredPrograms verbosity requiredBuildTools    (pkg_descr2, programDb2) <-@@ -907,7 +1134,7 @@     defaultInstallDirs'       use_external_internal_deps       (compilerFlavor comp)-      (fromFlag (configUserInstall cfg))+      (fromFlagOrDefault True (configUserInstall cfg))       (hasLibs pkg_descr2)   let     installDirs =@@ -936,17 +1163,16 @@    return (lbc, pbd) -finalizeAndConfigurePackage-  :: ConfigFlags+computePackageInfo+  :: VerbosityHandles+  -> ConfigFlags   -> LBC.LocalBuildConfig   -> GenericPackageDescription   -> Compiler-  -> Platform-  -> ComponentRequestedSpec-  -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr, PackageInfo)-finalizeAndConfigurePackage cfg lbc0 g_pkg_descr comp platform enabled = do+  -> IO ([PackageVersionConstraint], PackageInfo)+computePackageInfo verbHandles cfg lbc0 g_pkg_descr comp = do   let common = configCommonFlags cfg-      verbosity = fromFlag $ setupVerbosity common+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)       mbWorkDir = flagToMaybe $ setupWorkingDir common    let programDb0 = LBC.withPrograms lbc0@@ -954,21 +1180,33 @@       packageDbs :: PackageDBStack       packageDbs =         interpretPackageDbFlags-          (fromFlag (configUserInstall cfg))+          (fromFlagOrDefault True (configUserInstall cfg))           (configPackageDBs cfg)    -- The InstalledPackageIndex of all installed packages   installedPackageSet :: InstalledPackageIndex <-     getInstalledPackages-      (lessVerbose verbosity)+      (modifyVerbosityFlags lessVerbose verbosity)       comp       mbWorkDir       packageDbs       programDb0+  computePackageInfoFromIndex verbHandles cfg g_pkg_descr installedPackageSet -  -- The set of package names which are "shadowed" by internal-  -- packages, and which component they map to-  let internalPackageSet :: Set LibraryName+-- | Like 'computePackageInfo' but takes a given 'InstalledPackageIndex'+-- instead of needing to query the @hc-pkg@ program to obtain it.+computePackageInfoFromIndex+  :: VerbosityHandles+  -> ConfigFlags+  -> GenericPackageDescription+  -> InstalledPackageIndex+  -> IO ([PackageVersionConstraint], PackageInfo)+computePackageInfoFromIndex verbHandles cfg g_pkg_descr installedPackageSet = do+  let common = configCommonFlags cfg+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)+      -- The set of package names which are "shadowed" by internal+      -- packages, and which component they map to+      internalPackageSet :: Set LibraryName       internalPackageSet = getInternalLibraries g_pkg_descr    -- Some sanity checks related to dynamic/static linking.@@ -999,14 +1237,37 @@    let     promisedDepsSet = mkPromisedDepsSet (configPromisedDependencies cfg)-    pkg_info =-      PackageInfo+  return+    ( allConstraints+    , PackageInfo         { internalPackageSet         , promisedDepsSet         , installedPackageSet         , requiredDepsMap         }+    ) +finalizePackageDescription+  :: VerbosityHandles+  -> ConfigFlags+  -> GenericPackageDescription+  -> Compiler+  -> Platform+  -> ComponentRequestedSpec+  -> [PackageVersionConstraint]+  -> PackageInfo+  -> IO (PackageDBStack, PackageDescription, FlagAssignment)+finalizePackageDescription verbHandles cfg g_pkg_descr comp platform enabled allConstraints pkgInfo = do+  let common = configCommonFlags cfg+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)++  -- What package database(s) to use+  let packageDbs :: PackageDBStack+      packageDbs =+        interpretPackageDbFlags+          (fromFlagOrDefault True (configUserInstall cfg))+          (configPackageDBs cfg)+   -- pkg_descr:   The resolved package description, that does not contain any   --              conditionals, because we have an assignment for   --              every flag, either picking them ourselves using a@@ -1028,7 +1289,7 @@   ( pkg_descr0 :: PackageDescription     , flags :: FlagAssignment     ) <--    configureFinalizedPackage+    finalizePackageDescription2       verbosity       cfg       enabled@@ -1038,27 +1299,12 @@           (fromFlagOrDefault False (configExactConfiguration cfg))           (fromFlagOrDefault False (configAllowDependingOnPrivateLibs cfg))           (packageName g_pkg_descr)-          installedPackageSet-          internalPackageSet-          promisedDepsSet-          requiredDepsMap+          pkgInfo       )       comp       platform       g_pkg_descr--  (lbc, pbd) <--    configurePackage-      cfg-      lbc0-      pkg_descr0-      flags-      enabled-      comp-      platform-      programDb0-      packageDbs-  return (lbc, pbd, pkg_info)+  return (packageDbs, pkg_descr0, flags)  addExtraIncludeLibDirsFromConfigFlags   :: PackageDescription -> ConfigFlags -> PackageDescription@@ -1110,12 +1356,13 @@         }  finalCheckPackage-  :: GenericPackageDescription+  :: VerbosityHandles+  -> GenericPackageDescription   -> LBC.PackageBuildDescr   -> HookedBuildInfo-  -> PackageInfo-  -> IO ([PreExistingComponent], [ConfiguredPromisedComponent])+  -> IO () finalCheckPackage+  verbHandles   g_pkg_descr   ( LBC.PackageBuildDescr       { configFlags = cfg@@ -1125,16 +1372,11 @@       , componentEnabledSpec = enabled       }     )-  hookedBuildInfo-  (PackageInfo{internalPackageSet, promisedDepsSet, installedPackageSet, requiredDepsMap}) =+  hookedBuildInfo =     do       let common = configCommonFlags cfg-          verbosity = fromFlag $ setupVerbosity common+          verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)           cabalFileDir = packageRoot common-          use_external_internal_deps =-            case enabled of-              OneComponentRequestedSpec{} -> True-              ComponentRequestedSpec{} -> False        checkCompilerProblems verbosity comp pkg_descr enabled       checkPackageProblems@@ -1150,70 +1392,39 @@       -- Check languages and extensions       -- TODO: Move this into a helper function.       let langlist =-            nub $-              catMaybes $-                map-                  defaultLanguage-                  (enabledBuildInfos pkg_descr enabled)+            ordNub $+              mapMaybe defaultLanguage (enabledBuildInfos pkg_descr enabled)       let langs = unsupportedLanguages comp langlist-      when (not (null langs)) $+      unless (null langs) $         dieWithException verbosity $-          UnsupportedLanguages (packageId g_pkg_descr) (compilerId comp) (map prettyShow langs)+          UnsupportedLanguages (packageId pkg_descr) (compilerId comp) (map prettyShow langs)       let extlist =-            nub $+            ordNub $               concatMap                 allExtensions                 (enabledBuildInfos pkg_descr enabled)       let exts = unsupportedExtensions comp extlist-      when (not (null exts)) $+      unless (null exts) $         dieWithException verbosity $-          UnsupportedLanguageExtension (packageId g_pkg_descr) (compilerId comp) (map prettyShow exts)+          UnsupportedLanguageExtension (packageId pkg_descr) (compilerId comp) (map prettyShow exts)        -- Check foreign library build requirements       let flibs = [flib | CFLib flib <- enabledComponents pkg_descr enabled]       let unsupportedFLibs = unsupportedForeignLibs comp compPlatform flibs-      when (not (null unsupportedFLibs)) $+      unless (null unsupportedFLibs) $         dieWithException verbosity $           CantFindForeignLibraries unsupportedFLibs -      -- The list of 'InstalledPackageInfo' recording the selected-      -- dependencies on external packages.-      ---      -- Invariant: For any package name, there is at most one package-      -- in externalPackageDeps which has that name.-      ---      -- NB: The dependency selection is global over ALL components-      -- in the package (similar to how allConstraints and-      -- requiredDepsMap are global over all components).  In particular,-      -- if *any* component (post-flag resolution) has an unsatisfiable-      -- dependency, we will fail.  This can sometimes be undesirable-      -- for users, see #1786 (benchmark conflicts with executable),-      ---      -- In the presence of Backpack, these package dependencies are-      -- NOT complete: they only ever include the INDEFINITE-      -- dependencies.  After we apply an instantiation, we'll get-      -- definite references which constitute extra dependencies.-      -- (Why not have cabal-install pass these in explicitly?-      -- For one it's deterministic; for two, we need to associate-      -- them with renamings which would require a far more complicated-      -- input scheme than what we have today.)-      configureDependencies-        verbosity-        use_external_internal_deps-        internalPackageSet-        promisedDepsSet-        installedPackageSet-        requiredDepsMap-        pkg_descr-        enabled- configureComponents-  :: LBC.LocalBuildConfig+  :: VerbosityHandles+  -> LBC.LocalBuildConfig   -> LBC.PackageBuildDescr-  -> PackageInfo+  -> InstalledPackageIndex+  -> Map (PackageName, ComponentName) PromisedComponent   -> ([PreExistingComponent], [ConfiguredPromisedComponent])   -> IO LocalBuildInfo configureComponents+  verbHandles   lbc@(LBC.LocalBuildConfig{withPrograms = programDb})   pbd0@( LBC.PackageBuildDescr           { configFlags = cfg@@ -1222,11 +1433,12 @@           , componentEnabledSpec = enabled           }         )-  (PackageInfo{promisedDepsSet, installedPackageSet})+  installedPackageSet+  promisedDepsSet   externalPkgDeps =     do       let common = configCommonFlags cfg-          verbosity = fromFlag $ setupVerbosity common+          verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)           use_external_internal_deps =             case enabled of               OneComponentRequestedSpec{} -> True@@ -1362,6 +1574,7 @@       dirinfo "Executables" (bindir dirs) (bindir relative)       dirinfo "Libraries" (libdir dirs) (libdir relative)       dirinfo "Dynamic Libraries" (dynlibdir dirs) (dynlibdir relative)+      dirinfo "Bytecode Libraries" (bytecodelibdir dirs) (bytecodelibdir relative)       dirinfo "Private executables" (libexecdir dirs) (libexecdir relative)       dirinfo "Data files" (datadir dirs) (datadir relative)       dirinfo "Documentation" (docdir dirs) (docdir relative)@@ -1380,16 +1593,17 @@ -- | Adds the extra program paths from the flags provided to @configure@ as -- well as specified locations for certain known programs and their default -- arguments.-mkProgramDb :: ConfigFlags -> ProgramDb -> IO ProgramDb-mkProgramDb cfg initialProgramDb = do+mkProgramDb :: VerbosityHandles -> ConfigFlags -> ProgramDb -> IO ProgramDb+mkProgramDb verbHandles cfg initialProgramDb = do   programDb <-     modifyProgramSearchPath (getProgramSearchPath initialProgramDb ++) -- We need to have the paths to programs installed by build-tool-depends before all other paths-      <$> prependProgramSearchPath (fromFlagOrDefault normal (configVerbosity cfg)) searchpath [] initialProgramDb+      <$> prependProgramSearchPath verbosity searchpath [] initialProgramDb   pure     . userSpecifyArgss (configProgramArgs cfg)     . userSpecifyPaths (configProgramPaths cfg)     $ programDb   where+    verbosity = mkVerbosity verbHandles $ fromFlagOrDefault normal (configVerbosity cfg)     searchpath = fromNubList (configProgramPathExtra cfg)  -- Note. We try as much as possible to _prepend_ rather than postpend the extra-prog-path@@ -1442,7 +1656,7 @@     let cmdlineFlags = map fst (unFlagAssignment (configConfigurationsFlags cfg))         allFlags = map flagName . genPackageFlags $ pkg_descr0         diffFlags = allFlags \\ cmdlineFlags-    when (not . null $ diffFlags) $+    unless (null diffFlags) $       dieWithException verbosity $         FlagsNotSpecified diffFlags @@ -1474,23 +1688,19 @@   -> Bool   -- ^ allow depending on private libs?   -> PackageName-  -> InstalledPackageIndex-  -- ^ installed set-  -> Set LibraryName-  -- ^ library components-  -> Map (PackageName, ComponentName) PromisedComponent-  -> Map (PackageName, ComponentName) InstalledPackageInfo-  -- ^ required dependencies+  -> PackageInfo   -> (Dependency -> DependencySatisfaction) dependencySatisfiable   use_external_internal_deps   exact_config   allow_private_deps   pn-  installedPackageSet-  packageLibraries-  promisedDeps-  requiredDepsMap+  PackageInfo+    { internalPackageSet = packageLibraries+    , promisedDepsSet = promisedDeps+    , installedPackageSet+    , requiredDepsMap+    }   (Dependency depName vr sublibs)     | exact_config =         -- When we're given '--exact-configuration', we assume that all@@ -1539,12 +1749,12 @@          in if null $ PackageIndex.matchingDependencies vr allVersions               then                 if null eligibleVersions-                  then Unsatisfied $ MissingPackage+                  then Unsatisfied MissingPackage                   else Unsatisfied $ WrongVersion eligibleVersions               else Satisfied        internalDepSatisfiable =-        let missingLibraries = (NES.toSet sublibs) `Set.difference` packageLibraries+        let missingLibraries = NES.toSet sublibs `Set.difference` packageLibraries          in case nonEmpty $ Set.toList missingLibraries of               Nothing -> Satisfied               Just missingLibraries' -> Unsatisfied $ MissingLibrary missingLibraries'@@ -1585,7 +1795,7 @@ -- | Finalize a generic package description. -- -- The workhorse is 'finalizePD'.-configureFinalizedPackage+finalizePackageDescription2   :: Verbosity   -> ConfigFlags   -> ComponentRequestedSpec@@ -1597,7 +1807,7 @@   -> Platform   -> GenericPackageDescription   -> IO (PackageDescription, FlagAssignment)-configureFinalizedPackage+finalizePackageDescription2   verbosity   cfg   enabled@@ -1653,25 +1863,17 @@     $ dieWithException verbosity CompilerDoesn'tSupportBackpack  -- | Select dependencies for the package.-configureDependencies+selectDependencies   :: Verbosity   -> UseExternalInternalDeps-  -> Set LibraryName-  -> Map (PackageName, ComponentName) PromisedComponent-  -> InstalledPackageIndex-  -- ^ installed packages-  -> Map (PackageName, ComponentName) InstalledPackageInfo-  -- ^ required deps+  -> PackageInfo   -> PackageDescription   -> ComponentRequestedSpec   -> IO ([PreExistingComponent], [ConfiguredPromisedComponent])-configureDependencies+selectDependencies   verbosity   use_external_internal_deps-  packageLibraries-  promisedDeps-  installedPackageSet-  requiredDepsMap+  pkgInfo   pkg_descr   enableSpec = do     let failedDeps :: [FailedDependency]@@ -1679,15 +1881,12 @@         (failedDeps, allPkgDeps) =           partitionEithers $             concat-              [ fmap (\s -> (dep, s)) <$> status+              [ fmap (dep,) <$> status               | dep <- enabledBuildDepends pkg_descr enableSpec               , let status =                       selectDependency                         (package pkg_descr)-                        packageLibraries-                        promisedDeps-                        installedPackageSet-                        requiredDepsMap+                        pkgInfo                         use_external_internal_deps                         dep               ]@@ -1941,15 +2140,7 @@ selectDependency   :: PackageId   -- ^ Package id of current package-  -> Set LibraryName-  -- ^ package libraries-  -> Map (PackageName, ComponentName) PromisedComponent-  -- ^ Set of components that are promised, i.e. are not installed already. See 'PromisedDependency' for more details.-  -> InstalledPackageIndex-  -- ^ Installed packages-  -> Map (PackageName, ComponentName) InstalledPackageInfo-  -- ^ Packages for which we have been given specific deps to-  -- use+  -> PackageInfo   -> UseExternalInternalDeps   -- ^ Are we configuring a   -- single component?@@ -1957,10 +2148,13 @@   -> [Either FailedDependency DependencyResolution] selectDependency   pkgid-  internalIndex-  promisedIndex-  installedIndex-  requiredDepsMap+  ( PackageInfo+      { internalPackageSet = internalIndex+      , promisedDepsSet = promisedIndex+      , installedPackageSet = installedIndex+      , requiredDepsMap+      }+    )   use_external_internal_deps   (Dependency dep_pkgname vr libs) =     -- If the dependency specification matches anything in the internal package@@ -2067,7 +2261,7 @@   -- do not check empty packagedbs (ghc-pkg would error out)   packageDBs' <- filterM packageDBExists packageDBs   case compilerFlavor comp of-    GHC -> GHC.getInstalledPackages verbosity comp mbWorkDir packageDBs' progdb+    GHC -> GHC.getInstalledPackages verbosity mbWorkDir packageDBs' progdb     GHCJS -> GHCJS.getInstalledPackages verbosity mbWorkDir packageDBs' progdb     UHC -> UHC.getInstalledPackages verbosity comp mbWorkDir packageDBs' progdb     flv ->@@ -2136,7 +2330,7 @@ -- | Looks up the 'InstalledPackageInfo' of the given 'UnitId's from the -- 'PackageDBStack' in the 'LocalBuildInfo'. getInstalledPackagesById-  :: (Exception (VerboseException exception), Show exception, Typeable exception)+  :: Exception (VerboseException exception)   => Verbosity   -> LocalBuildInfo   -> (UnitId -> exception)@@ -2193,7 +2387,7 @@       , Map (PackageName, ComponentName) InstalledPackageInfo       ) combinedConstraints constraints dependencies installedPackages = do-  when (not (null badComponentIds)) $+  unless (null badComponentIds) $     Left $       CombinedConstraints (dispDependencies badComponentIds) @@ -2363,7 +2557,7 @@   | otherwise = do       (_, _, progdb') <-         requireProgramVersion-          (lessVerbose verbosity)+          (modifyVerbosityFlags lessVerbose verbosity)           pkgConfigProgram           (orLaterVersion $ mkVersion [0, 9, 0])           progdb@@ -2386,7 +2580,7 @@     allpkgs = concatMap pkgconfigDepends (enabledBuildInfos pkg_descr enabled)     pkgconfig =       getDbProgramOutput-        (lessVerbose verbosity)+        (modifyVerbosityFlags lessVerbose verbosity)         pkgConfigProgram         progdb @@ -2436,7 +2630,7 @@     pkgconfigBuildInfo :: [PkgconfigDependency] -> IO BuildInfo     pkgconfigBuildInfo [] = return mempty     pkgconfigBuildInfo pkgdeps = do-      let pkgs = nub [prettyShow pkg | PkgconfigDependency pkg _ <- pkgdeps]+      let pkgs = ordNub [prettyShow pkg | PkgconfigDependency pkg _ <- pkgdeps]       ccflags <- pkgconfig ("--cflags" : pkgs)       ldflags <- pkgconfig ("--libs" : pkgs)       ldflags_static <- pkgconfig ("--libs" : "--static" : pkgs)@@ -2457,8 +2651,8 @@   let (includeDirs', cflags') = partition ("-I" `isPrefixOf`) cflags       (extraLibs', ldflags') = partition ("-l" `isPrefixOf`) ldflags       (extraLibDirs', ldflags'') = partition ("-L" `isPrefixOf`) ldflags'-      (extraLibsStatic') = filter ("-l" `isPrefixOf`) ldflags_static-      (extraLibDirsStatic') = filter ("-L" `isPrefixOf`) ldflags_static+      extraLibsStatic' = filter ("-l" `isPrefixOf`) ldflags_static+      extraLibDirsStatic' = filter ("-L" `isPrefixOf`) ldflags_static    in mempty         { includeDirs = map (makeSymbolicPath . drop 2) includeDirs'         , extraLibs = map (drop 2) extraLibs'@@ -2473,12 +2667,13 @@ -- Determining the compiler details  configCompilerAuxEx-  :: ConfigFlags+  :: VerbosityHandles+  -> ConfigFlags   -> IO (Compiler, Platform, ProgramDb)-configCompilerAuxEx cfg = do-  programDb <- mkProgramDb cfg defaultProgramDb+configCompilerAuxEx verbHandles cfg = do+  programDb <- mkProgramDb verbHandles cfg defaultProgramDb   let common = configCommonFlags cfg-      verbosity = fromFlag $ setupVerbosity common+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity common)   configCompilerEx     (flagToMaybe $ configHcFlavor cfg)     (flagToMaybe $ configHcPath cfg)@@ -2578,14 +2773,10 @@     -- in either the generated (most likely by `configure`)     -- build directory (e.g. `dist/build`) or in the source directory.     ---    -- If it exists in both, we'll remove the one in the source-    -- directory, as the generated should take precedence.+    -- If it exists in both, issue a warning, because C compilers are+    -- not guaranteed to pick the correct one and there appears to be+    -- no way to control which is picked.     ---    -- C compilers like to prefer source local relative includes,-    -- so the search paths provided to the compiler via -I are-    -- ignored if the included file can be found relative to the-    -- including file.  As such we need to take drastic measures-    -- and delete the offending file in the source directory.     checkDuplicateHeaders = do       let relIncDirs = filter (not . isAbsolute) (collectField (fmap getSymbolicPath . includeDirs))           isHeader = isSuffixOf ".h"@@ -2602,9 +2793,7 @@             ++ (getSymbolicPath (buildDir lbi) </> hdr)             ++ " and "             ++ (baseDir </> hdr)-            ++ "; removing "-            ++ (baseDir </> hdr)-        removeFile (baseDir </> hdr)+            ++ ". Which one the C compiler will use is unspecified."      findOffendingHdr =       ifBuildsWith@@ -2766,7 +2955,7 @@       (errors, warnings) =         partitionEithers (M.mapMaybe classEW $ pureChecks ++ ioChecks)   if null errors-    then traverse_ (warn verbosity) (map ppPackageCheck warnings)+    then traverse_ (warn verbosity . ppPackageCheck) warnings     else dieWithException verbosity $ CheckPackageProblems (map ppPackageCheck errors)   where     -- Classify error/warnings. Left: error, Right: warning.@@ -2809,7 +2998,7 @@     -- and RPATH, make sure you add your OS to RPATH-support list of:     -- Distribution.Simple.GHC.getRPaths     checkOS =-      unless (os `elem` [OSX, Linux]) $+      unless (os `elem` [OSX, Linux, FreeBSD]) $         dieWithException verbosity $           NoOSSupport os "relocatable builds"       where@@ -2817,7 +3006,7 @@      -- Check if the Compiler support relocatable builds     checkCompiler =-      unless (compilerFlavor comp `elem` [GHC]) $+      unless (compilerFlavor comp == GHC) $         dieWithException verbosity $           NoCompilerSupport (show comp)       where@@ -2827,7 +3016,7 @@     packagePrefixRelative =       unless (relativeInstallDirs installDirs) $         dieWithException verbosity $-          InstallDirsNotPrefixRelative (installDirs)+          InstallDirsNotPrefixRelative installDirs       where         -- NB: should be good enough to check this against the default         -- component ID, but if we wanted to be strictly correct we'd@@ -2836,22 +3025,20 @@         p = prefix installDirs         relativeInstallDirs (InstallDirs{..}) =           all-            isJust-            ( fmap-                (stripPrefix p)-                [ bindir-                , libdir-                , dynlibdir-                , libexecdir-                , includedir-                , datadir-                , docdir-                , mandir-                , htmldir-                , haddockdir-                , sysconfdir-                ]-            )+            (isJust . stripPrefix p)+            [ bindir+            , libdir+            , dynlibdir+            , bytecodelibdir+            , libexecdir+            , includedir+            , datadir+            , docdir+            , mandir+            , htmldir+            , haddockdir+            , sysconfdir+            ]      -- Check if the library dirs of the dependencies that are in the package     -- database to which the package is installed are relative to the@@ -2861,7 +3048,7 @@       traverse_ (doCheck $ getSymbolicPath pkgr) ipkgs       where         doCheck pkgr ipkg-          | maybe False (== pkgr) (IPI.pkgRoot ipkg) =+          | Just pkgr == IPI.pkgRoot ipkg =               for_ (IPI.libraryDirs ipkg) $ \libdir -> do                 -- When @prefix@ is not under @pkgroot@,                 -- @shortRelativePath prefix pkgroot@ will return a path with@@ -2895,12 +3082,7 @@ checkForeignLibSupported comp platform flib = go (compilerFlavor comp)   where     go :: CompilerFlavor -> Maybe String-    go GHC-      | compilerVersion comp < mkVersion [7, 8] =-          unsupported-            [ "Building foreign libraries is only supported with GHC >= 7.8"-            ]-      | otherwise = goGhcPlatform platform+    go GHC = goGhcPlatform platform     go _ =       unsupported         [ "Building foreign libraries is currently only supported with ghc"

@@ -35,14 +35,14 @@ import Distribution.System (Platform, buildPlatform) import Distribution.Utils.NubList import Distribution.Utils.Path+import Distribution.Verbosity  -- Base-import System.Directory (createDirectoryIfMissing, doesFileExist)+import System.Directory (createDirectoryIfMissing, doesFileExist, makeAbsolute) import qualified System.FilePath as FilePath #ifdef mingw32_HOST_OS import System.FilePath    (normalise, splitDrive) #endif-import Distribution.Compat.Directory (makeAbsolute) import Distribution.Compat.Environment (getEnvironment) import Distribution.Compat.GetShortPathName (getShortPathName) @@ -50,15 +50,16 @@ import qualified Data.Map as Map  runConfigureScript-  :: ConfigFlags+  :: VerbosityHandles+  -> ConfigFlags   -> FlagAssignment   -> ProgramDb   -> Platform   -- ^ host platform   -> IO ()-runConfigureScript cfg flags programDb hp = do+runConfigureScript verbHandles cfg flags programDb hp = do   let commonCfg = configCommonFlags cfg-      verbosity = fromFlag $ setupVerbosity commonCfg+      verbosity = mkVerbosity verbHandles (fromFlag $ setupVerbosity commonCfg)   dist_dir <- findDistPrefOrDefault $ setupDistPref commonCfg   let build_dir = dist_dir </> makeRelativePathEx "build"       mbWorkDir = flagToMaybe $ setupWorkingDir commonCfg@@ -66,8 +67,7 @@   confExists <- doesFileExist configureScriptPath   unless confExists $     dieWithException verbosity (ConfigureScriptNotFound configureScriptPath)-  configureFile <--    makeAbsolute $ configureScriptPath+  configureFile <- makeAbsolute configureScriptPath   env <- getEnvironment   (ccProg, ccFlags) <- configureCCompiler verbosity programDb   ccProgShort <- getShortPathName ccProg@@ -183,7 +183,7 @@           : [("CXXFLAGS", Just (mkFlagsEnv cxxFlags "CXXFLAGS")) | Just cxxFlags <- [mcxxFlags]]           ++ [("PATH", Just pathEnv) | not (null extraPath)]           ++ cabalFlagEnv-      maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)]+      maybeHostFlag = ["--host=" ++ show (pretty hp) | hp /= buildPlatform]       args' =         configureFile'           : args

@@ -49,10 +49,10 @@   | -- | @NoLibraryFound@ has been downgraded to a warning, and is therefore no longer emitted.     NoLibraryFound   | CompilerNotInstalled CompilerFlavor-  | CantFindIncludeFile String+  | CantFindIncludeFile String [String]   | UnsupportedTestSuite String   | UnsupportedBenchMark String-  | NoIncludeFileFound String+  | NoIncludeFileFound String [String]   | NoModuleFound ModuleName [Suffix]   | RegMultipleInstancePkg   | SuppressingChecksOnFile@@ -96,8 +96,7 @@   | AmbiguousBuildTarget [(String, [(String, String)])]   | CheckBuildTargets String   | VersionMismatchGHC FilePath Version FilePath Version-  | CheckPackageDbStackPost76-  | CheckPackageDbStackPre76+  | CheckPackageDbStack   | GlobalPackageDbSpecifiedFirst   | CantInstallForeignLib   | NoSupportForPreProcessingTest TestType@@ -170,6 +169,7 @@   | MissingCoveredInstalledLibrary UnitId   | SetupHooksException SetupHooksException   | MultiReplDoesNotSupportComplexReexportedModules PackageName ComponentName+  | StandaloneBytecodeNotSupportedYet   deriving (Show)  exceptionCode :: CabalException -> Int@@ -229,8 +229,8 @@   AmbiguousBuildTarget{} -> 7865   CheckBuildTargets{} -> 4733   VersionMismatchGHC{} -> 4000-  CheckPackageDbStackPost76{} -> 3000-  CheckPackageDbStackPre76{} -> 5640+  CheckPackageDbStack{} -> 3000+  -- Retired: CheckPackageDbStackPre76{} -> 5640   GlobalPackageDbSpecifiedFirst{} -> 2345   CantInstallForeignLib{} -> 8221   NoSupportForPreProcessingTest{} -> 3008@@ -304,6 +304,7 @@   SetupHooksException err ->     setupHooksExceptionCode err   MultiReplDoesNotSupportComplexReexportedModules{} -> 9355+  StandaloneBytecodeNotSupportedYet -> 9356  versionRequirement :: VersionRange -> String versionRequirement range@@ -318,10 +319,10 @@   NoBenchMark bmName -> "no such benchmark: " ++ bmName   NoLibraryFound -> "No executables and no library found. Nothing to do."   CompilerNotInstalled compilerFlavor -> "installing with " ++ prettyShow compilerFlavor ++ "is not implemented"-  CantFindIncludeFile file -> "can't find include file " ++ file+  CantFindIncludeFile file sd -> "can't find include file " ++ file ++ " in any of the search dirs " ++ intercalate ", " sd   UnsupportedTestSuite test_type -> "Unsupported test suite type: " ++ test_type   UnsupportedBenchMark benchMarkType -> "Unsupported benchmark type: " ++ benchMarkType-  NoIncludeFileFound f -> "can't find include file " ++ f+  NoIncludeFileFound f sd -> "can't find include file " ++ f ++ " in any of the search dirs " ++ intercalate ", " sd   NoModuleFound m suffixes ->     "Could not find module: "       ++ prettyShow m@@ -468,13 +469,9 @@       ++ ghcPkgProgPath       ++ " is version "       ++ prettyShow ghcPkgVersion-  CheckPackageDbStackPost76 ->+  CheckPackageDbStack ->     "If the global package db is specified, it must be "       ++ "specified first and cannot be specified multiple times"-  CheckPackageDbStackPre76 ->-    "With current ghc versions the global package db is always used "-      ++ "and must be listed first. This ghc limitation is lifted in GHC 7.6,"-      ++ "see https://gitlab.haskell.org/ghc/ghc/-/issues/5977"   GlobalPackageDbSpecifiedFirst ->     "If the global package db is specified, it must be "       ++ "specified first and cannot be specified multiple times"@@ -804,3 +801,8 @@       ++ prettyShow pname       ++ " a module renaming was found.\n"       ++ "Multi-repl does not work with complicated reexported-modules until GHC-9.12."+  StandaloneBytecodeNotSupportedYet ->+    unlines+      [ "The ecosystem doesn't support building packages with just bytecode libraries yet."+      , "If you have run into this error, please comment on issue #<TODO>"+      ]

@@ -39,6 +39,7 @@ import qualified Distribution.Compat.CharParsing as P import Distribution.Parsec import Distribution.Pretty+import Distribution.Utils.Generic (isAsciiAlpha) import qualified Text.PrettyPrint as Disp  --------------------------------------------------------------------------------@@ -211,7 +212,7 @@       root = FilePathRoot "/" <$ P.char '/'       home = FilePathHomeDir <$ P.string "~/"       drive = do-        dr <- P.satisfy $ \c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')+        dr <- P.satisfy isAsciiAlpha         _ <- P.char ':'         _ <- P.char '/' <|> P.char '\\'         return (FilePathRoot (toUpper dr : ":\\"))

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}@@ -60,7 +61,6 @@   , hcPkgInfo   , registerPackage   , Internal.componentGhcOptions-  , Internal.componentCcGhcOptions   , getGhcAppDir   , getLibDir   , compilerBuildWay@@ -91,7 +91,6 @@ import Data.Maybe (fromJust) import Distribution.CabalSpecVersion import Distribution.InstalledPackageInfo (InstalledPackageInfo)-import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo import Distribution.Package import Distribution.PackageDescription as PD import Distribution.Pretty@@ -99,6 +98,7 @@ import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.Errors+import Distribution.Simple.Flag import qualified Distribution.Simple.GHC.Build as GHC import Distribution.Simple.GHC.Build.Modules (BuildWay (..)) import Distribution.Simple.GHC.Build.Utils@@ -142,7 +142,7 @@   , doesDirectoryExist   , doesFileExist   , getAppUserDataDirectory-  , getDirectoryContents+  , listDirectory #ifndef mingw32_HOST_OS   , renameFile #endif@@ -186,9 +186,9 @@       (userMaybeSpecifyPath "ghc" hcPath conf0)    -- Cabal currently supports GHC less than `maxGhcVersion`-  let maxGhcVersion = mkVersion [9, 16]+  let maxGhcVersion = mkVersion [10, 2]   unless (ghcVersion < maxGhcVersion) $-    warn verbosity $+    info verbosity $       "Unknown/unsupported 'ghc' version detected "         ++ "(Cabal "         ++ prettyShow cabalVersion@@ -200,8 +200,8 @@         ++ prettyShow ghcVersion    let implInfo = ghcVersionImplInfo ghcVersion-  languages <- Internal.getLanguages verbosity implInfo ghcProg-  extensions0 <- Internal.getExtensions verbosity implInfo ghcProg+  languages <- Internal.getLanguages implInfo+  extensions0 <- Internal.getExtensions verbosity ghcProg    ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg @@ -209,10 +209,8 @@       filterJS = if ghcVersion < mkVersion [9, 8] then filterExt JavaScriptFFI else id       extensions =         -- workaround https://gitlab.haskell.org/ghc/ghc/-/issues/11214-        filterJS $-          -- see 'filterExtTH' comment below-          filterExtTH $-            extensions0+        -- see 'filterExtTH' comment below+        filterJS $ filterExtTH extensions0        -- starting with GHC 8.0, `TemplateHaskell` will be omitted from       -- `--supported-extensions` when it's not available.@@ -229,21 +227,36 @@       compilerId :: CompilerId       compilerId = CompilerId GHC ghcVersion +      projectUnitId :: Maybe String+      projectUnitId = Map.lookup "Project Unit Id" ghcInfoMap+       -- The @AbiTag@ is the @Project Unit Id@ but with redundant information from the compiler version removed.       -- For development versions of the compiler these look like:       -- @Project Unit Id@: "ghc-9.13-inplace"       -- @compilerId@: "ghc-9.13.20250413"       -- So, we need to be careful to only strip the /common/ prefix.       -- In this example, @AbiTag@ is "inplace".+      -- If the @Project Unit Id@ exactly matches @compilerId@, stripping the+      -- common prefix yields the empty string, which should be treated as+      -- @NoAbiTag@ rather than @AbiTag ""@.       compilerAbiTag :: AbiTag       compilerAbiTag =-        maybe-          NoAbiTag-          AbiTag-          ( dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId)-              <$> Map.lookup "Project Unit Id" ghcInfoMap-          )+        let abiTagSuffix =+              dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId)+                <$> projectUnitId+         in case abiTagSuffix of+              Nothing -> NoAbiTag+              Just "" -> NoAbiTag+              Just tag -> AbiTag tag +      wiredInUnitIds = do+        ghcInternalUnitId <- Map.lookup "ghc-internal Unit Id" ghcInfoMap+        ghcUnitId <- projectUnitId+        pure+          [ (mkPackageName "ghc", mkUnitId ghcUnitId)+          , (mkPackageName "ghc-internal", mkUnitId ghcInternalUnitId)+          ]+   let comp =         Compiler           { compilerId@@ -252,6 +265,7 @@           , compilerLanguages = languages           , compilerExtensions = extensions           , compilerProperties = ghcInfoMap+          , compilerWiredInUnitIds = wiredInUnitIds           }       compPlatform = Internal.targetPlatform ghcInfo   return (comp, compPlatform, progdb1)@@ -270,25 +284,6 @@   -- ^ user-specified @ghc-pkg@ path (optional)   -> IO ProgramDb compilerProgramDb verbosity comp progdb1 hcPkgPath = do-  let-    ghcProg = fromJust $ lookupProgram ghcProgram progdb1-    ghcVersion = compilerVersion comp--  -- This is slightly tricky, we have to configure ghc first, then we use the-  -- location of ghc to help find ghc-pkg in the case that the user did not-  -- specify the location of ghc-pkg directly:-  (ghcPkgProg, ghcPkgVersion, progdb2) <--    requireProgramVersion-      verbosity-      ghcPkgProgram-        { programFindLocation = guessGhcPkgFromGhcPath ghcProg-        }-      anyVersion-      (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)--  when (ghcVersion /= ghcPkgVersion) $-    dieWithException verbosity $-      VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion   -- Likewise we try to find the matching hsc2hs and haddock programs.   let hsc2hsProgram' =         hsc2hsProgram@@ -306,20 +301,49 @@         runghcProgram           { programFindLocation = guessRunghcFromGhcPath ghcProg           }-      progdb3 =-        addKnownProgram haddockProgram' $-          addKnownProgram hsc2hsProgram' $-            addKnownProgram hpcProgram' $-              addKnownProgram runghcProgram' progdb2+      ghcPkgProgram' =+        ghcPkgProgram+          { programFindLocation = guessGhcPkgFromGhcPath ghcProg+          }+      progdb2 =+        -- The knownPrograms are populated before userMaybeSpecifyPath+        -- in the case that ProgramDb has been restored from a cache and is empty+        -- See #11373 for where this went wrong before+        userMaybeSpecifyPath "ghc-pkg" hcPkgPath $+          addKnownProgram haddockProgram' $+            addKnownProgram hsc2hsProgram' $+              addKnownProgram hpcProgram' $+                addKnownProgram runghcProgram' $+                  addKnownProgram+                    ghcPkgProgram'+                    progdb1 +      ghcProg = fromJust $ lookupProgram ghcProgram progdb1+      ghcVersion = compilerVersion comp+       -- configure gcc, ld, ar etc... based on the paths stored       -- in the GHC settings file-      progdb4 =+      progdb3 =         Internal.configureToolchain           (ghcVersionImplInfo ghcVersion)           ghcProg           (compilerProperties comp)-          progdb3+          progdb2++  -- This is slightly tricky, we have to configure ghc first, then we use the+  -- location of ghc to help find ghc-pkg in the case that the user did not+  -- specify the location of ghc-pkg directly:+  (ghcPkgProg, ghcPkgVersion, progdb4) <-+    requireProgramVersion+      verbosity+      ghcPkgProgram'+      anyVersion+      progdb3++  when (ghcVersion /= ghcPkgVersion) $+    dieWithException verbosity $+      VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion+   return progdb4  -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find@@ -469,14 +493,13 @@ -- | Given a package DB stack, return all installed packages. getInstalledPackages   :: Verbosity-  -> Compiler   -> Maybe (SymbolicPath CWD (Dir from))   -> PackageDBStackX (SymbolicPath from (Dir PkgDB))   -> ProgramDb   -> IO InstalledPackageIndex-getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do+getInstalledPackages verbosity mbWorkDir packagedbs progdb = do   checkPackageDbEnvVar verbosity-  checkPackageDbStack verbosity comp packagedbs+  checkPackageDbStack verbosity packagedbs   pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb   index <- toPackageIndex verbosity pkgss progdb   return $! hackRtsPackage index@@ -484,7 +507,7 @@     hackRtsPackage index =       case PackageIndex.lookupPackageName index (mkPackageName "rts") of         [(_, [rts])] ->-          PackageIndex.insert (removeMingwIncludeDir rts) index+          PackageIndex.insert rts index         _ -> index -- No (or multiple) ghc rts package is registered!!         -- Feh, whatever, the ghc test suite does some crazy stuff. @@ -556,39 +579,13 @@ checkPackageDbEnvVar verbosity =   Internal.checkPackageDbEnvVar verbosity "GHC" "GHC_PACKAGE_PATH" -checkPackageDbStack :: Eq fp => Verbosity -> Compiler -> PackageDBStackX fp -> IO ()-checkPackageDbStack verbosity comp =-  if flagPackageConf implInfo-    then checkPackageDbStackPre76 verbosity-    else checkPackageDbStackPost76 verbosity-  where-    implInfo = ghcVersionImplInfo (compilerVersion comp)--checkPackageDbStackPost76 :: Eq fp => Verbosity -> PackageDBStackX fp -> IO ()-checkPackageDbStackPost76 _ (GlobalPackageDB : rest)+checkPackageDbStack :: Eq fp => Verbosity -> PackageDBStackX fp -> IO ()+checkPackageDbStack _ (GlobalPackageDB : rest)   | GlobalPackageDB `notElem` rest = return ()-checkPackageDbStackPost76 verbosity rest+checkPackageDbStack verbosity rest   | GlobalPackageDB `elem` rest =-      dieWithException verbosity CheckPackageDbStackPost76-checkPackageDbStackPost76 _ _ = return ()--checkPackageDbStackPre76 :: Eq fp => Verbosity -> PackageDBStackX fp -> IO ()-checkPackageDbStackPre76 _ (GlobalPackageDB : rest)-  | GlobalPackageDB `notElem` rest = return ()-checkPackageDbStackPre76 verbosity rest-  | GlobalPackageDB `notElem` rest =-      dieWithException verbosity CheckPackageDbStackPre76-checkPackageDbStackPre76 verbosity _ =-  dieWithException verbosity GlobalPackageDbSpecifiedFirst---- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This--- breaks when you want to use a different gcc, so we need to filter--- it out.-removeMingwIncludeDir :: InstalledPackageInfo -> InstalledPackageInfo-removeMingwIncludeDir pkg =-  let ids = InstalledPackageInfo.includeDirs pkg-      ids' = filter (not . ("mingw" `isSuffixOf`)) ids-   in pkg{InstalledPackageInfo.includeDirs = ids'}+      dieWithException verbosity CheckPackageDbStack+checkPackageDbStack _ _ = return ()  -- | Get the packages from specific PackageDBs, not cumulative. getInstalledPackages'@@ -643,15 +640,16 @@ -- Building a library  buildLib-  :: BuildFlags+  :: VerbosityHandles+  -> BuildFlags   -> Flag ParStrat   -> PackageDescription   -> LocalBuildInfo   -> Library   -> ComponentLocalBuildInfo   -> IO ()-buildLib flags numJobs pkg lbi lib clbi =-  GHC.build numJobs pkg $+buildLib verbHandles flags numJobs pkg lbi lib clbi =+  GHC.build numJobs verbHandles pkg $     PreBuildComponentInputs       { buildingWhat = BuildNormal flags       , localBuildInfo = lbi@@ -659,15 +657,16 @@       }  replLib-  :: ReplFlags+  :: VerbosityHandles+  -> ReplFlags   -> Flag ParStrat   -> PackageDescription   -> LocalBuildInfo   -> Library   -> ComponentLocalBuildInfo   -> IO ()-replLib flags numJobs pkg lbi lib clbi =-  GHC.build numJobs pkg $+replLib verbHandles flags numJobs pkg lbi lib clbi =+  GHC.build numJobs verbHandles pkg $     PreBuildComponentInputs       { buildingWhat = BuildRepl flags       , localBuildInfo = lbi@@ -688,7 +687,7 @@           { ghcOptMode = toFlag GhcModeInteractive           , ghcOptPackageDBs = packageDBs           }-  checkPackageDbStack verbosity comp packageDBs+  checkPackageDbStack verbosity packageDBs   (ghcProg, _) <- requireProgram verbosity ghcProgram progdb   -- This doesn't pass source file arguments to GHC, so we don't have to worry   -- about using a response file here.@@ -707,28 +706,29 @@   -> ComponentLocalBuildInfo   -> IO () buildFLib v numJobs pkg lbi flib clbi =-  GHC.build numJobs pkg $+  GHC.build numJobs (verbosityHandles v) pkg $     PreBuildComponentInputs       { buildingWhat =           BuildNormal $             mempty               { buildCommonFlags =-                  mempty{setupVerbosity = toFlag v}+                  mempty{setupVerbosity = toFlag $ verbosityFlags v}               }       , localBuildInfo = lbi       , targetInfo = TargetInfo clbi (CFLib flib)       }  replFLib-  :: ReplFlags+  :: VerbosityHandles+  -> ReplFlags   -> Flag ParStrat   -> PackageDescription   -> LocalBuildInfo   -> ForeignLib   -> ComponentLocalBuildInfo   -> IO ()-replFLib replFlags njobs pkg lbi flib clbi =-  GHC.build njobs pkg $+replFLib verbHandles replFlags njobs pkg lbi flib clbi =+  GHC.build njobs verbHandles pkg $     PreBuildComponentInputs       { buildingWhat = BuildRepl replFlags       , localBuildInfo = lbi@@ -745,28 +745,29 @@   -> ComponentLocalBuildInfo   -> IO () buildExe v njobs pkg lbi exe clbi =-  GHC.build njobs pkg $+  GHC.build njobs (verbosityHandles v) pkg $     PreBuildComponentInputs       { buildingWhat =           BuildNormal $             mempty               { buildCommonFlags =-                  mempty{setupVerbosity = toFlag v}+                  mempty{setupVerbosity = toFlag $ verbosityFlags v}               }       , localBuildInfo = lbi       , targetInfo = TargetInfo clbi (CExe exe)       }  replExe-  :: ReplFlags+  :: VerbosityHandles+  -> ReplFlags   -> Flag ParStrat   -> PackageDescription   -> LocalBuildInfo   -> Executable   -> ComponentLocalBuildInfo   -> IO ()-replExe replFlags njobs pkg lbi exe clbi =-  GHC.build njobs pkg $+replExe verbHandles replFlags njobs pkg lbi exe clbi =+  GHC.build njobs verbHandles pkg $     PreBuildComponentInputs       { buildingWhat = BuildRepl replFlags       , localBuildInfo = lbi@@ -789,7 +790,7 @@     platform = hostPlatform lbi     mbWorkDir = mbWorkDirLBI lbi     vanillaArgs =-      (Internal.componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))+      Internal.componentGhcOptions (verbosityLevel verbosity) lbi libBi clbi (componentBuildDir lbi clbi)         `mappend` mempty           { ghcOptMode = toFlag GhcModeAbiHash           , ghcOptInputModules = toNubListR $ exposedModules lib@@ -801,7 +802,7 @@           , ghcOptFPic = toFlag True           , ghcOptHiSuffix = toFlag "dyn_hi"           , ghcOptObjSuffix = toFlag "dyn_o"-          , ghcOptExtra = hcOptions GHC libBi ++ hcSharedOptions GHC libBi+          , ghcOptExtra = hcSharedOptions GHC libBi           }     profArgs =       vanillaArgs@@ -813,7 +814,7 @@                 (withProfLibDetail lbi)           , ghcOptHiSuffix = toFlag "p_hi"           , ghcOptObjSuffix = toFlag "p_o"-          , ghcOptExtra = hcOptions GHC libBi ++ hcProfOptions GHC libBi+          , ghcOptExtra = hcProfOptions GHC libBi           }     profDynArgs =       vanillaArgs@@ -827,7 +828,7 @@           , ghcOptFPic = toFlag True           , ghcOptHiSuffix = toFlag "p_dyn_hi"           , ghcOptObjSuffix = toFlag "p_dyn_o"-          , ghcOptExtra = hcOptions GHC libBi ++ hcProfSharedOptions GHC libBi+          , ghcOptExtra = hcProfSharedOptions GHC libBi           }     ghcArgs =       let (libWays, _, _) = buildWays lbi@@ -916,10 +917,8 @@         else installOrdinaryFile verbosity src dst       -- Now install appropriate symlinks if library is versioned       let (Platform _ os) = hostPlatform lbi-      when (not (null (foreignLibVersion flib os))) $ do-        when (os /= Linux) $-          dieWithException verbosity $-            CantInstallForeignLib+      unless (null (foreignLibVersion flib os)) $ do+        when (os /= Linux) $ dieWithException verbosity CantInstallForeignLib #ifndef mingw32_HOST_OS         -- 'createSymbolicLink file1 file2' creates a symbolic link         -- named 'file2' which points to the file 'file1'.@@ -928,7 +927,7 @@         -- directory it's created in.         -- Finally, we first create the symlinks in a temporary         -- directory and then rename to simulate 'ln --force'.-        withTempDirectory verbosity dstDir nm $ \tmpDir -> do+        withTempDirectory dstDir nm $ \tmpDir -> do             let link1 = flibBuildName lbi flib                 link2 = "lib" ++ nm <.> "so"             createSymbolicLink name (tmpDir </> link1)@@ -940,7 +939,7 @@         nm = unUnqualComponentName $ foreignLibName flib #endif /* mingw32_HOST_OS */ --- | Install for ghc, .hi, .a and, if --with-ghci given, .o+-- | Install for ghc, .hi, .a, .so, .bytecodelib and, if --with-ghci given, .o installLib   :: Verbosity   -> LocalBuildInfo@@ -949,12 +948,14 @@   -> FilePath   -- ^ install location for dynamic libraries   -> FilePath+  -- ^ install location for bytecode libraries+  -> FilePath   -- ^ Build location   -> PackageDescription   -> Library   -> ComponentLocalBuildInfo   -> IO ()-installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do+installLib verbosity lbi targetDir dynlibTargetDir bytecodeTargetDir _builtDir pkg lib clbi = do   let     (wantedLibWays, _, _) = buildWays lbi     isIndef = componentIsIndefinite clbi@@ -963,7 +964,7 @@   info verbosity ("Wanted install ways: " ++ show libWays)    -- copy .hi files over:-  forM_ (wantedLibWays isIndef) $ \w -> case w of+  forM_ (wantedLibWays isIndef) $ \case     StaticWay -> copyModuleFiles (Suffix "hi")     DynWay -> copyModuleFiles (Suffix "dyn_hi")     ProfWay -> copyModuleFiles (Suffix "p_hi")@@ -974,7 +975,11 @@    -- copy the built library files over:   when (has_code && hasLib) $ do-    forM_ libWays $ \w -> case w of+    -- Bytecode libraries are installed in bytecodelibdir and are copied+    -- without stripping; see doc/internal/bytecode-libraries.md.+    whenBytecodeLib $ installOrdinaryNoStrip builtDir bytecodeTargetDir bytecodeLibName++    forM_ libWays $ \case       StaticWay -> do         sequence_           [ installOrdinary@@ -984,7 +989,7 @@           | l <-               getHSLibraryName                 (componentUnitId clbi)-                : (extraBundledLibs (libBuildInfo lib))+                : extraBundledLibs (libBuildInfo lib)           , f <- "" : extraLibFlavours (libBuildInfo lib)           ]         whenGHCi $ installOrdinary builtDir targetDir ghciLibName@@ -1023,7 +1028,7 @@                   ]                 sequence_                   [ do-                    files <- getDirectoryContents (i builtDir)+                    files <- listDirectory (i builtDir)                     let l' =                           mkGenericSharedBundledLibName                             platform@@ -1047,7 +1052,7 @@     builtDir = componentBuildDir lbi clbi     mbWorkDir = mbWorkDirLBI lbi -    install isShared srcDir dstDir name = do+    install isShared shouldStrip srcDir dstDir name = do       let src = i $ srcDir </> makeRelativePathEx name           dst = dstDir </> name @@ -1057,15 +1062,16 @@         then installExecutableFile verbosity src dst         else installOrdinaryFile verbosity src dst -      when (stripLibs lbi) $+      when (shouldStrip && stripLibs lbi) $         Strip.stripLib           verbosity           platform           (withPrograms lbi)           dst -    installOrdinary = install False-    installShared = install True+    installOrdinary = install False True+    installOrdinaryNoStrip = install False False+    installShared = install True True      copyModuleFiles ext = do       files <- findModuleFilesCwd verbosity mbWorkDir [builtDir] [ext] (allLibModules lib clbi)@@ -1083,6 +1089,7 @@     platform = hostPlatform lbi     uid = componentUnitId clbi     profileLibName = mkProfLibName uid+    bytecodeLibName = mkBytecodeLibName compiler_id uid     ghciLibName = Internal.mkGHCiLibName uid     ghciProfLibName = Internal.mkGHCiProfLibName uid @@ -1099,27 +1106,14 @@       _ -> False     has_code = not (componentIsIndefinite clbi)     whenGHCi = when (hasLib && withGHCiLib lbi && has_code)+    whenBytecodeLib = when (hasLib && withBytecodeLib lbi && has_code)  -- ----------------------------------------------------------------------------- -- Registering -hcPkgInfo :: ProgramDb -> HcPkg.HcPkgInfo+hcPkgInfo :: ProgramDb -> HcPkg.ConfiguredProgram hcPkgInfo progdb =-  HcPkg.HcPkgInfo-    { HcPkg.hcPkgProgram = ghcPkgProg-    , HcPkg.noPkgDbStack = v < [6, 9]-    , HcPkg.noVerboseFlag = v < [6, 11]-    , HcPkg.flagPackageConf = v < [7, 5]-    , HcPkg.supportsDirDbs = v >= [6, 8]-    , HcPkg.requiresDirDbs = v >= [7, 10]-    , HcPkg.nativeMultiInstance = v >= [7, 10]-    , HcPkg.recacheMultiInstance = v >= [6, 12]-    , HcPkg.suppressFilesCheck = v >= [6, 6]-    }-  where-    v = versionNumbers ver-    ghcPkgProg = fromMaybe (error "GHC.hcPkgInfo: no ghc program") $ lookupProgram ghcPkgProgram progdb-    ver = fromMaybe (error "GHC.hcPkgInfo: no ghc version") $ programVersion ghcPkgProg+  fromMaybe (error "GHC.hcPkgInfo: no ghc program") $ lookupProgram ghcPkgProgram progdb  registerPackage   :: Verbosity