Cabal 3.12.1.0 → 3.14.0.0

raw patch · 88 files changed

+10708/−5173 lines, 88 filesdep ~Cabal-syntaxdep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Cabal-syntax, base, containers

API changes (from Hackage documentation)

Files

• Cabal.cabal +15/−8
• ChangeLog.md +4/−0
• src/Distribution/Backpack/Configure.hs +4/−4
• src/Distribution/Backpack/PreExistingComponent.hs +3/−3
• src/Distribution/Compat/Async.hs +2/−8
• src/Distribution/Compat/Internal/TempFile.hs +3/−2
• src/Distribution/Compat/ResponseFile.hs +3/−51
• src/Distribution/Compat/Stack.hs +7/−67
• src/Distribution/Compat/Time.hs +4/−13
• src/Distribution/Make.hs +32/−18
• src/Distribution/PackageDescription/Check.hs +39/−22
• src/Distribution/PackageDescription/Check/Target.hs +30/−28
• src/Distribution/PackageDescription/Check/Warning.hs +14/−10
• src/Distribution/Simple.hs +466/−238
• src/Distribution/Simple/Bench.hs +51/−11
• src/Distribution/Simple/Build.hs +310/−178
• src/Distribution/Simple/Build/Inputs.hs +5/−1
• src/Distribution/Simple/BuildPaths.hs +198/−36
• src/Distribution/Simple/BuildTarget.hs +8/−7
• src/Distribution/Simple/BuildWay.hs +14/−0
• src/Distribution/Simple/Command.hs +13/−0
• src/Distribution/Simple/Compiler.hs +121/−15
• src/Distribution/Simple/Configure.hs +448/−223
• src/Distribution/Simple/ConfigureScript.hs +38/−30
• src/Distribution/Simple/Errors.hs +44/−43
• src/Distribution/Simple/FileMonitor/Types.hs +217/−0
• src/Distribution/Simple/GHC.hs +206/−119
• src/Distribution/Simple/GHC/Build.hs +56/−58
• src/Distribution/Simple/GHC/Build/ExtraSources.hs +143/−125
• src/Distribution/Simple/GHC/Build/Link.hs +262/−159
• src/Distribution/Simple/GHC/Build/Modules.hs +135/−76
• src/Distribution/Simple/GHC/Build/Utils.hs +45/−16
• src/Distribution/Simple/GHC/EnvironmentParser.hs +3/−5
• src/Distribution/Simple/GHC/Internal.hs +69/−107
• src/Distribution/Simple/GHCJS.hs +133/−87
• src/Distribution/Simple/Glob.hs +418/−41
• src/Distribution/Simple/Glob/Internal.hs +2/−366
• src/Distribution/Simple/Haddock.hs +1614/−1224
• src/Distribution/Simple/HaskellSuite.hs +16/−13
• src/Distribution/Simple/Hpc.hs +35/−26
• src/Distribution/Simple/Install.hs +123/−59
• src/Distribution/Simple/InstallDirs.hs +2/−0
• src/Distribution/Simple/LocalBuildInfo.hs +59/−22
• src/Distribution/Simple/PackageDescription.hs +30/−10
• src/Distribution/Simple/PreProcess.hs +142/−114
• src/Distribution/Simple/PreProcess/Types.hs +18/−5
• src/Distribution/Simple/Program.hs +64/−4
• src/Distribution/Simple/Program/Ar.hs +36/−27
• src/Distribution/Simple/Program/Builtin.hs +2/−10
• src/Distribution/Simple/Program/Db.hs +64/−17
• src/Distribution/Simple/Program/Find.hs +14/−0
• src/Distribution/Simple/Program/GHC.hs +59/−39
• src/Distribution/Simple/Program/HcPkg.hs +112/−57
• src/Distribution/Simple/Program/Hpc.hs +34/−30
• src/Distribution/Simple/Program/Ld.hs +40/−34
• src/Distribution/Simple/Program/ResponseFile.hs +15/−6
• src/Distribution/Simple/Program/Run.hs +25/−3
• src/Distribution/Simple/Program/Types.hs +1/−1
• src/Distribution/Simple/Register.hs +93/−77
• src/Distribution/Simple/Setup.hs +31/−15
• src/Distribution/Simple/Setup/Benchmark.hs +74/−45
• src/Distribution/Simple/Setup/Build.hs +59/−36
• src/Distribution/Simple/Setup/Clean.hs +54/−24
• src/Distribution/Simple/Setup/Common.hs +108/−9
• src/Distribution/Simple/Setup/Config.hs +145/−92
• src/Distribution/Simple/Setup/Copy.hs +76/−51
• src/Distribution/Simple/Setup/Global.hs +11/−0
• src/Distribution/Simple/Setup/Haddock.hs +254/−197
• src/Distribution/Simple/Setup/Hscolour.hs +103/−75
• src/Distribution/Simple/Setup/Install.hs +58/−29
• src/Distribution/Simple/Setup/Register.hs +126/−100
• src/Distribution/Simple/Setup/Repl.hs +69/−37
• src/Distribution/Simple/Setup/SDist.hs +70/−38
• src/Distribution/Simple/Setup/Test.hs +150/−117
• src/Distribution/Simple/SetupHooks/Errors.hs +231/−0
• src/Distribution/Simple/SetupHooks/Internal.hs +1096/−0
• src/Distribution/Simple/SetupHooks/Rule.hs +1142/−0
• src/Distribution/Simple/ShowBuildInfo.hs +16/−13
• src/Distribution/Simple/SrcDist.hs +107/−71
• src/Distribution/Simple/Test.hs +32/−19
• src/Distribution/Simple/Test/ExeV10.hs +26/−20
• src/Distribution/Simple/Test/LibV09.hs +30/−25
• src/Distribution/Simple/UHC.hs +37/−24
• src/Distribution/Simple/UserHooks.hs +1/−1
• src/Distribution/Simple/Utils.hs +329/−163
• src/Distribution/Types/GivenComponent.hs +19/−0
• src/Distribution/Types/LocalBuildConfig.hs +9/−4
• src/Distribution/Types/LocalBuildInfo.hs +82/−15

@@ -1,6 +1,6 @@ cabal-version: 3.0 name:          Cabal-version:       3.12.1.0+version:       3.14.0.0 copyright:     2003-2024, Cabal Development Team (see AUTHORS file) license:       BSD-3-Clause license-file:  LICENSE@@ -34,9 +34,9 @@   hs-source-dirs: src    build-depends:-    Cabal-syntax ^>= 3.12.1.0,+    Cabal-syntax ^>= 3.14,     array      >= 0.4.0.1  && < 0.6,-    base       >= 4.11     && < 5,+    base       >= 4.13     && < 5,     bytestring >= 0.10.0.0 && < 0.13,     containers >= 0.5.0.0  && < 0.8,     deepseq    >= 1.3.0.1  && < 1.6,@@ -51,7 +51,13 @@   else     build-depends: unix  >= 2.6.0.0 && < 2.9 -  ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates+  ghc-options:+    -Wall+    -fno-ignore-asserts+    -fwarn-tabs+    -fwarn-incomplete-uni-patterns+    -fwarn-incomplete-record-updates+    -fno-warn-unticked-promoted-constructors    if impl(ghc >= 8.0)     ghc-options: -Wcompat -Wnoncanonical-monad-instances@@ -59,9 +65,6 @@   if impl(ghc >= 8.0) && impl(ghc < 8.8)     ghc-options: -Wnoncanonical-monadfail-instances -  if impl(ghc >= 8.10)-    ghc-options: -Wunused-packages-   exposed-modules:     Distribution.Backpack.Configure     Distribution.Backpack.ComponentsGraph@@ -98,11 +101,13 @@     Distribution.Simple.BuildPaths     Distribution.Simple.BuildTarget     Distribution.Simple.BuildToolDepends+    Distribution.Simple.BuildWay     Distribution.Simple.CCompiler     Distribution.Simple.Command     Distribution.Simple.Compiler     Distribution.Simple.Configure     Distribution.Simple.Errors+    Distribution.Simple.FileMonitor.Types     Distribution.Simple.Flag     Distribution.Simple.GHC     Distribution.Simple.GHCJS@@ -145,6 +150,9 @@     Distribution.Simple.Test.Log     Distribution.Simple.UHC     Distribution.Simple.UserHooks+    Distribution.Simple.SetupHooks.Errors+    Distribution.Simple.SetupHooks.Internal+    Distribution.Simple.SetupHooks.Rule     Distribution.Simple.Utils     Distribution.TestSuite     Distribution.Types.AnnotatedId@@ -181,7 +189,6 @@     Distribution.Compat.Parsing,     Distribution.Compat.Prelude,     Distribution.Compat.Semigroup,-    Distribution.Compat.Typeable,     Distribution.Compiler,     Distribution.FieldGrammar,     Distribution.FieldGrammar.Class,

@@ -1,7 +1,11 @@+# 3.14.0.0 [Hécate](mailto:hecate+github@glitchbra.in) September 2024+* See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.14.0.0.md+ # 3.12.1.0 [Artem Pelenitsyn](mailto:a.pelenitsyn@gmail.com) June 2024 * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.12.1.0.md  # 3.12.0.0 [Francesco Ariis](mailto:fa-ml@ariis.it) May 2024+# 3.12.0.0 [Francesco Ariis](mailto:fa-ml@ariis.it) March 2024 * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.12.0.0.md  # 3.10.3.0 [Hécate](mailto:hecate+github@glitchbra.in) January 2024

@@ -70,7 +70,7 @@   -> Flag String -- configIPID   -> Flag ComponentId -- configCID   -> PackageDescription-  -> ([PreExistingComponent], [PromisedComponent])+  -> ([PreExistingComponent], [ConfiguredPromisedComponent])   -> FlagAssignment -- configConfigurationsFlags   -> [(ModuleName, Module)] -- configInstantiateWith   -> InstalledPackageIndex@@ -118,7 +118,7 @@             `Map.union` Map.fromListWith               Map.union               [ (pkg, Map.singleton (ann_cname aid) aid)-              | PromisedComponent pkg aid <- promisedPkgDeps+              | ConfiguredPromisedComponent pkg aid <- promisedPkgDeps               ]     graph1 <-       toConfiguredComponents@@ -151,7 +151,7 @@                   , emptyModuleShape                   )                 )-              | PromisedComponent _ aid <- promisedPkgDeps+              | ConfiguredPromisedComponent _ aid <- promisedPkgDeps               ]         uid_lookup def_uid           | Just pkg <- PackageIndex.lookupUnitId installedPackageSet uid =@@ -208,7 +208,7 @@ toComponentLocalBuildInfos   :: Compiler   -> InstalledPackageIndex -- FULL set-  -> [PromisedComponent]+  -> [ConfiguredPromisedComponent]   -> PackageDescription   -> [PreExistingComponent] -- external package deps   -> [ReadyComponent]

@@ -1,7 +1,7 @@ -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst> module Distribution.Backpack.PreExistingComponent   ( PreExistingComponent (..)-  , PromisedComponent (..)+  , ConfiguredPromisedComponent (..)   , ipiToPreExistingComponent   ) where @@ -24,12 +24,12 @@ -- These components are promised to @configure@ but are not yet built. -- -- In other words this is 'PreExistingComponent' which doesn't yet exist.-data PromisedComponent = PromisedComponent+data ConfiguredPromisedComponent = ConfiguredPromisedComponent   { pr_pkgname :: PackageName   , pr_cid :: AnnotatedId ComponentId   } -instance Package PromisedComponent where+instance Package ConfiguredPromisedComponent where   packageId = packageId . pr_cid  -- | Stripped down version of 'LinkedComponent' for things

@@ -29,6 +29,8 @@   ( BlockedIndefinitelyOnMVar (..)   , Exception (..)   , SomeException (..)+  , asyncExceptionFromException+  , asyncExceptionToException   , catch   , evaluate   , mask@@ -41,10 +43,6 @@ import Data.Typeable (Typeable) import GHC.Exts (inline) -#if MIN_VERSION_base(4,7,0)-import Control.Exception (asyncExceptionFromException, asyncExceptionToException)-#endif- -- | Async, but based on 'MVar', as we don't depend on @stm@. data AsyncM a = Async   { asyncThreadId :: {-# UNPACK #-} !ThreadId@@ -148,15 +146,11 @@     , Typeable     ) -{- FOURMOLU_DISABLE -} instance Exception AsyncCancelled where-#if MIN_VERSION_base(4,7,0)   -- wraps in SomeAsyncException   -- See https://github.com/ghc/ghc/commit/756a970eacbb6a19230ee3ba57e24999e4157b09   fromException = asyncExceptionFromException   toException = asyncExceptionToException-#endif-{- FOURMOLU_ENABLE -}  -- | Cancel an asynchronous action --

@@ -126,10 +126,11 @@   findTempName pid   where     findTempName x = do-      let dirpath = dir </> template ++ "-" ++ show x+      let relpath = template ++ "-" ++ show x+          dirpath = dir </> relpath       r <- tryIO $ mkPrivateDir dirpath       case r of-        Right _ -> return dirpath+        Right _ -> return relpath         Left e           | isAlreadyExistsError e -> findTempName (x + 1)           | otherwise -> ioError e

@@ -8,62 +8,14 @@ module Distribution.Compat.ResponseFile (expandResponse, escapeArgs) where  import Distribution.Compat.Prelude++import GHC.ResponseFile (escapeArgs, unescapeArgs)+ import Prelude ()  import System.FilePath import System.IO (hPutStrLn, stderr) import System.IO.Error--#if MIN_VERSION_base(4,12,0)-import GHC.ResponseFile (unescapeArgs, escapeArgs)-#else--unescapeArgs :: String -> [String]-unescapeArgs = filter (not . null) . unescape--data Quoting = NoneQ | SngQ | DblQ--unescape :: String -> [String]-unescape args = reverse . map reverse $ go args NoneQ False [] []-    where-      -- n.b., the order of these cases matters; these are cribbed from gcc-      -- case 1: end of input-      go []     _q    _bs   a as = a:as-      -- case 2: back-slash escape in progress-      go (c:cs) q     True  a as = go cs q     False (c:a) as-      -- case 3: no back-slash escape in progress, but got a back-slash-      go (c:cs) q     False a as-        | '\\' == c              = go cs q     True  a     as-      -- case 4: single-quote escaping in progress-      go (c:cs) SngQ  False a as-        | '\'' == c              = go cs NoneQ False a     as-        | otherwise              = go cs SngQ  False (c:a) as-      -- case 5: double-quote escaping in progress-      go (c:cs) DblQ  False a as-        | '"' == c               = go cs NoneQ False a     as-        | otherwise              = go cs DblQ  False (c:a) as-      -- case 6: no escaping is in progress-      go (c:cs) NoneQ False a as-        | isSpace c              = go cs NoneQ False []    (a:as)-        | '\'' == c              = go cs SngQ  False a     as-        | '"'  == c              = go cs DblQ  False a     as-        | otherwise              = go cs NoneQ False (c:a) as--escapeArgs :: [String] -> String-escapeArgs = unlines . map escapeArg--escapeArg :: String -> String-escapeArg = reverse . foldl' escape []--escape :: String -> Char -> String-escape cs c-  |    isSpace c-    || '\\' == c-    || '\'' == c-    || '"'  == c = c:'\\':cs -- n.b., our caller must reverse the result-  | otherwise    = c:cs--#endif  -- | The arg file / response file parser. --

@@ -13,91 +13,31 @@   , parentSrcLocPrefix   ) where -import System.IO.Error--#ifdef MIN_VERSION_base-#if MIN_VERSION_base(4,8,1)-#define GHC_STACK_SUPPORTED 1-#endif-#endif--#ifdef GHC_STACK_SUPPORTED import GHC.Stack-#endif--#ifdef GHC_STACK_SUPPORTED+import System.IO.Error -#if MIN_VERSION_base(4,9,0) type WithCallStack a = HasCallStack => a-#elif MIN_VERSION_base(4,8,1)-type WithCallStack a = (?callStack :: CallStack) => a-#endif -#if !MIN_VERSION_base(4,9,0)--- NB: Can't say WithCallStack (WithCallStack a -> a);--- Haskell doesn't support this kind of implicit parameter!--- See https://mail.haskell.org/pipermail/ghc-devs/2016-January/011096.html--- Since this function doesn't do anything, it's OK to--- give it a less good type.-withFrozenCallStack :: WithCallStack (a -> a)-withFrozenCallStack x = x--callStack :: (?callStack :: CallStack) => CallStack-callStack = ?callStack--prettyCallStack :: CallStack -> String-prettyCallStack = showCallStack-#endif- -- | 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.--- parentSrcLocPrefix :: WithCallStack String-#if MIN_VERSION_base(4,9,0) parentSrcLocPrefix =   case getCallStack callStack of-    (_:(_, loc):_) -> showLoc loc+    (_ : (_, loc) : _) -> showLoc loc     [(_, loc)] -> showLoc loc     [] -> error "parentSrcLocPrefix: empty call stack"- where-  showLoc loc =-    srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ ": "-#else-parentSrcLocPrefix = "Call sites not available with base < 4.9.0.0 (GHC 8.0): "-#endif+  where+    showLoc loc =+      srcLocFile loc ++ ":" ++ show (srcLocStartLine loc) ++ ": "  -- Yeah, this uses skivvy implementation details. withLexicalCallStack :: (a -> WithCallStack (IO b)) -> WithCallStack (a -> IO b) withLexicalCallStack f =-    let stk = ?callStack-    in \x -> let ?callStack = stk in f x--#else--data CallStack = CallStack-    deriving (Eq, Show)--type WithCallStack a = a--withFrozenCallStack :: a -> a-withFrozenCallStack x = x--callStack :: CallStack-callStack = CallStack--prettyCallStack :: CallStack -> String-prettyCallStack _ = "Call stacks not available with base < 4.8.1.0 (GHC 7.10)"--parentSrcLocPrefix :: String-parentSrcLocPrefix = "Call sites not available with base < 4.9.0.0 (GHC 8.0): "--withLexicalCallStack :: (a -> IO b) -> a -> IO b-withLexicalCallStack f = f--#endif+  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

@@ -21,7 +21,8 @@  import System.Directory (getModificationTime) -import Distribution.Simple.Utils (withTempDirectory)+import Distribution.Simple.Utils (withTempDirectoryCwd)+import Distribution.Utils.Path (getSymbolicPath, sameDirectory) import Distribution.Verbosity (silent)  import System.FilePath@@ -33,11 +34,7 @@  import qualified Prelude import Data.Bits          ((.|.), unsafeShiftL)-#if MIN_VERSION_base(4,7,0) import Data.Bits          (finiteBitSize)-#else-import Data.Bits          (bitSize)-#endif  import Foreign            ( allocaBytes, peekByteOff ) import System.IO.Error    ( mkIOError, doesNotExistErrorType )@@ -91,15 +88,9 @@                 index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwLowDateTime       dwHigh <- peekByteOff info                 index_WIN32_FILE_ATTRIBUTE_DATA_ftLastWriteTime_dwHighDateTime-#if MIN_VERSION_base(4,7,0)       let qwTime =             (fromIntegral (dwHigh :: DWORD) `unsafeShiftL` finiteBitSize dwHigh)             .|. (fromIntegral (dwLow :: DWORD))-#else-      let qwTime =-            (fromIntegral (dwHigh :: DWORD) `unsafeShiftL` bitSize dwHigh)-            .|. (fromIntegral (dwLow :: DWORD))-#endif       return $! ModTime (qwTime :: Word64)  {- FOURMOLU_DISABLE -}@@ -177,8 +168,8 @@ -- than 10 ms, but never larger than 1 second. calibrateMtimeChangeDelay :: IO (Int, Int) calibrateMtimeChangeDelay =-  withTempDirectory silent "." "calibration-" $ \dir -> do-    let fileName = dir </> "probe"+  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

@@ -68,15 +68,13 @@ 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.License-import Distribution.Pretty import Distribution.Version  import System.Environment (getArgs, getProgName)@@ -114,7 +112,6 @@       putStrLn $         "Cabal library version "           ++ prettyShow cabalVersion-     progs = defaultProgramDb     commands =       [ configureCommand progs `commandAddAction` configureAction@@ -131,8 +128,9 @@ configureAction :: ConfigFlags -> [String] -> IO () configureAction flags args = do   noExtraFlags args-  let verbosity = fromFlag (configVerbosity flags)-  rawSystemExit verbosity "sh" $+  let verbosity = fromFlag $ configVerbosity flags+      mbWorkDir = flagToMaybe $ configWorkingDir flags+  rawSystemExit verbosity mbWorkDir "sh" $     "configure"       : configureArgs backwardsCompatHack flags   where@@ -141,47 +139,63 @@ copyAction :: CopyFlags -> [String] -> IO () copyAction flags args = do   noExtraFlags args-  let destArgs = case fromFlag $ copyDest flags of+  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 (fromFlag $ copyVerbosity flags) "make" destArgs+  rawSystemExit verbosity mbWorkDir "make" destArgs  installAction :: InstallFlags -> [String] -> IO () installAction flags args = do   noExtraFlags args-  rawSystemExit (fromFlag $ installVerbosity flags) "make" ["install"]-  rawSystemExit (fromFlag $ installVerbosity flags) "make" ["register"]+  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-  rawSystemExit (fromFlag $ haddockVerbosity flags) "make" ["docs"]+  let verbosity = fromFlag $ haddockVerbosity flags+      mbWorkDir = flagToMaybe $ haddockWorkingDir flags+  rawSystemExit verbosity mbWorkDir "make" ["docs"]     `catchIO` \_ ->-      rawSystemExit (fromFlag $ haddockVerbosity flags) "make" ["doc"]+      rawSystemExit verbosity mbWorkDir "make" ["doc"]  buildAction :: BuildFlags -> [String] -> IO () buildAction flags args = do   noExtraFlags args-  rawSystemExit (fromFlag $ buildVerbosity flags) "make" []+  let verbosity = fromFlag $ buildVerbosity flags+      mbWorkDir = flagToMaybe $ buildWorkingDir flags+  rawSystemExit verbosity mbWorkDir "make" []  cleanAction :: CleanFlags -> [String] -> IO () cleanAction flags args = do   noExtraFlags args-  rawSystemExit (fromFlag $ cleanVerbosity flags) "make" ["clean"]+  let verbosity = fromFlag $ cleanVerbosity flags+      mbWorkDir = flagToMaybe $ cleanWorkingDir flags+  rawSystemExit verbosity mbWorkDir "make" ["clean"]  sdistAction :: SDistFlags -> [String] -> IO () sdistAction flags args = do   noExtraFlags args-  rawSystemExit (fromFlag $ sDistVerbosity flags) "make" ["dist"]+  let verbosity = fromFlag $ sDistVerbosity flags+      mbWorkDir = flagToMaybe $ sDistWorkingDir flags+  rawSystemExit verbosity mbWorkDir "make" ["dist"]  registerAction :: RegisterFlags -> [String] -> IO () registerAction flags args = do   noExtraFlags args-  rawSystemExit (fromFlag $ regVerbosity flags) "make" ["register"]+  let verbosity = fromFlag $ registerVerbosity flags+      mbWorkDir = flagToMaybe $ registerWorkingDir flags+  rawSystemExit verbosity mbWorkDir "make" ["register"]  unregisterAction :: RegisterFlags -> [String] -> IO () unregisterAction flags args = do   noExtraFlags args-  rawSystemExit (fromFlag $ regVerbosity flags) "make" ["unregister"]+  let verbosity = fromFlag $ registerVerbosity flags+      mbWorkDir = flagToMaybe $ registerWorkingDir flags+  rawSystemExit verbosity mbWorkDir "make" ["unregister"]

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-}  -- |@@ -70,14 +71,9 @@ import Distribution.Simple.Utils hiding (findPackageDesc, notice) import Distribution.Utils.Generic (isAscii) import Distribution.Utils.Path-  ( LicenseFile-  , PackageDir-  , SymbolicPath-  , getSymbolicPath-  ) import Distribution.Verbosity import Distribution.Version-import System.FilePath (splitExtension, takeFileName, (<.>), (</>))+import System.FilePath (splitExtension, takeFileName)  import qualified Data.ByteString.Lazy as BS import qualified Distribution.SPDX as SPDX@@ -185,6 +181,7 @@         , getDirectoryContentsM = System.Directory.getDirectoryContents . relative         } +    relative :: FilePath -> FilePath     relative path = root </> path  -- | Same as  'checkPackageFilesGPD', but working with 'PackageDescription'.@@ -412,6 +409,7 @@           extraSrcFiles_           extraTmpFiles_           extraDocFiles_+          extraFiles_         ) = do     -- § Sanity checks.     checkPackageId package_@@ -456,26 +454,30 @@       (PackageDistSuspicious ShortDesc)      -- § Paths.-    mapM_ (checkPath False "extra-source-files" PathKindGlob) extraSrcFiles_-    mapM_ (checkPath False "extra-tmp-files" PathKindFile) extraTmpFiles_-    mapM_ (checkPath False "extra-doc-files" PathKindGlob) extraDocFiles_-    mapM_ (checkPath False "data-files" PathKindGlob) dataFiles_-    checkPath True "data-dir" PathKindDirectory dataDir_+    mapM_ (checkPath False "extra-source-files" PathKindGlob . getSymbolicPath) extraSrcFiles_+    mapM_ (checkPath False "extra-tmp-files" PathKindFile . getSymbolicPath) extraTmpFiles_+    mapM_ (checkPath False "extra-doc-files" PathKindGlob . getSymbolicPath) extraDocFiles_+    mapM_ (checkPath False "extra-files" PathKindGlob . getSymbolicPath) extraFiles_+    mapM_ (checkPath False "data-files" PathKindGlob . getSymbolicPath) dataFiles_+    let rawDataDir = getSymbolicPath dataDir_+    checkPath True "data-dir" PathKindDirectory rawDataDir     let licPaths = map getSymbolicPath licenseFiles_     mapM_ (checkPath False "license-file" PathKindFile) licPaths     mapM_ checkLicFileExist licenseFiles_      -- § Globs.-    dataGlobs <- mapM (checkGlob "data-files") dataFiles_-    extraGlobs <- mapM (checkGlob "extra-source-files") extraSrcFiles_-    docGlobs <- mapM (checkGlob "extra-doc-files") extraDocFiles_+    dataGlobs <- mapM (checkGlob "data-files" . getSymbolicPath) dataFiles_+    extraSrcGlobs <- mapM (checkGlob "extra-source-files" . getSymbolicPath) extraSrcFiles_+    docGlobs <- mapM (checkGlob "extra-doc-files" . getSymbolicPath) extraDocFiles_+    extraGlobs <- mapM (checkGlob "extra-files" . getSymbolicPath) extraFiles_     -- We collect globs to feed them to checkMissingDocs.      -- § Missing documentation.     checkMissingDocs       (catMaybes dataGlobs)-      (catMaybes extraGlobs)+      (catMaybes extraSrcGlobs)       (catMaybes docGlobs)+      (catMaybes extraGlobs)      -- § Datafield checks.     checkSetupBuildInfo setupBuildInfo_@@ -512,16 +514,17 @@       (isNothing buildTypeRaw_ && specVersion_ < CabalSpecV2_2)       (PackageBuildWarning NoBuildType)     checkP-      (isJust setupBuildInfo_ && buildType pkg /= Custom)+      (isJust setupBuildInfo_ && buildType pkg `notElem` [Custom, Hooks])       (PackageBuildWarning NoCustomSetup)      -- Contents.     checkConfigureExists (buildType pkg)     checkSetupExists (buildType pkg)     checkCabalFile (packageName pkg)-    mapM_ (checkGlobFile specVersion_ "." "extra-source-files") extraSrcFiles_-    mapM_ (checkGlobFile specVersion_ "." "extra-doc-files") extraDocFiles_-    mapM_ (checkGlobFile specVersion_ dataDir_ "data-files") dataFiles_+    mapM_ (checkGlobFile specVersion_ "." "extra-source-files" . getSymbolicPath) extraSrcFiles_+    mapM_ (checkGlobFile specVersion_ "." "extra-doc-files" . getSymbolicPath) extraDocFiles_+    mapM_ (checkGlobFile specVersion_ "." "extra-files" . getSymbolicPath) extraFiles_+    mapM_ (checkGlobFile specVersion_ rawDataDir "data-files" . getSymbolicPath) dataFiles_     where       checkNull         :: Monad m@@ -681,6 +684,7 @@         checkP           (isNothing repoLocation_)           (PackageDistInexcusable MissingLocation)+        checkGitProtocol repoLocation_         checkP           ( repoType_ == Just (KnownRepoType CVS)               && isNothing repoModule_@@ -719,6 +723,17 @@     repoTypeDirname Monotone = ["_MTN"]     repoTypeDirname Pijul = [".pijul"] +-- git:// lacks TLS or other encryption, see+-- https://git-scm.com/book/en/v2/Git-on-the-Server-The-Protocols#_the_cons_4+checkGitProtocol+  :: Monad m+  => Maybe String -- Repository location+  -> CheckM m ()+checkGitProtocol mloc =+  checkP+    (fmap (isPrefixOf "git://") mloc == Just True)+    (PackageBuildWarning GitProtocol)+ -- ------------------------------------------------------------ -- Package and distribution checks -- ------------------------------------------------------------@@ -786,7 +801,7 @@  checkLicFileExist   :: Monad m-  => SymbolicPath PackageDir LicenseFile+  => RelativePath Pkg File   -> CheckM m () checkLicFileExist sp = do   let fp = getSymbolicPath sp@@ -987,8 +1002,9 @@   => [Glob] -- data-files globs.   -> [Glob] -- extra-source-files globs.   -> [Glob] -- extra-doc-files globs.+  -> [Glob] -- extra-files globs.   -> CheckM m ()-checkMissingDocs dgs esgs edgs = do+checkMissingDocs dgs esgs edgs efgs = do   extraDocSupport <- (>= CabalSpecV1_18) <$> asksCM ccSpecVersion    -- Everything in this block uses CheckPreDistributionOps interface.@@ -1007,9 +1023,10 @@         rgs <- realGlob dgs         res <- realGlob esgs         red <- realGlob edgs+        ref <- realGlob efgs          -- 3. Check if anything in 1. is missing in 2.-        let mcs = checkDoc extraDocSupport des (rgs ++ res ++ red)+        let mcs = checkDoc extraDocSupport des (rgs ++ res ++ red ++ ref)          -- 4. Check if files are present but in the wrong field.         let pcsData = checkDocMove extraDocSupport "data-files" des rgs

@@ -86,7 +86,7 @@     checkP       ( not $           all-            (flip elem (allExplicitIncludes lib))+            (flip elem (allExplicitIncludes lib) . getSymbolicPath)             (view L.autogenIncludes lib)       )       $ (PackageBuildImpossible AutogenIncludesNotIncluded)@@ -107,8 +107,8 @@     where       allExplicitIncludes :: L.HasBuildInfo a => a -> [FilePath]       allExplicitIncludes x =-        view L.includes x-          ++ view L.installIncludes x+        map getSymbolicPath (view L.includes x)+          ++ map getSymbolicPath (view L.installIncludes x)  checkForeignLib :: Monad m => ForeignLib -> CheckM m () checkForeignLib@@ -136,12 +136,13 @@   ads   exe@( Executable           exeName_-          modulePath_+          symbolicModulePath_           _exeScope_           buildInfo_         ) = do     -- Target type/name (exe).     let cet = CETExecutable exeName_+        modulePath_ = getSymbolicPath symbolicModulePath_      -- § Exe specific checks     checkP@@ -172,7 +173,7 @@     checkP       ( not $           all-            (flip elem (view L.includes exe))+            (flip elem (view L.includes exe) . relativeSymbolicPath)             (view L.autogenIncludes exe)       )       (PackageBuildImpossible AutogenIncludesNotIncludedExe)@@ -217,7 +218,7 @@     checkP       ( not $           all-            (flip elem (view L.includes ts))+            (flip elem (view L.includes ts) . relativeSymbolicPath)             (view L.autogenIncludes ts)       )       (PackageBuildImpossible AutogenIncludesNotIncludedExe)@@ -233,12 +234,12 @@     where       mainIsWrongExt =         case testInterface_ of-          TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage f)+          TestSuiteExeV10 _ f -> not (fileExtensionSupportedLanguage $ getSymbolicPath f)           _ -> False        mainIsNotHsExt =         case testInterface_ of-          TestSuiteExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]+          TestSuiteExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]           _ -> False  checkBenchmark@@ -278,7 +279,7 @@     checkP       ( not $           all-            (flip elem (view L.includes bm))+            (flip elem (view L.includes bm) . relativeSymbolicPath)             (view L.autogenIncludes bm)       )       (PackageBuildImpossible AutogenIncludesNotIncludedExe)@@ -290,7 +291,7 @@       -- they are different.       mainIsWrongExt =         case benchmarkInterface_ of-          BenchmarkExeV10 _ f -> takeExtension f `notElem` [".hs", ".lhs"]+          BenchmarkExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"]           _ -> False  -- ------------------------------------------------------------@@ -346,14 +347,14 @@   mapM_ checkCustomField (customFieldsBI bi)    -- Content.-  mapM_ (checkLocalPathExist "extra-lib-dirs") (extraLibDirs bi)+  mapM_ (checkLocalPathExist "extra-lib-dirs" . getSymbolicPath) (extraLibDirs bi)   mapM_-    (checkLocalPathExist "extra-lib-dirs-static")+    (checkLocalPathExist "extra-lib-dirs-static" . getSymbolicPath)     (extraLibDirsStatic bi)   mapM_-    (checkLocalPathExist "extra-framework-dirs")+    (checkLocalPathExist "extra-framework-dirs" . getSymbolicPath)     (extraFrameworkDirs bi)-  mapM_ (checkLocalPathExist "include-dirs") (includeDirs bi)+  mapM_ (checkLocalPathExist "include-dirs" . getSymbolicPath) (includeDirs bi)   mapM_     (checkLocalPathExist "hs-source-dirs" . getSymbolicPath)     (hsSourceDirs bi)@@ -431,27 +432,27 @@ -- Paths well-formedness check for BuildInfo. checkBuildInfoPathsWellFormedness :: Monad m => BuildInfo -> CheckM m () checkBuildInfoPathsWellFormedness bi = do-  mapM_ (checkPath False "asm-sources" PathKindFile) (asmSources bi)-  mapM_ (checkPath False "cmm-sources" PathKindFile) (cmmSources bi)-  mapM_ (checkPath False "c-sources" PathKindFile) (cSources bi)-  mapM_ (checkPath False "cxx-sources" PathKindFile) (cxxSources bi)-  mapM_ (checkPath False "js-sources" PathKindFile) (jsSources bi)+  mapM_ (checkPath False "asm-sources" PathKindFile . getSymbolicPath) (asmSources bi)+  mapM_ (checkPath False "cmm-sources" PathKindFile . getSymbolicPath) (cmmSources bi)+  mapM_ (checkPath False "c-sources" PathKindFile . getSymbolicPath) (cSources bi)+  mapM_ (checkPath False "cxx-sources" PathKindFile . getSymbolicPath) (cxxSources bi)+  mapM_ (checkPath False "js-sources" PathKindFile . getSymbolicPath) (jsSources bi)   mapM_-    (checkPath False "install-includes" PathKindFile)+    (checkPath False "install-includes" PathKindFile . getSymbolicPath)     (installIncludes bi)   mapM_     (checkPath False "hs-source-dirs" PathKindDirectory . getSymbolicPath)     (hsSourceDirs bi)   -- Possibly absolute paths.-  mapM_ (checkPath True "includes" PathKindFile) (includes bi)+  mapM_ (checkPath True "includes" PathKindFile . getSymbolicPath) (includes bi)   mapM_-    (checkPath True "include-dirs" PathKindDirectory)+    (checkPath True "include-dirs" PathKindDirectory . getSymbolicPath)     (includeDirs bi)   mapM_-    (checkPath True "extra-lib-dirs" PathKindDirectory)+    (checkPath True "extra-lib-dirs" PathKindDirectory . getSymbolicPath)     (extraLibDirs bi)   mapM_-    (checkPath True "extra-lib-dirs-static" PathKindDirectory)+    (checkPath True "extra-lib-dirs-static" PathKindDirectory . getSymbolicPath)     (extraLibDirsStatic bi)   mapM_ checkOptionPath (perCompilerFlavorToList $ options bi)   where@@ -501,8 +502,8 @@     (PackageBuildWarning CVExtensionsDeprecated)    -- asm-sources, cmm-sources and friends only w/ spec ≥ 1.10-  checkCVSources (asmSources bi)-  checkCVSources (cmmSources bi)+  checkCVSources (map getSymbolicPath $ asmSources bi)+  checkCVSources (map getSymbolicPath $ cmmSources bi)   checkCVSources (extraBundledLibs bi)   checkCVSources (extraLibFlavours bi) @@ -824,9 +825,10 @@       checkFlags         ["-prof"]         (PackageBuildWarning $ OptProf title)-      -- Does not apply to scripts.-      -- Why do we need this? See #8963.       pid <- asksCM (pnPackageId . ccNames)+      -- Scripts add the -o flag in the fake-package.cabal in order to have the+      -- executable name match the script name even when there are characters+      -- in the script name which are illegal to have as a target name.       unless (pid == fakePackageId) $         checkFlags           ["-o"]

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -46,12 +47,7 @@ import Distribution.Types.TestType (TestType, knownTestTypes) import Distribution.Types.UnqualComponentName import Distribution.Types.Version (Version)-import Distribution.Utils.Path-  ( LicenseFile-  , PackageDir-  , SymbolicPath-  , getSymbolicPath-  )+import Distribution.Utils.Path (FileOrDir (..), Pkg, RelativePath, getSymbolicPath) import Language.Haskell.Extension (Extension)  import qualified Data.Either as Either@@ -197,6 +193,7 @@   | UnrecognisedSourceRepo String   | MissingType   | MissingLocation+  | GitProtocol   | MissingModule   | MissingTag   | SubdirRelPath@@ -276,7 +273,7 @@   | NotPackageName FilePath String   | NoDesc   | MultiDesc [String]-  | UnknownFile String (SymbolicPath PackageDir LicenseFile)+  | UnknownFile String (RelativePath Pkg File)   | MissingSetupFile   | MissingConfigureScript   | UnknownDirectory String FilePath@@ -359,6 +356,7 @@   | CIUnrecognisedSourceRepo   | CIMissingType   | CIMissingLocation+  | CIGitProtocol   | CIMissingModule   | CIMissingTag   | CISubdirRelPath@@ -500,6 +498,7 @@ checkExplanationId (UnrecognisedSourceRepo{}) = CIUnrecognisedSourceRepo checkExplanationId (MissingType{}) = CIMissingType checkExplanationId (MissingLocation{}) = CIMissingLocation+checkExplanationId (GitProtocol{}) = CIGitProtocol checkExplanationId (MissingModule{}) = CIMissingModule checkExplanationId (MissingTag{}) = CIMissingTag checkExplanationId (SubdirRelPath{}) = CISubdirRelPath@@ -646,6 +645,7 @@ ppCheckExplanationId CIUnrecognisedSourceRepo = "unrecognised-repo-type" ppCheckExplanationId CIMissingType = "repo-no-type" ppCheckExplanationId CIMissingLocation = "repo-no-location"+ppCheckExplanationId CIGitProtocol = "git-protocol" ppCheckExplanationId CIMissingModule = "repo-no-module" ppCheckExplanationId CIMissingTag = "repo-no-tag" ppCheckExplanationId CISubdirRelPath = "repo-relative-dir"@@ -968,6 +968,10 @@   "The source-repository 'type' is a required field." ppExplanation MissingLocation =   "The source-repository 'location' is a required field."+ppExplanation GitProtocol =+  "Cloning over git:// might lead to an arbitrary code execution "+    ++ "vulnerability. Furthermore, popular forges like GitHub do "+    ++ "not support it. Use https:// or ssh:// instead." ppExplanation MissingModule =   "For a CVS source-repository, the 'module' is a required field." ppExplanation MissingTag =@@ -1117,9 +1121,9 @@     ++ quotes paths     ++ " invalid on Windows, which "     ++ "would cause portability problems for this package. Windows file "-    ++ "names cannot contain any of the characters \":*?<>|\" and there "-    ++ "a few reserved names including \"aux\", \"nul\", \"con\", "-    ++ "\"prn\", \"com1-9\", \"lpt1-9\" and \"clock$\"."+    ++ "names cannot contain any of the characters \":*?<>|\", and there "+    ++ "are a few reserved names including \"aux\", \"nul\", \"con\", "+    ++ "\"prn\", \"com{1-9}\", \"lpt{1-9}\" and \"clock$\"."   where     quotes [failed] = "path " ++ quote failed ++ " is"     quotes failed =

