Commits (308)
......@@ -15,10 +15,11 @@ dist-*
/Cabal/dist/
/Cabal/tests/Setup
/Cabal/Setup
/Cabal/misc/source-file-list
/Cabal/source-file-list
/cabal-install/dist/
/cabal-install/Setup
/cabal-install/source-file-list
# editor temp files
......
......@@ -8,6 +8,7 @@ env:
- GHCVER=7.6.3
- GHCVER=7.8.4
- GHCVER=7.10.3
- GHCVER=8.0.1
# TODO add PARSEC_BUNDLED=YES when it's so
- GHCVER=head
......@@ -15,8 +16,9 @@ env:
before_install:
- travis_retry sudo add-apt-repository -y ppa:hvr/ghc
- travis_retry sudo apt-get update
- travis_retry sudo apt-get install cabal-install-1.22 ghc-$GHCVER-prof ghc-$GHCVER-dyn happy
- export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/1.22/bin:$PATH
- travis_retry sudo apt-get install cabal-install-1.24 ghc-$GHCVER-prof ghc-$GHCVER-dyn happy
- export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/1.24/bin:$PATH
- git version
install:
- cabal update
......@@ -34,7 +36,7 @@ script:
# Cabal
- cd Cabal
# Test if gen-extra-source-files.sh was run recently enough
- ./misc/gen-extra-source-files.sh
- ./misc/gen-extra-source-files.sh Cabal.cabal
- ./misc/travis-diff-files.sh
- mkdir -p ./dist/setup
- cp Setup.hs ./dist/setup/setup.hs
......@@ -45,7 +47,7 @@ script:
- ./dist/setup/setup configure --user --ghc-option=-Werror --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
- ./dist/setup/setup build # this builds all libraries and executables (including tests/benchmarks)
- ./dist/setup/setup haddock # see https://github.com/haskell/cabal/issues/2198
- ./dist/setup/setup test --show-details=streaming
- ./dist/setup/setup test --show-details=streaming --test-option=--hide-successes
- cabal check
- cabal sdist # tests that a source-distribution can be generated
......@@ -54,7 +56,7 @@ script:
- function install_from_tarball {
export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
if [ -f "dist/$SRC_TGZ" ]; then
cabal install "dist/$SRC_TGZ" -v2;
cabal install -j1 "dist/$SRC_TGZ" -v2;
else
echo "expected 'dist/$SRC_TGZ' not found";
exit 1;
......@@ -65,6 +67,8 @@ script:
# Also build cabal-install.
- cd ../cabal-install
- ../Cabal/misc/gen-extra-source-files.sh cabal-install.cabal
- ../Cabal/misc/travis-diff-files.sh
- mkdir -p ./dist/setup
- cp Setup.hs ./dist/setup/setup.hs
- ghc --make -odir ./dist/setup -hidir ./dist/setup -i -i. ./dist/setup/setup.hs -o ./dist/setup/setup -Wall -Werror -threaded # the command cabal-install would use to build setup
......@@ -73,7 +77,7 @@ script:
- ./dist/setup/setup configure --user --ghc-option=-Werror --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
- ./dist/setup/setup build
- ./dist/setup/setup haddock # see https://github.com/haskell/cabal/issues/2198
- ./dist/setup/setup test --show-details=streaming
- ./dist/setup/setup test --show-details=streaming --test-option=--hide-successes
- cabal check
- cabal sdist
- install_from_tarball
......
name: Cabal
version: 1.23.1.0
version: 1.25.0.0
copyright: 2003-2006, Isaac Jones
2005-2011, Duncan Coutts
license: BSD3
......@@ -32,6 +32,10 @@ extra-source-files:
-- Generated with 'misc/gen-extra-source-files.sh'
-- Do NOT edit this section manually; instead, run the script.
-- BEGIN gen-extra-source-files
tests/PackageTests/AllowNewer/AllowNewer.cabal
tests/PackageTests/AllowNewer/benchmarks/Bench.hs
tests/PackageTests/AllowNewer/src/Foo.hs
tests/PackageTests/AllowNewer/tests/Test.hs
tests/PackageTests/BenchmarkExeV10/Foo.hs
tests/PackageTests/BenchmarkExeV10/benchmarks/bench-Foo.hs
tests/PackageTests/BenchmarkExeV10/my.cabal
......@@ -89,6 +93,24 @@ extra-source-files:
tests/PackageTests/DuplicateModuleName/tests/Foo.hs
tests/PackageTests/DuplicateModuleName/tests2/Foo.hs
tests/PackageTests/EmptyLib/empty/empty.cabal
tests/PackageTests/GhcPkgGuess/SameDirectory/SameDirectory.cabal
tests/PackageTests/GhcPkgGuess/SameDirectory/ghc
tests/PackageTests/GhcPkgGuess/SameDirectory/ghc-pkg
tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/SameDirectory.cabal
tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/ghc-7.10
tests/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/ghc-pkg-ghc-7.10
tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/SameDirectory.cabal
tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/ghc-7.10
tests/PackageTests/GhcPkgGuess/SameDirectoryVersion/ghc-pkg-7.10
tests/PackageTests/GhcPkgGuess/Symlink/SameDirectory.cabal
tests/PackageTests/GhcPkgGuess/Symlink/bin/ghc
tests/PackageTests/GhcPkgGuess/Symlink/bin/ghc-pkg
tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/SameDirectory.cabal
tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/bin/ghc-7.10
tests/PackageTests/GhcPkgGuess/SymlinkGhcVersion/bin/ghc-pkg-7.10
tests/PackageTests/GhcPkgGuess/SymlinkVersion/SameDirectory.cabal
tests/PackageTests/GhcPkgGuess/SymlinkVersion/bin/ghc-7.10
tests/PackageTests/GhcPkgGuess/SymlinkVersion/bin/ghc-pkg-ghc-7.10
tests/PackageTests/Haddock/CPP.hs
tests/PackageTests/Haddock/Literate.lhs
tests/PackageTests/Haddock/NoCPP.hs
......@@ -97,6 +119,7 @@ extra-source-files:
tests/PackageTests/HaddockNewline/A.hs
tests/PackageTests/HaddockNewline/HaddockNewline.cabal
tests/PackageTests/HaddockNewline/Setup.hs
tests/PackageTests/Options.hs
tests/PackageTests/OrderFlags/Foo.hs
tests/PackageTests/OrderFlags/my.cabal
tests/PackageTests/PathsModule/Executable/Main.hs
......@@ -143,9 +166,6 @@ extra-source-files:
tests/PackageTests/UniqueIPID/P2/my.cabal
tests/PackageTests/multInst/my.cabal
tests/Setup.hs
tests/Test/Distribution/Version.hs
tests/Test/Laws.hs
tests/Test/QuickCheck/Utils.hs
tests/hackage/check.sh
tests/hackage/download.sh
tests/hackage/unpack.sh
......@@ -191,6 +211,9 @@ library
Win32 >= 2.2 && < 2.4
ghc-options: -Wall -fno-ignore-asserts -fwarn-tabs
if impl(ghc >= 8.0)
ghc-options: -Wcompat -Wnoncanonical-monad-instances
-Wnoncanonical-monadfail-instances
exposed-modules:
Distribution.Compat.CreatePipe
......@@ -198,6 +221,7 @@ library
Distribution.Compat.Exception
Distribution.Compat.Internal.TempFile
Distribution.Compat.ReadP
Distribution.Compat.Semigroup
Distribution.Compiler
Distribution.InstalledPackageInfo
Distribution.License
......@@ -267,11 +291,11 @@ library
Distribution.Verbosity
Distribution.Version
Language.Haskell.Extension
Distribution.Compat.Binary
other-modules:
Distribution.Compat.Binary
Distribution.Compat.CopyFile
Distribution.Compat.Semigroup
Distribution.Compat.MonadFail
Distribution.GetOpt
Distribution.Lex
Distribution.Simple.GHC.Internal
......@@ -295,19 +319,24 @@ test-suite unit-tests
type: exitcode-stdio-1.0
hs-source-dirs: tests
other-modules:
Test.Laws
Test.QuickCheck.Utils
UnitTests.Distribution.Compat.CreatePipe
UnitTests.Distribution.Compat.ReadP
UnitTests.Distribution.Simple.Program.Internal
UnitTests.Distribution.Utils.NubList
UnitTests.Distribution.Simple.Utils
UnitTests.Distribution.System
UnitTests.Distribution.Utils.NubList
UnitTests.Distribution.Version
main-is: UnitTests.hs
build-depends:
base,
directory,
tasty,
tasty-hunit,
tasty-quickcheck,
pretty,
QuickCheck < 2.9,
QuickCheck >= 2.7 && < 2.9,
Cabal
ghc-options: -Wall
default-language: Haskell98
......@@ -322,17 +351,13 @@ test-suite package-tests
PackageTests.DeterministicAr.Check
PackageTests.TestSuiteTests.ExeV10.Check
PackageTests.PackageTester
Test.Distribution.Version
Test.Laws
Test.QuickCheck.Utils
hs-source-dirs: tests
build-depends:
base,
containers,
tagged,
tasty,
tasty-quickcheck,
tasty-hunit,
QuickCheck >= 2.1.0.1 && < 2.9,
transformers,
Cabal,
process,
......
{-# LANGUAGE CPP #-}
-- | Compatibility layer for "Control.Monad.Fail"
module Distribution.Compat.MonadFail ( MonadFail(fail) ) where
#if __GLASGOW_HASKELL__ >= 800
-- provided by base-4.9.0.0 and later
import Control.Monad.Fail (MonadFail(fail))
#else
-- the following code corresponds to
-- http://hackage.haskell.org/package/fail-4.9.0.0
import qualified Prelude as P
import Prelude hiding (fail)
import Text.ParserCombinators.ReadP
import Text.ParserCombinators.ReadPrec
class Monad m => MonadFail m where
fail :: String -> m a
-- instances provided by base-4.9
instance MonadFail Maybe where
fail _ = Nothing
instance MonadFail [] where
fail _ = []
instance MonadFail IO where
fail = P.fail
instance MonadFail ReadPrec where
fail = P.fail -- = P (\_ -> fail s)
instance MonadFail ReadP where
fail = P.fail
#endif
......@@ -69,6 +69,8 @@ module Distribution.Compat.ReadP
)
where
import qualified Distribution.Compat.MonadFail as Fail
import Control.Monad( MonadPlus(..), liftM, liftM2, replicateM, ap, (>=>) )
import Data.Char (isSpace)
import Control.Applicative as AP (Applicative(..), Alternative(empty, (<|>)))
......@@ -104,6 +106,9 @@ instance Monad (P s) where
(Result x p) >>= k = k x `mplus` (p >>= k)
(Final r) >>= k = final [ys' | (x,s) <- r, ys' <- run (k x) s]
fail = Fail.fail
instance Fail.MonadFail (P s) where
fail _ = Fail
instance Alternative (P s) where
......@@ -156,9 +161,12 @@ instance Applicative (Parser r s) where
instance Monad (Parser r s) where
return = AP.pure
fail _ = R (const Fail)
fail = Fail.fail
R m >>= f = R (\k -> m (\a -> let R m' = f a in m' k))
instance Fail.MonadFail (Parser r s) where
fail _ = R (const Fail)
--instance MonadPlus (Parser r s) where
-- mzero = pfail
-- mplus = (+++)
......
{-# LANGUAGE CPP #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeOperators #-}
-- | Compatibility layer for "Data.Semigroup"
module Distribution.Compat.Semigroup
......@@ -6,8 +10,17 @@ module Distribution.Compat.Semigroup
, Mon.Monoid(..)
, All(..)
, Any(..)
, Last'(..)
, gmappend
, gmempty
) where
import Distribution.Compat.Binary (Binary)
import Control.Applicative as App
import GHC.Generics
#if __GLASGOW_HASKELL__ >= 711
-- Data.Semigroup is available since GHC 8.0/base-4.9
import Data.Semigroup
......@@ -15,6 +28,12 @@ import qualified Data.Monoid as Mon
#else
-- provide internal simplified non-exposed class for older GHCs
import Data.Monoid as Mon (Monoid(..), All(..), Any(..), Dual(..))
-- containers
import Data.Set (Set)
import Data.IntSet (IntSet)
import Data.Map (Map)
import Data.IntMap (IntMap)
class Semigroup a where
(<>) :: a -> a -> a
......@@ -67,4 +86,86 @@ instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e)
=> Semigroup (a, b, c, d, e) where
(a,b,c,d,e) <> (a',b',c',d',e') = (a<>a',b<>b',c<>c',d<>d',e<>e')
-- containers instances
instance Semigroup IntSet where
(<>) = mappend
instance Ord a => Semigroup (Set a) where
(<>) = mappend
instance Semigroup (IntMap v) where
(<>) = mappend
instance Ord k => Semigroup (Map k v) where
(<>) = mappend
#endif
-- | Cabal's own 'Data.Monoid.Last' copy to avoid requiring an orphan
-- 'Binary' instance.
--
-- Once the oldest `binary` version we support provides a 'Binary'
-- instance for 'Data.Monoid.Last' we can remove this one here.
--
-- NB: 'Data.Semigroup.Last' is defined differently and not a 'Monoid'
newtype Last' a = Last' { getLast' :: Maybe a }
deriving (Eq, Ord, Read, Show, Binary,
Functor, App.Applicative, Generic)
instance Semigroup (Last' a) where
x <> Last' Nothing = x
_ <> x = x
instance Monoid (Last' a) where
mempty = Last' Nothing
mappend = (<>)
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-- Stolen from Edward Kmett's BSD3-licensed `semigroups` package
-- | Generically generate a 'Semigroup' ('<>') operation for any type
-- implementing 'Generic'. This operation will append two values
-- by point-wise appending their component fields. It is only defined
-- for product types.
--
-- @
-- 'gmappend' a ('gmappend' b c) = 'gmappend' ('gmappend' a b) c
-- @
gmappend :: (Generic a, GSemigroup (Rep a)) => a -> a -> a
gmappend x y = to (gmappend' (from x) (from y))
class GSemigroup f where
gmappend' :: f p -> f p -> f p
instance Semigroup a => GSemigroup (K1 i a) where
gmappend' (K1 x) (K1 y) = K1 (x <> y)
instance GSemigroup f => GSemigroup (M1 i c f) where
gmappend' (M1 x) (M1 y) = M1 (gmappend' x y)
instance (GSemigroup f, GSemigroup g) => GSemigroup (f :*: g) where
gmappend' (x1 :*: x2) (y1 :*: y2) = gmappend' x1 y1 :*: gmappend' x2 y2
-- | Generically generate a 'Monoid' 'mempty' for any product-like type
-- implementing 'Generic'.
--
-- It is only defined for product types.
--
-- @
-- 'gmappend' 'gmempty' a = a = 'gmappend' a 'gmempty'
-- @
gmempty :: (Generic a, GMonoid (Rep a)) => a
gmempty = to gmempty'
class GSemigroup f => GMonoid f where
gmempty' :: f p
instance (Semigroup a, Monoid a) => GMonoid (K1 i a) where
gmempty' = K1 mempty
instance GMonoid f => GMonoid (M1 i c f) where
gmempty' = M1 gmempty'
instance (GMonoid f, GMonoid g) => GMonoid (f :*: g) where
gmempty' = gmempty' :*: gmempty'
......@@ -29,6 +29,7 @@
module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
installedComponentId,
installedPackageId,
OriginalModule(..), ExposedModule(..),
ParseResult(..), PError(..), PWarning,
emptyInstalledPackageInfo,
......@@ -41,7 +42,7 @@ module Distribution.InstalledPackageInfo (
import Distribution.ParseUtils
import Distribution.License
import Distribution.Package hiding (installedUnitId)
import Distribution.Package hiding (installedUnitId, installedPackageId)
import qualified Distribution.Package as Package
import Distribution.ModuleName
import Distribution.Version
......@@ -103,6 +104,11 @@ installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId ipi = case installedUnitId ipi of
SimpleUnitId cid -> cid
{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
-- | Backwards compatibility with Cabal pre-1.24.
installedPackageId :: InstalledPackageInfo -> UnitId
installedPackageId = installedUnitId
instance Binary InstalledPackageInfo
instance Package.Package InstalledPackageInfo where
......
......@@ -42,6 +42,7 @@ module Distribution.Package (
-- * Package classes
Package(..), packageName, packageVersion,
HasUnitId(..),
installedPackageId,
PackageInstalled(..),
) where
......@@ -122,6 +123,7 @@ data ComponentId
= ComponentId String
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
{-# DEPRECATED InstalledPackageId "Use UnitId instead" #-}
type InstalledPackageId = UnitId
instance Binary ComponentId
......@@ -214,6 +216,11 @@ instance Package PackageIdentifier where
class Package pkg => HasUnitId pkg where
installedUnitId :: pkg -> UnitId
{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
-- | Compatibility wrapper for Cabal pre-1.24.
installedPackageId :: HasUnitId pkg => pkg -> UnitId
installedPackageId = installedUnitId
-- | Class of installed packages.
--
-- The primary data type which is an instance of this package is
......
......@@ -111,7 +111,7 @@ module Distribution.PackageDescription (
import Distribution.Compat.Binary
import qualified Distribution.Compat.Semigroup as Semi ((<>))
import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup)
import Distribution.Compat.Semigroup as Semi (Monoid(..), Semigroup, gmempty, gmappend)
import qualified Distribution.Compat.ReadP as Parse
import Distribution.Compat.ReadP ((<++))
import Distribution.Package
......@@ -314,15 +314,12 @@ data SetupBuildInfo = SetupBuildInfo {
instance Binary SetupBuildInfo
instance Monoid SetupBuildInfo where
mempty = SetupBuildInfo {
setupDepends = Semi.mempty
}
instance Semi.Monoid SetupBuildInfo where
mempty = gmempty
mappend = (Semi.<>)
instance Semigroup SetupBuildInfo where
a <> b = SetupBuildInfo { setupDepends = combine setupDepends }
where combine field = field a `mappend` field b
(<>) = gmappend
-- ---------------------------------------------------------------------------
-- Module renaming
......@@ -498,11 +495,7 @@ data Executable = Executable {
instance Binary Executable
instance Monoid Executable where
mempty = Executable {
exeName = mempty,
modulePath = mempty,
buildInfo = mempty
}
mempty = gmempty
mappend = (Semi.<>)
instance Semigroup Executable where
......@@ -812,6 +805,7 @@ data BuildInfo = BuildInfo {
ldOptions :: [String], -- ^ options for linker
pkgconfigDepends :: [Dependency], -- ^ pkg-config packages that are used
frameworks :: [String], -- ^support frameworks for Mac OS X
extraFrameworkDirs:: [String], -- ^ extra locations to find frameworks.
cSources :: [FilePath],
jsSources :: [FilePath],
hsSourceDirs :: [FilePath], -- ^ where to look for the Haskell module hierarchy
......@@ -844,66 +838,68 @@ instance Binary BuildInfo
instance Monoid BuildInfo where
mempty = BuildInfo {
buildable = True,
buildTools = [],
cppOptions = [],
ccOptions = [],
ldOptions = [],
pkgconfigDepends = [],
frameworks = [],
cSources = [],
jsSources = [],
hsSourceDirs = [],
otherModules = [],
defaultLanguage = Nothing,
otherLanguages = [],
defaultExtensions = [],
otherExtensions = [],
oldExtensions = [],
extraLibs = [],
extraGHCiLibs = [],
extraLibDirs = [],
includeDirs = [],
includes = [],
installIncludes = [],
options = [],
profOptions = [],
sharedOptions = [],
customFieldsBI = [],
targetBuildDepends = [],
buildable = True,
buildTools = [],
cppOptions = [],
ccOptions = [],
ldOptions = [],
pkgconfigDepends = [],
frameworks = [],
extraFrameworkDirs = [],
cSources = [],
jsSources = [],
hsSourceDirs = [],
otherModules = [],
defaultLanguage = Nothing,
otherLanguages = [],
defaultExtensions = [],
otherExtensions = [],
oldExtensions = [],
extraLibs = [],
extraGHCiLibs = [],
extraLibDirs = [],
includeDirs = [],
includes = [],
installIncludes = [],
options = [],
profOptions = [],
sharedOptions = [],
customFieldsBI = [],
targetBuildDepends = [],
targetBuildRenaming = Map.empty
}
mappend = (Semi.<>)
instance Semigroup BuildInfo where
a <> b = BuildInfo {
buildable = buildable a && buildable b,
buildTools = combine buildTools,
cppOptions = combine cppOptions,
ccOptions = combine ccOptions,
ldOptions = combine ldOptions,
pkgconfigDepends = combine pkgconfigDepends,
frameworks = combineNub frameworks,
cSources = combineNub cSources,
jsSources = combineNub jsSources,
hsSourceDirs = combineNub hsSourceDirs,
otherModules = combineNub otherModules,
defaultLanguage = combineMby defaultLanguage,
otherLanguages = combineNub otherLanguages,
defaultExtensions = combineNub defaultExtensions,
otherExtensions = combineNub otherExtensions,
oldExtensions = combineNub oldExtensions,
extraLibs = combine extraLibs,
extraGHCiLibs = combine extraGHCiLibs,
extraLibDirs = combineNub extraLibDirs,
includeDirs = combineNub includeDirs,
includes = combineNub includes,
installIncludes = combineNub installIncludes,
options = combine options,
profOptions = combine profOptions,
sharedOptions = combine sharedOptions,
customFieldsBI = combine customFieldsBI,
targetBuildDepends = combineNub targetBuildDepends,
buildable = buildable a && buildable b,
buildTools = combine buildTools,
cppOptions = combine cppOptions,
ccOptions = combine ccOptions,
ldOptions = combine ldOptions,
pkgconfigDepends = combine pkgconfigDepends,
frameworks = combineNub frameworks,
extraFrameworkDirs = combineNub extraFrameworkDirs,
cSources = combineNub cSources,
jsSources = combineNub jsSources,
hsSourceDirs = combineNub hsSourceDirs,
otherModules = combineNub otherModules,
defaultLanguage = combineMby defaultLanguage,
otherLanguages = combineNub otherLanguages,
defaultExtensions = combineNub defaultExtensions,
otherExtensions = combineNub otherExtensions,
oldExtensions = combineNub oldExtensions,
extraLibs = combine extraLibs,
extraGHCiLibs = combine extraGHCiLibs,
extraLibDirs = combineNub extraLibDirs,
includeDirs = combineNub includeDirs,
includes = combineNub includes,
installIncludes = combineNub installIncludes,
options = combine options,
profOptions = combine profOptions,
sharedOptions = combine sharedOptions,
customFieldsBI = combine customFieldsBI,
targetBuildDepends = combineNub targetBuildDepends,
targetBuildRenaming = combineMap targetBuildRenaming
}
where
......
......@@ -91,7 +91,7 @@ data PackageCheck =
| PackageDistSuspicious { explanation :: String }
-- | Like PackageDistSuspicious but will only display warnings
-- rather than causing abnormal exit.
-- rather than causing abnormal exit when you run 'cabal check'.
| PackageDistSuspiciousWarn { explanation :: String }
-- | An issue that is OK in the author's environment but is almost
......@@ -580,7 +580,7 @@ checkGhcOptions pkg =
PackageBuildWarning $
"'ghc-options: -prof' is not necessary and will lead to problems "
++ "when used on a library. Use the configure flag "
++ "--enable-library-profiling and/or --enable-executable-profiling."
++ "--enable-library-profiling and/or --enable-profiling."
, checkFlags ["-o"] $
PackageBuildWarning $
......@@ -669,12 +669,21 @@ checkGhcOptions pkg =
, checkAlternatives "ghc-options" "extra-lib-dirs"
[ (flag, dir) | flag@('-':'L':dir) <- all_ghc_options ]
, checkAlternatives "ghc-options" "frameworks"
[ (flag, fmwk) | (flag@"-framework", fmwk) <-
zip all_ghc_options (safeTail all_ghc_options) ]
, checkAlternatives "ghc-options" "extra-framework-dirs"
[ (flag, dir) | (flag@"-framework-path", dir) <-
zip all_ghc_options (safeTail all_ghc_options) ]
]
where
all_ghc_options = concatMap get_ghc_options (allBuildInfo pkg)
lib_ghc_options = maybe [] (get_ghc_options . libBuildInfo) (library pkg)
get_ghc_options bi = hcOptions GHC bi ++ hcProfOptions GHC bi
++ hcSharedOptions GHC bi
checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags flags = check (any (`elem` flags) all_ghc_options)
......@@ -911,6 +920,13 @@ checkCabalVersion pkg =
++ ". To use this new syntax, the package needs to specify at least"
++ "'cabal-version: >= 1.21'."
-- check use of 'extra-framework-dirs' field
, checkVersion [1,23] (any (not . null) (buildInfoField extraFrameworkDirs)) $
-- Just a warning, because this won't break on old Cabal versions.
PackageDistSuspiciousWarn $
"To use the 'extra-framework-dirs' field the package needs to specify"
++ " at least 'cabal-version: >= 1.23'."
-- check use of default-extensions field
-- don't need to do the equivalent check for other-extensions
, checkVersion [1,10] (any (not . null) (buildInfoField defaultExtensions)) $
......@@ -1036,7 +1052,7 @@ checkCabalVersion pkg =
, check (specVersion pkg < Version [1,23] []
&& isNothing (setupBuildInfo pkg)
&& buildType pkg == Just Custom) $
PackageDistSuspicious $
PackageDistSuspiciousWarn $
"From version 1.23 cabal supports specifiying explicit dependencies "
++ "for Custom setup scripts. Consider using cabal-version >= 1.23 and "
++ "adding a 'custom-setup' section with a 'setup-depends' field "
......@@ -1363,6 +1379,7 @@ checkDevelopmentOnlyFlagsBuildInfo bi =
has_Wall = "-Wall" `elem` ghc_options
has_W = "-W" `elem` ghc_options
ghc_options = hcOptions GHC bi ++ hcProfOptions GHC bi
++ hcSharedOptions GHC bi
checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck
checkFlags flags = check (any (`elem` flags) ghc_options)
......@@ -1566,6 +1583,8 @@ checkLocalPathsExist ops pkg = do
| bi <- allBuildInfo pkg
, (dir, kind) <-
[ (dir, "extra-lib-dirs") | dir <- extraLibDirs bi ]
++ [ (dir, "extra-framework-dirs")
| dir <- extraFrameworkDirs bi ]
++ [ (dir, "include-dirs") | dir <- includeDirs bi ]
++ [ (dir, "hs-source-dirs") | dir <- hsSourceDirs bi ]
, isRelative dir ]
......
......@@ -22,10 +22,14 @@ module Distribution.PackageDescription.Configuration (
-- Utils
parseCondition,
freeVars,
extractCondition,
addBuildableCondition,
mapCondTree,
mapTreeData,
mapTreeConds,
mapTreeConstrs,
transformAllBuildInfos,
transformAllBuildDepends,
) where
import Distribution.Package
......@@ -45,6 +49,7 @@ import Data.Char ( isAlphaNum )
import Data.Maybe ( mapMaybe, maybeToList )
import Data.Map ( Map, fromListWith, toList )
import qualified Data.Map as Map
import Data.Tree ( Tree(Node) )
------------------------------------------------------------------------------
......@@ -176,8 +181,6 @@ instance Semigroup d => Semigroup (DepTestRslt d) where
x <> DepOk = x
(MissingDeps d) <> (MissingDeps d') = MissingDeps (d <> d')
data BT a = BTN a | BTB (BT a) (BT a) -- very simple binary tree
-- | Try to find a flag assignment that satisfies the constraints of all trees.
--
......@@ -185,8 +188,9 @@ data BT a = BTN a | BTB (BT a) (BT a) -- very simple binary tree
-- resulting data, the associated dependencies, and the chosen flag
-- assignments.
--
-- In case of failure, the _smallest_ number of of missing dependencies is
-- returned. [TODO: Could also be specified with a function argument.]
-- In case of failure, the union of the dependencies that led to backtracking
-- on all branches is returned.
-- [TODO: Could also be specified with a function argument.]
--
-- TODO: The current algorithm is rather naive. A better approach would be to:
--
......@@ -212,9 +216,7 @@ resolveWithFlags ::
-- ^ Either the missing dependencies (error case), or a pair of
-- (set of build targets with dependencies, chosen flag assignments)
resolveWithFlags dom os arch impl constrs trees checkDeps =
case try dom [] of
Right r -> Right r
Left dbt -> Left $ findShortest dbt
either (Left . fromDepMapUnion) Right $ explore (build [] dom)
where
extraConstrs = toDepMap constrs
......@@ -222,58 +224,123 @@ resolveWithFlags dom os arch impl constrs trees checkDeps =
-- dependencies to dependency maps.
simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]
simplifiedTrees = map ( mapTreeConstrs toDepMap -- convert to maps
. addBuildableCondition pdTaggedBuildInfo
. mapTreeConds (fst . simplifyWithSysParams os arch impl))
trees
-- @try@ recursively tries all possible flag assignments in the domain and
-- either succeeds or returns a binary tree with the missing dependencies
-- encountered in each run. Since the tree is constructed lazily, we
-- avoid some computation overhead in the successful case.
try :: [(FlagName, [Bool])]
-> [(FlagName, Bool)]
-> Either (BT [Dependency]) (TargetSet PDTagged, FlagAssignment)
try [] flags =
-- @explore@ searches a tree of assignments, backtracking whenever a flag
-- introduces a dependency that cannot be satisfied. If there is no
-- solution, @explore@ returns the union of all dependencies that caused
-- it to backtrack. Since the tree is constructed lazily, we avoid some
-- computation overhead in the successful case.
explore :: Tree FlagAssignment
-> Either DepMapUnion (TargetSet PDTagged, FlagAssignment)
explore (Node flags ts) =
let targetSet = TargetSet $ flip map simplifiedTrees $
-- apply additional constraints to all dependencies
first (`constrainBy` extraConstrs) .
simplifyCondTree (env flags)
deps = overallDependencies targetSet
in case checkDeps (fromDepMap deps) of
DepOk -> Right (targetSet, flags)
MissingDeps mds -> Left (BTN mds)
try ((n, vals):rest) flags =
tryAll $ map (\v -> try rest ((n, v):flags)) vals
DepOk | null ts -> Right (targetSet, flags)
| otherwise -> tryAll $ map explore ts
MissingDeps mds -> Left (toDepMapUnion mds)
-- Builds a tree of all possible flag assignments. Internal nodes
-- have only partial assignments.
build :: FlagAssignment -> [(FlagName, [Bool])] -> Tree FlagAssignment
build assigned [] = Node assigned []
build assigned ((fn, vals) : unassigned) =
Node assigned $ map (\v -> build ((fn, v) : assigned) unassigned) vals
tryAll :: [Either DepMapUnion a] -> Either DepMapUnion a
tryAll = foldr mp mz
-- special version of `mplus' for our local purposes
mp (Left xs) (Left ys) = (Left (BTB xs ys))
mp (Left _) m@(Right _) = m
mp :: Either DepMapUnion a -> Either DepMapUnion a -> Either DepMapUnion a
mp m@(Right _) _ = m
mp _ m@(Right _) = m
mp (Left xs) (Left ys) =
let union = Map.foldrWithKey (Map.insertWith' combine)
(unDepMapUnion xs) (unDepMapUnion ys)
combine x y = simplifyVersionRange $ unionVersionRanges x y
in union `seq` Left (DepMapUnion union)
-- `mzero'
mz = Left (BTN [])
mz :: Either DepMapUnion a
mz = Left (DepMapUnion Map.empty)
env :: FlagAssignment -> FlagName -> Either FlagName Bool
env flags flag = (maybe (Left flag) Right . lookup flag) flags
-- for the error case we inspect our lazy tree of missing dependencies and
-- pick the shortest list of missing dependencies
findShortest (BTN x) = x
findShortest (BTB lt rt) =
let l = findShortest lt
r = findShortest rt
in case (l,r) of
([], xs) -> xs -- [] is too short
(xs, []) -> xs
([x], _) -> [x] -- single elem is optimum
(_, [x]) -> [x]
(xs, ys) -> if lazyLengthCmp xs ys
then xs else ys
-- lazy variant of @\xs ys -> length xs <= length ys@
lazyLengthCmp [] _ = True
lazyLengthCmp _ [] = False
lazyLengthCmp (_:xs) (_:ys) = lazyLengthCmp xs ys
pdTaggedBuildInfo :: PDTagged -> BuildInfo
pdTaggedBuildInfo (Lib l) = libBuildInfo l
pdTaggedBuildInfo (Exe _ e) = buildInfo e
pdTaggedBuildInfo (Test _ t) = testBuildInfo t
pdTaggedBuildInfo (Bench _ b) = benchmarkBuildInfo b
pdTaggedBuildInfo PDNull = mempty
-- | Transforms a 'CondTree' by putting the input under the "then" branch of a
-- conditional that is True when Buildable is True. If 'addBuildableCondition'
-- can determine that Buildable is always True, it returns the input unchanged.
-- If Buildable is always False, it returns the empty 'CondTree'.
addBuildableCondition :: (Eq v, Monoid a, Monoid c) => (a -> BuildInfo)
-> CondTree v c a
-> CondTree v c a
addBuildableCondition getInfo t =
case extractCondition (buildable . getInfo) t of
Lit True -> t
Lit False -> CondNode mempty mempty []
c -> CondNode mempty mempty [(c, t, Nothing)]
-- | Extract buildable condition from a cond tree.
--
-- Background: If the conditions in a cond tree lead to Buildable being set to False,
-- then none of the dependencies for this cond tree should actually be taken into
-- account. On the other hand, some of the flags may only be decided in the solver,
-- so we cannot necessarily make the decision whether a component is Buildable or not
-- prior to solving.
--
-- What we are doing here is to partially evaluate a condition tree in order to extract
-- the condition under which Buildable is True. The predicate determines whether data
-- under a 'CondTree' is buildable.
extractCondition :: Eq v => (a -> Bool) -> CondTree v c a -> Condition v
extractCondition p = go
where
go (CondNode x _ cs) | not (p x) = Lit False
| otherwise = goList cs
goList [] = Lit True
goList ((c, t, e) : cs) =
let
ct = go t
ce = maybe (Lit True) go e
in
((c `cand` ct) `cor` (CNot c `cand` ce)) `cand` goList cs
cand (Lit False) _ = Lit False
cand _ (Lit False) = Lit False
cand (Lit True) x = x
cand x (Lit True) = x
cand x y = CAnd x y
cor (Lit True) _ = Lit True
cor _ (Lit True) = Lit True
cor (Lit False) x = x
cor x (Lit False) = x
cor c (CNot d)
| c == d = Lit True
cor x y = COr x y
-- | A map of dependencies that combines version ranges using 'unionVersionRanges'.
newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange }
toDepMapUnion :: [Dependency] -> DepMapUnion
toDepMapUnion ds =
DepMapUnion $ fromListWith unionVersionRanges [ (p,vr) | Dependency p vr <- ds ]
fromDepMapUnion :: DepMapUnion -> [Dependency]
fromDepMapUnion m = [ Dependency p vr | (p,vr) <- toList (unDepMapUnion m) ]
-- | A map of dependencies. Newtyped since the default monoid instance is not
-- appropriate. The monoid instance uses 'intersectVersionRanges'.
......@@ -295,6 +362,8 @@ toDepMap ds =
fromDepMap :: DependencyMap -> [Dependency]
fromDepMap m = [ Dependency p vr | (p,vr) <- toList (unDependencyMap m) ]
-- | Flattens a CondTree using a partial flag assignment. When a condition
-- cannot be evaluated, both branches are ignored.
simplifyCondTree :: (Monoid a, Monoid d) =>
(v -> Either v Bool)
-> CondTree v d a
......@@ -306,7 +375,7 @@ simplifyCondTree env (CondNode a d ifs) =
case simplifyCondition cnd env of
(Lit True, _) -> Just $ simplifyCondTree env t
(Lit False, _) -> fmap (simplifyCondTree env) me
_ -> error $ "Environment not defined for all free vars"
_ -> Nothing
-- | Flatten a CondTree. This will resolve the CondTree by taking all
-- possible paths into account. Note that since branches represent exclusive
......@@ -459,9 +528,10 @@ instance Semigroup PDTagged where
--
-- This function will fail if it cannot find a flag assignment that leads to
-- satisfiable dependencies. (It will not try alternative assignments for
-- explicitly specified flags.) In case of failure it will return a /minimum/
-- number of dependencies that could not be satisfied. On success, it will
-- return the package description and the full flag assignment chosen.
-- explicitly specified flags.) In case of failure it will return the missing
-- dependencies that it encountered when trying different flag assignments.
-- On success, it will return the package description and the full flag
-- assignment chosen.
--
finalizePackageDescription ::
FlagAssignment -- ^ Explicitly specified flag assignments
......@@ -597,3 +667,82 @@ biFillInDefaults bi =
if null (hsSourceDirs bi)
then bi { hsSourceDirs = [currentDir] }
else bi
-- Walk a 'GenericPackageDescription' and apply @onBuildInfo@/@onSetupBuildInfo@
-- to all nested 'BuildInfo'/'SetupBuildInfo' values.
transformAllBuildInfos :: (BuildInfo -> BuildInfo)
-> (SetupBuildInfo -> SetupBuildInfo)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildInfos onBuildInfo onSetupBuildInfo gpd = gpd'
where
onLibrary lib = lib { libBuildInfo = onBuildInfo $ libBuildInfo lib }
onExecutable exe = exe { buildInfo = onBuildInfo $ buildInfo exe }
onTestSuite tst = tst { testBuildInfo = onBuildInfo $ testBuildInfo tst }
onBenchmark bmk = bmk { benchmarkBuildInfo =
onBuildInfo $ benchmarkBuildInfo bmk }
pd = packageDescription gpd
pd' = pd {
library = fmap onLibrary (library pd),
executables = map onExecutable (executables pd),
testSuites = map onTestSuite (testSuites pd),
benchmarks = map onBenchmark (benchmarks pd),
setupBuildInfo = fmap onSetupBuildInfo (setupBuildInfo pd)
}
gpd' = transformAllCondTrees onLibrary onExecutable
onTestSuite onBenchmark id
$ gpd { packageDescription = pd' }
-- | Walk a 'GenericPackageDescription' and apply @f@ to all nested
-- @build-depends@ fields.
transformAllBuildDepends :: (Dependency -> Dependency)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildDepends f gpd = gpd'
where
onBI bi = bi { targetBuildDepends = map f $ targetBuildDepends bi }
onSBI stp = stp { setupDepends = map f $ setupDepends stp }
onPD pd = pd { buildDepends = map f $ buildDepends pd }
pd' = onPD $ packageDescription gpd
gpd' = transformAllCondTrees id id id id (map f)
. transformAllBuildInfos onBI onSBI
$ gpd { packageDescription = pd' }
-- | Walk all 'CondTree's inside a 'GenericPackageDescription' and apply
-- appropriate transformations to all nodes. Helper function used by
-- 'transformAllBuildDepends' and 'transformAllBuildInfos'.
transformAllCondTrees :: (Library -> Library)
-> (Executable -> Executable)
-> (TestSuite -> TestSuite)
-> (Benchmark -> Benchmark)
-> ([Dependency] -> [Dependency])
-> GenericPackageDescription -> GenericPackageDescription
transformAllCondTrees onLibrary onExecutable
onTestSuite onBenchmark onDepends gpd = gpd'
where
gpd' = gpd {
condLibrary = condLib',
condExecutables = condExes',
condTestSuites = condTests',
condBenchmarks = condBenchs'
}
condLib = condLibrary gpd
condExes = condExecutables gpd
condTests = condTestSuites gpd
condBenchs = condBenchmarks gpd
condLib' = fmap (onCondTree onLibrary) condLib
condExes' = map (mapSnd $ onCondTree onExecutable) condExes
condTests' = map (mapSnd $ onCondTree onTestSuite) condTests
condBenchs' = map (mapSnd $ onCondTree onBenchmark) condBenchs
mapSnd :: (a -> b) -> (c,a) -> (c,b)
mapSnd = fmap
onCondTree :: (a -> b) -> CondTree v [Dependency] a
-> CondTree v [Dependency] b
onCondTree g = mapCondTree g onDepends id
......@@ -405,6 +405,9 @@ binfoFieldDescrs =
, listField "frameworks"
showToken parseTokenQ
frameworks (\val binfo -> binfo{frameworks=val})
, listField "extra-framework-dirs"
showToken parseFilePathQ
extraFrameworkDirs (\val binfo -> binfo{extraFrameworkDirs=val})
, listFieldWithSep vcat "c-sources"
showFilePath parseFilePathQ
cSources (\paths binfo -> binfo{cSources=paths})
......
......@@ -44,6 +44,7 @@ import Distribution.License
import Distribution.Version
import Distribution.Package
import Distribution.ModuleName
import qualified Distribution.Compat.MonadFail as Fail
import Distribution.Compat.ReadP as ReadP hiding (get)
import Distribution.ReadE
import Distribution.Text
......@@ -100,6 +101,9 @@ instance Monad ParseResult where
ParseOk ws x >>= f = case f x of
ParseFailed err -> ParseFailed err
ParseOk ws' x' -> ParseOk (ws'++ws) x'
fail = Fail.fail
instance Fail.MonadFail ParseResult where
fail s = ParseFailed (FromString s Nothing)
catchParseError :: ParseResult a -> (PError -> ParseResult a)
......
......@@ -453,9 +453,9 @@ getBuildConfig hooks verbosity distPref = do
-- Since the list of unconfigured programs is not serialized,
-- restore it to the same value as normally used at the beginning
-- of a configure run:
configPrograms = restoreProgramConfiguration
configPrograms_ = restoreProgramConfiguration
(builtinPrograms ++ hookedPrograms hooks)
(configPrograms cFlags),
`fmap` configPrograms_ cFlags,
-- Use the current, not saved verbosity level:
configVerbosity = Flag verbosity
......
......@@ -52,8 +52,9 @@ import Distribution.Simple.Register
import Distribution.Simple.Test.LibV09
import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.System
import Distribution.Text
import Distribution.Verbosity
import qualified Data.Map as Map
import qualified Data.Set as Set
......@@ -153,11 +154,12 @@ repl pkg_descr lbi flags suffixes args = do
-- | Start an interpreter without loading any package files.
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> PackageDBStack -> IO ()
startInterpreter verbosity programDb comp packageDBs =
startInterpreter :: Verbosity -> ProgramDb -> Compiler -> Platform
-> PackageDBStack -> IO ()
startInterpreter verbosity programDb comp platform packageDBs =
case compilerFlavor comp of
GHC -> GHC.startInterpreter verbosity programDb comp packageDBs
GHCJS -> GHCJS.startInterpreter verbosity programDb comp packageDBs
GHC -> GHC.startInterpreter verbosity programDb comp platform packageDBs
GHCJS -> GHCJS.startInterpreter verbosity programDb comp platform packageDBs
_ -> die "A REPL is not supported with this compiler."
buildComponent :: Verbosity
......
......@@ -31,7 +31,8 @@ import Distribution.Version
import Distribution.PackageDescription
( PackageDescription )
import Distribution.Simple.LocalBuildInfo
( LocalBuildInfo(withPrograms), externalPackageDeps, localComponentId, localCompatPackageKey )
( LocalBuildInfo(withPrograms), externalPackageDeps
, localComponentId, localCompatPackageKey )
import Distribution.Simple.Program.Db
( configuredPrograms )
import Distribution.Simple.Program.Types
......
......@@ -94,15 +94,13 @@ mkSharedLibName (CompilerId compilerFlavor compilerVersion) lib
-- * Platform file extensions
-- ------------------------------------------------------------
-- ToDo: This should be determined via autoconf (AC_EXEEXT)
-- | Extension for executable files
-- | Default extension for executable files on the current platform.
-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
exeExtension :: String
exeExtension = case buildOS of
Windows -> "exe"
_ -> ""
-- TODO: This should be determined via autoconf (AC_OBJEXT)
-- | Extension for object files. For GHC the extension is @\"o\"@.
objExtension :: String
objExtension = "o"
......
......@@ -48,6 +48,7 @@ module Distribution.Simple.Configure (configure,
ConfigStateFileError(..),
tryGetConfigStateFile,
platformDefines,
relaxPackageDeps,
)
where
......@@ -57,7 +58,8 @@ import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.PreProcess
import Distribution.Package
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.InstalledPackageInfo (InstalledPackageInfo, emptyInstalledPackageInfo)
import Distribution.InstalledPackageInfo (InstalledPackageInfo
,emptyInstalledPackageInfo)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.PackageDescription as PD hiding (Flag)
......@@ -96,7 +98,7 @@ import qualified Data.ByteString.Lazy.Char8 as BLC8
import Data.List
( (\\), nub, partition, isPrefixOf, inits, stripPrefix )
import Data.Maybe
( isNothing, catMaybes, fromMaybe, isJust )
( isNothing, catMaybes, fromMaybe, mapMaybe, isJust )
import Data.Either
( partitionEithers )
import qualified Data.Set as Set
......@@ -130,7 +132,8 @@ data ConfigStateFileError
| ConfigStateFileBadHeader -- ^ Incorrect header.
| ConfigStateFileNoParse -- ^ Cannot parse file contents.
| ConfigStateFileMissing -- ^ No file!
| ConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo) -- ^ Mismatched version.
| ConfigStateFileBadVersion PackageIdentifier PackageIdentifier
(Either ConfigStateFileError LocalBuildInfo) -- ^ Mismatched version.
deriving (Typeable)
instance Show ConfigStateFileError where
......@@ -192,7 +195,8 @@ getConfigStateFile filename = do
| otherwise = act
deferErrorIfBadVersion getStoredValue
-- | Read the 'localBuildInfoFile', returning either an error or the local build info.
-- | Read the 'localBuildInfoFile', returning either an error or the local build
-- info.
tryGetConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.
-> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile = try . getConfigStateFile
......@@ -236,12 +240,13 @@ currentCompilerId :: PackageIdentifier
currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)
System.Info.compilerVersion
-- | Parse the @setup-config@ file header, returning the package identifiers
-- | Parse the @setup-config@ file header, returning the package identifiers
-- for Cabal and the compiler.
parseHeader :: ByteString -- ^ The file contents.
-> (PackageIdentifier, PackageIdentifier)
parseHeader header = case BLC8.words header of
["Saved", "package", "config", "for", pkgId, "written", "by", cabalId, "using", compId] ->
["Saved", "package", "config", "for", pkgId, "written", "by", cabalId,
"using", compId] ->
fromMaybe (throw ConfigStateFileBadHeader) $ do
_ <- simpleParse (BLC8.unpack pkgId) :: Maybe PackageIdentifier
cabalId' <- simpleParse (BLC8.unpack cabalId)
......@@ -276,9 +281,9 @@ localBuildInfoFile distPref = distPref </> "setup-config"
-- * Configuration
-- -----------------------------------------------------------------------------
-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken from
-- (in order of highest to lowest preference) the override prefix, the \"CABAL_BUILDDIR\"
-- environment variable, or the default prefix.
-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken
-- from (in order of highest to lowest preference) the override prefix, the
-- \"CABAL_BUILDDIR\" environment variable, or the default prefix.
findDistPref :: FilePath -- ^ default \"dist\" prefix
-> Setup.Flag FilePath -- ^ override \"dist\" prefix
-> IO FilePath
......@@ -291,11 +296,12 @@ findDistPref defDistPref overrideDistPref = do
Just distPref | not (null distPref) -> toFlag distPref
_ -> NoFlag
-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken from
-- (in order of highest to lowest preference) the override prefix, the \"CABAL_BUILDDIR\"
-- environment variable, or 'defaultDistPref' is used. Call this function to resolve a
-- @*DistPref@ flag whenever it is not known to be set. (The @*DistPref@ flags are always
-- set to a definite value before invoking 'UserHooks'.)
-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken
-- from (in order of highest to lowest preference) the override prefix, the
-- \"CABAL_BUILDDIR\" environment variable, or 'defaultDistPref' is used. Call
-- this function to resolve a @*DistPref@ flag whenever it is not known to be
-- set. (The @*DistPref@ flags are always set to a definite value before
-- invoking 'UserHooks'.)
findDistPrefOrDefault :: Setup.Flag FilePath -- ^ override \"dist\" prefix
-> IO FilePath
findDistPrefOrDefault = findDistPref defaultDistPref
......@@ -304,7 +310,15 @@ findDistPrefOrDefault = findDistPref defaultDistPref
-- Returns the @.setup-config@ file.
configure :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
configure (pkg_descr0, pbi) cfg = do
configure (pkg_descr0', pbi) cfg = do
let pkg_descr0 =
-- Ignore '--allow-newer' when we're given '--exact-configuration'.
if fromFlagOrDefault False (configExactConfiguration cfg)
then pkg_descr0'
else relaxPackageDeps
(fromMaybe AllowNewerNone $ configAllowNewer cfg)
pkg_descr0'
setupMessage verbosity "Configuring" (packageId pkg_descr0)
checkDeprecatedFlags verbosity cfg
......@@ -453,7 +467,8 @@ configure (pkg_descr0, pbi) cfg = do
, (pkg, ver) <- uses ]
-- installation directories
defaultDirs <- defaultInstallDirs (compilerFlavor comp) (fromFlag (configUserInstall cfg)) (hasLibs pkg_descr)
defaultDirs <- defaultInstallDirs (compilerFlavor comp)
(fromFlag (configUserInstall cfg)) (hasLibs pkg_descr)
let installDirs = combineInstallDirs fromFlagOrDefault
defaultDirs (configInstallDirs cfg)
......@@ -679,7 +694,8 @@ mkProgramsConfig cfg initialProgramsConfig = programsConfig
. setProgramSearchPath searchpath
$ initialProgramsConfig
searchpath = getProgramSearchPath (initialProgramsConfig)
++ map ProgramSearchPathDir (fromNubList $ configProgramPathExtra cfg)
++ map ProgramSearchPathDir
(fromNubList $ configProgramPathExtra cfg)
-- -----------------------------------------------------------------------------
-- Helper functions for configure
......@@ -710,7 +726,7 @@ checkExactConfiguration pkg_descr0 cfg = do
allFlags = map flagName . genPackageFlags $ pkg_descr0
diffFlags = allFlags \\ cmdlineFlags
when (not . null $ diffFlags) $
die $ "'--exact-conf' was given, "
die $ "'--exact-configuration' was given, "
++ "but the following flags were not specified: "
++ intercalate ", " (map show diffFlags)
......@@ -780,6 +796,29 @@ dependencySatisfiable
isInternalDep = not . null
$ PackageIndex.lookupDependency internalPackageSet d
-- | Relax the dependencies of this package if needed.
relaxPackageDeps :: AllowNewer -> GenericPackageDescription
-> GenericPackageDescription
relaxPackageDeps AllowNewerNone gpd = gpd
relaxPackageDeps AllowNewerAll gpd = transformAllBuildDepends relaxAll gpd
where
relaxAll = \(Dependency pkgName verRange) ->
Dependency pkgName (removeUpperBound verRange)
relaxPackageDeps (AllowNewerSome allowNewerDeps') gpd =
transformAllBuildDepends relaxSome gpd
where
thisPkgName = packageName gpd
allowNewerDeps = mapMaybe f allowNewerDeps'
f (Setup.AllowNewerDep p) = Just p
f (Setup.AllowNewerDepScoped scope p) | scope == thisPkgName = Just p
| otherwise = Nothing
relaxSome = \d@(Dependency depName verRange) ->
if depName `elem` allowNewerDeps
then Dependency depName (removeUpperBound verRange)
else d
-- | Finalize a generic package description. The workhorse is
-- 'finalizePackageDescription' but there's a bit of other nattering
-- about necessary.
......@@ -819,7 +858,7 @@ configureFinalizedPackage verbosity cfg
pkg_descr0''
of Right r -> return r
Left missing ->
die $ "At least the following dependencies are missing:\n"
die $ "Encountered missing dependencies:\n"
++ (render . nest 4 . sep . punctuate comma
. map (disp . simplifyDependency)
$ missing)
......@@ -837,6 +876,7 @@ configureFinalizedPackage verbosity cfg
where
addExtraIncludeLibDirs pkg_descr =
let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
, extraFrameworkDirs = configExtraFrameworkDirs cfg
, PD.includeDirs = configExtraIncludeDirs cfg}
modifyLib l = l{ libBuildInfo = libBuildInfo l
`mappend` extraBi }
......@@ -929,7 +969,8 @@ data FailedDependency = DependencyNotExists PackageName
selectDependency :: InstalledPackageIndex -- ^ Internally defined packages
-> InstalledPackageIndex -- ^ Installed packages
-> Map PackageName InstalledPackageInfo
-- ^ Packages for which we have been given specific deps to use
-- ^ Packages for which we have been given specific deps to
-- use
-> Dependency
-> Either FailedDependency ResolvedDependency
selectDependency internalIndex installedIndex requiredDepsMap
......@@ -1097,7 +1138,8 @@ combinedConstraints constraints dependencies installedPackages = do
when (not (null badNames)) $
Left $ render $ text "The following package dependencies were requested"
$+$ nest 4 (dispDependencies badNames)
$+$ text "however the installed package's name does not match the name given."
$+$ text ("however the installed package's name does not match "
++ "the name given.")
--TODO: we don't check that all dependencies are used!
......@@ -1472,8 +1514,9 @@ computeCompatPackageKey comp pid cname uid@(SimpleUnitId (ComponentId str))
CExeName n -> "-z-exe-" ++ zdashcode n
package_name
| cname == CLibName = pkgName pid
| otherwise = PackageName $ "z-" ++ zdashcode (display (pkgName pid))
++ zdashcode cname_str
| otherwise = PackageName $ "z-"
++ zdashcode (display (pkgName pid))
++ zdashcode cname_str
old_style_key
| cname == CLibName = display pid
| otherwise = display package_name ++ "-"
......@@ -1519,20 +1562,24 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
let env = packageTemplateEnv (package pkg_descr)
(mkUnitId "")
str = fromPathTemplate
(InstallDirs.substPathTemplate env (toPathTemplate cid0))
(InstallDirs.substPathTemplate env
(toPathTemplate cid0))
in ComponentId str
_ ->
computeComponentId (package pkg_descr) CLibName (getDeps CLibName) flagAssignment
computeComponentId (package pkg_descr) CLibName
(getDeps CLibName) flagAssignment
uid = SimpleUnitId cid
(_, compat_key) = computeCompatPackageKey comp (package pkg_descr) CLibName uid
(_, compat_key) = computeCompatPackageKey comp
(package pkg_descr) CLibName uid
sequence
[ do clbi <- componentLocalBuildInfo uid compat_key c
return (componentName c, clbi, cdeps)
| (c, cdeps) <- graph ]
where
getDeps cname =
let externalPkgs = maybe [] (\lib -> selectSubset (componentBuildInfo lib)
externalPkgDeps)
let externalPkgs = maybe [] (\lib -> selectSubset
(componentBuildInfo lib)
externalPkgDeps)
(lookupComponent pkg_descr cname)
in map Installed.installedComponentId externalPkgs
......@@ -1595,7 +1642,8 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
-- deps were bundled up in buildDepends, we didn't do this for
-- renamings, so it's not even clear how to get the merged
-- version. So just assume that all of them are the default..
else Map.fromList (map (\(_,pid) -> (packageName pid, defaultRenaming)) cpds)
else Map.fromList (map (