Cabal 3.14.2.0 → 3.16.1.0
raw patch · 85 files changed
Files
- Cabal.cabal +38/−24
- ChangeLog.md +7/−1
- LICENSE +1/−1
- src/Distribution/Backpack/Configure.hs +1/−3
- src/Distribution/Backpack/ConfiguredComponent.hs +0/−2
- src/Distribution/Backpack/Id.hs +2/−1
- src/Distribution/Backpack/ModuleScope.hs +0/−2
- src/Distribution/Backpack/PreModuleShape.hs +0/−1
- src/Distribution/Compat/Environment.hs +1/−1
- src/Distribution/Compat/FilePath.hs +1/−1
- src/Distribution/Compat/GetShortPathName.hs +1/−1
- src/Distribution/Compat/Internal/TempFile.hs +3/−98
- src/Distribution/Compat/Time.hs +1/−1
- src/Distribution/GetOpt.hs +4/−4
- src/Distribution/PackageDescription/Check.hs +0/−2
- src/Distribution/PackageDescription/Check/Common.hs +2/−2
- src/Distribution/PackageDescription/Check/Monad.hs +1/−1
- src/Distribution/PackageDescription/Check/Paths.hs +1/−0
- src/Distribution/PackageDescription/Check/Target.hs +39/−1
- src/Distribution/PackageDescription/Check/Warning.hs +15/−10
- src/Distribution/Simple.hs +2/−4
- src/Distribution/Simple/Bench.hs +3/−4
- src/Distribution/Simple/Build.hs +9/−35
- src/Distribution/Simple/Build/Inputs.hs +0/−4
- src/Distribution/Simple/Build/Macros.hs +1/−1
- src/Distribution/Simple/Build/PackageInfoModule.hs +1/−1
- src/Distribution/Simple/Build/PackageInfoModule/Z.hs +24/−1
- src/Distribution/Simple/Build/PathsModule.hs +1/−0
- src/Distribution/Simple/Build/PathsModule/Z.hs +85/−8
- src/Distribution/Simple/BuildTarget.hs +0/−1
- src/Distribution/Simple/BuildToolDepends.hs +1/−2
- src/Distribution/Simple/Command.hs +2/−2
- src/Distribution/Simple/Compiler.hs +17/−8
- src/Distribution/Simple/Configure.hs +84/−28
- src/Distribution/Simple/ConfigureScript.hs +23/−7
- src/Distribution/Simple/Errors.hs +14/−10
- src/Distribution/Simple/Flag.hs +16/−48
- src/Distribution/Simple/GHC.hs +109/−49
- src/Distribution/Simple/GHC/Build/ExtraSources.hs +14/−2
- src/Distribution/Simple/GHC/Build/Link.hs +58/−16
- src/Distribution/Simple/GHC/Build/Modules.hs +20/−13
- src/Distribution/Simple/GHC/EnvironmentParser.hs +0/−3
- src/Distribution/Simple/GHC/Internal.hs +31/−8
- src/Distribution/Simple/GHCJS.hs +57/−20
- src/Distribution/Simple/Glob.hs +27/−9
- src/Distribution/Simple/Glob/Internal.hs +0/−2
- src/Distribution/Simple/Haddock.hs +17/−15
- src/Distribution/Simple/HaskellSuite.hs +0/−270
- src/Distribution/Simple/Install.hs +0/−12
- src/Distribution/Simple/InstallDirs.hs +1/−1
- src/Distribution/Simple/LocalBuildInfo.hs +0/−2
- src/Distribution/Simple/PackageIndex.hs +54/−15
- src/Distribution/Simple/PreProcess.hs +17/−35
- src/Distribution/Simple/PreProcess/Types.hs +2/−1
- src/Distribution/Simple/Program.hs +1/−2
- src/Distribution/Simple/Program/Ar.hs +1/−1
- src/Distribution/Simple/Program/Builtin.hs +44/−72
- src/Distribution/Simple/Program/Find.hs +0/−2
- src/Distribution/Simple/Program/GHC.hs +128/−14
- src/Distribution/Simple/Program/Internal.hs +12/−5
- src/Distribution/Simple/Program/Ld.hs +1/−3
- src/Distribution/Simple/Program/ResponseFile.hs +2/−7
- src/Distribution/Simple/Program/Run.hs +2/−1
- src/Distribution/Simple/Program/Types.hs +1/−1
- src/Distribution/Simple/Register.hs +5/−7
- src/Distribution/Simple/Setup.hs +5/−2
- src/Distribution/Simple/Setup/Benchmark.hs +3/−2
- src/Distribution/Simple/Setup/Common.hs +36/−5
- src/Distribution/Simple/Setup/Config.hs +1/−8
- src/Distribution/Simple/Setup/Copy.hs +0/−1
- src/Distribution/Simple/Setup/Haddock.hs +132/−149
- src/Distribution/Simple/Setup/Install.hs +0/−1
- src/Distribution/Simple/Setup/Repl.hs +9/−1
- src/Distribution/Simple/Setup/Test.hs +3/−2
- src/Distribution/Simple/SetupHooks/Internal.hs +0/−1
- src/Distribution/Simple/SetupHooks/Rule.hs +5/−7
- src/Distribution/Simple/ShowBuildInfo.hs +0/−1
- src/Distribution/Simple/Test.hs +3/−3
- src/Distribution/Simple/UHC.hs +1/−2
- src/Distribution/Simple/Utils.hs +62/−26
- src/Distribution/Types/ComponentLocalBuildInfo.hs +12/−0
- src/Distribution/Types/LocalBuildConfig.hs +0/−2
- src/Distribution/Types/LocalBuildInfo.hs +1/−1
- src/Distribution/Utils/IOData.hs +1/−1
- src/Distribution/Utils/LogProgress.hs +0/−1
Cabal.cabal view
@@ -1,7 +1,7 @@-cabal-version: 3.0+cabal-version: 3.6 name: Cabal-version: 3.14.2.0-copyright: 2003-2024, Cabal Development Team (see AUTHORS file)+version: 3.16.1.0+copyright: 2003-2025, Cabal Development Team (see AUTHORS file) license: BSD-3-Clause license-file: LICENSE author: Cabal Development Team <cabal-devel@haskell.org>@@ -29,35 +29,47 @@ location: https://github.com/haskell/cabal/ subdir: Cabal +flag git-rev+ description: include Git revision hash in version+ default: False+ manual: True+ library default-language: Haskell2010 hs-source-dirs: src build-depends:- Cabal-syntax ^>= 3.14,- array >= 0.4.0.1 && < 0.6,- 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,- directory >= 1.2 && < 1.4,- filepath >= 1.3.0.1 && < 1.6,- pretty >= 1.1.1 && < 1.2,- process >= 1.2.1.0 && < 1.7,- time >= 1.4.0.1 && < 1.15+ , Cabal-syntax ^>= 3.16.1.0+ , array >= 0.4.0.1 && < 0.6+ , base >= 4.13 && < 5+ , bytestring >= 0.10.0.0 && < 0.13+ , containers >= 0.5.0.0 && < 0.9+ , deepseq >= 1.3.0.1 && < 1.7+ , directory >= 1.2 && < 1.4+ , filepath >= 1.3.0.1 && < 1.6+ , pretty >= 1.1.1 && < 1.2+ , process >= 1.2.1.0 && < 1.7+ , time >= 1.4.0.1 && < 1.16 if os(windows)- build-depends: Win32 >= 2.3.0.0 && < 2.15+ build-depends:+ , Win32 >= 2.3.0.0 && < 2.15 else- build-depends: unix >= 2.8.6.0 && < 2.9+ build-depends:+ , unix >= 2.8.6.0 && < 2.9 + if flag(git-rev)+ build-depends:+ , githash ^>= 0.1.7.0+ cpp-options: -DGIT_REV+ ghc-options: -Wall -fno-ignore-asserts- -fwarn-tabs- -fwarn-incomplete-uni-patterns- -fwarn-incomplete-record-updates- -fno-warn-unticked-promoted-constructors+ -Wtabs+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wno-unticked-promoted-constructors if impl(ghc >= 8.0) ghc-options: -Wcompat -Wnoncanonical-monad-instances@@ -114,7 +126,6 @@ Distribution.Simple.Haddock Distribution.Simple.Glob Distribution.Simple.Glob.Internal- Distribution.Simple.HaskellSuite Distribution.Simple.Hpc Distribution.Simple.Install Distribution.Simple.InstallDirs@@ -248,6 +259,7 @@ Distribution.Types.ConfVar, Distribution.Types.Dependency, Distribution.Types.DependencyMap,+ Distribution.Types.DependencySatisfaction, Distribution.Types.ExeDependency, Distribution.Types.Executable, Distribution.Types.Executable.Lens,@@ -271,6 +283,8 @@ Distribution.Types.Library.Lens, Distribution.Types.LibraryName, Distribution.Types.LibraryVisibility,+ Distribution.Types.MissingDependency,+ Distribution.Types.MissingDependencyReason, Distribution.Types.Mixin, Distribution.Types.Module, Distribution.Types.ModuleReexport,@@ -316,9 +330,9 @@ build-depends: -- transformers-0.4.0.0 doesn't have record syntax e.g. for Identity -- See also https://github.com/ekmett/transformers-compat/issues/35- transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.7),- mtl >= 2.1 && < 2.4,- parsec >= 3.1.13.0 && < 3.2+ , transformers (>= 0.3 && < 0.4) || (>=0.4.1.0 && <0.7)+ , mtl >= 2.1 && < 2.4+ , parsec >= 3.1.13.0 && < 3.2 other-modules: Distribution.Backpack.PreExistingComponent
ChangeLog.md view
@@ -1,3 +1,9 @@+# 3.16.1.0 [Artem Pelenitsyn](mailto:a@pelenitsyn.top) December 2025+* See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.16.1.0.md++# 3.16.0.0 [Artem Pelenitsyn](mailto:a@pelenitsyn.top) July 2025+* See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.16.0.0.md+ # 3.14.2.0 [Mikolaj Konarski](mailto:mikolaj@well-typed.com) April 2025 * See https://github.com/haskell/cabal/blob/master/release-notes/Cabal-3.14.2.0.md @@ -776,7 +782,7 @@ * Many checks added for common mistakes * New `--package-db=` option for specific package databases * Many internal changes to support cabal-install- * Stricter parsing for version strings, eg dissalows "1.05"+ * Stricter parsing for version strings, eg disallows "1.05" * Improved user guide introduction * Programatica support removed * New options `--program-prefix/suffix` allows eg versioned programs
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2003-2024, Cabal Development Team.+Copyright (c) 2003-2025, Cabal Development Team. See the AUTHORS file for the full list of copyright holders. See */LICENSE for the copyright holders of the subcomponents.
src/Distribution/Backpack/Configure.hs view
@@ -1,8 +1,6 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NoMonoLocalBinds #-}@@ -37,7 +35,7 @@ import qualified Distribution.InstalledPackageInfo as Installed import Distribution.ModuleName import Distribution.Package-import Distribution.PackageDescription+import Distribution.PackageDescription (FlagAssignment, PackageDescription (..), libName) import Distribution.Simple.Compiler import Distribution.Simple.Flag import Distribution.Simple.LocalBuildInfo
src/Distribution/Backpack/ConfiguredComponent.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE PatternGuards #-}- -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst> module Distribution.Backpack.ConfiguredComponent ( ConfiguredComponent (..)
src/Distribution/Backpack/Id.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>@@ -13,7 +14,7 @@ import Distribution.PackageDescription import Distribution.Simple.Compiler-import Distribution.Simple.Flag (Flag (..))+import Distribution.Simple.Flag (Flag, pattern Flag, pattern NoFlag) import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Simple.LocalBuildInfo import Distribution.Types.ComponentId
src/Distribution/Backpack/ModuleScope.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
src/Distribution/Backpack/PreModuleShape.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Distribution.Backpack.PreModuleShape
src/Distribution/Compat/Environment.hs view
@@ -63,7 +63,7 @@ {- FOURMOLU_DISABLE -} # if defined(i386_HOST_ARCH) # define WINDOWS_CCONV stdcall-# elif defined(x86_64_HOST_ARCH)+# elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) # define WINDOWS_CCONV ccall # else # error Unknown mingw32 arch
src/Distribution/Compat/FilePath.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -Wno-unused-imports #-} module Distribution.Compat.FilePath ( isExtensionOf
src/Distribution/Compat/GetShortPathName.hs view
@@ -23,7 +23,7 @@ import Foreign.Marshal.Array (allocaArray) {- FOURMOLU_DISABLE -}-#ifdef x86_64_HOST_ARCH+#if defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) #define WINAPI ccall #else #define WINAPI stdcall
src/Distribution/Compat/Internal/TempFile.hs view
@@ -12,20 +12,9 @@ import System.FilePath ((</>)) -import System.IO (Handle, openBinaryTempFile, openTempFile)-#if defined(__IO_MANAGER_WINIO__)-import System.IO (openBinaryTempFileWithDefaultPermissions)-import System.Posix.Internals (c_getpid)-#else-import Control.Exception (onException)-import Data.Bits ((.|.))-import Foreign.C (CInt, eEXIST, getErrno, errnoToIOError)-import GHC.IO.Handle.FD (fdToHandle)-import System.Posix.Internals (c_getpid, c_open, c_close, o_EXCL, o_BINARY, withFilePath,- o_CREAT, o_RDWR, o_NONBLOCK, o_NOCTTY)-#endif-+import System.IO (Handle, openBinaryTempFile, openBinaryTempFileWithDefaultPermissions, openTempFile) import System.IO.Error (isAlreadyExistsError)+import System.Posix.Internals (c_getpid) #if defined(mingw32_HOST_OS) || defined(ghcjs_HOST_OS) import System.Directory ( createDirectory )@@ -33,92 +22,8 @@ import qualified System.Posix #endif --- ---------------------------------------------------------------- * temporary files---- ---------------------------------------------------------------- This is here for Haskell implementations that do not come with--- System.IO.openTempFile. This includes nhc-1.20, hugs-2006.9.--- TODO: This file should probably be removed.---- This is a copy/paste of the openBinaryTempFile definition, but--- it uses 666 rather than 600 for the permissions. Newer versions--- of base have a new function with this behavior which we use on--- Windows when the new IO manager is used. openNewBinaryFile :: FilePath -> String -> IO (FilePath, Handle)-openNewBinaryFile dir template = do---- This method can't be used under WINIO. Also the current implementation has--- thread safety issues depending on which GHC is used. On newer GHC's let's--- use the built in one.-#if defined(__IO_MANAGER_WINIO__)- openBinaryTempFileWithDefaultPermissions dir template-#else- pid <- c_getpid- findTempName pid- where- -- We split off the last extension, so we can use .foo.ext files- -- for temporary files (hidden on Unix OSes). Unfortunately we're- -- below file path in the hierarchy here.- (prefix,suffix) =- case break (== '.') $ reverse template of- -- First case: template contains no '.'s. Just re-reverse it.- (rev_suffix, "") -> (reverse rev_suffix, "")- -- Second case: template contains at least one '.'. Strip the- -- dot from the prefix and prepend it to the suffix (if we don't- -- do this, the unique number will get added after the '.' and- -- thus be part of the extension, which is wrong.)- (rev_suffix, '.':rest) -> (reverse rest, '.':reverse rev_suffix)- -- Otherwise, something is wrong, because (break (== '.')) should- -- always return a pair with either the empty string or a string- -- beginning with '.' as the second component.- _ -> error "bug in System.IO.openTempFile"-- oflags = rw_flags .|. o_EXCL .|. o_BINARY-- findTempName x = do- fd <- withFilePath filepath $ \ f ->- c_open f oflags 0o666- if fd < 0- then do- errno <- getErrno- if errno == eEXIST- then findTempName (x+1)- else ioError (errnoToIOError "openNewBinaryFile" errno Nothing (Just dir))- else do- -- TODO: We want to tell fdToHandle what the file path is,- -- as any exceptions etc will only be able to report the- -- FD currently- h <- fdToHandle fd `onException` c_close fd- return (filepath, h)- where- filename = prefix ++ show x ++ suffix- filepath = dir `combine` filename-- -- FIXME: bits copied from System.FilePath- combine a b- | null b = a- | null a = b- | last a == pathSeparator = a ++ b- | otherwise = a ++ [pathSeparator] ++ b---- FIXME: Copied from GHC.Handle-std_flags, output_flags, rw_flags :: CInt-std_flags = o_NONBLOCK .|. o_NOCTTY-output_flags = std_flags .|. o_CREAT-rw_flags = output_flags .|. o_RDWR---- FIXME: Should use System.FilePath library-pathSeparator :: Char-#ifdef mingw32_HOST_OS-pathSeparator = '\\'-#else-pathSeparator = '/'-#endif--- /* __IO_MANAGER_WINIO__ */-#endif+openNewBinaryFile = openBinaryTempFileWithDefaultPermissions createTempDirectory :: FilePath -> String -> IO FilePath createTempDirectory dir template = do
src/Distribution/Compat/Time.hs view
@@ -94,7 +94,7 @@ return $! ModTime (qwTime :: Word64) {- FOURMOLU_DISABLE -}-#ifdef x86_64_HOST_ARCH+#if defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) #define CALLCONV ccall #else #define CALLCONV stdcall
src/Distribution/GetOpt.hs view
@@ -134,11 +134,11 @@ -- | Pretty printing of short options. -- * With required arguments can be given as: -- @-w PATH or -wPATH (but not -w=PATH)@--- This is dislayed as:+-- This is displayed as: -- @-w PATH or -wPATH@ -- * With optional but default arguments can be given as: -- @-j or -jNUM (but not -j=NUM or -j NUM)@--- This is dislayed as:+-- This is displayed as: -- @-j[NUM]@ fmtShort :: ArgDescr a -> Char -> String fmtShort (NoArg _) so = "-" ++ [so]@@ -152,11 +152,11 @@ -- | Pretty printing of long options. -- * With required arguments can be given as: -- @--with-compiler=PATH (but not --with-compiler PATH)@--- This is dislayed as:+-- This is displayed as: -- @--with-compiler=PATH@ -- * With optional but default arguments can be given as: -- @--jobs or --jobs=NUM (but not --jobs NUM)@--- This is dislayed as:+-- This is displayed as: -- @--jobs[=NUM]@ fmtLong :: ArgDescr a -> String -> String fmtLong (NoArg _) lo = "--" ++ lo
src/Distribution/PackageDescription/Check.hs view
@@ -268,8 +268,6 @@ checkP (not . null $ dups names) (PackageBuildImpossible $ DuplicateSections dupes)- -- PackageDescription checks.- checkPackageDescription packageDescription_ -- Flag names. mapM_ checkFlagName genPackageFlags_
src/Distribution/PackageDescription/Check/Common.hs view
@@ -80,7 +80,7 @@ -- shared targets that match fads = filter (flip elem dqs . fst) ads -- the names of such targets- inNam = nub $ map fst fads :: [UnqualComponentName]+ inName = nub $ map fst fads :: [UnqualComponentName] -- the dependencies of such targets inDep = concatMap snd fads :: [Dependency] @@ -97,7 +97,7 @@ -- text, ← no warning, inherited -- monadacme ← warning! let fFun d =- notElem (unqualName d) inNam+ notElem (unqualName d) inName && notElem (unqualName d) (map unqualName inDep)
src/Distribution/PackageDescription/Check/Monad.hs view
@@ -242,7 +242,7 @@ -- There are some errors which, even though severe, will -- be allowed by Hackage *if* under a non-default flag. isErrAllowable :: PackageCheck -> Bool- isErrAllowable c = case extractCheckExplantion c of+ isErrAllowable c = case extractCheckExplanation c of (WErrorUnneeded _) -> True (JUnneeded _) -> True (FDeferTypeErrorsUnneeded _) -> True
src/Distribution/PackageDescription/Check/Paths.hs view
@@ -10,6 +10,7 @@ module Distribution.PackageDescription.Check.Paths ( checkGlob , checkPath+ , checkPackageFileNamesWithGlob , fileExtensionSupportedLanguage , isGoodRelativeDirectoryPath , isGoodRelativeFilePath
src/Distribution/PackageDescription/Check/Target.hs view
@@ -21,7 +21,7 @@ import Distribution.CabalSpecVersion import Distribution.Compat.Lens import Distribution.Compiler-import Distribution.ModuleName (ModuleName)+import Distribution.ModuleName (ModuleName, toFilePath) import Distribution.Package import Distribution.PackageDescription import Distribution.PackageDescription.Check.Common@@ -61,6 +61,8 @@ _libVisibility_ libBuildInfo_ ) = do+ mapM_ checkModuleName (explicitLibModules lib)+ checkP (libName_ == LMainLibName && isSub) (PackageBuildImpossible UnnamedInternal)@@ -144,6 +146,8 @@ let cet = CETExecutable exeName_ modulePath_ = getSymbolicPath symbolicModulePath_ + mapM_ checkModuleName (exeModules exe)+ -- § Exe specific checks checkP (null modulePath_)@@ -205,6 +209,9 @@ TestSuiteUnsupported tt -> tellP (PackageBuildWarning $ TestsuiteNotSupported tt) _ -> return ()++ mapM_ checkModuleName (testModules ts)+ checkP mainIsWrongExt (PackageBuildImpossible NoHsLhsMain)@@ -257,6 +264,8 @@ -- Target type/name (benchmark). let cet = CETBenchmark benchmarkName_ + mapM_ checkModuleName (benchmarkModules bm)+ -- § Interface & bm specific tests. case benchmarkInterface_ of BenchmarkUnsupported tt@(BenchmarkTypeUnknown _ _) ->@@ -294,6 +303,11 @@ BenchmarkExeV10 _ f -> takeExtension (getSymbolicPath f) `notElem` [".hs", ".lhs"] _ -> False +-- | Check if a module name is valid on both Windows and Posix systems+checkModuleName :: Monad m => ModuleName -> CheckM m ()+checkModuleName moduleName =+ checkPackageFileNamesWithGlob PathKindFile (toFilePath moduleName)+ -- ------------------------------------------------------------ -- Build info -- ------------------------------------------------------------@@ -800,6 +814,7 @@ checkCLikeOptions LangC "cc-options" (ccOptions bi) ldOpts checkCLikeOptions LangCPlusPlus "cxx-options" (cxxOptions bi) ldOpts checkCPPOptions (cppOptions bi)+ checkJSPOptions (jsppOptions bi) -- | Checks GHC options for commonly misused or non-portable flags. checkGHCOptions@@ -892,6 +907,12 @@ ) checkAlternatives title+ "jspp-options"+ ( [(flag, flag) | flag@('-' : 'D' : _) <- ghcNoRts]+ ++ [(flag, flag) | flag@('-' : 'U' : _) <- ghcNoRts]+ )+ checkAlternatives+ title "include-dirs" [(flag, dir) | flag@('-' : 'I' : dir) <- ghcNoRts] checkAlternatives@@ -1077,5 +1098,22 @@ checkP (not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"]) (PackageBuildWarning (COptCPP opt))+ )+ opts++checkJSPOptions+ :: Monad m+ => [String] -- Options in String form.+ -> CheckM m ()+checkJSPOptions opts = do+ checkAlternatives+ "jspp-options"+ "include-dirs"+ [(flag, dir) | flag@('-' : 'I' : dir) <- opts]+ mapM_+ ( \opt ->+ checkP+ (not $ any (`isPrefixOf` opt) ["-D", "-U", "-I"])+ (PackageBuildWarning (OptJSPP opt)) ) opts
src/Distribution/PackageDescription/Check/Warning.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -25,7 +24,7 @@ , ppPackageCheck , ppCheckExplanationId , isHackageDistError- , extractCheckExplantion+ , extractCheckExplanation , filterPackageChecksById , filterPackageChecksByIdString ) where@@ -124,7 +123,7 @@ ff c = flip notElem is . checkExplanationId- . extractCheckExplantion+ . extractCheckExplanation $ c -- | Filter Package Check by Check explanation /string/.@@ -215,6 +214,7 @@ | OptWithRts String | COptONumber String WarnLang | COptCPP String+ | OptJSPP String | OptAlternatives String String [(String, String)] | RelativeOutside String FilePath | AbsolutePath String FilePath@@ -296,14 +296,14 @@ -- to be a ad hoc monoid. -- Convenience.-extractCheckExplantion :: PackageCheck -> CheckExplanation-extractCheckExplantion (PackageBuildImpossible e) = e-extractCheckExplantion (PackageBuildWarning e) = e-extractCheckExplantion (PackageDistSuspicious e) = e-extractCheckExplantion (PackageDistSuspiciousWarn e) = e-extractCheckExplantion (PackageDistInexcusable e) = e+extractCheckExplanation :: PackageCheck -> CheckExplanation+extractCheckExplanation (PackageBuildImpossible e) = e+extractCheckExplanation (PackageBuildWarning e) = e+extractCheckExplanation (PackageDistSuspicious e) = e+extractCheckExplanation (PackageDistSuspiciousWarn e) = e+extractCheckExplanation (PackageDistInexcusable e) = e --- | Identifier for the speficic 'CheckExplanation'. This ensures `--ignore`+-- | Identifier for the specific 'CheckExplanation'. This ensures `--ignore` -- can output a warning on unrecognised values. -- ☞ N.B.: should be kept in sync with 'CheckExplanation'. data CheckExplanationID@@ -381,6 +381,7 @@ | CIOptWithRts | CICOptONumber | CICOptCPP+ | CIOptJSPP | CIOptAlternatives | CIRelativeOutside | CIAbsolutePath@@ -526,6 +527,7 @@ checkExplanationId (OptWithRts{}) = CIOptWithRts checkExplanationId (COptONumber{}) = CICOptONumber checkExplanationId (COptCPP{}) = CICOptCPP+checkExplanationId (OptJSPP{}) = CIOptJSPP checkExplanationId (OptAlternatives{}) = CIOptAlternatives checkExplanationId (RelativeOutside{}) = CIRelativeOutside checkExplanationId (AbsolutePath{}) = CIAbsolutePath@@ -678,6 +680,7 @@ ppCheckExplanationId CIOptWithRts = "option-with-rtsopts" ppCheckExplanationId CICOptONumber = "option-opt-c" ppCheckExplanationId CICOptCPP = "cpp-options"+ppCheckExplanationId CIOptJSPP = "jspp-options" ppCheckExplanationId CIOptAlternatives = "misplaced-c-opt" ppCheckExplanationId CIRelativeOutside = "relative-path-outside" ppCheckExplanationId CIAbsolutePath = "absolute-path"@@ -1087,6 +1090,8 @@ ++ " --disable-optimization flag." ppExplanation (COptCPP opt) = "'cpp-options: " ++ opt ++ "' is not a portable C-preprocessor flag."+ppExplanation (OptJSPP opt) =+ "'jspp-options: " ++ opt ++ "' is not a portable JavaScript-preprocessor flag." ppExplanation (OptAlternatives badField goodField flags) = "Instead of " ++ quote (badField ++ ": " ++ unwords badFlags)
src/Distribution/Simple.hs view
@@ -1,12 +1,9 @@ {-# 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:@@ -15,7 +12,8 @@ (imported from Distribution.Simple.UserHooks): Deprecated: "Please use the new testing interface instead!" -}-{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- | -- Module : Distribution.Simple
src/Distribution/Simple/Bench.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} -----------------------------------------------------------------------------@@ -25,7 +24,7 @@ import qualified Distribution.PackageDescription as PD import Distribution.Pretty-import Distribution.Simple.Build (addInternalBuildToolsFixed)+import Distribution.Simple.Build (addInternalBuildTools) import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.Errors@@ -72,8 +71,8 @@ lbi { -- Include any build-tool-depends on build tools internal to the current package. LBI.withPrograms =- addInternalBuildToolsFixed- (Just curDir)+ addInternalBuildTools+ curDir pkg_descr lbi (benchmarkBuildInfo bm)
src/Distribution/Simple/Build.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} @@ -48,7 +47,6 @@ -- * Handling of internal build tools , addInternalBuildTools- , addInternalBuildToolsFixed ) where import Distribution.Compat.Prelude@@ -74,7 +72,6 @@ import Distribution.Package import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.GHCJS as GHCJS-import qualified Distribution.Simple.HaskellSuite as HaskellSuite import qualified Distribution.Simple.PackageIndex as Index import qualified Distribution.Simple.UHC as UHC @@ -98,7 +95,6 @@ import Distribution.Simple.LocalBuildInfo 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@@ -197,7 +193,7 @@ clbi = targetCLBI target bi = componentBuildInfo comp -- Include any build-tool-depends on build tools internal to the current package.- progs' = addInternalBuildToolsFixed (Just curDir) pkg_descr lbi bi (withPrograms lbi)+ progs' = addInternalBuildTools curDir pkg_descr lbi bi (withPrograms lbi) lbi' = lbi { withPrograms = progs'@@ -320,7 +316,6 @@ flavorToProgram GHCJS = Just ghcjsProgram flavorToProgram UHC = Just uhcProgram flavorToProgram JHC = Just jhcProgram- flavorToProgram HaskellSuite{} = Just haskellSuiteProgram flavorToProgram _ = Nothing repl@@ -386,8 +381,8 @@ { withPackageDB = withPackageDB lbi' ++ [internalPackageDB] , withPrograms = -- Include any build-tool-depends on build tools internal to the current package.- addInternalBuildToolsFixed- (Just curDir)+ addInternalBuildTools+ curDir pkg_descr lbi' (componentBuildInfo comp)@@ -931,18 +926,14 @@ -- 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.------ NB: This function will be removed in the next Cabal major version--- (use addInternalBuildTools instead). This function is introduced solely for--- backporting in a PVP compliant way.-addInternalBuildToolsFixed- :: Maybe (AbsolutePath (Dir Pkg))+addInternalBuildTools+ :: AbsolutePath (Dir Pkg) -> PackageDescription -> LocalBuildInfo -> BuildInfo -> ProgramDb -> ProgramDb-addInternalBuildToolsFixed mpwd pkg lbi bi progs =+addInternalBuildTools pwd pkg lbi bi progs = prependProgramSearchPathNoLogging internalToolPaths [pkgDataDirVar]@@ -962,26 +953,10 @@ </> makeRelativePathEx (toolName' </> toolName' <.> exeExtension (hostPlatform lbi)) ] + -- This is an absolute path, so if a process changes directory, it can still+ -- find the datadir (#10717) dataDirPath :: FilePath- dataDirPath =- case mpwd of- -- This is an absolute path, so if a process changes directory, it can still- -- find the datadir (#10717)- Just pwd -> interpretSymbolicPathAbsolute pwd (dataDir pkg)- -- This is just wrong, but implemented for PVP compliance..- Nothing -> interpretSymbolicPathCWD (dataDir pkg)--{-# WARNING addInternalBuildTools "This function is broken, use addInternalBuildToolsFixed instead" #-}---- | A backwards compatible (broken) version of `addInternalBuildTools`, do not--- use this function. Use 'addInternalBuildToolsFixed' instead.-addInternalBuildTools- :: PackageDescription- -> LocalBuildInfo- -> BuildInfo- -> ProgramDb- -> ProgramDb-addInternalBuildTools = addInternalBuildToolsFixed Nothing+ dataDirPath = interpretSymbolicPathAbsolute pwd (dataDir pkg) -- TODO: build separate libs in separate dirs so that we can build -- multiple libs, e.g. for 'LibTest' library-style test suites@@ -999,7 +974,6 @@ GHC -> GHC.buildLib flags numJobs pkg_descr lbi lib clbi GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi- HaskellSuite{} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi _ -> dieWithException verbosity BuildingNotSupportedWithCompiler -- | Build a foreign library
src/Distribution/Simple/Build/Inputs.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE PatternSynonyms #-}- module Distribution.Simple.Build.Inputs ( -- * Inputs of actions for building components PreBuildComponentInputs (..)
src/Distribution/Simple/Build/Macros.hs view
@@ -58,7 +58,7 @@ , let (major1, major2, minor) = majorMinor ver ] , Z.zPackageKey = case clbi of- LibComponentLocalBuildInfo{} -> componentCompatPackageKey clbi+ LibComponentLocalBuildInfo{componentCompatPackageKey = compatPackageKey} -> compatPackageKey _ -> "" , Z.zComponentId = prettyShow (componentComponentId clbi) , Z.zPackageVersion = pkgVersion (package pkg_descr)
src/Distribution/Simple/Build/PackageInfoModule.hs view
@@ -10,7 +10,7 @@ -- Generating the PackageInfo_pkgname module. -- -- This is a module that Cabal generates for the benefit of packages. It--- enables them to find their package informations.+-- enables them to find their package information. module Distribution.Simple.Build.PackageInfoModule ( generatePackageInfoModule ) where
src/Distribution/Simple/Build/PackageInfoModule/Z.hs view
@@ -22,8 +22,25 @@ return () else do return ()- tell "{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}\n"+ tell "{-# OPTIONS_GHC -Wno-missing-import-lists #-}\n" tell "{-# OPTIONS_GHC -w #-}\n"+ tell "\n"+ tell "{-|\n"+ tell "Module : PackageInfo_"+ tell (zPackageName z_root)+ tell "\n"+ tell "Description : Contents of some of the package's Cabal file's fields.\n"+ tell "\n"+ tell "WARNING: This module was generated by Cabal. Any modifications will be\n"+ tell "overwritten if the module is regenerated.\n"+ tell "\n"+ tell "This module exports values that record information from some of the fields of\n"+ tell "the package's Cabal package description file (Cabal file).\n"+ tell "\n"+ tell "For further information about the fields in a Cabal file, see the Cabal User\n"+ tell "Guide.\n"+ tell "-}\n"+ tell "\n" tell "module PackageInfo_" tell (zPackageName z_root) tell " (\n"@@ -37,23 +54,29 @@ tell "import Data.Version (Version(..))\n" tell "import Prelude\n" tell "\n"+ tell "-- |The content of the @name@ field of the package's Cabal file, but with any\n"+ tell "-- hyphen characters replaced by underscore characters.\n" tell "name :: String\n" tell "name = " tell (show $ zPackageName z_root) tell "\n"+ tell "-- |The content of the @version@ field of the package's Cabal file.\n" tell "version :: Version\n" tell "version = Version " tell (zVersionDigits z_root) tell " []\n" tell "\n"+ tell "-- |The content of the @synopsis@ field of the package's Cabal file.\n" tell "synopsis :: String\n" tell "synopsis = " tell (show $ zSynopsis z_root) tell "\n"+ tell "-- |The content of the @copyright@ field of the package's Cabal file.\n" tell "copyright :: String\n" tell "copyright = " tell (show $ zCopyright z_root) tell "\n"+ tell "-- |The content of the @homepage@ field of the package's Cabal file.\n" tell "homepage :: String\n" tell "homepage = " tell (show $ zHomepage z_root)
src/Distribution/Simple/Build/PathsModule.hs view
@@ -51,6 +51,7 @@ , Z.zIsWindows = isWindows , Z.zIsI386 = buildArch == I386 , Z.zIsX8664 = buildArch == X86_64+ , Z.zIsAArch64 = buildArch == AArch64 , Z.zNot = not , Z.zManglePkgName = showPkgName , Z.zPrefix = show flat_prefix
src/Distribution/Simple/Build/PathsModule/Z.hs view
@@ -12,6 +12,7 @@ zIsWindows :: Bool, zIsI386 :: Bool, zIsX8664 :: Bool,+ zIsAArch64 :: Bool, zPrefix :: FilePath, zBindir :: FilePath, zLibdir :: FilePath,@@ -50,8 +51,27 @@ return () else do return ()- tell "{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}\n"+ tell "{-# OPTIONS_GHC -Wno-missing-import-lists #-}\n" tell "{-# OPTIONS_GHC -w #-}\n"+ tell "\n"+ tell "{-|\n"+ tell "Module : Paths_"+ tell (zManglePkgName z_root (zPackageName z_root))+ tell "\n"+ tell "Description : Data file location, and package version and installation\n"+ tell " directories.\n"+ tell "\n"+ tell "WARNING: This module was generated by Cabal. Any modifications will be\n"+ tell "overwritten if the module is regenerated.\n"+ tell "\n"+ tell "This module exports a function to locate data files, and values that record\n"+ tell "the version of the package and some directories which the package has been\n"+ tell "configured to be installed into.\n"+ tell "\n"+ tell "For further information about Cabal's options for its configuration step, and\n"+ tell "their default values, see the Cabal User Guide.\n"+ tell "-}\n"+ tell "\n" tell "module Paths_" tell (zManglePkgName z_root (zPackageName z_root)) tell " (\n"@@ -69,7 +89,6 @@ return () tell "\n" tell "import qualified Control.Exception as Exception\n"- tell "import qualified Data.List as List\n" tell "import Data.Version (Version(..))\n" tell "import System.Environment (getEnv)\n" tell "import Prelude\n"@@ -101,18 +120,64 @@ tell "catchIO = Exception.catch\n" return () tell "\n"+ tell "-- |The package version.\n" tell "version :: Version\n" tell "version = Version " tell (zVersionDigits z_root) tell " []\n" tell "\n"+ tell "-- |If the argument is a filename, the result is the name of a corresponding\n"+ tell "-- file on the system on which the program is running, if the file were listed\n"+ tell "-- in the @data-files@ field of the package's Cabal package description file.\n"+ tell "-- No check is performed that the given filename is listed in that field.\n" tell "getDataFileName :: FilePath -> IO FilePath\n" tell "getDataFileName name = do\n" tell " dir <- getDataDir\n" tell " return (dir `joinFileName` name)\n" tell "\n"- tell "getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath\n"+ tell "-- |The location of the directory specified by Cabal's @--bindir@ option (where\n"+ tell "-- executables that the user might invoke are installed). This can be overridden\n"+ tell "-- at runtime using the environment variable "+ tell (zManglePkgName z_root (zPackageName z_root))+ tell "_bindir.\n"+ tell "getBinDir :: IO FilePath\n" tell "\n"+ tell "-- |The location of the directory specified by Cabal's @--libdir@ option (where\n"+ tell "-- object libraries are installed). This can be overridden at runtime using the\n"+ tell "-- environment variable "+ tell (zManglePkgName z_root (zPackageName z_root))+ tell "_libdir.\n"+ tell "getLibDir :: IO FilePath\n"+ tell "\n"+ tell "-- |The location of the directory specified by Cabal's @--dynlibdir@ option\n"+ tell "-- (where dynamic libraries are installed). This can be overridden at runtime\n"+ tell "-- using the environment variable "+ tell (zManglePkgName z_root (zPackageName z_root))+ tell "_dynlibdir.\n"+ tell "getDynLibDir :: IO FilePath\n"+ tell "\n"+ tell "-- |The location of the directory specified by Cabal's @--datadir@ option (where\n"+ tell "-- architecture-independent data files are installed). This can be overridden at\n"+ tell "-- runtime using the environment variable "+ tell (zManglePkgName z_root (zPackageName z_root))+ tell "_datadir.\n"+ tell "getDataDir :: IO FilePath\n"+ tell "\n"+ tell "-- |The location of the directory specified by Cabal's @--libexedir@ option\n"+ tell "-- (where executables that are not expected to be invoked directly by the user\n"+ tell "-- are installed). This can be overridden at runtime using the environment\n"+ tell "-- variable "+ tell (zManglePkgName z_root (zPackageName z_root))+ tell "_libexedir.\n"+ tell "getLibexecDir :: IO FilePath\n"+ tell "\n"+ tell "-- |The location of the directory specified by Cabal's @--sysconfdir@ option\n"+ tell "-- (where configuration files are installed). This can be overridden at runtime\n"+ tell "-- using the environment variable "+ tell (zManglePkgName z_root (zPackageName z_root))+ tell "_sysconfdir.\n"+ tell "getSysconfDir :: IO FilePath\n"+ tell "\n" let z_var0_function_defs = do tell "minusFileName :: FilePath -> String -> FilePath\n"@@ -285,9 +350,16 @@ tell " c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n" return () else do- tell "-- win32 supported only with I386, X86_64\n"- tell "c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"- tell "c_GetModuleFileName = _\n"+ if (zIsAArch64 z_root)+ then do+ tell "foreign import ccall unsafe \"windows.h GetModuleFileNameW\"\n"+ tell " c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"+ return ()+ else do+ tell "-- win32 supported only with I386, X86_64, AArch64\n"+ tell "c_GetModuleFileName :: Ptr () -> CWString -> Int32 -> IO Int32\n"+ tell "c_GetModuleFileName = _\n"+ return () return () return () tell "\n"@@ -306,9 +378,14 @@ tell "joinFileName \"\" fname = fname\n" tell "joinFileName \".\" fname = fname\n" tell "joinFileName dir \"\" = dir\n"- tell "joinFileName dir fname\n"- tell " | isPathSeparator (List.last dir) = dir ++ fname\n"+ tell "joinFileName dir@(c:cs) fname\n"+ tell " | isPathSeparator (lastChar c cs) = dir ++ fname\n" tell " | otherwise = dir ++ pathSeparator : fname\n"+ tell " where\n"+ tell " -- We do not use Data.List.NonEmpty.last, as that would limit the module to\n"+ tell " -- base >= 4.9.0.0 (GHC >= 8.0.1).\n"+ tell " lastChar x [] = x\n"+ tell " lastChar _ (x:xs) = lastChar x xs\n" tell "\n" tell "pathSeparator :: Char\n" if (zIsWindows z_root)
src/Distribution/Simple/BuildTarget.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} -----------------------------------------------------------------------------
src/Distribution/Simple/BuildToolDepends.hs view
@@ -13,7 +13,7 @@ import Distribution.Package import Distribution.PackageDescription --- | Same as 'desugarBuildTool', but requires atomic informations (package+-- | Same as 'desugarBuildTool', but requires atomic information (package -- name, executable names) instead of a whole 'PackageDescription'. desugarBuildToolSimple :: PackageName@@ -34,7 +34,6 @@ , "hsc2hs" , "c2hs" , "cpphs"- , "greencard" , "hspec-discover" ] allowMap = Map.fromList $ flip map allowlist $ \n ->
src/Distribution/Simple/Command.hs view
@@ -624,8 +624,8 @@ -- | Mark command as hidden. Hidden commands don't show up in the 'progname -- help' or 'progname --help' output. hiddenCommand :: Command action -> Command action-hiddenCommand (Command name synopsys f _cmdType) =- Command name synopsys f HiddenCommand+hiddenCommand (Command name synopsis f _cmdType) =+ Command name synopsis f HiddenCommand commandAddAction :: CommandUI flags
src/Distribution/Simple/Compiler.hs view
@@ -1,6 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} @@ -86,6 +84,7 @@ , libraryDynDirSupported , libraryVisibilitySupported , jsemSupported+ , reexportedAsSupported -- * Support for profiling detail levels , ProfDetailLevel (..)@@ -434,6 +433,14 @@ where v = compilerVersion comp +-- | Does the compiler support the -reexported-modules "A as B" syntax+reexportedAsSupported :: Compiler -> Bool+reexportedAsSupported comp = case compilerFlavor comp of+ GHC -> v >= mkVersion [9, 12]+ _ -> False+ where+ v = compilerVersion comp+ -- | Does this compiler support a package database entry with: -- "dynamic-library-dirs"? libraryDynDirSupported :: Compiler -> Bool@@ -481,7 +488,7 @@ waySupported way comp = case compilerFlavor comp of GHC ->- -- Infomation about compiler ways is only accurately reported after+ -- Information 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]@@ -502,11 +509,13 @@ -- | 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+profilingDynamicSupported comp+ | GHC <- compilerFlavor comp+ , -- Certainly not before 9.11, as prof+dyn was not implemented yet.+ compilerVersion comp <= mkVersion [9, 11, 0] =+ Just False+ | otherwise =+ waySupported "p_dyn" comp -- | Either profiling dynamic is definitely supported or we don't know (so assume -- it is)
src/Distribution/Simple/Configure.hs view
@@ -48,8 +48,10 @@ , getInstalledPackagesMonitorFiles , getInstalledPackagesById , getPackageDBContents+ , configCompiler , configCompilerEx , configCompilerAuxEx+ , configCompilerProgDb , computeEffectiveProfiling , ccLdOptionsBuildInfo , checkForeignDeps@@ -105,18 +107,20 @@ import Distribution.Simple.Utils import Distribution.System import Distribution.Types.ComponentRequestedSpec+import Distribution.Types.DependencySatisfaction (DependencySatisfaction (..)) import Distribution.Types.GivenComponent import qualified Distribution.Types.LocalBuildConfig as LBC import Distribution.Types.LocalBuildInfo+import Distribution.Types.MissingDependencyReason (MissingDependencyReason (..)) import Distribution.Types.PackageVersionConstraint import Distribution.Utils.LogProgress import Distribution.Utils.NubList+import Distribution.Utils.String (trim) import Distribution.Verbosity import Distribution.Version import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.GHCJS as GHCJS-import qualified Distribution.Simple.HaskellSuite as HaskellSuite import qualified Distribution.Simple.UHC as UHC import Control.Exception@@ -153,7 +157,6 @@ ( canonicalizePath , createDirectoryIfMissing , doesFileExist- , getTemporaryDirectory , removeFile ) import System.FilePath@@ -1478,7 +1481,7 @@ -> Map (PackageName, ComponentName) PromisedComponent -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ required dependencies- -> (Dependency -> Bool)+ -> (Dependency -> DependencySatisfaction) dependencySatisfiable use_external_internal_deps exact_config@@ -1504,16 +1507,14 @@ internalDepSatisfiable else -- Backward compatibility for the old sublibrary syntax - ( sublibs == mainLibSet- && Map.member- ( pn- , CLibName $- LSubLibName $- packageNameToUnqualComponentName depName- )- requiredDepsMap- )- || all visible sublibs+ let depComponentName =+ CLibName $ LSubLibName $ packageNameToUnqualComponentName depName+ invisibleLibraries = NES.filter (not . visible) sublibs+ in if sublibs == mainLibSet && Map.member (pn, depComponentName) requiredDepsMap+ then Satisfied+ else case nonEmpty $ Set.toList invisibleLibraries of+ Nothing -> Satisfied+ Just invisibleLibraries' -> Unsatisfied $ MissingLibrary invisibleLibraries' | isInternalDep = if use_external_internal_deps then -- When we are doing per-component configure, we now need to@@ -1530,12 +1531,31 @@ isInternalDep = pn == depName depSatisfiable =- not . null $ PackageIndex.lookupDependency installedPackageSet depName vr+ let allVersions = PackageIndex.lookupPackageName installedPackageSet depName+ eligibleVersions =+ [ version+ | (version, _infos) <- PackageIndex.eligibleDependencies allVersions+ ]+ in if null $ PackageIndex.matchingDependencies vr allVersions+ then+ if null eligibleVersions+ then Unsatisfied $ MissingPackage+ else Unsatisfied $ WrongVersion eligibleVersions+ else Satisfied internalDepSatisfiable =- Set.isSubsetOf (NES.toSet sublibs) packageLibraries+ let missingLibraries = (NES.toSet sublibs) `Set.difference` packageLibraries+ in case nonEmpty $ Set.toList missingLibraries of+ Nothing -> Satisfied+ Just missingLibraries' -> Unsatisfied $ MissingLibrary missingLibraries'+ internalDepSatisfiableExternally =- all (\ln -> not $ null $ PackageIndex.lookupInternalDependency installedPackageSet pn vr ln) sublibs+ -- TODO: Might need to propagate information on which versions _are_ available, if any...+ let missingLibraries =+ NES.filter (null . PackageIndex.lookupInternalDependency installedPackageSet pn vr) sublibs+ in case nonEmpty $ Set.toList missingLibraries of+ Nothing -> Satisfied+ Just missingLibraries' -> Unsatisfied $ MissingLibrary missingLibraries' -- Check whether a library exists and is visible. -- We don't disambiguate between dependency on non-existent or private@@ -1570,7 +1590,7 @@ -> ConfigFlags -> ComponentRequestedSpec -> [PackageVersionConstraint]- -> (Dependency -> Bool)+ -> (Dependency -> DependencySatisfaction) -- ^ tests if a dependency is satisfiable. -- Might say it's satisfiable even when not. -> Compiler@@ -2050,8 +2070,6 @@ 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@@ -2377,7 +2395,6 @@ pkgconfig ["--modversion", pkg] `catchIO` (\_ -> dieWithException verbosity $ PkgConfigNotFound pkg versionRequirement) `catchExit` (\_ -> dieWithException verbosity $ PkgConfigNotFound pkg versionRequirement)- let trim = dropWhile isSpace . dropWhileEnd isSpace let v = PkgconfigVersion (toUTF8BS $ trim version) if not (withinPkgconfigVersionRange v range) then dieWithException verbosity $ BadVersion pkg versionRequirement v@@ -2469,10 +2486,14 @@ programDb verbosity +-- | Configure the compiler and associated programs such as @hc-pkg@, @haddock@+-- and toolchain program such as @ar@, @ld@. configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath+ -- ^ user-specified @hc@ path (optional) -> Maybe FilePath+ -- ^ user-specified @hc-pkg@ path (optional) -> ProgramDb -> Verbosity -> IO (Compiler, Platform, ProgramDb)@@ -2481,11 +2502,46 @@ (comp, maybePlatform, programDb) <- case hcFlavor of GHC -> GHC.configure verbosity hcPath hcPkg progdb GHCJS -> GHCJS.configure verbosity hcPath hcPkg progdb- UHC -> UHC.configure verbosity hcPath hcPkg progdb- HaskellSuite{} -> HaskellSuite.configure verbosity hcPath hcPkg progdb+ UHC -> UHC.configure verbosity hcPath progdb _ -> dieWithException verbosity UnknownCompilerException return (comp, fromMaybe buildPlatform maybePlatform, programDb) +-- | Configure the compiler ONLY.+configCompiler+ :: Maybe CompilerFlavor+ -> Maybe FilePath+ -- ^ user-specified @hc@ path (optional)+ -> ProgramDb+ -> Verbosity+ -> IO (Compiler, Platform, ProgramDb)+configCompiler mbFlavor hcPath progdb verbosity = do+ (comp, maybePlatform, programDb) <-+ case mbFlavor of+ Nothing -> dieWithException verbosity UnknownCompilerException+ Just hcFlavor ->+ case hcFlavor of+ GHC -> GHC.configureCompiler verbosity hcPath progdb+ GHCJS -> GHCJS.configureCompiler verbosity hcPath progdb+ UHC -> UHC.configure verbosity hcPath progdb+ _ -> dieWithException verbosity UnknownCompilerException+ return (comp, fromMaybe buildPlatform maybePlatform, programDb)++-- | Configure programs associated to the compiler, such as @hc-pkg@, @haddock@+-- and toolchain program such as @ar@, @ld@.+configCompilerProgDb+ :: Verbosity+ -> Compiler+ -> ProgramDb+ -- ^ program database containing the compiler+ -> Maybe FilePath+ -- ^ user-specified @hc-pkg@ path (optional)+ -> IO ProgramDb+configCompilerProgDb verbosity comp hcProgDb hcPkgPath = do+ case compilerFlavor comp of+ GHC -> GHC.compilerProgramDb verbosity comp hcProgDb hcPkgPath+ GHCJS -> GHCJS.compilerProgramDb verbosity comp hcProgDb hcPkgPath+ _ -> return hcProgDb+ -- ----------------------------------------------------------------------------- -- Testing C lib and header dependencies @@ -2672,10 +2728,9 @@ builds :: String -> [ProgArg] -> IO Bool builds program args =- do- tempDir <- makeSymbolicPath <$> getTemporaryDirectory- withTempFileCwd mbWorkDir tempDir ".c" $ \cName cHnd ->- withTempFileCwd mbWorkDir tempDir "" $ \oNname oHnd -> do+ withTempFileCwd ".c" $ \cName cHnd ->+ withTempFileCwd "" $ \oNname oHnd ->+ do hPutStrLn cHnd program hClose cHnd hClose oHnd@@ -2687,8 +2742,8 @@ (withPrograms lbi) (getSymbolicPath cName : "-o" : getSymbolicPath oNname : args) return True- `catchIO` (\_ -> return False)- `catchExit` (\_ -> return False)+ `catchIO` (\_ -> return False)+ `catchExit` (\_ -> return False) explainErrors Nothing [] = return () -- should be impossible! explainErrors _ _@@ -2854,6 +2909,7 @@ goGhcPlatform :: Platform -> Maybe String goGhcPlatform (Platform _ OSX) = goGhcOsx (foreignLibType flib) goGhcPlatform (Platform _ Linux) = goGhcLinux (foreignLibType flib)+ goGhcPlatform (Platform _ FreeBSD) = goGhcLinux (foreignLibType flib) goGhcPlatform (Platform I386 Windows) = goGhcWindows (foreignLibType flib) goGhcPlatform (Platform X86_64 Windows) = goGhcWindows (foreignLibType flib) goGhcPlatform _ =
src/Distribution/Simple/ConfigureScript.hs view
@@ -5,7 +5,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Distribution.Simple.ConfigureScript@@ -78,6 +78,18 @@ -- We don't try and tell configure which ld to use, as we don't have -- a way to pass its flags too + -- Do not presume the CXX compiler is available, but it always will be after 9.4.+ (mcxxProgShort, mcxxFlags) <- do+ mprog <- needProgram verbosity gppProgram programDb+ case mprog of+ Just (p, _) -> do+ let pInv = programInvocation p []+ let cxxProg = progInvokePath pInv+ let cxxFlags = progInvokeArgs pInv+ cxxProgShort <- getShortPathName cxxProg+ return (Just cxxProgShort, Just cxxFlags)+ Nothing -> return (Nothing, Nothing)+ 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:@@ -159,9 +171,7 @@ ) ] let extraPath = fromNubList $ configProgramPathExtra cfg- let cflagsEnv =- maybe (unwords ccFlags) (++ (" " ++ unwords ccFlags)) $- lookup "CFLAGS" env+ let mkFlagsEnv fs var = maybe (unwords fs) (++ (" " ++ unwords fs)) (lookup var env) spSep = [FilePath.searchPathSeparator] pathEnv = maybe@@ -169,11 +179,17 @@ ((intercalate spSep extraPath ++ spSep) ++) $ lookup "PATH" env overEnv =- ("CFLAGS", Just cflagsEnv)- : [("PATH", Just pathEnv) | not (null extraPath)]+ ("CFLAGS", Just (mkFlagsEnv ccFlags "CFLAGS"))+ : [("CXXFLAGS", Just (mkFlagsEnv cxxFlags "CXXFLAGS")) | Just cxxFlags <- [mcxxFlags]]+ ++ [("PATH", Just pathEnv) | not (null extraPath)] ++ cabalFlagEnv maybeHostFlag = if hp == buildPlatform then [] else ["--host=" ++ show (pretty hp)]- args' = configureFile' : args ++ ["CC=" ++ ccProgShort] ++ maybeHostFlag+ args' =+ configureFile'+ : args+ ++ ["CC=" ++ ccProgShort]+ ++ ["CXX=" ++ cxxProgShort | Just cxxProgShort <- [mcxxProgShort]]+ ++ maybeHostFlag shProg = simpleProgram "sh" progDb <- prependProgramSearchPath verbosity extraPath [] emptyProgramDb shConfiguredProg <-
src/Distribution/Simple/Errors.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE LambdaCase #-}- ----------------------------------------------------------------------------- -- Module : Distribution.Simple.Errors@@ -31,6 +29,7 @@ import Distribution.Simple.PreProcess.Types (Suffix) import Distribution.Simple.SetupHooks.Errors import Distribution.System (OS)+import Distribution.Types.MissingDependency (MissingDependency) import Distribution.Types.VersionRange.Internal () import Distribution.Version import Text.PrettyPrint@@ -79,8 +78,6 @@ | NoSupportBuildingTestSuite TestType | NoSupportBuildingBenchMark BenchmarkType | BuildingNotSupportedWithCompiler- | ProvideHaskellSuiteTool String- | CannotDetermineCompilerVersion | PkgDumpFailed | FailedToParseOutput | CantFindSourceModule ModuleName@@ -126,7 +123,7 @@ | CantFindForeignLibraries [String] | ExpectedAbsoluteDirectory FilePath | FlagsNotSpecified [FlagName]- | EncounteredMissingDependency [Dependency]+ | EncounteredMissingDependency [MissingDependency] | CompilerDoesn'tSupportThinning | CompilerDoesn'tSupportReexports | CompilerDoesn'tSupportBackpack@@ -172,6 +169,7 @@ | UnknownVersionDb String VersionRange FilePath | MissingCoveredInstalledLibrary UnitId | SetupHooksException SetupHooksException+ | MultiReplDoesNotSupportComplexReexportedModules PackageName ComponentName deriving (Show) exceptionCode :: CabalException -> Int@@ -211,8 +209,8 @@ NoSupportBuildingTestSuite{} -> 4106 NoSupportBuildingBenchMark{} -> 5320 BuildingNotSupportedWithCompiler{} -> 7077- ProvideHaskellSuiteTool{} -> 7509- CannotDetermineCompilerVersion{} -> 4519+ -- Retired: ProvideHaskellSuiteTool{} -> 7509+ -- Retired: CannotDetermineCompilerVersion{} -> 4519 PkgDumpFailed{} -> 2291 FailedToParseOutput{} -> 5500 CantFindSourceModule{} -> 8870@@ -305,6 +303,7 @@ MissingCoveredInstalledLibrary{} -> 9341 SetupHooksException err -> setupHooksExceptionCode err+ MultiReplDoesNotSupportComplexReexportedModules{} -> 9355 versionRequirement :: VersionRange -> String versionRequirement range@@ -365,8 +364,6 @@ 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- CannotDetermineCompilerVersion -> "haskell-suite: couldn't determine compiler version" PkgDumpFailed -> "pkg dump failed" FailedToParseOutput -> "failed to parse output of 'pkg dump'" CantFindSourceModule moduleName -> "can't find source for module " ++ prettyShow moduleName@@ -552,7 +549,7 @@ . nest 4 . sep . punctuate comma- . map (pretty . simplifyDependency)+ . map pretty $ missing ) CompilerDoesn'tSupportThinning ->@@ -800,3 +797,10 @@ ++ "' in package database stack." SetupHooksException err -> setupHooksExceptionMessage err+ MultiReplDoesNotSupportComplexReexportedModules pname cname ->+ "When attempting start the repl for "+ ++ showComponentName cname+ ++ " from package "+ ++ prettyShow pname+ ++ " a module renaming was found.\n"+ ++ "Multi-repl does not work with complicated reexported-modules until GHC-9.12."
src/Distribution/Simple/Flag.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-} ----------------------------------------------------------------------------- @@ -20,7 +18,9 @@ -- -- Split off from "Distribution.Simple.Setup" to break import cycles. module Distribution.Simple.Flag- ( Flag (..)+ ( Flag+ , pattern Flag+ , pattern NoFlag , allFlags , toFlag , fromFlag@@ -33,6 +33,7 @@ , BooleanFlag (..) ) where +import Data.Monoid (Last (..)) import Distribution.Compat.Prelude hiding (get) import Distribution.Compat.Stack import Prelude ()@@ -62,43 +63,15 @@ -- 'NoFlag' and later flags override earlier ones. -- -- Isomorphic to 'Maybe' a.-data Flag a = Flag a | NoFlag deriving (Eq, Generic, Show, Read, Foldable, Traversable)--instance Binary a => Binary (Flag a)-instance Structured a => Structured (Flag a)--instance Functor Flag where- fmap f (Flag x) = Flag (f x)- fmap _ NoFlag = NoFlag--instance Applicative Flag where- (Flag x) <*> y = x <$> y- NoFlag <*> _ = NoFlag- pure = Flag--instance Monoid (Flag a) where- mempty = NoFlag- mappend = (<>)+type Flag = Last -instance Semigroup (Flag a) where- _ <> f@(Flag _) = f- f <> NoFlag = f+pattern Flag :: a -> Last a+pattern Flag a = Last (Just a) -instance Bounded a => Bounded (Flag a) where- minBound = toFlag minBound- maxBound = toFlag maxBound+pattern NoFlag :: Last a+pattern NoFlag = Last Nothing -instance Enum a => Enum (Flag a) where- fromEnum = fromEnum . fromFlag- toEnum = toFlag . toEnum- enumFrom (Flag a) = map toFlag . enumFrom $ a- enumFrom _ = []- enumFromThen (Flag a) (Flag b) = toFlag `map` enumFromThen a b- enumFromThen _ _ = []- enumFromTo (Flag a) (Flag b) = toFlag `map` enumFromTo a b- enumFromTo _ _ = []- enumFromThenTo (Flag a) (Flag b) (Flag c) = toFlag `map` enumFromThenTo a b c- enumFromThenTo _ _ _ = []+{-# COMPLETE Flag, NoFlag #-} -- | Wraps a value in 'Flag'. toFlag :: a -> Flag a@@ -111,26 +84,22 @@ -- | Extracts a value from a 'Flag', and returns the default value on 'NoFlag'. fromFlagOrDefault :: a -> Flag a -> a-fromFlagOrDefault _ (Flag x) = x-fromFlagOrDefault def NoFlag = def+fromFlagOrDefault def = fromMaybe def . getLast -- | Converts a 'Flag' value to a 'Maybe' value. flagToMaybe :: Flag a -> Maybe a-flagToMaybe (Flag x) = Just x-flagToMaybe NoFlag = Nothing+flagToMaybe = getLast -- | Pushes a function through a 'Flag' value, and returns a default -- if the 'Flag' value is 'NoFlag'. -- -- @since 3.4.0.0 flagElim :: b -> (a -> b) -> Flag a -> b-flagElim n _ NoFlag = n-flagElim _ f (Flag x) = f x+flagElim n f = maybe n f . getLast -- | Converts a 'Flag' value to a list. flagToList :: Flag a -> [a]-flagToList (Flag x) = [x]-flagToList NoFlag = []+flagToList = maybeToList . getLast -- | Returns 'True' only if every 'Flag' 'Bool' value is Flag True, else 'False'. allFlags :: [Flag Bool] -> Flag Bool@@ -141,8 +110,7 @@ -- | Converts a 'Maybe' value to a 'Flag' value. maybeToFlag :: Maybe a -> Flag a-maybeToFlag Nothing = NoFlag-maybeToFlag (Just x) = Flag x+maybeToFlag = Last -- | Merge the elements of a list 'Flag' with another list 'Flag'. mergeListFlag :: Flag [a] -> Flag [a] -> Flag [a]
src/Distribution/Simple/GHC.hs view
@@ -5,7 +5,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- @@ -42,6 +41,8 @@ module Distribution.Simple.GHC ( getGhcInfo , configure+ , configureCompiler+ , compilerProgramDb , getInstalledPackages , getInstalledPackagesMonitorFiles , getPackageDBContents@@ -86,8 +87,8 @@ import Control.Arrow ((***)) import Control.Monad (forM_)-import Data.List (stripPrefix) import qualified Data.Map as Map+import Data.Maybe (fromJust) import Distribution.CabalSpecVersion import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo@@ -154,75 +155,56 @@ -- ----------------------------------------------------------------------------- -- Configuring +-- | Configure GHC, and then auxiliary programs such as @ghc-pkg@, @haddock@+-- as well as toolchain programs such as @ar@, @ld. configure :: Verbosity -> Maybe FilePath+ -- ^ user-specified @ghc@ path (optional) -> Maybe FilePath+ -- ^ user-specified @ghc-pkg@ path (optional) -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb) configure verbosity hcPath hcPkgPath conf0 = do+ (comp, compPlatform, progdb1) <- configureCompiler verbosity hcPath conf0+ compProgDb <- compilerProgramDb verbosity comp progdb1 hcPkgPath+ return (comp, compPlatform, compProgDb)++-- | Configure GHC.+configureCompiler+ :: Verbosity+ -> Maybe FilePath+ -- ^ user-specified @ghc@ path (optional)+ -> ProgramDb+ -> IO (Compiler, Maybe Platform, ProgramDb)+configureCompiler verbosity hcPath conf0 = do (ghcProg, ghcVersion, progdb1) <- requireProgramVersion verbosity ghcProgram (orLaterVersion (mkVersion [7, 0, 1])) (userMaybeSpecifyPath "ghc" hcPath conf0)- let implInfo = ghcVersionImplInfo ghcVersion - -- Cabal currently supports ghc >= 7.0.1 && < 9.14- -- ... and the following odd development version- unless (ghcVersion < mkVersion [9, 14]) $+ -- Cabal currently supports GHC less than `maxGhcVersion`+ let maxGhcVersion = mkVersion [9, 16]+ unless (ghcVersion < maxGhcVersion) $ warn verbosity $ "Unknown/unsupported 'ghc' version detected " ++ "(Cabal " ++ prettyShow cabalVersion- ++ " supports 'ghc' version < 9.14): "+ ++ " supports 'ghc' version < "+ ++ prettyShow maxGhcVersion+ ++ "): " ++ programPath ghcProg ++ " is version " ++ prettyShow ghcVersion - -- This is slightly tricky, we have to configure ghc first, then we use the- -- location of ghc to help find ghc-pkg in the case that the user did not- -- specify the location of ghc-pkg directly:- (ghcPkgProg, ghcPkgVersion, progdb2) <-- requireProgramVersion- verbosity- ghcPkgProgram- { programFindLocation = guessGhcPkgFromGhcPath ghcProg- }- anyVersion- (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)-- when (ghcVersion /= ghcPkgVersion) $- dieWithException verbosity $- VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion- -- Likewise we try to find the matching hsc2hs and haddock programs.- let hsc2hsProgram' =- hsc2hsProgram- { programFindLocation = guessHsc2hsFromGhcPath ghcProg- }- haddockProgram' =- haddockProgram- { programFindLocation = guessHaddockFromGhcPath ghcProg- }- hpcProgram' =- hpcProgram- { programFindLocation = guessHpcFromGhcPath ghcProg- }- runghcProgram' =- runghcProgram- { programFindLocation = guessRunghcFromGhcPath ghcProg- }- progdb3 =- addKnownProgram haddockProgram' $- addKnownProgram hsc2hsProgram' $- addKnownProgram hpcProgram' $- addKnownProgram runghcProgram' progdb2-+ let implInfo = ghcVersionImplInfo ghcVersion languages <- Internal.getLanguages verbosity implInfo ghcProg extensions0 <- Internal.getExtensions verbosity implInfo ghcProg ghcInfo <- Internal.getGhcInfo verbosity implInfo ghcProg+ let ghcInfoMap = Map.fromList ghcInfo filterJS = if ghcVersion < mkVersion [9, 8] then filterExt JavaScriptFFI else id extensions =@@ -247,8 +229,20 @@ compilerId :: CompilerId compilerId = CompilerId GHC ghcVersion + -- The @AbiTag@ is the @Project Unit Id@ but with redundant information from the compiler version removed.+ -- For development versions of the compiler these look like:+ -- @Project Unit Id@: "ghc-9.13-inplace"+ -- @compilerId@: "ghc-9.13.20250413"+ -- So, we need to be careful to only strip the /common/ prefix.+ -- In this example, @AbiTag@ is "inplace". compilerAbiTag :: AbiTag- compilerAbiTag = maybe NoAbiTag AbiTag (Map.lookup "Project Unit Id" ghcInfoMap >>= stripPrefix (prettyShow compilerId <> "-"))+ compilerAbiTag =+ maybe+ NoAbiTag+ AbiTag+ ( dropWhile (== '-') . stripCommonPrefix (prettyShow compilerId)+ <$> Map.lookup "Project Unit Id" ghcInfoMap+ ) let comp = Compiler@@ -260,10 +254,74 @@ , compilerProperties = ghcInfoMap } compPlatform = Internal.targetPlatform ghcInfo- -- configure gcc and ld- progdb4 = Internal.configureToolchain implInfo ghcProg ghcInfoMap progdb3- return (comp, compPlatform, progdb4)+ return (comp, compPlatform, progdb1) +-- | Given a configured @ghc@ program, configure auxiliary programs such+-- as @ghc-pkg@ or @haddock@, as well as toolchain programs such as @ar@, @ld@,+-- based on:+--+-- - the location of the @ghc@ executable,+-- - toolchain information in the GHC settings file.+compilerProgramDb+ :: Verbosity+ -> Compiler+ -> ProgramDb+ -> Maybe FilePath+ -- ^ user-specified @ghc-pkg@ path (optional)+ -> IO ProgramDb+compilerProgramDb verbosity comp progdb1 hcPkgPath = do+ let+ ghcProg = fromJust $ lookupProgram ghcProgram progdb1+ ghcVersion = compilerVersion comp++ -- This is slightly tricky, we have to configure ghc first, then we use the+ -- location of ghc to help find ghc-pkg in the case that the user did not+ -- specify the location of ghc-pkg directly:+ (ghcPkgProg, ghcPkgVersion, progdb2) <-+ requireProgramVersion+ verbosity+ ghcPkgProgram+ { programFindLocation = guessGhcPkgFromGhcPath ghcProg+ }+ anyVersion+ (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1)++ when (ghcVersion /= ghcPkgVersion) $+ dieWithException verbosity $+ VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion+ -- Likewise we try to find the matching hsc2hs and haddock programs.+ let hsc2hsProgram' =+ hsc2hsProgram+ { programFindLocation = guessHsc2hsFromGhcPath ghcProg+ }+ haddockProgram' =+ haddockProgram+ { programFindLocation = guessHaddockFromGhcPath ghcProg+ }+ hpcProgram' =+ hpcProgram+ { programFindLocation = guessHpcFromGhcPath ghcProg+ }+ runghcProgram' =+ runghcProgram+ { programFindLocation = guessRunghcFromGhcPath ghcProg+ }+ progdb3 =+ addKnownProgram haddockProgram' $+ addKnownProgram hsc2hsProgram' $+ addKnownProgram hpcProgram' $+ addKnownProgram runghcProgram' progdb2++ -- configure gcc, ld, ar etc... based on the paths stored+ -- in the GHC settings file+ progdb4 =+ Internal.configureToolchain+ (ghcVersionImplInfo ghcVersion)+ ghcProg+ (compilerProperties comp)+ progdb3+ return progdb4+ -- | Given something like /usr/local/bin/ghc-6.6.1(.exe) we try and find -- the corresponding tool; e.g. if the tool is ghc-pkg, we try looking -- for a versioned or unversioned ghc-pkg in the same dir, that is:@@ -632,6 +690,8 @@ } checkPackageDbStack verbosity comp packageDBs (ghcProg, _) <- requireProgram verbosity ghcProgram progdb+ -- This doesn't pass source file arguments to GHC, so we don't have to worry+ -- about using a response file here. runGHC verbosity ghcProg comp platform Nothing replOpts -- -----------------------------------------------------------------------------
src/Distribution/Simple/GHC/Build/ExtraSources.hs view
@@ -23,6 +23,7 @@ import Distribution.Simple.GHC.Build.Utils import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program.Types+import Distribution.Simple.Setup.Common (commonSetupTempFileOptions) import Distribution.System (Arch (JavaScript), Platform (..)) import Distribution.Types.ComponentLocalBuildInfo import Distribution.Utils.Path@@ -176,7 +177,17 @@ sources = viewSources (targetComponent targetInfo) comp = compiler lbi platform = hostPlatform lbi- runGhcProg = runGHC verbosity ghcProg comp platform+ tempFileOptions = commonSetupTempFileOptions $ buildingWhatCommonFlags buildingWhat+ runGhcProg =+ runGHCWithResponseFile+ "ghc.rsp"+ Nothing+ tempFileOptions+ verbosity+ ghcProg+ comp+ platform+ mbWorkDir buildAction :: SymbolicPath Pkg File -> IO () buildAction sourceFile = do@@ -219,7 +230,7 @@ compileIfNeeded :: GhcOptions -> IO () compileIfNeeded opts = do needsRecomp <- checkNeedsRecompilation mbWorkDir sourceFile opts- when needsRecomp $ runGhcProg mbWorkDir opts+ when needsRecomp $ runGhcProg opts createDirectoryIfMissingVerbose verbosity True (i odir) case targetComponent targetInfo of@@ -251,6 +262,7 @@ DynWay -> compileIfNeeded sharedSrcOpts ProfWay -> compileIfNeeded profSrcOpts ProfDynWay -> compileIfNeeded profSharedSrcOpts+ -- build any sources if (null sources || componentIsIndefinite clbi) then return mempty
src/Distribution/Simple/GHC/Build/Link.hs view
@@ -1,16 +1,17 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeApplications #-} module Distribution.Simple.GHC.Build.Link where import Distribution.Compat.Prelude import Prelude () +import Control.Monad import Control.Monad.IO.Class import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.Set as Set+import Distribution.Backpack import Distribution.Compat.Binary (encode) import Distribution.Compat.ResponseFile import Distribution.InstalledPackageInfo (InstalledPackageInfo)@@ -24,6 +25,7 @@ import Distribution.Simple.Build.Inputs import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler+import Distribution.Simple.Errors import Distribution.Simple.GHC.Build.Modules import Distribution.Simple.GHC.Build.Utils (exeTargetName, flibBuildName, flibTargetName, withDynFLib) import Distribution.Simple.GHC.ImplInfo@@ -98,6 +100,7 @@ clbi = buildCLBI pbci isIndef = componentIsIndefinite clbi mbWorkDir = mbWorkDirLBI lbi+ tempFileOptions = commonSetupTempFileOptions $ buildingWhatCommonFlags what -- See Note [Symbolic paths] in Distribution.Utils.Path i = interpretSymbolicPathLBI lbi@@ -188,10 +191,25 @@ -- exports. when (case component of CLib lib -> null (allLibModules lib clbi); _ -> False) $ warn verbosity "No exposed modules"- runReplOrWriteFlags ghcProg lbi replFlags replOpts_final (pkgName (PD.package pkg_descr)) target+ runReplOrWriteFlags+ ghcProg+ lbi+ replFlags+ replOpts_final+ (pkgName (PD.package pkg_descr))+ target _otherwise -> let- runGhcProg = runGHC verbosity ghcProg comp platform mbWorkDir+ runGhcProg =+ runGHCWithResponseFile+ "ghc.rsp"+ Nothing+ tempFileOptions+ verbosity+ ghcProg+ comp+ platform+ mbWorkDir platform = hostPlatform lbi comp = compiler lbi get_rpaths ways =@@ -725,31 +743,54 @@ runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target = let bi = componentBuildInfo $ targetComponent target clbi = targetCLBI target+ cname = componentName (targetComponent target) comp = compiler lbi platform = hostPlatform lbi common = configCommonFlags $ configFlags lbi mbWorkDir = mbWorkDirLBI lbi verbosity = fromFlag $ setupVerbosity common+ tempFileOptions = commonSetupTempFileOptions common in case replOptionsFlagOutput (replReplOptions rflags) of- NoFlag -> runGHC verbosity ghcProg comp platform mbWorkDir ghcOpts+ NoFlag -> do+ -- If a specific GHC implementation is specified, use it+ runReplProgram+ (flagToMaybe $ replWithRepl (replReplOptions rflags))+ tempFileOptions+ verbosity+ ghcProg+ comp+ platform+ mbWorkDir+ ghcOpts Flag out_dir -> do let uid = componentUnitId clbi this_unit = prettyShow uid+ getOpenModName (OpenModule _ mn) = Just mn+ getOpenModName (OpenModuleVar{}) = Nothing reexported_modules =- [ mn | LibComponentLocalBuildInfo{componentExposedModules = exposed_mods} <- [clbi], IPI.ExposedModule mn (Just{}) <- exposed_mods+ [ (from_mn, to_mn) | LibComponentLocalBuildInfo{componentExposedModules = exposed_mods} <- [clbi], IPI.ExposedModule to_mn (Just m) <- exposed_mods, Just from_mn <- [getOpenModName m] ]+ renderReexportedModule (from_mn, to_mn)+ | reexportedAsSupported comp =+ pure $ prettyShow from_mn ++ " as " ++ prettyShow to_mn+ | otherwise =+ if from_mn == to_mn+ then pure $ prettyShow to_mn+ else dieWithException verbosity (MultiReplDoesNotSupportComplexReexportedModules pkg_name cname) hidden_modules = otherModules bi- extra_opts =- concat $- [ ["-this-package-name", prettyShow pkg_name]- , case mbWorkDir of- Nothing -> []- Just wd -> ["-working-dir", getSymbolicPath wd]- ]- ++ [ ["-reexported-module", prettyShow m] | m <- reexported_modules- ]- ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules- ]+ render_extra_opts = do+ rexp_mods <- mapM renderReexportedModule reexported_modules+ pure $+ concat $+ [ ["-this-package-name", prettyShow pkg_name]+ , case mbWorkDir of+ Nothing -> []+ Just wd -> ["-working-dir", getSymbolicPath wd]+ ]+ ++ [ ["-reexported-module", m] | m <- rexp_mods+ ]+ ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules+ ] -- Create "paths" subdirectory if it doesn't exist. This is where we write -- information about how the PATH was augmented. createDirectoryIfMissing False (out_dir </> "paths")@@ -757,6 +798,7 @@ writeFileAtomic (out_dir </> "paths" </> this_unit) (encode ghcProg) -- Write out options for this component into a file ready for loading into -- the multi-repl+ extra_opts <- render_extra_opts writeFileAtomic (out_dir </> this_unit) $ BS.pack $ escapeArgs $
src/Distribution/Simple/GHC/Build/Modules.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TupleSections #-} module Distribution.Simple.GHC.Build.Modules ( buildHaskellModules@@ -137,20 +135,29 @@ | BuildRepl{} <- what = True | otherwise = False - -- TODO: do we need to put hs-boot files into place for mutually recursive- -- modules? FIX: what about exeName.hi-boot?+ -- TODO: do we need to put hs-boot files into place for mutually recursive+ -- modules? FIX: what about exeName.hi-boot? - -- Determine if program coverage should be enabled and if so, what- -- '-hpcdir' should be.- let isCoverageEnabled = if isLib then libCoverage lbi else exeCoverage lbi- hpcdir way- | forRepl = mempty -- HPC is not supported in ghci- | isCoverageEnabled = Flag $ Hpc.mixDir (coerceSymbolicPath $ coerceSymbolicPath buildTargetDir </> extraCompilationArtifacts) way- | otherwise = mempty+ -- Determine if program coverage should be enabled and if so, what+ -- '-hpcdir' should be.+ isCoverageEnabled = if isLib then libCoverage lbi else exeCoverage lbi+ hpcdir way+ | forRepl = mempty -- HPC is not supported in ghci+ | isCoverageEnabled = Flag $ Hpc.mixDir (coerceSymbolicPath $ coerceSymbolicPath buildTargetDir </> extraCompilationArtifacts) way+ | otherwise = mempty - let mbWorkDir = mbWorkDirLBI lbi- runGhcProg = runGHC verbosity ghcProg comp platform mbWorkDir+ tempFileOptions = commonSetupTempFileOptions $ buildingWhatCommonFlags what+ runGhcProg =+ runGHCWithResponseFile+ "ghc.rsp"+ Nothing+ tempFileOptions+ verbosity+ ghcProg+ comp+ platform+ mbWorkDir platform = hostPlatform lbi (hsMains, scriptMains) =
src/Distribution/Simple/GHC/EnvironmentParser.hs view
@@ -1,8 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-} module Distribution.Simple.GHC.EnvironmentParser (parseGhcEnvironmentFile, readGhcEnvironmentFile, ParseErrorExc (..)) where
src/Distribution/Simple/GHC/Internal.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} -----------------------------------------------------------------------------@@ -67,7 +68,7 @@ import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.Errors-import Distribution.Simple.Flag (Flag (NoFlag), maybeToFlag, toFlag)+import Distribution.Simple.Flag (Flag, maybeToFlag, toFlag, pattern NoFlag) import Distribution.Simple.GHC.ImplInfo import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program@@ -85,7 +86,7 @@ import Distribution.Verbosity import Distribution.Version (Version) import Language.Haskell.Extension-import System.Directory (getDirectoryContents, getTemporaryDirectory)+import System.Directory (getDirectoryContents) import System.Environment (getEnv) import System.FilePath ( takeDirectory@@ -111,6 +112,11 @@ , programPostConf = configureGcc } . addKnownProgram+ gppProgram+ { programFindLocation = findProg gppProgramName extraGppPath+ , programPostConf = configureGpp+ }+ . addKnownProgram ldProgram { programFindLocation = findProg ldProgramName extraLdPath , programPostConf = \v cp ->@@ -137,6 +143,7 @@ maybeName prog = maybe (programName prog) (dropExeExtension . takeFileName) gccProgramName = maybeName gccProgram mbGccLocation+ gppProgramName = maybeName gppProgram mbGppLocation ldProgramName = maybeName ldProgram mbLdLocation arProgramName = maybeName arProgram mbArLocation stripProgramName = maybeName stripProgram mbStripLocation@@ -149,18 +156,20 @@ mbDir = maybeToList . fmap takeDirectory $ mbPath extraGccPath = mkExtraPath mbGccLocation windowsExtraGccDir+ extraGppPath = mkExtraPath mbGppLocation windowsExtraGppDir extraLdPath = mkExtraPath mbLdLocation windowsExtraLdDir extraArPath = mkExtraPath mbArLocation windowsExtraArDir extraStripPath = mkExtraPath mbStripLocation windowsExtraStripDir -- on Windows finding and configuring ghc's gcc & binutils is a bit special ( windowsExtraGccDir+ , windowsExtraGppDir , windowsExtraLdDir , windowsExtraArDir , windowsExtraStripDir ) = let b = mingwBinDir </> binPrefix- in (b, b, b, b)+ in (b, b, b, b, b) findProg :: String@@ -176,11 +185,13 @@ -- Read tool locations from the 'ghc --info' output. Useful when -- cross-compiling. mbGccLocation = Map.lookup "C compiler command" ghcInfo+ mbGppLocation = Map.lookup "C++ compiler command" ghcInfo mbLdLocation = Map.lookup "ld command" ghcInfo mbArLocation = Map.lookup "ar command" ghcInfo mbStripLocation = Map.lookup "strip command" ghcInfo ccFlags = getFlags "C compiler flags"+ cxxFlags = getFlags "C++ compiler flags" -- GHC 7.8 renamed "Gcc Linker flags" to "C compiler link flags" -- and "Ld Linker flags" to "ld flags" (GHC #4862). gccLinkerFlags = getFlags "Gcc Linker flags" ++ getFlags "C compiler link flags"@@ -210,6 +221,15 @@ ++ gccLinkerFlags } + configureGpp :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram+ configureGpp _v gppProg = do+ return+ gppProg+ { programDefaultArgs =+ programDefaultArgs gppProg+ ++ cxxFlags+ }+ configureLd :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram configureLd v ldProg = do ldProg' <- configureLd' v ldProg@@ -221,9 +241,8 @@ -- we need to find out if ld supports the -x flag configureLd' :: Verbosity -> ConfiguredProgram -> IO ConfiguredProgram configureLd' verbosity ldProg = do- tempDir <- getTemporaryDirectory- ldx <- withTempFile tempDir ".c" $ \testcfile testchnd ->- withTempFile tempDir ".o" $ \testofile testohnd -> do+ ldx <- withTempFile ".c" $ \testcfile testchnd ->+ withTempFile ".o" $ \testofile testohnd -> do hPutStrLn testchnd "int foo() { return 0; }" hClose testchnd hClose testohnd@@ -236,7 +255,7 @@ , "-o" , testofile ]- withTempFile tempDir ".o" $ \testofile' testohnd' ->+ withTempFile ".o" $ \testofile' testohnd' -> do hClose testohnd' _ <-@@ -468,6 +487,7 @@ ) ++ asmOptions bi , ghcOptObjDir = toFlag odir+ , ghcOptExtra = hcOptions GHC bi } componentJsGhcOptions@@ -485,11 +505,13 @@ ghcOptVerbosity = toFlag (min verbosity normal) , ghcOptMode = toFlag GhcModeCompile , ghcOptInputFiles = toNubListR [filename]+ , ghcOptJSppOptions = jsppOptions bi , ghcOptCppIncludePath = includePaths lbi bi clbi odir , ghcOptHideAllPackages = toFlag True , ghcOptPackageDBs = withPackageDB lbi , ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi , ghcOptObjDir = toFlag odir+ , ghcOptExtra = hcOptions GHC bi } componentGhcOptions@@ -547,6 +569,7 @@ ++ [autogenPackageModulesDir lbi] , ghcOptCppIncludePath = includePaths lbi bi clbi odir , ghcOptCppOptions = cppOptions bi+ , ghcOptJSppOptions = jsppOptions bi , ghcOptCppIncludes = toNubListR $ [coerceSymbolicPath (autogenComponentModulesDir lbi clbi </> makeRelativePathEx cppHeaderName)]@@ -603,7 +626,7 @@ , ghcOptPackages = toNubListR $ mkGhcOptPackages (promisedPkgs lbi) clbi , ghcOptOptimisation = toGhcOptimisation (withOptimization lbi) , ghcOptDebugInfo = toFlag (withDebugInfo lbi)- , ghcOptExtra = cmmOptions bi+ , ghcOptExtra = hcOptions GHC bi <> cmmOptions bi , ghcOptObjDir = toFlag odir }
src/Distribution/Simple/GHCJS.hs view
@@ -1,11 +1,12 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TupleSections #-} module Distribution.Simple.GHCJS ( getGhcInfo , configure+ , configureCompiler+ , compilerProgramDb , getInstalledPackages , getInstalledPackagesMonitorFiles , getPackageDBContents@@ -88,6 +89,7 @@ import Control.Monad (msum) import Data.Char (isLower) import qualified Data.Map as Map+import Data.Maybe (fromJust) import System.Directory ( canonicalizePath , createDirectoryIfMissing@@ -107,13 +109,29 @@ -- ----------------------------------------------------------------------------- -- Configuring +-- | Configure GHCJS, and then auxiliary programs such as @ghc-pkg@, @haddock@+-- as well as toolchain programs such as @ar@, @ld. configure :: Verbosity -> Maybe FilePath+ -- ^ user-specified @ghcjs@ path (optional) -> Maybe FilePath+ -- ^ user-specified @ghcjs-pkg@ path (optional) -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb) configure verbosity hcPath hcPkgPath conf0 = do+ (comp, compPlatform, progdb1) <- configureCompiler verbosity hcPath conf0+ compProgDb <- compilerProgramDb verbosity comp progdb1 hcPkgPath+ return (comp, compPlatform, compProgDb)++-- | Configure GHCJS.+configureCompiler+ :: Verbosity+ -> Maybe FilePath+ -- ^ user-specified @ghc@ path (optional)+ -> ProgramDb+ -> IO (Compiler, Maybe Platform, ProgramDb)+configureCompiler verbosity hcPath conf0 = do (ghcjsProg, ghcjsVersion, progdb1) <- requireProgramVersion verbosity@@ -134,6 +152,43 @@ let implInfo = ghcjsVersionImplInfo ghcjsVersion ghcjsGhcVersion + languages <- Internal.getLanguages verbosity implInfo ghcjsProg+ extensions <- Internal.getExtensions verbosity implInfo ghcjsProg++ ghcjsInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg+ let ghcInfoMap = Map.fromList ghcjsInfo++ let comp =+ Compiler+ { compilerId = CompilerId GHCJS ghcjsVersion+ , compilerAbiTag =+ AbiTag $+ "ghc" ++ intercalate "_" (map show . versionNumbers $ ghcjsGhcVersion)+ , compilerCompat = [CompilerId GHC ghcjsGhcVersion]+ , compilerLanguages = languages+ , compilerExtensions = extensions+ , compilerProperties = ghcInfoMap+ }+ compPlatform = Internal.targetPlatform ghcjsInfo+ return (comp, compPlatform, progdb1)++-- | Given a configured @ghcjs@ program, configure auxiliary programs such+-- as @ghcjs-pkg@ or @haddock@, based on the location of the @ghcjs@ executable.+compilerProgramDb+ :: Verbosity+ -> Compiler+ -> ProgramDb+ -> Maybe FilePath+ -- ^ user-specified @ghc-pkg@ path (optional)+ -> IO ProgramDb+compilerProgramDb verbosity comp progdb1 hcPkgPath = do+ let+ ghcjsProg = fromJust $ lookupProgram ghcjsProgram progdb1+ ghcjsVersion = compilerVersion comp+ ghcjsGhcVersion = case compilerCompat comp of+ [CompilerId GHC ghcjsGhcVer] -> ghcjsGhcVer+ compat -> error $ "could not parse ghcjsGhcVersion:" ++ show compat+ -- This is slightly tricky, we have to configure ghc first, then we use the -- location of ghc to help find ghc-pkg in the case that the user did not -- specify the location of ghc-pkg directly:@@ -188,25 +243,7 @@ addKnownProgram hpcProgram' $ {- addKnownProgram runghcProgram' -} progdb2 - languages <- Internal.getLanguages verbosity implInfo ghcjsProg- extensions <- Internal.getExtensions verbosity implInfo ghcjsProg-- ghcjsInfo <- Internal.getGhcInfo verbosity implInfo ghcjsProg- let ghcInfoMap = Map.fromList ghcjsInfo-- let comp =- Compiler- { compilerId = CompilerId GHCJS ghcjsVersion- , compilerAbiTag =- AbiTag $- "ghc" ++ intercalate "_" (map show . versionNumbers $ ghcjsGhcVersion)- , compilerCompat = [CompilerId GHC ghcjsGhcVersion]- , compilerLanguages = languages- , compilerExtensions = extensions- , compilerProperties = ghcInfoMap- }- compPlatform = Internal.targetPlatform ghcjsInfo- return (comp, compPlatform, progdb3)+ return progdb3 guessGhcjsPkgFromGhcjsPath :: ConfiguredProgram
src/Distribution/Simple/Glob.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} @@ -370,7 +369,6 @@ "Null dir passed to runDirFileGlob; interpreting it " ++ "as '.'. This is probably an internal error." let root = if null rawRoot then "." else rawRoot- debug verbosity $ "Expanding glob '" ++ show (pretty pat) ++ "' in directory '" ++ root ++ "'." -- This function might be called from the project root with dir as -- ".". Walking the tree starting there involves going into .git/ -- and dist-newstyle/, which is a lot of work for no reward, so@@ -379,7 +377,7 @@ -- the whole directory if *, and just the specific file if it's a -- literal. let- (prefixSegments, variablePattern) = splitConstantPrefix pat+ (prefixSegments, pathOrVariablePattern) = splitConstantPrefix pat joinedPrefix = joinPath prefixSegments -- The glob matching function depends on whether we care about the cabal version or not@@ -431,17 +429,37 @@ concat <$> traverse (\subdir -> go globPath (dir </> subdir)) subdirs go GlobDirTrailing dir = return [GlobMatch dir] - directoryExists <- doesDirectoryExist (root </> joinedPrefix)- if directoryExists- then go variablePattern joinedPrefix- else return [GlobMissingDirectory joinedPrefix]+ case pathOrVariablePattern of+ Left filename -> do+ let filepath = joinedPrefix </> filename+ debug verbosity $ "Treating glob as filepath literal '" ++ filepath ++ "' in directory '" ++ root ++ "'."+ directoryExists <- doesDirectoryExist (root </> filepath)+ if directoryExists+ then pure [GlobMatchesDirectory filepath]+ else do+ exist <- doesFileExist (root </> filepath)+ pure $+ if exist+ then [GlobMatch filepath]+ else []+ Right variablePattern -> do+ debug verbosity $ "Expanding glob '" ++ show (pretty pat) ++ "' in directory '" ++ root ++ "'."+ directoryExists <- doesDirectoryExist (root </> joinedPrefix)+ if directoryExists+ then go variablePattern joinedPrefix+ else return [GlobMissingDirectory joinedPrefix] where -- \| Extract the (possibly null) constant prefix from the pattern. -- This has the property that, if @(pref, final) = splitConstantPrefix pat@, -- then @pat === foldr GlobDir final pref@.- splitConstantPrefix :: Glob -> ([FilePath], Glob)- splitConstantPrefix = unfoldr' step+ splitConstantPrefix :: Glob -> ([FilePath], Either FilePath Glob)+ splitConstantPrefix = fmap literalize . unfoldr' step where+ literalize (GlobFile [Literal filename]) =+ Left filename+ literalize glob =+ Right glob+ step (GlobDir [Literal seg] pat') = Right (seg, pat') step pat' = Left pat'
src/Distribution/Simple/Glob/Internal.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-} -----------------------------------------------------------------------------
src/Distribution/Simple/Haddock.hs view
@@ -5,7 +5,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- @@ -67,12 +66,9 @@ import qualified Distribution.Simple.Program.HcPkg as HcPkg import Distribution.Simple.Program.ResponseFile import Distribution.Simple.Register-import Distribution.Simple.Setup.Common-import Distribution.Simple.Setup.Haddock-import Distribution.Simple.Setup.Hscolour+import Distribution.Simple.Setup import Distribution.Simple.SetupHooks.Internal ( BuildHooks (..)- , BuildingWhat (..) , noBuildHooks ) import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks@@ -265,6 +261,7 @@ mbWorkDir = flagToMaybe $ haddockWorkingDir flags comp = compiler lbi platform = hostPlatform lbi+ config = configFlags lbi quickJmpFlag = haddockQuickJump flags' flags = case haddockTarget of@@ -282,9 +279,7 @@ flag f = fromFlag $ f flags tmpFileOpts =- defaultTempFileOptions- { optKeepTempFiles = flag haddockKeepTempFiles- }+ commonSetupTempFileOptions $ configCommonFlags config htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $ flags@@ -342,7 +337,7 @@ clbi = targetCLBI target bi = componentBuildInfo component -- Include any build-tool-depends on build tools internal to the current package.- progs' = addInternalBuildToolsFixed (Just curDir) pkg_descr lbi bi (withPrograms lbi)+ progs' = addInternalBuildTools curDir pkg_descr lbi bi (withPrograms lbi) lbi' = lbi { withPrograms = progs'@@ -554,9 +549,11 @@ -> IO () createHaddockIndex verbosity programDb comp platform mbWorkDir flags = do let args = fromHaddockProjectFlags flags+ tmpFileOpts =+ commonSetupTempFileOptions $ haddockProjectCommonFlags $ flags (haddockProg, _version) <- getHaddockProg verbosity programDb comp args (Flag True)- runHaddock verbosity mbWorkDir defaultTempFileOptions comp platform haddockProg False args+ runHaddock verbosity mbWorkDir tmpFileOpts comp platform haddockProg False args -- ------------------------------------------------------------------------------ -- Contributions to HaddockArgs (see also Doctest.hs for very similar code).@@ -621,6 +618,7 @@ , argInterfaces = fromFlagOrDefault [] (haddockProjectInterfaces flags) , argLinkedSource = Flag True , argResourcesDir = haddockProjectResourcesDir flags+ , argCssFile = haddockProjectCss flags } fromPackageDescription :: HaddockTarget -> PackageDescription -> HaddockArgs@@ -1073,7 +1071,13 @@ let vanillaOpts = componentGhcOptions normal lbi bi clbi (buildDir lbi) i = interpretSymbolicPath mbWorkDir- copyDir ghcDir tmpDir = copyDirectoryRecursive verbosity (i $ fromFlag $ ghcDir vanillaOpts) (i tmpDir)+ copyDir getGhcDir tmpDir = do+ let ghcDir = i $ fromFlag $ getGhcDir vanillaOpts+ ghcDirExists <- doesDirectoryExist ghcDir+ -- Don't try to copy artifacts if they don't exist, e.g. if+ -- we have not yet run the 'build' command.+ when ghcDirExists $+ copyDirectoryRecursive verbosity ghcDir (i tmpDir) copyDir ghcOptObjDir tmpObjDir copyDir ghcOptHiDir tmpHiDir -- copyDir ghcOptStubDir tmpStubDir -- (see W.1 in Note [Hi Haddock Recompilation Avoidance])@@ -1134,8 +1138,6 @@ withResponseFile verbosity tmpFileOpts- mbWorkDir- outputDir "haddock-response.txt" (if haddockSupportsUTF8 then Just utf8 else Nothing) renderedArgs@@ -1145,7 +1147,7 @@ (Flag pfile, _) -> withPrologueArgs ["--prologue=" ++ pfile] (_, Flag prologueText) ->- withTempFileEx tmpFileOpts mbWorkDir outputDir "haddock-prologue.txt" $+ withTempFileEx tmpFileOpts "haddock-prologue.txt" $ \prologueFileName h -> do when haddockSupportsUTF8 (hSetEncoding h utf8) hPutStrLn h prologueText@@ -1386,7 +1388,7 @@ let missing = [pkgid | Left pkgid <- interfaces] warning =- "The documentation for the following packages are not "+ "The following packages have no Haddock documentation " ++ "installed. No links will be generated to these packages: " ++ intercalate ", " (map prettyShow missing) flags = rights interfaces
− src/Distribution/Simple/HaskellSuite.hs
@@ -1,270 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}--module Distribution.Simple.HaskellSuite where--import Distribution.Compat.Prelude-import Prelude ()--import qualified Data.List.NonEmpty as NE--import Distribution.InstalledPackageInfo hiding (includeDirs)-import Distribution.Package-import Distribution.PackageDescription-import Distribution.Parsec (simpleParsec)-import Distribution.Pretty-import Distribution.Simple.BuildPaths-import Distribution.Simple.Compiler-import Distribution.Simple.Errors-import Distribution.Simple.LocalBuildInfo-import Distribution.Simple.PackageIndex as PackageIndex-import Distribution.Simple.Program-import Distribution.Simple.Program.Builtin-import Distribution.Simple.Utils-import Distribution.System (Platform)-import Distribution.Utils.Path-import Distribution.Verbosity-import Distribution.Version-import Language.Haskell.Extension--configure- :: Verbosity- -> Maybe FilePath- -> Maybe FilePath- -> ProgramDb- -> IO (Compiler, Maybe Platform, ProgramDb)-configure verbosity mbHcPath hcPkgPath progdb0 = do- -- We have no idea how a haskell-suite tool is named, so we require at- -- least some information from the user.- hcPath <-- let msg = "You have to provide name or path of a haskell-suite tool (-w PATH)"- in maybe (dieWithException verbosity $ ProvideHaskellSuiteTool msg) return mbHcPath-- when (isJust hcPkgPath) $- warn verbosity "--with-hc-pkg option is ignored for haskell-suite"-- (comp, confdCompiler, progdb1) <- configureCompiler hcPath progdb0-- -- Update our pkg tool. It uses the same executable as the compiler, but- -- all command start with "pkg"- (confdPkg, _) <- requireProgram verbosity haskellSuitePkgProgram progdb1- let progdb2 =- updateProgram- confdPkg- { programLocation = programLocation confdCompiler- , programDefaultArgs = ["pkg"]- }- progdb1-- return (comp, Nothing, progdb2)- where- configureCompiler hcPath progdb0' = do- let- haskellSuiteProgram' =- haskellSuiteProgram- { programFindLocation = \v p -> findProgramOnSearchPath v p hcPath- }-- -- NB: cannot call requireProgram right away — it'd think that- -- the program is already configured and won't reconfigure it again.- -- Instead, call configureProgram directly first.- progdb1 <- configureProgram verbosity haskellSuiteProgram' progdb0'- (confdCompiler, progdb2) <- requireProgram verbosity haskellSuiteProgram' progdb1-- extensions <- getExtensions verbosity confdCompiler- languages <- getLanguages verbosity confdCompiler- (compName, compVersion) <-- getCompilerVersion verbosity confdCompiler-- let- comp =- Compiler- { compilerId = CompilerId (HaskellSuite compName) compVersion- , compilerAbiTag = NoAbiTag- , compilerCompat = []- , compilerLanguages = languages- , compilerExtensions = extensions- , compilerProperties = mempty- }-- return (comp, confdCompiler, progdb2)--hstoolVersion :: Verbosity -> FilePath -> IO (Maybe Version)-hstoolVersion = findProgramVersion "--hspkg-version" id--numericVersion :: Verbosity -> FilePath -> IO (Maybe Version)-numericVersion = findProgramVersion "--compiler-version" (fromMaybe "" . safeLast . words)--getCompilerVersion :: Verbosity -> ConfiguredProgram -> IO (String, Version)-getCompilerVersion verbosity prog = do- output <- rawSystemStdout verbosity (programPath prog) ["--compiler-version"]- let- parts = words output- name = concat $ safeInit parts -- there shouldn't be any spaces in the name anyway- versionStr = fromMaybe "" $ safeLast parts- version <-- maybe- (dieWithException verbosity CannotDetermineCompilerVersion)- return- $ simpleParsec versionStr- return (name, version)--getExtensions :: Verbosity -> ConfiguredProgram -> IO [(Extension, Maybe CompilerFlag)]-getExtensions verbosity prog = do- extStrs <-- lines- `fmap` rawSystemStdout verbosity (programPath prog) ["--supported-extensions"]- return- [(ext, Just $ "-X" ++ prettyShow ext) | Just ext <- map simpleParsec extStrs]--getLanguages :: Verbosity -> ConfiguredProgram -> IO [(Language, CompilerFlag)]-getLanguages verbosity prog = do- langStrs <-- lines- `fmap` rawSystemStdout verbosity (programPath prog) ["--supported-languages"]- return- [(ext, "-G" ++ prettyShow ext) | Just ext <- map simpleParsec langStrs]---- Other compilers do some kind of a packagedb stack check here. Not sure--- if we need something like that as well.-getInstalledPackages- :: Verbosity- -- Not migrated to work with --working-dir but this is legacy dead code- -> PackageDBStackX (SymbolicPath from (Dir PkgDB))- -> ProgramDb- -> IO InstalledPackageIndex-getInstalledPackages verbosity packagedbs progdb =- liftM (PackageIndex.fromList . concat) $ for packagedbs $ \packagedb ->- do- str <-- getDbProgramOutput- verbosity- haskellSuitePkgProgram- progdb- ["dump", packageDbOpt packagedb]- `catchExit` \_ -> dieWithException verbosity PkgDumpFailed-- case parsePackages str of- Right ok -> return ok- _ -> dieWithException verbosity FailedToParseOutput- where- parsePackages str =- case partitionEithers $ map (parseInstalledPackageInfo . toUTF8BS) (splitPkgs str) of- ([], ok) -> Right [pkg | (_, pkg) <- ok]- (msgss, _) -> Left (foldMap NE.toList msgss)-- splitPkgs :: String -> [String]- splitPkgs = map unlines . splitWith ("---" ==) . lines- where- splitWith :: (a -> Bool) -> [a] -> [[a]]- splitWith p xs =- ys : case zs of- [] -> []- _ : ws -> splitWith p ws- where- (ys, zs) = break p xs--buildLib- :: Verbosity- -> PackageDescription- -> LocalBuildInfo- -> Library- -> ComponentLocalBuildInfo- -> IO ()-buildLib verbosity pkg_descr lbi lib clbi = do- -- In future, there should be a mechanism for the compiler to request any- -- number of the above parameters (or their parts) — in particular,- -- pieces of PackageDescription.- --- -- For now, we only pass those that we know are used.-- let odir = buildDir lbi- bi = libBuildInfo lib- srcDirs = map u (hsSourceDirs bi) ++ [u odir]- dbStack = withPackageDB lbi- language = fromMaybe Haskell98 (defaultLanguage bi)- progdb = withPrograms lbi- pkgid = packageId pkg_descr- u = interpretSymbolicPathCWD -- See Note [Symbolic paths] in Distribution.Utils.Path- runDbProgramCwd verbosity (mbWorkDirLBI lbi) haskellSuiteProgram progdb $- ["compile", "--build-dir", u odir]- ++ concat [["-i", d] | d <- srcDirs]- ++ concat- [ ["-I", d]- | d <-- [ u $ autogenComponentModulesDir lbi clbi- , u $ autogenPackageModulesDir lbi- , u odir- ]- ++ map u (includeDirs bi)- ]- ++ [packageDbOpt pkgDb | pkgDb <- dbStack]- ++ ["--package-name", prettyShow pkgid]- ++ concat- [ ["--package-id", prettyShow ipkgid]- | (ipkgid, _) <- componentPackageDeps clbi- ]- ++ ["-G", prettyShow language]- ++ concat [["-X", prettyShow ex] | ex <- usedExtensions bi]- ++ cppOptions (libBuildInfo lib)- ++ [prettyShow modu | modu <- allLibModules lib clbi]--installLib- :: Verbosity- -> LocalBuildInfo- -> FilePath- -- ^ install location- -> FilePath- -- ^ install location for dynamic libraries- -> FilePath- -- ^ Build location- -> PackageDescription- -> Library- -> ComponentLocalBuildInfo- -> IO ()-installLib verbosity lbi targetDir dynlibTargetDir builtDir pkg lib clbi = do- let progdb = withPrograms lbi- wdir = mbWorkDirLBI lbi- runDbProgramCwd verbosity wdir haskellSuitePkgProgram progdb $- [ "install-library"- , "--build-dir"- , builtDir- , "--target-dir"- , targetDir- , "--dynlib-target-dir"- , dynlibTargetDir- , "--package-id"- , prettyShow $ packageId pkg- ]- ++ map prettyShow (allLibModules lib clbi)--registerPackage- :: Verbosity- -> ProgramDb- -> PackageDBStackS from- -> InstalledPackageInfo- -> IO ()-registerPackage verbosity progdb packageDbs installedPkgInfo = do- (hspkg, _) <- requireProgram verbosity haskellSuitePkgProgram progdb-- runProgramInvocation verbosity $- ( programInvocation- hspkg- ["update", packageDbOpt $ registrationPackageDB packageDbs]- )- { progInvokeInput = Just $ IODataText $ showInstalledPackageInfo installedPkgInfo- }--initPackageDB :: Verbosity -> ProgramDb -> FilePath -> IO ()-initPackageDB verbosity progdb dbPath =- runDbProgram- verbosity- haskellSuitePkgProgram- progdb- ["init", dbPath]--packageDbOpt :: PackageDBX (SymbolicPath from (Dir PkgDB)) -> String-packageDbOpt GlobalPackageDB = "--global"-packageDbOpt UserPackageDB = "--user"-packageDbOpt (SpecificPackageDB db) = "--package-db=" ++ interpretSymbolicPathCWD db
src/Distribution/Simple/Install.hs view
@@ -74,7 +74,6 @@ import Distribution.Simple.Errors import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.GHCJS as GHCJS-import qualified Distribution.Simple.HaskellSuite as HaskellSuite import Distribution.Simple.Setup.Common import qualified Distribution.Simple.UHC as UHC @@ -249,16 +248,6 @@ GHC -> GHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi GHCJS -> GHCJS.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi UHC -> UHC.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi- HaskellSuite _ ->- HaskellSuite.installLib- verbosity- lbi- libPref- dynlibPref- buildPref- pkg_descr- lib- clbi _ -> dieWithException verbosity $ CompilerNotInstalled (compilerFlavor (compiler lbi)) copyComponent verbosity pkg_descr lbi (CFLib flib) clbi copydest = do@@ -307,7 +296,6 @@ GHC -> GHC.installExe verbosity lbi binPref buildPref progFix pkg_descr exe GHCJS -> GHCJS.installExe verbosity lbi binPref buildPref progFix pkg_descr exe UHC -> return ()- HaskellSuite{} -> return () _ -> dieWithException verbosity $ CompilerNotInstalled (compilerFlavor (compiler lbi))
src/Distribution/Simple/InstallDirs.hs view
@@ -537,7 +537,7 @@ -- csidl_PROGRAM_FILES_COMMON = 0x002b {- FOURMOLU_DISABLE -}-#ifdef x86_64_HOST_ARCH+#if defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) #define CALLCONV ccall #else #define CALLCONV stdcall
src/Distribution/Simple/LocalBuildInfo.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} -----------------------------------------------------------------------------
src/Distribution/Simple/PackageIndex.hs view
@@ -67,6 +67,7 @@ , lookupSourcePackageId , lookupPackageId , lookupPackageName+ , lookupInternalPackageName , lookupDependency , lookupInternalDependency @@ -92,6 +93,10 @@ , dependencyCycles , dependencyGraph , moduleNameIndex++ -- ** Filters on lookup results+ , eligibleDependencies+ , matchingDependencies ) where import qualified Data.Map.Strict as Map@@ -473,7 +478,18 @@ -> [(Version, [a])] lookupPackageName index name = -- Do not match internal libraries- case Map.lookup (name, LMainLibName) (packageIdIndex index) of+ lookupInternalPackageName index name LMainLibName++-- | Does a lookup by source package name and library name.+--+-- Also looks up internal packages.+lookupInternalPackageName+ :: PackageIndex a+ -> PackageName+ -> LibraryName+ -> [(Version, [a])]+lookupInternalPackageName index name library =+ case Map.lookup (name, library) (packageIdIndex index) of Nothing -> [] Just pvers -> Map.toList pvers @@ -508,22 +524,45 @@ -> LibraryName -> [(Version, [IPI.InstalledPackageInfo])] lookupInternalDependency index name versionRange libn =- case Map.lookup (name, libn) (packageIdIndex index) of- Nothing -> []- Just pvers ->- [ (ver, pkgs')- | (ver, pkgs) <- Map.toList pvers- , ver `withinRange` versionRange- , let pkgs' = filter eligible pkgs- , -- Enforce the invariant- not (null pkgs')- ]+ matchingDependencies versionRange $+ lookupInternalPackageName index name libn++-- | Filter a set of installed packages to ones eligible as dependencies.+--+-- When we select for dependencies, we ONLY want to pick up indefinite+-- packages, or packages with no instantiations. We'll do mix-in linking to+-- improve any such package into an instantiated one later.+--+-- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty.+eligibleDependencies+ :: [(Version, [IPI.InstalledPackageInfo])]+ -> [(Version, [IPI.InstalledPackageInfo])]+eligibleDependencies versions =+ [ (ver, pkgs')+ | (ver, pkgs) <- versions+ , let pkgs' = filter eligible pkgs+ , -- Enforce the invariant+ not (null pkgs')+ ] where- -- When we select for dependencies, we ONLY want to pick up indefinite- -- packages, or packages with no instantiations. We'll do mix-in- -- linking to improve any such package into an instantiated one- -- later. eligible pkg = IPI.indefinite pkg || null (IPI.instantiatedWith pkg)++-- | Get eligible dependencies from a list of versions.+--+-- This can be used to filter the output of 'lookupPackageName' or+-- 'lookupInternalPackageName'.+--+-- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty.+matchingDependencies+ :: VersionRange+ -> [(Version, [IPI.InstalledPackageInfo])]+ -> [(Version, [IPI.InstalledPackageInfo])]+matchingDependencies versionRange versions =+ let eligibleVersions = eligibleDependencies versions+ in [ (ver, pkgs)+ | (ver, pkgs) <- eligibleVersions+ , ver `withinRange` versionRange+ ] --
src/Distribution/Simple/PreProcess.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- @@ -36,7 +35,6 @@ , runSimplePreProcessor , ppCpp , ppCpp'- , ppGreenCard , ppC2hs , ppHsc2hs , ppHappy@@ -347,8 +345,8 @@ createDirectoryIfMissingVerbose verbosity True destDir runPreProcessorWithHsBootHack pp- (getSymbolicPath $ psrcLoc, getSymbolicPath $ psrcRelFile)- (getSymbolicPath $ buildLoc, srcStem <.> "hs")+ (psrcLoc, getSymbolicPath $ psrcRelFile)+ (buildLoc, srcStem <.> "hs") where i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path buildAsSrcLoc :: SymbolicPath Pkg (Dir Source)@@ -363,20 +361,25 @@ pp (inBaseDir, inRelativeFile) (outBaseDir, outRelativeFile) = do+ -- Preprocessors are expected to take into account the working+ -- directory, e.g. using runProgramCwd with a working directory+ -- computed with mbWorkDirLBI.+ -- Hence the use of 'getSymbolicPath' here. runPreProcessor pp- (inBaseDir, inRelativeFile)- (outBaseDir, outRelativeFile)+ (getSymbolicPath $ inBaseDir, inRelativeFile)+ (getSymbolicPath $ outBaseDir, outRelativeFile) verbosity - exists <- doesFileExist inBoot- when exists $ copyFileVerbose verbosity inBoot outBoot- where+ -- Here we interact directly with the file system, so we must+ -- interpret symbolic paths with respect to the working directory.+ let+ inFile = normalise (i inBaseDir </> inRelativeFile)+ outFile = normalise (i outBaseDir </> outRelativeFile) inBoot = replaceExtension inFile "hs-boot" outBoot = replaceExtension outFile "hs-boot"-- inFile = normalise (inBaseDir </> inRelativeFile)- outFile = normalise (outBaseDir </> outRelativeFile)+ exists <- doesFileExist inBoot+ when exists $ copyFileVerbose verbosity inBoot outBoot -- ------------------------------------------------------------ @@ -384,20 +387,6 @@ -- ------------------------------------------------------------ -ppGreenCard :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor-ppGreenCard _ lbi _ =- PreProcessor- { platformIndependent = False- , ppOrdering = unsorted- , runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity ->- runDbProgramCwd- verbosity- (mbWorkDirLBI lbi)- greencardProgram- (withPrograms lbi)- (["-tffi", "-o" ++ outFile, inFile])- }- -- This one is useful for preprocessors that can't handle literate source. -- We also need a way to chain preprocessors. ppUnlit :: PreProcessor@@ -511,8 +500,6 @@ withResponseFile verbosity defaultTempFileOptions- mbWorkDir- (makeSymbolicPath $ takeDirectory outFile) "hsc2hs-response.txt" Nothing pureArgs@@ -763,10 +750,6 @@ ++ ["-D" ++ arch ++ "_BUILD_ARCH=1"] ++ map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr ++ map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr- HaskellSuite{} ->- ["-D__HASKELL_SUITE__"]- ++ map (\os' -> "-D" ++ os' ++ "_HOST_OS=1") osStr- ++ map (\arch' -> "-D" ++ arch' ++ "_HOST_ARCH=1") archStr _ -> [] where comp = compiler lbi@@ -876,11 +859,10 @@ ppSuffixes :: [PPSuffixHandler] -> [Suffix] ppSuffixes = map fst --- | Standard preprocessors: GreenCard, c2hs, hsc2hs, happy, alex and cpphs.+-- | Standard preprocessors: c2hs, hsc2hs, happy, alex and cpphs. knownSuffixHandlers :: [PPSuffixHandler] knownSuffixHandlers =- [ (Suffix "gc", ppGreenCard)- , (Suffix "chs", ppC2hs)+ [ (Suffix "chs", ppC2hs) , (Suffix "hsc", ppHsc2hs) , (Suffix "x", ppAlex) , (Suffix "y", ppHappy)
src/Distribution/Simple/PreProcess/Types.hs view
@@ -44,11 +44,12 @@ -- > ppTestHandler = -- > PreProcessor { -- > platformIndependent = True,+-- > ppOrdering = \_ _ -> return, -- > runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> -- > do info verbosity (inFile++" has been preprocessed to "++outFile) -- > stuff <- readFile inFile -- > writeFile outFile ("-- preprocessed as a test\n\n" ++ stuff)--- > return ExitSuccess+-- > return () -- -- We split the input and output file names into a base directory and the -- rest of the file name. The input base dir is the path in the list of search
src/Distribution/Simple/Program.hs view
@@ -111,10 +111,10 @@ , ghcPkgProgram , ghcjsProgram , ghcjsPkgProgram- , hmakeProgram , jhcProgram , uhcProgram , gccProgram+ , gppProgram , arProgram , stripProgram , happyProgram@@ -125,7 +125,6 @@ , hscolourProgram , doctestProgram , haddockProgram- , greencardProgram , ldProgram , tarProgram , cppProgram
src/Distribution/Simple/Program/Ar.hs view
@@ -154,7 +154,7 @@ (initial, middle, final) (map getSymbolicPath files) ]- else withResponseFile verbosity defaultTempFileOptions mbWorkDir tmpDir "ar.rsp" Nothing (map getSymbolicPath files) $+ else withResponseFile verbosity defaultTempFileOptions "ar.rsp" Nothing (map getSymbolicPath files) $ \path -> runProgramInvocation verbosity $ invokeWithResponseFile path unless
src/Distribution/Simple/Program/Builtin.hs view
@@ -20,12 +20,10 @@ , runghcProgram , ghcjsProgram , ghcjsPkgProgram- , hmakeProgram , jhcProgram- , haskellSuiteProgram- , haskellSuitePkgProgram , uhcProgram , gccProgram+ , gppProgram , arProgram , stripProgram , happyProgram@@ -36,7 +34,6 @@ , hscolourProgram , doctestProgram , haddockProgram- , greencardProgram , ldProgram , tarProgram , cppProgram@@ -74,9 +71,6 @@ , ghcPkgProgram , ghcjsProgram , ghcjsPkgProgram- , haskellSuiteProgram- , haskellSuitePkgProgram- , hmakeProgram , jhcProgram , uhcProgram , hpcProgram@@ -89,7 +83,6 @@ , hsc2hsProgram , c2hsProgram , cpphsProgram- , greencardProgram , -- platform toolchain gccProgram , arProgram@@ -104,33 +97,45 @@ ghcProgram = (simpleProgram "ghc") { programFindVersion = findProgramVersion "--numeric-version" id- , -- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/8825- -- (spurious warning on non-english locales)- programPostConf = \_verbosity ghcProg ->- do- let ghcProg' =- ghcProg- { programOverrideEnv =- ("LANGUAGE", Just "en")- : programOverrideEnv ghcProg- }- -- Only the 7.8 branch seems to be affected. Fixed in 7.8.4.- affectedVersionRange =- intersectVersionRanges- (laterVersion $ mkVersion [7, 8, 0])- (earlierVersion $ mkVersion [7, 8, 4])- return $- maybe- ghcProg- ( \v ->- if withinRange v affectedVersionRange- then ghcProg'- else ghcProg- )- (programVersion ghcProg)+ , programPostConf = ghcPostConf , programNormaliseArgs = normaliseGhcArgs }+ where+ ghcPostConf _verbosity ghcProg = do+ let setLanguageEnv prog =+ prog+ { programOverrideEnv =+ ("LANGUAGE", Just "en")+ : programOverrideEnv ghcProg+ } + ignorePackageEnv prog = prog{programDefaultArgs = "-package-env=-" : programDefaultArgs prog}++ -- Only the 7.8 branch seems to be affected. Fixed in 7.8.4.+ affectedVersionRange =+ intersectVersionRanges+ (laterVersion $ mkVersion [7, 8, 0])+ (earlierVersion $ mkVersion [7, 8, 4])++ canIgnorePackageEnv = orLaterVersion $ mkVersion [8, 4, 4]++ applyWhen cond f prog = if cond then f prog else prog++ return $+ maybe+ ghcProg+ ( \v ->+ -- By default, ignore GHC_ENVIRONMENT variable of any package environmnet+ -- files. See #10759+ applyWhen (withinRange v canIgnorePackageEnv) ignorePackageEnv+ -- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/8825+ -- (spurious warning on non-english locales)+ $+ applyWhen (withinRange v affectedVersionRange) setLanguageEnv $+ ghcProg+ )+ (programVersion ghcProg)+ runghcProgram :: Program runghcProgram = (simpleProgram "runghc")@@ -170,17 +175,6 @@ _ -> "" } -hmakeProgram :: Program-hmakeProgram =- (simpleProgram "hmake")- { programFindVersion = findProgramVersion "--version" $ \str ->- -- Invoking "hmake --version" gives a string line- -- "/usr/local/bin/hmake: 3.13 (2006-11-01)"- case words str of- (_ : ver : _) -> ver- _ -> ""- }- jhcProgram :: Program jhcProgram = (simpleProgram "jhc")@@ -208,32 +202,6 @@ _ -> "" } --- This represents a haskell-suite compiler. Of course, the compiler--- itself probably is not called "haskell-suite", so this is not a real--- program. (But we don't know statically the name of the actual compiler,--- so this is the best we can do.)------ Having this Program value serves two purposes:------ 1. We can accept options for the compiler in the form of------ --haskell-suite-option(s)=...------ 2. We can find a program later using this static id (with--- requireProgram).------ The path to the real compiler is found and recorded in the ProgramDb--- during the configure phase.-haskellSuiteProgram :: Program-haskellSuiteProgram =- simpleProgram "haskell-suite"---- This represent a haskell-suite package manager. See the comments for--- haskellSuiteProgram.-haskellSuitePkgProgram :: Program-haskellSuitePkgProgram =- simpleProgram "haskell-suite-pkg"- happyProgram :: Program happyProgram = (simpleProgram "happy")@@ -262,6 +230,13 @@ { programFindVersion = findProgramVersion "-dumpversion" id } +gppProgram :: Program+gppProgram =+ (simpleProgram "gpp")+ { programFindVersion = findProgramVersion "-dumpversion" id+ , programFindLocation = \v p -> findProgramOnSearchPath v p "g++"+ }+ arProgram :: Program arProgram = simpleProgram "ar" @@ -334,9 +309,6 @@ _ -> "" , programNormaliseArgs = \_ _ args -> args }--greencardProgram :: Program-greencardProgram = simpleProgram "greencard" ldProgram :: Program ldProgram =
src/Distribution/Simple/Program/Find.hs view
@@ -1,6 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}
src/Distribution/Simple/Program/GHC.hs view
@@ -5,7 +5,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} module Distribution.Simple.Program.GHC ( GhcOptions (..)@@ -16,6 +15,8 @@ , ghcInvocation , renderGhcOptions , runGHC+ , runGHCWithResponseFile+ , runReplProgram , packageDbArgsDb , normaliseGhcArgs ) where@@ -32,8 +33,10 @@ import Distribution.Simple.Flag import Distribution.Simple.GHC.ImplInfo import Distribution.Simple.Program.Find (getExtraPathEnv)+import Distribution.Simple.Program.ResponseFile import Distribution.Simple.Program.Run import Distribution.Simple.Program.Types+import Distribution.Simple.Utils (TempFileOptions, infoNoWrap) import Distribution.System import Distribution.Types.ComponentId import Distribution.Types.ParStrat@@ -42,17 +45,19 @@ import Distribution.Verbosity import Distribution.Version +import GHC.IO.Encoding (TextEncoding) import Language.Haskell.Extension import Data.List (stripPrefix) import qualified Data.Map as Map import Data.Monoid (All (..), Any (..), Endo (..)) import qualified Data.Set as Set+import qualified System.Process as Process normaliseGhcArgs :: Maybe Version -> PackageDescription -> [String] -> [String] normaliseGhcArgs (Just ghcVersion) PackageDescription{..} ghcArgs | ghcVersion `withinRange` supportedGHCVersions =- argumentFilters . filter simpleFilters . filterRtsOpts $ ghcArgs+ argumentFilters . filter simpleFilters . filterRtsArgs $ ghcArgs where supportedGHCVersions :: VersionRange supportedGHCVersions = orLaterVersion (mkVersion [8, 0])@@ -162,18 +167,9 @@ flagArgumentFilter ["-ghci-script", "-H", "-interactive-print"] - filterRtsOpts :: [String] -> [String]- filterRtsOpts = go False- where- go :: Bool -> [String] -> [String]- go _ [] = []- go _ ("+RTS" : opts) = go True opts- go _ ("-RTS" : opts) = go False opts- go isRTSopts (opt : opts) = addOpt $ go isRTSopts opts- where- addOpt- | isRTSopts = id- | otherwise = (opt :)+ -- \| Remove RTS arguments from a list.+ filterRtsArgs :: [String] -> [String]+ filterRtsArgs = snd . splitRTSArgs simpleFilters :: String -> Bool simpleFilters =@@ -442,6 +438,8 @@ -- the @ghc -i@ flag (@-i@ on its own with no path argument). , ghcOptSourcePath :: NubListR (SymbolicPath Pkg (Dir Source)) -- ^ Search path for Haskell source files; the @ghc -i@ flag.+ , ghcOptUnitFiles :: [FilePath]+ -- ^ Unit files to load; the @ghc -unit@ flag. , ------------- -- Packages @@ -510,6 +508,8 @@ -- ^ Options to pass through to the Assembler. , ghcOptCppOptions :: [String] -- ^ Options to pass through to CPP; the @ghc -optP@ flag.+ , ghcOptJSppOptions :: [String]+ -- ^ Options to pass through to CPP; the @ghc -optJSP@ flag. @since 3.16.0.0 , ghcOptCppIncludePath :: NubListR (SymbolicPath Pkg (Dir Include)) -- ^ Search path for CPP includes like header files; the @ghc -I@ flag. , ghcOptCppIncludes :: NubListR (SymbolicPath Pkg File)@@ -647,6 +647,97 @@ runProgramInvocation verbosity =<< ghcInvocation verbosity ghcProg comp platform mbWorkDir opts +runGHCWithResponseFile+ :: FilePath+ -> Maybe TextEncoding+ -> TempFileOptions+ -> Verbosity+ -> ConfiguredProgram+ -> Compiler+ -> Platform+ -> Maybe (SymbolicPath CWD (Dir Pkg))+ -> GhcOptions+ -> IO ()+runGHCWithResponseFile fileNameTemplate encoding tempFileOptions verbosity ghcProg comp platform maybeWorkDir opts = do+ invocation <- ghcInvocation verbosity ghcProg comp platform maybeWorkDir opts++ let compilerSupportsResponseFiles =+ case compilerCompatVersion GHC comp of+ -- GHC 9.4 is the first version which supports response files.+ Just version -> version >= mkVersion [9, 4]+ Nothing -> False++ args = progInvokeArgs invocation++ if not compilerSupportsResponseFiles+ then runProgramInvocation verbosity invocation+ else do+ let (rtsArgs, otherArgs) = splitRTSArgs args++ withResponseFile+ verbosity+ tempFileOptions+ fileNameTemplate+ encoding+ otherArgs+ $ \responseFile -> do+ let newInvocation =+ invocation{progInvokeArgs = ('@' : responseFile) : rtsArgs}++ infoNoWrap verbosity $+ "GHC response file arguments: "+ <> case otherArgs of+ [] -> ""+ arg : args' -> Process.showCommandForUser arg args'++ runProgramInvocation verbosity newInvocation++-- Note [Make --interactive the first argument to GHC]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- The ghc argument @--interactive@ needs to be the first argument to the+-- ghc invocation, because Haskell Language Server used to rely on this.+-- This was initially changed for Cabal 3.16, but it broke all existing Haskell+-- Language Server prebuilt binaries.+-- To avoid this, we uphold this assumption in Haskell Language Server until the next+-- Cabal release (3.18).+--+-- The solution is to make sure that @--interactive@ is not passed as an argument in+-- the response file that is usually passed to ghc.+-- Instead, we filter out @--interactive@ and always pass it as the first argument,+-- if it exists.+--+-- We plan to remove this Hack in Cabal 3.18.++-- Start the repl. Either use `ghc`, or the program specified by the --with-repl flag.+runReplProgram+ :: Maybe FilePath+ -- ^ --with-repl argument+ -> TempFileOptions+ -> Verbosity+ -> ConfiguredProgram+ -> Compiler+ -> Platform+ -> Maybe (SymbolicPath CWD (Dir Pkg))+ -> GhcOptions+ -> IO ()+runReplProgram withReplProg _tempFileOptions verbosity ghcProg comp platform mbWorkDir ghcOpts =+ let replProg = case withReplProg of+ Just path -> ghcProg{programLocation = FoundOnSystem path}+ Nothing -> ghcProg+ in do+ -- in runGHCWithResponseFile "ghci.rsp" Nothing tempFileOptions verbosity replProg comp platform mbWorkDir ghcOpts+ -- See Note [Make --interactive the first argument to GHC]+ -- In Cabal 3.18, restore the line above.+ invocation <- ghcInvocation verbosity replProg comp platform mbWorkDir ghcOpts+ let invocation' =+ let+ argsWithoutInteractive = filter (/= "--interactive") (progInvokeArgs invocation)+ in+ invocation+ { progInvokeArgs = ["--interactive"] <> argsWithoutInteractive+ }+ runProgramInvocation verbosity invocation'+ ghcInvocation :: Verbosity -> ConfiguredProgram@@ -786,6 +877,7 @@ ["-I" ++ u dir | dir <- flags ghcOptCppIncludePath] , ["-optP" ++ opt | opt <- ghcOptCppOptions opts]+ , ["-optJSP" ++ opt | opt <- ghcOptJSppOptions opts] , concat [ ["-optP-include", "-optP" ++ u inc] | inc <- flags ghcOptCppIncludes@@ -897,6 +989,8 @@ , [prettyShow modu | modu <- flags ghcOptInputModules] , concat [["-o", u out] | out <- flag ghcOptOutputFile] , concat [["-dyno", out] | out <- flag ghcOptOutputDynFile]+ , -- unit files+ concat [["-unit", "@" ++ unit] | unit <- ghcOptUnitFiles opts] , --------------- -- Extra @@ -959,6 +1053,26 @@ packageDbArgs implInfo | flagPackageConf implInfo = packageDbArgsConf | otherwise = packageDbArgsDb++-- | Split a list of command-line arguments into RTS arguments and non-RTS+-- arguments.+splitRTSArgs :: [String] -> ([String], [String])+splitRTSArgs args =+ let addRTSArg arg ~(rtsArgs, nonRTSArgs) = (arg : rtsArgs, nonRTSArgs)+ addNonRTSArg arg ~(rtsArgs, nonRTSArgs) = (rtsArgs, arg : nonRTSArgs)++ go _ [] = ([], [])+ go isRTSArg (arg : rest) =+ case arg of+ "+RTS" -> addRTSArg arg $ go True rest+ "-RTS" -> addRTSArg arg $ go False rest+ "--RTS" -> ([arg], rest)+ "--" -> ([], arg : rest)+ _ ->+ if isRTSArg+ then addRTSArg arg $ go isRTSArg rest+ else addNonRTSArg arg $ go isRTSArg rest+ in go False args -- ----------------------------------------------------------------------------- -- Boilerplate Monoid instance for GhcOptions
src/Distribution/Simple/Program/Internal.hs view
@@ -17,21 +17,28 @@ -- | Extract the version number from the output of 'strip --version'. ----- Invoking "strip --version" gives very inconsistent results. We ignore--- everything in parentheses (see #2497), look for the first word that starts--- with a number, and try parsing out the first two components of it. Non-GNU--- 'strip' doesn't appear to have a version flag.+-- Invoking "strip --version" gives very inconsistent results. We+-- ignore everything in parentheses (see #2497), look for the first+-- word that starts with a number, and try parsing out the first two+-- components of it. Non-GNU, non-LLVM 'strip' doesn't appear to have+-- a version flag. stripExtractVersion :: String -> String stripExtractVersion str = let numeric "" = False numeric (x : _) = isDigit x + closingParentheses =+ [ ")"+ , -- LLVM strip outputs "llvm-strip, compatible with GNU strip\nLLVM (http://llvm.org/):\n..."+ "):"+ ]+ -- Filter out everything in parentheses. filterPar' :: Int -> [String] -> [String] filterPar' _ [] = [] filterPar' n (x : xs) | n >= 0 && "(" `isPrefixOf` x = filterPar' (n + 1) ((safeTail x) : xs)- | n > 0 && ")" `isSuffixOf` x = filterPar' (n - 1) xs+ | n > 0 && any (`isSuffixOf` x) closingParentheses = filterPar' (n - 1) xs | n > 0 = filterPar' n xs | otherwise = x : filterPar' n xs
src/Distribution/Simple/Program/Ld.hs view
@@ -83,8 +83,6 @@ middle = ld middleArgs final = ld finalArgs - targetDir = takeDirectorySymbolicPath target- invokeWithResponseFile :: FilePath -> ProgramInvocation invokeWithResponseFile atFile = ld $ simpleArgs ++ ['@' : atFile]@@ -106,7 +104,7 @@ if oldVersionManualOverride || responseArgumentsNotSupported then run $ multiStageProgramInvocation simple (initial, middle, final) (map getSymbolicPath files)- else withResponseFile verbosity defaultTempFileOptions mbWorkDir targetDir "ld.rsp" Nothing (map getSymbolicPath files) $+ else withResponseFile verbosity defaultTempFileOptions "ld.rsp" Nothing (map getSymbolicPath files) $ \path -> runProgramInvocation verbosity $ invokeWithResponseFile path where tmpfile = target <.> "tmp" -- perhaps should use a proper temp file
src/Distribution/Simple/Program/ResponseFile.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeApplications #-} ---------------------------------------------------------------------------- @@ -27,10 +26,6 @@ withResponseFile :: Verbosity -> TempFileOptions- -> Maybe (SymbolicPath CWD (Dir Pkg))- -- ^ Working directory- -> SymbolicPath Pkg (Dir Response)- -- ^ Directory to create response file in. -> String -- ^ Template for response file name. -> Maybe TextEncoding@@ -39,8 +34,8 @@ -- ^ Arguments to put into response file. -> (FilePath -> IO a) -> IO a-withResponseFile verbosity tmpFileOpts mbWorkDir responseDir fileNameTemplate encoding arguments f =- withTempFileEx tmpFileOpts mbWorkDir responseDir fileNameTemplate $ \responsePath hf -> do+withResponseFile verbosity tmpFileOpts fileNameTemplate encoding arguments f =+ withTempFileEx tmpFileOpts fileNameTemplate $ \responsePath hf -> do let responseFileName = getSymbolicPath responsePath traverse_ (hSetEncoding hf) encoding let responseContents =
src/Distribution/Simple/Program/Run.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- @@ -62,6 +61,7 @@ , progInvokeInputEncoding :: IOEncoding -- ^ TODO: remove this, make user decide when constructing 'progInvokeInput'. , progInvokeOutputEncoding :: IOEncoding+ , progInvokeWhen :: IO Bool } data IOEncoding@@ -83,6 +83,7 @@ , progInvokeInput = Nothing , progInvokeInputEncoding = IOEncodingText , progInvokeOutputEncoding = IOEncodingText+ , progInvokeWhen = pure True } simpleProgramInvocation
src/Distribution/Simple/Program/Types.hs view
@@ -142,7 +142,7 @@ , programMonitorFiles :: [FilePath] -- ^ In addition to the 'programLocation' where the program was found, -- these are additional locations that were looked at. The combination- -- of ths found location and these not-found locations can be used to+ -- of this found location and these not-found locations can be used to -- monitor to detect when the re-configuring the program might give a -- different result (e.g. found in a different location). }
src/Distribution/Simple/Register.hs view
@@ -59,7 +59,6 @@ import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.GHCJS as GHCJS-import qualified Distribution.Simple.HaskellSuite as HaskellSuite import qualified Distribution.Simple.PackageIndex as Index import qualified Distribution.Simple.UHC as UHC @@ -371,7 +370,6 @@ GHC -> HcPkg.init (GHC.hcPkgInfo progdb) verbosity preferCompat dbPath GHCJS -> HcPkg.init (GHCJS.hcPkgInfo progdb) verbosity False dbPath UHC -> return ()- HaskellSuite _ -> HaskellSuite.initPackageDB verbosity progdb dbPath _ -> dieWithException verbosity CreatePackageDB doesPackageDBExist :: FilePath -> IO Bool@@ -436,8 +434,6 @@ case compilerFlavor comp of GHC -> GHC.registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions GHCJS -> GHCJS.registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions- HaskellSuite{} ->- HaskellSuite.registerPackage verbosity progdb packageDbs installedPkgInfo _ | HcPkg.registerMultiInstance registerOptions -> dieWithException verbosity RegisMultiplePkgNotSupported@@ -497,9 +493,9 @@ { IPI.sourcePackageId = packageId pkg , IPI.installedUnitId = componentUnitId clbi , IPI.installedComponentId_ = componentComponentId clbi- , IPI.instantiatedWith = componentInstantiatedWith clbi+ , IPI.instantiatedWith = expectLibraryComponent (maybeComponentInstantiatedWith clbi) , IPI.sourceLibName = libName lib- , IPI.compatPackageKey = componentCompatPackageKey clbi+ , IPI.compatPackageKey = expectLibraryComponent (maybeComponentCompatPackageKey clbi) , -- If GHC >= 8.4 we register with SDPX, otherwise with legacy license IPI.license = if ghc84@@ -518,7 +514,7 @@ , IPI.indefinite = componentIsIndefinite clbi , IPI.exposed = libExposed lib , IPI.exposedModules =- componentExposedModules clbi+ expectLibraryComponent (maybeComponentExposedModules clbi) -- add virtual modules into the list of exposed modules for the -- package database as well. ++ map (\name -> IPI.ExposedModule name Nothing) (virtualModules bi)@@ -601,6 +597,8 @@ ) | otherwise = (libdir installDirs : dynlibdir installDirs : extraLibDirs', [])+ expectLibraryComponent (Just attribute) = attribute+ expectLibraryComponent Nothing = (error "generalInstalledPackageInfo: Expected a library component, got something else.") -- the compiler doesn't understand the dynamic-library-dirs field so we -- add the dyn directory to the "normal" list in the library-dirs field
src/Distribution/Simple/Setup.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} -- |@@ -38,6 +38,7 @@ , globalCommand , CommonSetupFlags (..) , defaultCommonSetupFlags+ , commonSetupTempFileOptions , ConfigFlags (..) , emptyConfigFlags , defaultConfigFlags@@ -118,7 +119,9 @@ , splitArgs , defaultDistPref , optionDistPref- , Flag (..)+ , Flag+ , pattern Flag+ , pattern NoFlag , toFlag , fromFlag , fromFlagOrDefault
src/Distribution/Simple/Setup/Benchmark.hs view
@@ -118,7 +118,8 @@ [] ["benchmark-options"] ( "give extra options to benchmark executables "- ++ "(name templates can use $pkgid, $compiler, "+ ++ "(split on spaces, use \"\" to prevent splitting; "+ ++ "name templates can use $pkgid, $compiler, " ++ "$os, $arch, $benchmark)" ) benchmarkOptions@@ -132,7 +133,7 @@ [] ["benchmark-option"] ( "give extra option to benchmark executables "- ++ "(no need to quote options containing spaces, "+ ++ "(passed directly as a single argument; " ++ "name template can use $pkgid, $compiler, " ++ "$os, $arch, $benchmark)" )
src/Distribution/Simple/Setup/Common.hs view
@@ -1,8 +1,7 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} -- |@@ -20,6 +19,7 @@ ( CommonSetupFlags (..) , defaultCommonSetupFlags , withCommonSetupOptions+ , commonSetupTempFileOptions , CopyDest (..) , configureCCompiler , configureLinker@@ -33,7 +33,9 @@ , defaultDistPref , extraCompilationArtifacts , optionDistPref- , Flag (..)+ , Flag+ , pattern Flag+ , pattern NoFlag , toFlag , fromFlag , fromFlagOrDefault@@ -82,6 +84,13 @@ -- -- TODO: this one should not be here, it's just that the silly -- UserHooks stop us from passing extra info in other ways+ , setupKeepTempFiles :: Flag Bool+ -- ^ When this flag is set, temporary files will be kept after building.+ --+ -- Note: Keeping temporary files is important functionality for HLS, which+ -- runs @cabal repl@ with a fake GHC to get CLI arguments. It will need the+ -- temporary files (including multi unit repl response files) to stay, even+ -- after the @cabal repl@ command exits. } deriving (Eq, Show, Read, Generic) @@ -103,8 +112,17 @@ , setupDistPref = NoFlag , setupCabalFilePath = NoFlag , setupTargets = []+ , setupKeepTempFiles = NoFlag } +-- | Get `TempFileOptions` that respect the `setupKeepTempFiles` flag.+commonSetupTempFileOptions :: CommonSetupFlags -> TempFileOptions+commonSetupTempFileOptions options =+ TempFileOptions+ { optKeepTempFiles =+ fromFlagOrDefault False (setupKeepTempFiles options)+ }+ commonSetupOptions :: ShowOrParseArgs -> [OptionField CommonSetupFlags] commonSetupOptions showOrParseArgs = [ optionVerbosity@@ -121,6 +139,14 @@ setupCabalFilePath (\v flags -> flags{setupCabalFilePath = v}) (reqSymbolicPathArgFlag "PATH")+ , option+ ""+ ["keep-temp-files"]+ ( "Keep temporary files."+ )+ setupKeepTempFiles+ (\keepTempFiles flags -> flags{setupKeepTempFiles = keepTempFiles})+ trueArg -- NB: no --working-dir flag, as that value is populated using the -- global flag (see Distribution.Simple.Setup.Global.globalCommand). ]@@ -252,7 +278,9 @@ [prog ++ "-option"] ( "give an extra option to " ++ prog- ++ " (no need to quote options containing spaces)"+ ++ " (passed directly to "+ ++ prog+ ++ " as a single argument)" ) get set@@ -289,7 +317,10 @@ option "" [prog ++ "-options"]- ("give extra options to " ++ prog)+ ( "give extra options to "+ ++ prog+ ++ " (split on spaces, use \"\" to prevent splitting)"+ ) get set (reqArg' "OPTS" (\args -> [(prog, splitArgs args)]) (const []))
src/Distribution/Simple/Setup/Config.hs view
@@ -438,13 +438,6 @@ [ (Flag GHC, ("g", ["ghc"]), "compile with GHC") , (Flag GHCJS, ([], ["ghcjs"]), "compile with GHCJS") , (Flag UHC, ([], ["uhc"]), "compile with UHC")- , -- "haskell-suite" compiler id string will be replaced- -- by a more specific one during the configure stage-- ( Flag (HaskellSuite "haskell-suite")- , ([], ["haskell-suite"])- , "compile with a haskell-suite compiler"- ) ] ) , option@@ -1101,7 +1094,7 @@ (Flag hc, NoFlag) -> [hc_flag_name ++ prettyShow hc] (NoFlag, NoFlag) -> [] hc_flag_name- -- TODO kill off thic bc hack when defaultUserHooks is removed.+ -- TODO kill off this bc hack when defaultUserHooks is removed. | bcHack = "--with-hc=" | otherwise = "--with-compiler=" optFlag name config_field = case config_field flags of
src/Distribution/Simple/Setup/Copy.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-}
src/Distribution/Simple/Setup/Haddock.hs view
@@ -107,7 +107,6 @@ , haddockHscolourCss :: Flag FilePath , haddockContents :: Flag PathTemplate , haddockIndex :: Flag PathTemplate- , haddockKeepTempFiles :: Flag Bool , haddockBaseUrl :: Flag String , haddockResourcesDir :: Flag String , haddockOutputDir :: Flag FilePath@@ -162,7 +161,6 @@ , haddockQuickJump = Flag False , haddockHscolourCss = NoFlag , haddockContents = NoFlag- , haddockKeepTempFiles = Flag False , haddockIndex = NoFlag , haddockBaseUrl = NoFlag , haddockResourcesDir = NoFlag@@ -216,13 +214,6 @@ showOrParseArgs [ option ""- ["keep-temp-files"]- "Keep temporary files"- haddockKeepTempFiles- (\b flags -> flags{haddockKeepTempFiles = b})- trueArg- , option- "" ["hoogle"] "Generate a hoogle database" haddockHoogle@@ -409,7 +400,8 @@ deriving (Eq, Show) data HaddockProjectFlags = HaddockProjectFlags- { haddockProjectHackage :: Flag Bool+ { haddockProjectCommonFlags :: !CommonSetupFlags+ , haddockProjectHackage :: Flag Bool -- ^ a shortcut option which builds documentation linked to hackage. It implies: -- * `--html-location='https://hackage.haskell.org/package/$prg-$version/docs' -- * `--quickjump`@@ -442,9 +434,7 @@ , -- haddockContent is not supported, a fixed value is provided -- haddockIndex is not supported, a fixed value is provided -- haddockDistPerf is not supported, note: it changes location of the haddocks- haddockProjectKeepTempFiles :: Flag Bool- , haddockProjectVerbosity :: Flag Verbosity- , -- haddockBaseUrl is not supported, a fixed value is provided+ -- haddockBaseUrl is not supported, a fixed value is provided haddockProjectResourcesDir :: Flag String , haddockProjectUseUnicode :: Flag Bool }@@ -453,7 +443,8 @@ defaultHaddockProjectFlags :: HaddockProjectFlags defaultHaddockProjectFlags = HaddockProjectFlags- { haddockProjectHackage = Flag False+ { haddockProjectCommonFlags = defaultCommonSetupFlags+ , haddockProjectHackage = Flag False , haddockProjectDir = Flag "./haddocks" , haddockProjectPrologue = NoFlag , haddockProjectTestSuites = Flag False@@ -467,8 +458,6 @@ , haddockProjectInternal = Flag False , haddockProjectCss = NoFlag , haddockProjectHscolourCss = NoFlag- , haddockProjectKeepTempFiles = Flag False- , haddockProjectVerbosity = Flag normal , haddockProjectResourcesDir = NoFlag , haddockProjectInterfaces = NoFlag , haddockProjectUseUnicode = NoFlag@@ -513,140 +502,134 @@ emptyProgramDb haddockProjectOptions :: ShowOrParseArgs -> [OptionField HaddockProjectFlags]-haddockProjectOptions _showOrParseArgs =- [ option- ""- ["hackage"]- ( concat- [ "A short-cut option to build documentation linked to hackage."- ]- )- haddockProjectHackage- (\v flags -> flags{haddockProjectHackage = v})- trueArg- , option- ""- ["output"]- "Output directory"- haddockProjectDir- (\v flags -> flags{haddockProjectDir = v})- (optArg' "DIRECTORY" maybeToFlag (fmap Just . flagToList))- , option- ""- ["prologue"]- "File path to a prologue file in haddock format"- haddockProjectPrologue- (\v flags -> flags{haddockProjectPrologue = v})- (optArg' "PATH" maybeToFlag (fmap Just . flagToList))- , option- ""- ["hoogle"]- "Generate a hoogle database"- haddockProjectHoogle- (\v flags -> flags{haddockProjectHoogle = v})- trueArg- , option- ""- ["html-location"]- "Location of HTML documentation for pre-requisite packages"- haddockProjectHtmlLocation- (\v flags -> flags{haddockProjectHtmlLocation = v})- (reqArgFlag "URL")- , option- ""- ["executables"]- "Run haddock for Executables targets"- haddockProjectExecutables- (\v flags -> flags{haddockProjectExecutables = v})- trueArg- , option- ""- ["tests"]- "Run haddock for Test Suite targets"- haddockProjectTestSuites- (\v flags -> flags{haddockProjectTestSuites = v})- trueArg- , option- ""- ["benchmarks"]- "Run haddock for Benchmark targets"- haddockProjectBenchmarks- (\v flags -> flags{haddockProjectBenchmarks = v})- trueArg- , option- ""- ["foreign-libraries"]- "Run haddock for Foreign Library targets"- haddockProjectForeignLibs- (\v flags -> flags{haddockProjectForeignLibs = v})- trueArg- , option- ""- ["all", "haddock-all"]- "Run haddock for all targets"- ( \f ->- allFlags- [ haddockProjectExecutables f- , haddockProjectTestSuites f- , haddockProjectBenchmarks f- , haddockProjectForeignLibs f+haddockProjectOptions showOrParseArgs =+ withCommonSetupOptions+ haddockProjectCommonFlags+ (\c f -> f{haddockProjectCommonFlags = c})+ showOrParseArgs+ [ option+ ""+ ["hackage"]+ ( concat+ [ "A short-cut option to build documentation linked to hackage." ]- )- ( \v flags ->- flags- { haddockProjectExecutables = v- , haddockProjectTestSuites = v- , haddockProjectBenchmarks = v- , haddockProjectForeignLibs = v- }- )- trueArg- , option- ""- ["internal"]- "Run haddock for internal modules and include all symbols"- haddockProjectInternal- (\v flags -> flags{haddockProjectInternal = v})- trueArg- , option- ""- ["css"]- "Use PATH as the haddock stylesheet"- haddockProjectCss- (\v flags -> flags{haddockProjectCss = v})- (reqArgFlag "PATH")- , option- ""- ["hscolour-css"]- "Use PATH as the HsColour stylesheet"- haddockProjectHscolourCss- (\v flags -> flags{haddockProjectHscolourCss = v})- (reqArgFlag "PATH")- , option- ""- ["keep-temp-files"]- "Keep temporary files"- haddockProjectKeepTempFiles- (\b flags -> flags{haddockProjectKeepTempFiles = b})- trueArg- , optionVerbosity- haddockProjectVerbosity- (\v flags -> flags{haddockProjectVerbosity = v})- , option- ""- ["resources-dir"]- "location of Haddocks static / auxiliary files"- haddockProjectResourcesDir- (\v flags -> flags{haddockProjectResourcesDir = v})- (reqArgFlag "DIR")- , option- ""- ["use-unicode"]- "Pass --use-unicode option to haddock"- haddockProjectUseUnicode- (\v flags -> flags{haddockProjectUseUnicode = v})- trueArg- ]+ )+ haddockProjectHackage+ (\v flags -> flags{haddockProjectHackage = v})+ trueArg+ , option+ ""+ ["output"]+ "Output directory"+ haddockProjectDir+ (\v flags -> flags{haddockProjectDir = v})+ (optArg' "DIRECTORY" maybeToFlag (fmap Just . flagToList))+ , option+ ""+ ["prologue"]+ "File path to a prologue file in haddock format"+ haddockProjectPrologue+ (\v flags -> flags{haddockProjectPrologue = v})+ (optArg' "PATH" maybeToFlag (fmap Just . flagToList))+ , option+ ""+ ["hoogle"]+ "Generate a hoogle database"+ haddockProjectHoogle+ (\v flags -> flags{haddockProjectHoogle = v})+ trueArg+ , option+ ""+ ["html-location"]+ "Location of HTML documentation for pre-requisite packages"+ haddockProjectHtmlLocation+ (\v flags -> flags{haddockProjectHtmlLocation = v})+ (reqArgFlag "URL")+ , option+ ""+ ["executables"]+ "Run haddock for Executables targets"+ haddockProjectExecutables+ (\v flags -> flags{haddockProjectExecutables = v})+ trueArg+ , option+ ""+ ["tests"]+ "Run haddock for Test Suite targets"+ haddockProjectTestSuites+ (\v flags -> flags{haddockProjectTestSuites = v})+ trueArg+ , option+ ""+ ["benchmarks"]+ "Run haddock for Benchmark targets"+ haddockProjectBenchmarks+ (\v flags -> flags{haddockProjectBenchmarks = v})+ trueArg+ , option+ ""+ ["foreign-libraries"]+ "Run haddock for Foreign Library targets"+ haddockProjectForeignLibs+ (\v flags -> flags{haddockProjectForeignLibs = v})+ trueArg+ , option+ ""+ ["all", "haddock-all"]+ "Run haddock for all targets"+ ( \f ->+ allFlags+ [ haddockProjectExecutables f+ , haddockProjectTestSuites f+ , haddockProjectBenchmarks f+ , haddockProjectForeignLibs f+ ]+ )+ ( \v flags ->+ flags+ { haddockProjectExecutables = v+ , haddockProjectTestSuites = v+ , haddockProjectBenchmarks = v+ , haddockProjectForeignLibs = v+ }+ )+ trueArg+ , option+ ""+ ["internal"]+ "Run haddock for internal modules and include all symbols"+ haddockProjectInternal+ (\v flags -> flags{haddockProjectInternal = v})+ trueArg+ , option+ ""+ ["css"]+ "Use PATH as the haddock stylesheet"+ haddockProjectCss+ (\v flags -> flags{haddockProjectCss = v})+ (reqArgFlag "PATH")+ , option+ ""+ ["hscolour-css"]+ "Use PATH as the HsColour stylesheet"+ haddockProjectHscolourCss+ (\v flags -> flags{haddockProjectHscolourCss = v})+ (reqArgFlag "PATH")+ , option+ ""+ ["resources-dir"]+ "location of Haddocks static / auxiliary files"+ haddockProjectResourcesDir+ (\v flags -> flags{haddockProjectResourcesDir = v})+ (reqArgFlag "DIR")+ , option+ ""+ ["use-unicode"]+ "Pass --use-unicode option to haddock"+ haddockProjectUseUnicode+ (\v flags -> flags{haddockProjectUseUnicode = v})+ trueArg+ ] emptyHaddockProjectFlags :: HaddockProjectFlags emptyHaddockProjectFlags = mempty
src/Distribution/Simple/Setup/Install.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE PatternSynonyms #-}
src/Distribution/Simple/Setup/Repl.hs view
@@ -54,6 +54,7 @@ { replOptionsFlags :: [String] , replOptionsNoLoad :: Flag Bool , replOptionsFlagOutput :: Flag FilePath+ , replWithRepl :: Flag FilePath } deriving (Show, Generic) @@ -85,7 +86,7 @@ instance Structured ReplOptions instance Monoid ReplOptions where- mempty = ReplOptions mempty (Flag False) NoFlag+ mempty = ReplOptions mempty (Flag False) NoFlag NoFlag mappend = (<>) instance Semigroup ReplOptions where@@ -229,4 +230,11 @@ replOptionsFlagOutput (\p flags -> flags{replOptionsFlagOutput = p}) (reqArg "DIR" (succeedReadE Flag) flagToList)+ , option+ []+ ["with-repl"]+ "Give the path to a program to use for REPL"+ replWithRepl+ (\v flags -> flags{replWithRepl = v})+ (reqArgFlag "PATH") ]
src/Distribution/Simple/Setup/Test.hs view
@@ -245,7 +245,8 @@ [] ["test-options"] ( "give extra options to test executables "- ++ "(name templates can use $pkgid, $compiler, "+ ++ "(split on spaces, use \"\" to prevent splitting; "+ ++ "name templates can use $pkgid, $compiler, " ++ "$os, $arch, $test-suite)" ) testOptions@@ -259,7 +260,7 @@ [] ["test-option"] ( "give extra option to test executables "- ++ "(no need to quote options containing spaces, "+ ++ "(passed directly as a single argument; " ++ "name template can use $pkgid, $compiler, " ++ "$os, $arch, $test-suite)" )
src/Distribution/Simple/SetupHooks/Internal.hs view
@@ -7,7 +7,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -- |
src/Distribution/Simple/SetupHooks/Rule.hs view
@@ -9,10 +9,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE QuantifiedConstraints #-}@@ -612,9 +610,9 @@ -> StaticPtr (arg -> res) -> arg -> Command arg res-mkCommand dict actionPtr arg =+mkCommand dict action arg = Command- { actionPtr = UserStatic actionPtr+ { actionPtr = UserStatic action , actionArg = ScopedArgument arg , cmdInstances = UserStatic dict }@@ -723,7 +721,7 @@ how much to read in order to reconstruct the associated opaque 'ByteString'. To ensure we always serialise/deserialise including the length of the data, the 'ScopedArgument' newtype is used, with a custom 'Binary' instance that always-incldues the length. We use this newtype:+includes the length. We use this newtype: - in the definition of 'CommandData', for arguments to rules, - in the definition of 'DepsRes', for the result of dynamic dependency computations.@@ -824,9 +822,9 @@ } | Dict <- deRefStaticPtr instsPtr -> Just $ do- (deps, depsRes) <- runCommand depsCmd+ (deps, dynDeps) <- runCommand depsCmd -- See Note [Hooks Binary instances]- return $ (deps, Binary.encode $ ScopedArgument @User depsRes)+ return $ (deps, Binary.encode $ ScopedArgument @User dynDeps) -- | Project out the command for running the rule, passing in the result of -- the dependency computation if there was one.
src/Distribution/Simple/ShowBuildInfo.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} -- | -- This module defines a simple JSON-based format for exporting basic
src/Distribution/Simple/Test.hs view
@@ -27,7 +27,7 @@ import qualified Distribution.PackageDescription as PD import Distribution.Pretty-import Distribution.Simple.Build (addInternalBuildToolsFixed)+import Distribution.Simple.Build (addInternalBuildTools) import Distribution.Simple.Compiler import Distribution.Simple.Hpc import Distribution.Simple.InstallDirs@@ -96,8 +96,8 @@ lbi { withPrograms = -- Include any build-tool-depends on build tools internal to the current package.- addInternalBuildToolsFixed- (Just curDir)+ addInternalBuildTools+ curDir pkg_descr lbi (PD.testBuildInfo suite)
src/Distribution/Simple/UHC.hs view
@@ -59,10 +59,9 @@ configure :: Verbosity -> Maybe FilePath- -> Maybe FilePath -> ProgramDb -> IO (Compiler, Maybe Platform, ProgramDb)-configure verbosity hcPath _hcPkgPath progdb = do+configure verbosity hcPath progdb = do (_uhcProg, uhcVersion, progdb') <- requireProgramVersion verbosity
src/Distribution/Simple/Utils.hs view
@@ -1,7 +1,5 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}@@ -9,6 +7,9 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+#ifdef GIT_REV+{-# LANGUAGE TemplateHaskell #-}+#endif ----------------------------------------------------------------------------- @@ -28,6 +29,7 @@ -- various directory and file functions that do extra logging. module Distribution.Simple.Utils ( cabalVersion+ , cabalGitInfo -- * logging and errors , dieNoVerbosity@@ -183,6 +185,7 @@ , listUnion , listUnionRight , ordNub+ , sortNub , ordNubBy , ordNubRight , safeHead@@ -192,6 +195,7 @@ , unintersperse , wrapText , wrapLine+ , stripCommonPrefix -- * FilePath stuff , isAbsoluteOnAnyPlatform@@ -250,6 +254,7 @@ , getDirectoryContents , getModificationTime , getPermissions+ , getTemporaryDirectory , removeDirectoryRecursive , removeFile )@@ -286,6 +291,16 @@ import qualified System.Process as Process import qualified Text.PrettyPrint as Disp +#ifdef GIT_REV+import Data.Either (isLeft)+import GitHash+ ( giHash+ , giBranch+ , giCommitDate+ , tGitInfoCwdTry+ )+#endif+ -- We only get our own version number when we're building with ourselves cabalVersion :: Version #if defined(BOOTSTRAPPED_CABAL)@@ -296,6 +311,30 @@ cabalVersion = mkVersion [3,0] --used when bootstrapping #endif +-- |+-- `Cabal` Git information. Only filled in if built in a Git tree in+-- development mode and Template Haskell is available.+cabalGitInfo :: String+#ifdef GIT_REV+cabalGitInfo = if giHash' == ""+ then ""+ else concat [ "(commit "+ , giHash'+ , branchInfo+ , ", "+ , either (const "") giCommitDate gi'+ , ")"+ ]+ where+ gi' = $$tGitInfoCwdTry+ giHash' = take 7 . either (const "") giHash $ gi'+ branchInfo | isLeft gi' = ""+ | either id giBranch gi' == "master" = ""+ | otherwise = " on " <> either id giBranch gi'+#else+cabalGitInfo = ""+#endif+ -- ---------------------------------------------------------------------------- -- Exception and logging utils @@ -387,7 +426,7 @@ =<< pure . addErrorPrefix =<< prefixWithProgName msg --- Type which will be a wrapper for cabal -expections and cabal-install exceptions+-- Type which will be a wrapper for cabal -exceptions and cabal-install exceptions data VerboseException a = VerboseException CallStack POSIXTime Verbosity a deriving (Show) @@ -533,7 +572,7 @@ warn :: Verbosity -> String -> IO () warn verbosity msg = warnMessage "Warning" verbosity msg --- | Like 'warn', but prepend @Error: …@ instead of @Waring: …@ before the+-- | Like 'warn', but prepend @Error: …@ instead of @Warning: …@ before the -- the message. Useful when you want to highlight the condition is an error -- but do not want to quit the program yet. warnError :: Verbosity -> String -> IO ()@@ -1733,23 +1772,17 @@ -- | Use a temporary filename that doesn't already exist withTempFile- :: FilePath- -- ^ Temp dir to create the file in- -> String+ :: String -- ^ File name template. See 'openTempFile'. -> (FilePath -> Handle -> IO a) -> IO a-withTempFile tmpDir template f = withFrozenCallStack $- withTempFileCwd Nothing (makeSymbolicPath tmpDir) template $+withTempFile template f = withFrozenCallStack $+ withTempFileCwd template $ \fp h -> f (getSymbolicPath fp) h -- | Use a temporary filename that doesn't already exist. withTempFileCwd- :: Maybe (SymbolicPath CWD (Dir Pkg))- -- ^ Working directory- -> SymbolicPath Pkg (Dir tmpDir)- -- ^ Temp dir to create the file in- -> String+ :: String -- ^ File name template. See 'openTempFile'. -> (SymbolicPath Pkg File -> Handle -> IO a) -> IO a@@ -1758,20 +1791,17 @@ -- | A version of 'withTempFile' that additionally takes a 'TempFileOptions' -- argument. withTempFileEx- :: forall a tmpDir+ :: forall a . TempFileOptions- -> Maybe (SymbolicPath CWD (Dir Pkg))- -- ^ Working directory- -> SymbolicPath Pkg (Dir tmpDir)- -- ^ Temp dir to create the file in -> String -- ^ File name template. See 'openTempFile'. -> (SymbolicPath Pkg File -> Handle -> IO a) -> IO a-withTempFileEx opts mbWorkDir tmpDir template action =+withTempFileEx opts template action = do+ tmp <- getTemporaryDirectory withFrozenCallStack $ Exception.bracket- (openTempFile (i tmpDir) template)+ (openTempFile tmp template) ( \(name, handle) -> do hClose handle unless (optKeepTempFiles opts) $@@ -1779,12 +1809,11 @@ removeFile $ name )- (withLexicalCallStack (\(fn, h) -> action (mkRelToPkg fn) h))+ (withLexicalCallStack (\(fn, h) -> action (mkRelToPkg tmp fn) h)) where- i = interpretSymbolicPath mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path- mkRelToPkg :: FilePath -> SymbolicPath Pkg File- mkRelToPkg fp =- tmpDir </> makeRelativePathEx (takeFileName fp)+ mkRelToPkg :: FilePath -> FilePath -> SymbolicPath Pkg File+ mkRelToPkg tmp fp =+ makeSymbolicPath tmp </> makeRelativePathEx (takeFileName fp) -- 'openTempFile' returns a path of the form @i tmpDir </> fn@, but we -- want 'withTempFileEx' to return @tmpDir </> fn@. So we split off@@ -2034,3 +2063,10 @@ buildInfoExt :: String buildInfoExt = ".buildinfo"++-- | @stripCommonPrefix xs ys@ gives you @ys@ without the common prefix with @xs@.+stripCommonPrefix :: String -> String -> String+stripCommonPrefix (x : xs) (y : ys)+ | x == y = stripCommonPrefix xs ys+ | otherwise = y : ys+stripCommonPrefix _ ys = ys
src/Distribution/Types/ComponentLocalBuildInfo.hs view
@@ -5,6 +5,8 @@ ( ComponentLocalBuildInfo (..) , componentIsIndefinite , maybeComponentInstantiatedWith+ , maybeComponentCompatPackageKey+ , maybeComponentExposedModules ) where import Distribution.Compat.Prelude@@ -125,3 +127,13 @@ maybeComponentInstantiatedWith LibComponentLocalBuildInfo{componentInstantiatedWith = insts} = Just insts maybeComponentInstantiatedWith _ = Nothing++maybeComponentCompatPackageKey :: ComponentLocalBuildInfo -> Maybe String+maybeComponentCompatPackageKey+ LibComponentLocalBuildInfo{componentCompatPackageKey = key} = Just key+maybeComponentCompatPackageKey _ = Nothing++maybeComponentExposedModules :: ComponentLocalBuildInfo -> Maybe [Installed.ExposedModule]+maybeComponentExposedModules+ LibComponentLocalBuildInfo{componentExposedModules = exposed} = Just exposed+maybeComponentExposedModules _ = Nothing
src/Distribution/Types/LocalBuildConfig.hs view
@@ -2,8 +2,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}
src/Distribution/Types/LocalBuildInfo.hs view
@@ -446,7 +446,7 @@ let -- enable-library-profiling (enable (static profiling way)) .p_o -- enable-shared (enabled dynamic way) .dyn_o- -- enable-profiling-shared (enable dyanmic profilng way) .p_dyn_o+ -- enable-profiling-shared (enable dynamic profilng way) .p_dyn_o -- enable-library-vanilla (enable vanilla way) .o -- -- enable-executable-dynamic => build dynamic executables
src/Distribution/Utils/IOData.hs view
@@ -80,7 +80,7 @@ -- | 'IOData' Wrapper for 'System.IO.hPutStr' and 'System.IO.hClose' ----- This is the dual operation ot 'hGetIODataContents',+-- This is the dual operation to 'hGetIODataContents', -- and consequently the handle is closed with `hClose`. -- -- /Note:/ this performs lazy-IO.
src/Distribution/Utils/LogProgress.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Rank2Types #-} module Distribution.Utils.LogProgress