@@ -1,7 +1,12 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- {- Work around this warning:@@ -53,6 +58,8 @@   , UserHooks (..)   , Args   , defaultMainWithHooks+  , defaultMainWithSetupHooks+  , defaultMainWithSetupHooksArgs   , defaultMainWithHooksArgs   , defaultMainWithHooksNoRead   , defaultMainWithHooksNoReadArgs@@ -60,12 +67,14 @@     -- ** Standard sets of hooks   , simpleUserHooks   , autoconfUserHooks+  , autoconfSetupHooks   , emptyUserHooks   ) where  import Control.Exception (try)  import Distribution.Compat.Prelude+import Distribution.Compat.ResponseFile (expandResponse) import Prelude ()  -- local@@ -79,6 +88,7 @@ import Distribution.Simple.PreProcess import Distribution.Simple.Program import Distribution.Simple.Setup+import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks import Distribution.Simple.UserHooks  import Distribution.Simple.Build@@ -91,20 +101,24 @@ import Distribution.Pretty import Distribution.Simple.Bench import Distribution.Simple.BuildPaths-import Distribution.Simple.ConfigureScript+import Distribution.Simple.ConfigureScript (runConfigureScript) import Distribution.Simple.Errors import Distribution.Simple.Haddock import Distribution.Simple.Install import Distribution.Simple.LocalBuildInfo+import Distribution.Simple.SetupHooks.Internal+  ( SetupHooks+  ) import Distribution.Simple.Test import Distribution.Simple.Utils+import qualified Distribution.Types.LocalBuildConfig as LBC+import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension  -- Base--import Distribution.Compat.ResponseFile (expandResponse)+import Data.List (unionBy, (\\)) import System.Directory   ( doesDirectoryExist   , doesFileExist@@ -112,10 +126,7 @@   , removeFile   ) import System.Environment (getArgs, getProgName)-import System.FilePath (takeDirectory, (</>)) -import Data.List (unionBy, (\\))- -- | A simple implementation of @main@ for a Cabal setup script. -- It reads the package description file using IO, and performs the -- action specified on the command line.@@ -127,6 +138,112 @@ defaultMainArgs :: [String] -> IO () defaultMainArgs = defaultMainHelper simpleUserHooks +defaultMainWithSetupHooks :: SetupHooks -> IO ()+defaultMainWithSetupHooks setup_hooks =+  getArgs >>= defaultMainWithSetupHooksArgs setup_hooks++defaultMainWithSetupHooksArgs :: SetupHooks -> [String] -> IO ()+defaultMainWithSetupHooksArgs setupHooks =+  defaultMainHelper $+    simpleUserHooks+      { confHook = setup_confHook+      , buildHook = setup_buildHook+      , copyHook = setup_copyHook+      , instHook = setup_installHook+      , replHook = setup_replHook+      , haddockHook = setup_haddockHook+      , hscolourHook = setup_hscolourHook+      }+  where+    setup_confHook+      :: (GenericPackageDescription, HookedBuildInfo)+      -> ConfigFlags+      -> IO LocalBuildInfo+    setup_confHook =+      configure_setupHooks+        (SetupHooks.configureHooks setupHooks)++    setup_buildHook+      :: PackageDescription+      -> LocalBuildInfo+      -> UserHooks+      -> BuildFlags+      -> IO ()+    setup_buildHook pkg_descr lbi hooks flags =+      build_setupHooks+        (SetupHooks.buildHooks setupHooks)+        pkg_descr+        lbi+        flags+        (allSuffixHandlers hooks)++    setup_copyHook+      :: PackageDescription+      -> LocalBuildInfo+      -> UserHooks+      -> CopyFlags+      -> IO ()+    setup_copyHook pkg_descr lbi _hooks flags =+      install_setupHooks+        (SetupHooks.installHooks setupHooks)+        pkg_descr+        lbi+        flags++    setup_installHook+      :: PackageDescription+      -> LocalBuildInfo+      -> UserHooks+      -> InstallFlags+      -> IO ()+    setup_installHook =+      defaultInstallHook_setupHooks+        (SetupHooks.installHooks setupHooks)++    setup_replHook+      :: PackageDescription+      -> LocalBuildInfo+      -> UserHooks+      -> ReplFlags+      -> [String]+      -> IO ()+    setup_replHook pkg_descr lbi hooks flags args =+      repl_setupHooks+        (SetupHooks.buildHooks setupHooks)+        pkg_descr+        lbi+        flags+        (allSuffixHandlers hooks)+        args++    setup_haddockHook+      :: PackageDescription+      -> LocalBuildInfo+      -> UserHooks+      -> HaddockFlags+      -> IO ()+    setup_haddockHook pkg_descr lbi hooks flags =+      haddock_setupHooks+        (SetupHooks.buildHooks setupHooks)+        pkg_descr+        lbi+        (allSuffixHandlers hooks)+        flags++    setup_hscolourHook+      :: PackageDescription+      -> LocalBuildInfo+      -> UserHooks+      -> HscolourFlags+      -> IO ()+    setup_hscolourHook pkg_descr lbi hooks flags =+      hscolour_setupHooks+        (SetupHooks.buildHooks setupHooks)+        pkg_descr+        lbi+        (allSuffixHandlers hooks)+        flags+ -- | A customizable version of 'defaultMain'. defaultMainWithHooks :: UserHooks -> IO () defaultMainWithHooks hooks = getArgs >>= defaultMainHelper hooks@@ -173,15 +290,15 @@     CommandHelp help -> printHelp help     CommandList opts -> printOptionsList opts     CommandErrors errs -> printErrors errs-    CommandReadyToGo (flags, commandParse) ->+    CommandReadyToGo (globalFlags, commandParse) ->       case commandParse of         _-          | fromFlag (globalVersion flags) -> printVersion-          | fromFlag (globalNumericVersion flags) -> printNumericVersion+          | fromFlag (globalVersion globalFlags) -> printVersion+          | fromFlag (globalNumericVersion globalFlags) -> printNumericVersion         CommandHelp help -> printHelp help         CommandList opts -> printOptionsList opts         CommandErrors errs -> printErrors errs-        CommandReadyToGo action -> action+        CommandReadyToGo action -> action globalFlags   where     printHelp help = getProgName >>= putStr . help     printOptionsList = putStr . unlines@@ -195,21 +312,24 @@           ++ prettyShow cabalVersion      progs = addKnownPrograms (hookedPrograms hooks) defaultProgramDb+    addAction :: CommandUI flags -> (GlobalFlags -> UserHooks -> flags -> [String] -> IO res) -> Command (GlobalFlags -> IO ())+    addAction cmd action =+      cmd `commandAddAction` \flags as globalFlags -> void $ action globalFlags hooks flags as+    commands :: [Command (GlobalFlags -> IO ())]     commands =-      [ configureCommand progs-          `commandAddAction` \fs as -> configureAction hooks fs as >> return ()-      , buildCommand progs `commandAddAction` buildAction hooks-      , replCommand progs `commandAddAction` replAction hooks-      , installCommand `commandAddAction` installAction hooks-      , copyCommand `commandAddAction` copyAction hooks-      , haddockCommand `commandAddAction` haddockAction hooks-      , cleanCommand `commandAddAction` cleanAction hooks-      , sdistCommand `commandAddAction` sdistAction hooks-      , hscolourCommand `commandAddAction` hscolourAction hooks-      , registerCommand `commandAddAction` registerAction hooks-      , unregisterCommand `commandAddAction` unregisterAction hooks-      , testCommand `commandAddAction` testAction hooks-      , benchmarkCommand `commandAddAction` benchAction hooks+      [ configureCommand progs `addAction` configureAction+      , buildCommand progs `addAction` buildAction+      , replCommand progs `addAction` replAction+      , installCommand `addAction` installAction+      , copyCommand `addAction` copyAction+      , haddockCommand `addAction` haddockAction+      , cleanCommand `addAction` cleanAction+      , sdistCommand `addAction` sdistAction+      , hscolourCommand `addAction` hscolourAction+      , registerCommand `addAction` registerAction+      , unregisterCommand `addAction` unregisterAction+      , testCommand `addAction` testAction+      , benchmarkCommand `addAction` benchAction       ]  -- | Combine the preprocessors in the given hooks with the@@ -223,14 +343,22 @@     overridesPP :: [PPSuffixHandler] -> [PPSuffixHandler] -> [PPSuffixHandler]     overridesPP = unionBy (\x y -> fst x == fst y) -configureAction :: UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo-configureAction hooks flags args = do-  distPref <- findDistPrefOrDefault (configDistPref flags)-  let flags' =+configureAction :: GlobalFlags -> UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo+configureAction globalFlags hooks flags args = do+  distPref <- findDistPrefOrDefault (setupDistPref $ configCommonFlags flags)+  let commonFlags = configCommonFlags flags+      commonFlags' =+        commonFlags+          { setupDistPref = toFlag distPref+          , setupWorkingDir = globalWorkingDir globalFlags <> setupWorkingDir commonFlags+          , setupTargets = args+          }+      flags' =         flags-          { configDistPref = toFlag distPref-          , configArgs = args+          { configCommonFlags = commonFlags'           }+      mbWorkDir = flagToMaybe $ setupWorkingDir commonFlags'+      verbosity = fromFlag $ setupVerbosity commonFlags'    -- See docs for 'HookedBuildInfo'   pbi <- preConf hooks args flags'@@ -239,55 +367,75 @@     confPkgDescr       hooks       verbosity-      (flagToMaybe (configCabalFilePath flags))+      mbWorkDir+      (flagToMaybe (setupCabalFilePath commonFlags'))    let epkg_descr = (pkg_descr0, pbi) -  localbuildinfo0 <- confHook hooks epkg_descr flags'+  lbi1 <- confHook hooks epkg_descr flags'    -- remember the .cabal filename if we know it   -- and all the extra command line args   let localbuildinfo =-        localbuildinfo0+        lbi1           { pkgDescrFile = mb_pd_file           , extraConfigArgs = args           }-  writePersistBuildConfig distPref localbuildinfo+  writePersistBuildConfig mbWorkDir distPref localbuildinfo    let pkg_descr = localPkgDescr localbuildinfo   postConf hooks args flags' pkg_descr localbuildinfo   return localbuildinfo-  where-    verbosity = fromFlag (configVerbosity flags)  confPkgDescr   :: UserHooks   -> Verbosity-  -> Maybe FilePath-  -> IO (Maybe FilePath, GenericPackageDescription)-confPkgDescr hooks verbosity mb_path = do+  -> Maybe (SymbolicPath CWD (Dir Pkg))+  -> Maybe (SymbolicPath Pkg File)+  -> IO (Maybe (SymbolicPath Pkg File), GenericPackageDescription)+confPkgDescr hooks verbosity cwd mb_path = do   mdescr <- readDesc hooks   case mdescr of     Just descr -> return (Nothing, descr)     Nothing -> do       pdfile <- case mb_path of-        Nothing -> defaultPackageDesc verbosity+        Nothing -> relativeSymbolicPath <$> tryFindPackageDesc verbosity cwd         Just path -> return path       info verbosity "Using Parsec parser"-      descr <- readGenericPackageDescription verbosity pdfile+      descr <- readGenericPackageDescription verbosity cwd pdfile       return (Just pdfile, descr) -buildAction :: UserHooks -> BuildFlags -> Args -> IO ()-buildAction hooks flags args = do-  distPref <- findDistPrefOrDefault (buildDistPref flags)-  let verbosity = fromFlag $ buildVerbosity flags-  lbi <- getBuildConfig hooks verbosity distPref-  let flags' =-        flags-          { buildDistPref = toFlag distPref-          , buildCabalFilePath = maybeToFlag (cabalFilePath lbi)-          }+getCommonFlags+  :: GlobalFlags+  -> UserHooks+  -> CommonSetupFlags+  -> Args+  -> IO (LocalBuildInfo, CommonSetupFlags)+getCommonFlags globalFlags hooks commonFlags args = do+  distPref <- findDistPrefOrDefault (setupDistPref commonFlags)+  let verbosity = fromFlag $ setupVerbosity commonFlags+  lbi <- getBuildConfig globalFlags hooks verbosity distPref+  let common' = configCommonFlags $ configFlags lbi+  return $+    ( lbi+    , commonFlags+        { setupDistPref = toFlag distPref+        , setupCabalFilePath = setupCabalFilePath common' <> setupCabalFilePath commonFlags+        , setupWorkingDir =+            globalWorkingDir globalFlags+              <> setupWorkingDir common'+              <> setupWorkingDir commonFlags+        , setupTargets = args+        }+    ) +buildAction :: GlobalFlags -> UserHooks -> BuildFlags -> Args -> IO ()+buildAction globalFlags hooks flags args = do+  let common = buildCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{buildCommonFlags = common'}+   progs <-     reconfigurePrograms       verbosity@@ -302,16 +450,15 @@     postBuild     (return lbi{withPrograms = progs})     hooks-    flags'{buildArgs = args}+    flags'     args -replAction :: UserHooks -> ReplFlags -> Args -> IO ()-replAction hooks flags args = do-  distPref <- findDistPrefOrDefault (replDistPref flags)-  let verbosity = fromFlag $ replVerbosity flags-      flags' = flags{replDistPref = toFlag distPref}--  lbi <- getBuildConfig hooks verbosity distPref+replAction :: GlobalFlags -> UserHooks -> ReplFlags -> Args -> IO ()+replAction globalFlags hooks flags args = do+  let common = replCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{replCommonFlags = common'}   progs <-     reconfigurePrograms       verbosity@@ -334,37 +481,30 @@   replHook hooks pkg_descr lbi' hooks flags' args   postRepl hooks args flags' pkg_descr lbi' -hscolourAction :: UserHooks -> HscolourFlags -> Args -> IO ()-hscolourAction hooks flags args = do-  distPref <- findDistPrefOrDefault (hscolourDistPref flags)-  let verbosity = fromFlag $ hscolourVerbosity flags-  lbi <- getBuildConfig hooks verbosity distPref-  let flags' =-        flags-          { hscolourDistPref = toFlag distPref-          , hscolourCabalFilePath = maybeToFlag (cabalFilePath lbi)-          }+hscolourAction :: GlobalFlags -> UserHooks -> HscolourFlags -> Args -> IO ()+hscolourAction globalFlags hooks flags args = do+  let common = hscolourCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (_lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{hscolourCommonFlags = common'}+      distPref = fromFlag $ setupDistPref common'    hookedAction     verbosity     preHscolour     hscolourHook     postHscolour-    (getBuildConfig hooks verbosity distPref)+    (getBuildConfig globalFlags hooks verbosity distPref)     hooks     flags'     args -haddockAction :: UserHooks -> HaddockFlags -> Args -> IO ()-haddockAction hooks flags args = do-  distPref <- findDistPrefOrDefault (haddockDistPref flags)-  let verbosity = fromFlag $ haddockVerbosity flags-  lbi <- getBuildConfig hooks verbosity distPref-  let flags' =-        flags-          { haddockDistPref = toFlag distPref-          , haddockCabalFilePath = maybeToFlag (cabalFilePath lbi)-          }+haddockAction :: GlobalFlags -> UserHooks -> HaddockFlags -> Args -> IO ()+haddockAction globalFlags hooks flags args = do+  let common = haddockCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{haddockCommonFlags = common'}    progs <-     reconfigurePrograms@@ -380,25 +520,42 @@     postHaddock     (return lbi{withPrograms = progs})     hooks-    flags'{haddockArgs = args}+    flags'     args -cleanAction :: UserHooks -> CleanFlags -> Args -> IO ()-cleanAction hooks flags args = do-  distPref <- findDistPrefOrDefault (cleanDistPref flags)--  elbi <- tryGetBuildConfig hooks verbosity distPref-  let flags' =-        flags-          { cleanDistPref = toFlag distPref-          , cleanCabalFilePath = case elbi of-              Left _ -> mempty-              Right lbi -> maybeToFlag (cabalFilePath lbi)+cleanAction :: GlobalFlags -> UserHooks -> CleanFlags -> Args -> IO ()+cleanAction globalFlags hooks flags args = do+  let common = cleanCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  distPref <- findDistPrefOrDefault (setupDistPref common)+  elbi <- tryGetBuildConfig globalFlags hooks verbosity distPref+  let common' =+        common+          { setupDistPref = toFlag distPref+          , setupWorkingDir = case elbi of+              Left _ ->+                globalWorkingDir globalFlags+                  <> setupWorkingDir common+              Right lbi ->+                globalWorkingDir globalFlags+                  <> setupWorkingDir (configCommonFlags $ configFlags lbi)+                  <> setupWorkingDir common+          , setupCabalFilePath = case elbi of+              Left _ -> setupCabalFilePath common+              Right lbi ->+                setupCabalFilePath common+                  <> setupCabalFilePath (configCommonFlags $ configFlags lbi)+          , setupTargets = args           }+      flags' =+        flags{cleanCommonFlags = common'} +      mbWorkDirFlag = cleanWorkingDir flags'+      mbWorkDir = flagToMaybe mbWorkDirFlag+   pbi <- preClean hooks args flags' -  (_, ppd) <- confPkgDescr hooks verbosity Nothing+  (_, ppd) <- confPkgDescr hooks verbosity mbWorkDir Nothing   -- It might seem like we are doing something clever here   -- but we're really not: if you look at the implementation   -- of 'clean' in the end all the package description is@@ -413,125 +570,115 @@    cleanHook hooks pkg_descr () hooks flags'   postClean hooks args flags' pkg_descr ()-  where-    verbosity = fromFlag (cleanVerbosity flags) -copyAction :: UserHooks -> CopyFlags -> Args -> IO ()-copyAction hooks flags args = do-  distPref <- findDistPrefOrDefault (copyDistPref flags)-  let verbosity = fromFlag $ copyVerbosity flags-  lbi <- getBuildConfig hooks verbosity distPref-  let flags' =-        flags-          { copyDistPref = toFlag distPref-          , copyCabalFilePath = maybeToFlag (cabalFilePath lbi)-          }+copyAction :: GlobalFlags -> UserHooks -> CopyFlags -> Args -> IO ()+copyAction globalFlags hooks flags args = do+  let common = copyCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (_lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{copyCommonFlags = common'}+      distPref = fromFlag $ setupDistPref common'   hookedAction     verbosity     preCopy     copyHook     postCopy-    (getBuildConfig hooks verbosity distPref)+    (getBuildConfig globalFlags hooks verbosity distPref)     hooks-    flags'{copyArgs = args}+    flags'     args -installAction :: UserHooks -> InstallFlags -> Args -> IO ()-installAction hooks flags args = do-  distPref <- findDistPrefOrDefault (installDistPref flags)-  let verbosity = fromFlag $ installVerbosity flags-  lbi <- getBuildConfig hooks verbosity distPref-  let flags' =-        flags-          { installDistPref = toFlag distPref-          , installCabalFilePath = maybeToFlag (cabalFilePath lbi)-          }+installAction :: GlobalFlags -> UserHooks -> InstallFlags -> Args -> IO ()+installAction globalFlags hooks flags args = do+  let common = installCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (_lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{installCommonFlags = common'}+      distPref = fromFlag $ setupDistPref common'   hookedAction     verbosity     preInst     instHook     postInst-    (getBuildConfig hooks verbosity distPref)+    (getBuildConfig globalFlags hooks verbosity distPref)     hooks     flags'     args  -- Since Cabal-3.4 UserHooks are completely ignored-sdistAction :: UserHooks -> SDistFlags -> Args -> IO ()-sdistAction _hooks flags _args = do-  (_, ppd) <- confPkgDescr emptyUserHooks verbosity Nothing+sdistAction :: GlobalFlags -> UserHooks -> SDistFlags -> Args -> IO ()+sdistAction _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   where-    verbosity = fromFlag (sDistVerbosity flags)--testAction :: UserHooks -> TestFlags -> Args -> IO ()-testAction hooks flags args = do-  distPref <- findDistPrefOrDefault (testDistPref flags)-  let verbosity = fromFlag $ testVerbosity flags-      flags' = flags{testDistPref = toFlag distPref}+    verbosity = fromFlag (setupVerbosity $ sDistCommonFlags flags) +testAction :: GlobalFlags -> UserHooks -> TestFlags -> Args -> IO ()+testAction globalFlags hooks flags args = do+  let common = testCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (_lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{testCommonFlags = common'}+      distPref = fromFlag $ setupDistPref common'   hookedActionWithArgs     verbosity     preTest     testHook     postTest-    (getBuildConfig hooks verbosity distPref)+    (getBuildConfig globalFlags hooks verbosity distPref)     hooks     flags'     args -benchAction :: UserHooks -> BenchmarkFlags -> Args -> IO ()-benchAction hooks flags args = do-  distPref <- findDistPrefOrDefault (benchmarkDistPref flags)-  let verbosity = fromFlag $ benchmarkVerbosity flags-      flags' = flags{benchmarkDistPref = toFlag distPref}+benchAction :: GlobalFlags -> UserHooks -> BenchmarkFlags -> Args -> IO ()+benchAction globalFlags hooks flags args = do+  let common = benchmarkCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (_lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{benchmarkCommonFlags = common'}+      distPref = fromFlag $ setupDistPref common'   hookedActionWithArgs     verbosity     preBench     benchHook     postBench-    (getBuildConfig hooks verbosity distPref)+    (getBuildConfig globalFlags hooks verbosity distPref)     hooks     flags'     args -registerAction :: UserHooks -> RegisterFlags -> Args -> IO ()-registerAction hooks flags args = do-  distPref <- findDistPrefOrDefault (regDistPref flags)-  let verbosity = fromFlag $ regVerbosity flags-  lbi <- getBuildConfig hooks verbosity distPref-  let flags' =-        flags-          { regDistPref = toFlag distPref-          , regCabalFilePath = maybeToFlag (cabalFilePath lbi)-          }+registerAction :: GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()+registerAction globalFlags hooks flags args = do+  let common = registerCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (_lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{registerCommonFlags = common'}+      distPref = fromFlag $ setupDistPref common'   hookedAction     verbosity     preReg     regHook     postReg-    (getBuildConfig hooks verbosity distPref)+    (getBuildConfig globalFlags hooks verbosity distPref)     hooks-    flags'{regArgs = args}+    flags'     args -unregisterAction :: UserHooks -> RegisterFlags -> Args -> IO ()-unregisterAction hooks flags args = do-  distPref <- findDistPrefOrDefault (regDistPref flags)-  let verbosity = fromFlag $ regVerbosity flags-  lbi <- getBuildConfig hooks verbosity distPref-  let flags' =-        flags-          { regDistPref = toFlag distPref-          , regCabalFilePath = maybeToFlag (cabalFilePath lbi)-          }+unregisterAction :: GlobalFlags -> UserHooks -> RegisterFlags -> Args -> IO ()+unregisterAction globalFlags hooks flags args = do+  let common = registerCommonFlags flags+      verbosity = fromFlag $ setupVerbosity common+  (_lbi, common') <- getCommonFlags globalFlags hooks common args+  let flags' = flags{registerCommonFlags = common'}+      distPref = fromFlag $ setupDistPref common'   hookedAction     verbosity     preUnreg     unregHook     postUnreg-    (getBuildConfig hooks verbosity distPref)+    (getBuildConfig globalFlags hooks verbosity distPref)     hooks     flags'     args@@ -625,16 +772,22 @@  -- | Try to read the 'localBuildInfoFile' tryGetBuildConfig-  :: UserHooks+  :: GlobalFlags+  -> UserHooks   -> Verbosity-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -> IO (Either ConfigStateFileError LocalBuildInfo)-tryGetBuildConfig u v = try . getBuildConfig u v+tryGetBuildConfig g u v = try . getBuildConfig g u v  -- | Read the 'localBuildInfoFile' or throw an exception.-getBuildConfig :: UserHooks -> Verbosity -> FilePath -> IO LocalBuildInfo-getBuildConfig hooks verbosity distPref = do-  lbi_wo_programs <- getPersistBuildConfig distPref+getBuildConfig+  :: GlobalFlags+  -> UserHooks+  -> Verbosity+  -> SymbolicPath Pkg (Dir Dist)+  -> IO LocalBuildInfo+getBuildConfig globalFlags hooks verbosity distPref = do+  lbi_wo_programs <- getPersistBuildConfig mbWorkDir distPref   -- Restore info about unconfigured programs, since it is not serialized   let lbi =         lbi_wo_programs@@ -647,15 +800,16 @@   case pkgDescrFile lbi of     Nothing -> return lbi     Just pkg_descr_file -> do-      outdated <- checkPersistBuildConfigOutdated distPref pkg_descr_file+      outdated <- checkPersistBuildConfigOutdated mbWorkDir distPref pkg_descr_file       if outdated         then reconfigure pkg_descr_file lbi         else return lbi   where-    reconfigure :: FilePath -> LocalBuildInfo -> IO LocalBuildInfo+    mbWorkDir = flagToMaybe $ globalWorkingDir globalFlags+    reconfigure :: SymbolicPath Pkg File -> LocalBuildInfo -> IO LocalBuildInfo     reconfigure pkg_descr_file lbi = do       notice verbosity $-        pkg_descr_file+        getSymbolicPath pkg_descr_file           ++ " has been changed. "           ++ "Re-configuring with most recently used options. "           ++ "If this fails, please run configure manually.\n"@@ -671,35 +825,43 @@                         (builtinPrograms ++ hookedPrograms hooks)                     )                     `fmap` configPrograms_ cFlags-              , -- Use the current, not saved verbosity level:-                configVerbosity = Flag verbosity+              , configCommonFlags =+                  (configCommonFlags cFlags)+                    { -- Use the current, not saved verbosity level:+                      setupVerbosity = Flag verbosity+                    }               }-      configureAction hooks cFlags' (extraConfigArgs lbi)+      configureAction globalFlags hooks cFlags' (extraConfigArgs lbi)  -- -------------------------------------------------------------------------- -- Cleaning  clean :: PackageDescription -> CleanFlags -> IO () clean pkg_descr flags = do-  let distPref = fromFlagOrDefault defaultDistPref $ cleanDistPref flags+  let common = cleanCommonFlags flags+      verbosity = fromFlag (setupVerbosity common)+      distPref = fromFlagOrDefault defaultDistPref $ setupDistPref common+      mbWorkDir = flagToMaybe $ setupWorkingDir common+      i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path+      distPath = i distPref   notice verbosity "cleaning..."    maybeConfig <-     if fromFlag (cleanSaveConf flags)-      then maybeGetPersistBuildConfig distPref+      then maybeGetPersistBuildConfig mbWorkDir distPref       else return Nothing    -- remove the whole dist/ directory rather than tracking exactly what files   -- we created in there.   chattyTry "removing dist/" $ do-    exists <- doesDirectoryExist distPref-    when exists (removeDirectoryRecursive distPref)+    exists <- doesDirectoryExist distPath+    when exists (removeDirectoryRecursive distPath)    -- Any extra files the user wants to remove-  traverse_ removeFileOrDirectory (extraTmpFiles pkg_descr)+  traverse_ (removeFileOrDirectory . i) (extraTmpFiles pkg_descr)    -- If the user wanted to save the config, write it back-  traverse_ (writePersistBuildConfig distPref) maybeConfig+  traverse_ (writePersistBuildConfig mbWorkDir distPref) maybeConfig   where     removeFileOrDirectory :: FilePath -> IO ()     removeFileOrDirectory fname = do@@ -708,7 +870,6 @@       if isDir         then removeDirectoryRecursive fname         else when isFile $ removeFile fname-    verbosity = fromFlag (cleanVerbosity flags)  -- -------------------------------------------------------------------------- -- Default hooks@@ -724,9 +885,9 @@     , replHook = defaultReplHook     , copyHook = \desc lbi _ f -> install desc lbi f     , -- 'install' has correct 'copy' behavior with params-      testHook = defaultTestHook+      instHook = defaultInstallHook+    , testHook = defaultTestHook     , benchHook = defaultBenchHook-    , instHook = defaultInstallHook     , 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@@ -737,7 +898,7 @@     finalChecks _args flags pkg_descr lbi =       checkForeignDeps pkg_descr lbi (lessVerbose verbosity)       where-        verbosity = fromFlag (configVerbosity flags)+        verbosity = fromFlag (setupVerbosity $ configCommonFlags flags)  -- | Basic autoconf 'UserHooks': --@@ -752,17 +913,17 @@ autoconfUserHooks =   simpleUserHooks     { postConf = defaultPostConf-    , preBuild = readHookWithArgs buildVerbosity buildDistPref-    , preRepl = readHookWithArgs replVerbosity replDistPref-    , preCopy = readHookWithArgs copyVerbosity copyDistPref-    , preClean = readHook cleanVerbosity cleanDistPref-    , preInst = readHook installVerbosity installDistPref-    , preHscolour = readHook hscolourVerbosity hscolourDistPref-    , preHaddock = readHookWithArgs haddockVerbosity haddockDistPref-    , preReg = readHook regVerbosity regDistPref-    , preUnreg = readHook regVerbosity regDistPref-    , preTest = readHookWithArgs testVerbosity testDistPref-    , preBench = readHookWithArgs benchmarkVerbosity benchmarkDistPref+    , preBuild = readHookWithArgs buildCommonFlags+    , preRepl = readHookWithArgs replCommonFlags+    , preCopy = readHookWithArgs copyCommonFlags+    , preClean = readHook cleanCommonFlags+    , preInst = readHook installCommonFlags+    , preHscolour = readHook hscolourCommonFlags+    , preHaddock = readHookWithArgs haddockCommonFlags+    , preReg = readHook registerCommonFlags+    , preUnreg = readHook registerCommonFlags+    , preTest = readHookWithArgs testCommonFlags+    , preBench = readHookWithArgs benchmarkCommonFlags     }   where     defaultPostConf@@ -773,60 +934,119 @@       -> IO ()     defaultPostConf args flags pkg_descr lbi =       do-        let verbosity = fromFlag (configVerbosity flags)-            baseDir lbi' =-              fromMaybe-                ""-                (takeDirectory <$> cabalFilePath lbi')-        confExists <- doesFileExist $ (baseDir lbi) </> "configure"-        if confExists-          then-            runConfigureScript-              verbosity-              flags-              lbi-          else dieWithException verbosity ConfigureScriptNotFound--        pbi <- getHookedBuildInfo verbosity (buildDir lbi)+        let common = configCommonFlags flags+            verbosity = fromFlag $ setupVerbosity common+            mbWorkDir = flagToMaybe $ setupWorkingDir common+        runConfigureScript+          flags+          (flagAssignment lbi)+          (withPrograms lbi)+          (hostPlatform lbi)+        pbi <- getHookedBuildInfo verbosity mbWorkDir (buildDir lbi)         sanityCheckHookedBuildInfo verbosity pkg_descr pbi         let pkg_descr' = updatePackageDescription pbi pkg_descr             lbi' = lbi{localPkgDescr = pkg_descr'}         postConf simpleUserHooks args flags pkg_descr' lbi'      readHookWithArgs-      :: (a -> Flag Verbosity)-      -> (a -> Flag FilePath)+      :: (flags -> CommonSetupFlags)       -> Args-      -> a+      -> flags       -> IO HookedBuildInfo-    readHookWithArgs get_verbosity get_dist_pref _ flags = do-      dist_dir <- findDistPrefOrDefault (get_dist_pref flags)-      getHookedBuildInfo verbosity (dist_dir </> "build")-      where-        verbosity = fromFlag (get_verbosity flags)+    readHookWithArgs get_common_flags _args flags = do+      let common = get_common_flags flags+          verbosity = fromFlag (setupVerbosity common)+          mbWorkDir = flagToMaybe $ setupWorkingDir common+          distPref = setupDistPref common+      dist_dir <- findDistPrefOrDefault distPref+      getHookedBuildInfo verbosity mbWorkDir (dist_dir </> makeRelativePathEx "build")      readHook-      :: (a -> Flag Verbosity)-      -> (a -> Flag FilePath)+      :: (flags -> CommonSetupFlags)       -> Args-      -> a+      -> flags       -> IO HookedBuildInfo-    readHook get_verbosity get_dist_pref a flags = do-      noExtraFlags a-      dist_dir <- findDistPrefOrDefault (get_dist_pref flags)-      getHookedBuildInfo verbosity (dist_dir </> "build")-      where-        verbosity = fromFlag (get_verbosity flags)+    readHook get_common_flags args flags = do+      let common = get_common_flags flags+          verbosity = fromFlag (setupVerbosity common)+          mbWorkDir = flagToMaybe $ setupWorkingDir common+          distPref = setupDistPref common+      noExtraFlags args+      dist_dir <- findDistPrefOrDefault distPref+      getHookedBuildInfo verbosity mbWorkDir (dist_dir </> makeRelativePathEx "build") -getHookedBuildInfo :: Verbosity -> FilePath -> IO HookedBuildInfo-getHookedBuildInfo verbosity build_dir = do-  maybe_infoFile <- findHookedPackageDesc verbosity build_dir+getHookedBuildInfo+  :: Verbosity+  -> Maybe (SymbolicPath CWD (Dir Pkg))+  -> SymbolicPath Pkg (Dir Build)+  -> IO HookedBuildInfo+getHookedBuildInfo verbosity mbWorkDir build_dir = do+  maybe_infoFile <- findHookedPackageDesc verbosity mbWorkDir build_dir   case maybe_infoFile of     Nothing -> return emptyHookedBuildInfo     Just infoFile -> do-      info verbosity $ "Reading parameters from " ++ infoFile-      readHookedBuildInfo verbosity infoFile+      info verbosity $ "Reading parameters from " ++ getSymbolicPath infoFile+      readHookedBuildInfo verbosity mbWorkDir infoFile +autoconfSetupHooks :: SetupHooks+autoconfSetupHooks =+  SetupHooks.noSetupHooks+    { SetupHooks.configureHooks =+        SetupHooks.noConfigureHooks+          { SetupHooks.postConfPackageHook = Just post_conf_pkg+          , SetupHooks.preConfComponentHook = Just pre_conf_comp+          }+    }+  where+    post_conf_pkg+      :: SetupHooks.PostConfPackageInputs+      -> IO ()+    post_conf_pkg+      ( SetupHooks.PostConfPackageInputs+          { SetupHooks.localBuildConfig =+            LBC.LocalBuildConfig{LBC.withPrograms = progs}+          , SetupHooks.packageBuildDescr =+            LBC.PackageBuildDescr+              { LBC.configFlags = cfg+              , LBC.flagAssignment = flags+              , LBC.hostPlatform = plat+              }+          }+        ) = runConfigureScript cfg flags progs plat++    pre_conf_comp+      :: SetupHooks.PreConfComponentInputs+      -> IO SetupHooks.PreConfComponentOutputs+    pre_conf_comp+      ( SetupHooks.PreConfComponentInputs+          { SetupHooks.packageBuildDescr =+            LBC.PackageBuildDescr+              { LBC.configFlags = cfg+              , localPkgDescr = pkg_descr+              }+          , SetupHooks.component = component+          }+        ) = do+        let verbosity = fromFlag $ configVerbosity cfg+            mbWorkDir = flagToMaybe $ configWorkingDir cfg+            distPref = configDistPref cfg+        dist_dir <- findDistPrefOrDefault distPref+        -- Read the ".buildinfo" file and use that to update+        -- the components (main library + executables only).+        hbi <- getHookedBuildInfo verbosity mbWorkDir (dist_dir </> makeRelativePathEx "build")+        sanityCheckHookedBuildInfo verbosity pkg_descr hbi+        -- SetupHooks TODO: we are reading getHookedBuildInfo once+        -- for each component. I think this is inherent to the SetupHooks+        -- approach.+        let comp_name = componentName component+        diff <- case SetupHooks.hookedBuildInfoComponentDiff_maybe hbi comp_name of+          Nothing -> return $ SetupHooks.emptyComponentDiff comp_name+          Just do_diff -> do_diff+        return $+          SetupHooks.PreConfComponentOutputs+            { SetupHooks.componentDiff = diff+            }+ defaultTestHook   :: Args   -> PackageDescription@@ -853,22 +1073,30 @@   -> UserHooks   -> InstallFlags   -> IO ()-defaultInstallHook pkg_descr localbuildinfo _ flags = do+defaultInstallHook =+  defaultInstallHook_setupHooks SetupHooks.noInstallHooks++defaultInstallHook_setupHooks+  :: SetupHooks.InstallHooks+  -> PackageDescription+  -> LocalBuildInfo+  -> UserHooks+  -> InstallFlags+  -> IO ()+defaultInstallHook_setupHooks inst_hooks pkg_descr localbuildinfo _ flags = do   let copyFlags =         defaultCopyFlags-          { copyDistPref = installDistPref flags-          , copyDest = installDest flags-          , copyVerbosity = installVerbosity flags+          { copyDest = installDest flags+          , copyCommonFlags = installCommonFlags flags           }-  install pkg_descr localbuildinfo copyFlags+  install_setupHooks inst_hooks pkg_descr localbuildinfo copyFlags   let registerFlags =         defaultRegisterFlags-          { regDistPref = installDistPref flags-          , regInPlace = installInPlace flags+          { regInPlace = installInPlace flags           , regPackageDB = installPackageDB flags-          , regVerbosity = installVerbosity flags           }-  when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags+  when (hasLibs pkg_descr) $+    register pkg_descr localbuildinfo registerFlags  defaultBuildHook   :: PackageDescription@@ -900,6 +1128,6 @@     then register pkg_descr localbuildinfo flags     else       setupMessage-        (fromFlag (regVerbosity flags))+        (fromFlag (setupVerbosity $ registerCommonFlags flags))         "Package contains no library to register:"         (packageId pkg_descr)

@@ -1,4 +1,6 @@+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}  -----------------------------------------------------------------------------@@ -21,22 +23,28 @@ import Distribution.Compat.Prelude import Prelude () +import Distribution.Compat.Environment import qualified Distribution.PackageDescription as PD import Distribution.Pretty+import Distribution.Simple.Build (addInternalBuildTools) import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler-import Distribution.Simple.Flag (fromFlag)+import Distribution.Simple.Errors import Distribution.Simple.InstallDirs import qualified Distribution.Simple.LocalBuildInfo as LBI+import Distribution.Simple.Program.Db+import Distribution.Simple.Program.Find+import Distribution.Simple.Program.Run import Distribution.Simple.Setup.Benchmark+import Distribution.Simple.Setup.Common import Distribution.Simple.UserHooks import Distribution.Simple.Utils-+import Distribution.System (Platform (Platform))+import Distribution.Types.Benchmark (Benchmark (benchmarkBuildInfo)) import Distribution.Types.UnqualComponentName+import Distribution.Utils.Path -import Distribution.Simple.Errors import System.Directory (doesFileExist)-import System.FilePath ((<.>), (</>))  -- | Perform the \"@.\/setup bench@\" action. bench@@ -53,16 +61,28 @@   let verbosity = fromFlag $ benchmarkVerbosity flags       benchmarkNames = args       pkgBenchmarks = PD.benchmarks pkg_descr-      enabledBenchmarks = map fst (LBI.enabledBenchLBIs pkg_descr lbi)+      enabledBenchmarks = LBI.enabledBenchLBIs pkg_descr lbi+      mbWorkDir = flagToMaybe $ benchmarkWorkingDir flags+      i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path        -- Run the benchmark-      doBench :: PD.Benchmark -> IO ExitCode-      doBench bm =+      doBench :: (PD.Benchmark, LBI.ComponentLocalBuildInfo) -> IO ExitCode+      doBench (bm, clbi) = do+        let lbiForBench =+              lbi+                { -- Include any build-tool-depends on build tools internal to the current package.+                  LBI.withPrograms =+                    addInternalBuildTools+                      pkg_descr+                      lbi+                      (benchmarkBuildInfo bm)+                      (LBI.withPrograms lbi)+                }         case PD.benchmarkInterface bm of           PD.BenchmarkExeV10 _ _ -> do-            let cmd = LBI.buildDir lbi </> name </> name <.> exeExtension (LBI.hostPlatform lbi)+            let cmd = i $ LBI.buildDir lbiForBench </> makeRelativePathEx (name </> name <.> exeExtension (LBI.hostPlatform lbi))                 options =-                  map (benchOption pkg_descr lbi bm) $+                  map (benchOption pkg_descr lbiForBench bm) $                     benchmarkOptions flags             -- Check that the benchmark executable exists.             exists <- doesFileExist cmd@@ -70,10 +90,29 @@               dieWithException verbosity $                 NoBenchMarkProgram cmd +            existingEnv <- getEnvironment++            -- Compute the appropriate environment for running the benchmark+            let progDb = LBI.withPrograms lbiForBench+                pathVar = progSearchPath progDb+                envOverrides = progOverrideEnv progDb+            newPath <- programSearchPathAsPATHVar pathVar+            overrideEnv <- fromMaybe [] <$> getEffectiveEnvironment ([("PATH", Just newPath)] ++ envOverrides)+            let shellEnv = overrideEnv ++ existingEnv++            -- Add (DY)LD_LIBRARY_PATH if needed+            shellEnv' <-+              if LBI.withDynExe lbiForBench+                then do+                  let (Platform _ os) = LBI.hostPlatform lbiForBench+                  paths <- LBI.depLibraryPaths True False lbiForBench clbi+                  return (addLibraryPath os paths shellEnv)+                else return shellEnv+             notice verbosity $ startMessage name             -- This will redirect the child process             -- stdout/stderr to the parent process.-            exitcode <- rawSystemExitCode verbosity cmd options+            exitcode <- rawSystemExitCode verbosity mbWorkDir cmd options (Just shellEnv')             notice verbosity $ finishMessage name exitcode             return exitcode           _ -> do@@ -98,7 +137,7 @@     [] -> return enabledBenchmarks     names -> for names $ \bmName ->       let benchmarkMap = zip enabledNames enabledBenchmarks-          enabledNames = map PD.benchmarkName enabledBenchmarks+          enabledNames = map (PD.benchmarkName . fst) enabledBenchmarks           allNames = map PD.benchmarkName pkgBenchmarks        in case lookup (mkUnqualComponentName bmName) benchmarkMap of             Just t -> return t@@ -110,6 +149,7 @@   let totalBenchmarks = length bmsToRun   notice verbosity $ "Running " ++ show totalBenchmarks ++ " benchmarks..."   exitcodes <- traverse doBench bmsToRun+   let allOk = totalBenchmarks == length (filter (== ExitSuccess) exitcodes)   unless allOk exitFailure   where

@@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} @@ -22,9 +25,11 @@ module Distribution.Simple.Build   ( -- * Build     build+  , build_setupHooks      -- * Repl   , repl+  , repl_setupHooks   , startInterpreter      -- * Build preparation@@ -40,6 +45,9 @@      -- * Internal package database creation   , createInternalPackageDB++    -- * Handling of internal build tools+  , addInternalBuildTools   ) where  import Distribution.Compat.Prelude@@ -71,7 +79,7 @@  import Distribution.Simple.Build.Macros (generateCabalMacrosHeader) import Distribution.Simple.Build.PackageInfoModule (generatePackageInfoModule)-import Distribution.Simple.Build.PathsModule (generatePathsModule)+import Distribution.Simple.Build.PathsModule (generatePathsModule, pkgPathEnvVar) import qualified Distribution.Simple.Program.HcPkg as HcPkg  import Distribution.InstalledPackageInfo (InstalledPackageInfo)@@ -90,12 +98,21 @@ import Distribution.Simple.PreProcess import Distribution.Simple.Program import Distribution.Simple.Program.Builtin (haskellSuiteProgram)+import Distribution.Simple.Program.Db import qualified Distribution.Simple.Program.GHC as GHC import Distribution.Simple.Program.Types import Distribution.Simple.Register import Distribution.Simple.Setup.Build+import Distribution.Simple.Setup.Common import Distribution.Simple.Setup.Config import Distribution.Simple.Setup.Repl+import Distribution.Simple.SetupHooks.Internal+  ( BuildHooks (..)+  , BuildingWhat (..)+  , noBuildHooks+  )+import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks+import qualified Distribution.Simple.SetupHooks.Rule as SetupHooks import Distribution.Simple.ShowBuildInfo import Distribution.Simple.Test.LibV09 import Distribution.Simple.Utils@@ -113,8 +130,8 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Map as Map import Distribution.Simple.Errors-import System.Directory (doesFileExist, getCurrentDirectory, removeFile)-import System.FilePath (takeDirectory, (<.>), (</>))+import System.Directory (doesFileExist, removeFile)+import System.FilePath (takeDirectory)  -- ----------------------------------------------------------------------------- @@ -129,70 +146,108 @@   -> [PPSuffixHandler]   -- ^ preprocessors to run before compiling   -> IO ()-build pkg_descr lbi flags suffixes = do-  checkSemaphoreSupport verbosity (compiler lbi) flags-  targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)-  let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)-  info verbosity $-    "Component build order: "-      ++ intercalate-        ", "-        ( map-            (showComponentName . componentLocalName . targetCLBI)-            componentsToBuild-        )+build = build_setupHooks noBuildHooks -  when (null targets) $-    -- Only bother with this message if we're building the whole package-    setupMessage verbosity "Building" (packageId pkg_descr)+build_setupHooks+  :: BuildHooks+  -> PackageDescription+  -- ^ Mostly information from the .cabal file+  -> LocalBuildInfo+  -- ^ Configuration information+  -> BuildFlags+  -- ^ Flags that the user passed to build+  -> [PPSuffixHandler]+  -- ^ preprocessors to run before compiling+  -> IO ()+build_setupHooks+  (BuildHooks{preBuildComponentRules = mbPbcRules, postBuildComponentHook = mbPostBuild})+  pkg_descr+  lbi+  flags+  suffixHandlers = do+    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: "+        ++ intercalate+          ", "+          ( map+              (showComponentName . componentLocalName . targetCLBI)+              componentsToBuild+          ) -  internalPackageDB <- createInternalPackageDB verbosity lbi distPref+    when (null targets) $+      -- Only bother with this message if we're building the whole package+      setupMessage verbosity "Building" (packageId pkg_descr) -  -- Before the actual building, dump out build-information.-  -- This way, if the actual compilation failed, the options have still been-  -- dumped.-  dumpBuildInfo verbosity distPref (configDumpBuildInfo (configFlags lbi)) pkg_descr lbi flags+    internalPackageDB <- createInternalPackageDB verbosity lbi distPref -  -- Now do the actual building-  (\f -> foldM_ f (installedPkgs lbi) componentsToBuild) $ \index target -> do-    preBuildComponent verbosity lbi target-    let comp = targetComponent target-        clbi = targetCLBI target-        bi = componentBuildInfo comp-        progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)-        lbi' =-          lbi-            { withPrograms = progs'-            , withPackageDB = withPackageDB lbi ++ [internalPackageDB]-            , installedPkgs = index-            }-    par_strat <--      toFlag <$> case buildUseSemaphore flags of-        Flag sem_name -> case buildNumJobs flags of-          Flag{} -> do-            warn verbosity $ "Ignoring -j due to --semaphore"-            return $ UseSem sem_name-          NoFlag -> return $ UseSem sem_name-        NoFlag -> return $ case buildNumJobs flags of-          Flag n -> NumJobs n-          NoFlag -> Serial-    mb_ipi <--      buildComponent-        flags-        par_strat-        pkg_descr-        lbi'-        suffixes-        comp-        clbi-        distPref-    return (maybe index (Index.insert `flip` index) mb_ipi)+    -- Before the actual building, dump out build-information.+    -- This way, if the actual compilation failed, the options have still been+    -- dumped.+    dumpBuildInfo verbosity distPref (configDumpBuildInfo (configFlags lbi)) pkg_descr lbi flags -  return ()-  where-    distPref = fromFlag (buildDistPref flags)-    verbosity = fromFlag (buildVerbosity flags)+    -- Now do the actual building+    (\f -> foldM_ f (installedPkgs lbi) componentsToBuild) $ \index target -> do+      let comp = targetComponent target+          clbi = targetCLBI target+          bi = componentBuildInfo comp+          -- Include any build-tool-depends on build tools internal to the current package.+          progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)+          lbi' =+            lbi+              { withPrograms = progs'+              , 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+      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"+              return $ UseSem sem_name+            NoFlag -> return $ UseSem sem_name+          NoFlag -> return $ case numJobs of+            Flag n -> NumJobs n+            NoFlag -> Serial+      mb_ipi <-+        buildComponent+          flags+          par_strat+          pkg_descr+          lbi'+          suffixHandlers+          comp+          clbi+          distPref+      let postBuildInputs =+            SetupHooks.PostBuildComponentInputs+              { SetupHooks.buildFlags = flags+              , SetupHooks.localBuildInfo = lbi'+              , SetupHooks.targetInfo = target+              }+      for_ mbPostBuild ($ postBuildInputs)+      return (maybe index (Index.insert `flip` index) mb_ipi) +    return ()+    where+      distPref = fromFlag (buildDistPref flags)+      verbosity = fromFlag (buildVerbosity flags)+ -- | Check for conditions that would prevent the build from succeeding. checkSemaphoreSupport   :: Verbosity -> Compiler -> BuildFlags -> IO ()@@ -208,7 +263,7 @@ -- lib:Cabal made sure that dependencies are up-to-date. dumpBuildInfo   :: Verbosity-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -- ^ To which directory should the build-info be dumped?   -> Flag DumpBuildInfo   -- ^ Should we dump detailed build information for this component?@@ -232,26 +287,27 @@               (showComponentName . componentLocalName . targetCLBI)               activeTargets           )-    pwd <- getCurrentDirectory      (compilerProg, _) <- case flavorToProgram (compilerFlavor (compiler lbi)) of       Nothing ->         dieWithException verbosity $ UnknownCompilerFlavor (compilerFlavor (compiler lbi))       Just program -> requireProgram verbosity program (withPrograms lbi) -    let (warns, json) = mkBuildInfo pwd pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets+    wdir <- absoluteWorkingDirLBI lbi+    let (warns, json) = mkBuildInfo wdir pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets         buildInfoText = renderJson json     unless (null warns) $       warn verbosity $         "Encountered warnings while dumping build-info:\n"           ++ unlines warns-    LBS.writeFile (buildInfoPref distPref) buildInfoText+    LBS.writeFile buildInfoFile buildInfoText    when (not shouldDumpBuildInfo) $ do     -- Remove existing build-info.json as it might be outdated now.-    exists <- doesFileExist (buildInfoPref distPref)-    when exists $ removeFile (buildInfoPref distPref)+    exists <- doesFileExist buildInfoFile+    when exists $ removeFile buildInfoFile   where+    buildInfoFile = interpretSymbolicPathLBI lbi $ buildInfoPref distPref     shouldDumpBuildInfo = fromFlagOrDefault NoDumpBuildInfo dumpBuildInfoFlag == DumpBuildInfo      -- \| Given the flavor of the compiler, try to find out@@ -275,67 +331,100 @@   -- ^ preprocessors to run before compiling   -> [String]   -> IO ()-repl pkg_descr lbi flags suffixes args = do-  let distPref = fromFlag (replDistPref flags)-      verbosity = fromFlag (replVerbosity flags)+repl = repl_setupHooks noBuildHooks -  target <--    readTargetInfos verbosity pkg_descr lbi args >>= \r -> case r of-      -- This seems DEEPLY questionable.-      [] -> case allTargetsInBuildOrder' pkg_descr lbi of-        (target : _) -> return target-        [] -> dieWithException verbosity $ FailedToDetermineTarget-      [target] -> return target-      _ -> dieWithException verbosity $ NoMultipleTargets-  let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi [nodeKey target]-  debug verbosity $-    "Component build order: "-      ++ intercalate-        ", "-        ( map-            (showComponentName . componentLocalName . targetCLBI)-            componentsToBuild-        )+repl_setupHooks+  :: BuildHooks+  -- ^ build hook+  -> PackageDescription+  -- ^ Mostly information from the .cabal file+  -> LocalBuildInfo+  -- ^ Configuration information+  -> ReplFlags+  -- ^ Flags that the user passed to build+  -> [PPSuffixHandler]+  -- ^ preprocessors to run before compiling+  -> [String]+  -> IO ()+repl_setupHooks+  (BuildHooks{preBuildComponentRules = mbPbcRules})+  pkg_descr+  lbi+  flags+  suffixHandlers+  args = do+    let distPref = fromFlag (replDistPref flags)+        verbosity = fromFlag (replVerbosity flags) -  internalPackageDB <- createInternalPackageDB verbosity lbi distPref+    target <-+      readTargetInfos verbosity pkg_descr lbi args >>= \r -> case r of+        -- This seems DEEPLY questionable.+        [] -> case allTargetsInBuildOrder' pkg_descr lbi of+          (target : _) -> return target+          [] -> dieWithException verbosity $ FailedToDetermineTarget+        [target] -> return target+        _ -> dieWithException verbosity $ NoMultipleTargets+    let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi [nodeKey target]+    debug verbosity $+      "Component build order: "+        ++ intercalate+          ", "+          ( map+              (showComponentName . componentLocalName . targetCLBI)+              componentsToBuild+          ) -  let lbiForComponent comp lbi' =-        lbi'-          { withPackageDB = withPackageDB lbi ++ [internalPackageDB]-          , withPrograms =-              addInternalBuildTools-                pkg_descr-                lbi'-                (componentBuildInfo comp)-                (withPrograms lbi')-          }+    internalPackageDB <- createInternalPackageDB verbosity lbi distPref -  -- build any dependent components-  sequence_-    [ do-      let clbi = targetCLBI subtarget-          comp = targetComponent subtarget-          lbi' = lbiForComponent comp lbi-      preBuildComponent verbosity lbi subtarget-      buildComponent-        mempty{buildVerbosity = toFlag verbosity}-        NoFlag-        pkg_descr-        lbi'-        suffixes-        comp-        clbi-        distPref-    | subtarget <- safeInit componentsToBuild-    ]+    let lbiForComponent comp lbi' =+          lbi'+            { withPackageDB = withPackageDB lbi ++ [internalPackageDB]+            , withPrograms =+                -- Include any build-tool-depends on build tools internal to the current package.+                addInternalBuildTools+                  pkg_descr+                  lbi'+                  (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 -  -- REPL for target components-  let clbi = targetCLBI target-      comp = targetComponent target-      lbi' = lbiForComponent comp lbi-  preBuildComponent verbosity lbi target-  replComponent flags verbosity pkg_descr lbi' suffixes comp clbi distPref+    -- build any dependent components+    sequence_+      [ do+        let clbi = targetCLBI subtarget+            comp = targetComponent subtarget+            lbi' = lbiForComponent comp lbi+        preBuildComponent runPreBuildHooks verbosity lbi' subtarget+        buildComponent+          (mempty{buildCommonFlags = mempty{setupVerbosity = toFlag verbosity}})+          NoFlag+          pkg_descr+          lbi'+          suffixHandlers+          comp+          clbi+          distPref+      | subtarget <- safeInit componentsToBuild+      ] +    -- REPL for target components+    let clbi = targetCLBI target+        comp = targetComponent target+        lbi' = lbiForComponent comp lbi+    preBuildComponent runPreBuildHooks verbosity lbi' target+    replComponent flags verbosity pkg_descr lbi' suffixHandlers comp clbi distPref+ -- | Start an interpreter without loading any package files. startInterpreter   :: Verbosity@@ -358,18 +447,20 @@   -> [PPSuffixHandler]   -> Component   -> ComponentLocalBuildInfo-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -> IO (Maybe InstalledPackageInfo) buildComponent flags _ _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =-  dieWithException (fromFlag $ buildVerbosity flags) $ NoSupportBuildingTestSuite tt+  dieWithException (fromFlag $ buildVerbosity flags) $+    NoSupportBuildingTestSuite tt buildComponent flags _ _ _ _ (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt}) _ _ =-  dieWithException (fromFlag $ buildVerbosity flags) $ NoSupportBuildingBenchMark tt+  dieWithException (fromFlag $ buildVerbosity flags) $+    NoSupportBuildingBenchMark tt buildComponent   flags   numJobs   pkg_descr   lbi0-  suffixes+  suffixHandlers   comp@( CTest           test@TestSuite{testInterface = TestSuiteLibV09{}}         )@@ -380,11 +471,11 @@   -- built.   distPref =     do+      inplaceDir <- absoluteWorkingDirLBI lbi0       let verbosity = fromFlag $ buildVerbosity flags-      pwd <- getCurrentDirectory       let (pkg, lib, libClbi, lbi, ipi, exe, exeClbi) =-            testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd-      preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes+            testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 inplaceDir distPref+      preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers       extras <- preprocessExtras verbosity comp lbi -- TODO find cpphs processed files       (genDir, generatedExtras) <- generateCode (testCodeGenerators test) (testName test) pkg_descr (testBuildInfo test) lbi clbi verbosity       setupMessage'@@ -403,6 +494,7 @@         verbosity         (compiler lbi)         (withPrograms lbi)+        (mbWorkDirLBI lbi)         (withPackageDB lbi)         ipi         HcPkg.defaultRegisterOptions@@ -420,13 +512,13 @@   numJobs   pkg_descr   lbi-  suffixes+  suffixHandlers   comp   clbi   distPref =     do       let verbosity = fromFlag $ buildVerbosity flags-      preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes+      preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers       extras <- preprocessExtras verbosity comp lbi       setupMessage'         verbosity@@ -459,12 +551,12 @@             then do               -- Register the library in-place, so exes can depend               -- on internally defined libraries.-              pwd <- getCurrentDirectory+              inplaceDir <- absoluteWorkingDirLBI lbi               let                 -- The in place registration uses the "-inplace" suffix, not an ABI hash                 installedPkgInfo =                   inplaceInstalledPackageInfo-                    pwd+                    inplaceDir                     distPref                     pkg_descr                     -- NB: Use a fake ABI hash to avoid@@ -478,6 +570,7 @@                 verbosity                 (compiler lbi)                 (withPrograms lbi)+                (flagToMaybe $ buildWorkingDir flags)                 (withPackageDB lbi)                 installedPkgInfo                 HcPkg.defaultRegisterOptions@@ -519,24 +612,27 @@   -> LocalBuildInfo   -> ComponentLocalBuildInfo   -> Verbosity-  -> IO (FilePath, [ModuleName.ModuleName])+  -> IO (SymbolicPath Pkg (Dir Source), [ModuleName.ModuleName]) generateCode codeGens nm pdesc bi lbi clbi verbosity = do-  when (not . null $ codeGens) $ createDirectoryIfMissingVerbose verbosity True tgtDir+  when (not . null $ codeGens) $ createDirectoryIfMissingVerbose verbosity True $ i tgtDir   (\x -> (tgtDir, x)) . concat <$> mapM go codeGens   where     allLibs = (maybe id (:) $ library pdesc) (subLibraries pdesc)     dependencyLibs = filter (const True) allLibs -- intersect with componentPackageDeps of clbi     srcDirs = concatMap (hsSourceDirs . libBuildInfo) dependencyLibs     nm' = unUnqualComponentName nm-    tgtDir = buildDir lbi </> nm' </> nm' ++ "-gen"+    mbWorkDir = mbWorkDirLBI lbi+    i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path+    tgtDir = buildDir lbi </> makeRelativePathEx (nm' </> nm' ++ "-gen")     go :: String -> IO [ModuleName.ModuleName]     go codeGenProg =       fmap fromString . lines-        <$> getDbProgramOutput+        <$> getDbProgramOutputCwd           verbosity+          mbWorkDir           (simpleProgram codeGenProg)           (withPrograms lbi)-          ( (tgtDir : map getSymbolicPath srcDirs)+          ( map interpretSymbolicPathCWD (tgtDir : srcDirs)               ++ ( "--"                     : GHC.renderGhcOptions (compiler lbi) (hostPlatform lbi) (GHC.componentGhcOptions verbosity lbi bi clbi tgtDir)                  )@@ -544,35 +640,35 @@  -- | Add extra C sources generated by preprocessing to build -- information.-addExtraCSources :: BuildInfo -> [FilePath] -> BuildInfo+addExtraCSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo addExtraCSources bi extras = bi{cSources = new}   where     new = ordNub (extras ++ cSources bi)  -- | Add extra C++ sources generated by preprocessing to build -- information.-addExtraCxxSources :: BuildInfo -> [FilePath] -> BuildInfo+addExtraCxxSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo addExtraCxxSources bi extras = bi{cxxSources = new}   where     new = ordNub (extras ++ cxxSources bi)  -- | Add extra C-- sources generated by preprocessing to build -- information.-addExtraCmmSources :: BuildInfo -> [FilePath] -> BuildInfo+addExtraCmmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo addExtraCmmSources bi extras = bi{cmmSources = new}   where     new = ordNub (extras ++ cmmSources bi)  -- | Add extra ASM sources generated by preprocessing to build -- information.-addExtraAsmSources :: BuildInfo -> [FilePath] -> BuildInfo+addExtraAsmSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo addExtraAsmSources bi extras = bi{asmSources = new}   where     new = ordNub (extras ++ asmSources bi)  -- | Add extra JS sources generated by preprocessing to build -- information.-addExtraJsSources :: BuildInfo -> [FilePath] -> BuildInfo+addExtraJsSources :: BuildInfo -> [SymbolicPath Pkg File] -> BuildInfo addExtraJsSources bi extras = bi{jsSources = new}   where     new = ordNub (extras ++ jsSources bi)@@ -585,10 +681,10 @@     new = ordNub (extras ++ otherModules bi)  -- | Add extra source dir for generated modules.-addSrcDir :: BuildInfo -> FilePath -> BuildInfo+addSrcDir :: BuildInfo -> SymbolicPath Pkg (Dir Source) -> BuildInfo addSrcDir bi extra = bi{hsSourceDirs = new}   where-    new = ordNub (unsafeMakeSymbolicPath extra : hsSourceDirs bi)+    new = ordNub (extra : hsSourceDirs bi)  replComponent   :: ReplFlags@@ -598,7 +694,7 @@   -> [PPSuffixHandler]   -> Component   -> ComponentLocalBuildInfo-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -> IO () replComponent _ verbosity _ _ _ (CTest TestSuite{testInterface = TestSuiteUnsupported tt}) _ _ =   dieWithException verbosity $ NoSupportBuildingTestSuite tt@@ -609,16 +705,16 @@   verbosity   pkg_descr   lbi0-  suffixes+  suffixHandlers   comp@( CTest           test@TestSuite{testInterface = TestSuiteLibV09{}}         )   clbi   distPref = do-    pwd <- getCurrentDirectory+    inplaceDir <- absoluteWorkingDirLBI lbi0     let (pkg, lib, libClbi, lbi, _, _, _) =-          testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 distPref pwd-    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes+          testSuiteLibV09AsLibAndExe pkg_descr test clbi lbi0 inplaceDir distPref+    preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers     extras <- preprocessExtras verbosity comp lbi     let libbi = libBuildInfo lib         lib' = lib{libBuildInfo = libbi{cSources = cSources libbi ++ extras}}@@ -628,12 +724,12 @@   verbosity   pkg_descr   lbi-  suffixes+  suffixHandlers   comp   clbi   _ =     do-      preprocessComponent pkg_descr comp lbi clbi False verbosity suffixes+      preprocessComponent pkg_descr comp lbi clbi False verbosity suffixHandlers       extras <- preprocessExtras verbosity comp lbi       case comp of         CLib lib -> do@@ -693,8 +789,9 @@   -> TestSuite   -> ComponentLocalBuildInfo   -> LocalBuildInfo-  -> FilePath-  -> FilePath+  -> AbsolutePath (Dir Pkg)+  -- ^ absolute inplace dir+  -> SymbolicPath Pkg (Dir Dist)   -> ( PackageDescription      , Library      , ComponentLocalBuildInfo@@ -708,8 +805,8 @@   test@TestSuite{testInterface = TestSuiteLibV09 _ m}   clbi   lbi-  distPref-  pwd =+  inplaceDir+  distPref =     (pkg, lib, libClbi, lbi, ipi, exe, exeClbi)     where       bi = testBuildInfo test@@ -753,12 +850,7 @@           , testSuites = []           , subLibraries = [lib]           }-      ipi = inplaceInstalledPackageInfo pwd distPref pkg (mkAbiHash "") lib lbi libClbi-      testDir =-        buildDir lbi-          </> stubName test-          </> stubName test-          ++ "-tmp"+      ipi = inplaceInstalledPackageInfo inplaceDir distPref pkg (mkAbiHash "") lib lbi libClbi       testLibDep =         Dependency           pkgName'@@ -767,11 +859,11 @@       exe =         Executable           { exeName = mkUnqualComponentName $ stubName test-          , modulePath = stubFilePath test+          , modulePath = makeRelativePathEx $ stubFilePath test           , exeScope = ExecutablePublic           , buildInfo =               (testBuildInfo test)-                { hsSourceDirs = [unsafeMakeSymbolicPath testDir]+                { hsSourceDirs = [coerceSymbolicPath $ testBuildDir lbi test]                 , targetBuildDepends =                     testLibDep                       : targetBuildDepends (testBuildInfo test)@@ -811,16 +903,28 @@ createInternalPackageDB   :: Verbosity   -> LocalBuildInfo-  -> FilePath+  -> SymbolicPath Pkg (Dir Dist)   -> IO PackageDB createInternalPackageDB verbosity lbi distPref = do   existsAlready <- doesPackageDBExist dbPath   when existsAlready $ deletePackageDB dbPath   createPackageDB verbosity (compiler lbi) (withPrograms lbi) False dbPath-  return (SpecificPackageDB dbPath)+  return (SpecificPackageDB dbRelPath)   where-    dbPath = internalPackageDBPath lbi distPref+    dbRelPath = internalPackageDBPath lbi distPref+    dbPath = interpretSymbolicPathLBI lbi dbRelPath +-- | Update the program database to include any build-tool-depends specified+-- in the given 'BuildInfo' on build tools internal to the current package.+--+-- This function:+--+--  - adds these internal build tools to the 'ProgramDb', including+--    paths to their respective data directories,+--  - adds their paths to the current 'progSearchPath', and adds the data+--    directory environment variable for the current package to the current+--    'progOverrideEnv', so that any programs configured from now on will be+--    able to invoke these build tools. addInternalBuildTools   :: PackageDescription   -> LocalBuildInfo@@ -828,14 +932,31 @@   -> ProgramDb   -> ProgramDb addInternalBuildTools pkg lbi bi progs =-  foldr updateProgram progs internalBuildTools+  prependProgramSearchPathNoLogging+    internalToolPaths+    [pkgDataDirVar]+    $ foldr updateProgram progs internalBuildTools   where+    internalToolPaths = map (takeDirectory . programPath) internalBuildTools+    pkgDataDirVar = (pkgPathEnvVar pkg "datadir", Just dataDirPath)     internalBuildTools =-      [ simpleConfiguredProgram toolName' (FoundOnSystem toolLocation)+      [ (simpleConfiguredProgram toolName' (FoundOnSystem toolLocation))+        { programOverrideEnv = [pkgDataDirVar]+        }       | toolName <- getAllInternalToolDependencies pkg bi       , let toolName' = unUnqualComponentName toolName-      , let toolLocation = buildDir lbi </> toolName' </> toolName' <.> exeExtension (hostPlatform lbi)+      , let toolLocation =+              interpretSymbolicPathLBI lbi $+                buildDir lbi+                  </> makeRelativePathEx (toolName' </> toolName' <.> exeExtension (hostPlatform lbi))       ]+    mbWorkDir = mbWorkDirLBI lbi+    rawDataDir = dataDir pkg+    dataDirPath+      | null $ getSymbolicPath rawDataDir =+          interpretSymbolicPath mbWorkDir sameDirectory+      | otherwise =+          interpretSymbolicPath mbWorkDir rawDataDir  -- TODO: build separate libs in separate dirs so that we can build -- multiple libs, e.g. for 'LibTest' library-style test suites@@ -916,7 +1037,15 @@   let verbosity = fromFlag $ replVerbosity flags    in case compilerFlavor (compiler lbi) of         GHC -> GHC.replExe flags NoFlag pkg_descr lbi exe clbi-        GHCJS -> GHCJS.replExe (replOptionsFlags $ replReplOptions flags) verbosity NoFlag pkg_descr lbi exe clbi+        GHCJS ->+          GHCJS.replExe+            (replOptionsFlags $ replReplOptions flags)+            verbosity+            NoFlag+            pkg_descr+            lbi+            exe+            clbi         _ -> dieWithException verbosity REPLNotSupported  replFLib@@ -979,7 +1108,7 @@   -- ^ The verbosity to use   -> IO () componentInitialBuildSteps _distPref pkg_descr lbi clbi verbosity = do-  let compBuildDir = componentBuildDir lbi clbi+  let compBuildDir = interpretSymbolicPathLBI lbi $ componentBuildDir lbi clbi   createDirectoryIfMissingVerbose verbosity True compBuildDir   writeBuiltinAutogenFiles verbosity pkg_descr lbi clbi {-# DEPRECATED@@ -987,20 +1116,23 @@   "This function does not prepare all source files for a component. Suggestion: use 'Setup repl <compName> --repl-multi-file=<fn>'."   #-} --- | Pre-build steps for a component: creates the autogenerated files--- for a particular configured component.+-- | Creates the autogenerated files for a particular configured component,+-- and runs the pre-build hook. preBuildComponent-  :: Verbosity+  :: (LocalBuildInfo -> TargetInfo -> IO ())+  -- ^ pre-build hook+  -> Verbosity   -> LocalBuildInfo   -- ^ Configuration information   -> TargetInfo   -> IO ()-preBuildComponent verbosity lbi tgt = do+preBuildComponent preBuildHook verbosity lbi tgt = do   let pkg_descr = localPkgDescr lbi       clbi = targetCLBI tgt-      compBuildDir = componentBuildDir lbi clbi+      compBuildDir = interpretSymbolicPathLBI lbi $ componentBuildDir lbi clbi   createDirectoryIfMissingVerbose verbosity True compBuildDir   writeBuiltinAutogenFiles verbosity pkg_descr lbi clbi+  preBuildHook lbi tgt  -- | Generate and write to disk all built-in autogenerated files -- for the specified component. These files will be put in the@@ -1106,4 +1238,4 @@     -- Write the contents of the file.     rewriteFileLBS verbosity path contents   where-    autogenDir = autogenComponentModulesDir lbi clbi+    autogenDir = interpretSymbolicPathLBI lbi $ autogenComponentModulesDir lbi clbi

@@ -18,13 +18,17 @@   , BuildingWhat (..)   , LocalBuildInfo (..)   , TargetInfo (..)+  , buildingWhatCommonFlags   , buildingWhatVerbosity+  , buildingWhatWorkingDir   , buildingWhatDistPref   ) where  import Distribution.Simple.Compiler-import Distribution.Simple.Setup (BuildingWhat (..), buildingWhatDistPref, buildingWhatVerbosity)+import Distribution.Simple.Setup hiding+  ( BuildFlags (buildVerbosity)+  ) import Distribution.Types.BuildInfo import Distribution.Types.Component import Distribution.Types.ComponentLocalBuildInfo

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} @@ -18,6 +19,9 @@   , srcPref   , buildInfoPref   , haddockDirName+  , haddockLibraryDirPath+  , haddockTestDirPath+  , haddockBenchmarkDirPath   , hscolourPref   , haddockPref   , autogenPackageModulesDir@@ -25,12 +29,17 @@   , autogenPathsModuleName   , autogenPackageInfoModuleName   , cppHeaderName-  , haddockName+  , haddockPath+  , haddockPackageLibraryName+  , haddockPackageLibraryName'+  , haddockLibraryName+  , haddockLibraryPath   , mkGenericStaticLibName   , mkLibName   , mkProfLibName   , mkGenericSharedLibName   , mkSharedLibName+  , mkProfSharedLibName   , mkStaticLibName   , mkGenericSharedBundledLibName   , exeExtension@@ -42,9 +51,14 @@   , getSourceFiles   , getLibSourceFiles   , getExeSourceFiles+  , getTestSourceFiles+  , getBenchmarkSourceFiles   , getFLibSourceFiles   , exeBuildDir   , flibBuildDir+  , stubName+  , testBuildDir+  , benchmarkBuildDir   ) where  import Distribution.Compat.Prelude@@ -59,13 +73,12 @@ import Distribution.Simple.Errors import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PreProcess.Types (builtinHaskellSuffixes)-import Distribution.Simple.Setup.Common (defaultDistPref)+import Distribution.Simple.Setup.Common import Distribution.Simple.Setup.Haddock (HaddockTarget (..)) import Distribution.Simple.Utils import Distribution.System import Distribution.Utils.Path import Distribution.Verbosity-import System.FilePath (normalise, (<.>), (</>))  -- --------------------------------------------------------------------------- -- Build directories and files@@ -73,33 +86,77 @@ srcPref :: FilePath -> FilePath srcPref distPref = distPref </> "src" -hscolourPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath+hscolourPref+  :: HaddockTarget+  -> SymbolicPath root (Dir Dist)+  -> PackageDescription+  -> SymbolicPath root (Dir Artifacts) hscolourPref = haddockPref  -- | Build info json file, generated in every build-buildInfoPref :: FilePath -> FilePath-buildInfoPref distPref = distPref </> "build-info.json"+buildInfoPref+  :: SymbolicPath root (Dir Dist)+  -> SymbolicPath root File+buildInfoPref distPref = distPref </> makeRelativePathEx "build-info.json"  -- | This is the name of the directory in which the generated haddocks -- should be stored. It does not include the @<dist>/doc/html@ prefix.+--+-- It is also used by `haddock-project` when constructing its output directory. haddockDirName :: HaddockTarget -> PackageDescription -> FilePath haddockDirName ForDevelopment = prettyShow . packageName haddockDirName ForHackage = (++ "-docs") . prettyShow . packageId +-- | This is the name of the directory in which the generated haddocks for+-- a (sub)library should be stored. It does not include the @<dist>/doc/html@+-- prefix.+--+-- It is also used by `haddock-project` when constructing its output directory.+haddockLibraryDirPath+  :: HaddockTarget+  -> PackageDescription+  -> Library+  -> FilePath+haddockLibraryDirPath haddockTarget pkg_descr lib =+  case libName lib of+    LSubLibName sublib_name ->+      haddockDirName haddockTarget pkg_descr </> prettyShow sublib_name+    _ -> haddockDirName haddockTarget pkg_descr++haddockTestDirPath+  :: HaddockTarget+  -> PackageDescription+  -> TestSuite+  -> FilePath+haddockTestDirPath haddockTarget pkg_descr test =+  haddockDirName haddockTarget pkg_descr </> prettyShow (testName test)++haddockBenchmarkDirPath+  :: HaddockTarget+  -> PackageDescription+  -> Benchmark+  -> FilePath+haddockBenchmarkDirPath haddockTarget pkg_descr bench =+  haddockDirName haddockTarget pkg_descr </> prettyShow (benchmarkName bench)+ -- | The directory to which generated haddock documentation should be written.-haddockPref :: HaddockTarget -> FilePath -> PackageDescription -> FilePath+haddockPref+  :: HaddockTarget+  -> SymbolicPath root (Dir Dist)+  -> PackageDescription+  -> SymbolicPath root (Dir Artifacts) haddockPref haddockTarget distPref pkg_descr =-  distPref </> "doc" </> "html" </> haddockDirName haddockTarget pkg_descr+  distPref </> makeRelativePathEx ("doc" </> "html" </> haddockDirName haddockTarget pkg_descr)  -- | The directory in which we put auto-generated modules for EVERY -- component in the package.-autogenPackageModulesDir :: LocalBuildInfo -> String-autogenPackageModulesDir lbi = buildDir lbi </> "global-autogen"+autogenPackageModulesDir :: LocalBuildInfo -> SymbolicPath Pkg (Dir Source)+autogenPackageModulesDir lbi = buildDir lbi </> makeRelativePathEx "global-autogen"  -- | The directory in which we put auto-generated modules for a -- particular component.-autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> String-autogenComponentModulesDir lbi clbi = componentBuildDir lbi clbi </> "autogen"+autogenComponentModulesDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> SymbolicPath Pkg (Dir Source)+autogenComponentModulesDir lbi clbi = componentBuildDir lbi clbi </> makeRelativePathEx "autogen"  -- NB: Look at 'checkForeignDeps' for where a simplified version of this -- has been copy-pasted.@@ -125,9 +182,36 @@     fixchar '-' = '_'     fixchar c = c -haddockName :: PackageDescription -> FilePath-haddockName pkg_descr = prettyShow (packageName pkg_descr) <.> "haddock"+haddockPath :: PackageDescription -> FilePath+haddockPath pkg_descr = prettyShow (packageName pkg_descr) <.> "haddock" +-- | A name of a (sub)library used by haddock, in the form+-- `<package>:<library>` if it is a sublibrary, or `<package>` if it is the+-- main library.+--+-- Used by `haddock-project` and `Distribution.Simple.Haddock`.+haddockPackageLibraryName :: PackageDescription -> Library -> String+haddockPackageLibraryName pkg_descr lib =+  haddockPackageLibraryName' (packageName pkg_descr) (libName lib)++haddockPackageLibraryName' :: PackageName -> LibraryName -> String+haddockPackageLibraryName' pkg_name lib_name =+  case lib_name of+    LSubLibName sublib_name ->+      prettyShow pkg_name ++ ":" ++ prettyShow sublib_name+    LMainLibName -> prettyShow pkg_name++-- | A name of a (sub)library used by haddock.+haddockLibraryName :: PackageDescription -> Library -> String+haddockLibraryName pkg_descr lib =+  case libName lib of+    LSubLibName sublib_name -> prettyShow sublib_name+    LMainLibName -> prettyShow (packageName pkg_descr)++-- | File path of the ".haddock" file.+haddockLibraryPath :: PackageDescription -> Library -> FilePath+haddockLibraryPath pkg_descr lib = haddockLibraryName pkg_descr lib <.> "haddock"+ -- ----------------------------------------------------------------------------- -- Source File helper @@ -136,14 +220,16 @@   -> LocalBuildInfo   -> Library   -> ComponentLocalBuildInfo-  -> IO [(ModuleName.ModuleName, FilePath)]-getLibSourceFiles verbosity lbi lib clbi = getSourceFiles verbosity searchpaths modules+  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg File)]+getLibSourceFiles verbosity lbi lib clbi =+  getSourceFiles verbosity mbWorkDir searchpaths modules   where     bi = libBuildInfo lib     modules = allLibModules lib clbi+    mbWorkDir = mbWorkDirLBI lbi     searchpaths =-      componentBuildDir lbi clbi-        : map getSymbolicPath (hsSourceDirs bi)+      coerceSymbolicPath (componentBuildDir lbi clbi)+        : hsSourceDirs bi         ++ [ autogenComponentModulesDir lbi clbi            , autogenPackageModulesDir lbi            ]@@ -153,61 +239,133 @@   -> LocalBuildInfo   -> Executable   -> ComponentLocalBuildInfo-  -> IO [(ModuleName.ModuleName, FilePath)]+  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)] getExeSourceFiles verbosity lbi exe clbi = do-  moduleFiles <- getSourceFiles verbosity searchpaths modules-  srcMainPath <- findFileEx verbosity (map getSymbolicPath $ hsSourceDirs bi) (modulePath exe)+  moduleFiles <- getSourceFiles verbosity mbWorkDir searchpaths modules+  srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) (modulePath exe)   return ((ModuleName.main, srcMainPath) : moduleFiles)   where+    mbWorkDir = mbWorkDirLBI lbi     bi = buildInfo exe     modules = otherModules bi     searchpaths =       autogenComponentModulesDir lbi clbi         : autogenPackageModulesDir lbi-        : exeBuildDir lbi exe-        : map getSymbolicPath (hsSourceDirs bi)+        : coerceSymbolicPath (exeBuildDir lbi exe)+        : hsSourceDirs bi +getTestSourceFiles+  :: Verbosity+  -> LocalBuildInfo+  -> TestSuite+  -> ComponentLocalBuildInfo+  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)]+getTestSourceFiles verbosity lbi test@TestSuite{testInterface = TestSuiteExeV10 _ path} clbi = do+  moduleFiles <- getSourceFiles verbosity mbWorkDir searchpaths modules+  srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) path+  return ((ModuleName.main, srcMainPath) : moduleFiles)+  where+    mbWorkDir = mbWorkDirLBI lbi+    bi = testBuildInfo test+    modules = otherModules bi+    searchpaths =+      autogenComponentModulesDir lbi clbi+        : autogenPackageModulesDir lbi+        : coerceSymbolicPath (testBuildDir lbi test)+        : hsSourceDirs bi+getTestSourceFiles _ _ _ _ = return []++getBenchmarkSourceFiles+  :: Verbosity+  -> LocalBuildInfo+  -> Benchmark+  -> ComponentLocalBuildInfo+  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg 'File)]+getBenchmarkSourceFiles verbosity lbi bench@Benchmark{benchmarkInterface = BenchmarkExeV10 _ path} clbi = do+  moduleFiles <- getSourceFiles verbosity mbWorkDir searchpaths modules+  srcMainPath <- findFileCwd verbosity mbWorkDir (hsSourceDirs bi) path+  return ((ModuleName.main, srcMainPath) : moduleFiles)+  where+    mbWorkDir = mbWorkDirLBI lbi+    bi = benchmarkBuildInfo bench+    modules = otherModules bi+    searchpaths =+      autogenComponentModulesDir lbi clbi+        : autogenPackageModulesDir lbi+        : coerceSymbolicPath (benchmarkBuildDir lbi bench)+        : hsSourceDirs bi+getBenchmarkSourceFiles _ _ _ _ = return []+ getFLibSourceFiles   :: Verbosity   -> LocalBuildInfo   -> ForeignLib   -> ComponentLocalBuildInfo-  -> IO [(ModuleName.ModuleName, FilePath)]-getFLibSourceFiles verbosity lbi flib clbi = getSourceFiles verbosity searchpaths modules+  -> IO [(ModuleName.ModuleName, SymbolicPath Pkg File)]+getFLibSourceFiles verbosity lbi flib clbi =+  getSourceFiles verbosity mbWorkDir searchpaths modules   where     bi = foreignLibBuildInfo flib     modules = otherModules bi+    mbWorkDir = mbWorkDirLBI lbi     searchpaths =       autogenComponentModulesDir lbi clbi         : autogenPackageModulesDir lbi-        : flibBuildDir lbi flib-        : map getSymbolicPath (hsSourceDirs bi)+        : coerceSymbolicPath (flibBuildDir lbi flib)+        : hsSourceDirs bi  getSourceFiles   :: Verbosity-  -> [FilePath]+  -> Maybe (SymbolicPath CWD ('Dir Pkg))+  -> [SymbolicPathX allowAbsolute Pkg (Dir Source)]   -> [ModuleName.ModuleName]-  -> IO [(ModuleName.ModuleName, FilePath)]-getSourceFiles verbosity dirs modules = flip traverse modules $ \m ->+  -> IO [(ModuleName.ModuleName, SymbolicPathX allowAbsolute Pkg File)]+getSourceFiles verbosity mbWorkDir dirs modules = flip traverse modules $ \m ->   fmap ((,) m) $-    findFileWithExtension builtinHaskellSuffixes dirs (ModuleName.toFilePath m)-      >>= maybe (notFound m) (return . normalise)+    findFileCwdWithExtension+      mbWorkDir+      builtinHaskellSuffixes+      dirs+      (moduleNameSymbolicPath m)+      >>= maybe (notFound m) (return . normaliseSymbolicPath)   where     notFound module_ =       dieWithException verbosity $ CantFindSourceModule module_  -- | The directory where we put build results for an executable-exeBuildDir :: LocalBuildInfo -> Executable -> FilePath-exeBuildDir lbi exe = buildDir lbi </> nm </> nm ++ "-tmp"+exeBuildDir :: LocalBuildInfo -> Executable -> SymbolicPath Pkg (Dir Build)+exeBuildDir lbi exe = buildDir lbi </> makeRelativePathEx (nm </> nm ++ "-tmp")   where     nm = unUnqualComponentName $ exeName exe  -- | The directory where we put build results for a foreign library-flibBuildDir :: LocalBuildInfo -> ForeignLib -> FilePath-flibBuildDir lbi flib = buildDir lbi </> nm </> nm ++ "-tmp"+flibBuildDir :: LocalBuildInfo -> ForeignLib -> SymbolicPath Pkg (Dir Build)+flibBuildDir lbi flib = buildDir lbi </> makeRelativePathEx (nm </> nm ++ "-tmp")   where     nm = unUnqualComponentName $ foreignLibName flib +-- | The name of the stub executable associated with a library 'TestSuite'.+stubName :: TestSuite -> FilePath+stubName t = unUnqualComponentName (testName t) ++ "Stub"++-- | The directory where we put build results for a test suite+testBuildDir :: LocalBuildInfo -> TestSuite -> SymbolicPath Pkg (Dir Build)+testBuildDir lbi tst =+  buildDir lbi </> makeRelativePathEx testDir+  where+    testDir = case testInterface tst of+      TestSuiteLibV09{} ->+        stubName tst </> stubName tst ++ "-tmp"+      _ -> nm </> nm ++ "-tmp"+    nm = unUnqualComponentName $ testName tst++-- | The directory where we put build results for a benchmark suite+benchmarkBuildDir :: LocalBuildInfo -> Benchmark -> SymbolicPath Pkg (Dir Build)+benchmarkBuildDir lbi bm =+  buildDir lbi </> makeRelativePathEx (nm </> nm ++ "-tmp")+  where+    nm = unUnqualComponentName $ benchmarkName bm+ -- --------------------------------------------------------------------------- -- Library file names @@ -237,6 +395,10 @@ mkSharedLibName :: Platform -> CompilerId -> UnitId -> String mkSharedLibName platform comp lib =   mkGenericSharedLibName platform comp (getHSLibraryName lib)++mkProfSharedLibName :: Platform -> CompilerId -> UnitId -> String+mkProfSharedLibName platform comp lib =+  mkGenericSharedLibName platform comp (getHSLibraryName lib ++ "_p")  -- Static libs are named the same as shared libraries, only with -- a different extension.

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}@@ -496,12 +497,12 @@     , cinfoStrName = componentStringName pkg (componentName c)     , cinfoSrcDirs = map getSymbolicPath $ hsSourceDirs bi     , cinfoModules = componentModules c-    , cinfoHsFiles = componentHsFiles c-    , cinfoAsmFiles = asmSources bi-    , cinfoCmmFiles = cmmSources bi-    , cinfoCFiles = cSources bi-    , cinfoCxxFiles = cxxSources bi-    , cinfoJsFiles = jsSources bi+    , cinfoHsFiles = map getSymbolicPath $ componentHsFiles c+    , cinfoAsmFiles = map getSymbolicPath $ asmSources bi+    , cinfoCmmFiles = map getSymbolicPath $ cmmSources bi+    , cinfoCFiles = map getSymbolicPath $ cSources bi+    , cinfoCxxFiles = map getSymbolicPath $ cxxSources bi+    , cinfoJsFiles = map getSymbolicPath $ jsSources bi     }   | c <- pkgComponents pkg   , let bi = componentBuildInfo c@@ -529,7 +530,7 @@ componentModules (CTest test) = testModules test componentModules (CBench bench) = benchmarkModules bench -componentHsFiles :: Component -> [FilePath]+componentHsFiles :: Component -> [RelativePath Source File] componentHsFiles (CExe exe) = [modulePath exe] componentHsFiles   ( CTest

@@ -0,0 +1,14 @@+{-# LANGUAGE LambdaCase #-}++module Distribution.Simple.BuildWay 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_"

@@ -1,6 +1,8 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}  ----------------------------------------------------------------------------- @@ -64,6 +66,7 @@      -- * Option Descriptions   , OptDescr (..)+  , fmapOptDescr   , Description   , SFlags   , LFlags@@ -150,6 +153,16 @@       OptFlags {-False-}       (Bool -> a -> a)       (a -> Maybe Bool)++fmapOptDescr :: forall a b. (b -> a) -> (a -> (b -> b)) -> OptDescr a -> OptDescr b+fmapOptDescr x u = \case+  ReqArg d o p upd get -> ReqArg d o p (fmap m upd) (get . x)+  OptArg d o p upd (str, g) get -> OptArg d o p (fmap m upd) (str, m g) (get . x)+  ChoiceOpt opts -> ChoiceOpt $ fmap (\(d, o, upd, get) -> (d, o, m upd, get . x)) opts+  BoolOpt d true false upd get -> BoolOpt d true false (\b -> m $ upd b) (get . x)+  where+    m :: (a -> a) -> (b -> b)+    m upd_a b = u (upd_a $ x b) b  -- | Short command line option strings type SFlags = [Char]

@@ -1,5 +1,9 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}  ----------------------------------------------------------------------------- @@ -34,11 +38,21 @@   , compilerInfo      -- * Support for package databases-  , PackageDB (..)+  , PackageDB   , PackageDBStack+  , PackageDBCWD+  , PackageDBStackCWD+  , PackageDBX (..)+  , PackageDBStackX+  , PackageDBS+  , PackageDBStackS   , registrationPackageDB   , absolutePackageDBPaths   , absolutePackageDBPath+  , interpretPackageDB+  , interpretPackageDBStack+  , coercePackageDB+  , coercePackageDBStack      -- * Support for optimisation levels   , OptimisationLevel (..)@@ -62,6 +76,11 @@   , unitIdSupported   , coverageSupported   , profilingSupported+  , profilingDynamicSupported+  , profilingDynamicSupportedOrUnknown+  , profilingVanillaSupported+  , profilingVanillaSupportedOrUnknown+  , dynamicSupported   , backpackSupported   , arResponseFilesSupported   , arDashLSupported@@ -82,7 +101,9 @@  import Distribution.Compiler import Distribution.Simple.Utils+import Distribution.Utils.Path import Distribution.Version+ import Language.Haskell.Extension  import qualified Data.Map as Map (lookup)@@ -172,14 +193,17 @@ --  the file system. This can be used to build isolated environments of --  packages, for example to build a collection of related packages --  without installing them globally.-data PackageDB+--+--  Abstracted over+data PackageDBX fp   = GlobalPackageDB   | UserPackageDB-  | SpecificPackageDB FilePath-  deriving (Eq, Generic, Ord, Show, Read, Typeable)+  | -- | NB: the path might be relative or it might be absolute+    SpecificPackageDB fp+  deriving (Eq, Generic, Ord, Show, Read, Typeable, Functor, Foldable, Traversable) -instance Binary PackageDB-instance Structured PackageDB+instance Binary fp => Binary (PackageDBX fp)+instance Structured fp => Structured (PackageDBX fp)  -- | We typically get packages from several databases, and stack them -- together. This type lets us be explicit about that stacking. For example@@ -196,25 +220,64 @@ -- we can use several custom package dbs and the user package db together. -- -- When it comes to writing, the top most (last) package is used.-type PackageDBStack = [PackageDB]+type PackageDBStackX from = [PackageDBX from] +type PackageDB = PackageDBX (SymbolicPath Pkg (Dir PkgDB))+type PackageDBStack = PackageDBStackX (SymbolicPath Pkg (Dir PkgDB))++type PackageDBS from = PackageDBX (SymbolicPath from (Dir PkgDB))+type PackageDBStackS from = PackageDBStackX (SymbolicPath from (Dir PkgDB))++type PackageDBCWD = PackageDBX FilePath+type PackageDBStackCWD = PackageDBStackX FilePath+ -- | Return the package that we should register into. This is the package db at -- the top of the stack.-registrationPackageDB :: PackageDBStack -> PackageDB+registrationPackageDB :: PackageDBStackX from -> PackageDBX from registrationPackageDB dbs = case safeLast dbs of   Nothing -> error "internal error: empty package db set"   Just p -> p  -- | Make package paths absolute-absolutePackageDBPaths :: PackageDBStack -> IO PackageDBStack-absolutePackageDBPaths = traverse absolutePackageDBPath+absolutePackageDBPaths+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -> PackageDBStack+  -> IO PackageDBStack+absolutePackageDBPaths mbWorkDir = traverse $ absolutePackageDBPath mbWorkDir -absolutePackageDBPath :: PackageDB -> IO PackageDB-absolutePackageDBPath GlobalPackageDB = return GlobalPackageDB-absolutePackageDBPath UserPackageDB = return UserPackageDB-absolutePackageDBPath (SpecificPackageDB db) =-  SpecificPackageDB `liftM` canonicalizePath db+absolutePackageDBPath+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -> PackageDB+  -> IO PackageDB+absolutePackageDBPath _ GlobalPackageDB = return GlobalPackageDB+absolutePackageDBPath _ UserPackageDB = return UserPackageDB+absolutePackageDBPath mbWorkDir (SpecificPackageDB db) = do+  let db' =+        case symbolicPathRelative_maybe db of+          Nothing -> getSymbolicPath db+          Just rel_path -> interpretSymbolicPath mbWorkDir rel_path+  SpecificPackageDB . makeSymbolicPath <$> canonicalizePath db' +interpretPackageDB :: Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDB -> PackageDBCWD+interpretPackageDB _ GlobalPackageDB = GlobalPackageDB+interpretPackageDB _ UserPackageDB = UserPackageDB+interpretPackageDB mbWorkDir (SpecificPackageDB db) =+  SpecificPackageDB (interpretSymbolicPath mbWorkDir db)++interpretPackageDBStack :: Maybe (SymbolicPath CWD (Dir Pkg)) -> PackageDBStack -> PackageDBStackCWD+interpretPackageDBStack mbWorkDir = map (interpretPackageDB mbWorkDir)++-- | Transform a package db using a FilePath into one using symbolic paths.+coercePackageDB :: PackageDBCWD -> PackageDBX (SymbolicPath CWD (Dir PkgDB))+coercePackageDB GlobalPackageDB = GlobalPackageDB+coercePackageDB UserPackageDB = UserPackageDB+coercePackageDB (SpecificPackageDB db) = SpecificPackageDB (makeSymbolicPath db)++coercePackageDBStack+  :: [PackageDBCWD]+  -> [PackageDBX (SymbolicPath CWD (Dir PkgDB))]+coercePackageDBStack = map coercePackageDB+ -- ------------------------------------------------------------  -- * Optimisation levels@@ -412,6 +475,49 @@     GHC -> True     GHCJS -> True     _ -> False++-- | Returns Just if we can certainly determine whether a way is supported+-- if we don't know, return Nothing+waySupported :: String -> Compiler -> Maybe Bool+waySupported way comp =+  case compilerFlavor comp of+    GHC ->+      -- Infomation about compiler ways is only accurately reported after+      -- 9.10.1. Which is useful as this is before profiling dynamic support+      -- was introduced. (See GHC #24881)+      if compilerVersion comp >= mkVersion [9, 10, 1]+        then case Map.lookup "RTS ways" (compilerProperties comp) of+          Just ways -> Just (way `elem` words ways)+          Nothing -> Just False+        else Nothing+    _ -> Nothing++-- | Either profiling is definitely supported or we don't know (so assume+-- it is)+profilingVanillaSupportedOrUnknown :: Compiler -> Bool+profilingVanillaSupportedOrUnknown comp = profilingVanillaSupported comp `elem` [Just True, Nothing]++-- | Is the compiler distributed with profiling libraries+profilingVanillaSupported :: Compiler -> Maybe Bool+profilingVanillaSupported comp = waySupported "p" comp++-- | Is the compiler distributed with profiling dynamic libraries+profilingDynamicSupported :: Compiler -> Maybe Bool+profilingDynamicSupported comp =+  -- Certainly not before this version, as it was not implemented yet.+  if compilerVersion comp <= mkVersion [9, 11, 0]+    then Just False+    else waySupported "p_dyn" comp++-- | Either profiling dynamic is definitely supported or we don't know (so assume+-- it is)+profilingDynamicSupportedOrUnknown :: Compiler -> Bool+profilingDynamicSupportedOrUnknown comp =+  profilingDynamicSupported comp `elem` [Just True, Nothing]++-- | Is the compiler distributed with dynamic libraries+dynamicSupported :: Compiler -> Maybe Bool+dynamicSupported comp = waySupported "dyn" comp  -- | Does this compiler support a package database entry with: -- "visibility"?

@@ -1,3 +1,4 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-}@@ -31,6 +32,7 @@ -- level. module Distribution.Simple.Configure   ( configure+  , configure_setupHooks   , writePersistBuildConfig   , getConfigStateFile   , getPersistBuildConfig@@ -79,15 +81,28 @@ import Distribution.PackageDescription.PrettyPrint import Distribution.Simple.BuildTarget import Distribution.Simple.BuildToolDepends+import Distribution.Simple.BuildWay import Distribution.Simple.Compiler import Distribution.Simple.LocalBuildInfo import Distribution.Simple.PackageIndex (InstalledPackageIndex, lookupUnitId) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PreProcess import Distribution.Simple.Program-import Distribution.Simple.Program.Db (lookupProgramByName, modifyProgramSearchPath, prependProgramSearchPath)+import Distribution.Simple.Program.Db+  ( ProgramDb (..)+  , lookupProgramByName+  , modifyProgramSearchPath+  , prependProgramSearchPath+  , updateConfiguredProgs+  ) import Distribution.Simple.Setup.Common as Setup import Distribution.Simple.Setup.Config as Setup+import Distribution.Simple.SetupHooks.Internal+  ( ConfigureHooks (..)+  , applyComponentDiffs+  , noConfigureHooks+  )+import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks import Distribution.Simple.Utils import Distribution.System import Distribution.Types.ComponentRequestedSpec@@ -131,6 +146,9 @@   , pretty   , prettyShow   )+import Distribution.Simple.Errors+import Distribution.Types.AnnotatedId+import Distribution.Utils.Path import Distribution.Utils.Structured (structuredDecodeOrFailIO, structuredEncode) import System.Directory   ( canonicalizePath@@ -141,8 +159,6 @@   ) import System.FilePath   ( isAbsolute-  , takeDirectory-  , (</>)   ) import System.IO   ( hClose@@ -165,8 +181,6 @@ import qualified Data.Maybe as M import qualified Data.Set as Set import qualified Distribution.Compat.NonEmptySet as NES-import Distribution.Simple.Errors-import Distribution.Types.AnnotatedId  type UseExternalInternalDeps = Bool @@ -180,6 +194,9 @@     ConfigStateFileNoParse   | -- | No file!     ConfigStateFileMissing+      { cfgStateFileErrorCwd :: Maybe (SymbolicPath CWD (Dir Pkg))+      , cfgStateFileErrorFile :: SymbolicPath Pkg File+      }   | -- | Mismatched version.     ConfigStateFileBadVersion       PackageIdentifier@@ -191,20 +208,20 @@ dispConfigStateFileError :: ConfigStateFileError -> Doc dispConfigStateFileError ConfigStateFileNoHeader =   text "Saved package config file header is missing."-    <+> text "Re-run the 'configure' command."+    <+> text "Re-run the 'Setup configure' command." dispConfigStateFileError ConfigStateFileBadHeader =   text "Saved package config file header is corrupt."-    <+> text "Re-run the 'configure' command."+    <+> text "Re-run the 'Setup configure' command." dispConfigStateFileError ConfigStateFileNoParse =   text "Saved package config file is corrupt."-    <+> text "Re-run the 'configure' command."-dispConfigStateFileError ConfigStateFileMissing =-  text "Run the 'configure' command first."+    <+> text "Re-run the 'Setup configure' command."+dispConfigStateFileError ConfigStateFileMissing{} =+  text "Run the 'Setup configure' command first." dispConfigStateFileError (ConfigStateFileBadVersion oldCabal oldCompiler _) =   text "Saved package config file is outdated:"     $+$ badCabal     $+$ badCompiler-    $+$ text "Re-run the 'configure' command."+    $+$ text "Re-run the 'Setup configure' command."   where     badCabal =       text "• the Cabal version changed from"@@ -228,12 +245,14 @@ -- missing, if the file cannot be read, or if the file was created by an older -- version of Cabal. getConfigStateFile-  :: FilePath+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -> SymbolicPath Pkg File   -- ^ The file path of the @setup-config@ file.   -> IO LocalBuildInfo-getConfigStateFile filename = do+getConfigStateFile mbWorkDir setupConfigFile = do+  let filename = interpretSymbolicPath mbWorkDir setupConfigFile   exists <- doesFileExist filename-  unless exists $ throwIO ConfigStateFileMissing+  unless exists $ throwIO $ ConfigStateFileMissing mbWorkDir setupConfigFile   -- Read the config file into a strict ByteString to avoid problems with   -- lazy I/O, then convert to lazy because the binary package needs that.   contents <- BS.readFile filename@@ -258,48 +277,60 @@ -- | Read the 'localBuildInfoFile', returning either an error or the local build -- info. tryGetConfigStateFile-  :: FilePath+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -- ^ Working directory.+  -> SymbolicPath Pkg File   -- ^ The file path of the @setup-config@ file.   -> IO (Either ConfigStateFileError LocalBuildInfo)-tryGetConfigStateFile = try . getConfigStateFile+tryGetConfigStateFile mbWorkDir = try . getConfigStateFile mbWorkDir  -- | Try to read the 'localBuildInfoFile'. tryGetPersistBuildConfig-  :: FilePath+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -- ^ Working directory.+  -> SymbolicPath Pkg (Dir Dist)   -- ^ The @dist@ directory path.   -> IO (Either ConfigStateFileError LocalBuildInfo)-tryGetPersistBuildConfig = try . getPersistBuildConfig+tryGetPersistBuildConfig mbWorkDir = try . getPersistBuildConfig mbWorkDir  -- | Read the 'localBuildInfoFile'. Throw an exception if the file is -- missing, if the file cannot be read, or if the file was created by an older -- version of Cabal. getPersistBuildConfig-  :: FilePath+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -- ^ Working directory.+  -> SymbolicPath Pkg (Dir Dist)   -- ^ The @dist@ directory path.   -> IO LocalBuildInfo-getPersistBuildConfig = getConfigStateFile . localBuildInfoFile+getPersistBuildConfig mbWorkDir distPref =+  getConfigStateFile mbWorkDir $ localBuildInfoFile distPref  -- | Try to read the 'localBuildInfoFile'. maybeGetPersistBuildConfig-  :: FilePath+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -- ^ Working directory.+  -> SymbolicPath Pkg (Dir Dist)   -- ^ The @dist@ directory path.   -> IO (Maybe LocalBuildInfo)-maybeGetPersistBuildConfig =-  liftM (either (const Nothing) Just) . tryGetPersistBuildConfig+maybeGetPersistBuildConfig mbWorkDir =+  liftM (either (const Nothing) Just) . tryGetPersistBuildConfig mbWorkDir  -- | After running configure, output the 'LocalBuildInfo' to the -- 'localBuildInfoFile'. writePersistBuildConfig-  :: FilePath+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -- ^ Working directory+  -> SymbolicPath Pkg (Dir Dist)   -- ^ The @dist@ directory path.   -> LocalBuildInfo   -- ^ The 'LocalBuildInfo' to write.   -> IO ()-writePersistBuildConfig distPref lbi = do-  createDirectoryIfMissing False distPref-  writeFileAtomic (localBuildInfoFile distPref) $+writePersistBuildConfig mbWorkDir distPref lbi = do+  createDirectoryIfMissing False (i distPref)+  writeFileAtomic (i $ localBuildInfoFile distPref) $     BLC8.unlines [showHeader pkgId, structuredEncode lbi]   where+    i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path     pkgId = localPackage lbi  -- | Identifier of the current Cabal package.@@ -359,16 +390,22 @@  -- | Check that localBuildInfoFile is up-to-date with respect to the -- .cabal file.-checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool-checkPersistBuildConfigOutdated distPref pkg_descr_file =-  pkg_descr_file `moreRecentFile` localBuildInfoFile distPref+checkPersistBuildConfigOutdated+  :: Maybe (SymbolicPath CWD (Dir Pkg))+  -> SymbolicPath Pkg (Dir Dist)+  -> SymbolicPath Pkg File+  -> IO Bool+checkPersistBuildConfigOutdated mbWorkDir distPref pkg_descr_file =+  i pkg_descr_file `moreRecentFile` i (localBuildInfoFile distPref)+  where+    i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path  -- | Get the path of @dist\/setup-config@. localBuildInfoFile-  :: FilePath+  :: SymbolicPath Pkg (Dir Dist)   -- ^ The @dist@ directory path.-  -> FilePath-localBuildInfoFile distPref = distPref </> "setup-config"+  -> SymbolicPath Pkg File+localBuildInfoFile distPref = distPref </> makeRelativePathEx "setup-config"  -- ----------------------------------------------------------------------------- @@ -380,18 +417,18 @@ -- from (in order of highest to lowest preference) the override prefix, the -- \"CABAL_BUILDDIR\" environment variable, or the default prefix. findDistPref-  :: FilePath+  :: SymbolicPath Pkg (Dir Dist)   -- ^ default \"dist\" prefix-  -> Setup.Flag FilePath+  -> Setup.Flag (SymbolicPath Pkg (Dir Dist))   -- ^ override \"dist\" prefix-  -> IO FilePath+  -> IO (SymbolicPath Pkg (Dir Dist)) findDistPref defDistPref overrideDistPref = do   envDistPref <- liftM parseEnvDistPref (lookupEnv "CABAL_BUILDDIR")   return $ fromFlagOrDefault defDistPref (mappend envDistPref overrideDistPref)   where     parseEnvDistPref env =       case env of-        Just distPref | not (null distPref) -> toFlag distPref+        Just distPref | not (null distPref) -> toFlag $ makeSymbolicPath distPref         _ -> NoFlag  -- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken@@ -401,9 +438,9 @@ -- set. (The @*DistPref@ flags are always set to a definite value before -- invoking 'UserHooks'.) findDistPrefOrDefault-  :: Setup.Flag FilePath+  :: Setup.Flag (SymbolicPath Pkg (Dir Dist))   -- ^ override \"dist\" prefix-  -> IO FilePath+  -> IO (SymbolicPath Pkg (Dir Dist)) findDistPrefOrDefault = findDistPref defaultDistPref  -- | Perform the \"@.\/setup configure@\" action.@@ -412,24 +449,106 @@   :: (GenericPackageDescription, HookedBuildInfo)   -> ConfigFlags   -> IO LocalBuildInfo-configure (g_pkg_descr, hookedBuildInfo) cfg = do-  -- Cabal pre-configure-  (lbc1, comp, platform, enabledComps) <- preConfigurePackage cfg g_pkg_descr+configure = configure_setupHooks noConfigureHooks -  -- Cabal package-wide configure-  (lbc2, pbd2, pkg_info) <--    finalizeAndConfigurePackage cfg lbc1 g_pkg_descr comp platform enabledComps+configure_setupHooks+  :: ConfigureHooks+  -> (GenericPackageDescription, HookedBuildInfo)+  -> ConfigFlags+  -> IO LocalBuildInfo+configure_setupHooks+  (ConfigureHooks{preConfPackageHook, postConfPackageHook, preConfComponentHook})+  (g_pkg_descr, hookedBuildInfo)+  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 -  -- Cabal per-component configure-  externalPkgDeps <- finalCheckPackage g_pkg_descr pbd2 hookedBuildInfo pkg_info-  configureComponents lbc2 pbd2 pkg_info externalPkgDeps+    -- 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+              } +    -- Cabal package-wide configure+    (lbc2, pbd2, pkg_info) <-+      finalizeAndConfigurePackage cfg lbc1 g_pkg_descr comp platform enabledComps++    -- Package-wide post-configure hook+    for_ postConfPackageHook $ \postConfPkg -> do+      let input =+            SetupHooks.PostConfPackageInputs+              { SetupHooks.localBuildConfig = lbc2+              , SetupHooks.packageBuildDescr = pbd2+              }+      postConfPkg input++    -- 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}++    -- Cabal per-component configure+    externalPkgDeps <- finalCheckPackage g_pkg_descr pbd3 hookedBuildInfo pkg_info+    lbi <- configureComponents lbc2 pbd3 pkg_info externalPkgDeps++    writePersistBuildConfig mbWorkDir distPref lbi++    return lbi+ preConfigurePackage   :: ConfigFlags   -> GenericPackageDescription   -> IO (LBC.LocalBuildConfig, Compiler, Platform, ComponentRequestedSpec) preConfigurePackage cfg g_pkg_descr = do-  let verbosity = fromFlag (configVerbosity cfg)+  let verbosity = 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@@ -438,11 +557,12 @@   -- configure everything (the old behavior).   (mb_cname :: Maybe ComponentName) <- do     let flat_pkg_descr = flattenPackageDescription g_pkg_descr-    targets <- readBuildTargets verbosity flat_pkg_descr (configArgs cfg)+        targets0 = configTargets cfg+    targets <- readBuildTargets verbosity flat_pkg_descr targets0     -- TODO: bleat if you use the module/file syntax     let targets' = [cname | BuildTargetComponent cname <- targets]     case targets' of-      _ | null (configArgs cfg) -> return Nothing+      _ | null targets0 -> return Nothing       [cname] -> return (Just cname)       [] -> dieWithException verbosity NoValidComponent       _ -> dieWithException verbosity ConfigureEitherSingleOrAll@@ -505,12 +625,14 @@       (lessVerbose verbosity)    -- Where to build the package-  let build_dir :: FilePath -- e.g. dist/build-      build_dir = configFlagsBuildDir cfg+  let builddir :: SymbolicPath Pkg (Dir Build) -- e.g. dist/build+      builddir = setupFlagsBuildDir $ configCommonFlags cfg+      mbWorkDir = flagToMaybe $ configWorkingDir cfg   -- 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 build_dir+  createDirectoryIfMissingVerbose (lessVerbose verbosity) True $+    interpretSymbolicPath mbWorkDir builddir    lbc <- computeLocalBuildConfig cfg comp programDb00   return (lbc, comp, compPlatform, enabled)@@ -521,7 +643,8 @@   -> ProgramDb   -> IO LBC.LocalBuildConfig computeLocalBuildConfig cfg comp programDb = do-  let verbosity = fromFlag (configVerbosity cfg)+  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)@@ -587,7 +710,7 @@             -- 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.isDynamic comp)+            not (GHC.compilerBuildWay comp `elem` [DynWay, ProfDynWay])           CompilerId GHCJS _ ->             not (GHCJS.isDynamic comp)           _ -> False@@ -612,7 +735,7 @@             CompilerId GHC _ ->               -- if ghc is dynamic, then ghci needs a shared               -- library, so we build one by default.-              GHC.isDynamic comp+              GHC.compilerBuildWay comp == DynWay             CompilerId GHCJS _ ->               GHCJS.isDynamic comp             _ -> False@@ -632,12 +755,6 @@        withFullyStaticExe_ = fromFlag $ configFullyStaticExe cfg -  when (withDynExe_ && not withSharedLib_) $-    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."-   setProfiling <- configureProfiling verbosity cfg comp    setCoverage <- configureCoverage verbosity cfg comp@@ -670,6 +787,7 @@             , withDynExe = withDynExe_             , withFullyStaticExe = withFullyStaticExe_             , withProfLib = False+            , withProfLibShared = False             , withProfLibDetail = ProfDetailNone             , withProfExe = False             , withProfExeDetail = ProfDetailNone@@ -685,6 +803,20 @@             , 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."++  -- 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."+   return $     LBC.LocalBuildConfig       { extraConfigArgs = [] -- Currently configure does not@@ -696,7 +828,7 @@  data PackageInfo = PackageInfo   { internalPackageSet :: Set LibraryName-  , promisedDepsSet :: Map (PackageName, ComponentName) ComponentId+  , promisedDepsSet :: Map (PackageName, ComponentName) PromisedComponent   , installedPackageSet :: InstalledPackageIndex   , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo   }@@ -713,7 +845,8 @@   -> PackageDBStack   -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr) configurePackage cfg lbc0 pkg_descr00 flags enabled comp platform programDb0 packageDbs = do-  let verbosity = fromFlag (configVerbosity cfg)+  let common = configCommonFlags cfg+      verbosity = fromFlag $ setupVerbosity common        -- add extra include/lib dirs as specified in cfg       pkg_descr0 = addExtraIncludeLibDirsFromConfigFlags pkg_descr00 cfg@@ -725,29 +858,33 @@   -- right before calling configurePackage?    -- Configure certain external build tools, see below for which ones.-  let requiredBuildTools = do-        bi <- enabledBuildInfos pkg_descr0 enabled-        -- First, we collect any tool dep that we know is external. This is,-        -- in practice:-        ---        -- 1. `build-tools` entries on the whitelist-        ---        -- 2. `build-tool-depends` that aren't from the current package.-        let externBuildToolDeps =-              [ LegacyExeDependency (unUnqualComponentName eName) versionRange-              | buildTool@(ExeDependency _ eName versionRange) <--                  getAllToolDependencies pkg_descr0 bi-              , not $ isInternal pkg_descr0 buildTool-              ]-        -- Second, we collect any build-tools entry we don't know how to-        -- desugar. We'll never have any idea how to build them, so we just-        -- hope they are already on the PATH.-        let unknownBuildTools =-              [ buildTool-              | buildTool <- buildTools bi-              , Nothing == desugarBuildTool pkg_descr0 buildTool-              ]-        externBuildToolDeps ++ unknownBuildTools+  let requiredBuildTools+        -- If --ignore-build-tools is set, no build tool is required:+        | fromFlagOrDefault False $ configIgnoreBuildTools cfg =+            []+        | otherwise = do+            bi <- enabledBuildInfos pkg_descr0 enabled+            -- First, we collect any tool dep that we know is external. This is,+            -- in practice:+            --+            -- 1. `build-tools` entries on the whitelist+            --+            -- 2. `build-tool-depends` that aren't from the current package.+            let externBuildToolDeps =+                  [ LegacyExeDependency (unUnqualComponentName eName) versionRange+                  | buildTool@(ExeDependency _ eName versionRange) <-+                      getAllToolDependencies pkg_descr0 bi+                  , not $ isInternal pkg_descr0 buildTool+                  ]+            -- Second, we collect any build-tools entry we don't know how to+            -- desugar. We'll never have any idea how to build them, so we just+            -- hope they are already on the PATH.+            let unknownBuildTools =+                  [ buildTool+                  | buildTool <- buildTools bi+                  , Nothing == desugarBuildTool pkg_descr0 buildTool+                  ]+            externBuildToolDeps ++ unknownBuildTools    programDb1 <-     configureAllKnownPrograms (lessVerbose verbosity) programDb0@@ -807,7 +944,9 @@   -> ComponentRequestedSpec   -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr, PackageInfo) finalizeAndConfigurePackage cfg lbc0 g_pkg_descr comp platform enabled = do-  let verbosity = fromFlag (configVerbosity cfg)+  let common = configCommonFlags cfg+      verbosity = fromFlag $ setupVerbosity common+      mbWorkDir = flagToMaybe $ setupWorkingDir common    let programDb0 = LBC.withPrograms lbc0       -- What package database(s) to use@@ -822,6 +961,7 @@     getInstalledPackages       (lessVerbose verbosity)       comp+      mbWorkDir       packageDbs       programDb0 @@ -973,7 +1113,7 @@   -> LBC.PackageBuildDescr   -> HookedBuildInfo   -> PackageInfo-  -> IO ([PreExistingComponent], [PromisedComponent])+  -> IO ([PreExistingComponent], [ConfiguredPromisedComponent]) finalCheckPackage   g_pkg_descr   ( LBC.PackageBuildDescr@@ -987,15 +1127,14 @@   hookedBuildInfo   (PackageInfo{internalPackageSet, promisedDepsSet, installedPackageSet, requiredDepsMap}) =     do-      let verbosity = fromFlag (configVerbosity cfg)+      let common = configCommonFlags cfg+          verbosity = fromFlag $ setupVerbosity common+          cabalFileDir = packageRoot common           use_external_internal_deps =             case enabled of               OneComponentRequestedSpec{} -> True               ComponentRequestedSpec{} -> False -      let cabalFileDir =-            maybe "." takeDirectory $-              flagToMaybe (configCabalFilePath cfg)       checkCompilerProblems verbosity comp pkg_descr enabled       checkPackageProblems         verbosity@@ -1071,7 +1210,7 @@   :: LBC.LocalBuildConfig   -> LBC.PackageBuildDescr   -> PackageInfo-  -> ([PreExistingComponent], [PromisedComponent])+  -> ([PreExistingComponent], [ConfiguredPromisedComponent])   -> IO LocalBuildInfo configureComponents   lbc@(LBC.LocalBuildConfig{withPrograms = programDb})@@ -1085,7 +1224,8 @@   (PackageInfo{promisedDepsSet, installedPackageSet})   externalPkgDeps =     do-      let verbosity = fromFlag (configVerbosity cfg)+      let common = configCommonFlags cfg+          verbosity = fromFlag $ setupVerbosity common           use_external_internal_deps =             case enabled of               OneComponentRequestedSpec{} -> True@@ -1140,7 +1280,9 @@           extraCoverageUnitIds = case enabled of             -- Whole package configure, add package libs             ComponentRequestedSpec{} -> mapMaybe mbCompUnitId buildComponents-            -- Component configure, no need to do anything+            -- Component configure, no need to do anything since+            -- extra-coverage-for will be passed for all other components that+            -- should be covered.             OneComponentRequestedSpec{} -> []           mbCompUnitId LibComponentLocalBuildInfo{componentUnitId} = Just componentUnitId           mbCompUnitId _ = Nothing@@ -1165,6 +1307,9 @@       when (LBC.relocatable $ LBC.withBuildOptions lbc) $         checkRelocatable verbosity pkg_descr lbi +      when (LBC.withDynExe $ LBC.withBuildOptions lbc) $+        checkSharedExes verbosity lbi+       -- TODO: This is not entirely correct, because the dirs may vary       -- across libraries/executables       let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest@@ -1228,8 +1373,8 @@        return lbi -mkPromisedDepsSet :: [GivenComponent] -> Map (PackageName, ComponentName) ComponentId-mkPromisedDepsSet comps = Map.fromList [((pn, CLibName ln), cid) | GivenComponent pn ln cid <- comps]+mkPromisedDepsSet :: [PromisedComponent] -> Map (PackageName, ComponentName) PromisedComponent+mkPromisedDepsSet comps = Map.fromList [((packageName pn, CLibName ln), p) | p@(PromisedComponent pn ln _) <- comps]  -- | Adds the extra program paths from the flags provided to @configure@ as -- well as specified locations for certain known programs and their default@@ -1238,7 +1383,7 @@ mkProgramDb 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 (fromFlagOrDefault normal (configVerbosity cfg)) searchpath [] initialProgramDb   pure     . userSpecifyArgss (configProgramArgs cfg)     . userSpecifyPaths (configProgramPaths cfg)@@ -1332,7 +1477,7 @@   -- ^ installed set   -> Set LibraryName   -- ^ library components-  -> Map (PackageName, ComponentName) ComponentId+  -> Map (PackageName, ComponentName) PromisedComponent   -> Map (PackageName, ComponentName) InstalledPackageInfo   -- ^ required dependencies   -> (Dependency -> Bool)@@ -1494,14 +1639,14 @@   :: Verbosity   -> UseExternalInternalDeps   -> Set LibraryName-  -> Map (PackageName, ComponentName) ComponentId+  -> Map (PackageName, ComponentName) PromisedComponent   -> InstalledPackageIndex   -- ^ installed packages   -> Map (PackageName, ComponentName) InstalledPackageInfo   -- ^ required deps   -> PackageDescription   -> ComponentRequestedSpec-  -> IO ([PreExistingComponent], [PromisedComponent])+  -> IO ([PreExistingComponent], [ConfiguredPromisedComponent]) configureDependencies   verbosity   use_external_internal_deps@@ -1606,7 +1751,7 @@ -- -- Note that @--enable-executable-profiling@ also affects profiling -- of benchmarks and (non-detailed) test suites.-computeEffectiveProfiling :: ConfigFlags -> (Bool {- lib -}, Bool {- exe -})+computeEffectiveProfiling :: ConfigFlags -> (Bool {- lib vanilla-}, Bool {- lib shared -}, Bool {- exe -}) computeEffectiveProfiling cfg =   -- The --profiling flag sets the default for both libs and exes,   -- but can be overridden by --library-profiling, or the old deprecated@@ -1614,15 +1759,20 @@   --   -- The --profiling-detail and --library-profiling-detail flags behave   -- similarly-  let tryExeProfiling =+  let dynamicExe = fromFlagOrDefault False (configDynExe cfg)+      tryExeProfiling =         fromFlagOrDefault           False           (mappend (configProf cfg) (configProfExe cfg))       tryLibProfiling =         fromFlagOrDefault-          tryExeProfiling-          (mappend (configProf cfg) (configProfLib cfg))-   in (tryLibProfiling, tryExeProfiling)+          (tryExeProfiling && not dynamicExe)+          (configProfLib cfg)+      tryLibProfilingShared =+        fromFlagOrDefault+          (tryExeProfiling && dynamicExe)+          (configProfShared cfg)+   in (tryLibProfiling, tryLibProfilingShared, tryExeProfiling)  -- | Select and apply profiling settings for the build based on the -- 'ConfigFlags' and 'Compiler'.@@ -1632,7 +1782,7 @@   -> Compiler   -> IO (LBC.BuildOptions -> LBC.BuildOptions) configureProfiling verbosity cfg comp = do-  let (tryLibProfiling, tryExeProfiling) = computeEffectiveProfiling cfg+  let (tryLibProfiling, tryLibProfilingShared, tryExeProfiling) = computeEffectiveProfiling cfg        tryExeProfileLevel =         fromFlagOrDefault@@ -1659,8 +1809,8 @@         return ProfDetailDefault       checkProfileLevel other = return other -  (exeProfWithoutLibProf, applyProfiling) <--    if profilingSupported comp+  applyProfiling <-+    if profilingSupported comp && (profilingVanillaSupportedOrUnknown comp || profilingDynamicSupportedOrUnknown comp)       then do         exeLevel <- checkProfileLevel tryExeProfileLevel         libLevel <- checkProfileLevel tryLibProfileLevel@@ -1671,11 +1821,46 @@                 , LBC.withProfExe = tryExeProfiling                 , LBC.withProfExeDetail = exeLevel                 }-        return (tryExeProfiling && not tryLibProfiling, apply)+        let compilerSupportsProfilingDynamic = profilingDynamicSupportedOrUnknown comp+        apply2 <-+          if compilerSupportsProfilingDynamic+            then -- Case 1: We support profiled shared libraries so turn on shared profiling+            -- libraries if the user asked for it.+            return $ \buildOptions -> apply buildOptions{LBC.withProfLibShared = tryLibProfilingShared}+            else -- Case 2: Compiler doesn't support profiling shared so turn them off+            do+              -- If we wanted to enable profiling shared libraries.. tell the+              -- user we couldn't.+              when (profilingVanillaSupportedOrUnknown comp && tryLibProfilingShared) $+                warn+                  verbosity+                  ( "The compiler "+                      ++ showCompilerId comp+                      ++ " does not support "+                      ++ "profiling shared objects. Static profiled objects "+                      ++ "will be built."+                  )+              return $ \buildOptions ->+                let original_options = apply buildOptions+                 in original_options+                      { LBC.withProfLibShared = False+                      , LBC.withProfLib = profilingVanillaSupportedOrUnknown comp && (tryLibProfilingShared || LBC.withProfLib original_options)+                      , LBC.withDynExe = if LBC.withProfExe original_options then False else LBC.withDynExe original_options+                      }++        when (tryExeProfiling && not (tryLibProfiling || tryLibProfilingShared)) $ do+          warn+            verbosity+            ( "Executables will be built with profiling, but library "+                ++ "profiling is disabled. Linking will fail if any executables "+                ++ "depend on the library."+            )+        return apply2       else do         let apply buildOptions =               buildOptions                 { LBC.withProfLib = False+                , LBC.withProfLibShared = False                 , LBC.withProfLibDetail = ProfDetailNone                 , LBC.withProfExe = False                 , LBC.withProfExeDetail = ProfDetailNone@@ -1688,15 +1873,7 @@                 ++ " does not support "                 ++ "profiling. Profiling has been disabled."             )-        return (False, apply)--  when exeProfWithoutLibProf $-    warn-      verbosity-      ( "Executables will be built with profiling, but library "-          ++ "profiling is disabled. Linking will fail if any executables "-          ++ "depend on the library."-      )+        return apply    return applyProfiling @@ -1735,11 +1912,11 @@     -- we need to build packages in the interactive ghci session, no matter     -- whether they have been built before.     -- Building them in the configure phase is then redundant and costs time.-    PromisedDependency PromisedComponent+    PromisedDependency ConfiguredPromisedComponent   | -- | An internal dependency ('PackageId' should be a library name)     -- which we are going to have to build.  (The     -- 'PackageId' here is a hack to get a modest amount of-    -- polymorphism out of the 'Package' typeclass.)+    -- polymorphism out of the Pkg' typeclass.)     InternalDependency PackageId  -- | Test for a package dependency and record the version we have installed.@@ -1748,7 +1925,7 @@   -- ^ Package id of current package   -> Set LibraryName   -- ^ package libraries-  -> Map (PackageName, ComponentName) ComponentId+  -> Map (PackageName, ComponentName) PromisedComponent   -- ^ Set of components that are promised, i.e. are not installed already. See 'PromisedDependency' for more details.   -> InstalledPackageIndex   -- ^ Installed packages@@ -1800,8 +1977,8 @@       -- We have to look it up externally       do_external_external :: LibraryName -> Either FailedDependency DependencyResolution       do_external_external lib-        | Just cid <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex =-            return $ PromisedDependency (PromisedComponent dep_pkgname (AnnotatedId currentCabalId (CLibName lib) cid))+        | Just pc <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex =+            return $ PromisedDependency (ConfiguredPromisedComponent dep_pkgname (AnnotatedId (promisedComponentPackage pc) (CLibName lib) (promisedComponentId pc)))       do_external_external lib = do         ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of           -- If we know the exact pkg to use, then use it.@@ -1814,8 +1991,8 @@        do_external_internal :: LibraryName -> Either FailedDependency DependencyResolution       do_external_internal lib-        | Just cid <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex =-            return $ PromisedDependency (PromisedComponent dep_pkgname (AnnotatedId currentCabalId (CLibName lib) cid))+        | Just pc <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex =+            return $ PromisedDependency (ConfiguredPromisedComponent dep_pkgname (AnnotatedId (promisedComponentPackage pc) (CLibName lib) (promisedComponentId pc)))       do_external_internal lib = do         ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of           -- If we know the exact pkg to use, then use it.@@ -1859,11 +2036,12 @@ getInstalledPackages   :: Verbosity   -> Compiler-  -> PackageDBStack+  -> Maybe (SymbolicPath CWD (Dir from))+  -> PackageDBStackX (SymbolicPath from (Dir PkgDB))   -- ^ The stack of package databases.   -> ProgramDb   -> IO InstalledPackageIndex-getInstalledPackages verbosity comp packageDBs progdb = do+getInstalledPackages verbosity comp mbWorkDir packageDBs progdb = do   when (null packageDBs) $     dieWithException verbosity NoPackageDatabaseSpecified @@ -1871,15 +2049,16 @@   -- do not check empty packagedbs (ghc-pkg would error out)   packageDBs' <- filterM packageDBExists packageDBs   case compilerFlavor comp of-    GHC -> GHC.getInstalledPackages verbosity comp packageDBs' progdb-    GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs' progdb-    UHC -> UHC.getInstalledPackages verbosity comp packageDBs' progdb+    GHC -> GHC.getInstalledPackages verbosity comp mbWorkDir packageDBs' progdb+    GHCJS -> GHCJS.getInstalledPackages verbosity mbWorkDir packageDBs' progdb+    UHC -> UHC.getInstalledPackages verbosity comp mbWorkDir packageDBs' progdb     HaskellSuite{} ->       HaskellSuite.getInstalledPackages verbosity packageDBs' progdb     flv ->       dieWithException verbosity $ HowToFindInstalledPackages flv   where-    packageDBExists (SpecificPackageDB path) = do+    packageDBExists (SpecificPackageDB path0) = do+      let path = interpretSymbolicPath mbWorkDir path0       exists <- doesPathExist path       unless exists $         warn verbosity $@@ -1900,31 +2079,34 @@ getPackageDBContents   :: Verbosity   -> Compiler+  -> Maybe (SymbolicPath CWD (Dir Pkg))   -> PackageDB   -> ProgramDb   -> IO InstalledPackageIndex-getPackageDBContents verbosity comp packageDB progdb = do+getPackageDBContents verbosity comp mbWorkDir packageDB progdb = do   info verbosity "Reading installed packages..."   case compilerFlavor comp of-    GHC -> GHC.getPackageDBContents verbosity packageDB progdb-    GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progdb+    GHC -> GHC.getPackageDBContents verbosity mbWorkDir packageDB progdb+    GHCJS -> GHCJS.getPackageDBContents verbosity mbWorkDir packageDB progdb     -- For other compilers, try to fall back on 'getInstalledPackages'.-    _ -> getInstalledPackages verbosity comp [packageDB] progdb+    _ -> getInstalledPackages verbosity comp mbWorkDir [packageDB] progdb  -- | A set of files (or directories) that can be monitored to detect when -- there might have been a change in the installed packages. getInstalledPackagesMonitorFiles   :: Verbosity   -> Compiler-  -> PackageDBStack+  -> Maybe (SymbolicPath CWD ('Dir from))+  -> PackageDBStackS from   -> ProgramDb   -> Platform   -> IO [FilePath]-getInstalledPackagesMonitorFiles verbosity comp packageDBs progdb platform =+getInstalledPackagesMonitorFiles verbosity comp mbWorkDir packageDBs progdb platform =   case compilerFlavor comp of     GHC ->       GHC.getInstalledPackagesMonitorFiles         verbosity+        mbWorkDir         platform         progdb         packageDBs@@ -1948,8 +2130,9 @@   -> [UnitId]   -- ^ The unit ids to lookup in the installed packages   -> IO [InstalledPackageInfo]-getInstalledPackagesById verbosity LocalBuildInfo{compiler = comp, withPackageDB = pkgDb, withPrograms = progDb} mkException unitids = do-  ipindex <- getInstalledPackages verbosity comp pkgDb progDb+getInstalledPackagesById verbosity lbi@LocalBuildInfo{compiler = comp, withPackageDB = pkgDb, withPrograms = progDb} mkException unitids = do+  let mbWorkDir = mbWorkDirLBI lbi+  ipindex <- getInstalledPackages verbosity comp mbWorkDir pkgDb progDb   mapM     ( \uid -> case lookupUnitId ipindex uid of         Nothing -> dieWithException verbosity (mkException uid)@@ -1961,7 +2144,7 @@ -- @--global@, @--user@ and @--package-db=global|user|clear|$file@. -- This function combines the global/user flag and interprets the package-db -- flag into a single package db stack.-interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack+interpretPackageDbFlags :: Bool -> [Maybe (PackageDBX fp)] -> PackageDBStackX fp interpretPackageDbFlags userInstall specificDBs =   extra initialStack specificDBs   where@@ -2078,55 +2261,77 @@   verbosity   progdb   (LegacyExeDependency progName verRange) =-    case lookupKnownProgram progName progdb of-      Nothing ->-        -- Try to configure it as a 'simpleProgram' automatically-        ---        -- There's a bit of a story behind this line.  In old versions-        -- of Cabal, there were only internal build-tools dependencies.  So the-        -- behavior in this case was:-        ---        --    - If a build-tool dependency was internal, don't do-        --      any checking.-        ---        --    - If it was external, call 'configureRequiredProgram' to-        --      "configure" the executable.  In particular, if-        --      the program was not "known" (present in 'ProgramDb'),-        --      then we would just error.  This was fine, because-        --      the only way a program could be executed from 'ProgramDb'-        --      is if some library code from Cabal actually called it,-        --      and the pre-existing Cabal code only calls known-        --      programs from 'defaultProgramDb', and so if it-        --      is calling something else, you have a Custom setup-        --      script, and in that case you are expected to register-        --      the program you want to call in the ProgramDb.-        ---        -- OK, so that was fine, until I (ezyang, in 2016) refactored-        -- Cabal to support per-component builds.  In this case, what-        -- was previously an internal build-tool dependency now became-        -- an external one, and now previously "internal" dependencies-        -- are now external.  But these are permitted to exist even-        -- when they are not previously configured (something that-        -- can only occur by a Custom script.)+    case lookupProgramByName progName progdb of+      Just prog ->+        -- If the program has already been configured, use it+        -- (as long as the version is compatible).         ---        -- So, I decided, "Fine, let's just accept these in any-        -- case."  Thus this line.  The alternative would have been to-        -- somehow detect when a build-tools dependency was "internal" (by-        -- looking at the unflattened package description) but this-        -- would also be incompatible with future work to support-        -- external executable dependencies: we definitely cannot-        -- assume they will be preinitialized in the 'ProgramDb'.-        configureProgram verbosity (simpleProgram progName) progdb-      Just prog-        -- requireProgramVersion always requires the program have a version-        -- but if the user says "build-depends: foo" ie no version constraint-        -- then we should not fail if we cannot discover the program version.-        | verRange == anyVersion -> do-            (_, progdb') <- requireProgram verbosity prog progdb-            return progdb'-        | otherwise -> do-            (_, _, progdb') <- requireProgramVersion verbosity prog verRange progdb-            return progdb'+        -- Not doing so means falling back to the "simpleProgram" path below,+        -- which might fail if the program has custom logic to find a version+        -- (such as hsc2hs).+        let loc = locationPath $ programLocation prog+         in case programVersion prog of+              Nothing+                | verRange == anyVersion ->+                    return progdb+                | otherwise ->+                    dieWithException verbosity $!+                      UnknownVersionDb (programId prog) verRange loc+              Just version+                | withinRange version verRange ->+                    return progdb+                | otherwise ->+                    dieWithException verbosity $!+                      BadVersionDb (programId prog) version verRange loc+      Nothing ->+        -- Otherwise, try to configure it as a 'simpleProgram' automatically+        case lookupKnownProgram progName progdb of+          Nothing ->+            -- There's a bit of a story behind this line.  In old versions+            -- of Cabal, there were only internal build-tools dependencies.  So the+            -- behavior in this case was:+            --+            --    - If a build-tool dependency was internal, don't do+            --      any checking.+            --+            --    - If it was external, call 'configureRequiredProgram' to+            --      "configure" the executable.  In particular, if+            --      the program was not "known" (present in 'ProgramDb'),+            --      then we would just error.  This was fine, because+            --      the only way a program could be executed from 'ProgramDb'+            --      is if some library code from Cabal actually called it,+            --      and the pre-existing Cabal code only calls known+            --      programs from 'defaultProgramDb', and so if it+            --      is calling something else, you have a Custom setup+            --      script, and in that case you are expected to register+            --      the program you want to call in the ProgramDb.+            --+            -- OK, so that was fine, until I (ezyang, in 2016) refactored+            -- Cabal to support per-component builds.  In this case, what+            -- was previously an internal build-tool dependency now became+            -- an external one, and now previously "internal" dependencies+            -- are now external.  But these are permitted to exist even+            -- when they are not previously configured (something that+            -- can only occur by a Custom script.)+            --+            -- So, I decided, "Fine, let's just accept these in any+            -- case."  Thus this line.  The alternative would have been to+            -- somehow detect when a build-tools dependency was "internal" (by+            -- looking at the unflattened package description) but this+            -- would also be incompatible with future work to support+            -- external executable dependencies: we definitely cannot+            -- assume they will be preinitialized in the 'ProgramDb'.+            configureProgram verbosity (simpleProgram progName) progdb+          Just prog+            -- requireProgramVersion always requires the program have a version+            -- but if the user says "build-depends: foo" ie no version constraint+            -- then we should not fail if we cannot discover the program version.+            | verRange == anyVersion -> do+                (_, progdb') <- requireProgram verbosity prog progdb+                return progdb'+            | otherwise -> do+                (_, _, progdb') <- requireProgramVersion verbosity prog verRange progdb+                return progdb'  -- ----------------------------------------------------------------------------- -- Configuring pkg-config package dependencies@@ -2240,11 +2445,11 @@       (extraLibsStatic') = filter ("-l" `isPrefixOf`) ldflags_static       (extraLibDirsStatic') = filter ("-L" `isPrefixOf`) ldflags_static    in mempty-        { includeDirs = map (drop 2) includeDirs'+        { includeDirs = map (makeSymbolicPath . drop 2) includeDirs'         , extraLibs = map (drop 2) extraLibs'-        , extraLibDirs = map (drop 2) extraLibDirs'+        , extraLibDirs = map (makeSymbolicPath . drop 2) extraLibDirs'         , extraLibsStatic = map (drop 2) extraLibsStatic'-        , extraLibDirsStatic = map (drop 2) extraLibDirsStatic'+        , extraLibDirsStatic = map (makeSymbolicPath . drop 2) extraLibDirsStatic'         , ccOptions = cflags'         , ldOptions = ldflags''         }@@ -2257,12 +2462,14 @@   -> IO (Compiler, Platform, ProgramDb) configCompilerAuxEx cfg = do   programDb <- mkProgramDb cfg defaultProgramDb+  let common = configCommonFlags cfg+      verbosity = fromFlag $ setupVerbosity common   configCompilerEx     (flagToMaybe $ configHcFlavor cfg)     (flagToMaybe $ configHcPath cfg)     (flagToMaybe $ configHcPkg cfg)     programDb-    (fromFlag (configVerbosity cfg))+    verbosity  configCompilerEx   :: Maybe CompilerFlavor@@ -2293,8 +2500,7 @@ checkForeignDeps pkg lbi verbosity =   ifBuildsWith     allHeaders-    (commonCcArgs ++ makeLdArgs allLibs) -- I'm feeling-    -- lucky+    (commonCcArgs ++ makeLdArgs allLibs) -- I'm feeling lucky     (return ())     ( do         missingLibs <- findMissingLibs@@ -2302,7 +2508,7 @@         explainErrors missingHdr missingLibs     )   where-    allHeaders = collectField includes+    allHeaders = collectField (fmap getSymbolicPath . includes)     allLibs =       collectField $         if withFullyStaticExe lbi@@ -2327,24 +2533,24 @@     -- 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 includeDirs)+      let relIncDirs = filter (not . isAbsolute) (collectField (fmap getSymbolicPath . includeDirs))           isHeader = isSuffixOf ".h"       genHeaders <- for relIncDirs $ \dir ->         fmap (dir </>) . filter isHeader-          <$> listDirectory (buildDir lbi </> dir) `catchIO` (\_ -> return [])+          <$> listDirectory (i (buildDir lbi) </> dir) `catchIO` (\_ -> return [])       srcHeaders <- for relIncDirs $ \dir ->         fmap (dir </>) . filter isHeader-          <$> listDirectory (baseDir lbi </> dir) `catchIO` (\_ -> return [])+          <$> listDirectory (baseDir </> dir) `catchIO` (\_ -> return [])       let commonHeaders = concat genHeaders `intersect` concat srcHeaders       for_ commonHeaders $ \hdr -> do         warn verbosity $           "Duplicate header found in "-            ++ (buildDir lbi </> hdr)+            ++ (getSymbolicPath (buildDir lbi) </> hdr)             ++ " and "-            ++ (baseDir lbi </> hdr)+            ++ (baseDir </> hdr)             ++ "; removing "-            ++ (baseDir lbi </> hdr)-        removeFile (baseDir lbi </> hdr)+            ++ (baseDir </> hdr)+        removeFile (baseDir </> hdr)      findOffendingHdr =       ifBuildsWith@@ -2379,29 +2585,34 @@      libExists lib = builds (makeProgram []) (makeLdArgs [lib]) -    baseDir lbi' = fromMaybe "." (takeDirectory <$> cabalFilePath lbi')+    common = configCommonFlags $ configFlags lbi+    baseDir = packageRoot common +    -- See Note [Symbolic paths] in Distribution.Utils.Path+    i = interpretSymbolicPathLBI lbi+    mbWorkDir = mbWorkDirLBI lbi+     commonCppArgs =       platformDefines lbi         -- TODO: This is a massive hack, to work around the         -- fact that the test performed here should be         -- PER-component (c.f. the "I'm Feeling Lucky"; we         -- should NOT be glomming everything together.)-        ++ ["-I" ++ buildDir lbi </> "autogen"]+        ++ ["-I" ++ i (buildDir lbi </> makeRelativePathEx "autogen")]         -- `configure' may generate headers in the build directory-        ++ [ "-I" ++ buildDir lbi </> dir-           | dir <- ordNub (collectField includeDirs)-           , not (isAbsolute dir)+        ++ [ "-I" ++ i (buildDir lbi </> unsafeCoerceSymbolicPath dir)+           | dir <- mapMaybe symbolicPathRelative_maybe $ ordNub (collectField includeDirs)            ]         -- we might also reference headers from the         -- packages directory.-        ++ [ "-I" ++ baseDir lbi </> dir-           | dir <- ordNub (collectField includeDirs)-           , not (isAbsolute dir)+        ++ [ "-I" ++ baseDir </> getSymbolicPath dir+           | dir <- mapMaybe symbolicPathRelative_maybe $ ordNub (collectField includeDirs)            ]-        ++ [ "-I" ++ dir | dir <- ordNub (collectField includeDirs), isAbsolute dir+        ++ [ "-I" ++ dir+           | dir <- ordNub (collectField (fmap getSymbolicPath . includeDirs))+           , isAbsolute dir            ]-        ++ ["-I" ++ baseDir lbi]+        ++ ["-I" ++ baseDir]         ++ collectField cppOptions         ++ collectField ccOptions         ++ [ "-I" ++ dir@@ -2428,7 +2639,7 @@            ]      commonLdArgs =-      [ "-L" ++ dir+      [ "-L" ++ getSymbolicPath dir       | dir <-           ordNub $             collectField@@ -2461,20 +2672,22 @@     allBi = enabledBuildInfos pkg (componentEnabledSpec lbi)     deps = PackageIndex.topologicalOrder (installedPkgs lbi) +    builds :: String -> [ProgArg] -> IO Bool     builds program args =       do-        tempDir <- getTemporaryDirectory-        withTempFile tempDir ".c" $ \cName cHnd ->-          withTempFile tempDir "" $ \oNname oHnd -> do+        tempDir <- makeSymbolicPath <$> getTemporaryDirectory+        withTempFileCwd mbWorkDir tempDir ".c" $ \cName cHnd ->+          withTempFileCwd mbWorkDir tempDir "" $ \oNname oHnd -> do             hPutStrLn cHnd program             hClose cHnd             hClose oHnd             _ <--              getDbProgramOutput+              getDbProgramOutputCwd                 verbosity+                mbWorkDir                 gccProgram                 (withPrograms lbi)-                (cName : "-o" : oNname : args)+                (getSymbolicPath cName : "-o" : getSymbolicPath oNname : args)             return True         `catchIO` (\_ -> return False)         `catchExit` (\_ -> return False)@@ -2511,6 +2724,18 @@     classEW (PackageDistSuspiciousWarn _) = Nothing     classEW (PackageDistInexcusable _) = Nothing +-- | Perform checks if a shared executable can be built+checkSharedExes+  :: Verbosity+  -> LocalBuildInfo+  -> IO ()+checkSharedExes verbosity lbi =+  when (os == Windows) $+    dieWithException verbosity $+      NoOSSupport os "shared executables"+  where+    (Platform _ os) = hostPlatform lbi+ -- | Preform checks if a relocatable build is allowed checkRelocatable   :: Verbosity@@ -2533,7 +2758,7 @@     checkOS =       unless (os `elem` [OSX, Linux]) $         dieWithException verbosity $-          NoOSSupport os+          NoOSSupport os "relocatable builds"       where         (Platform _ os) = hostPlatform lbi @@ -2580,7 +2805,7 @@     -- prefix of the package     depsPrefixRelative = do       pkgr <- GHC.pkgRoot verbosity lbi (registrationPackageDB (withPackageDB lbi))-      traverse_ (doCheck pkgr) ipkgs+      traverse_ (doCheck $ getSymbolicPath pkgr) ipkgs       where         doCheck pkgr ipkg           | maybe False (== pkgr) (IPI.pkgRoot ipkg) =

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-}@@ -23,6 +24,7 @@ -- local import Distribution.PackageDescription import Distribution.Pretty+import Distribution.Simple.Configure (findDistPrefOrDefault) import Distribution.Simple.Errors import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program@@ -30,18 +32,13 @@ import Distribution.Simple.Setup.Common import Distribution.Simple.Setup.Config import Distribution.Simple.Utils-import Distribution.System (buildPlatform)+import Distribution.System (Platform, buildPlatform) import Distribution.Utils.NubList-import Distribution.Verbosity+import Distribution.Utils.Path  -- Base-import System.FilePath-  ( dropDrive-  , searchPathSeparator-  , splitDirectories-  , takeDirectory-  , (</>)-  )+import System.Directory (createDirectoryIfMissing, doesFileExist)+import qualified System.FilePath as FilePath #ifdef mingw32_HOST_OS import System.FilePath    (normalise, splitDrive) #endif@@ -53,13 +50,25 @@ import qualified Data.Map as Map  runConfigureScript-  :: Verbosity-  -> ConfigFlags-  -> LocalBuildInfo+  :: ConfigFlags+  -> FlagAssignment+  -> ProgramDb+  -> Platform+  -- ^ host platform   -> IO ()-runConfigureScript verbosity flags lbi = do+runConfigureScript cfg flags programDb hp = do+  let commonCfg = configCommonFlags cfg+      verbosity = fromFlag $ setupVerbosity commonCfg+  dist_dir <- findDistPrefOrDefault $ setupDistPref commonCfg+  let build_dir = dist_dir </> makeRelativePathEx "build"+      mbWorkDir = flagToMaybe $ setupWorkingDir commonCfg+      configureScriptPath = packageRoot commonCfg </> "configure"+  confExists <- doesFileExist configureScriptPath+  unless confExists $+    dieWithException verbosity (ConfigureScriptNotFound configureScriptPath)+  configureFile <-+    makeAbsolute $ configureScriptPath   env <- getEnvironment-  let programDb = withPrograms lbi   (ccProg, ccFlags) <- configureCCompiler verbosity programDb   ccProgShort <- getShortPathName ccProg   -- The C compiler's compilation and linker flags (e.g.@@ -68,9 +77,8 @@   -- to ccFlags   -- We don't try and tell configure which ld to use, as we don't have   -- a way to pass its flags too-  configureFile <--    makeAbsolute $-      fromMaybe "." (takeDirectory <$> cabalFilePath lbi) </> "configure"++  let configureFile' = toUnix configureFile   -- autoconf is fussy about filenames, and has a set of forbidden   -- characters that can't appear in the build directory, etc:   -- https://www.gnu.org/software/autoconf/manual/autoconf.html#File-System-Conventions@@ -84,9 +92,8 @@   -- TODO: We don't check for colons, tildes or leading dashes. We   -- also should check the builddir's path, destdir, and all other   -- paths as well.-  let configureFile' = toUnix configureFile   for_ badAutoconfCharacters $ \(c, cname) ->-    when (c `elem` dropDrive configureFile') $+    when (c `elem` FilePath.dropDrive configureFile') $       warn verbosity $         concat           [ "The path to the './configure' script, '"@@ -116,7 +123,7 @@       Map.fromListWith         (<>)         [ (flagEnvVar flag, (flag, bool) :| [])-        | (flag, bool) <- unFlagAssignment $ flagAssignment lbi+        | (flag, bool) <- unFlagAssignment flags         ]   -- A map from env vars to flag names to the single flag we will go with   cabalFlagMapDeconflicted :: Map String (FlagName, Bool) <-@@ -148,14 +155,14 @@         ]           ++ [                ( "CABAL_FLAGS"-               , Just $ unwords [showFlagValue fv | fv <- unFlagAssignment $ flagAssignment lbi]+               , Just $ unwords [showFlagValue fv | fv <- unFlagAssignment flags]                )              ]-  let extraPath = fromNubList $ configProgramPathExtra flags+  let extraPath = fromNubList $ configProgramPathExtra cfg   let cflagsEnv =         maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags)) $           lookup "CFLAGS" env-      spSep = [searchPathSeparator]+      spSep = [FilePath.searchPathSeparator]       pathEnv =         maybe           (intercalate spSep extraPath)@@ -165,23 +172,24 @@         ("CFLAGS", Just cflagsEnv)           : [("PATH", Just pathEnv) | not (null extraPath)]           ++ cabalFlagEnv-      hp = hostPlatform lbi       maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)]       args' = configureFile' : args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag       shProg = simpleProgram "sh"-  progDb <- prependProgramSearchPath verbosity extraPath emptyProgramDb+  progDb <- prependProgramSearchPath verbosity extraPath [] emptyProgramDb   shConfiguredProg <-     lookupProgram shProg       `fmap` configureProgram verbosity shProg progDb   case shConfiguredProg of-    Just sh ->+    Just sh -> do+      let build_in = interpretSymbolicPath mbWorkDir build_dir+      createDirectoryIfMissing True build_in       runProgramInvocation verbosity $         (programInvocation (sh{programOverrideEnv = overEnv}) args')-          { progInvokeCwd = Just (buildDir lbi)+          { progInvokeCwd = Just build_in           }     Nothing -> dieWithException verbosity NotFoundMsg   where-    args = configureArgs backwardsCompatHack flags+    args = configureArgs backwardsCompatHack cfg     backwardsCompatHack = False  -- | Convert Windows path to Unix ones@@ -191,10 +199,10 @@                (l, rest) = case splitDrive tmp of                              ([],  x) -> ("/"      , x)                              (h:_, x) -> ('/':h:"/", x)-               parts = splitDirectories rest+               parts = FilePath.splitDirectories rest            in  l ++ intercalate "/" parts #else-toUnix s = intercalate "/" $ splitDirectories s+toUnix s = intercalate "/" $ FilePath.splitDirectories s #endif  badAutoconfCharacters :: [(Char, String)]

@@ -1,3 +1,5 @@+{-# LANGUAGE LambdaCase #-}+ -----------------------------------------------------------------------------  -- Module      :  Distribution.Simple.Errors@@ -20,18 +22,15 @@ import Distribution.InstalledPackageInfo import Distribution.ModuleName import Distribution.Package-import Distribution.PackageDescription (FlagName, UnqualComponentName)+import Distribution.PackageDescription import Distribution.Pretty   ( Pretty (pretty)   , prettyShow   ) import Distribution.Simple.InstallDirs import Distribution.Simple.PreProcess.Types (Suffix)+import Distribution.Simple.SetupHooks.Errors import Distribution.System (OS)-import Distribution.Types.BenchmarkType-import Distribution.Types.LibraryName-import Distribution.Types.PkgconfigVersion-import Distribution.Types.TestType import Distribution.Types.VersionRange.Internal () import Distribution.Version import Text.PrettyPrint@@ -116,7 +115,7 @@   | CheckSemaphoreSupport   | NoLibraryForPackage   | SanityCheckHookedBuildInfo UnqualComponentName-  | ConfigureScriptNotFound+  | ConfigureScriptNotFound FilePath   | NoValidComponent   | ConfigureEitherSingleOrAll   | ConfigCIDValidForPreComponent@@ -139,7 +138,7 @@   | BadVersion String String PkgconfigVersion   | UnknownCompilerException   | NoWorkingGcc-  | NoOSSupport OS+  | NoOSSupport OS String   | NoCompilerSupport String   | InstallDirsNotPrefixRelative (InstallDirs FilePath)   | ExplainErrors (Maybe (Either [Char] [Char])) [String]@@ -153,8 +152,7 @@   | Couldn'tFindTestProgLibV09 FilePath   | TestCoverageSupportLibV09   | RawSystemStdout String-  | FindFileCwd FilePath-  | FindFileEx FilePath+  | FindFile FilePath   | FindModuleFileEx ModuleName [Suffix] [FilePath]   | MultipleFilesWithExtension String   | NoDesc@@ -173,6 +171,7 @@   | BadVersionDb String Version VersionRange FilePath   | UnknownVersionDb String VersionRange FilePath   | MissingCoveredInstalledLibrary UnitId+  | SetupHooksException SetupHooksException   deriving (Show, Typeable)  exceptionCode :: CabalException -> Int@@ -285,8 +284,7 @@   Couldn'tFindTestProgLibV09{} -> 9012   TestCoverageSupportLibV09{} -> 1076   RawSystemStdout{} -> 3098-  FindFileCwd{} -> 4765-  FindFileEx{} -> 2115+  FindFile{} -> 2115   FindModuleFileEx{} -> 6663   MultipleFilesWithExtension{} -> 3333   NoDesc{} -> 7654@@ -305,6 +303,8 @@   BadVersionDb{} -> 8038   UnknownVersionDb{} -> 1008   MissingCoveredInstalledLibrary{} -> 9341+  SetupHooksException err ->+    setupHooksExceptionCode err  versionRequirement :: VersionRange -> String versionRequirement range@@ -314,13 +314,13 @@ exceptionMessage :: CabalException -> String exceptionMessage e = case e of   NoBenchMarkProgram cmd -> "Could not find benchmark program \"" ++ cmd ++ "\". Did you build the package first?"-  EnableBenchMark -> "No benchmarks enabled. Did you remember to configure with " ++ "\'--enable-benchmarks\'?"+  EnableBenchMark -> "No benchmarks enabled. Did you remember to \'Setup configure\' with " ++ "\'--enable-benchmarks\'?"   BenchMarkNameDisabled bmName -> "Package configured with benchmark " ++ bmName ++ " disabled."   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-  UnsupportedTestSuite testType -> "Unsupported test suite type: " ++ testType+  UnsupportedTestSuite test_type -> "Unsupported test suite type: " ++ test_type   UnsupportedBenchMark benchMarkType -> "Unsupported benchmark type: " ++ benchMarkType   NoIncludeFileFound f -> "can't find include file " ++ f   NoModuleFound m suffixes ->@@ -331,8 +331,8 @@       ++ ".\n"       ++ "If the module "       ++ "is autogenerated it should be added to 'autogen-modules'."-  RegMultipleInstancePkg -> "HcPkg.register: the compiler does not support,registering multiple instances of packages."-  SuppressingChecksOnFile -> "HcPkg.register: the compiler does not support ,suppressing checks on files."+  RegMultipleInstancePkg -> "HcPkg.register: the compiler does not support registering multiple instances of packages."+  SuppressingChecksOnFile -> "HcPkg.register: the compiler does not support suppressing checks on files."   NoSupportDirStylePackageDb -> "HcPkg.writeRegistrationFileDirectly: compiler does not support dir style package dbs"   OnlySupportSpecificPackageDb -> "HcPkg.writeRegistrationFileDirectly: only supports SpecificPackageDB for now"   FailedToParseOutputDescribe programId pkgId -> "failed to parse output of '" ++ programId ++ " describe " ++ prettyShow pkgId ++ "'"@@ -353,7 +353,7 @@       ++ " but "       ++ "haddock is using GHC version "       ++ prettyShow haddockGhcVersion-  MustHaveSharedLibraries -> "Must have vanilla or shared libraries " ++ "enabled in order to run haddock"+  MustHaveSharedLibraries -> "Must have vanilla or shared libraries enabled in order to run haddock"   HaddockPackageFlags inf ->     "internal error when calculating transitive "       ++ "package dependencies.\nDebug info: "@@ -362,7 +362,7 @@   FailedToDetermineTarget -> "Failed to determine target."   NoMultipleTargets -> "The 'repl' command does not support multiple targets at once."   REPLNotSupported -> "A REPL is not supported with this compiler."-  NoSupportBuildingTestSuite testType -> "No support for building test suite type " ++ show testType+  NoSupportBuildingTestSuite test_type -> "No support for building test suite type " ++ show test_type   NoSupportBuildingBenchMark benchMarkType -> "No support for building benchmark type " ++ show benchMarkType   BuildingNotSupportedWithCompiler -> "Building is not supported with this compiler."   ProvideHaskellSuiteTool msg -> show msg@@ -391,7 +391,7 @@   GlobalPackageDBLimitation ->     "With current ghc versions the global package db is always used "       ++ "and must be listed first. This ghc limitation may be lifted in "-      ++ "future, see https://gitlab.haskell.org/ghc/ghc/-/issues/5977"+      ++ "the future, 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"@@ -487,8 +487,7 @@       ++ "suite type "       ++ prettyShow tt   NoSupportForPreProcessingBenchmark tt ->-    "No support for preprocessing benchmark "-      ++ "type "+    "No support for preprocessing benchmark type "       ++ prettyShow tt   CantFindSourceForPreProcessFile errorStr -> errorStr   NoSupportPreProcessingTestExtras tt ->@@ -511,11 +510,11 @@   SanityCheckHookedBuildInfo exe1 ->     "The buildinfo contains info for an executable called '"       ++ prettyShow exe1-      ++ "' but the package does not have a "+      ++ "' but the package does not have an "       ++ "executable with that name."-  ConfigureScriptNotFound -> "configure script not found."+  ConfigureScriptNotFound fp -> "configure script not found at " ++ fp ++ "."   NoValidComponent -> "No valid component targets found"-  ConfigureEitherSingleOrAll -> "Can only configure either single component or all of them"+  ConfigureEitherSingleOrAll -> "Can only configure either a single component or all of them"   ConfigCIDValidForPreComponent -> "--cid is only supported for per-component configure"   SanityCheckForEnableComponents ->     "--enable-tests/--enable-benchmarks are incompatible with"@@ -525,23 +524,23 @@       ++ " are incompatible with each other."   UnsupportedLanguages pkgId compilerId langs ->     "The package "-      ++ prettyShow (pkgId)+      ++ prettyShow pkgId       ++ " requires the following languages which are not "       ++ "supported by "-      ++ prettyShow (compilerId)+      ++ prettyShow compilerId       ++ ": "       ++ intercalate ", " langs   UnsupportedLanguageExtension pkgId compilerId exts ->     "The package "-      ++ prettyShow (pkgId)+      ++ prettyShow pkgId       ++ " requires the following language extensions which are not "       ++ "supported by "-      ++ prettyShow (compilerId)+      ++ prettyShow compilerId       ++ ": "       ++ intercalate ", " exts   CantFindForeignLibraries unsupportedFLibs ->     "Cannot build some foreign libraries: "-      ++ intercalate "," unsupportedFLibs+      ++ intercalate ", " unsupportedFLibs   ExpectedAbsoluteDirectory fPath -> "expected an absolute directory name for --prefix: " ++ fPath   FlagsNotSpecified diffFlags ->     "'--exact-configuration' was given, "@@ -572,7 +571,7 @@       ++ "' refers to a library which is defined within the same "       ++ "package. To use this feature the package must specify at "       ++ "least 'cabal-version: >= 1.8'."-  ReportFailedDependencies failed hackageUrl -> (intercalate "\n\n" (map reportFailedDependency failed))+  ReportFailedDependencies failed hackageUrl -> intercalate "\n\n" (map reportFailedDependency failed)     where       reportFailedDependency (DependencyNotExists pkgname) =         "there is no version of "@@ -617,15 +616,16 @@   NoWorkingGcc ->     unlines       [ "No working gcc"-      , "This package depends on foreign library but we cannot "+      , "This package depends on a foreign library but we cannot "           ++ "find a working C compiler. If you have it in a "           ++ "non-standard location you can use the --with-gcc "           ++ "flag to specify it."       ]-  NoOSSupport os ->+  NoOSSupport os what ->     "Operating system: "       ++ prettyShow os-      ++ ", does not support relocatable builds"+      ++ ", does not support "+      ++ what   NoCompilerSupport comp ->     "Compiler: "       ++ comp@@ -673,8 +673,8 @@           ++ "where it is."           ++ "If the library file does exist, it may contain errors that "           ++ "are caught by the C compiler at the preprocessing stage. "-          ++ "In this case you can re-run configure with the verbosity "-          ++ "flag -v3 to see the error messages."+          ++ "In this case you can re-run 'Setup configure' with the "+          ++ "verbosity flag -v3 to see the error messages."       messagePlural =         "This problem can usually be solved by installing the system "           ++ "packages that provide these libraries (you may need the "@@ -684,18 +684,18 @@           ++ "where they are."           ++ "If the library files do exist, it may contain errors that "           ++ "are caught by the C compiler at the preprocessing stage. "-          ++ "In this case you can re-run configure with the verbosity "-          ++ "flag -v3 to see the error messages."+          ++ "In this case you can re-run 'Setup configure' with the "+          ++ "verbosity flag -v3 to see the error messages."       headerCppMessage =         "If the header file does exist, it may contain errors that "           ++ "are caught by the C compiler at the preprocessing stage. "-          ++ "In this case you can re-run configure with the verbosity "-          ++ "flag -v3 to see the error messages."+          ++ "In this case you can re-run 'Setup configure' with the "+          ++ "verbosity flag -v3 to see the error messages."       headerCcMessage =         "The header file contains a compile error. "-          ++ "You can re-run configure with the verbosity flag "+          ++ "You can re-run 'Setup configure' with the verbosity flag "           ++ "-v3 to see the error messages from the C compiler."-  CheckPackageProblems errors -> (intercalate "\n\n" $ errors)+  CheckPackageProblems errors -> intercalate "\n\n" errors   LibDirDepsPrefixNotRelative l p ->     "Library directory of a dependency: "       ++ show l@@ -726,8 +726,7 @@       ++ "\". Did you build the package first?"   TestCoverageSupportLibV09 -> "Test coverage is only supported for packages with a library component."   RawSystemStdout errors -> errors-  FindFileCwd fileName -> fileName ++ " doesn't exist"-  FindFileEx fileName -> fileName ++ " doesn't exist"+  FindFile fileName -> fileName ++ " doesn't exist"   FindModuleFileEx mod_name extensions searchPath ->     "Could not find module: "       ++ prettyShow mod_name@@ -757,7 +756,7 @@   RegisMultiplePkgNotSupported -> "Registering multiple package instances is not yet supported for this compiler"   RegisteringNotImplemented -> "Registering is not implemented for this compiler"   NoTestSuitesEnabled ->-    "No test suites enabled. Did you remember to configure with "+    "No test suites enabled. Did you remember to 'Setup configure' with "       ++ "\'--enable-tests\'?"   TestNameDisabled tName ->     "Package configured with test suite "@@ -799,3 +798,5 @@     "Failed to find the installed unit '"       ++ prettyShow unitId       ++ "' in package database stack."+  SetupHooksException err ->+    setupHooksExceptionMessage err

@@ -0,0 +1,217 @@+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module: Distribution.Simple.FileMonitor.Types+--+-- Types for monitoring files and directories.+module Distribution.Simple.FileMonitor.Types+  ( -- * Globs with respect to a root+    RootedGlob (..)+  , FilePathRoot (..)+  , Glob++    -- * File monitoring+  , MonitorFilePath (..)+  , MonitorKindFile (..)+  , MonitorKindDir (..)++    -- ** Utility constructors of t'MonitorFilePath'+  , monitorFile+  , monitorFileHashed+  , monitorNonExistentFile+  , monitorFileExistence+  , monitorDirectory+  , monitorNonExistentDirectory+  , monitorDirectoryExistence+  , monitorFileOrDirectory+  , monitorFileGlob+  , monitorFileGlobExistence+  , monitorFileSearchPath+  , monitorFileHashedSearchPath+  )+where++import Distribution.Compat.Prelude+import Distribution.Simple.Glob.Internal+  ( Glob (..)+  )++import qualified Distribution.Compat.CharParsing as P+import Distribution.Parsec+import Distribution.Pretty+import qualified Text.PrettyPrint as Disp++--------------------------------------------------------------------------------+-- Rooted globs.+--++-- | A file path specified by globbing, relative+-- to some root directory.+data RootedGlob+  = RootedGlob+      FilePathRoot+      -- ^ what the glob is relative to+      Glob+      -- ^ the glob+  deriving (Eq, Show, Generic)++instance Binary RootedGlob+instance Structured RootedGlob++data FilePathRoot+  = FilePathRelative+  | -- | e.g. @"/"@, @"c:\"@ or result of 'takeDrive'+    FilePathRoot FilePath+  | FilePathHomeDir+  deriving (Eq, Show, Generic)++instance Binary FilePathRoot+instance Structured FilePathRoot++------------------------------------------------------------------------------+-- Types for specifying files to monitor+--++-- | A description of a file (or set of files) to monitor for changes.+--+-- Where file paths are relative they are relative to a common directory+-- (e.g. project root), not necessarily the process current directory.+data MonitorFilePath+  = MonitorFile+      { monitorKindFile :: !MonitorKindFile+      , monitorKindDir :: !MonitorKindDir+      , monitorPath :: !FilePath+      }+  | MonitorFileGlob+      { monitorKindFile :: !MonitorKindFile+      , monitorKindDir :: !MonitorKindDir+      , monitorPathGlob :: !RootedGlob+      }+  deriving (Eq, Show, Generic)++data MonitorKindFile+  = FileExists+  | FileModTime+  | FileHashed+  | FileNotExists+  deriving (Eq, Show, Generic)++data MonitorKindDir+  = DirExists+  | DirModTime+  | DirNotExists+  deriving (Eq, Show, Generic)++instance Binary MonitorFilePath+instance Binary MonitorKindFile+instance Binary MonitorKindDir++instance Structured MonitorFilePath+instance Structured MonitorKindFile+instance Structured MonitorKindDir++-- | Monitor a single file for changes, based on its modification time.+-- The monitored file is considered to have changed if it no longer+-- exists or if its modification time has changed.+monitorFile :: FilePath -> MonitorFilePath+monitorFile = MonitorFile FileModTime DirNotExists++-- | Monitor a single file for changes, based on its modification time+-- and content hash. The monitored file is considered to have changed if+-- it no longer exists or if its modification time and content hash have+-- changed.+monitorFileHashed :: FilePath -> MonitorFilePath+monitorFileHashed = MonitorFile FileHashed DirNotExists++-- | Monitor a single non-existent file for changes. The monitored file+-- is considered to have changed if it exists.+monitorNonExistentFile :: FilePath -> MonitorFilePath+monitorNonExistentFile = MonitorFile FileNotExists DirNotExists++-- | Monitor a single file for existence only. The monitored file is+-- considered to have changed if it no longer exists.+monitorFileExistence :: FilePath -> MonitorFilePath+monitorFileExistence = MonitorFile FileExists DirNotExists++-- | Monitor a single directory for changes, based on its modification+-- time. The monitored directory is considered to have changed if it no+-- longer exists or if its modification time has changed.+monitorDirectory :: FilePath -> MonitorFilePath+monitorDirectory = MonitorFile FileNotExists DirModTime++-- | Monitor a single non-existent directory for changes.  The monitored+-- directory is considered to have changed if it exists.+monitorNonExistentDirectory :: FilePath -> MonitorFilePath+-- Just an alias for monitorNonExistentFile, since you can't+-- tell the difference between a non-existent directory and+-- a non-existent file :)+monitorNonExistentDirectory = monitorNonExistentFile++-- | Monitor a single directory for existence. The monitored directory is+-- considered to have changed only if it no longer exists.+monitorDirectoryExistence :: FilePath -> MonitorFilePath+monitorDirectoryExistence = MonitorFile FileNotExists DirExists++-- | Monitor a single file or directory for changes, based on its modification+-- time. The monitored file is considered to have changed if it no longer+-- exists or if its modification time has changed.+monitorFileOrDirectory :: FilePath -> MonitorFilePath+monitorFileOrDirectory = MonitorFile FileModTime DirModTime++-- | Monitor a set of files (or directories) identified by a file glob.+-- The monitored glob is considered to have changed if the set of files+-- matching the glob changes (i.e. creations or deletions), or for files if the+-- modification time and content hash of any matching file has changed.+monitorFileGlob :: RootedGlob -> MonitorFilePath+monitorFileGlob = MonitorFileGlob FileHashed DirExists++-- | Monitor a set of files (or directories) identified by a file glob for+-- existence only. The monitored glob is considered to have changed if the set+-- of files matching the glob changes (i.e. creations or deletions).+monitorFileGlobExistence :: RootedGlob -> MonitorFilePath+monitorFileGlobExistence = MonitorFileGlob FileExists DirExists++-- | Creates a list of files to monitor when you search for a file which+-- unsuccessfully looked in @notFoundAtPaths@ before finding it at+-- @foundAtPath@.+monitorFileSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]+monitorFileSearchPath notFoundAtPaths foundAtPath =+  monitorFile foundAtPath+    : map monitorNonExistentFile notFoundAtPaths++-- | Similar to 'monitorFileSearchPath', but also instructs us to+-- monitor the hash of the found file.+monitorFileHashedSearchPath :: [FilePath] -> FilePath -> [MonitorFilePath]+monitorFileHashedSearchPath notFoundAtPaths foundAtPath =+  monitorFileHashed foundAtPath+    : map monitorNonExistentFile notFoundAtPaths++------------------------------------------------------------------------------+-- Parsing & pretty-printing+--++instance Pretty RootedGlob where+  pretty (RootedGlob root pathglob) = pretty root Disp.<> pretty pathglob++instance Parsec RootedGlob where+  parsec = do+    root <- parsec+    case root of+      FilePathRelative -> RootedGlob root <$> parsec+      _ -> RootedGlob root <$> parsec <|> pure (RootedGlob root GlobDirTrailing)++instance Pretty FilePathRoot where+  pretty FilePathRelative = Disp.empty+  pretty (FilePathRoot root) = Disp.text root+  pretty FilePathHomeDir = Disp.char '~' Disp.<> Disp.char '/'++instance Parsec FilePathRoot where+  parsec = root <|> P.try home <|> P.try drive <|> pure FilePathRelative+    where+      root = FilePathRoot "/" <$ P.char '/'+      home = FilePathHomeDir <$ P.string "~/"+      drive = do+        dr <- P.satisfy $ \c -> (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')+        _ <- P.char ':'+        _ <- P.char '/' <|> P.char '\\'+        return (FilePathRoot (toUpper dr : ":\\"))

@@ -1,8 +1,10 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}  -----------------------------------------------------------------------------@@ -60,7 +62,7 @@   , Internal.componentCcGhcOptions   , getGhcAppDir   , getLibDir-  , isDynamic+  , compilerBuildWay   , getGlobalPackageDB   , pkgRoot @@ -82,6 +84,7 @@ import Distribution.Compat.Prelude import Prelude () +import Control.Arrow ((***)) import Control.Monad (forM_) import Data.List (stripPrefix) import qualified Data.Map as Map@@ -95,8 +98,8 @@ import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.Errors-import Distribution.Simple.Flag (Flag (..), toFlag) import qualified Distribution.Simple.GHC.Build as GHC+import Distribution.Simple.GHC.Build.Modules (BuildWay (..)) import Distribution.Simple.GHC.Build.Utils import Distribution.Simple.GHC.EnvironmentParser import Distribution.Simple.GHC.ImplInfo@@ -110,7 +113,7 @@ import Distribution.Simple.Program.GHC import qualified Distribution.Simple.Program.HcPkg as HcPkg import qualified Distribution.Simple.Program.Strip as Strip-import Distribution.Simple.Setup.Common (extraCompilationArtifacts)+import Distribution.Simple.Setup.Common import Distribution.Simple.Setup.Repl import Distribution.Simple.Utils import Distribution.System@@ -118,6 +121,7 @@ import Distribution.Types.ParStrat import Distribution.Types.TargetInfo import Distribution.Utils.NubList+import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension@@ -130,9 +134,8 @@   , getDirectoryContents   ) import System.FilePath-  ( takeDirectory-  , (<.>)-  , (</>)+  ( isRelative+  , takeDirectory   ) import qualified System.Info #ifndef mingw32_HOST_OS@@ -392,24 +395,26 @@ -- | Given a single package DB, return all installed packages. getPackageDBContents   :: Verbosity-  -> PackageDB+  -> Maybe (SymbolicPath CWD (Dir from))+  -> PackageDBX (SymbolicPath from (Dir PkgDB))   -> ProgramDb   -> IO InstalledPackageIndex-getPackageDBContents verbosity packagedb progdb = do-  pkgss <- getInstalledPackages' verbosity [packagedb] progdb+getPackageDBContents verbosity mbWorkDir packagedb progdb = do+  pkgss <- getInstalledPackages' verbosity mbWorkDir [packagedb] progdb   toPackageIndex verbosity pkgss progdb  -- | Given a package DB stack, return all installed packages. getInstalledPackages   :: Verbosity   -> Compiler-  -> PackageDBStack+  -> Maybe (SymbolicPath CWD (Dir from))+  -> PackageDBStackX (SymbolicPath from (Dir PkgDB))   -> ProgramDb   -> IO InstalledPackageIndex-getInstalledPackages verbosity comp packagedbs progdb = do+getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do   checkPackageDbEnvVar verbosity   checkPackageDbStack verbosity comp packagedbs-  pkgss <- getInstalledPackages' verbosity packagedbs progdb+  pkgss <- getInstalledPackages' verbosity mbWorkDir packagedbs progdb   index <- toPackageIndex verbosity pkgss progdb   return $! hackRtsPackage index   where@@ -425,7 +430,7 @@ -- 'getInstalledPackages'. toPackageIndex   :: Verbosity-  -> [(PackageDB, [InstalledPackageInfo])]+  -> [(PackageDBX a, [InstalledPackageInfo])]   -> ProgramDb   -> IO InstalledPackageIndex toPackageIndex verbosity pkgss progdb = do@@ -488,7 +493,7 @@ checkPackageDbEnvVar verbosity =   Internal.checkPackageDbEnvVar verbosity "GHC" "GHC_PACKAGE_PATH" -checkPackageDbStack :: Verbosity -> Compiler -> PackageDBStack -> IO ()+checkPackageDbStack :: Eq fp => Verbosity -> Compiler -> PackageDBStackX fp -> IO () checkPackageDbStack verbosity comp =   if flagPackageConf implInfo     then checkPackageDbStackPre76 verbosity@@ -496,7 +501,7 @@   where     implInfo = ghcVersionImplInfo (compilerVersion comp) -checkPackageDbStackPost76 :: Verbosity -> PackageDBStack -> IO ()+checkPackageDbStackPost76 :: Eq fp => Verbosity -> PackageDBStackX fp -> IO () checkPackageDbStackPost76 _ (GlobalPackageDB : rest)   | GlobalPackageDB `notElem` rest = return () checkPackageDbStackPost76 verbosity rest@@ -504,7 +509,7 @@       dieWithException verbosity CheckPackageDbStackPost76 checkPackageDbStackPost76 _ _ = return () -checkPackageDbStackPre76 :: Verbosity -> PackageDBStack -> IO ()+checkPackageDbStackPre76 :: Eq fp => Verbosity -> PackageDBStackX fp -> IO () checkPackageDbStackPre76 _ (GlobalPackageDB : rest)   | GlobalPackageDB `notElem` rest = return () checkPackageDbStackPre76 verbosity rest@@ -525,38 +530,45 @@ -- | Get the packages from specific PackageDBs, not cumulative. getInstalledPackages'   :: Verbosity-  -> [PackageDB]+  -> Maybe (SymbolicPath CWD (Dir from))+  -> [PackageDBX (SymbolicPath from (Dir PkgDB))]   -> ProgramDb-  -> IO [(PackageDB, [InstalledPackageInfo])]-getInstalledPackages' verbosity packagedbs progdb =+  -> IO [(PackageDBX (SymbolicPath from (Dir PkgDB)), [InstalledPackageInfo])]+getInstalledPackages' verbosity mbWorkDir packagedbs progdb =   sequenceA     [ do-      pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity packagedb+      pkgs <- HcPkg.dump (hcPkgInfo progdb) verbosity mbWorkDir packagedb       return (packagedb, pkgs)     | packagedb <- packagedbs     ]  getInstalledPackagesMonitorFiles-  :: Verbosity+  :: forall from+   . Verbosity+  -> Maybe (SymbolicPath CWD (Dir from))   -> Platform   -> ProgramDb-  -> [PackageDB]+  -> [PackageDBS from]   -> IO [FilePath]-getInstalledPackagesMonitorFiles verbosity platform progdb =+getInstalledPackagesMonitorFiles verbosity mbWorkDir platform progdb =   traverse getPackageDBPath   where-    getPackageDBPath :: PackageDB -> IO FilePath+    getPackageDBPath :: PackageDBS from -> IO FilePath     getPackageDBPath GlobalPackageDB =       selectMonitorFile =<< getGlobalPackageDB verbosity ghcProg     getPackageDBPath UserPackageDB =       selectMonitorFile =<< getUserPackageDB verbosity ghcProg platform-    getPackageDBPath (SpecificPackageDB path) = selectMonitorFile path+    getPackageDBPath (SpecificPackageDB path) = selectMonitorFile (interpretSymbolicPath mbWorkDir path)      -- GHC has old style file dbs, and new style directory dbs.     -- Note that for dir style dbs, we only need to monitor the cache file, not     -- the whole directory. The ghc program itself only reads the cache file     -- so it's safe to only monitor this one file.-    selectMonitorFile path = do+    selectMonitorFile path0 = do+      let path =+            if isRelative path0+              then interpretSymbolicPath mbWorkDir (makeRelativePathEx path0)+              else path0       isFileStyle <- doesFileExist path       if isFileStyle         then return path@@ -577,7 +589,11 @@   -> IO () buildLib flags numJobs pkg lbi lib clbi =   GHC.build numJobs pkg $-    PreBuildComponentInputs (BuildNormal flags) lbi (TargetInfo clbi (CLib lib))+    PreBuildComponentInputs+      { buildingWhat = BuildNormal flags+      , localBuildInfo = lbi+      , targetInfo = TargetInfo clbi (CLib lib)+      }  replLib   :: ReplFlags@@ -589,7 +605,11 @@   -> IO () replLib flags numJobs pkg lbi lib clbi =   GHC.build numJobs pkg $-    PreBuildComponentInputs (BuildRepl flags) lbi (TargetInfo clbi (CLib lib))+    PreBuildComponentInputs+      { buildingWhat = BuildRepl flags+      , localBuildInfo = lbi+      , targetInfo = TargetInfo clbi (CLib lib)+      }  -- | Start a REPL without loading any source files. startInterpreter@@ -607,7 +627,7 @@           }   checkPackageDbStack verbosity comp packageDBs   (ghcProg, _) <- requireProgram verbosity ghcProgram progdb-  runGHC verbosity ghcProg comp platform replOpts+  runGHC verbosity ghcProg comp platform Nothing replOpts  -- ----------------------------------------------------------------------------- -- Building an executable or foreign library@@ -623,7 +643,16 @@   -> IO () buildFLib v numJobs pkg lbi flib clbi =   GHC.build numJobs pkg $-    PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CFLib flib))+    PreBuildComponentInputs+      { buildingWhat =+          BuildNormal $+            mempty+              { buildCommonFlags =+                  mempty{setupVerbosity = toFlag v}+              }+      , localBuildInfo = lbi+      , targetInfo = TargetInfo clbi (CFLib flib)+      }  replFLib   :: ReplFlags@@ -635,7 +664,11 @@   -> IO () replFLib replFlags njobs pkg lbi flib clbi =   GHC.build njobs pkg $-    PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CFLib flib))+    PreBuildComponentInputs+      { buildingWhat = BuildRepl replFlags+      , localBuildInfo = lbi+      , targetInfo = TargetInfo clbi (CFLib flib)+      }  -- | Build an executable with GHC. buildExe@@ -648,7 +681,16 @@   -> IO () buildExe v njobs pkg lbi exe clbi =   GHC.build njobs pkg $-    PreBuildComponentInputs (BuildNormal mempty{buildVerbosity = toFlag v}) lbi (TargetInfo clbi (CExe exe))+    PreBuildComponentInputs+      { buildingWhat =+          BuildNormal $+            mempty+              { buildCommonFlags =+                  mempty{setupVerbosity = toFlag v}+              }+      , localBuildInfo = lbi+      , targetInfo = TargetInfo clbi (CExe exe)+      }  replExe   :: ReplFlags@@ -660,7 +702,11 @@   -> IO () replExe replFlags njobs pkg lbi exe clbi =   GHC.build njobs pkg $-    PreBuildComponentInputs (BuildRepl replFlags) lbi (TargetInfo clbi (CExe exe))+    PreBuildComponentInputs+      { buildingWhat = BuildRepl replFlags+      , localBuildInfo = lbi+      , targetInfo = TargetInfo clbi (CExe exe)+      }  -- | Extracts a String representing a hash of the ABI of a built -- library.  It can fail if the library has not yet been built.@@ -676,6 +722,7 @@     libBi = libBuildInfo lib     comp = compiler lbi     platform = hostPlatform lbi+    mbWorkDir = mbWorkDirLBI lbi     vanillaArgs =       (Internal.componentGhcOptions verbosity lbi libBi clbi (componentBuildDir lbi clbi))         `mappend` mempty@@ -689,7 +736,7 @@           , ghcOptFPic = toFlag True           , ghcOptHiSuffix = toFlag "dyn_hi"           , ghcOptObjSuffix = toFlag "dyn_o"-          , ghcOptExtra = hcSharedOptions GHC libBi+          , ghcOptExtra = hcOptions GHC libBi ++ hcSharedOptions GHC libBi           }     profArgs =       vanillaArgs@@ -701,20 +748,37 @@                 (withProfLibDetail lbi)           , ghcOptHiSuffix = toFlag "p_hi"           , ghcOptObjSuffix = toFlag "p_o"-          , ghcOptExtra = hcProfOptions GHC libBi+          , ghcOptExtra = hcOptions GHC libBi ++ hcProfOptions GHC libBi           }-    ghcArgs-      | withVanillaLib lbi = vanillaArgs-      | withSharedLib lbi = sharedArgs-      | withProfLib lbi = profArgs-      | otherwise = error "libAbiHash: Can't find an enabled library way"+    profDynArgs =+      vanillaArgs+        `mappend` mempty+          { ghcOptProfilingMode = toFlag True+          , ghcOptProfilingAuto =+              Internal.profDetailLevelFlag+                True+                (withProfLibDetail lbi)+          , ghcOptDynLinkMode = toFlag GhcDynamicOnly+          , ghcOptFPic = toFlag True+          , ghcOptHiSuffix = toFlag "p_dyn_hi"+          , ghcOptObjSuffix = toFlag "p_dyn_o"+          , ghcOptExtra = hcOptions GHC libBi ++ hcProfSharedOptions GHC libBi+          }+    ghcArgs =+      let (libWays, _, _) = buildWays lbi+       in case libWays (componentIsIndefinite clbi) of+            (ProfDynWay : _) -> profDynArgs+            (ProfWay : _) -> profArgs+            (StaticWay : _) -> vanillaArgs+            (DynWay : _) -> sharedArgs+            _ -> error "libAbiHash: Can't find an enabled library way"    (ghcProg, _) <- requireProgram verbosity ghcProgram (withPrograms lbi)    hash <-     getProgramInvocationOutput       verbosity-      =<< ghcInvocation verbosity ghcProg comp platform ghcArgs+      =<< ghcInvocation verbosity ghcProg comp platform mbWorkDir ghcArgs    return (takeWhile (not . isSpace) hash) @@ -826,80 +890,100 @@   -> ComponentLocalBuildInfo   -> IO () installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do+  let+    (wantedLibWays, _, _) = buildWays lbi+    isIndef = componentIsIndefinite clbi+    libWays = wantedLibWays isIndef++  info verbosity ("Wanted install ways: " ++ show libWays)+   -- copy .hi files over:-  whenVanilla $ copyModuleFiles $ Suffix "hi"-  whenProf $ copyModuleFiles $ Suffix "p_hi"-  whenShared $ copyModuleFiles $ Suffix "dyn_hi"+  forM_ (wantedLibWays isIndef) $ \w -> case w of+    StaticWay -> copyModuleFiles (Suffix "hi")+    DynWay -> copyModuleFiles (Suffix "dyn_hi")+    ProfWay -> copyModuleFiles (Suffix "p_hi")+    ProfDynWay -> copyModuleFiles (Suffix "p_dyn_hi")    -- copy extra compilation artifacts that ghc plugins may produce   copyDirectoryIfExists extraCompilationArtifacts    -- copy the built library files over:-  whenHasCode $ do-    whenVanilla $ do-      sequence_-        [ installOrdinary+  when (has_code && hasLib) $ do+    forM_ libWays $ \w -> case w of+      StaticWay -> do+        sequence_+          [ installOrdinary+            builtDir+            targetDir+            (mkGenericStaticLibName (l ++ f))+          | l <-+              getHSLibraryName+                (componentUnitId clbi)+                : (extraBundledLibs (libBuildInfo lib))+          , f <- "" : extraLibFlavours (libBuildInfo lib)+          ]+        whenGHCi $ installOrdinary builtDir targetDir ghciLibName+      ProfWay -> do+        installOrdinary builtDir targetDir profileLibName+        whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName+      ProfDynWay -> do+        installShared           builtDir-          targetDir-          (mkGenericStaticLibName (l ++ f))-        | l <--            getHSLibraryName-              (componentUnitId clbi)-              : (extraBundledLibs (libBuildInfo lib))-        , f <- "" : extraLibFlavours (libBuildInfo lib)-        ]-      whenGHCi $ installOrdinary builtDir targetDir ghciLibName-    whenProf $ do-      installOrdinary builtDir targetDir profileLibName-      whenGHCi $ installOrdinary builtDir targetDir ghciProfLibName-    whenShared $-      if-          -- The behavior for "extra-bundled-libraries" changed in version 2.5.0.-          -- See ghc issue #15837 and Cabal PR #5855.-          | specVersion pkg < CabalSpecV3_0 -> do-              sequence_-                [ installShared-                  builtDir-                  dynlibTargetDir-                  (mkGenericSharedLibName platform compiler_id (l ++ f))-                | l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)-                , f <- "" : extraDynLibFlavours (libBuildInfo lib)-                ]-          | otherwise -> do-              sequence_-                [ installShared-                  builtDir-                  dynlibTargetDir-                  ( mkGenericSharedLibName-                      platform-                      compiler_id-                      (getHSLibraryName uid ++ f)-                  )-                | f <- "" : extraDynLibFlavours (libBuildInfo lib)-                ]-              sequence_-                [ do-                  files <- getDirectoryContents builtDir-                  let l' =-                        mkGenericSharedBundledLibName-                          platform-                          compiler_id-                          l-                  forM_ files $ \file ->-                    when (l' `isPrefixOf` file) $ do-                      isFile <- doesFileExist (builtDir </> file)-                      when isFile $ do-                        installShared-                          builtDir-                          dynlibTargetDir-                          file-                | l <- extraBundledLibs (libBuildInfo lib)-                ]+          dynlibTargetDir+          (mkProfSharedLibName platform compiler_id uid)+      DynWay -> do+        if+            -- The behavior for "extra-bundled-libraries" changed in version 2.5.0.+            -- See ghc issue #15837 and Cabal PR #5855.+            | specVersion pkg < CabalSpecV3_0 -> do+                sequence_+                  [ installShared+                    builtDir+                    dynlibTargetDir+                    (mkGenericSharedLibName platform compiler_id (l ++ f))+                  | l <- getHSLibraryName uid : extraBundledLibs (libBuildInfo lib)+                  , f <- "" : extraDynLibFlavours (libBuildInfo lib)+                  ]+            | otherwise -> do+                sequence_+                  [ installShared+                    builtDir+                    dynlibTargetDir+                    ( mkGenericSharedLibName+                        platform+                        compiler_id+                        (getHSLibraryName uid ++ f)+                    )+                  | f <- "" : extraDynLibFlavours (libBuildInfo lib)+                  ]+                sequence_+                  [ do+                    files <- getDirectoryContents (i builtDir)+                    let l' =+                          mkGenericSharedBundledLibName+                            platform+                            compiler_id+                            (l ++ f)+                    forM_ files $ \file ->+                      when (l' `isPrefixOf` file) $ do+                        isFile <- doesFileExist (i $ builtDir </> makeRelativePathEx file)+                        when isFile $ do+                          installShared+                            builtDir+                            dynlibTargetDir+                            file+                  | l <- extraBundledLibs (libBuildInfo lib)+                  , f <- "" : extraDynLibFlavours (libBuildInfo lib)+                  ]   where+    -- See Note [Symbolic paths] in Distribution.Utils.Path+    i = interpretSymbolicPathLBI lbi+     builtDir = componentBuildDir lbi clbi+    mbWorkDir = mbWorkDirLBI lbi      install isShared srcDir dstDir name = do-      let src = srcDir </> name+      let src = i $ srcDir </> makeRelativePathEx name           dst = dstDir </> name        createDirectoryIfMissingVerbose verbosity True dstDir@@ -918,13 +1002,15 @@     installOrdinary = install False     installShared = install True -    copyModuleFiles ext =-      findModuleFilesEx verbosity [builtDir] [ext] (allLibModules lib clbi)-        >>= installOrdinaryFiles verbosity targetDir+    copyModuleFiles ext = do+      files <- findModuleFilesCwd verbosity mbWorkDir [builtDir] [ext] (allLibModules lib clbi)+      let files' = map (i *** getSymbolicPath) files+      installOrdinaryFiles verbosity targetDir files' +    copyDirectoryIfExists :: RelativePath Build (Dir Artifacts) -> IO ()     copyDirectoryIfExists dirName = do-      let src = builtDir </> dirName-          dst = targetDir </> dirName+      let src = i $ builtDir </> dirName+          dst = targetDir </> getSymbolicPath dirName       dirExists <- doesDirectoryExist src       when dirExists $ copyDirectoryRecursive verbosity src dst @@ -947,11 +1033,7 @@       Platform JavaScript _ -> True       _ -> False     has_code = not (componentIsIndefinite clbi)-    whenHasCode = when has_code-    whenVanilla = when (hasLib && withVanillaLib lbi)-    whenProf = when (hasLib && withProfLib lbi && has_code)     whenGHCi = when (hasLib && withGHCiLib lbi && has_code)-    whenShared = when (hasLib && withSharedLib lbi && has_code)  -- ----------------------------------------------------------------------------- -- Registering@@ -977,20 +1059,22 @@ registerPackage   :: Verbosity   -> ProgramDb-  -> PackageDBStack+  -> Maybe (SymbolicPath CWD (Dir from))+  -> PackageDBStackS from   -> InstalledPackageInfo   -> HcPkg.RegisterOptions   -> IO ()-registerPackage verbosity progdb packageDbs installedPkgInfo registerOptions =+registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions =   HcPkg.register     (hcPkgInfo progdb)     verbosity+    mbWorkDir     packageDbs     installedPkgInfo     registerOptions -pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO FilePath-pkgRoot verbosity lbi = pkgRoot'+pkgRoot :: Verbosity -> LocalBuildInfo -> PackageDB -> IO (SymbolicPath CWD (Dir Pkg))+pkgRoot verbosity lbi = fmap makeSymbolicPath . pkgRoot'   where     pkgRoot' GlobalPackageDB =       let ghcProg = fromMaybe (error "GHC.pkgRoot: no ghc program") $ lookupProgram ghcProgram (withPrograms lbi)@@ -1006,9 +1090,12 @@               : prettyShow ver           rootDir = appDir </> subdir       -- We must create the root directory for the user package database if it-      -- does not yet exists. Otherwise '${pkgroot}' will resolve to a+      -- does not yet exist. Otherwise '${pkgroot}' will resolve to a       -- directory at the time of 'ghc-pkg register', and registration will       -- fail.       createDirectoryIfMissing True rootDir       return rootDir-    pkgRoot' (SpecificPackageDB fp) = return (takeDirectory fp)+    pkgRoot' (SpecificPackageDB fp) =+      return $+        takeDirectory $+          interpretSymbolicPathLBI lbi fp

@@ -1,30 +1,33 @@+{-# LANGUAGE DataKinds #-}+ module Distribution.Simple.GHC.Build where  import Distribution.Compat.Prelude import Prelude ()  import Control.Monad.IO.Class-import qualified Data.Set as Set import Distribution.PackageDescription as PD hiding (buildInfo) import Distribution.Simple.Build.Inputs import Distribution.Simple.Flag (Flag) import Distribution.Simple.GHC.Build.ExtraSources import Distribution.Simple.GHC.Build.Link import Distribution.Simple.GHC.Build.Modules-import Distribution.Simple.GHC.Build.Utils (withDynFLib)+import Distribution.Simple.GHC.Build.Utils (isHaskell) import Distribution.Simple.LocalBuildInfo-import Distribution.Simple.Program+import Distribution.Simple.Program.Builtin (ghcProgram)+import Distribution.Simple.Program.Db (requireProgram) import Distribution.Simple.Utils-import Distribution.Types.ComponentLocalBuildInfo (componentIsIndefinite)++import Distribution.Types.ComponentLocalBuildInfo+import Distribution.Types.PackageName.Magic (fakePackageId) import Distribution.Types.ParStrat import Distribution.Utils.NubList (fromNubListR)-import System.Directory hiding (exeExtension)-import System.FilePath+import Distribution.Utils.Path -{--Note [Build Target Dir vs Target Dir]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+import System.FilePath (splitDirectories) +{- Note [Build Target Dir vs Target Dir]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Where to place the build result (targetDir) and the build artifacts (buildTargetDir).  \* For libraries, targetDir == buildTargetDir, where both the library and@@ -47,7 +50,7 @@ invocations that different OSes constrain us to. Cabal invocations can rapidly reach this limit, in part, due to the long length of cabal v2 prefixes. To minimize the likelihood, we use-`makeRelativeToCurrentDirectory` to shorten the paths used in invocations+`tryMakeRelativeToWorkingDir` to shorten the paths used in invocations (see da6321bb).  However, in executables, we don't do this. It seems that we don't need to do it@@ -68,73 +71,68 @@ build numJobs pkg_descr pbci = do   let     verbosity = buildVerbosity pbci-    component = buildComponent pbci     isLib = buildIsLib pbci     lbi = localBuildInfo pbci     clbi = buildCLBI pbci+    isIndef = componentIsIndefinite clbi+    mbWorkDir = mbWorkDirLBI lbi+    i = interpretSymbolicPathLBI lbi -- See Note [Symbolic paths] in Distribution.Utils.Path    -- Create a few directories for building the component   -- See Note [Build Target Dir vs Target Dir]-  let targetDir_absolute = componentBuildDir lbi clbi-      buildTargetDir_absolute+  let targetDir0 :: SymbolicPath Pkg ('Dir Build)+      targetDir0 = componentBuildDir lbi clbi+      buildTargetDir0 :: SymbolicPath Pkg ('Dir Artifacts)+      buildTargetDir0         -- Libraries use the target dir for building (see above)-        | isLib = targetDir_absolute+        | isLib = coerceSymbolicPath targetDir0         -- In other cases, use targetDir/<name-of-target-dir>-tmp-        | targetDirName : _ <- reverse $ splitDirectories targetDir_absolute =-            targetDir_absolute </> (targetDirName ++ "-tmp")+        | targetDirName : _ <- reverse $ splitDirectories $ getSymbolicPath targetDir0 =+            coerceSymbolicPath targetDir0 </> makeRelativePathEx (targetDirName ++ "-tmp")         | otherwise = error "GHC.build: targetDir is empty"    liftIO $ do-    createDirectoryIfMissingVerbose verbosity True targetDir_absolute-    createDirectoryIfMissingVerbose verbosity True buildTargetDir_absolute+    createDirectoryIfMissingVerbose verbosity True $ i targetDir0+    createDirectoryIfMissingVerbose verbosity True $ i buildTargetDir0    -- See Note [Build Target Dir vs Target Dir] as well-  _targetDir <- liftIO $ makeRelativeToCurrentDirectory targetDir_absolute+  let targetDir = targetDir0 -- NB: no 'makeRelative'   buildTargetDir <--    -- To preserve the previous behaviour, we don't use relative dirs for-    -- executables. Historically, this isn't needed to reduce the CLI limit-    -- (unlike for libraries) because we link executables with the module names-    -- instead of passing the path to object file -- that's something else we-    -- can now fix after the refactor lands.     if isLib-      then liftIO $ makeRelativeToCurrentDirectory buildTargetDir_absolute-      else return buildTargetDir_absolute+      then -- NB: this might fail to make the buildTargetDir relative,+      -- as noted in #9776. Oh well.+        tryMakeRelative mbWorkDir buildTargetDir0+      else return buildTargetDir0+  -- To preserve the previous behaviour, we don't use relative dirs for+  -- executables. Historically, this isn't needed to reduce the CLI limit+  -- (unlike for libraries) because we link executables with the module names+  -- instead of passing the path to object file -- that's something else we+  -- can now fix after the refactor lands.    (ghcProg, _) <- liftIO $ requireProgram verbosity ghcProgram (withPrograms lbi) -  -- Determine in which ways we want to build the component-  let-    wantVanilla = if isLib then withVanillaLib lbi else False-    -- Arguably, wantStatic should be "withFullyStaticExe lbi" for executables,-    -- but it was not before the refactor.-    wantStatic = if isLib then withStaticLib lbi else not (wantDynamic || wantProf)-    wantDynamic = case component of-      CLib{} -> withSharedLib lbi-      CFLib flib -> withDynFLib flib-      CExe{} -> withDynExe lbi-      CTest{} -> withDynExe lbi-      CBench{} -> withDynExe lbi-    wantProf = if isLib then withProfLib lbi else withProfExe lbi--    -- See also Note [Building Haskell Modules accounting for TH] in Distribution.Simple.GHC.Build.Modules-    -- We build static by default if no other way is wanted.-    -- For executables and foreign libraries, there should only be one wanted way.-    wantedWays =-      Set.fromList $-        -- If building a library, we accumulate all the ways,-        -- otherwise, we take just one.-        (if isLib then id else take 1) $-          [ProfWay | wantProf]-            -- I don't see why we shouldn't build with dynamic-            -- indefinite components.-            <> [DynWay | wantDynamic && not (componentIsIndefinite clbi)]-            <> [StaticWay | wantStatic || wantVanilla || not (wantDynamic || wantProf)]--  liftIO $ info verbosity ("Wanted build ways: " ++ show (Set.toList wantedWays))+  let wantedWays@(wantedLibWays, _, wantedExeWay) = buildWays lbi +  liftIO $ info verbosity ("Wanted build ways(" ++ show isLib ++ "): " ++ show (if isLib then wantedLibWays isIndef else [wantedExeWay]))   -- We need a separate build and link phase, and C sources must be compiled   -- after Haskell modules, because C sources may depend on stub headers   -- generated from compiling Haskell modules (#842, #3294).-  buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir_absolute wantedWays pbci-  extraSources <- buildAllExtraSources ghcProg buildTargetDir pbci-  linkOrLoadComponent ghcProg pkg_descr (fromNubListR extraSources) (buildTargetDir, targetDir_absolute) (wantedWays, buildOpts) pbci+  (mbMainFile, inputModules) <- componentInputs buildTargetDir pkg_descr pbci+  let (hsMainFile, nonHsMainFile) =+        case mbMainFile of+          Just mainFile+            | PD.package pkg_descr == fakePackageId+                || isHaskell (getSymbolicPath mainFile) ->+                (Just mainFile, Nothing)+            | otherwise ->+                (Nothing, Just mainFile)+          Nothing -> (Nothing, Nothing)+  buildOpts <- buildHaskellModules numJobs ghcProg hsMainFile inputModules buildTargetDir (wantedLibWays isIndef) pbci+  extraSources <- buildAllExtraSources nonHsMainFile ghcProg buildTargetDir wantedWays pbci+  linkOrLoadComponent+    ghcProg+    pkg_descr+    (fromNubListR extraSources)+    (buildTargetDir, targetDir)+    (wantedWays, buildOpts)+    pbci

@@ -1,6 +1,8 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}  module Distribution.Simple.GHC.Build.ExtraSources where @@ -16,26 +18,30 @@ import Distribution.Types.Component import Distribution.Types.TargetInfo +import Distribution.Simple.Build.Inputs+import Distribution.Simple.GHC.Build.Modules import Distribution.Simple.GHC.Build.Utils import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program.Types import Distribution.System (Arch (JavaScript), Platform (..)) import Distribution.Types.ComponentLocalBuildInfo-import Distribution.Types.Executable+import Distribution.Utils.Path import Distribution.Verbosity (Verbosity) -import Distribution.Simple.Build.Inputs- -- | An action that builds all the extra build sources of a component, i.e. C, -- C++, Js, Asm, C-- sources. buildAllExtraSources-  :: ConfiguredProgram+  :: Maybe (SymbolicPath Pkg File)+  -- ^ An optional non-Haskell Main file+  -> ConfiguredProgram   -- ^ The GHC configured program-  -> FilePath+  -> SymbolicPath Pkg (Dir Artifacts)   -- ^ The build directory for this target+  -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)+  -- ^ Needed build ways   -> PreBuildComponentInputs   -- ^ The context and component being built in it.-  -> IO (NubListR FilePath)+  -> IO (NubListR (SymbolicPath Pkg File))   -- ^ Returns the (nubbed) list of extra sources that were built buildAllExtraSources =   mconcat@@ -51,43 +57,50 @@   , buildJsSources   , buildAsmSources   , buildCmmSources-    :: ConfiguredProgram+    :: Maybe (SymbolicPath Pkg File)+    -- ^ An optional non-Haskell Main file+    -> ConfiguredProgram     -- ^ The GHC configured program-    -> FilePath+    -> SymbolicPath Pkg (Dir Artifacts)     -- ^ The build directory for this target+    -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)+    -- ^ Needed build ways     -> PreBuildComponentInputs     -- ^ The context and component being built in it.-    -> IO (NubListR FilePath)+    -> IO (NubListR (SymbolicPath Pkg File))     -- ^ Returns the list of extra sources that were built-buildCSources =+buildCSources mbMainFile =   buildExtraSources     "C Sources"     Internal.componentCcGhcOptions-    True-    ( \c ->-        cSources (componentBuildInfo c)-          ++ case c of-            CExe exe | isC (modulePath exe) -> [modulePath exe]-            _otherwise -> []+    ( \c -> do+        let cFiles = cSources (componentBuildInfo c)+        case c of+          CExe{}+            | Just main <- mbMainFile+            , isC $ getSymbolicPath main ->+                cFiles ++ [main]+          _otherwise -> cFiles     )-buildCxxSources =+buildCxxSources mbMainFile =   buildExtraSources     "C++ Sources"     Internal.componentCxxGhcOptions-    True-    ( \c ->-        cxxSources (componentBuildInfo c)-          ++ case c of-            CExe exe | isCxx (modulePath exe) -> [modulePath exe]-            _otherwise -> []+    ( \c -> do+        let cxxFiles = cxxSources (componentBuildInfo c)+        case c of+          CExe{}+            | Just main <- mbMainFile+            , isCxx $ getSymbolicPath main ->+                cxxFiles ++ [main]+          _otherwise -> cxxFiles     )-buildJsSources ghcProg buildTargetDir = do+buildJsSources _mbMainFile ghcProg buildTargetDir neededWays = do   Platform hostArch _ <- hostPlatform <$> localBuildInfo   let hasJsSupport = hostArch == JavaScript   buildExtraSources     "JS Sources"     Internal.componentJsGhcOptions-    False     ( \c ->         if hasJsSupport           then -- JS files are C-like with GHC's JS backend: they are@@ -99,17 +112,16 @@     )     ghcProg     buildTargetDir-buildAsmSources =+    neededWays+buildAsmSources _mbMainFile =   buildExtraSources     "Assembler Sources"     Internal.componentAsmGhcOptions-    True     (asmSources . componentBuildInfo)-buildCmmSources =+buildCmmSources _mbMainFile =   buildExtraSources     "C-- Sources"     Internal.componentCmmGhcOptions-    True     (cmmSources . componentBuildInfo)  -- | Create 'PreBuildComponentRules' for a given type of extra build sources@@ -118,16 +130,19 @@ buildExtraSources   :: String   -- ^ String describing the extra sources being built, for printing.-  -> (Verbosity -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo -> FilePath -> FilePath -> GhcOptions)+  -> ( Verbosity+       -> LocalBuildInfo+       -> BuildInfo+       -> ComponentLocalBuildInfo+       -> SymbolicPath Pkg (Dir Artifacts)+       -> SymbolicPath Pkg File+       -> GhcOptions+     )   -- ^ Function to determine the @'GhcOptions'@ for the   -- invocation of GHC when compiling these extra sources (e.g.   -- @'Internal.componentCxxGhcOptions'@,   -- @'Internal.componentCmmGhcOptions'@)-  -> Bool-  -- ^ Some types of build sources should not be built in the dynamic way, namely, JS sources.-  -- I'm not entirely sure this remains true after we migrate to supporting GHC's JS backend rather than GHCJS.-  -- Boolean for "do we allow building these sources the dynamic way?"-  -> (Component -> [FilePath])+  -> (Component -> [SymbolicPath Pkg File])   -- ^ View the extra sources of a component, typically from   -- the build info (e.g. @'asmSources'@, @'cSources'@).   -- @'Executable'@ components might additionally add the@@ -135,104 +150,107 @@   -- if it should be compiled as the rest of them.   -> ConfiguredProgram   -- ^ The GHC configured program-  -> FilePath+  -> SymbolicPath Pkg (Dir Artifacts)   -- ^ The build directory for this target+  -> (Bool -> [BuildWay], Bool -> BuildWay, BuildWay)+  -- ^ Needed build ways   -> PreBuildComponentInputs   -- ^ The context and component being built in it.-  -> IO (NubListR FilePath)+  -> IO (NubListR (SymbolicPath Pkg File))   -- ^ Returns the list of extra sources that were built-buildExtraSources description componentSourceGhcOptions wantDyn viewSources ghcProg buildTargetDir =-  \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} ->-    let-      bi = componentBuildInfo (targetComponent targetInfo)-      verbosity = buildingWhatVerbosity buildingWhat-      clbi = targetCLBI targetInfo--      sources = viewSources (targetComponent targetInfo)+buildExtraSources+  description+  componentSourceGhcOptions+  viewSources+  ghcProg+  buildTargetDir+  (neededLibWays, neededFLibWay, neededExeWay) =+    \PreBuildComponentInputs{buildingWhat, localBuildInfo = lbi, targetInfo} -> do+      let+        bi = componentBuildInfo (targetComponent targetInfo)+        verbosity = buildingWhatVerbosity buildingWhat+        clbi = targetCLBI targetInfo+        isIndef = componentIsIndefinite clbi+        mbWorkDir = mbWorkDirLBI lbi+        i = interpretSymbolicPath mbWorkDir+        sources = viewSources (targetComponent targetInfo)+        comp = compiler lbi+        platform = hostPlatform lbi+        runGhcProg = runGHC verbosity ghcProg comp platform -      comp = compiler lbi-      platform = hostPlatform lbi-      -- Instead of keeping this logic here, we really just want to-      -- receive as an input the `neededWays` from GHC/Build.build and build-      -- accordingly, since we've already determined the extra needed ways-      -- needed for e.g. template haskell. Although we'd have to account for 'wantDyn'.-      isGhcDynamic = isDynamic comp-      doingTH = usesTemplateHaskellOrQQ bi-      forceSharedLib = doingTH && isGhcDynamic-      runGhcProg = runGHC verbosity ghcProg comp platform+        buildAction :: SymbolicPath Pkg File -> IO ()+        buildAction sourceFile = do+          let baseSrcOpts =+                componentSourceGhcOptions+                  verbosity+                  lbi+                  bi+                  clbi+                  buildTargetDir+                  sourceFile+              vanillaSrcOpts =+                -- -fPIC is used in case you are using the repl+                -- of a dynamically linked GHC+                baseSrcOpts{ghcOptFPic = toFlag True}+              profSrcOpts =+                vanillaSrcOpts+                  `mappend` mempty+                    { ghcOptProfilingMode = toFlag True+                    }+              sharedSrcOpts =+                vanillaSrcOpts+                  `mappend` mempty+                    { ghcOptFPic = toFlag True+                    , ghcOptDynLinkMode = toFlag GhcDynamicOnly+                    }+              profSharedSrcOpts =+                vanillaSrcOpts+                  `mappend` mempty+                    { ghcOptProfilingMode = toFlag True+                    , ghcOptFPic = toFlag True+                    , ghcOptDynLinkMode = toFlag GhcDynamicOnly+                    }+              -- TODO: Placing all Haskell, C, & C++ objects in a single directory+              --       Has the potential for file collisions. In general we would+              --       consider this a user error. However, we should strive to+              --       add a warning if this occurs.+              odir = fromFlag (ghcOptObjDir vanillaSrcOpts) -      buildAction sourceFile = do-        let baseSrcOpts =-              componentSourceGhcOptions-                verbosity-                lbi-                bi-                clbi-                buildTargetDir-                sourceFile-            vanillaSrcOpts-              -- Dynamic GHC requires C sources to be built-              -- with -fPIC for REPL to work. See #2207.-              | isGhcDynamic && wantDyn = baseSrcOpts{ghcOptFPic = toFlag True}-              | otherwise = baseSrcOpts-            profSrcOpts =-              vanillaSrcOpts-                `mappend` mempty-                  { ghcOptProfilingMode = toFlag True-                  }-            sharedSrcOpts =-              vanillaSrcOpts-                `mappend` mempty-                  { ghcOptFPic = toFlag True-                  , ghcOptDynLinkMode = toFlag GhcDynamicOnly-                  }-            -- TODO: Placing all Haskell, C, & C++ objects in a single directory-            --       Has the potential for file collisions. In general we would-            --       consider this a user error. However, we should strive to-            --       add a warning if this occurs.-            odir = fromFlag (ghcOptObjDir vanillaSrcOpts)-            compileIfNeeded opts = do-              needsRecomp <- checkNeedsRecompilation sourceFile opts-              when needsRecomp $ runGhcProg opts+              compileIfNeeded :: GhcOptions -> IO ()+              compileIfNeeded opts = do+                needsRecomp <- checkNeedsRecompilation mbWorkDir sourceFile opts+                when needsRecomp $ runGhcProg mbWorkDir opts -        -- TODO: This whole section can be streamlined to the-        -- wantedWays+neededWays logic used in Build/Modules.hs-        createDirectoryIfMissingVerbose verbosity True odir-        case targetComponent targetInfo of-          -- For libraries, we compile extra objects in the three ways: vanilla, shared, and profiled.-          -- We suffix shared objects with .dyn_o and profiled ones with .p_o.-          CLib _lib-            -- Unless for repl, in which case we only need the vanilla way-            | BuildRepl _ <- buildingWhat ->-                compileIfNeeded vanillaSrcOpts-            | otherwise ->-                do+          createDirectoryIfMissingVerbose verbosity True (i odir)+          case targetComponent targetInfo of+            -- For libraries, we compile extra objects in the four ways: vanilla, shared, profiled and profiled shared.+            -- We suffix shared objects with `.dyn_o`, profiled ones with `.p_o` and profiled shared ones with `.p_dyn_o`.+            CLib _lib+              -- Unless for repl, in which case we only need the vanilla way+              | BuildRepl _ <- buildingWhat ->                   compileIfNeeded vanillaSrcOpts-                  when (wantDyn && (forceSharedLib || withSharedLib lbi)) $-                    compileIfNeeded sharedSrcOpts{ghcOptObjSuffix = toFlag "dyn_o"}-                  when (withProfLib lbi) $-                    compileIfNeeded profSrcOpts{ghcOptObjSuffix = toFlag "p_o"}--          -- For foreign libraries, we determine with which options to build the-          -- objects (vanilla vs shared vs profiled)-          CFLib flib-            | withProfExe lbi -> -- It doesn't sound right to query "ProfExe" for a foreign library...-                compileIfNeeded profSrcOpts-            | withDynFLib flib && wantDyn ->-                compileIfNeeded sharedSrcOpts-            | otherwise ->-                compileIfNeeded vanillaSrcOpts-          -- For the remaining component types (Exec, Test, Bench), we also-          -- determine with which options to build the objects (vanilla vs shared vs-          -- profiled), but predicate is the same for the three kinds.-          _exeLike-            | withProfExe lbi ->-                compileIfNeeded profSrcOpts-            | withDynExe lbi && wantDyn ->-                compileIfNeeded sharedSrcOpts-            | otherwise ->-                compileIfNeeded vanillaSrcOpts-     in+              | otherwise ->+                  do+                    forM_ (neededLibWays isIndef) $ \case+                      StaticWay -> compileIfNeeded vanillaSrcOpts+                      DynWay -> compileIfNeeded sharedSrcOpts{ghcOptObjSuffix = toFlag "dyn_o"}+                      ProfWay -> compileIfNeeded profSrcOpts{ghcOptObjSuffix = toFlag "p_o"}+                      ProfDynWay -> compileIfNeeded profSharedSrcOpts{ghcOptObjSuffix = toFlag "p_dyn_o"}+            CFLib flib ->+              case neededFLibWay (withDynFLib flib) of+                StaticWay -> compileIfNeeded vanillaSrcOpts+                DynWay -> compileIfNeeded sharedSrcOpts+                ProfWay -> compileIfNeeded profSrcOpts+                ProfDynWay -> compileIfNeeded profSharedSrcOpts+            -- For the remaining component types (Exec, Test, Bench), we also+            -- determine with which options to build the objects (vanilla vs shared vs+            -- profiled), but predicate is the same for the three kinds.+            _exeLike ->+              case neededExeWay of+                StaticWay -> compileIfNeeded vanillaSrcOpts+                DynWay -> compileIfNeeded sharedSrcOpts+                ProfWay -> compileIfNeeded profSrcOpts+                ProfDynWay -> compileIfNeeded profSharedSrcOpts       -- build any sources       if (null sources || componentIsIndefinite clbi)         then return mempty